diff --git a/official/1.96/Install.bat b/official/1.96/Install.bat new file mode 100644 index 0000000..3496cc1 --- /dev/null +++ b/official/1.96/Install.bat @@ -0,0 +1,13 @@ +@echo off + +cd install\build +call pretest.bat +if ERRORLEVEL 1 GOTO FINI + +SET DELPHIVERSION=%1 +if "%1" == "" SET DELPHIVERSION=newest + +build.exe %DELPHIVERSION% "--make=installer" + +:FINI +cd ..\.. diff --git a/official/1.96/Install.txt b/official/1.96/Install.txt new file mode 100644 index 0000000..99e4499 --- /dev/null +++ b/official/1.96/Install.txt @@ -0,0 +1,70 @@ +JEDI Code Library v 1.96 Installation + +Supported development tools versions: + +- Borland C++ Builder 5 +- Borland C++ Builder 6 +- Borland Delphi 5 Update Pack #1 +- Borland Delphi 6 Update Pack #2 (including Personal Edition) +- Borland Delphi 7 +- Borland Kylix 3 +- Borland Delphi 2005 +- Borland Developer Studio 2006 (also known as Delphi 2006, C++Builder 2006) + +For more detailed information, see docs\Readme.html. + +Please make sure you have installed latest update packs. You can download them +from Borland Support web page: + +Delphi: http://info.borland.com/devsupport/delphi/ +C++Builder: http://info.borland.com/devsupport/bcppbuilder/ + +******************************* IMPORTANT ************************************** +* * +* If you have installed any previous version of the JCL/JVCL you have to * +* delete them. * +* * +* * +* It is also necessary to remove all installed JCL/JVCL packages from the IDE. * +* Do not mix files or compiled packages from older versions of the JCL with * +* current version. * +* * +* JCL 1.96 is not compatible with JVCL versions < 3 and _will_ break them! * +* JVCL v. 3.1 will get released together with JCL 1.96; it is available from * +* http://jvcl.sourceforge.net/daily/ * +* * +******************************************************************************** + +JEDI INSTALLER +============== + +Helps you to integrate JCL with Delphi/BCB IDE. Currently it assists with: + +- Compiling library units (release and debug versions) +- Compiling packages and installing design-time packages to the IDE +- Adding sample JCL Debug extension dialogs to Object Repository +- Adding JCL directories to Library Path / Browsing Path in Environment Options +- Adding JCL debug .dcu directory to Debug DCU Path in Debugger Options +- Integrating JCL help file to the IDE. +- in undoing above changes to the IDE settings ("Uninstall", new in 1.94 final). + +To execute for + +1) Win32 +- click on "Install.bat" file in the JCL root directory. + + Note: If you have Delphi 8 for Microsoft .NET installed, you probably will have + to specify the root directory of the make.exe to use for JCL installation; + on the commandline, type (for example): + + >install "C:\Program Files\Borland\Delphi5" + +2) Kylix 3 +- open a shell window +- cd into JCL root directory +- at the command prompt, type "sh ./install.sh", then press "Enter". + You'll also need to do a "source kylixpath" first (see the README of your + Kylix 3 installation) in case your system is not set up to do that at startup. + +-------------------------------- +Document last updated 2005-10-30 diff --git a/official/1.96/QInstall.bat b/official/1.96/QInstall.bat new file mode 100644 index 0000000..ffd17cd --- /dev/null +++ b/official/1.96/QInstall.bat @@ -0,0 +1,13 @@ +@echo off + +cd install\build +call pretest.bat +if ERRORLEVEL 1 GOTO FINI + +SET DELPHIVERSION=%1 +if "%1" == "" SET DELPHIVERSION=d7 + +build.exe %DELPHIVERSION% "--make=qinstaller" + +:FINI +cd ..\.. diff --git a/official/1.96/bin/Borland Developer Studio 2006.log b/official/1.96/bin/Borland Developer Studio 2006.log new file mode 100644 index 0000000..fabf252 --- /dev/null +++ b/official/1.96/bin/Borland Developer Studio 2006.log @@ -0,0 +1,557 @@ +Borland Developer Studio 2006 Build 10.0.2558.35231 + +Added "T:\COMPON~1\jcl\lib\d10;T:\COMPON~1\jcl\source" to library path. + +Added "T:\COMPON~1\jcl\source\common;T:\COMPON~1\jcl\source\windows;T:\COMPON~1\jcl\source\vcl;T:\COMPON~1\jcl\source\visclx;" to library browsing path. + +Added "T:\COMPON~1\jcl\lib\d10\debug" to Debug DCU Path. + +Making common library units for Borland Developer Studio 2006 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias + -B = Build all units + -CC = Console target + -CG = GUI target + -D = Define conditionals + -E = EXE/DLL output directory + -F = Find error + -GD = Detailed map file + -GP = Map file with publics + -GS = Map file with segments + -H = Output hint messages + -I = Include directories + -J = Generate .obj file + -JPHNE = Generate C++ .obj file, .hpp file, in namespace, export all + -K = Set image base addr + -LE = package .bpl output directory + -LN = package .dcp output directory + -LU = Use package + -M = Make modified units + -N0 = unit .dcu output directory + -NH = unit .hpp output directory + -NO = unit .obj output directory + -NB = unit .bpi output directory + -NS = Namespace search path + -O = Object directories + -P = look for 8.3 file names also + -Q = Quiet compile + -R = Resource directories + -U = Unit directories + -V = Debug information in EXE + -VR = Generate remote debug (RSM) + -W[+|-][warn_id] = Output warning messages + -Z = Output 'never build' DCPs + -$ = Compiler directive + --help = Show this help screen + --version = Show name and version + --codepage: = specify source file encoding + --default-namespace: = set namespace + --depends = output unit dependency information + --doc = output XML documentation + --drc = output resource string .drc file + --no-config = do not load default DCC32.CFG file +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields + B- Full boolean Evaluation + C- Evaluate assertions at runtime + D- Debug information + G+ Use imported data references + H+ Use long strings by default + I+ I/O checking + J- Writeable structured consts + L+ Local debug symbols + M- Runtime type info + O+ Optimization + P+ Open string params + Q- Integer overflow checking + R- Range checking + T- Typed @ operator + U- Pentium(tm)-safe divide + V+ Strict var-strings + W- Generate stack frames + X+ Extended syntax + Y+ Symbol reference info + Z1 Minimum size of enum types + +Making windows library units for Borland Developer Studio 2006 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias + -B = Build all units + -CC = Console target + -CG = GUI target + -D = Define conditionals + -E = EXE/DLL output directory + -F = Find error + -GD = Detailed map file + -GP = Map file with publics + -GS = Map file with segments + -H = Output hint messages + -I = Include directories + -J = Generate .obj file + -JPHNE = Generate C++ .obj file, .hpp file, in namespace, export all + -K = Set image base addr + -LE = package .bpl output directory + -LN = package .dcp output directory + -LU = Use package + -M = Make modified units + -N0 = unit .dcu output directory + -NH = unit .hpp output directory + -NO = unit .obj output directory + -NB = unit .bpi output directory + -NS = Namespace search path + -O = Object directories + -P = look for 8.3 file names also + -Q = Quiet compile + -R = Resource directories + -U = Unit directories + -V = Debug information in EXE + -VR = Generate remote debug (RSM) + -W[+|-][warn_id] = Output warning messages + -Z = Output 'never build' DCPs + -$ = Compiler directive + --help = Show this help screen + --version = Show name and version + --codepage: = specify source file encoding + --default-namespace: = set namespace + --depends = output unit dependency information + --doc = output XML documentation + --drc = output resource string .drc file + --no-config = do not load default DCC32.CFG file +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields + B- Full boolean Evaluation + C- Evaluate assertions at runtime + D- Debug information + G+ Use imported data references + H+ Use long strings by default + I+ I/O checking + J- Writeable structured consts + L+ Local debug symbols + M- Runtime type info + O+ Optimization + P+ Open string params + Q- Integer overflow checking + R- Range checking + T- Typed @ operator + U- Pentium(tm)-safe divide + V+ Strict var-strings + W- Generate stack frames + X+ Extended syntax + Y+ Symbol reference info + Z1 Minimum size of enum types + +Making vcl library units for Borland Developer Studio 2006 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias + -B = Build all units + -CC = Console target + -CG = GUI target + -D = Define conditionals + -E = EXE/DLL output directory + -F = Find error + -GD = Detailed map file + -GP = Map file with publics + -GS = Map file with segments + -H = Output hint messages + -I = Include directories + -J = Generate .obj file + -JPHNE = Generate C++ .obj file, .hpp file, in namespace, export all + -K = Set image base addr + -LE = package .bpl output directory + -LN = package .dcp output directory + -LU = Use package + -M = Make modified units + -N0 = unit .dcu output directory + -NH = unit .hpp output directory + -NO = unit .obj output directory + -NB = unit .bpi output directory + -NS = Namespace search path + -O = Object directories + -P = look for 8.3 file names also + -Q = Quiet compile + -R = Resource directories + -U = Unit directories + -V = Debug information in EXE + -VR = Generate remote debug (RSM) + -W[+|-][warn_id] = Output warning messages + -Z = Output 'never build' DCPs + -$ = Compiler directive + --help = Show this help screen + --version = Show name and version + --codepage: = specify source file encoding + --default-namespace: = set namespace + --depends = output unit dependency information + --doc = output XML documentation + --drc = output resource string .drc file + --no-config = do not load default DCC32.CFG file +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields + B- Full boolean Evaluation + C- Evaluate assertions at runtime + D- Debug information + G+ Use imported data references + H+ Use long strings by default + I+ I/O checking + J- Writeable structured consts + L+ Local debug symbols + M- Runtime type info + O+ Optimization + P+ Open string params + Q- Integer overflow checking + R- Range checking + T- Typed @ operator + U- Pentium(tm)-safe divide + V+ Strict var-strings + W- Generate stack frames + X+ Extended syntax + Y+ Symbol reference info + Z1 Minimum size of enum types + +Making common library debug units for Borland Developer Studio 2006 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias + -B = Build all units + -CC = Console target + -CG = GUI target + -D = Define conditionals + -E = EXE/DLL output directory + -F = Find error + -GD = Detailed map file + -GP = Map file with publics + -GS = Map file with segments + -H = Output hint messages + -I = Include directories + -J = Generate .obj file + -JPHNE = Generate C++ .obj file, .hpp file, in namespace, export all + -K = Set image base addr + -LE = package .bpl output directory + -LN = package .dcp output directory + -LU = Use package + -M = Make modified units + -N0 = unit .dcu output directory + -NH = unit .hpp output directory + -NO = unit .obj output directory + -NB = unit .bpi output directory + -NS = Namespace search path + -O = Object directories + -P = look for 8.3 file names also + -Q = Quiet compile + -R = Resource directories + -U = Unit directories + -V = Debug information in EXE + -VR = Generate remote debug (RSM) + -W[+|-][warn_id] = Output warning messages + -Z = Output 'never build' DCPs + -$ = Compiler directive + --help = Show this help screen + --version = Show name and version + --codepage: = specify source file encoding + --default-namespace: = set namespace + --depends = output unit dependency information + --doc = output XML documentation + --drc = output resource string .drc file + --no-config = do not load default DCC32.CFG file +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields + B- Full boolean Evaluation + C+ Evaluate assertions at runtime + D+ Debug information + G+ Use imported data references + H+ Use long strings by default + I+ I/O checking + J- Writeable structured consts + L+ Local debug symbols + M- Runtime type info + O- Optimization + P+ Open string params + Q+ Integer overflow checking + R+ Range checking + T- Typed @ operator + U- Pentium(tm)-safe divide + V+ Strict var-strings + W+ Generate stack frames + X+ Extended syntax + Y+ Symbol reference info + Z1 Minimum size of enum types + +Making windows library debug units for Borland Developer Studio 2006 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias + -B = Build all units + -CC = Console target + -CG = GUI target + -D = Define conditionals + -E = EXE/DLL output directory + -F = Find error + -GD = Detailed map file + -GP = Map file with publics + -GS = Map file with segments + -H = Output hint messages + -I = Include directories + -J = Generate .obj file + -JPHNE = Generate C++ .obj file, .hpp file, in namespace, export all + -K = Set image base addr + -LE = package .bpl output directory + -LN = package .dcp output directory + -LU = Use package + -M = Make modified units + -N0 = unit .dcu output directory + -NH = unit .hpp output directory + -NO = unit .obj output directory + -NB = unit .bpi output directory + -NS = Namespace search path + -O = Object directories + -P = look for 8.3 file names also + -Q = Quiet compile + -R = Resource directories + -U = Unit directories + -V = Debug information in EXE + -VR = Generate remote debug (RSM) + -W[+|-][warn_id] = Output warning messages + -Z = Output 'never build' DCPs + -$ = Compiler directive + --help = Show this help screen + --version = Show name and version + --codepage: = specify source file encoding + --default-namespace: = set namespace + --depends = output unit dependency information + --doc = output XML documentation + --drc = output resource string .drc file + --no-config = do not load default DCC32.CFG file +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields + B- Full boolean Evaluation + C+ Evaluate assertions at runtime + D+ Debug information + G+ Use imported data references + H+ Use long strings by default + I+ I/O checking + J- Writeable structured consts + L+ Local debug symbols + M- Runtime type info + O- Optimization + P+ Open string params + Q+ Integer overflow checking + R+ Range checking + T- Typed @ operator + U- Pentium(tm)-safe divide + V+ Strict var-strings + W+ Generate stack frames + X+ Extended syntax + Y+ Symbol reference info + Z1 Minimum size of enum types + +Making vcl library debug units for Borland Developer Studio 2006 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias + -B = Build all units + -CC = Console target + -CG = GUI target + -D = Define conditionals + -E = EXE/DLL output directory + -F = Find error + -GD = Detailed map file + -GP = Map file with publics + -GS = Map file with segments + -H = Output hint messages + -I = Include directories + -J = Generate .obj file + -JPHNE = Generate C++ .obj file, .hpp file, in namespace, export all + -K = Set image base addr + -LE = package .bpl output directory + -LN = package .dcp output directory + -LU = Use package + -M = Make modified units + -N0 = unit .dcu output directory + -NH = unit .hpp output directory + -NO = unit .obj output directory + -NB = unit .bpi output directory + -NS = Namespace search path + -O = Object directories + -P = look for 8.3 file names also + -Q = Quiet compile + -R = Resource directories + -U = Unit directories + -V = Debug information in EXE + -VR = Generate remote debug (RSM) + -W[+|-][warn_id] = Output warning messages + -Z = Output 'never build' DCPs + -$ = Compiler directive + --help = Show this help screen + --version = Show name and version + --codepage: = specify source file encoding + --default-namespace: = set namespace + --depends = output unit dependency information + --doc = output XML documentation + --drc = output resource string .drc file + --no-config = do not load default DCC32.CFG file +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields + B- Full boolean Evaluation + C+ Evaluate assertions at runtime + D+ Debug information + G+ Use imported data references + H+ Use long strings by default + I+ I/O checking + J- Writeable structured consts + L+ Local debug symbols + M- Runtime type info + O- Optimization + P+ Open string params + Q+ Integer overflow checking + R+ Range checking + T- Typed @ operator + U- Pentium(tm)-safe divide + V+ Strict var-strings + W+ Generate stack frames + X+ Extended syntax + Y+ Symbol reference info + Z1 Minimum size of enum types + +Compiling package T:\COMPON~1\jcl\packages\d10\Jcl.dpk... +Cleaning package cache for Jcl100.bpl +Compiling package T:\COMPON~1\jcl\packages\d10\Jcl.dpk +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d10\Jcl.dpk +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation +128 lines, 0.61 seconds, 802048 bytes code, 44320 bytes data. +Compilation success +...done. + +Compiling package T:\COMPON~1\jcl\packages\d10\JclVcl.dpk... +Cleaning package cache for JclVcl100.bpl +Cleaning ok +Compiling package T:\COMPON~1\jcl\packages\d10\JclVcl.dpk +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d10\JclVcl.dpk +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation +53 lines, 0.16 seconds, 69712 bytes code, 832 bytes data. +Compilation success +...done. + +Installing package T:\COMPON~1\jcl\packages\d10\JclBaseExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d10\JclBaseExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d10\JclBaseExpert.dpk +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d10\JclBaseExpert.dpk +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation +7986 lines, 0.20 seconds, 21836 bytes code, 296 bytes data. +Compilation success +Cleaning package cache for JclBaseExpert100.bpl +Registering package T:\Bpl_D10\JclBaseExpert100.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d10\JclDebugExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d10\JclDebugExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d10\JclDebugExpert.dpk +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d10\JclDebugExpert.dpk +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation +2557 lines, 0.16 seconds, 12404 bytes code, 128 bytes data. +Compilation success +Cleaning package cache for JclDebugExpert100.bpl +Registering package T:\Bpl_D10\JclDebugExpert100.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d10\JclProjectAnalysisExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d10\JclProjectAnalysisExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d10\JclProjectAnalysisExpert.dpk +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d10\JclProjectAnalysisExpert.dpk +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation +3875 lines, 0.14 seconds, 15352 bytes code, 148 bytes data. +Compilation success +Cleaning package cache for JclProjectAnalysisExpert100.bpl +Registering package T:\Bpl_D10\JclProjectAnalysisExpert100.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d10\JclFavoriteFoldersExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d10\JclFavoriteFoldersExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d10\JclFavoriteFoldersExpert.dpk +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d10\JclFavoriteFoldersExpert.dpk +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation +3662 lines, 0.14 seconds, 8540 bytes code, 128 bytes data. +Compilation success +Cleaning package cache for JclFavoriteFoldersExpert100.bpl +Registering package T:\Bpl_D10\JclFavoriteFoldersExpert100.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d10\JclUsesExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d10\JclUsesExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d10\JclUsesExpert.dpk +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d10\JclUsesExpert.dpk +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation +6764 lines, 0.14 seconds, 24664 bytes code, 244 bytes data. +Compilation success +Cleaning package cache for JclUsesExpert100.bpl +Registering package T:\Bpl_D10\JclUsesExpert100.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d10\JclSIMDViewExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d10\JclSIMDViewExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d10\JclSIMDViewExpert.dpk +"C:\Archivos de programa\Borland\Delphi10\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d10\JclSIMDViewExpert.dpk +Borland Delphi for Win32 compiler version 18.0 +Copyright (c) 1983,2005 Borland Software Corporation +10456 lines, 0.22 seconds, 34696 bytes code, 624 bytes data. +Compilation success +Cleaning package cache for JclSIMDViewExpert100.bpl +Registering package T:\Bpl_D10\JclSIMDViewExpert100.bpl +Registration ok +Installation of package finished +...done. + diff --git a/official/1.96/bin/Delphi 7.log b/official/1.96/bin/Delphi 7.log new file mode 100644 index 0000000..d4469d2 --- /dev/null +++ b/official/1.96/bin/Delphi 7.log @@ -0,0 +1,426 @@ +Delphi 7 Build 7.0.8.1 ===================== + +Added "T:\COMPON~1\jcl\lib\d7;T:\COMPON~1\jcl\source" to library path. + +Added "T:\COMPON~1\jcl\source\common;T:\COMPON~1\jcl\source\windows;T:\COMPON~1\jcl\source\vcl;T:\COMPON~1\jcl\source\visclx;" to library browsing path. + +Added "T:\COMPON~1\jcl\lib\d7\debug" to Debug DCU Path. + +Making common library units for Delphi 7 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias -LU = Use package + -B = Build all units -M = Make modified units + -CC = Console target -N = DCU output directory + -CG = GUI target -O = Object directories + -D = Define conditionals -P = look for 8.3 file names also + -E = EXE output directory -Q = Quiet compile + -F = Find error -R = Resource directories + -GD = Detailed map file -U = Unit directories + -GP = Map file with publics -V = Debug information in EXE + -GS = Map file with segments -VR = Generate remote debug (RSM) + -H = Output hint messages -W = Output warning messages + -I = Include directories -Z = Output 'never build' DCPs + -J = Generate .obj file -$ = Compiler directive + -JP = Generate C++ .obj file --help = Show this help screen + -K = Set image base addr --version = Show name and version +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields P+ Open string params + B- Full boolean Evaluation Q- Integer overflow checking + C- Evaluate assertions at runtime R- Range checking + D- Debug information T- Typed @ operator + G+ Use imported data references U- Pentium(tm)-safe divide + H+ Use long strings by default V+ Strict var-strings + I+ I/O checking W- Generate stack frames + J- Writeable structured consts X+ Extended syntax + L+ Local debug symbols Y+ Symbol reference info + M- Runtime type info Z1 Minimum size of enum types + O+ Optimization + +Making windows library units for Delphi 7 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias -LU = Use package + -B = Build all units -M = Make modified units + -CC = Console target -N = DCU output directory + -CG = GUI target -O = Object directories + -D = Define conditionals -P = look for 8.3 file names also + -E = EXE output directory -Q = Quiet compile + -F = Find error -R = Resource directories + -GD = Detailed map file -U = Unit directories + -GP = Map file with publics -V = Debug information in EXE + -GS = Map file with segments -VR = Generate remote debug (RSM) + -H = Output hint messages -W = Output warning messages + -I = Include directories -Z = Output 'never build' DCPs + -J = Generate .obj file -$ = Compiler directive + -JP = Generate C++ .obj file --help = Show this help screen + -K = Set image base addr --version = Show name and version +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields P+ Open string params + B- Full boolean Evaluation Q- Integer overflow checking + C- Evaluate assertions at runtime R- Range checking + D- Debug information T- Typed @ operator + G+ Use imported data references U- Pentium(tm)-safe divide + H+ Use long strings by default V+ Strict var-strings + I+ I/O checking W- Generate stack frames + J- Writeable structured consts X+ Extended syntax + L+ Local debug symbols Y+ Symbol reference info + M- Runtime type info Z1 Minimum size of enum types + O+ Optimization + +Making vcl library units for Delphi 7 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias -LU = Use package + -B = Build all units -M = Make modified units + -CC = Console target -N = DCU output directory + -CG = GUI target -O = Object directories + -D = Define conditionals -P = look for 8.3 file names also + -E = EXE output directory -Q = Quiet compile + -F = Find error -R = Resource directories + -GD = Detailed map file -U = Unit directories + -GP = Map file with publics -V = Debug information in EXE + -GS = Map file with segments -VR = Generate remote debug (RSM) + -H = Output hint messages -W = Output warning messages + -I = Include directories -Z = Output 'never build' DCPs + -J = Generate .obj file -$ = Compiler directive + -JP = Generate C++ .obj file --help = Show this help screen + -K = Set image base addr --version = Show name and version +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields P+ Open string params + B- Full boolean Evaluation Q- Integer overflow checking + C- Evaluate assertions at runtime R- Range checking + D- Debug information T- Typed @ operator + G+ Use imported data references U- Pentium(tm)-safe divide + H+ Use long strings by default V+ Strict var-strings + I+ I/O checking W- Generate stack frames + J- Writeable structured consts X+ Extended syntax + L+ Local debug symbols Y+ Symbol reference info + M- Runtime type info Z1 Minimum size of enum types + O+ Optimization + +Making visclx library units for Delphi 7 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias -LU = Use package + -B = Build all units -M = Make modified units + -CC = Console target -N = DCU output directory + -CG = GUI target -O = Object directories + -D = Define conditionals -P = look for 8.3 file names also + -E = EXE output directory -Q = Quiet compile + -F = Find error -R = Resource directories + -GD = Detailed map file -U = Unit directories + -GP = Map file with publics -V = Debug information in EXE + -GS = Map file with segments -VR = Generate remote debug (RSM) + -H = Output hint messages -W = Output warning messages + -I = Include directories -Z = Output 'never build' DCPs + -J = Generate .obj file -$ = Compiler directive + -JP = Generate C++ .obj file --help = Show this help screen + -K = Set image base addr --version = Show name and version +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields P+ Open string params + B- Full boolean Evaluation Q- Integer overflow checking + C- Evaluate assertions at runtime R- Range checking + D- Debug information T- Typed @ operator + G+ Use imported data references U- Pentium(tm)-safe divide + H+ Use long strings by default V+ Strict var-strings + I+ I/O checking W- Generate stack frames + J- Writeable structured consts X+ Extended syntax + L+ Local debug symbols Y+ Symbol reference info + M- Runtime type info Z1 Minimum size of enum types + O+ Optimization + +Making common library debug units for Delphi 7 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias -LU = Use package + -B = Build all units -M = Make modified units + -CC = Console target -N = DCU output directory + -CG = GUI target -O = Object directories + -D = Define conditionals -P = look for 8.3 file names also + -E = EXE output directory -Q = Quiet compile + -F = Find error -R = Resource directories + -GD = Detailed map file -U = Unit directories + -GP = Map file with publics -V = Debug information in EXE + -GS = Map file with segments -VR = Generate remote debug (RSM) + -H = Output hint messages -W = Output warning messages + -I = Include directories -Z = Output 'never build' DCPs + -J = Generate .obj file -$ = Compiler directive + -JP = Generate C++ .obj file --help = Show this help screen + -K = Set image base addr --version = Show name and version +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields P+ Open string params + B- Full boolean Evaluation Q+ Integer overflow checking + C+ Evaluate assertions at runtime R+ Range checking + D+ Debug information T- Typed @ operator + G+ Use imported data references U- Pentium(tm)-safe divide + H+ Use long strings by default V+ Strict var-strings + I+ I/O checking W+ Generate stack frames + J- Writeable structured consts X+ Extended syntax + L+ Local debug symbols Y+ Symbol reference info + M- Runtime type info Z1 Minimum size of enum types + O- Optimization + +Making windows library debug units for Delphi 7 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias -LU = Use package + -B = Build all units -M = Make modified units + -CC = Console target -N = DCU output directory + -CG = GUI target -O = Object directories + -D = Define conditionals -P = look for 8.3 file names also + -E = EXE output directory -Q = Quiet compile + -F = Find error -R = Resource directories + -GD = Detailed map file -U = Unit directories + -GP = Map file with publics -V = Debug information in EXE + -GS = Map file with segments -VR = Generate remote debug (RSM) + -H = Output hint messages -W = Output warning messages + -I = Include directories -Z = Output 'never build' DCPs + -J = Generate .obj file -$ = Compiler directive + -JP = Generate C++ .obj file --help = Show this help screen + -K = Set image base addr --version = Show name and version +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields P+ Open string params + B- Full boolean Evaluation Q+ Integer overflow checking + C+ Evaluate assertions at runtime R+ Range checking + D+ Debug information T- Typed @ operator + G+ Use imported data references U- Pentium(tm)-safe divide + H+ Use long strings by default V+ Strict var-strings + I+ I/O checking W+ Generate stack frames + J- Writeable structured consts X+ Extended syntax + L+ Local debug symbols Y+ Symbol reference info + M- Runtime type info Z1 Minimum size of enum types + O- Optimization + +Making vcl library debug units for Delphi 7 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias -LU = Use package + -B = Build all units -M = Make modified units + -CC = Console target -N = DCU output directory + -CG = GUI target -O = Object directories + -D = Define conditionals -P = look for 8.3 file names also + -E = EXE output directory -Q = Quiet compile + -F = Find error -R = Resource directories + -GD = Detailed map file -U = Unit directories + -GP = Map file with publics -V = Debug information in EXE + -GS = Map file with segments -VR = Generate remote debug (RSM) + -H = Output hint messages -W = Output warning messages + -I = Include directories -Z = Output 'never build' DCPs + -J = Generate .obj file -$ = Compiler directive + -JP = Generate C++ .obj file --help = Show this help screen + -K = Set image base addr --version = Show name and version +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields P+ Open string params + B- Full boolean Evaluation Q+ Integer overflow checking + C+ Evaluate assertions at runtime R+ Range checking + D+ Debug information T- Typed @ operator + G+ Use imported data references U- Pentium(tm)-safe divide + H+ Use long strings by default V+ Strict var-strings + I+ I/O checking W+ Generate stack frames + J- Writeable structured consts X+ Extended syntax + L+ Local debug symbols Y+ Symbol reference info + M- Runtime type info Z1 Minimum size of enum types + O- Optimization + +Making visclx library debug units for Delphi 7 + +Compiling .dcu files... +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation + +Syntax: dcc32 [options] filename [options] + + -A= = Set unit alias -LU = Use package + -B = Build all units -M = Make modified units + -CC = Console target -N = DCU output directory + -CG = GUI target -O = Object directories + -D = Define conditionals -P = look for 8.3 file names also + -E = EXE output directory -Q = Quiet compile + -F = Find error -R = Resource directories + -GD = Detailed map file -U = Unit directories + -GP = Map file with publics -V = Debug information in EXE + -GS = Map file with segments -VR = Generate remote debug (RSM) + -H = Output hint messages -W = Output warning messages + -I = Include directories -Z = Output 'never build' DCPs + -J = Generate .obj file -$ = Compiler directive + -JP = Generate C++ .obj file --help = Show this help screen + -K = Set image base addr --version = Show name and version +Compiler switches: -$ (defaults are shown below) + A8 Aligned record fields P+ Open string params + B- Full boolean Evaluation Q+ Integer overflow checking + C+ Evaluate assertions at runtime R+ Range checking + D+ Debug information T- Typed @ operator + G+ Use imported data references U- Pentium(tm)-safe divide + H+ Use long strings by default V+ Strict var-strings + I+ I/O checking W+ Generate stack frames + J- Writeable structured consts X+ Extended syntax + L+ Local debug symbols Y+ Symbol reference info + M- Runtime type info Z1 Minimum size of enum types + O- Optimization + +Compiling package T:\COMPON~1\jcl\packages\d7\Jcl.dpk... +Compiling package T:\COMPON~1\jcl\packages\d7\Jcl.dpk +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d7\Jcl.dpk +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation +128 lines, 0.81 seconds, 803604 bytes code, 44413 bytes data. +Compilation success +...done. + +Compiling package T:\COMPON~1\jcl\packages\d7\JclVClx.dpk... +Compiling package T:\COMPON~1\jcl\packages\d7\JclVClx.dpk +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d7\JclVClx.dpk +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation +51 lines, 0.27 seconds, 25320 bytes code, 585 bytes data. +Compilation success +...done. + +Compiling package T:\COMPON~1\jcl\packages\d7\JclVcl.dpk... +Compiling package T:\COMPON~1\jcl\packages\d7\JclVcl.dpk +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d7\JclVcl.dpk +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation +53 lines, 0.38 seconds, 70944 bytes code, 897 bytes data. +Compilation success +...done. + +Installing package T:\COMPON~1\jcl\packages\d7\JclBaseExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d7\JclBaseExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d7\JclBaseExpert.dpk +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d7\JclBaseExpert.dpk +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation +7986 lines, 0.28 seconds, 21916 bytes code, 317 bytes data. +Compilation success +Registering package T:\Bpl_D7\JclBaseExpert70.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d7\JclDebugExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d7\JclDebugExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d7\JclDebugExpert.dpk +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d7\JclDebugExpert.dpk +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation +2557 lines, 0.14 seconds, 13292 bytes code, 193 bytes data. +Compilation success +Registering package T:\Bpl_D7\JclDebugExpert70.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d7\JclProjectAnalysisExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d7\JclProjectAnalysisExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d7\JclProjectAnalysisExpert.dpk +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d7\JclProjectAnalysisExpert.dpk +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation +3875 lines, 0.12 seconds, 16244 bytes code, 213 bytes data. +Compilation success +Registering package T:\Bpl_D7\JclProjectAnalysisExpert70.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d7\JclFavoriteFoldersExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d7\JclFavoriteFoldersExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d7\JclFavoriteFoldersExpert.dpk +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d7\JclFavoriteFoldersExpert.dpk +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation +3662 lines, 0.12 seconds, 9528 bytes code, 193 bytes data. +Compilation success +Registering package T:\Bpl_D7\JclFavoriteFoldersExpert70.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d7\JclUsesExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d7\JclUsesExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d7\JclUsesExpert.dpk +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d7\JclUsesExpert.dpk +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation +6764 lines, 0.16 seconds, 25704 bytes code, 309 bytes data. +Compilation success +Registering package T:\Bpl_D7\JclUsesExpert70.bpl +Registration ok +Installation of package finished +...done. + +Installing package T:\COMPON~1\jcl\packages\d7\JclSIMDViewExpert.dpk... +Installing package T:\COMPON~1\jcl\packages\d7\JclSIMDViewExpert.dpk +Compiling package T:\COMPON~1\jcl\packages\d7\JclSIMDViewExpert.dpk +"C:\Archivos de programa\Borland\Delphi7\bin\dcc32.exe" T:\COMPON~1\jcl\packages\d7\JclSIMDViewExpert.dpk +Borland Delphi Version 15.0 +Copyright (c) 1983,2002 Borland Software Corporation +10456 lines, 0.16 seconds, 35980 bytes code, 689 bytes data. +Compilation success +Registering package T:\Bpl_D7\JclSIMDViewExpert70.bpl +Registration ok +Installation of package finished +...done. + +Installing Exception Dialog... +-> T:\COMPON~1\JCL\EXPERTS\DEBUG\DIALOG\EXCEPTDLG.PAS +-> T:\COMPON~1\JCL\EXPERTS\DEBUG\DIALOG\EXCEPTDLG.ico +...done. + +Installing Exception Dialog with Send... +-> T:\COMPON~1\JCL\EXPERTS\DEBUG\DIALOG\EXCEPTDLGMAIL.PAS +-> T:\COMPON~1\JCL\EXPERTS\DEBUG\DIALOG\EXCEPTDLGMAIL.ico +...done. + +Installing CLX Exception Dialog... +-> T:\COMPON~1\JCL\EXPERTS\DEBUG\DIALOG\CLXEXCEPTDLG.PAS +-> T:\COMPON~1\JCL\EXPERTS\DEBUG\DIALOG\CLXEXCEPTDLG.ico +...done. + +Added T:\COMPON~1\jcl\help\JCLHelp.hlp to Delphi Online Help + diff --git a/official/1.96/bin/JCL-install.ini b/official/1.96/bin/JCL-install.ini new file mode 100644 index 0000000..29be295 --- /dev/null +++ b/official/1.96/bin/JCL-install.ini @@ -0,0 +1,377 @@ +[Delphi 7] +ioTarget=2070 +ioJCL=2070 +ioJclDefThreadSafe=2070 +ioJclDefDropObsoleteCode=2070 +ioJclDefMathPrecSingle=-1 +ioJclDefMathPrecDouble=-1 +ioJclDefMathPrecExtended=2070 +ioJclMapCreate=-1 +ioJclMapLink=-1 +ioJclMapDelete=-1 +ioJclEnv=2070 +ioJclEnvLibPath=2070 +ioJclEnvBrowsingPath=2070 +ioJclEnvDebugDCUPath=2070 +ioJclMake=2070 +ioJclMakeRelease=2070 +ioJclMakeReleaseVClx=2070 +ioJclMakeDebug=2070 +ioJclMakeDebugVClx=2070 +ioJclCopyHppFiles=-1 +ioJclDualPackages=-1 +ioJclPackages=2070 +ioJclExpertsDesignPackages=2070 +ioJclExpertsDLL=-1 +ioJclExperts=2070 +ioJclExpertDebug=2070 +ioJclExpertAnalyzer=2070 +ioJclExpertFavorite=2070 +ioJclExpertThreadNames=-1 +ioJclExpertUses=2070 +ioJclExpertSimdView=2070 +ioJclExpertVersionControl=-1 +ioJclCopyPackagesHppFiles=-1 +ioJclExcDialog=2070 +ioJclExcDialogVCL=2070 +ioJclExcDialogVCLSnd=2070 +ioJclExcDialogCLX=2070 +ioJclHelp=2070 +ioJclHelpHlp=2070 +ioJclHelpChm=-1 +ioJclMakeDemos=-1 +BPL-Path=T:\Bpl_D7 +DCP-Path=D:\Proyectos\Componentes\jcl\lib\d7 + +[Delphi 7 demos] +common\containers\algorithms\AlgorithmsExample.dpr=-1 +windows\peimage\ApiHookExample.dpr=-1 +windows\appinst\AppInstExample.dpr=-1 +windows\ConsoleExamples.dpr=-1 +windows\asuser\CreateProcAsUserExample.dpr=-1 +windows\delphitools\dependencyviewer\DependView.dpr=-1 +windows\edisdk\EDICOMExample.dpr=-1 +windows\edisdk\comserver\EDISDK.dpr=-1 +common\expreval\ExprEvalExample.dpr=-1 +windows\debug\framestrack\FramesTrackExample.dpr=-1 +common\containers\hashing\HashingExample.dpr=-1 +windows\ntfs\JEDISoftLinks.dpr=-1 +windows\lanman\LanManExample.dpr=-1 +common\containers\lists\ListExample.dpr=-1 +windows\locales\LocalesExample.dpr=-1 +windows\mapi\MapiExample.dpr=-1 +common\multimedia\MidiOutExample.dpr=-1 +windows\multimedia\MultiMediaExample.dpr=-1 +windows\ntservice\NtSvcExample.dpr=-1 +common\pcre\PCREDemo.dpr=-1 +windows\peimage\PeFuncExample.dpr=-1 +windows\delphitools\peviewer\PeViewer.dpr=-1 +common\graphics\QClipLineDemo.dpr=-1 +common\sysinfo\QEnvironmentExample.dpr=-1 +common\expreval\QExprEvalExample.dpr=-1 +common\numformat\QNumFormatExample.dpr=-1 +common\pcre\QPCREDemo.dpr=-1 +common\rtti\QRTTIDemo.dpr=-1 +windows\mapi\ReadMailExample.dpr=-1 +windows\registry\RegistryExample.dpr=-1 +windows\delphitools\resfix\ResFix.dpr=-1 +common\rtti\RTTIExample.dpr=-1 +windows\delphitools\screenjpg\ScreenJPG.dpr=-1 +windows\appinst\SingleInstExample.dpr=-1 +windows\debug\sourceloc\SourceLocExample.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsComLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsDynamicLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsExample.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsStaticLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackExample.dpr=-1 +common\graphics\StretchGraphicExample.dpr=-1 +windows\structstorage\StructStorageExample.dpr=-1 +windows\sysinfo\SysInfoExample.dpr=-1 +windows\tasks\TaskDemo.dpr=-1 +common\textreader\TextReaderExample.dpr=-1 +windows\debug\threadexcept\ThreadExceptExample.dpr=-1 +windows\delphitools\toolhelpview\ToolHelpViewer.dpr=-1 +common\containers\trees\TreeExample.dpr=-1 +common\unitversioning\UnitVersioningTest.dpr=-1 +common\unitversioning\UnitVersioningTestDLL.dpr=-1 +windows\peimage\UnmangleNameExample.dpr=-1 +windows\fileversion\VerInfoExample.dpr=-1 + +[Delphi 5] +ioTarget=-1 +ioJCL=-1 +ioJclDefThreadSafe=-1 +ioJclDefDropObsoleteCode=-1 +ioJclDefMathPrecSingle=-1 +ioJclDefMathPrecDouble=-1 +ioJclDefMathPrecExtended=-1 +ioJclMapCreate=-1 +ioJclMapLink=-1 +ioJclMapDelete=-1 +ioJclEnv=-1 +ioJclEnvLibPath=-1 +ioJclEnvBrowsingPath=-1 +ioJclEnvDebugDCUPath=-1 +ioJclMake=-1 +ioJclMakeRelease=-1 +ioJclMakeReleaseVClx=-1 +ioJclMakeDebug=-1 +ioJclMakeDebugVClx=-1 +ioJclCopyHppFiles=-1 +ioJclDualPackages=-1 +ioJclPackages=-1 +ioJclExpertsDesignPackages=-1 +ioJclExpertsDLL=-1 +ioJclExperts=-1 +ioJclExpertDebug=-1 +ioJclExpertAnalyzer=-1 +ioJclExpertFavorite=-1 +ioJclExpertThreadNames=-1 +ioJclExpertUses=-1 +ioJclExpertSimdView=-1 +ioJclExpertVersionControl=-1 +ioJclCopyPackagesHppFiles=-1 +ioJclExcDialog=-1 +ioJclExcDialogVCL=-1 +ioJclExcDialogVCLSnd=-1 +ioJclExcDialogCLX=-1 +ioJclHelp=-1 +ioJclHelpHlp=-1 +ioJclHelpChm=-1 +ioJclMakeDemos=-1 +BPL-Path=(Enter valid path) +DCP-Path=(Enter valid path) + +[Delphi 5 demos] +common\containers\algorithms\AlgorithmsExample.dpr=-1 +windows\peimage\ApiHookExample.dpr=-1 +windows\appinst\AppInstExample.dpr=-1 +windows\ConsoleExamples.dpr=-1 +windows\asuser\CreateProcAsUserExample.dpr=-1 +windows\delphitools\dependencyviewer\DependView.dpr=-1 +windows\edisdk\EDICOMExample.dpr=-1 +windows\edisdk\comserver\EDISDK.dpr=-1 +common\expreval\ExprEvalExample.dpr=-1 +windows\debug\framestrack\FramesTrackExample.dpr=-1 +common\containers\hashing\HashingExample.dpr=-1 +windows\ntfs\JEDISoftLinks.dpr=-1 +windows\lanman\LanManExample.dpr=-1 +common\containers\lists\ListExample.dpr=-1 +windows\locales\LocalesExample.dpr=-1 +windows\mapi\MapiExample.dpr=-1 +common\multimedia\MidiOutExample.dpr=-1 +windows\multimedia\MultiMediaExample.dpr=-1 +windows\ntservice\NtSvcExample.dpr=-1 +common\pcre\PCREDemo.dpr=-1 +windows\peimage\PeFuncExample.dpr=-1 +windows\delphitools\peviewer\PeViewer.dpr=-1 +windows\mapi\ReadMailExample.dpr=-1 +windows\registry\RegistryExample.dpr=-1 +windows\delphitools\resfix\ResFix.dpr=-1 +common\rtti\RTTIExample.dpr=-1 +windows\delphitools\screenjpg\ScreenJPG.dpr=-1 +windows\appinst\SingleInstExample.dpr=-1 +windows\debug\sourceloc\SourceLocExample.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsComLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsDynamicLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsExample.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsStaticLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackExample.dpr=-1 +common\graphics\StretchGraphicExample.dpr=-1 +windows\structstorage\StructStorageExample.dpr=-1 +windows\sysinfo\SysInfoExample.dpr=-1 +windows\tasks\TaskDemo.dpr=-1 +common\textreader\TextReaderExample.dpr=-1 +windows\debug\threadexcept\ThreadExceptExample.dpr=-1 +windows\delphitools\toolhelpview\ToolHelpViewer.dpr=-1 +common\containers\trees\TreeExample.dpr=-1 +common\unitversioning\UnitVersioningTest.dpr=-1 +common\unitversioning\UnitVersioningTestDLL.dpr=-1 +windows\peimage\UnmangleNameExample.dpr=-1 +windows\fileversion\VerInfoExample.dpr=-1 + +[Delphi 6] +ioTarget=-1 +ioJCL=-1 +ioJclDefThreadSafe=-1 +ioJclDefDropObsoleteCode=-1 +ioJclDefMathPrecSingle=-1 +ioJclDefMathPrecDouble=-1 +ioJclDefMathPrecExtended=-1 +ioJclMapCreate=-1 +ioJclMapLink=-1 +ioJclMapDelete=-1 +ioJclEnv=-1 +ioJclEnvLibPath=-1 +ioJclEnvBrowsingPath=-1 +ioJclEnvDebugDCUPath=-1 +ioJclMake=-1 +ioJclMakeRelease=-1 +ioJclMakeReleaseVClx=-1 +ioJclMakeDebug=-1 +ioJclMakeDebugVClx=-1 +ioJclCopyHppFiles=-1 +ioJclDualPackages=-1 +ioJclPackages=-1 +ioJclExpertsDesignPackages=-1 +ioJclExpertsDLL=-1 +ioJclExperts=-1 +ioJclExpertDebug=-1 +ioJclExpertAnalyzer=-1 +ioJclExpertFavorite=-1 +ioJclExpertThreadNames=-1 +ioJclExpertUses=-1 +ioJclExpertSimdView=-1 +ioJclExpertVersionControl=-1 +ioJclCopyPackagesHppFiles=-1 +ioJclExcDialog=-1 +ioJclExcDialogVCL=-1 +ioJclExcDialogVCLSnd=-1 +ioJclExcDialogCLX=-1 +ioJclHelp=-1 +ioJclHelpHlp=-1 +ioJclHelpChm=-1 +ioJclMakeDemos=-1 +BPL-Path= +DCP-Path= + +[Delphi 6 demos] +common\containers\algorithms\AlgorithmsExample.dpr=-1 +windows\peimage\ApiHookExample.dpr=-1 +windows\appinst\AppInstExample.dpr=-1 +windows\ConsoleExamples.dpr=-1 +windows\asuser\CreateProcAsUserExample.dpr=-1 +windows\delphitools\dependencyviewer\DependView.dpr=-1 +windows\edisdk\EDICOMExample.dpr=-1 +windows\edisdk\comserver\EDISDK.dpr=-1 +common\expreval\ExprEvalExample.dpr=-1 +windows\debug\framestrack\FramesTrackExample.dpr=-1 +common\containers\hashing\HashingExample.dpr=-1 +windows\ntfs\JEDISoftLinks.dpr=-1 +windows\lanman\LanManExample.dpr=-1 +common\containers\lists\ListExample.dpr=-1 +windows\locales\LocalesExample.dpr=-1 +windows\mapi\MapiExample.dpr=-1 +common\multimedia\MidiOutExample.dpr=-1 +windows\multimedia\MultiMediaExample.dpr=-1 +windows\ntservice\NtSvcExample.dpr=-1 +common\pcre\PCREDemo.dpr=-1 +windows\peimage\PeFuncExample.dpr=-1 +windows\delphitools\peviewer\PeViewer.dpr=-1 +windows\mapi\ReadMailExample.dpr=-1 +windows\registry\RegistryExample.dpr=-1 +windows\delphitools\resfix\ResFix.dpr=-1 +common\rtti\RTTIExample.dpr=-1 +windows\delphitools\screenjpg\ScreenJPG.dpr=-1 +windows\appinst\SingleInstExample.dpr=-1 +windows\debug\sourceloc\SourceLocExample.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsComLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsDynamicLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsExample.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsStaticLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackExample.dpr=-1 +common\graphics\StretchGraphicExample.dpr=-1 +windows\structstorage\StructStorageExample.dpr=-1 +windows\sysinfo\SysInfoExample.dpr=-1 +windows\tasks\TaskDemo.dpr=-1 +common\textreader\TextReaderExample.dpr=-1 +windows\debug\threadexcept\ThreadExceptExample.dpr=-1 +windows\delphitools\toolhelpview\ToolHelpViewer.dpr=-1 +common\containers\trees\TreeExample.dpr=-1 +common\unitversioning\UnitVersioningTest.dpr=-1 +common\unitversioning\UnitVersioningTestDLL.dpr=-1 +windows\peimage\UnmangleNameExample.dpr=-1 +windows\fileversion\VerInfoExample.dpr=-1 + +[Borland Developer Studio 2006] +ioTarget=2070 +ioJCL=2070 +ioJclDefThreadSafe=2070 +ioJclDefDropObsoleteCode=2070 +ioJclDefMathPrecSingle=-1 +ioJclDefMathPrecDouble=-1 +ioJclDefMathPrecExtended=2070 +ioJclMapCreate=-1 +ioJclMapLink=-1 +ioJclMapDelete=-1 +ioJclEnv=2070 +ioJclEnvLibPath=2070 +ioJclEnvBrowsingPath=2070 +ioJclEnvDebugDCUPath=2070 +ioJclMake=2070 +ioJclMakeRelease=2070 +ioJclMakeReleaseVClx=-1 +ioJclMakeDebug=2070 +ioJclMakeDebugVClx=-1 +ioJclCopyHppFiles=-1 +ioJclDualPackages=-1 +ioJclPackages=2070 +ioJclExpertsDesignPackages=2070 +ioJclExpertsDLL=-1 +ioJclExperts=2070 +ioJclExpertDebug=2070 +ioJclExpertAnalyzer=2070 +ioJclExpertFavorite=2070 +ioJclExpertThreadNames=-1 +ioJclExpertUses=2070 +ioJclExpertSimdView=2070 +ioJclExpertVersionControl=-1 +ioJclCopyPackagesHppFiles=-1 +ioJclExcDialog=-1 +ioJclExcDialogVCL=-1 +ioJclExcDialogVCLSnd=-1 +ioJclExcDialogCLX=-1 +ioJclHelp=-1 +ioJclHelpHlp=-1 +ioJclHelpChm=-1 +ioJclMakeDemos=-1 +BPL-Path=T:\Bpl_D10 +DCP-Path=D:\PROYEC~1\COMPON~1\jcl\lib\d10 + +[Borland Developer Studio 2006 demos] +common\containers\algorithms\AlgorithmsExample.dpr=-1 +windows\peimage\ApiHookExample.dpr=-1 +windows\appinst\AppInstExample.dpr=-1 +windows\ConsoleExamples.dpr=-1 +windows\asuser\CreateProcAsUserExample.dpr=-1 +windows\delphitools\dependencyviewer\DependView.dpr=-1 +windows\edisdk\EDICOMExample.dpr=-1 +windows\edisdk\comserver\EDISDK.dpr=-1 +common\expreval\ExprEvalExample.dpr=-1 +windows\debug\framestrack\FramesTrackExample.dpr=-1 +common\containers\hashing\HashingExample.dpr=-1 +windows\ntfs\JEDISoftLinks.dpr=-1 +windows\lanman\LanManExample.dpr=-1 +common\containers\lists\ListExample.dpr=-1 +windows\locales\LocalesExample.dpr=-1 +windows\mapi\MapiExample.dpr=-1 +common\multimedia\MidiOutExample.dpr=-1 +windows\multimedia\MultiMediaExample.dpr=-1 +windows\ntservice\NtSvcExample.dpr=-1 +common\pcre\PCREDemo.dpr=-1 +windows\peimage\PeFuncExample.dpr=-1 +windows\delphitools\peviewer\PeViewer.dpr=-1 +windows\mapi\ReadMailExample.dpr=-1 +windows\registry\RegistryExample.dpr=-1 +windows\delphitools\resfix\ResFix.dpr=-1 +common\rtti\RTTIExample.dpr=-1 +windows\delphitools\screenjpg\ScreenJPG.dpr=-1 +windows\appinst\SingleInstExample.dpr=-1 +windows\debug\sourceloc\SourceLocExample.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsComLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsDynamicLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsExample.dpr=-1 +windows\debug\stacktrack\StackTrackDLLsStaticLibrary.dpr=-1 +windows\debug\stacktrack\StackTrackExample.dpr=-1 +common\graphics\StretchGraphicExample.dpr=-1 +windows\structstorage\StructStorageExample.dpr=-1 +windows\sysinfo\SysInfoExample.dpr=-1 +common\textreader\TextReaderExample.dpr=-1 +windows\debug\threadexcept\ThreadExceptExample.dpr=-1 +windows\delphitools\toolhelpview\ToolHelpViewer.dpr=-1 +common\containers\trees\TreeExample.dpr=-1 +common\unitversioning\UnitVersioningTest.dpr=-1 +common\unitversioning\UnitVersioningTestDLL.dpr=-1 +windows\peimage\UnmangleNameExample.dpr=-1 +windows\fileversion\VerInfoExample.dpr=-1 + diff --git a/official/1.96/bin/JediInstaller.exe b/official/1.96/bin/JediInstaller.exe new file mode 100644 index 0000000..4767cac Binary files /dev/null and b/official/1.96/bin/JediInstaller.exe differ diff --git a/official/1.96/bin/dirinfo.txt b/official/1.96/bin/dirinfo.txt new file mode 100644 index 0000000..38bc9b2 --- /dev/null +++ b/official/1.96/bin/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for sample application's EXE files \ No newline at end of file diff --git a/official/1.96/clean.bat b/official/1.96/clean.bat new file mode 100644 index 0000000..ac41a68 --- /dev/null +++ b/official/1.96/clean.bat @@ -0,0 +1,16 @@ +@echo cleaning... +@REM do not delete precompiled installer +@for %%f in (bin\*.exe) do @if not %%f==bin\JediInstaller.exe if not %%f==bin\QJediInstaller.exe (del %%f) +@del /f /s *.~* *.bk bin\*.dll *.a *.bpi *.dcp *.dcu *.dpu *.hpp *.jdbg *.map *.o +@cd lib +@del /f /s *.obj *.res *.lib *.bpi +@cd .. +@cd examples +@del /f /s *.cfg +@cd .. +@cd experts +@del /f /s *.cfg +@cd .. +@cd packages +@del /f /s *.cfg +@cd.. \ No newline at end of file diff --git a/official/1.96/clean.sh b/official/1.96/clean.sh new file mode 100644 index 0000000..a74b87f --- /dev/null +++ b/official/1.96/clean.sh @@ -0,0 +1,12 @@ +#!/bin/bash + +rm -f `find -name \*~` +rm -f `find -name *.~*` +rm -f `find -name *.a` +rm -f `find -name *.bpi` +rm -f `find -name *.dcp` +rm -f `find -name *.dcu` +rm -f `find -name *.dpu` +rm -f `find -name *.hpp` +rm -f `find -name *.o` +rm -f packages/k?/*.mak \ No newline at end of file diff --git a/official/1.96/devtools/jpp b/official/1.96/devtools/jpp new file mode 100644 index 0000000..a799c82 Binary files /dev/null and b/official/1.96/devtools/jpp differ diff --git a/official/1.96/devtools/jpp.exe b/official/1.96/devtools/jpp.exe new file mode 100644 index 0000000..95677ef Binary files /dev/null and b/official/1.96/devtools/jpp.exe differ diff --git a/official/1.96/devtools/pgEdit.exe b/official/1.96/devtools/pgEdit.exe new file mode 100644 index 0000000..8d08bb2 Binary files /dev/null and b/official/1.96/devtools/pgEdit.exe differ diff --git a/official/1.96/devtools/pgEdit.xml b/official/1.96/devtools/pgEdit.xml new file mode 100644 index 0000000..fccf5fa --- /dev/null +++ b/official/1.96/devtools/pgEdit.xml @@ -0,0 +1,127 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/dist-excludes b/official/1.96/dist-excludes new file mode 100644 index 0000000..c53dc1d --- /dev/null +++ b/official/1.96/dist-excludes @@ -0,0 +1,42 @@ +.* +*.~* +*~ +*.bpi +*.dcp +*.dcu +*.dpu +*.ddp +*.conf +*.desk +*.hpp +template.* +*.log +CVS +jcl/build.sh +jcl/convert.sh +jcl/listtxtfiles.sh +jcl/makedist.sh +jcl/want.exe +jcl/want.xml +jcl/bin/JCL-install.ini +jcl/bin/QJediInstaller* +jcl/devtools +jcl/dist +jcl/dist-excludes +jcl/docs/Contributors.txt +jcl/docs/*.info +jcl/help +jcl/install/Makefile +jcl/install/prototypes.mak +jcl/install/BCB5-dcc32.cfg.mak +jcl/install/prototypes +jcl/lib/*.o +jcl/packages/*.dev +jcl/packages/*.mak +jcl/packages/k1 +jcl/packages/k2 +jcl/packages/JclDev*.bpg +jcl/source/*.bat +jcl/source/Makefile.fpc +jcl/source/common/*.int +jcl/source/prototypes diff --git a/official/1.96/docs/Contacting authors.htm b/official/1.96/docs/Contacting authors.htm new file mode 100644 index 0000000..858354e --- /dev/null +++ b/official/1.96/docs/Contacting authors.htm @@ -0,0 +1,35 @@ + + + +Contacting authors + + +

Contacting authors

+

+The JEDI Code Library is built upon donations by various individuals. In the +documentation for each subroutine or class you will find who the author of that +particular code is by looking in the "Quick Info" section. The author's e-mail +is not listed there. It is listed in the contributors page elsewhere in this +document. Therefore if you really need to contact an author it is possible. However, +generically speaking, you should never contact an author regarding code included +in this library. There are various reasons for this with the two most prominent +being that some authors explicitly requested this and because "author" means +different things in different context. Usually "author" means that the described +code was donated to the JCL by that individual and included after reformatting and +only minor modifications. However, sometimes code was significantly altered, +rewritten several times or 'merely' based upon or inspired by code from that +individual. Consequently there exist several routines which in no way resemble +the original code as it was donated by the "author". Nevertheless, the individual +that orginally donated the code is still documented as the author. +

+In general, if you like some routine very much and it has proven to work correctly: +be grateful to the author (in thought, not by sending him or her an e-mail). On +the other hand, if some routine turns out to be buggy, incorrect or for whatever +reason is not to your liking: complain to me. It was most likely we who screwed +it up and introduced those bugs into code that was working perfectly until we got +our hands on it! To report bugs, use Project JEDI's +Issue Tracker. + +

Built on Friday, May 14, 2004
+ + \ No newline at end of file diff --git a/official/1.96/docs/Contributors.htm b/official/1.96/docs/Contributors.htm new file mode 100644 index 0000000..473dc92 --- /dev/null +++ b/official/1.96/docs/Contributors.htm @@ -0,0 +1,199 @@ + + + + JCL Contributors (code donators) + + +

Contributors

+

+ Following is a list of all people that donated, or gave permission to use their, + code in the JEDI Code Library. Be sure that you read the Contacting Authors page + in the JCL helpfile before contacting these people. Note that JCL is continously + in development and by far not all donations have been processed yet. We're not + even half way! Therefore it is very well possible that you donated code but it's + not in the JCL yet. However, if you're name is not in the list below then it's + likely that something has gone wrong. In that event, please + contact us. +

+

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
aaAlan LloydAlex DenissovAlex Konshin
Alexander RadchenkoAlexei KoudinovAllan LyonsAnders Melander
André SnepvangersAndreas HausladenAndreas JakobscheAngus Johnson
Anthony SteeleAzret BotashBarry KellyBender Heri
Bernhard BergerBryan CoutchCarl ClarkCenon Del Rosario
Charlie CalvertChris MorrisClayton CollieCorrie Engelbrecht
Cybertron_549672Daniel MøllerDavid ButlerDavid Hervieux
Deian IvanovDewald HessDick Maley (Advanced Delphi Systems)Dylan Thomas
Earl F. GlynnEric S. FisherErnesto BenestanteESB Consultancy
Felipe de Toledo FariasFlier LuFlorent OuchetHallvard Vassbotn
Heinz ZastrauHelen BorrieHeri BenderHuanlin Tsai
Ivo BauerJack BombeeckJack N.A. BakkerJames Azarja
Jean DebordJean-Fabien ConnaultJean-Philippe BEMPELJeroen Speldekamp
Johannes BergJohn C MolyneuxJud McCranieJulien Ferraro
Kevin S. GallagherLasse Vågsæther KarlsenLeonard WennekersLiran Shahar
Lloyd KinsellaLucjan LukasikM.H. AvegaartMalcolm Edgar
Manlio LaschenaMarc ConventsMarcel BestebroerMarcel van Brakel
Marcin WieczorekMarco KlemmMario R. CarroMarius le Roux
Mark VaughanMartin KimmingsMartin KubeckaMassimo Maria Ghisalberti
Matt HamiltonMatthias ThomaMichael RynnMichael Schnell
Michael TsaiMichael WinterMike LischkeNick Hodges
Nils HaeckOliver SchneiderOlivier SannierPatrick van Laake
Pavel CisarPelle LiljendalPeter FriesePeter McMahon
Peter PaninoPeter ThörnquistPetr VonesPython
Ralf JunkerRaymond AlexanderRik BarkerRobert Lee
Robert MarquardtRobert R. MarshRobert RossmairRudy Velthuis
Scott PriceSouthEasterStefan KirschnerStephane Fillon
Sterling ButtsTheo BebekisTim YatesTom Hahn
Uwe SchusterWim De CleenYaniv GolanYour name here?
+

+

+

Built on 2005-03-14
+

+ + diff --git a/official/1.96/docs/Contributors.txt b/official/1.96/docs/Contributors.txt new file mode 100644 index 0000000..51d4a95 --- /dev/null +++ b/official/1.96/docs/Contributors.txt @@ -0,0 +1,115 @@ +aa=aa@bitsmart.com +Alan Lloyd=alanglloyd@aol.com +Alex Denissov= +Alex Konshin=alexk@mtgroup.ru +Alexander Radchenko=ravnvt@chat.ru +Alexei Koudinov= +Allan Lyons= +Anders Melander= +André Snepvangers=asnepvangers@users.sourceforge.net +Andreas Hausladen=ahuser@users.sourceforge.net +Andreas Jakobsche=Jakobsche@addcom.de +Angus Johnson=ajohnson@rpi.net.au +Anthony Steele=asteele@iafrica.com +Azret Botash=azret@attglobal.net +Barry Kelly= +Bender Heri=HBender@Ergonomics.ch +Bernhard Berger=bernhardberger@yahoo.de +Bryan Coutch=oracle@bmts.com +Carl Clark=carl@caztec.co.za +Cenon Del Rosario=cenon@mail.com +Charlie Calvert=ccalvert@inprise.com +Chris Morris= +Clayton Collie= +Corrie Engelbrecht=sahfs@iafrica.com +Cybertron_549672=Cybertron_549672@yahoo.com +Daniel Møller=dj@sguft.com +David Butler=david@e.co.za +David Hervieux=dhervieux@Pirel.com +Deian Ivanov=deian@datecs.bg +Dewald Hess=dewaldh@emsoft.co.za +Dick Maley (Advanced Delphi Systems)=rmaley@fenix2.dol-esa.gov +Dylan Thomas=dylan@intelnet.net.gt +Earl F. Glynn=EarlGlynn@att.net +Eric S. Fisher= +Ernesto Benestante= +ESB Consultancy= +Felipe de Toledo Farias=ftfarias@dialdata.com.br +Flier Lu=flier@users.sourceforge.net +Florent Ouchet=ouchet.florent@laposte.net +Hallvard Vassbotn=hallvard.vassbotn@c2i.net +Heinz Zastrau=heinzz@users.sourceforge.net +Helen Borrie=helebor@wr.com.au +Heri Bender= +Huanlin Tsai= +Ivo Bauer=bauer@ozm.cz +Jack Bombeeck=Jack.Bombeeck@Onstream.com +Jack N.A. Bakker=jackb@europdonor.nl +James Azarja=support@jazarsoft.cjb.net +Jean Debord= +Jean-Fabien Connault= +Jean-Philippe BEMPEL=rdm_30@users.sourceforge.net +Jeroen Speldekamp= +Johannes Berg=johannes.berg@gmx.net +John C Molyneux=jaymol@hotmail.com +Jud McCranie=jud.mccranie@mindspring.com +Julien Ferraro=j.ferraro@netcourrier.com +Kevin S. Gallagher=gallaghe@teleport.com +Lasse Vågsæther Karlsen=lasse@cintra.no +Leonard Wennekers= +Liran Shahar=liran_shahar@hotmail.com +Lloyd Kinsella=lloydk@iname.com +Lucjan Lukasik=lucjanl@usa.net +M.H. Avegaart=mavegaart@csstelecom.nl +Malcolm Edgar=edgar@ccis.adisys.com.au +Manlio Laschena=manlio@users.sourceforge.net +Marc Convents= +Marcel Bestebroer=marcelb@zeelandnet.nl +Marcel van Brakel=brakelm@bart.nl +Marcin Wieczorek=wieczor@polbox.com +Marco Klemm=DonLuigi@gmx.net +Mario R. Carro=ochnap2@yahoo.com.ar +Marius le Roux=marius@caddie.co.za +Mark Vaughan= +Martin Kimmings= +Martin Kubecka= +Massimo Maria Ghisalberti=nissl@dada.it +Matt Hamilton=MHamilton@bunge.com.au +Matthias Thoma=mthoma@users.sourceforge.net +Michael Rynn=michrynn@ozemail.com.au +Michael Schnell=mschnell@bschnell.de +Michael Tsai=easyman@ms2.seeder.net +Michael Winter= +Mike Lischke=public@lischke-online.de +Nick Hodges=nhodges@icss.net +Nils Haeck=n.haeck@simdesign.nl +Oliver Schneider=assarbad@users.sourceforge.net +Olivier Sannier=obones@users.sourceforge.net +Patrick van Laake=patrick.vanlaake@ieee.org +Pavel Cisar=pcisar@atlas.cz +Pelle Liljendal=pelle.liljendal@firstconcern.com +Peter Friese=freter@gmx.net +Peter McMahon=fmcmp02@kc.kzn.school.za +Peter Panino=peter-panino@aon.at +Peter Thörnquist=peter3@users.sourceforge.net +Petr Vones=pvones@users.sourceforge.net +Python= +Ralf Junker=ralfjunker@gmx.de +Raymond Alexander=rayspostbox3@users.sourceforge.net +Rik Barker=rikbarker@users.sourceforge.net +Robert Lee=rhlee@nwu.edu +Robert Marquardt=marquardt@users.sourceforge.net +Robert R. Marsh=robmarsh@koit.fanz.net +Robert Rossmair=Robert.Rossmair@users.sourceforge.net +Rudy Velthuis=rvelthuis@gmx.de +Scott Price=scottprice@users.sourceforge.net +SouthEaster=anthony@southeaster.com +Stefan Kirschner=stefan_kirschner@01019freenet.de +Stephane Fillon=sfillon@ifrance.com +Sterling Butts=SterlingButts@Bigfoot.com +Theo Bebekis=bebekis@otenet.gr +Tim Yates=tim@things.demon.co.uk +Tom Hahn=tomhahn@users.sourceforge.net +Uwe Schuster=uschuster@users.sourceforge.net +Wim De Cleen=jones-jr@skynet.be +Yaniv Golan=ygolan@netvision.net.il diff --git a/official/1.96/docs/MPL FAQ.htm b/official/1.96/docs/MPL FAQ.htm new file mode 100644 index 0000000..90cc6c2 --- /dev/null +++ b/official/1.96/docs/MPL FAQ.htm @@ -0,0 +1,131 @@ + + + +MPL FAQ + + +

+ Mozilla Public License FAQ
+ Draft 1.0, 4/10/2000 +

+

+Please email Comments to Michael Beck
+For additional information, please also check the Official FAQ from Mozilla + +

Author perspective

+
    +
  1. Q: Do I retain copyright once I publish source under the MPL?
    + A: Absolutely. You still retain all your copyrights. +
  2. Q: Can I release the code under a different (possibly commercial type) license?
    + A: Yes. Since you have the original copyright, you can do it, but you can do + it only for your own code, and not for any contributions from others. +
  3. Q: In two years Acme, Inc. comes with a great new license, which I would love + to use. Am I always bound to MPL for my released code?
    + A: You can use a Dual License approach, i.e. you keep the code under MPL, and + you add another license, e.g. GPL. The user will have then the option to use + the one s/he prefers.
    + Or, as the Initial Contributor, with the original copyright, you can release + it under the other license. Please note: even if you release the code under + new license, users of your original MPL-released code can continue to use + under MPL as before. +
  4. Q: I think, JEDI could benefit from having cryptographic functions. I would + like to donate some (DES, Tripple DES etc.), which are covered by patent + rights (RSA, for example)? How should I do it?
    + A: All contributions are "Subject to third party intellectual property (IP) + claims." Thus, if you are aware of any patents infringements, before + submitting make sure that you: +
      +
    • secure the rights to use the IP in your contribution (e.g. by paying + a fee) +
    • modify the code so it doesn't infringe (in our case, provide other, + non-patented cryptographic functions) +
    • in a worst case scenario, if the two above are not possible, do not + submit the code +
    + Please note: different countries may have different patents laws. Therefore + in some countries it could be legal to use patented IP (e.g. because the + patent expired), while in others not. Check with your local Patent Office. +
+ +

User perspective

+
    +
  1. Q: Can I use the MPL code in commercial software? If yes, am I obligated to + credit the author?
    + A: Yes, you can use the MPL code in any commercial software. Since you have + to include the MPL code, the credit is included in the license header. + While not required, it is also customary to credit the author in "AboutBox". +
  2. Q: Must I release the source code of used components?
    + A: Only of those covered by MPL, together with any modifications to them. +
  3. Q: Must I publish my apps under MPL if I used MPL licensed code (the viral aspect) ?
    + A: No. That's the big advantage over GPL - you can use different code, mix MPL + and commercial code, but you don't have to release either the application, + nor the non-MPL code under MPL. Basically, what is MPL, will stay MPL, + but it doesn't have any impact on the non-MPL code. +
  4. Q: If a bug in MPL licensed code renders my clients machine unbootable, who + can I hold responsible for that?
    + A: Nobody. You use MPL licensed code at your own risk. Since it is provided + to you in a source code form, you can inspect it, test it, making sure that + it does, what you want it to do. +
  5. Q: Must I publish modifications to MPL licensed code?
    + A: Yes. This is one of the MPL requirements. You are getting a free source + code, but you have to publish all modifications to the code, unless you + have done the changes for your internal use. +
  6. Q: Must I publish code based on MPL licensed code under MPL?
    + A: Yes. You cannot change the license terms. Only the Initial Developer can + add an additional license (see dual license) +
  7. Q: If I subclass the MPL code, do I still have to publish the new code? After + all I didn't modify the code at all!
    + A: That's a tricky one. By the letter of the law, since you didn't touch the + original code, you might claim that it is a "new" code, therefore no need + for MPL. However, by the 'spirit of the law', Inheritance (or subclassing) + is a modification of the functionality of a given class, and as such a + "derived work", so even if you didn't touch the original code, you are + still making changes. +
  8. Q: I am proposing a modification to a JEDI-VCL component, which has a dual + license (MPL and GPL). This new file also needs to include a new class. + Should the source files for the new class be put in JEDI-VCL using MPL + with GPL dual-license or can it be put in another location and use only + the MPL?
    + A: The license of a file can't be changed without the consent of the copyright + owner. And a new file derived from an existing file inherits the licensing + from the existing file. In the case of this component, it has to stay MPL/GPL. +
  9. I am considering using an XML parser that has being covered by the MPL v1.1 + (or alternatively the GPL) in a commercial product. I will simply use the + DLL libraries without modification, including the necessary header files + in my own code. When I distribute (sell) my own product I would, of course, + need to distribute the DLL libraries as well. My questions are: +
      +
    1. Q1: Am I correct in assuming that simply including unmodified header + files and linking with a library covered by the MPL does not + place any legal restrictions or obligations on my commercial + product and its source code?
      + A1: It places no obligations on the code YOU wrote, but there are + still obligations for the code you included. These include + source distribution (for included MPL code, not YOUR code), + and some notification requirements. +
    2. Q2: Am I obligated to distribute the (unmodified) source code that + produced the libraries with which I link?
      + A2: Yes. Since you are shipping the DLL libraries with your product, + you have to make source available for the MPL code you ship.
      + Note that the license also allows you to meet the distribution requirement + by making the source available via electronic means rather than having to + physically ship them with your product (as long as you tell your users + where to get it). If you are using unmodified source code you could probably + just point at the code author's server. If you did that you'd have to + specify how users could get the exact version of the source you used, + such as a CVS date stamp or something.
      + This might be tricky -- you are responsible to make sure the source is + available for 12 months after you ship, and there's no way of knowing + how long the author will keep old versions around. The CVS repository + is more of a sure bet. You could, of course, host the source on your + own servers to be sure it'll stick around.       + +
    3. Q3: Am I obligated to make my use of the particular libraries known + to users of my product?
      + A3: Yes, it's spelled out in the license. You need to credit the + source of copyrighted code that is not yours in both the product + and its documentation. +
    +
+ + diff --git a/official/1.96/docs/MPL-1.1.txt b/official/1.96/docs/MPL-1.1.txt new file mode 100644 index 0000000..7a45bfe --- /dev/null +++ b/official/1.96/docs/MPL-1.1.txt @@ -0,0 +1,470 @@ + MOZILLA PUBLIC LICENSE + Version 1.1 + + --------------- + +1. Definitions. + + 1.0.1. "Commercial Use" means distribution or otherwise making the + Covered Code available to a third party. + + 1.1. "Contributor" means each entity that creates or contributes to + the creation of Modifications. + + 1.2. "Contributor Version" means the combination of the Original + Code, prior Modifications used by a Contributor, and the Modifications + made by that particular Contributor. + + 1.3. "Covered Code" means the Original Code or Modifications or the + combination of the Original Code and Modifications, in each case + including portions thereof. + + 1.4. "Electronic Distribution Mechanism" means a mechanism generally + accepted in the software development community for the electronic + transfer of data. + + 1.5. "Executable" means Covered Code in any form other than Source + Code. + + 1.6. "Initial Developer" means the individual or entity identified + as the Initial Developer in the Source Code notice required by Exhibit + A. + + 1.7. "Larger Work" means a work which combines Covered Code or + portions thereof with code not governed by the terms of this License. + + 1.8. "License" means this document. + + 1.8.1. "Licensable" means having the right to grant, to the maximum + extent possible, whether at the time of the initial grant or + subsequently acquired, any and all of the rights conveyed herein. + + 1.9. "Modifications" means any addition to or deletion from the + substance or structure of either the Original Code or any previous + Modifications. When Covered Code is released as a series of files, a + Modification is: + A. Any addition to or deletion from the contents of a file + containing Original Code or previous Modifications. + + B. Any new file that contains any part of the Original Code or + previous Modifications. + + 1.10. "Original Code" means Source Code of computer software code + which is described in the Source Code notice required by Exhibit A as + Original Code, and which, at the time of its release under this + License is not already Covered Code governed by this License. + + 1.10.1. "Patent Claims" means any patent claim(s), now owned or + hereafter acquired, including without limitation, method, process, + and apparatus claims, in any patent Licensable by grantor. + + 1.11. "Source Code" means the preferred form of the Covered Code for + making modifications to it, including all modules it contains, plus + any associated interface definition files, scripts used to control + compilation and installation of an Executable, or source code + differential comparisons against either the Original Code or another + well known, available Covered Code of the Contributor's choice. The + Source Code can be in a compressed or archival form, provided the + appropriate decompression or de-archiving software is widely available + for no charge. + + 1.12. "You" (or "Your") means an individual or a legal entity + exercising rights under, and complying with all of the terms of, this + License or a future version of this License issued under Section 6.1. + For legal entities, "You" includes any entity which controls, is + controlled by, or is under common control with You. For purposes of + this definition, "control" means (a) the power, direct or indirect, + to cause the direction or management of such entity, whether by + contract or otherwise, or (b) ownership of more than fifty percent + (50%) of the outstanding shares or beneficial ownership of such + entity. + +2. Source Code License. + + 2.1. The Initial Developer Grant. + The Initial Developer hereby grants You a world-wide, royalty-free, + non-exclusive license, subject to third party intellectual property + claims: + (a) under intellectual property rights (other than patent or + trademark) Licensable by Initial Developer to use, reproduce, + modify, display, perform, sublicense and distribute the Original + Code (or portions thereof) with or without Modifications, and/or + as part of a Larger Work; and + + (b) under Patents Claims infringed by the making, using or + selling of Original Code, to make, have made, use, practice, + sell, and offer for sale, and/or otherwise dispose of the + Original Code (or portions thereof). + + (c) the licenses granted in this Section 2.1(a) and (b) are + effective on the date Initial Developer first distributes + Original Code under the terms of this License. + + (d) Notwithstanding Section 2.1(b) above, no patent license is + granted: 1) for code that You delete from the Original Code; 2) + separate from the Original Code; or 3) for infringements caused + by: i) the modification of the Original Code or ii) the + combination of the Original Code with other software or devices. + + 2.2. Contributor Grant. + Subject to third party intellectual property claims, each Contributor + hereby grants You a world-wide, royalty-free, non-exclusive license + + (a) under intellectual property rights (other than patent or + trademark) Licensable by Contributor, to use, reproduce, modify, + display, perform, sublicense and distribute the Modifications + created by such Contributor (or portions thereof) either on an + unmodified basis, with other Modifications, as Covered Code + and/or as part of a Larger Work; and + + (b) under Patent Claims infringed by the making, using, or + selling of Modifications made by that Contributor either alone + and/or in combination with its Contributor Version (or portions + of such combination), to make, use, sell, offer for sale, have + made, and/or otherwise dispose of: 1) Modifications made by that + Contributor (or portions thereof); and 2) the combination of + Modifications made by that Contributor with its Contributor + Version (or portions of such combination). + + (c) the licenses granted in Sections 2.2(a) and 2.2(b) are + effective on the date Contributor first makes Commercial Use of + the Covered Code. + + (d) Notwithstanding Section 2.2(b) above, no patent license is + granted: 1) for any code that Contributor has deleted from the + Contributor Version; 2) separate from the Contributor Version; + 3) for infringements caused by: i) third party modifications of + Contributor Version or ii) the combination of Modifications made + by that Contributor with other software (except as part of the + Contributor Version) or other devices; or 4) under Patent Claims + infringed by Covered Code in the absence of Modifications made by + that Contributor. + +3. Distribution Obligations. + + 3.1. Application of License. + The Modifications which You create or to which You contribute are + governed by the terms of this License, including without limitation + Section 2.2. The Source Code version of Covered Code may be + distributed only under the terms of this License or a future version + of this License released under Section 6.1, and You must include a + copy of this License with every copy of the Source Code You + distribute. You may not offer or impose any terms on any Source Code + version that alters or restricts the applicable version of this + License or the recipients' rights hereunder. However, You may include + an additional document offering the additional rights described in + Section 3.5. + + 3.2. Availability of Source Code. + Any Modification which You create or to which You contribute must be + made available in Source Code form under the terms of this License + either on the same media as an Executable version or via an accepted + Electronic Distribution Mechanism to anyone to whom you made an + Executable version available; and if made available via Electronic + Distribution Mechanism, must remain available for at least twelve (12) + months after the date it initially became available, or at least six + (6) months after a subsequent version of that particular Modification + has been made available to such recipients. You are responsible for + ensuring that the Source Code version remains available even if the + Electronic Distribution Mechanism is maintained by a third party. + + 3.3. Description of Modifications. + You must cause all Covered Code to which You contribute to contain a + file documenting the changes You made to create that Covered Code and + the date of any change. You must include a prominent statement that + the Modification is derived, directly or indirectly, from Original + Code provided by the Initial Developer and including the name of the + Initial Developer in (a) the Source Code, and (b) in any notice in an + Executable version or related documentation in which You describe the + origin or ownership of the Covered Code. + + 3.4. Intellectual Property Matters + (a) Third Party Claims. + If Contributor has knowledge that a license under a third party's + intellectual property rights is required to exercise the rights + granted by such Contributor under Sections 2.1 or 2.2, + Contributor must include a text file with the Source Code + distribution titled "LEGAL" which describes the claim and the + party making the claim in sufficient detail that a recipient will + know whom to contact. If Contributor obtains such knowledge after + the Modification is made available as described in Section 3.2, + Contributor shall promptly modify the LEGAL file in all copies + Contributor makes available thereafter and shall take other steps + (such as notifying appropriate mailing lists or newsgroups) + reasonably calculated to inform those who received the Covered + Code that new knowledge has been obtained. + + (b) Contributor APIs. + If Contributor's Modifications include an application programming + interface and Contributor has knowledge of patent licenses which + are reasonably necessary to implement that API, Contributor must + also include this information in the LEGAL file. + + (c) Representations. + Contributor represents that, except as disclosed pursuant to + Section 3.4(a) above, Contributor believes that Contributor's + Modifications are Contributor's original creation(s) and/or + Contributor has sufficient rights to grant the rights conveyed by + this License. + + 3.5. Required Notices. + You must duplicate the notice in Exhibit A in each file of the Source + Code. If it is not possible to put such notice in a particular Source + Code file due to its structure, then You must include such notice in a + location (such as a relevant directory) where a user would be likely + to look for such a notice. If You created one or more Modification(s) + You may add your name as a Contributor to the notice described in + Exhibit A. You must also duplicate this License in any documentation + for the Source Code where You describe recipients' rights or ownership + rights relating to Covered Code. You may choose to offer, and to + charge a fee for, warranty, support, indemnity or liability + obligations to one or more recipients of Covered Code. However, You + may do so only on Your own behalf, and not on behalf of the Initial + Developer or any Contributor. You must make it absolutely clear than + any such warranty, support, indemnity or liability obligation is + offered by You alone, and You hereby agree to indemnify the Initial + Developer and every Contributor for any liability incurred by the + Initial Developer or such Contributor as a result of warranty, + support, indemnity or liability terms You offer. + + 3.6. Distribution of Executable Versions. + You may distribute Covered Code in Executable form only if the + requirements of Section 3.1-3.5 have been met for that Covered Code, + and if You include a notice stating that the Source Code version of + the Covered Code is available under the terms of this License, + including a description of how and where You have fulfilled the + obligations of Section 3.2. The notice must be conspicuously included + in any notice in an Executable version, related documentation or + collateral in which You describe recipients' rights relating to the + Covered Code. You may distribute the Executable version of Covered + Code or ownership rights under a license of Your choice, which may + contain terms different from this License, provided that You are in + compliance with the terms of this License and that the license for the + Executable version does not attempt to limit or alter the recipient's + rights in the Source Code version from the rights set forth in this + License. If You distribute the Executable version under a different + license You must make it absolutely clear that any terms which differ + from this License are offered by You alone, not by the Initial + Developer or any Contributor. You hereby agree to indemnify the + Initial Developer and every Contributor for any liability incurred by + the Initial Developer or such Contributor as a result of any such + terms You offer. + + 3.7. Larger Works. + You may create a Larger Work by combining Covered Code with other code + not governed by the terms of this License and distribute the Larger + Work as a single product. In such a case, You must make sure the + requirements of this License are fulfilled for the Covered Code. + +4. Inability to Comply Due to Statute or Regulation. + + If it is impossible for You to comply with any of the terms of this + License with respect to some or all of the Covered Code due to + statute, judicial order, or regulation then You must: (a) comply with + the terms of this License to the maximum extent possible; and (b) + describe the limitations and the code they affect. Such description + must be included in the LEGAL file described in Section 3.4 and must + be included with all distributions of the Source Code. Except to the + extent prohibited by statute or regulation, such description must be + sufficiently detailed for a recipient of ordinary skill to be able to + understand it. + +5. Application of this License. + + This License applies to code to which the Initial Developer has + attached the notice in Exhibit A and to related Covered Code. + +6. Versions of the License. + + 6.1. New Versions. + Netscape Communications Corporation ("Netscape") may publish revised + and/or new versions of the License from time to time. Each version + will be given a distinguishing version number. + + 6.2. Effect of New Versions. + Once Covered Code has been published under a particular version of the + License, You may always continue to use it under the terms of that + version. You may also choose to use such Covered Code under the terms + of any subsequent version of the License published by Netscape. No one + other than Netscape has the right to modify the terms applicable to + Covered Code created under this License. + + 6.3. Derivative Works. + If You create or use a modified version of this License (which you may + only do in order to apply it to code which is not already Covered Code + governed by this License), You must (a) rename Your license so that + the phrases "Mozilla", "MOZILLAPL", "MOZPL", "Netscape", + "MPL", "NPL" or any confusingly similar phrase do not appear in your + license (except to note that your license differs from this License) + and (b) otherwise make it clear that Your version of the license + contains terms which differ from the Mozilla Public License and + Netscape Public License. (Filling in the name of the Initial + Developer, Original Code or Contributor in the notice described in + Exhibit A shall not of themselves be deemed to be modifications of + this License.) + +7. DISCLAIMER OF WARRANTY. + + COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, + WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, + WITHOUT LIMITATION, WARRANTIES THAT THE COVERED CODE IS FREE OF + DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE OR NON-INFRINGING. + THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED CODE + IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, + YOU (NOT THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE + COST OF ANY NECESSARY SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER + OF WARRANTY CONSTITUTES AN ESSENTIAL PART OF THIS LICENSE. NO USE OF + ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER THIS DISCLAIMER. + +8. TERMINATION. + + 8.1. This License and the rights granted hereunder will terminate + automatically if You fail to comply with terms herein and fail to cure + such breach within 30 days of becoming aware of the breach. All + sublicenses to the Covered Code which are properly granted shall + survive any termination of this License. Provisions which, by their + nature, must remain in effect beyond the termination of this License + shall survive. + + 8.2. If You initiate litigation by asserting a patent infringement + claim (excluding declatory judgment actions) against Initial Developer + or a Contributor (the Initial Developer or Contributor against whom + You file such action is referred to as "Participant") alleging that: + + (a) such Participant's Contributor Version directly or indirectly + infringes any patent, then any and all rights granted by such + Participant to You under Sections 2.1 and/or 2.2 of this License + shall, upon 60 days notice from Participant terminate prospectively, + unless if within 60 days after receipt of notice You either: (i) + agree in writing to pay Participant a mutually agreeable reasonable + royalty for Your past and future use of Modifications made by such + Participant, or (ii) withdraw Your litigation claim with respect to + the Contributor Version against such Participant. If within 60 days + of notice, a reasonable royalty and payment arrangement are not + mutually agreed upon in writing by the parties or the litigation claim + is not withdrawn, the rights granted by Participant to You under + Sections 2.1 and/or 2.2 automatically terminate at the expiration of + the 60 day notice period specified above. + + (b) any software, hardware, or device, other than such Participant's + Contributor Version, directly or indirectly infringes any patent, then + any rights granted to You by such Participant under Sections 2.1(b) + and 2.2(b) are revoked effective as of the date You first made, used, + sold, distributed, or had made, Modifications made by that + Participant. + + 8.3. If You assert a patent infringement claim against Participant + alleging that such Participant's Contributor Version directly or + indirectly infringes any patent where such claim is resolved (such as + by license or settlement) prior to the initiation of patent + infringement litigation, then the reasonable value of the licenses + granted by such Participant under Sections 2.1 or 2.2 shall be taken + into account in determining the amount or value of any payment or + license. + + 8.4. In the event of termination under Sections 8.1 or 8.2 above, + all end user license agreements (excluding distributors and resellers) + which have been validly granted by You or any distributor hereunder + prior to termination shall survive termination. + +9. LIMITATION OF LIABILITY. + + UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, WHETHER TORT + (INCLUDING NEGLIGENCE), CONTRACT, OR OTHERWISE, SHALL YOU, THE INITIAL + DEVELOPER, ANY OTHER CONTRIBUTOR, OR ANY DISTRIBUTOR OF COVERED CODE, + OR ANY SUPPLIER OF ANY OF SUCH PARTIES, BE LIABLE TO ANY PERSON FOR + ANY INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES OF ANY + CHARACTER INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF GOODWILL, + WORK STOPPAGE, COMPUTER FAILURE OR MALFUNCTION, OR ANY AND ALL OTHER + COMMERCIAL DAMAGES OR LOSSES, EVEN IF SUCH PARTY SHALL HAVE BEEN + INFORMED OF THE POSSIBILITY OF SUCH DAMAGES. THIS LIMITATION OF + LIABILITY SHALL NOT APPLY TO LIABILITY FOR DEATH OR PERSONAL INJURY + RESULTING FROM SUCH PARTY'S NEGLIGENCE TO THE EXTENT APPLICABLE LAW + PROHIBITS SUCH LIMITATION. SOME JURISDICTIONS DO NOT ALLOW THE + EXCLUSION OR LIMITATION OF INCIDENTAL OR CONSEQUENTIAL DAMAGES, SO + THIS EXCLUSION AND LIMITATION MAY NOT APPLY TO YOU. + +10. U.S. GOVERNMENT END USERS. + + The Covered Code is a "commercial item," as that term is defined in + 48 C.F.R. 2.101 (Oct. 1995), consisting of "commercial computer + software" and "commercial computer software documentation," as such + terms are used in 48 C.F.R. 12.212 (Sept. 1995). Consistent with 48 + C.F.R. 12.212 and 48 C.F.R. 227.7202-1 through 227.7202-4 (June 1995), + all U.S. Government End Users acquire Covered Code with only those + rights set forth herein. + +11. MISCELLANEOUS. + + This License represents the complete agreement concerning subject + matter hereof. If any provision of this License is held to be + unenforceable, such provision shall be reformed only to the extent + necessary to make it enforceable. This License shall be governed by + California law provisions (except to the extent applicable law, if + any, provides otherwise), excluding its conflict-of-law provisions. + With respect to disputes in which at least one party is a citizen of, + or an entity chartered or registered to do business in the United + States of America, any litigation relating to this License shall be + subject to the jurisdiction of the Federal Courts of the Northern + District of California, with venue lying in Santa Clara County, + California, with the losing party responsible for costs, including + without limitation, court costs and reasonable attorneys' fees and + expenses. The application of the United Nations Convention on + Contracts for the International Sale of Goods is expressly excluded. + Any law or regulation which provides that the language of a contract + shall be construed against the drafter shall not apply to this + License. + +12. RESPONSIBILITY FOR CLAIMS. + + As between Initial Developer and the Contributors, each party is + responsible for claims and damages arising, directly or indirectly, + out of its utilization of rights under this License and You agree to + work with Initial Developer and Contributors to distribute such + responsibility on an equitable basis. Nothing herein is intended or + shall be deemed to constitute any admission of liability. + +13. MULTIPLE-LICENSED CODE. + + Initial Developer may designate portions of the Covered Code as + "Multiple-Licensed". "Multiple-Licensed" means that the Initial + Developer permits you to utilize portions of the Covered Code under + Your choice of the NPL or the alternative licenses, if any, specified + by the Initial Developer in the file described in Exhibit A. + +EXHIBIT A -Mozilla Public License. + + ``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 ______________________________________. + + The Initial Developer of the Original Code is ________________________. + Portions created by ______________________ are Copyright (C) ______ + _______________________. All Rights Reserved. + + Contributor(s): ______________________________________. + + Alternatively, the contents of this file may be used under the terms + of the _____ license (the "[___] License"), in which case the + provisions of [______] 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 [____] 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 [___] License. If you do not delete + the provisions above, a recipient may use your version of this file + under either the MPL or the [___] License." + + [NOTE: The text of this Exhibit A may differ slightly from the text of + the notices in the Source Code files of the Original Code. You should + use the text of this Exhibit A rather than the text found in the + Original Code Source Code for Your Modifications.] + diff --git a/official/1.96/docs/Readme.html b/official/1.96/docs/Readme.html new file mode 100644 index 0000000..c92d614 --- /dev/null +++ b/official/1.96/docs/Readme.html @@ -0,0 +1,347 @@ + + + + Jedi Code Library Release 1.97 + + + + + +
+

Jedi Code Library

+

Release 1.97
+Build 2172
+10-February-2006

+

+

News

+

JCL release 1.97 provide an updated support for all targets (including Borland +Developer Studio 2006) and an installation of some experts in C#Builder 1 and Delphi 8.

+

As always, multiple bugs have been fixed; for detailed change logs, +use the facilities of our CVS repository at SourceForge.net +, see below.

+

Important: +

+
    +

  • Note that the package naming has changed: the same package name is used by +all versions of the compiler supporting suffixes (C++Builder 6, Delphi 6, +Delphi 7, C#Builder 1, Delphi 8, Delphi 2005 and BDS 2006); a different suffix +is added for each target. The installer tries to remove old packages. +3rd party packages requiring old DJcl* resp. CJcl* packages need to be changed +to accomodate the new naming scheme or they will cause conflicts in the IDE at load time. +

    • +

  • DCP files are now created in the lib\target subdirectory of the JCL +installation. 3rd party packages requiring JCL packages need to have this path +in their "browse path" option to compile. +

    • +
+

(Windows only) Installation options:

+

Packages compiled by the JCL installer don't contain any debug +informations to keep their size as small as possible.

+

The Jedi Code Library packages are required by some 3rd party packages +(including the Jedi Visual Component Library - JVCL), the installer generates +them if the "Packages" node is checked.

+

The installer can generate MAP informations for each package. These informations +can be linked into binaries to become JCL debug data. Once linked MAP files could +be deleted. These options are subnodes of the "Packages" node.

+

Experts:

+

For Delphi 5, Delphi 6, Delphi 7, C++Builder 5 and C++Builder 6, experts can +be installed as design time packages or dll experts. For C#Builder 1 and Delphi 8, +experts are installed as dll experts (those products don't load design time +packages). For Delphi 2005 and Borland Developer Studio 2006, experts are +installed as design time packages.

+

A new expert integrating version control systems in the IDE was added. +It provides an integration of TortoiseCVS and TortoiseSVN inside the IDE, items +are added in the IDE menu and buttons can be placed in IDE toolbars via the +customize dialog, see below.

+

A dialog-box provides configuration options for JCL experts in the Tools menu.

+

.net Framework support:

+

A subset of JCL units was worked over to support Delphi.Net (Delphi 2005 +& BDS 2006). The packages belong to the Jedi.Jcl namespace.

+
+

Supported Tools

+

Run time support:

+
    +
  • Kylix 3
    • +
+ +

Design time support (only experts):

+
    +
  • C#Builder 1 (refer to installation notes below). +
    • +
  • Delphi 8.net (refer to installation notes below).
    • +
+

Both supports (run time and design time):

+
    +
  • Delphi version 5, 6, 7 +
    • +
  • C++Builder version 5 & 6 +
    • +
  • Delphi 2005 (Delphi Win32 and Delphi.net personalities) +
    • +
  • Borland Developer Studio 2006 (Delphi Win32, C++ Builder Win32, Delphi.net and C#Builder personalities)
    • +
+
+

Notes

+
    +
  • Not every unit supports all tools. Look out for *.exc +files in the tool-specific lib/subdirectories for a list of units +excluded from compilation. +
    • +
  • Kylix 3/C++ installation is broken; the installer will fail when +it attempts to build the packages. Since the dreaded file open/save dialog Kylix +bug is haunting us again (wasn't it considered to be defeated as of Kernel 2.4.21?), +we are at present not investigating this further. +
    • +
  • Free Pascal (FP) +support has not been updated for this release; most units from +source/common should work with FP 2.0, as tests with a 2.0 beta (1.9.8) +indicated, but this has not been verified. Note that there are no plans +to support FP versions from the 1.0 branch.
    • +
+

Installation on C#Builder 1 and Delphi 8:

+
    +
  1. These products cannot be used to build the JCL installer, you need an + other supported product to install JCL experts on these products.
    2. +
  2. These products are not able to use the JCL library as a runtime library. + You cannot write managed applications and managed packages based on the JCL. +
    3. +
  3. These products are not shipped with their native compilers, you have to + download it from codecentral (http://cc.borland.com). + The item (21333) +  the native compiler to be installed in Delphi 8. + The item (21334) +  the native compiler to be installed in C#Builder 1. + These zip files have to be extracted in the products director using the standard pattern:
    4. +
+
		   Executable files (exe and dll)      - BDS\X.0\bin
+		   Compiler files (dcp and dcu)        - BDS\X.0\lib
+		   Toolsapi source files               - BDS\X.0\source\ToolsAPI.
+
+
+

JCL Distribution content

+
Install.bat                   - Compile and run JCL Installer (Win32)
+QInstall.bat                  - Compile and run CLX version of JCL Installer (Win32)
+install.sh                    - Compile and run JCL Installer (Linux)
+bin                           - Common place for sample application EXE files
+lib                           - Common place for compiled units.
+docs                          - Readme (this file) and other documents
+examples                      - JCL example applications
+experts                       - JCL IDE experts source code
+experts\debug                 - JCL Debug IDE expert for using JclDebug unit
+experts\debug\dialog          - Application exception dialog replacement
+experts\debug\simdview        - Low-level debug window for XMM registers
+experts\debug\threadnames     - IDE expert showing class names for debugged threads
+experts\debug\tools           - Tools for creating files with JCL debug information
+experts\favfolders            - Favorite folders combobox in IDE open/save file dialogs
+experts\projectanalyzer       - Project Analyzer IDE expert
+experts\useswizard            - JCL uses wizard
+experts\versioncontrol        - Integration of TortoiseCVS and TortoiseSVN in the IDE
+examples\common               - CLX and Win32 example applications in Delphi
+examples\dotnet               - JCL example applications for Delphi.net
+examples\windows              - JCL example applications for Delphi.Win32
+examples\windows\delphitools  - Collection of system tools using JCL
+help                          - Help file
+install                       - Installer source code
+packages                      - JCL package sources
+source                        - JCL source code
+
+
+

Feedback

+If you have any comments or suggestions we would appreciate it if you +drop us a note. There are several ways to get in contact with us: + +
+

Issue Tracking

+

An issue tracking tool can be accessed via ('Code Library' category):

+

http://homepages.borland.com/jedi/issuetracker/

+

The general rule is: If you want to get a +bug fixed you need to log it!

+

The JEDI issue tracker is based up on the Mantis BugTracker Open +Source project. More background information about it is available on its homepage  +http://mantisbt.sourceforge.net

+

Please be aware that you are allowed there to enter feature request +and code donations as well.

+
+

Debug Extension for JclDebug unit

+

The experts\debug folder contains an IDE expert which +assists to insert JCL Debug information into executable files. This can be +useful when use source location routines from JclDebug unit. These routines +need some kind of special information to be able provide source location for +given address in the process. Currently there are four options to get it work:

+
    +
  1. Generate and deploy MAP file with your executable file. The file +is generated by the linker. It needs to be set in Project|Options +dialog -> Linker page, Detailed checkbox. +
    2. +
  2. Generate and deploy JDBG file file with your executable file. +This is binary file based on MAP file but its size is typically about +12% of original MAP file. You can generate it by MapToJdbg tool in jcl\examples\windows\tools +folder. The advantage over MAP file is smaller size and better security +of the file content because it is not a plain text file and it also +contains a checksum. +
    3. +
  3. Generate Borland TD32 debug symbols. These symbols are stored +directly in the executable file but usually adds several megabytes so +the file is very large. The advantage is you don't have to deploy any +other file and it is easy to generate it by checking Include TD32 debug +info in Linker option page. +
    4. +
  4. Insert JCL Debug info into executable file by the IDE expert. The +size of added data is similar to JDBG file but it will be inserted +directly into the executable file. This is probably best option because +it combines small size of included data and no requirement of deploying +additional files. In case you use this option you need install the +JclDebugIde expert.
    5. +
+

+The IDE expert will add new item to IDE Project menu. For +Delphi 5, 6 and 7 it adds 'Insert JCL Debug data' check item at the end +of the Project menu. When the item is checked, everytime the project is +compiled by one of following commands: Compile, Build, Compile All Projects, Build All +Projects or Run necessary JCL debug data are automatically inserted into the +executable. Moreover, for Build and Build All commands dialog with detailed +information of size of these data will be displayed.

+

+You can generate those debug data for packages and libraries as well +using the expert. Each executable file in the project can use different option +from those listed above. It is not necessary to generate any debug data for +Borland runtime packages because the source location code can use names of exported +functions to get procedure or method name. To get line number information for +Borland RTL and VCL/CLX units you have to check Use Debug DCUs checkbox in +Project|Options dialog -> Compiler tab. Unfortunately it is not +possible to get line number information for Borland runtime packages +because Borland does not provide detailed MAP files for them so you get +procedure or method name only.

+

In case you have more than one data source for an executable file by +an accident the best one is chosen in following order:

+
    +
  1. JCL Debug data in the executable file +
    2. +
  2. JDBG file +
    3. +
  3. Borland TD32 symbols +
    4. +
  4. MAP file +
    5. +
  5. Library or Borland package exports
    6. +
+

It is also possible to insert JCL debug data programmatically to the +executable file by using MakeJclDbg command line tool in +jcl\examples\windows\delphitools folder. You can study included makefiles +which uses this tool for building delphitools examples.

+

To help using JclDebug exceptional stack tracking in application +simple dialog is provided in jcl\experts\debug\dialogfolder. The dialog +replaces standard dialog displayed by VCL or CLX application when an unhandled +exception occurs. It has additional Detailed button showing the stack, list of +loaded modules and other system information. By adding the dialog to the +application exceptional stack tracking code is automatically initialized so you +don't have to care about it. You can also turn on logging to text file by setting +the Tag property of the dialog to '1'. There is also version for CLX +(ClxExceptDlg) but it works on Windows only. These dialogs are intended to be added to +Object Repository.

+

Short description of getting the JclDebug functionality in your +project:

+
    +
  1. Close all running instances of Delphi +
    2. +
  2. Install JCL and IDE experts by the JCL Installer +
    3. +
  3. Run Delphi IDE and open your project +
    4. +
  4. Remove any TApplication.OnException handlers from your project(if any). +
    5. +
  5. Add new Exception Dialog by selecting File | New | Other ... | +Dialogs tab, Select 'Exception Dialog' or 'Exception Dialog with Send' +icon, Click OK button, Save the form (use ExceptionDialog.pas name, for +example) +
    6. +
  6. Check Project | Insert JCL Debug data menu item +
    7. +
  7. Do Project | Build
    8. +
+
+

Version control expert

+

The JCL team is proud to release a new expert integrating version control actions +inside the Delphi/BCB/BDS IDE. It wraps TortoiseCVS  +and TortoiseSVN commands in +actions that can be placed on IDE toolbars and in IDE menu.

+

This expert requires TortoiseCVS  +or/and TortoiseSVN installed on the +system to work properly. Please refer to these products documentations for help +about using version control systems.

+

The structure of the "Jcl Version" menu can be customized in the JCL options +dialog (in the "Tools" menu).

+
+

Downloads of stable sources

+

These sources are official JCL releases and file status can be considered as +stable for use in final applications. During the past years, there have been around 2 +or 3 releases per year.

+

Jedi Code Library: File List on SourceForge:  +http://sourceforge.net/project/showfiles.php?group_id=47514 +

+
+

Development sources

+

These files are under active development and may cause some incompatibilities +and some conflicts with existing code. You should not use these files in final +applications. The JCL development team provides these files for testing and +feedback from users.

+ + + + +

You can download snapshots of the CVS repository updated every day in the + JCL daily page +

+ + +

To always have access to the most recent changes in the JCL, you +should install a CVS client (we recommend TortoiseCVS and WinCVS) and download +the CVS repository files to your computer. With the CVS client, you can update +your local repository at any time. For more instructions on how to set up CVS +and use it with JCL, see the CVS instruction page. +You can also access the CVS repository via the web interface. +

+
+

Getting involved in JCL development

+If you want to help out making JCL better or bigger or just plain +cooler, there are several ways in which you can help out. Here are some of the +things we need your help on: +
    +
  • Donate source code +
    • +
  • Donate time writing help +
    • +
  • Donate time writing demos +
    • +
  • Donate time fixing bugs +
    • +
  • Share your experience by helping users in newsgroups and mailing lists
    • +
+

JCL accepts donations from developers as long as the source fullfills the +requirements set up by the JEDI and JCL teams. To read more about these +requirements, visit the page http://homepages.borland.com/jedi/jcl

+

You can also donate your time by writing help for the source already +in JCL. We currently use Doc-o-Matic to create the finished help files but +the actual help sources are plain text files in a simple to understand format. +We can provide you with auto-generated templates with all classes, properties, +types etc already inserted. The "only" thing left to do is fill in the actual +help text for the help items. If you are interested in writing help, contact us.

+

If you want to help fix bugs in JCL, go to Mantis and check the bug report +there. You can post replies as well as fixes directly in the bug report. One of the +JCL developers will pick up the report/fix and update the CVS repository if the fix is +satisfactory. If you report and fix a lot of bugs, you might even get developer +access to CVS so you can update the JCL files directly.

+ + diff --git a/official/1.96/docs/Readme.txt b/official/1.96/docs/Readme.txt new file mode 100644 index 0000000..a75b732 --- /dev/null +++ b/official/1.96/docs/Readme.txt @@ -0,0 +1,322 @@ +-------------------------------------------------------------------------------- + +Jedi Code Library +Release 1.97 +Build 2172 +10-February-2006 + +-------------------------------------------------------------------------------- + +News +JCL release 1.97 provide an updated support for all targets (including Borland +Developer Studio 2006) and an installation of some experts in C#Builder 1 and +Delphi 8. + +As always, multiple bugs have been fixed; for detailed change logs, use the +facilities of our CVS repository at SourceForge.net , see below. + +Important: + +Note that the package naming has changed: the same package name is used by all +versions of the compiler supporting suffixes (C++Builder 6, Delphi 6, Delphi 7, +C#Builder 1, Delphi 8, Delphi 2005 and BDS 2006); a different suffix is added +for each target. The installer tries to remove old packages. 3rd party packages +requiring old DJcl* resp. CJcl* packages need to be changed to accomodate the +new naming scheme or they will cause conflicts in the IDE at load time. + +DCP files are now created in the lib\target subdirectory of the JCL +installation. 3rd party packages requiring JCL packages need to have this path +in their "browse path" option to compile. + +(Windows only) Installation options: + + - Packages compiled by the JCL installer don't contain any debug informations +to keep their size as small as possible. + + - The Jedi Code Library packages are required by some 3rd party packages +(including the Jedi Visual Component Library - JVCL), the installer generates +them if the "Packages" node is checked. + + - The installer can generate MAP informations for each package. These +informations can be linked into binaries to become JCL debug data. Once linked +MAP files could be deleted. These options are subnodes of the "Packages" node. + +Experts: + + - For Delphi 5, Delphi 6, Delphi 7, C++Builder 5 and C++Builder 6, experts can +be installed as design time packages or dll experts. For C#Builder 1 and +Delphi 8, experts are installed as dll experts (those products don't load +design time packages). For Delphi 2005 and Borland Developer Studio 2006, +experts are installed as design time packages. + + - A new expert integrating version control systems in the IDE was added. It +provides an integration of TortoiseCVS and TortoiseSVN inside the IDE, items are +added in the IDE menu and buttons can be placed in IDE toolbars via the +customize dialog, see below. + + - A dialog-box provides configuration options for JCL experts in the Tools menu. + +.net Framework support: + +A subset of JCL units was worked over to support Delphi.Net (Delphi 2005 & BDS +2006). The packages belong to the Jedi.Jcl namespace. + +-------------------------------------------------------------------------------- + +Supported Tools +Run time support: + - Kylix 3 + +Design time support (only experts): + - C#Builder 1 (refer to installation notes below). + - Delphi 8.net (refer to installation notes below). + +Both supports (run time and design time): + - Delphi version 5, 6, 7 + - C++Builder version 5 & 6 + - Delphi 2005 (Delphi Win32 and Delphi.net personalities) + - Borland Developer Studio 2006 (Delphi Win32, C++ Builder Win32, Delphi.net + and C#Builder personalities) + +-------------------------------------------------------------------------------- + +Notes +Not every unit supports all tools. Look out for *.exc files in the tool-specific +lib/subdirectories for a list of units excluded from compilation. +Kylix 3/C++ installation is broken; the installer will fail when it attempts to +build the packages. Since the dreaded file open/save dialog Kylix bug is +haunting us again (wasn't it considered to be defeated as of Kernel 2.4.21?), +we are at present not investigating this further. +Free Pascal (FP) support has not been updated for this release; most units from +source/common should work with FP 2.0, as tests with a 2.0 beta (1.9.8) +indicated, but this has not been verified. Note that there are no plans to +support FP versions from the 1.0 branch. +Installation on C#Builder 1 and Delphi 8: + +These products cannot be used to build the JCL installer, you need an other +supported product to install JCL experts on these products. +These products are not able to use the JCL library as a runtime library. You +cannot write managed applications and managed packages based on the JCL. +These products are not shipped with their native compilers, you have to download +it from codecentral (http://cc.borland.com). The item (21333) the native +compiler to be installed in Delphi 8. The item (21334) the native compiler to +be installed in C#Builder 1. These zip files have to be extracted in the +products director using the standard pattern: + Executable files (exe and dll) - BDS\X.0\bin + Compiler files (dcp and dcu) - BDS\X.0\lib + Toolsapi source files - BDS\X.0\source\ToolsAPI. + +-------------------------------------------------------------------------------- + +JCL Distribution content +Install.bat - Compile and run JCL Installer (Win32) +QInstall.bat - Compile and run CLX version of JCL Installer (Win32) +install.sh - Compile and run JCL Installer (Linux) +bin - Common place for sample application EXE files +lib - Common place for compiled units. +docs - Readme (this file) and other documents +examples - JCL example applications +experts - JCL IDE experts source code +experts\debug - JCL Debug IDE expert for using JclDebug unit +experts\debug\dialog - Application exception dialog replacement +experts\debug\simdview - Low-level debug window for XMM registers +experts\debug\threadnames - IDE expert showing class names for debugged threads +experts\debug\tools - Tools for creating files with JCL debug information +experts\favfolders - Favorite folders combobox in IDE open/save file dialogs +experts\projectanalyzer - Project Analyzer IDE expert +experts\useswizard - JCL uses wizard +experts\versioncontrol - Integration of TortoiseCVS and TortoiseSVN in the IDE +examples\common - CLX and Win32 example applications in Delphi +examples\dotnet - JCL example applications for Delphi.net +examples\windows - JCL example applications for Delphi.Win32 +examples\windows\delphitools - Collection of system tools using JCL +help - Help file +install - Installer source code +packages - JCL package sources +source - JCL source code + +-------------------------------------------------------------------------------- + +Feedback +If you have any comments or suggestions we would appreciate it if you drop us a +note. There are several ways to get in contact with us: + + - Newsgroup is the recommended way to contact other JCL users and the team +itself. They are hosted at news://forums.talkto.net/jedi.jcl. + + - Write to jcl@delphi-jedi.org or to jcl-testing@delphi-jedi.org This email +account should not be used for support requests. If you need support please use +either the newsgroups or the mailing list. + + - If you want to keep up to date about JCL then you can join the JCL mailing list +by going to http://www.egroups.com/group/JEDI-JCL You can also use this list to +voice your opinion, comments or suggestions. + +-------------------------------------------------------------------------------- + +Issue Tracking +An issue tracking tool can be accessed via ('Code Library' category): +http://homepages.borland.com/jedi/issuetracker/ + +The general rule is: IF YOU WANT TO GET A BUG FIXED YOU NEED TO LOG IT! + +The JEDI issue tracker is based up on the Mantis BugTracker Open Source project. +More background information about it is available on its homepage +http://mantisbt.sourceforge.net + +Please be aware that you are allowed there to enter feature request and code +donations as well. + +-------------------------------------------------------------------------------- + +Debug Extension for JclDebug unit +The experts\debug folder contains an IDE expert which assists to insert JCL +Debug information into executable files. This can be useful when use source +location routines from JclDebug unit. These routines need some kind of special +information to be able provide source location for given address in the process. +Currently there are four options to get it work: + +Generate and deploy MAP file with your executable file. The file is generated +by the linker. It needs to be set in Project|Options dialog -> Linker page, +Detailed checkbox. +Generate and deploy JDBG file file with your executable file. This is binary +file based on MAP file but its size is typically about 12% of original MAP file. +You can generate it by MapToJdbg tool in jcl\examples\windows\tools folder. +The advantage over MAP file is smaller size and better security of the file +content because it is not a plain text file and it also contains a checksum. +Generate Borland TD32 debug symbols. These symbols are stored directly in the +executable file but usually adds several megabytes so the file is very large. +The advantage is you don't have to deploy any other file and it is easy to +generate it by checking Include TD32 debug info in Linker option page. +Insert JCL Debug info into executable file by the IDE expert. The size of added +data is similar to JDBG file but it will be inserted directly into the +executable file. This is probably best option because it combines small size of +included data and no requirement of deploying additional files. In case you use +this option you need install the JclDebugIde expert. +The IDE expert will add new item to IDE Project menu. For Delphi 5, 6 and 7 it +adds 'Insert JCL Debug data' check item at the end of the Project menu. When the +item is checked, everytime the project is compiled by one of following commands: +Compile, Build, Compile All Projects, Build All Projects or Run necessary JCL +debug data are automatically inserted into the executable. Moreover, for Build +and Build All commands dialog with detailed information of size of these data +will be displayed. + +You can generate those debug data for packages and libraries as well using the +expert. Each executable file in the project can use different option from those +listed above. It is not necessary to generate any debug data for Borland runtime +packages because the source location code can use names of exported functions to +get procedure or method name. To get line number information for Borland RTL and +VCL/CLX units you have to check Use Debug DCUs checkbox in +Project|Options dialog -> Compiler tab. Unfortunately it is not possible to get +line number information for Borland runtime packages because Borland does not +provide detailed MAP files for them so you get procedure or method name only. + +In case you have more than one data source for an executable file by an accident +the best one is chosen in following order: + - JCL Debug data in the executable file + - JDBG file + - Borland TD32 symbols + - MAP file + +Library or Borland package exports +It is also possible to insert JCL debug data programmatically to the executable +file by using MakeJclDbg command line tool in jcl\examples\windows\delphitools +folder. You can study included makefiles which uses this tool for building +delphitools examples. + +To help using JclDebug exceptional stack tracking in application simple dialog +is provided in jcl\experts\debug\dialogfolder. The dialog replaces standard +dialog displayed by VCL or CLX application when an unhandled exception occurs. +It has additional Detailed button showing the stack, list of loaded modules and +other system information. By adding the dialog to the application exceptional +stack tracking code is automatically initialized so you don't have to care about +it. You can also turn on logging to text file by setting the Tag property of the +dialog to '1'. There is also version for CLX (ClxExceptDlg) but it works on +Windows only. These dialogs are intended to be added to Object Repository. + +Short description of getting the JclDebug functionality in your project: + + - Close all running instances of Delphi + - Install JCL and IDE experts by the JCL Installer + - Run Delphi IDE and open your project + - Remove any TApplication.OnException handlers from your project(if any). + - Add new Exception Dialog by selecting File | New | Other ... | Dialogs tab, + - Select 'Exception Dialog' or 'Exception Dialog with Send' icon, Click OK button, + - Save the form (use ExceptionDialog.pas name, for example) + - Check Project | Insert JCL Debug data menu item + - Do Project | Build + +-------------------------------------------------------------------------------- + +Version control expert + +The JCL team is proud to release a new expert integrating version control +actions inside the Delphi/BCB/BDS IDE. It wraps TortoiseCVS and TortoiseSVN +commands in actions that can be placed on IDE toolbars and in IDE menu. + +This expert requires TortoiseCVS or/and TortoiseSVN installed on the system to +work properly. Please refer to these products documentations for help about +using version control systems. + +The structure of the "Jcl Version" menu can be customized in the JCL options +dialog (in the "Tools" menu). + +-------------------------------------------------------------------------------- + +Downloads of stable sources + +These sources are official JCL releases and file status can be considered as +stable for use in final applications. During the past years, there have been +around 2 or 3 releases per year. + +Jedi Code Library: File List on SourceForge: +http://sourceforge.net/project/showfiles.php?group_id=47514 + +-------------------------------------------------------------------------------- + +Development sources + +These files are under active development and may cause some incompatibilities +and some conflicts with existing code. You should not use these files in final +applications. The JCL development team provides these files for testing and +feedback from users. + +You can download snapshots of the CVS repository updated every day in the JCL +daily page + +To always have access to the most recent changes in the JCL, you should install +a CVS client (we recommend TortoiseCVS and WinCVS) and download the CVS +repository files to your computer. With the CVS client, you can update your +local repository at any time. For more instructions on how to set up CVS and use +it with JCL, see the CVS instruction page. You can also access the CVS +repository via the web interface. + +-------------------------------------------------------------------------------- + +Getting involved in JCL development + +If you want to help out making JCL better or bigger or just plain cooler, there +are several ways in which you can help out. Here are some of the things we need +your help on: + - Donate source code + - Donate time writing help + - Donate time writing demos + - Donate time fixing bugs + - Share your experience by helping users in newsgroups and mailing lists + +JCL accepts donations from developers as long as the source fullfills the +requirements set up by the JEDI and JCL teams. To read more about these +requirements, visit the page http://homepages.borland.com/jedi/jcl + +You can also donate your time by writing help for the source already in JCL. We +currently use Doc-o-Matic to create the finished help files but the actual help +sources are plain text files in a simple to understand format. We can provide +you with auto-generated templates with all classes, properties, types etc +already inserted. The "only" thing left to do is fill in the actual help text +for the help items. If you are interested in writing help, contact us. + +If you want to help fix bugs in JCL, go to Mantis and check the bug report +there. You can post replies as well as fixes directly in the bug report. One of +the JCL developers will pick up the report/fix and update the CVS repository if +the fix is satisfactory. If you report and fix a lot of bugs, you might even get +developer access to CVS so you can update the JCL files directly. diff --git a/official/1.96/docs/cps.html b/official/1.96/docs/cps.html new file mode 100644 index 0000000..dc00e61 --- /dev/null +++ b/official/1.96/docs/cps.html @@ -0,0 +1,655 @@ + + + + + Jedi Code Library - Cross Platform Strategy + + +

Jedi Code Library - Cross Platform Strategy

+

+This paper presents the JCL teams strategy for cross platform +compliance of the +Jedi Code Library. It is based up on the discussions within the JCL +newsgroup +and JCL developer mailing lists. This document is currently work in +progress +and subject to changes with or without notice. +

+

+Version history:
+    0.1 Initial release +

+

+

+

Background

+

+The main objective is to make the Jedi Code Library VisualCLX (Kylix +for Delphi/Delphi) and Delphi.NET compatible. For a detailed +explanation of the currently used terminology, see the following +article +Overview of the VCL for .NET.

+

+We have to cope with nearly all aspects of cross platform progamming, +like different APIs, different operating system concepts etc. Since we +want to be as crossplatform compatible as possible interface +compatability is the most important +issue for us. Jedi Code Library users should have to opportunity the +use the JCL +on whatever platform they like. Figure 1 shows the three basic layers +we have to deal with: +

+
    +
  • Platform independent layer: Units which are not (or only very +minor) +platform specific and do not depend on a specific component set. This +doesn't mean that units in this layer have to consist of no platform +dependent code, but they have to +be nearly 100% interface compatible and all functionality must have +been ported to all +supported platforms.
    • +
  • Platform dependent layer: Units which depend on a specific +platform (e.g. JclCLI)
    • +
  • Component set dependent layer: Units which depend on a specific +component set
    • +
+

+
+Fig 1: The Jedi Code Library crossplatform layer structure +

+

+The Jedi Code Library currently targets the following platforms: +

+
    +
  • Kylix for Delphi (Kylix 3) / Linux
    • +
  • Delphi (Version 5,6,7) / Microsoft Windows
    • +
+and is trying to support the following platforms as soon as possible: +
    +
  • Delphi .NET / .NET (Micrsoft Windows)
    • +
+

+As a mid or long term perspective we are hoping to get the JCL +FreePascal compatible. +This involves the possibilty to have the JCL running on DOS, OS/2, +FreeBSD and +AmigaOS.

+

Common platform independent layer

+

+This layer consists of all files which are not platform dependent or +need only very minor adjustations. Furthermore all units in this layer +do not depend on a +specific component set. Examples for common platform independent units +are JclBase, JclDateTime, JclFileUtils and JclMath. The units have been +ported to all platforms and are the crossplatform "core" of the Jedi +Code Library. As a general rule a unit in this layer should have no +platform specific ifdefs in its +interface section. +

+

Platform dependent layer

+

+Furthermore we do not have to differentiate between VCL and VisualCLX +units only (the so called component set dependent layer), but also +between UNIX, Windows and .NET dependent units. The platform dependent +units doesn't need to be interface compatible (if there is an +equivalent in one of the other suported platforms at all!). +An example for a platform dependent unit is JclCLI. Nonetheless if +there are equivalents in all other supported platforms as well it might +be considerable to write a more general class and include that unit +into the common platform indepedant layer. +

+

Component set dependent layer

+

+When it comes to sharing code between VCL and VisualCLX-applications, +some facts need to be stated: +

+

+

+
  • A unit is called VCL-dependent, when it uses some +VCL-unit(s), e.g. Graphics. +
    • +
  • A unit is called VisualCLX-dependent, when it uses some +VisualCLX-unit(s), e.g. QGraphics.
    • +

    +When a unit contains neither VCL- nor VisualCLX-specific code, there is +no problem: It can be used by either type of application. +

    +

    +While it is basically possible to create VCL-dependent and +VisualCLX-dependent +variants of the same unit by means of conditional compilation - and use +them in +VCL- and VisualCLX-applications respectively -, this method fails at +design time: +One and the same unit cannot be installed twice in the IDE, not even as +part of +different packages. We would have to rename one of the variants, +effectively +creating a new unit. Therefor we will use a preprocessor to resolve the +conditional compilation symbols related to VCL/VisualCLX-specific code +and create +VCL/VisualCLX units from a common codebase. +

    +

    +Component dependent units should be largely "interface compatible" - +interface +adjustments for specific component sets are unavoidable - nonetheless +similar +interfaces are desirable. +

    +

    Preprocessor

    +

    +The preprocessor jpp is a modified version of Barry Kelly's ppp tool. +In contrast to ppp, which resolves all conditional compilation +directives without exception, with jpp symbols not only can be defined +but also undefined. Those symbols which are neither defined nor +explicitely undefined are considered +as of unknown status and it and its related source code remains +untouched. +

    +

    +The usage of jpp is not too hard. It is called via +

    +
    jpp [options] <input files>...
    +Possible options are +
      -i       Process includes
      -c       Process conditional directives
      -C       Strip comments
      -pxxx    Add xxx to include path
      -dxxx    Define xxx as a preprocessor conditional symbol
      -uxxx    Assume preprocessor conditional symbol xxx as not defined
      -x[n:]yyy  Strip first n characters from file name; precede filename by prefix yyy
    +

    +The example command line below generates a file JclQGraphics.pas in +subdirectory +CLX from file Graphics.cb located in the current directory. Symbols +"VisualCLX" +and "COMPILER6_UP" are specified as defined, "Bitmap32" and "VCL" as +undefined. +

    +
      jpp -c -dVisualCLX -dCOMPILER6_UP -uBitmap32 -uVCL -xCLX\JclQ Graphics.cb
    +

    Generating Jcl[Q]Graphics.pas and Jcl[Q]GraphUtils.pas

    +

    +First compile Preprocessor\jpp.exe from Preprocessor\jpp.dpr. +Then change to the "Source" directory and type "make" at the command +line. +This will create the units
    +VCL\JclGraphics.pas
    +VCL\JclGraphUtils.pas
    +CLX\JclQGraphics.pas
    +CLX\JclQGraphUtils.pas
    +

    +

    +from their prototypes _Graphics.pas and _GraphUtils.pas. +

    +

    Minimizing VCL dependencies

    +

    +To reduce VCL dependencies in JCL, the following changes have been +made: +

    + +
    +
    JclFileUtils
    +
    PathCompactPath is an overloaded function. The variant which +takes a TCanvas as argument (and thus creates a dependency on VCL unit +Graphics) has been removed.
    +
    +
    +
    +
    JclShell
    +
    ShellLinkGetIcon has been removed. It could get part of some +genuine VCL-dependent unit (e.g. JclGraphUtils), but for now it is left +out.
    +
    +
    +
    +
    JclPEImage
    +
    + 
     Replace "uses Consts," by

        uses
          {$IFDEF COMPILER6_UP}
          RtlConsts,         // VisualCLX-package compatible (part of rtlxx.bpl)
          {$ELSE}
          Consts,            // not VisualCLX-package compatible (part of vclxx.bpl)
          {$ENDIF COMPILER6_UP}
    +
    +
    +     +

    +Note that the first two changes have enormous impact, since many JCL +units use JclFileUtils and JclSysInfo (which both use JclShell). This +leaves JclGraphics and JclGraphUtils as sole units with genuine +VCL/VisualCLX-dependencies. +JclPrint is the only remaining pure VCL-dependent units.

    +

    New directory structure

    +

    +With the new JCL release we introduce a more appropriate source file +directory +structure. The files are now grouped according their respective layers. +

    +
    Source/
      Common
      DotNet
      Unix
      VCL
      VisCLX
      Windows
    +

    Status - Platforms

    +

    +This table gives a short overview of which units are already working +under four different Delphi language compilers/platforms. There are +four status levels possible: +

    +

    + + + + + + + + + + + + + + + + + + + +
    +
    +     		  the unit has been ported to that platform
    -  the unit has not been ported to that platform
     (+) +
    +     		  the unit compiles, but not all of its functionality +has been ported to that platform.
     platform +
    +     		  the unit is platform dependent and will not be ported.
    +

    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
    NameDelphi +(Windows)Kylix +for DelphiDelphi.NETFree +Pascal
    Jcl8087++-?
    JclAppInst+--?
    JclCil+--?
    JclClr+--?
    JclCom+--?
    JclComplex++-?
    JclConsole+--?
    JclCounter++-?
    JclDateTime+(+)-?
    JclDebug+--?
    JclDotNet+--?
    JclEDI++-?
    JclEDISEF++-?
    JclEDIXML++-?
    JclEDI_ANSIX12++-?
    JclEDI_UNEDIFACT++-?
    JclFileUtils+(+)-?
    JclExprEval++
    +     		-?
    JclHookExcept+--?
    JclIniFiles++
    +     		-?
    JclLanMan+--?
    JclLocales+--?
    JclLogic++-?
    JclMapi+--?
    JclMath++-?
    JclMetaData+--?
    JclMidi+--?
    JclMime++-?
    JclMiscel+--?
    JclMultimedia+--?
    JclNTFS+--?
    JclPEImage+--?
    JclPrint+--?
    JclStrHashMap++
    +     		-?
    JclStatistics++-?
    JclShell+--?
    JclSecurity+--?
    JclSchedule++-?
    JclRTTI+--?
    JclResources+--?
    JclRegistry+--?
    JclStrings++-?
    Jclsvcctrl+--?
    Jclsynch+--?
    JclTaskplatform--?
    JclSysUtils+(+)
    +     		-?
    JclSysInfo+(+)
    +     		-?
    JclTD32+--?
    JclUnicode+--?
    JclUnitConv++-?
    JclWin32platform --?
    JclWinMidiplatform --?
    +

    Assembler

    +

    +For crossplatform compatability it is absolutely necessary to reduce +the amount +of inline assembler code used. Therefore as a general rule every line +of assembler +must have a pure pascal pendant. Please use assembler only if it +really has a noticeable impact on the libraries performance.

    +
    {$IFNDEF PUREPASCAL}
      // assembler code here
    {$ELSE}
      // Delphi equivalent here
    {$ENDIF}
    +

    Packages

    + + diff --git a/official/1.96/docs/cps_files/strucv1.jpg b/official/1.96/docs/cps_files/strucv1.jpg new file mode 100644 index 0000000..4c2fddc Binary files /dev/null and b/official/1.96/docs/cps_files/strucv1.jpg differ diff --git a/official/1.96/docs/cps_files/test.css b/official/1.96/docs/cps_files/test.css new file mode 100644 index 0000000..435698a --- /dev/null +++ b/official/1.96/docs/cps_files/test.css @@ -0,0 +1,793 @@ +TD { + font-family : "Arial", "Helvetica", Sans-serif; +} + +PRE.SourceCode2 { + background-color : #e0ffff; + border-width : medium; + border-style : outset; + border-color : silver; + white-space : pre; +} + +PRE.SourceCode EM { + font-style : normal; + color : #9933cc; + white-space : pre; +} + +PRE.SourceCode { + font-family : "Courier", monospace; + background-color : white; + margin-right : 20px; + margin-left : 20px; + padding : 5px 20px; + border-width : medium; + border-style : outset; + border-color : silver; + white-space : pre; +} + +P.chatuser { + font-weight : bold; + color : #3366cc; + vertical-align : top; +} + +P.chatquestionpresented { + font-weight : bold; + background-color : #dddddd; + vertical-align : top; +} + +P.chatpublicmsg { + font-weight : normal; + vertical-align : top; + padding : 0 0 20px; +} + +P.chateditor { + color : red; + padding : 0 0 10px; +} + +P.chataction { + font-style : italic; + vertical-align : top; +} + +P.TechNote { + font-weight : normal; + background-color : #e0ffff; + padding : 2px 5px; + border-width : medium; + border-style : outset; + border-color : silver; +} + +H3 { + font-weight : bold; + font-size : 11pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; +} + +H2 { + font-weight : bold; + font-size : 14pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; +} + +H1 { + font-weight : bold; + font-size : 18pt; + line-height : 18pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; + padding : 10px 0 0; +} + +BODY { + background : #ffffff; + margin-left : 20 px; + margin-right : 20 px;} + +B.Help { + color : white; + background-color : gray; +} + +A:hover { + color : #cc3300; +} + +.webDirectoryLink { + font-size : 0.8em; + font-family : "Arial", "Helvetica", Sans-serif; + color : #3366cc; + text-decoration : underline; +} + +.webDirectoryCategoryLink { + font-size : 0.8em; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; +} + +.webDirectoryCatHead { + font-size : 0.9em; + font-family : "Arial", "Helvetica", Sans-serif; + color : #ffffff; + text-decoration : none; +} + +.vspace5 { + padding : 5px 0 0; +} + +.visibility { + font-weight : bold; + font-size : 0.8em; + font-family : "Arial", "Helvetica", Sans-serif; + color : #ff0000; + text-decoration : none; +} + +.tuser { + color : blue; + background-color : white; +} + +.ttitle { + font-weight : bold; + color : black; + background-color : #dddddd; +} + +.tthis { + font-weight : bold; + line-height : 1; + color : white; + background-color : red; + vertical-align : top; +} + +.tother { + font-weight : bold; + line-height : 1; + color : white; + background-color : blue; + vertical-align : top; +} + +.tmine { + font-weight : bold; + color : black; + background-color : #c71585; +} + +.title3 { + font-weight : bold; + font-size : 12pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; +} + +.thi { + background-color : #dddddd; +} + +.textAdLink { + font-weight : bold; + color : #ffffff; + text-decoration : none; +} + +.textAdCell { + font-size : 0.8em; +} + +.searchCell { + font-weight : bold; + font-size : 11px; +} + +.rightSidebarLink { + color : #000000; + text-decoration : none; +} + +.rightSidebarHeading { + font-weight : bold; + font-size : 10pt; + color : #ffffff; + background : #3366cc; +} + +.rightSidebarCell { + font-weight : bold; + font-size : 10pt; + color : #000000; + background : #dddddd; +} + +.presentLocation { + font-weight : bold; + color : #000000; + text-decoration : none; +} + +.logoCell { + background : #000000; +} + +.logoBar { + background : #000000; +} + +.loginLinkCell { + font-weight : bold; + font-size : 0.8em; + background : #3366cc; +} + +.loginLink { + color : #ffffff; + text-decoration : none; +} + +.loginStd { + text-align : right; +} + +.loginReq { + text-align : right; + font-weight : bold; + color : blue; +} + +.login_std { + text-align : right; +} + +.login_req { + text-align : right; + font-weight : bold; + color : blue; +} + +.locationLink { + color : #000000; + text-decoration : underline; +} + +.localLinkCell { + font-size : 9pt; + color : #ffffff; + background : #3366cc; +} + +.localLink { + font-weight : bold; + color : #ffffff; + text-decoration : none; +} + +.leftSidebarText { + font-weight : normal; + font-size : 9pt; + color : #000000; +} + +.leftSidebarSoapboxLink { + font-weight : normal; + font-size : 10pt; + color : #0000cc; + font-style : italic; + text-decoration : none + +} + +.leftSidebarSoapboxLink:hover { + COLOR: #6666cc; + font-weight : normal; + font-size : 10pt; + font-style : italic; + text-decoration : none + +} + + +.leftSidebarHeading { + font-weight : bold; + font-size : 12pt; + color : #3366cc; +} + +.leftSidebarCell { + font-size : 0.8em; + background : #dddddd; +} + +.heading3 { + font-weight : bold; + font-size : 11pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; + vertical-align: baseline; +} + +.heading2 { + font-weight : bold; + font-size : 14pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; +} + +.heading1 { + font-weight : bold; + font-size : 18pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; + padding : 10px 0 0; +} + +.globalNavBar { + background : #dddddd; +} + +.globalLinkCell { + font-size : 0.8em; + background : #dddddd; +} + +.globalLink { + font-weight : bold; + color : #000000; + text-decoration : none; +} + +.fineprint { + font-weight : normal; + font-size : 8pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; +} + +.directoryStuff { + font-size : 0.8em; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; +} + +.directoryLink { + font-size : 9pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; +} + +.directoryCategory { + font-size : 10pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : underline; +} + +.date3 { + font-weight : normal; + font-size : 9pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; + vertical-align: baseline ; + + } + +.copyrightLink { + color : #000000; + text-decoration : none; +} + +.copyrightCell { + font-size : 7pt; + background : #dddddd; +} + +.contentshortDescription { + font-weight : normal; + font-size : 9pt; + color : #000000; +} + +.contentTableCell { + font-size : 0.8em; + background : #ffffff; +} + +.contentTable { + background : #ffffff; +} + +.contentStoryLink { + color : #3366cc; +} + +.contentStoryHeadingCell { + background : #dddddd; +} + +.contentStoryHeading { + font-weight : normal; + font-size : 11pt; + color : #000000; + text-decoration : none; +} + +.contentStoryByline { + font-style : italic; + font-weight : normal; + font-size : 9pt; + color : #000000; +} + +.contentSectionHeading { + font-weight : bold; + font-size : 12pt; + color : #000000; + text-decoration : none; +} + +.contentRule { + background : #3366cc; +} + +.contentMoreLink { + font-weight : bold; + color : #3366cc; +} + +.contentHat { + font-weight : bold; + font-size : 10pt; + color : #000000; + text-decoration : none; +} + +.contentDevNewsStoryHeading { + font-weight : normal; + font-size : 10pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; +} + +.contentArticleTypeIndex { + font-size : 0.7em; + color : #3366cc; +} + +.body3, blb, bottomlink { + font-weight : normal; + font-size : 11pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; +} + +.blueHeading2 { + font-weight : bold; + font-size : 12pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #003399; + text-decoration : none; +} + +.bigBlue { + font-weight : bold; + font-size : 14pt; + color : #013399; + text-decoration : none; +} + +.abstract { + font-style : italic; + font-weight : normal; + font-size : 10pt; + line-height : 11pt; + font-family : "Arial", "Helvetica", Sans-serif; + color : #000000; + text-decoration : none; + padding : 10px; +} +/* new classes - added 01/11/01 rare medium */ + +.whiteLink { font-size : 10pt; text-decoration : none; color : #ffffff; } + +.whiteLinkB { font-size : 10pt; font-weight : bold; text-decoration : none; color : #ffffff; } + +.whiteLinkSmall { font-size : 9pt; text-decoration : none; color : #ffffff; } +.yellowLinkSmall { font-size : 9pt; font-weight : bold; text-decoration : none; color : #ffdf00; } +.whiteLinkVerySmall { font-size : 8pt; text-decoration : none; color : #ffffff; } + +.newBody { font-weight : normal; font-size : 9pt; font-family : "Arial", "Helvetica", Sans-serif; color : #000000; text-decoration : none; } + +.newTitle { font-weight : bold; font-size : 11pt; font-family : "Arial", "Helvetica", Sans-serif; color : #000000; text-decoration : none; } + +.newDate { font-weight : normal; font-size : 8pt; font-family : "Arial", "Helvetica", Sans-serif; color : #000000; text-decoration : none; margin-top : 3pt; } + +.newHeading { font-weight : bold; font-size : 9pt; font-family : "Arial", "Helvetica", Sans-serif; color : #000000; text-decoration : none; } + +.bigBlack { font-weight : bold; font-size : 14pt; font-family : "Arial", "Helvetica", Sans-serif; color : #000000; text-decoration : none; } + +BODY +{ + MARGINLEFT: 18px +} +/* Changed font size from 12px to 14 px here due to complaints 2002/5/20 Tom Lam */ +TR, TD, P, LAYER { + FONT-SIZE: 14px; + COLOR: #000000; + FONT-FAMILY: arial, helvetica, sans-serif; + TEXT-DECORATION: none; +} + +.newsItem { + FONT-SIZE: 11px; + COLOR: #000000; + FONT-FAMILY: arial, helvetica, sans-serif; + TEXT-DECORATION: none; +} + +A { + COLOR: #0000cc; + TEXT-DECORATION: none; +} + +A: hover { + COLOR: #6666cc; + TEXT-DECORATION: none; +} + +.divider +{ + BACKGROUND: #999999 +} + +.lightBG +{ + BACKGROUND: #cccccc; +} + +.intTopnav { + FONT-SIZE: 12px; + FONT-WEIGHT: bold; + COLOR: #666666; +} + +.intTopnav A { + FONT-SIZE: 12px; + FONT-WEIGHT: bold; + COLOR: #000000; + TEXT-DECORATION: none; +} + +.intTopnav A:hover { + FONT-SIZE: 12px; + FONT-WEIGHT: bold; + COLOR: #666666; + TEXT-DECORATION: underline; +} + +.leftNavTop { + FONT-SIZE: 14px; + FONT-WEIGHT: bold; +} + +.leftNavTop A { + FONT-SIZE: 14px; + FONT-WEIGHT: bold; + COLOR: #0000cc; + TEXT-DECORATION: underline; +} + +.leftNavTop A:hover { + FONT-SIZE: 14px; + FONT-WEIGHT: bold; + COLOR: #6666cc; +} + +.leftNav { + FONT-SIZE: 12px; + COLOR: #666666; + FONT-WEIGHT: bold; +} + +.leftNav A { + FONT-SIZE: 12px; + COLOR: #0000cc; + FONT-WEIGHT: normal; + TEXT-DECORATION: underline; +} + +.leftNav A:hover { + FONT-SIZE: 12px; + COLOR: #6666cc; + FONT-WEIGHT: normal; +} + +.prodList { + FONT-SIZE: 13px; + FONT-WEIGHT: bold; + COLOR: #666666; + TEXT-DECORATION: none; + MARGIN-TOP: -6px; +} + +.prodList A { + COLOR: #666666; + TEXT-DECORATION: none; +} + +.prodList A:hover { + COLOR: #6666cc; + TEXT-DECORATION: underline; +} + +.contentHeader { + FONT-FAMILY: arial, helvetica, sans-serif; + FONT-SIZE: 20px; + FONT-WEIGHT: bold; +} + +.contentHeader A { + COLOR: #000000; + TEXT-DECORATION: underline; +} + +.contentHeader A: hover { + COLOR: #666666; + TEXT-DECORATION: underline; +} + +.contentSubHeader { + FONT-FAMILY: arial, helvetica, sans-serif; + FONT-SIZE: 16px; + FONT-WEIGHT: bold; + MARGIN-BOTTOM: -8px; +} + +.subHeader { + FONT-FAMILY: arial, helvetica, sans-serif; + FONT-SIZE: 16px; + FONT-WEIGHT: bold; +} + +.pressSubHead { + FONT-WEIGHT: bold; + COLOR: #003366; +} + +.bodyLight { + COLOR: #666666; +} + +A.bodyNav1 { + COLOR: #0000cc; + TEXT-DECORATION: underline; +} + +A.bodyNav1:hover { + COLOR: #6666cc; + TEXT-DECORATION: underline; +} + +A.bodyNav2 { + COLOR: #333333; + TEXT-DECORATION: underline; +} + +A.bodyNav2:hover { + COLOR: #003366; + TEXT-DECORATION: underline; +} + +INPUT.TEXT { + font-size: 12px; +} + +.tableHeader { + FONT-SIZE: 11px; + COLOR: #333333; +} + +.footer { + font-size: 11px; + COLOR: #666666; + MARGIN-BOTTOM: 0px; +} + +.footer A { + COLOR: #003366; +} + +.footer A:hover { + COLOR: #006699; +} + +.Menu +{ + VISIBILITY: hidden; + POSITION: absolute; + TOP: 93px; +} + +.Menu TD +{ + FONT-SIZE: 11px; + COLOR: #ffffff; + FONT-FAMILY: arial, helvetica, sans-serif; + TEXT-DECORATION: none; +} + +.Menu A +{ + FONT-SIZE: 11px; + COLOR: #ffffff; + FONT-FAMILY: arial, helvetica, sans-serif; + TEXT-DECORATION: none; +} + +.Menu A:hover +{ + FONT-SIZE: 11px; + COLOR: #cccccc; + FONT-FAMILY: arial, helvetica, sans-serif; + TEXT-DECORATION: none; +} + +.Trigger +{ + POSITION: relative; + TOP: 0px; + LEFT: 0px; +} + +select { + FONT-SIZE: 10px; + COLOR: #000000; + FONT-FAMILY: arial, helvetica, sans-serif; +} + +INPUT.TEXT.srchBox { + FONT-SIZE: 12px; + WIDTH: 116px; +} +A.leftLink { + COLOR: #0000cc; + TEXT-DECORATION: none; +} + +A.leftLink:hover { + COLOR: #6666cc; + TEXT-DECORATION: none; +} + +A.leftLinkB { + COLOR: #000000; + TEXT-DECORATION: none; + FONT-WEIGHT: bold; +} + +.topLinkB { + diff --git a/official/1.96/docs/styles/default.css b/official/1.96/docs/styles/default.css new file mode 100644 index 0000000..feabecf --- /dev/null +++ b/official/1.96/docs/styles/default.css @@ -0,0 +1,34 @@ +body {padding: 0px 0px 0px 26px;background: #ffffff; color: #000000;font-family: Verdana, Arial, Helvetica, sans-serif;font-size: 9pt;} +h1, h2, h3, h4 {font-family: Verdana, Arial, Helvetica, sans-serif;margin-left: -6px;margin-top: .5em;margin-bottom: .5em; } +h1 {font-size: 160%;} +h2 {font-size: 145%;} +h3 {font-size: 130%;} +h4 {font-size: 115%;} +h5 {font-size: 105%;} +hr {align:"right";color:"#000080";noshade;} +ul p, ol p, dl p {margin-left: 0em;} +p {margin-top: .6em;margin-bottom:.6em;} +dl {margin-top: 0em;} +dd {margin-bottom: 0em;margin-left: 1.9em;} +dt {margin-top: .6em; } +ul, ol {margin-top: .6em;margin-bottom: 0em;} +ol {margin-left: 1.9em; } +ul {list-style-type: disc;margin-left: 1.9em; } +li {margin-bottom: .6em;} +ul ol, ol ol {list-style-type: lower-alpha;} +pre {margin-top: .6em;margin-bottom: .6em; } +pre,code {font-family: Courier New, Courier, mono;color: #660000;} +table {background: #999999;margin-top: .6em;margin-bottom: .3em;} +th {padding: 4px 8px;background: #cccccc;text-align: left;font-size: 70%;vertical-align: bottom;height: 25px;} +td {padding: 4px 8px;background: #ffffff;vertical-align: top;font-size: 70%;height: 25px;} +blockquote {margin-left: 3.8em;margin-right: 3.8em;margin-top: .6em;margin-bottom: .6em;} +sup {text-decoration: none;font-size: smaller; } +a:link {color: #0066ff;} +a:visited {color: #0066ff;} +a:hover {color: #cc9900;} +.select {margin-bottom:-4px;border-width: 1px;border-style: solid;width: 400px;} +.input, .textarea {margin-bottom:-4px;border-width: 1px;border-style: solid;width: 400px;} +.submit {background-color: #CCCCCC;border-width: 1px;border-style: solid;} +.reset {background-color: #CCCCCC;border-width: 1px;border-style: solid;} +.button {background-color: #CCCCCC;border-width: 1px;border-style: solid;} +.InfoField {border: 2px solid #AAAAAA;padding: 4px 4px;background: #EFEFEF;} diff --git a/official/1.96/examples/C10.exc b/official/1.96/examples/C10.exc new file mode 100644 index 0000000..72d76da --- /dev/null +++ b/official/1.96/examples/C10.exc @@ -0,0 +1,4 @@ +common\containers\performance\ContainerPerformance.dpr +windows\clr\ClrDemo.dpr +windows\tasks\TaskDemo.dpr +visclx.exc \ No newline at end of file diff --git a/official/1.96/examples/C5.exc b/official/1.96/examples/C5.exc new file mode 100644 index 0000000..6cb972c --- /dev/null +++ b/official/1.96/examples/C5.exc @@ -0,0 +1,2 @@ +windows\clr\ClrDemo.dpr +visclx.exc \ No newline at end of file diff --git a/official/1.96/examples/C6.exc b/official/1.96/examples/C6.exc new file mode 100644 index 0000000..c718820 --- /dev/null +++ b/official/1.96/examples/C6.exc @@ -0,0 +1,3 @@ +windows\clr\ClrDemo.dpr +common\filesearch\QFileSearchDemo.dpr +visclx.exc=STD \ No newline at end of file diff --git a/official/1.96/examples/D10.exc b/official/1.96/examples/D10.exc new file mode 100644 index 0000000..72d76da --- /dev/null +++ b/official/1.96/examples/D10.exc @@ -0,0 +1,4 @@ +common\containers\performance\ContainerPerformance.dpr +windows\clr\ClrDemo.dpr +windows\tasks\TaskDemo.dpr +visclx.exc \ No newline at end of file diff --git a/official/1.96/examples/D5.exc b/official/1.96/examples/D5.exc new file mode 100644 index 0000000..8490c59 --- /dev/null +++ b/official/1.96/examples/D5.exc @@ -0,0 +1,3 @@ +common\containers\performance\ContainerPerformance.dpr +windows\clr\ClrDemo.dpr +visclx.exc \ No newline at end of file diff --git a/official/1.96/examples/D6.exc b/official/1.96/examples/D6.exc new file mode 100644 index 0000000..11d92ed --- /dev/null +++ b/official/1.96/examples/D6.exc @@ -0,0 +1,4 @@ +common\containers\performance\ContainerPerformance.dpr +common\filesearch\QFileSearchDemo.dpr +windows\clr\ClrDemo.dpr +visclx.exc=STD \ No newline at end of file diff --git a/official/1.96/examples/D7.exc b/official/1.96/examples/D7.exc new file mode 100644 index 0000000..11d92ed --- /dev/null +++ b/official/1.96/examples/D7.exc @@ -0,0 +1,4 @@ +common\containers\performance\ContainerPerformance.dpr +common\filesearch\QFileSearchDemo.dpr +windows\clr\ClrDemo.dpr +visclx.exc=STD \ No newline at end of file diff --git a/official/1.96/examples/D9.exc b/official/1.96/examples/D9.exc new file mode 100644 index 0000000..72d76da --- /dev/null +++ b/official/1.96/examples/D9.exc @@ -0,0 +1,4 @@ +common\containers\performance\ContainerPerformance.dpr +windows\clr\ClrDemo.dpr +windows\tasks\TaskDemo.dpr +visclx.exc \ No newline at end of file diff --git a/official/1.96/examples/JclDebugExamples.bdsgroup b/official/1.96/examples/JclDebugExamples.bdsgroup new file mode 100644 index 0000000..c5489e2 --- /dev/null +++ b/official/1.96/examples/JclDebugExamples.bdsgroup @@ -0,0 +1,23 @@ + + + + + + + + + + + + + windows\debug\stacktrack\StackTrackDLLsExample.bdsproj + windows\debug\stacktrack\StackTrackDLLsStaticLibrary.bdsproj + windows\debug\stacktrack\StackTrackDLLsDynamicLibrary.bdsproj + windows\debug\stacktrack\StackTrackDLLsComLibrary.bdsproj + windows\debug\stacktrack\StackTrackExample.bdsproj + StackTrackDLLsExample.exe StackTrackDLLsStaticLibrary.dll StackTrackDLLsDynamicLibrary.dll StackTrackDLLsComLibrary.dll StackTrackExample.exe + + + + diff --git a/official/1.96/examples/JclDebugExamples.bpg b/official/1.96/examples/JclDebugExamples.bpg new file mode 100644 index 0000000..fbf9f71 --- /dev/null +++ b/official/1.96/examples/JclDebugExamples.bpg @@ -0,0 +1,33 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = StackTrackDLLsExample.exe StackTrackDLLsStaticLibrary.dll \ + StackTrackDLLsDynamicLibrary.dll StackTrackDLLsComLibrary.dll StackTrackExample.exe +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +StackTrackDLLsExample.exe: windows\debug\stacktrack\StackTrackDLLsExample.dpr + $(DCC) + +StackTrackDLLsStaticLibrary.dll: windows\debug\stacktrack\StackTrackDLLsStaticLibrary.dpr + $(DCC) + +StackTrackDLLsDynamicLibrary.dll: windows\debug\stacktrack\StackTrackDLLsDynamicLibrary.dpr + $(DCC) + +StackTrackDLLsComLibrary.dll: windows\debug\stacktrack\StackTrackDLLsComLibrary.dpr + $(DCC) + +StackTrackExample.exe: windows\debug\stacktrack\StackTrackExample.dpr + $(DCC) + + diff --git a/official/1.96/examples/common/containers/algorithms/AlgorithmsExample.dof b/official/1.96/examples/common/containers/algorithms/AlgorithmsExample.dof new file mode 100644 index 0000000..c22fe7f --- /dev/null +++ b/official/1.96/examples/common/containers/algorithms/AlgorithmsExample.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=..\..\..\..\bin diff --git a/official/1.96/examples/common/containers/algorithms/AlgorithmsExample.dpr b/official/1.96/examples/common/containers/algorithms/AlgorithmsExample.dpr new file mode 100644 index 0000000..0a39d15 --- /dev/null +++ b/official/1.96/examples/common/containers/algorithms/AlgorithmsExample.dpr @@ -0,0 +1,20 @@ +program AlgorithmsExample; + +{$I jcl.inc} + +uses + {$IFDEF MSWINDOWS} + Forms, + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + QForms, + {$ENDIF LINUX} + AlgorithmsExampleMain in 'AlgorithmsExampleMain.pas' {MainForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/common/containers/algorithms/AlgorithmsExample.res b/official/1.96/examples/common/containers/algorithms/AlgorithmsExample.res new file mode 100644 index 0000000..b111060 Binary files /dev/null and b/official/1.96/examples/common/containers/algorithms/AlgorithmsExample.res differ diff --git a/official/1.96/examples/common/containers/algorithms/AlgorithmsExampleMain.dfm b/official/1.96/examples/common/containers/algorithms/AlgorithmsExampleMain.dfm new file mode 100644 index 0000000..d4a2f7f --- /dev/null +++ b/official/1.96/examples/common/containers/algorithms/AlgorithmsExampleMain.dfm @@ -0,0 +1,251 @@ +object MainForm: TMainForm + Left = 280 + Top = 180 + Width = 392 + Height = 330 + ActiveControl = PageControl1 + Caption = 'Algos' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = 11 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + OldCreateOrder = True + Scaled = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object PageControl1: TPageControl + Left = 0 + Top = 0 + Width = 384 + Height = 303 + ActivePage = tbsApply + Align = alClient + TabOrder = 0 + object tbsApply: TTabSheet + Caption = 'Apply' + object btnApplyGenerate: TButton + Left = 152 + Top = 48 + Width = 75 + Height = 25 + Caption = 'Generate' + TabOrder = 0 + OnClick = btnApplyGenerateClick + end + object btnApply: TButton + Left = 152 + Top = 96 + Width = 75 + Height = 25 + Caption = 'Apply' + TabOrder = 1 + OnClick = btnApplyClick + end + object lbxApply: TListBox + Left = 16 + Top = 48 + Width = 121 + Height = 137 + ItemHeight = 13 + TabOrder = 2 + end + object edtApply: TEdit + Left = 240 + Top = 96 + Width = 121 + Height = 21 + TabOrder = 3 + Text = '4' + end + end + object tbsFind: TTabSheet + Caption = 'Find' + ImageIndex = 1 + object lblFound: TLabel + Left = 152 + Top = 136 + Width = 3 + Height = 13 + end + object btnFindGenerate: TButton + Left = 152 + Top = 48 + Width = 75 + Height = 25 + Caption = 'Generate' + TabOrder = 0 + OnClick = btnFindGenerateClick + end + object btnFind: TButton + Left = 152 + Top = 96 + Width = 75 + Height = 25 + Caption = 'Find' + TabOrder = 1 + OnClick = btnFindClick + end + object lbxFind: TListBox + Left = 16 + Top = 48 + Width = 121 + Height = 137 + ItemHeight = 13 + TabOrder = 2 + end + object edtFind: TEdit + Left = 240 + Top = 96 + Width = 121 + Height = 21 + TabOrder = 3 + end + end + object tbsCountObject: TTabSheet + Caption = 'CountObject' + ImageIndex = 2 + object lblCount: TLabel + Left = 152 + Top = 136 + Width = 6 + Height = 13 + Caption = '0' + end + object btnCountGenerate: TButton + Left = 152 + Top = 48 + Width = 75 + Height = 25 + Caption = 'Generate' + TabOrder = 0 + OnClick = btnCountGenerateClick + end + object btnCount: TButton + Left = 152 + Top = 96 + Width = 75 + Height = 25 + Caption = 'Count' + TabOrder = 1 + OnClick = btnCountClick + end + object lbxCount: TListBox + Left = 16 + Top = 48 + Width = 121 + Height = 137 + ItemHeight = 13 + TabOrder = 2 + end + object edtCount: TEdit + Left = 240 + Top = 96 + Width = 121 + Height = 21 + TabOrder = 3 + end + end + object tbsCopy: TTabSheet + Caption = 'Copy' + ImageIndex = 3 + object btnCopyGenerate: TButton + Left = 136 + Top = 64 + Width = 75 + Height = 25 + Caption = 'Generate' + TabOrder = 0 + OnClick = btnCopyGenerateClick + end + object btnCopy: TButton + Left = 136 + Top = 120 + Width = 75 + Height = 25 + Caption = 'Copy' + TabOrder = 1 + OnClick = btnCopyClick + end + object lbxCopySrc: TListBox + Left = 40 + Top = 56 + Width = 73 + Height = 153 + ItemHeight = 13 + TabOrder = 2 + end + object lbxCopyDes: TListBox + Left = 232 + Top = 56 + Width = 81 + Height = 153 + ItemHeight = 13 + TabOrder = 3 + end + end + object tbsReverse: TTabSheet + Caption = 'Reverse' + ImageIndex = 4 + object btnReverseGenerate: TButton + Left = 176 + Top = 56 + Width = 75 + Height = 25 + Caption = 'Generate' + TabOrder = 0 + OnClick = btnReverseGenerateClick + end + object btnReverse: TButton + Left = 176 + Top = 104 + Width = 75 + Height = 25 + Caption = 'Reverse' + TabOrder = 1 + OnClick = btnReverseClick + end + object lbxReverse: TListBox + Left = 32 + Top = 56 + Width = 121 + Height = 153 + ItemHeight = 13 + TabOrder = 2 + end + end + object tbsSort: TTabSheet + Caption = 'Sort' + ImageIndex = 5 + object btnSortGenerate: TButton + Left = 176 + Top = 56 + Width = 75 + Height = 25 + Caption = 'Generate' + TabOrder = 0 + OnClick = btnSortGenerateClick + end + object btnSort: TButton + Left = 176 + Top = 104 + Width = 75 + Height = 25 + Caption = 'Sort' + TabOrder = 1 + OnClick = btnSortClick + end + object lbxSort: TListBox + Left = 32 + Top = 56 + Width = 121 + Height = 153 + ItemHeight = 13 + TabOrder = 2 + end + end + end +end diff --git a/official/1.96/examples/common/containers/algorithms/AlgorithmsExampleMain.pas b/official/1.96/examples/common/containers/algorithms/AlgorithmsExampleMain.pas new file mode 100644 index 0000000..6c0becf --- /dev/null +++ b/official/1.96/examples/common/containers/algorithms/AlgorithmsExampleMain.pas @@ -0,0 +1,246 @@ +unit AlgorithmsExampleMain; + +interface + +uses + {$IFDEF WIN32} + Windows, Messages, Forms, ComCtrls, Graphics, Controls, + Dialogs, StdCtrls, + {$ENDIF} + {$IFDEF LINUX} + QForms, QStdCtrls, QControls, QComCtrls, + {$ENDIF} + SysUtils, Classes, + JclContainerIntf, JclArrayLists, JclLinkedLists; + +type + TMainForm = class(TForm) + PageControl1: TPageControl; + tbsApply: TTabSheet; + tbsFind: TTabSheet; + tbsCountObject: TTabSheet; + tbsCopy: TTabSheet; + tbsReverse: TTabSheet; + tbsSort: TTabSheet; + btnApplyGenerate: TButton; + btnApply: TButton; + lbxApply: TListBox; + btnFindGenerate: TButton; + btnFind: TButton; + lbxFind: TListBox; + edtFind: TEdit; + btnCountGenerate: TButton; + btnCount: TButton; + lbxCount: TListBox; + edtCount: TEdit; + btnCopyGenerate: TButton; + btnCopy: TButton; + lbxCopySrc: TListBox; + lbxCopyDes: TListBox; + btnReverseGenerate: TButton; + btnReverse: TButton; + lbxReverse: TListBox; + btnSortGenerate: TButton; + btnSort: TButton; + lbxSort: TListBox; + lblFound: TLabel; + lblCount: TLabel; + edtApply: TEdit; + procedure btnApplyGenerateClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure btnApplyClick(Sender: TObject); + procedure btnFindGenerateClick(Sender: TObject); + procedure btnFindClick(Sender: TObject); + procedure btnCountGenerateClick(Sender: TObject); + procedure btnCountClick(Sender: TObject); + procedure btnCopyGenerateClick(Sender: TObject); + procedure btnCopyClick(Sender: TObject); + procedure btnReverseGenerateClick(Sender: TObject); + procedure btnReverseClick(Sender: TObject); + procedure btnSortGenerateClick(Sender: TObject); + procedure btnSortClick(Sender: TObject); + private + public + List: IJclList; + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses JclAlgorithms; + +procedure TMainForm.btnApplyGenerateClick(Sender: TObject); +var + I: Integer; + It: IJclIterator; +begin + List.Clear; + for I := 1 to 10 do + List.Add(TObject(I)); + lbxApply.Items.Clear; + It := List.First; + while It.HasNext do + lbxApply.Items.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + List := TJclArrayList.Create(16, False); +end; + +function Add2(AObject: TObject): TObject; +begin + Result := TObject(Integer(AObject) + 2); +end; + +procedure TMainForm.btnApplyClick(Sender: TObject); +var + It: IJclIterator; + Value: Integer; +begin + Value := StrToIntDef(edtApply.Text, 0); + JclAlgorithms.Apply(List.First, Value, Add2); + lbxApply.Items.Clear; + It := List.First; + while It.HasNext do + lbxApply.Items.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.btnFindGenerateClick(Sender: TObject); +var + I: Integer; + It: IJclIterator; +begin + List.Clear; + for I := 1 to 10 do + List.Add(TObject(I)); + lbxFind.Items.Clear; + It := List.First; + while It.HasNext do + lbxFind.Items.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.btnFindClick(Sender: TObject); +var + It: IJclIterator; + Value: Integer; +begin + Value := StrToIntDef(edtFind.Text, 0); + It := JclAlgorithms.Find(List.First, List.Size, TObject(Value), SimpleCompare); + if It = nil then + lblFound.Caption := 'Not found' + else + lblFound.Caption := 'Found'; +end; + +procedure TMainForm.btnCountGenerateClick(Sender: TObject); +var + I: Integer; + It: IJclIterator; +begin + Randomize; + List.Clear; + for I := 1 to 10 do + List.Add(TObject(Random(10) + 1)); + lbxCount.Items.Clear; + It := List.First; + while It.HasNext do + lbxCount.Items.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.btnCountClick(Sender: TObject); +var + Count: Integer; + Value: Integer; +begin + Value := StrToIntDef(edtCount.Text, 0); + Count := JclAlgorithms.CountObject(List.First, List.Size, TObject(Value), SimpleCompare); + lblCount.Caption := IntToStr(Count); +end; + +procedure TMainForm.btnCopyGenerateClick(Sender: TObject); +var + I: Integer; + It: IJclIterator; +begin + Randomize; + List.Clear; + for I := 1 to 10 do + List.Add(TObject(Random(10) + 1)); + lbxCopySrc.Items.Clear; + It := List.First; + while It.HasNext do + lbxCopySrc.Items.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.btnCopyClick(Sender: TObject); +var + AnotherList: IJclList; + It: IJclIterator; +begin + AnotherList := TJclArrayList.Create(16, False); + JclAlgorithms.Generate(AnotherList, 10, TObject(0)); + JclAlgorithms.Copy(List.First, List.Size, AnotherList.First); + lbxCopyDes.Items.Clear; + It := AnotherList.First; + while It.HasNext do + lbxCopyDes.Items.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.btnReverseGenerateClick(Sender: TObject); +var + I: Integer; + It: IJclIterator; +begin + List.Clear; + for I := 1 to 10 do + List.Add(TObject(I)); + lbxReverse.Items.Clear; + It := List.First; + while It.HasNext do + lbxReverse.Items.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.btnReverseClick(Sender: TObject); +var + It: IJclIterator; +begin + JclAlgorithms.Reverse(List.First, List.Last); + lbxReverse.Items.Clear; + It := List.First; + while It.HasNext do + lbxReverse.Items.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.btnSortGenerateClick(Sender: TObject); +var + I: Integer; + It: IJclIterator; +begin + Randomize; + List.Clear; + for I := 1 to 10 do + List.Add(TObject(Random(10) - 5)); + lbxSort.Items.Clear; + It := List.First; + while It.HasNext do + lbxSort.Items.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.btnSortClick(Sender: TObject); +var + It: IJclIterator; +begin + JclAlgorithms.Sort(List, 0, 9, IntegerCompare); + lbxSort.Items.Clear; + It := List.First; + while It.HasNext do + lbxSort.Items.Add(IntToStr(Integer(It.Next))); +end; + +end. + diff --git a/official/1.96/examples/common/containers/hashing/HashingExample.dof b/official/1.96/examples/common/containers/hashing/HashingExample.dof new file mode 100644 index 0000000..aaf85f5 --- /dev/null +++ b/official/1.96/examples/common/containers/hashing/HashingExample.dof @@ -0,0 +1,76 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir=..\..\..\..\bin +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages= +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1031 +CodePage=1252 diff --git a/official/1.96/examples/common/containers/hashing/HashingExample.dpr b/official/1.96/examples/common/containers/hashing/HashingExample.dpr new file mode 100644 index 0000000..0b9659a --- /dev/null +++ b/official/1.96/examples/common/containers/hashing/HashingExample.dpr @@ -0,0 +1,20 @@ +program HashingExample; + +{$I jcl.inc} + +uses + {$IFDEF MSWINDOWS} + Forms, + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + QForms, + {$ENDIF LINUX} + HashingExampleMain in 'HashingExampleMain.pas' {MainForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/common/containers/hashing/HashingExample.res b/official/1.96/examples/common/containers/hashing/HashingExample.res new file mode 100644 index 0000000..b111060 Binary files /dev/null and b/official/1.96/examples/common/containers/hashing/HashingExample.res differ diff --git a/official/1.96/examples/common/containers/hashing/HashingExampleMain.dfm b/official/1.96/examples/common/containers/hashing/HashingExampleMain.dfm new file mode 100644 index 0000000..4f68676 --- /dev/null +++ b/official/1.96/examples/common/containers/hashing/HashingExampleMain.dfm @@ -0,0 +1,130 @@ +object MainForm: TMainForm + Left = 281 + Top = 201 + Width = 497 + Height = 279 + HorzScrollBar.Range = 476 + VertScrollBar.Range = 209 + ActiveControl = btnIntfIntfHashMap + AutoScroll = False + Caption = 'Hashing Example' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = 11 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + OldCreateOrder = True + Scaled = False + PixelsPerInch = 96 + TextHeight = 13 + object btnIntfIntfHashMap: TButton + Left = 16 + Top = 24 + Width = 89 + Height = 25 + Caption = 'IntfIntfHashMap' + TabOrder = 0 + OnClick = btnIntfIntfHashMapClick + end + object btnIntfHashSet: TButton + Left = 120 + Top = 24 + Width = 75 + Height = 25 + Caption = 'IntfHashSet' + TabOrder = 5 + OnClick = btnIntfHashSetClick + end + object btnHashMap: TButton + Left = 16 + Top = 184 + Width = 89 + Height = 25 + Caption = 'HashMap' + TabOrder = 4 + OnClick = btnHashMapClick + end + object btnHashSet: TButton + Left = 120 + Top = 184 + Width = 75 + Height = 25 + Caption = 'HashSet' + TabOrder = 7 + OnClick = btnHashSetClick + end + object btnStrIntfHashMap: TButton + Left = 16 + Top = 64 + Width = 89 + Height = 25 + Caption = 'StrIntfHashMap' + TabOrder = 1 + OnClick = btnStrIntfHashMapClick + end + object btnIntfArraySet: TButton + Left = 216 + Top = 24 + Width = 75 + Height = 25 + Caption = 'IntfArraySet' + TabOrder = 8 + OnClick = btnIntfArraySetClick + end + object btnArraySet: TButton + Left = 216 + Top = 184 + Width = 75 + Height = 25 + Caption = 'ArraySet' + TabOrder = 10 + OnClick = btnArraySetClick + end + object btnStrStrHashMap: TButton + Left = 16 + Top = 104 + Width = 89 + Height = 25 + Caption = 'StrStrHashMap' + TabOrder = 2 + OnClick = btnStrStrHashMapClick + end + object btnStrHashMap: TButton + Left = 16 + Top = 144 + Width = 89 + Height = 25 + Caption = 'StrHashMap' + TabOrder = 3 + OnClick = btnStrHashMapClick + end + object btnStrHashSet: TButton + Left = 120 + Top = 104 + Width = 73 + Height = 25 + Caption = 'StrHashSet' + TabOrder = 6 + OnClick = btnStrHashSetClick + end + object btnStrArraySet: TButton + Left = 216 + Top = 104 + Width = 73 + Height = 25 + Caption = 'StrArraySet' + TabOrder = 9 + OnClick = btnStrArraySetClick + end + object memResult: TListBox + Left = 304 + Top = 0 + Width = 185 + Height = 248 + Anchors = [akTop, akRight, akBottom] + ItemHeight = 13 + TabOrder = 11 + end +end diff --git a/official/1.96/examples/common/containers/hashing/HashingExampleMain.pas b/official/1.96/examples/common/containers/hashing/HashingExampleMain.pas new file mode 100644 index 0000000..3ee35a7 --- /dev/null +++ b/official/1.96/examples/common/containers/hashing/HashingExampleMain.pas @@ -0,0 +1,335 @@ +unit HashingExampleMain; + +interface + +uses + {$IFDEF WIN32} + Windows, Messages, Graphics, Controls, Forms, Dialogs, StdCtrls, + {$ENDIF} + {$IFDEF LINUX} + QForms, QControls, QStdCtrls, + {$ENDIF} + SysUtils, Classes; + +type + TMainForm = class(TForm) + btnIntfIntfHashMap: TButton; + btnIntfHashSet: TButton; + btnHashMap: TButton; + btnHashSet: TButton; + btnStrIntfHashMap: TButton; + btnIntfArraySet: TButton; + btnArraySet: TButton; + btnStrStrHashMap: TButton; + btnStrHashMap: TButton; + btnStrHashSet: TButton; + btnStrArraySet: TButton; + memResult: TListBox; + procedure btnIntfIntfHashMapClick(Sender: TObject); + procedure btnStrIntfHashMapClick(Sender: TObject); + procedure btnHashMapClick(Sender: TObject); + procedure btnIntfHashSetClick(Sender: TObject); + procedure btnHashSetClick(Sender: TObject); + procedure btnIntfArraySetClick(Sender: TObject); + procedure btnArraySetClick(Sender: TObject); + procedure btnStrStrHashMapClick(Sender: TObject); + procedure btnStrHashMapClick(Sender: TObject); + procedure btnStrHashSetClick(Sender: TObject); + procedure btnStrArraySetClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + + IIntfMyObject = interface + ['{B2CB604F-4F5F-44D8-A86F-6138CD329B42}'] + function GetInt: Integer; + function GetStr: string; + procedure SetInt(Value: Integer); + procedure SetStr(const Value: string); + property Int: Integer read GetInt write SetInt; + property Str: string read GetStr write SetStr; + end; + + TIntfMyObject = class(TInterfacedObject, IIntfMyObject) + private + FInt: Integer; + FStr: string; + protected + { IIntfMyObject } + function GetInt: Integer; + function GetStr: string; + procedure SetInt(Value: Integer); + procedure SetStr(const Value: string); + end; + + TMyObject = class(TObject) + private + FInt: Integer; + FStr: string; + public + property Int: Integer read FInt write FInt; + property Str: string read FStr write FStr; + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses JclContainerIntf, JclHashMaps, JclHashSets, JclArraySets; + +{ TIntfMyObject } + +function TIntfMyObject.GetInt: Integer; +begin + Result := FInt; +end; + +function TIntfMyObject.GetStr: string; +begin + Result := FStr; +end; + +procedure TIntfMyObject.SetInt(Value: Integer); +begin + FInt := Value; +end; + +procedure TIntfMyObject.SetStr(const Value: string); +begin + FStr := Value; +end; + +procedure TMainForm.btnIntfIntfHashMapClick(Sender: TObject); +var + Map: IJclIntfIntfMap; + MyObject: IIntfMyObject; + KeyObject: TInterfacedObject; + It: IJclIntfIterator; +begin + Map := TJclIntfIntfHashMap.Create; + MyObject := TIntfMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + KeyObject := TInterfacedObject.Create; + Map.PutValue(KeyObject, MyObject); + MyObject := IIntfMyObject(Map.GetValue(KeyObject)); + memResult.Items.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + + It := Map.Values.First; + while It.HasNext do + memResult.Items.Add(IIntfMyObject(It.Next).Str); + memResult.Items.Add('--------------------------------------------------------'); +end; + +procedure TMainForm.btnStrIntfHashMapClick(Sender: TObject); +var + Map: IJclStrIntfMap; + MyObject: IIntfMyObject; +begin + Map := TJclStrIntfHashMap.Create; + MyObject := TIntfMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + Map.PutValue('MyKey', MyObject); + MyObject := TIntfMyObject.Create; + MyObject.Int := 43; + MyObject.Str := 'AnotherString'; + Map.PutValue('MyKey2', MyObject); + MyObject := IIntfMyObject(Map.GetValue('MyKey2')); + memResult.Items.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + memResult.Items.Add('--------------------------------------------------------'); +end; + +procedure TMainForm.btnHashMapClick(Sender: TObject); +var + Map: IJclMap; + MyObject: TMyObject; + KeyObject: TObject; + It: IJclIterator; +begin + Map := TJclHashMap.Create; + MyObject := TMyObject.Create; + KeyObject := TObject.Create; + try + MyObject.Int := 42; + MyObject.Str := 'MyString'; + Map.PutValue(KeyObject, MyObject); + MyObject := TMyObject(Map.GetValue(KeyObject)); + memResult.Items.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + It := Map.Values.First; + while It.HasNext do + memResult.Items.Add(TMyObject(It.Next).Str); + memResult.Items.Add('--------------------------------------------------------'); + finally + // MyObject.Free; // Free in the map (Default: OwnsObject = True) + // KeyObject.Free; + end; +end; + +procedure TMainForm.btnIntfHashSetClick(Sender: TObject); +var + MySet: IJclIntfSet; + MyObject: IIntfMyObject; + It: IJclIntfIterator; +begin + MySet := TJclIntfHashSet.Create; + MyObject := TIntfMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + MySet.Add(MyObject); + MySet.Add(MyObject); + It := MySet.First; + while It.HasNext do + memResult.Items.Add(IIntfMyObject(It.Next).Str); + memResult.Items.Add(IntToStr(MySet.Size)); + memResult.Items.Add('--------------------------------------------------------'); +end; + +procedure TMainForm.btnHashSetClick(Sender: TObject); +var + MySet: IJclSet; + MyObject: TMyObject; + It: IJclIterator; +begin + MySet := TJclHashSet.Create; + MyObject := TMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + MySet.Add(MyObject); + MySet.Add(MyObject); + It := MySet.First; + while It.HasNext do + memResult.Items.Add(TMyObject(It.Next).Str); + memResult.Items.Add(IntToStr(MySet.Size)); + memResult.Items.Add('--------------------------------------------------------'); +end; + +procedure TMainForm.btnIntfArraySetClick(Sender: TObject); +var + MySet: IJclIntfSet; + MyObject: IIntfMyObject; + It: IJclIntfIterator; +begin + MySet := TJclIntfArraySet.Create; + MyObject := TIntfMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + MySet.Add(MyObject); + MySet.Add(MyObject); + It := MySet.First; + while It.HasNext do + memResult.Items.Add(IIntfMyObject(It.Next).Str); + memResult.Items.Add(IntToStr(MySet.Size)); + memResult.Items.Add('--------------------------------------------------------'); +end; + +procedure TMainForm.btnArraySetClick(Sender: TObject); +var + MySet: IJclSet; + MyObject: TMyObject; + It: IJclIterator; +begin + MySet := TJclArraySet.Create; + MyObject := TMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + MySet.Add(MyObject); + MySet.Add(MyObject); + It := MySet.First; + while It.HasNext do + memResult.Items.Add(TMyObject(It.Next).Str); + memResult.Items.Add(IntToStr(MySet.Size)); + memResult.Items.Add('--------------------------------------------------------'); +end; + +procedure TMainForm.btnStrStrHashMapClick(Sender: TObject); +var + Map: IJclStrStrMap; + It: IJclStrIterator; +begin + Map := TJclStrStrHashMap.Create; + Map.PutValue('MyKey1', 'MyString1'); + Map.PutValue('MyKey2', 'MyString2'); + Map.PutValue('MyKey3', 'MyString3'); + It := Map.KeySet.First; + while It.HasNext do + memResult.Items.Add(It.Next); + It := Map.Values.First; + while It.HasNext do + memResult.Items.Add(It.Next); + Map.PutValue('MyKey2', 'AnotherString2'); + memResult.Items.Add(Map.GetValue('MyKey2')); + memResult.Items.Add('--------------------------------------------------------'); +end; + +type + TLinks = class(TJclStrHashMap); + +procedure TMainForm.btnStrHashMapClick(Sender: TObject); +var + Map: IJclStrMap; + MyObject: TMyObject; + //It: IJclStrIterator; + Links: TLinks; +begin + Map := TJclStrHashMap.Create; + MyObject := TMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + +{ Map.PutValue('MyKey1', MyObject); + MyObject := TMyObject(Map.GetValue('MyKey1')); + memResult.Items.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + It := Map.KeySet.First; + while It.HasNext do + memResult.Items.Add(It.Next); + memResult.Items.Add('--------------------------------------------------------'); + } + Links := TLinks.Create; + Links.PutValue('MyKey1', MyObject); + Links.Remove('MyKey1'); + Links.PutValue('MyKey1', MyObject); +end; + +procedure TMainForm.btnStrHashSetClick(Sender: TObject); +var + MySet: IJclStrSet; + It: IJclStrIterator; +begin + MySet := TJclStrHashSet.Create; + MySet.Add('MyString'); + MySet.Add('MyString'); + It := MySet.First; + while It.HasNext do + memResult.Items.Add(It.Next); + memResult.Items.Add(IntToStr(MySet.Size)); + memResult.Items.Add('--------------------------------------------------------'); +end; + +procedure TMainForm.btnStrArraySetClick(Sender: TObject); +var + MySet: IJclStrSet; + It: IJclStrIterator; + I: Integer; +begin + MySet := TJclStrArraySet.Create; + for I := 1 to 8 do + MySet.Add(IntToStr(I)); + for I := 8 downto 1 do + MySet.Add(IntToStr(I)); + MySet.Add('MyString'); + MySet.Add('MyString'); + It := MySet.First; + while It.HasNext do + memResult.Items.Add(It.Next); + memResult.Items.Add(IntToStr(MySet.Size)); + memResult.Items.Add('--------------------------------------------------------'); +end; + +end. + diff --git a/official/1.96/examples/common/containers/lists/ListExample.dof b/official/1.96/examples/common/containers/lists/ListExample.dof new file mode 100644 index 0000000..aaf85f5 --- /dev/null +++ b/official/1.96/examples/common/containers/lists/ListExample.dof @@ -0,0 +1,76 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir=..\..\..\..\bin +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages= +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1031 +CodePage=1252 diff --git a/official/1.96/examples/common/containers/lists/ListExample.dpr b/official/1.96/examples/common/containers/lists/ListExample.dpr new file mode 100644 index 0000000..9e97295 --- /dev/null +++ b/official/1.96/examples/common/containers/lists/ListExample.dpr @@ -0,0 +1,21 @@ +program ListExample; + +{$I jcl.inc} + +uses + {$IFDEF MSWINDOWS} + Forms, + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + QForms, + {$ENDIF LINUX} + ListExampleMain in 'ListExampleMain.pas' {MainForm}, + MyObjectList in 'MyObjectList.pas'; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/common/containers/lists/ListExample.res b/official/1.96/examples/common/containers/lists/ListExample.res new file mode 100644 index 0000000..b111060 Binary files /dev/null and b/official/1.96/examples/common/containers/lists/ListExample.res differ diff --git a/official/1.96/examples/common/containers/lists/ListExampleMain.dfm b/official/1.96/examples/common/containers/lists/ListExampleMain.dfm new file mode 100644 index 0000000..fa123dc --- /dev/null +++ b/official/1.96/examples/common/containers/lists/ListExampleMain.dfm @@ -0,0 +1,120 @@ +object MainForm: TMainForm + Left = 276 + Top = 195 + Width = 548 + Height = 276 + HorzScrollBar.Range = 508 + VertScrollBar.Range = 217 + ActiveControl = btnIntfArrayList + AutoScroll = False + Caption = 'List Example' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = 11 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + OldCreateOrder = True + Scaled = False + PixelsPerInch = 96 + TextHeight = 13 + object btnIntfArrayList: TButton + Left = 24 + Top = 24 + Width = 75 + Height = 25 + Caption = 'IntfArrayList' + TabOrder = 0 + OnClick = btnIntfArrayListClick + end + object btnIntfLinkedList: TButton + Left = 152 + Top = 24 + Width = 75 + Height = 25 + Caption = 'IntfLinkedList' + TabOrder = 3 + OnClick = btnIntfLinkedListClick + end + object btnIntfVector: TButton + Left = 272 + Top = 24 + Width = 75 + Height = 25 + Caption = 'IntfVector' + TabOrder = 6 + OnClick = btnIntfVectorClick + end + object btnArrayList: TButton + Left = 24 + Top = 120 + Width = 75 + Height = 25 + Caption = 'ArrayList' + TabOrder = 2 + OnClick = btnArrayListClick + end + object btnLinkedList: TButton + Left = 152 + Top = 120 + Width = 75 + Height = 25 + Caption = 'LinkedList' + TabOrder = 5 + OnClick = btnLinkedListClick + end + object btnVector: TButton + Left = 272 + Top = 120 + Width = 75 + Height = 25 + Caption = 'Vector' + TabOrder = 8 + OnClick = btnVectorClick + end + object memResult: TMemo + Left = 379 + Top = 0 + Width = 161 + Height = 249 + Align = alRight + TabOrder = 10 + end + object btnMyObjectList: TButton + Left = 152 + Top = 192 + Width = 75 + Height = 25 + Caption = 'MyObjectList' + TabOrder = 9 + OnClick = btnMyObjectListClick + end + object btnStrArrayList: TButton + Left = 24 + Top = 72 + Width = 75 + Height = 25 + Caption = 'StrArrayList' + TabOrder = 1 + OnClick = btnStrArrayListClick + end + object btnStrLinkedList: TButton + Left = 152 + Top = 72 + Width = 75 + Height = 25 + Caption = 'StrLinkedList' + TabOrder = 4 + OnClick = btnStrLinkedListClick + end + object btnStrVector: TButton + Left = 272 + Top = 72 + Width = 75 + Height = 25 + Caption = 'StrVector' + TabOrder = 7 + OnClick = btnStrVectorClick + end +end diff --git a/official/1.96/examples/common/containers/lists/ListExampleMain.pas b/official/1.96/examples/common/containers/lists/ListExampleMain.pas new file mode 100644 index 0000000..7828c0d --- /dev/null +++ b/official/1.96/examples/common/containers/lists/ListExampleMain.pas @@ -0,0 +1,475 @@ +unit ListExampleMain; + +interface + +uses + {$IFDEF WIN32} + Windows, Messages, Graphics, Controls, Forms, Dialogs, StdCtrls, + {$ENDIF} + {$IFDEF LINUX} + QForms, QControls, QStdCtrls, + {$ENDIF} + SysUtils, Classes; + +type + TMainForm = class(TForm) + btnIntfArrayList: TButton; + btnIntfLinkedList: TButton; + btnIntfVector: TButton; + btnArrayList: TButton; + btnLinkedList: TButton; + btnVector: TButton; + memResult: TMemo; + btnMyObjectList: TButton; + btnStrArrayList: TButton; + btnStrLinkedList: TButton; + btnStrVector: TButton; + procedure btnIntfArrayListClick(Sender: TObject); + procedure btnIntfLinkedListClick(Sender: TObject); + procedure btnIntfVectorClick(Sender: TObject); + procedure btnArrayListClick(Sender: TObject); + procedure btnLinkedListClick(Sender: TObject); + procedure btnVectorClick(Sender: TObject); + procedure btnMyObjectListClick(Sender: TObject); + procedure btnStrArrayListClick(Sender: TObject); + procedure btnStrLinkedListClick(Sender: TObject); + procedure btnStrVectorClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + + IIntfMyObject = interface + ['{BA33CBCC-9CB2-4672-BF54-F52C2A0BEFFE}'] + function GetInt: Integer; + function GetStr: string; + procedure SetInt(Value: Integer); + procedure SetStr(const Value: string); + property Int: Integer read GetInt write SetInt; + property Str: string read GetStr write SetStr; + end; + + TIntfMyObject = class(TInterfacedObject, IIntfMyObject) + private + FInt: Integer; + FStr: string; + protected + { IIntfMyObject } + function GetInt: Integer; + function GetStr: string; + procedure SetInt(Value: Integer); + procedure SetStr(const Value: string); + end; + + IPerson = interface + ['{755C857B-A9E2-4D9D-8418-541CAEA79679}'] + function GetAge: Integer; + function GetMarried: Boolean; + function GetName: string; + procedure SetAge(Value: Integer); + procedure SetMarried(Value: Boolean); + procedure SetName(const Value: string); + property Age: Integer read GetAge write SetAge; + property Married: Boolean read GetMarried write SetMarried; + property Name: string read GetName write SetName; + end; + + TPerson = class(TInterfacedObject, IPerson) + private + FName: string; + FAge: Integer; + FMarried: Boolean; + protected + { IPerson } + function GetAge: Integer; + function GetMarried: Boolean; + function GetName: string; + procedure SetAge(Value: Integer); + procedure SetMarried(Value: Boolean); + procedure SetName(const Value: string); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses JclContainerIntf, JclArrayLists, JclLinkedLists, JclVectors, MyObjectList; + +{ TIntfMyObject } + +function TIntfMyObject.GetInt: Integer; +begin + Result := FInt; +end; + +function TIntfMyObject.GetStr: string; +begin + Result := FStr; +end; + +procedure TIntfMyObject.SetInt(Value: Integer); +begin + FInt := Value; +end; + +procedure TIntfMyObject.SetStr(const Value: string); +begin + FStr := Value; +end; + +procedure TMainForm.btnIntfArrayListClick(Sender: TObject); +var + List, Sub: IJclIntfList; + MyArray: IJclIntfArray; + MyObject: IIntfMyObject; + It: IJclIntfIterator; + I: Integer; +begin + memResult.Lines.Clear; + List := TJclIntfArrayList.Create; + MyObject := TIntfMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + List.Add(MyObject); + + MyObject := IIntfMyObject(List.GetObject(0)); + //memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + + MyObject := TIntfMyObject.Create; + MyObject.Int := 41; + MyObject.Str := 'AnotherString'; + List.Add(MyObject); + + Sub := List.SubList(0, 10); + + // Iteration + It := Sub.First; + while It.HasNext do + begin + MyObject := IIntfMyObject(It.Next); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + end; + // use [] default of Items[] + MyArray := List as IJclIntfArray; + for I := 0 to MyArray.Size - 1 do + begin + MyObject := IIntfMyObject(MyArray[I]); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + end; +end; + +procedure TMainForm.btnIntfLinkedListClick(Sender: TObject); +var + List, Sub: IJclIntfList; + MyObject: IIntfMyObject; + It: IJclIntfIterator; +begin + memResult.Lines.Clear; + List := TJclIntfLinkedList.Create; + MyObject := TIntfMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + List.Add(MyObject); + MyObject := IIntfMyObject(List.GetObject(0)); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + + MyObject := TIntfMyObject.Create; + MyObject.Int := 41; + MyObject.Str := 'AnotherString'; + List.Add(MyObject); + + Sub := List.SubList(1, 10); + + It := Sub.First; + while It.HasNext do + begin + MyObject := IIntfMyObject(It.Next); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + end; +end; + +procedure TMainForm.btnIntfVectorClick(Sender: TObject); +var + List: TJclIntfVector; + MyObject: IIntfMyObject; + It: IJclIntfIterator; + I: Integer; +begin + memResult.Lines.Clear; + List := TJclIntfVector.Create; + try + MyObject := TIntfMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + List.Add(MyObject); + MyObject := IIntfMyObject(List.GetObject(0)); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + + MyObject := TIntfMyObject.Create; + MyObject.Int := 41; + MyObject.Str := 'AnotherString'; + List.Add(MyObject); + It := List.First; + while It.HasNext do + begin + MyObject := IIntfMyObject(It.Next); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + end; + // Fastest way + for I := 0 to List.Size - 1 do + begin + MyObject := IIntfMyObject(List.Items[I]); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + end; + List.Clear; + finally + It := nil; // Force release Iterator before free list ! + List.Free; // No Ref Count + end; +end; + +procedure TMainForm.btnArrayListClick(Sender: TObject); +var + List: IJclList; + MyObject: TMyObject; + It: IJclIterator; +begin + memResult.Lines.Clear; + List := TJclArrayList.Create; + MyObject := TMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + List.Add(MyObject); + MyObject := TMyObject(List.GetObject(0)); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + + MyObject := TMyObject.Create; + MyObject.Int := 41; + MyObject.Str := 'AnotherString'; + List.Add(MyObject); + + It := List.First; + while It.HasNext do + begin + MyObject := TMyObject(It.Next); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + end; + It := List.First; + while It.HasNext do + It.Remove; +end; + +procedure TMainForm.btnLinkedListClick(Sender: TObject); +var + List: IJclList; + MyObject: TMyObject; + It: IJclIterator; +begin + memResult.Lines.Clear; + List := TJclLinkedList.Create; + MyObject := TMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + List.Add(MyObject); + MyObject := TMyObject(List.GetObject(0)); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + + MyObject := TMyObject.Create; + MyObject.Int := 41; + MyObject.Str := 'AnotherString'; + List.Add(MyObject); + + It := List.First; + while It.HasNext do + begin + MyObject := TMyObject(It.Next); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + end; +end; + +procedure TMainForm.btnVectorClick(Sender: TObject); +var + List: TJclVector; + MyObject: TMyObject; + It: IJclIterator; + I: Integer; +begin + memResult.Lines.Clear; + List := TJclVector.Create; + try + MyObject := TMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + List.Add(MyObject); + MyObject := TMyObject(List.GetObject(0)); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + + MyObject := TMyObject.Create; + MyObject.Int := 41; + MyObject.Str := 'AnotherString'; + List.Add(MyObject); + + It := List.First; + while It.HasNext do + begin + MyObject := TMyObject(It.Next); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + end; + // Fastest way + for I := 0 to List.Size - 1 do + begin + MyObject := TMyObject(List.Items[I]); + memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + end; + List.Clear; + finally + It := nil; // Force release Iterator before free list ! + List.Free; // No ref count + end; +end; + +procedure TMainForm.btnMyObjectListClick(Sender: TObject); +var + List: IMyObjectList; + MyObject: TMyObject; +begin + memResult.Lines.Clear; + List := TMyObjectList.Create; + MyObject := TMyObject.Create; + MyObject.Int := 42; + MyObject.Str := 'MyString'; + List.Add(MyObject); + memResult.Lines.Add(IntToStr(List.GetObject(0).Int)); + memResult.Lines.Add(List.GetObject(0).Str); +end; + +procedure TMainForm.btnStrArrayListClick(Sender: TObject); +var + List, Sub: IJclStrList; + MyArray: IJclStrArray; + It: IJclStrIterator; + I: Integer; + S: string; +begin + memResult.Lines.Clear; + List := TJclStrArrayList.Create; + List.Add('MyString'); + + S := List.GetString(0); + //memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str); + + List.Add('AnotherString'); + + Sub := List.SubList(0, 10); + // Iteration + It := Sub.First; + while It.HasNext do + begin + S := It.Next; + memResult.Lines.Add(S); + end; + // use [] default of Items[] + MyArray := List as IJclStrArray; + for I := 0 to MyArray.Size - 1 do + begin + S := MyArray[I]; + memResult.Lines.Add(S); + end; +end; + +{ TPerson } + +function TPerson.GetAge: Integer; +begin + Result := FAge; +end; + +function TPerson.GetMarried: Boolean; +begin + Result := FMarried; +end; + +function TPerson.GetName: string; +begin + Result := FName; +end; + +procedure TPerson.SetAge(Value: Integer); +begin + FAge := Value; +end; + +procedure TPerson.SetMarried(Value: Boolean); +begin + FMarried := Value; +end; + +procedure TPerson.SetName(const Value: string); +begin + FName := Value; +end; + +procedure TMainForm.btnStrLinkedListClick(Sender: TObject); +var + List, Sub: IJclStrList; + S: string; + It: IJclStrIterator; +begin + memResult.Lines.Clear; + List := TJclStrLinkedList.Create; + List.Add('MyString'); + memResult.Lines.Add(List.GetString(0)); + + List.Add('AnotherString'); + + Sub := List.SubList(1, 10); + + It := Sub.First; + while It.HasNext do + begin + S := It.Next; + memResult.Lines.Add(S); + end; +end; + +procedure TMainForm.btnStrVectorClick(Sender: TObject); +var + List: TJclStrVector; + S: string; + It: IJclStrIterator; + I: Integer; +begin + memResult.Lines.Clear; + List := TJclStrVector.Create; + try + List.Add('MyString'); + S := List.GetString(0); + memResult.Lines.Add(S); + + List.Add('AnotherString'); + + It := List.First; + while It.HasNext do + begin + S := It.Next; + memResult.Lines.Add(S); + end; + // Fastest way + for I := 0 to List.Size - 1 do + begin + S := List.Items[I]; + memResult.Lines.Add(S); + end; + List.Clear; + finally + It := nil; // Force release Iterator before free list ! + List.Free; // No Ref Count + end; +end; + +end. + diff --git a/official/1.96/examples/common/containers/lists/MyObjectList.pas b/official/1.96/examples/common/containers/lists/MyObjectList.pas new file mode 100644 index 0000000..c683497 --- /dev/null +++ b/official/1.96/examples/common/containers/lists/MyObjectList.pas @@ -0,0 +1,134 @@ +unit MyObjectList; + +interface + +uses + JclContainerIntf, JclArrayLists; + +type + TMyObject = class(TObject) + private + FInt: Integer; + FStr: string; + public + property Int: Integer read FInt write FInt; + property Str: string read FStr write FStr; + end; + + // An ArrayList typed with TMyObject + IMyObjectList = interface + ['{DB2B366E-2CA6-4AFC-A2C9-3285D252DC3E}'] + function Add(AObject: TMyObject): Boolean; overload; + function AddAll(ACollection: IJclCollection): Boolean; overload; + procedure Clear; + function Contains(AObject: TMyObject): Boolean; + function ContainsAll(ACollection: IJclCollection): Boolean; + function Equals(ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TMyObject): Boolean; overload; + function RemoveAll(ACollection: IJclCollection): Boolean; + function RetainAll(ACollection: IJclCollection): Boolean; + function Size: Integer; + + procedure Add(Index: Integer; AObject: TMyObject); overload; + function AddAll(Index: Integer; ACollection: IJclCollection): Boolean; overload; + function GetObject(Index: Integer): TMyObject; + function IndexOf(AObject: TMyObject): Integer; + function LastIndexOf(AObject: TMyObject): Integer; + function Remove(Index: Integer): TMyObject; overload; + procedure SetObject(Index: Integer; AObject: TMyObject); + function SubList(First, Count: Integer): IJclList; + end; + + TMyObjectList = class(TJclArrayList, IMyObjectList) + protected + { IJclCollection } + function Add(AObject: TMyObject): Boolean; overload; + function AddAll(ACollection: IJclCollection): Boolean; overload; + procedure IMyObjectList.Clear = Clear; + function Contains(AObject: TMyObject): Boolean; + function IMyObjectList.ContainsAll = ContainsAll; + function IMyObjectList.Equals = Equals; + function IMyObjectList.First = First; + function IMyObjectList.IsEmpty = IsEmpty; + function IMyObjectList.Last = Last; + function Remove(AObject: TMyObject): Boolean; overload; + function IMyObjectList.RemoveAll = RemoveAll; + function IMyObjectList.RetainAll = RetainAll; + function IMyObjectList.Size = Size; + protected + { IJclList } + procedure Add(Index: Integer; AObject: TMyObject); overload; + function AddAll(Index: Integer; ACollection: IJclCollection): Boolean; overload; + function GetObject(Index: Integer): TMyObject; + function IndexOf(AObject: TMyObject): Integer; + function LastIndexOf(AObject: TMyObject): Integer; + function Remove(Index: Integer): TMyObject; overload; + procedure SetObject(Index: Integer; AObject: TMyObject); + function IMyObjectList.SubList = SubList; + end; + +implementation + +{ TMyObjectList } + +procedure TMyObjectList.Add(Index: Integer; AObject: TMyObject); +begin + inherited Insert(Index, AObject); +end; + +function TMyObjectList.Add(AObject: TMyObject): Boolean; +begin + Result := inherited Add(AObject); +end; + +function TMyObjectList.AddAll(ACollection: IJclCollection): Boolean; +begin + Result := inherited AddAll(ACollection); +end; + +function TMyObjectList.AddAll(Index: Integer; + ACollection: IJclCollection): Boolean; +begin + Result := inherited InsertAll(Index, ACollection); +end; + +function TMyObjectList.Contains(AObject: TMyObject): Boolean; +begin +Result := inherited Contains(AObject); +end; + +function TMyObjectList.GetObject(Index: Integer): TMyObject; +begin + Result := TMyObject(inherited GetObject(Index)); +end; + +function TMyObjectList.IndexOf(AObject: TMyObject): Integer; +begin + Result := inherited IndexOf(AObject); +end; + +function TMyObjectList.LastIndexOf(AObject: TMyObject): Integer; +begin + Result := inherited LastIndexOf(AObject); +end; + +function TMyObjectList.Remove(AObject: TMyObject): Boolean; +begin + Result := inherited Remove(AObject); +end; + +function TMyObjectList.Remove(Index: Integer): TMyObject; +begin + Result := TMyObject(inherited Remove(Index)); +end; + +procedure TMyObjectList.SetObject(Index: Integer; AObject: TMyObject); +begin + inherited SetObject(Index, AObject); +end; + +end. + diff --git a/official/1.96/examples/common/containers/performance/ContainerPerformance.dof b/official/1.96/examples/common/containers/performance/ContainerPerformance.dof new file mode 100644 index 0000000..e957ac9 --- /dev/null +++ b/official/1.96/examples/common/containers/performance/ContainerPerformance.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin + diff --git a/official/1.96/examples/common/containers/performance/ContainerPerformance.dpr b/official/1.96/examples/common/containers/performance/ContainerPerformance.dpr new file mode 100644 index 0000000..c142549 --- /dev/null +++ b/official/1.96/examples/common/containers/performance/ContainerPerformance.dpr @@ -0,0 +1,21 @@ +program ContainerPerformance; + +{$I jcl.inc} + +uses + {$IFDEF MSWINDOWS} + Forms, + {$ENDIF MSWINDOWS} + {$IFDEF KYLIX} + QForms, + {$ENDIF KYLIX} + ContainerPerformanceMain in 'ContainerPerformanceMain.pas' {MainForm}, + ContainerPerformanceTests in 'ContainerPerformanceTests.pas'; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/common/containers/performance/ContainerPerformance.res b/official/1.96/examples/common/containers/performance/ContainerPerformance.res new file mode 100644 index 0000000..b111060 Binary files /dev/null and b/official/1.96/examples/common/containers/performance/ContainerPerformance.res differ diff --git a/official/1.96/examples/common/containers/performance/ContainerPerformanceMain.dfm b/official/1.96/examples/common/containers/performance/ContainerPerformanceMain.dfm new file mode 100644 index 0000000..9ff9338 --- /dev/null +++ b/official/1.96/examples/common/containers/performance/ContainerPerformanceMain.dfm @@ -0,0 +1,98 @@ +object MainForm: TMainForm + Left = 402 + Top = 120 + AutoScroll = False + Caption = 'Container Performance' + ClientHeight = 294 + ClientWidth = 569 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = 11 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + Menu = MainMenu1 + OldCreateOrder = True + Scaled = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object ListPerformanceGrid: TStringGrid + Left = 0 + Top = 0 + Width = 569 + Height = 173 + Align = alClient + DefaultColWidth = 100 + RowCount = 6 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine] + TabOrder = 0 + end + object HashPerformanceGrid: TStringGrid + Left = 0 + Top = 173 + Width = 569 + Height = 121 + Align = alBottom + DefaultColWidth = 100 + RowCount = 4 + Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine] + TabOrder = 1 + end + object MainMenu1: TMainMenu + Left = 216 + object FileMenu: TMenuItem + Caption = '&File' + object Exit1: TMenuItem + Caption = 'E&xit' + OnClick = Exit1Click + end + end + object TestMenu: TMenuItem + Caption = '&Test' + object mnList: TMenuItem + Caption = 'TList' + OnClick = mnListClick + end + object mnJclArrayList: TMenuItem + Caption = 'TJclArrayList' + OnClick = mnJclArrayListClick + end + object mnJclLinkedList: TMenuItem + Caption = 'TJclLinkedList' + OnClick = mnJclLinkedListClick + end + object mnJclVector: TMenuItem + Caption = 'TJclVector' + OnClick = mnJclVectorClick + end + object N1: TMenuItem + Caption = '-' + end + object mnBucketList: TMenuItem + Caption = 'TBucketList' + OnClick = mnBucketListClick + end + object mnJclHashMap: TMenuItem + Caption = 'TJclHashMap' + OnClick = mnJclHashMapClick + end + object mnHashedStringList: TMenuItem + Caption = 'THashedStringList' + OnClick = mnHashedStringListClick + end + object mnJclStrStrHashMap: TMenuItem + Caption = 'TJclStrStrHashMap' + OnClick = mnJclStrStrHashMapClick + end + object N2: TMenuItem + Caption = '-' + end + object mnAllTest: TMenuItem + Caption = 'All' + OnClick = mnAllTestClick + end + end + end +end diff --git a/official/1.96/examples/common/containers/performance/ContainerPerformanceMain.pas b/official/1.96/examples/common/containers/performance/ContainerPerformanceMain.pas new file mode 100644 index 0000000..672d893 --- /dev/null +++ b/official/1.96/examples/common/containers/performance/ContainerPerformanceMain.pas @@ -0,0 +1,148 @@ +unit ContainerPerformanceMain; + +{$I jcl.inc} + +interface + +uses + {$IFDEF WIN32} + Windows, Messages, Graphics, Controls, Forms, Dialogs, StdCtrls, + {$ENDIF WIN32} + {$IFDEF LINUX} + QForms, QStdCtrls, QControls, + {$ENDIF LINUX} + SysUtils, Classes, Grids, Menus; + +type + TMainForm = class(TForm) + ListPerformanceGrid: TStringGrid; + MainMenu1: TMainMenu; + FileMenu: TMenuItem; + Exit1: TMenuItem; + TestMenu: TMenuItem; + mnJclArrayList: TMenuItem; + mnList: TMenuItem; + mnJclLinkedList: TMenuItem; + mnJclVector: TMenuItem; + N1: TMenuItem; + mnBucketList: TMenuItem; + mnJclHashMap: TMenuItem; + mnHashedStringList: TMenuItem; + mnJclStrStrHashMap: TMenuItem; + N2: TMenuItem; + mnAllTest: TMenuItem; + HashPerformanceGrid: TStringGrid; + procedure FormCreate(Sender: TObject); + procedure mnAllTestClick(Sender: TObject); + procedure mnListClick(Sender: TObject); + procedure mnJclArrayListClick(Sender: TObject); + procedure mnJclLinkedListClick(Sender: TObject); + procedure mnJclVectorClick(Sender: TObject); + procedure mnBucketListClick(Sender: TObject); + procedure mnJclHashMapClick(Sender: TObject); + procedure mnHashedStringListClick(Sender: TObject); + procedure mnJclStrStrHashMapClick(Sender: TObject); + procedure Exit1Click(Sender: TObject); + public + end; + + TMyObject = class(TInterfacedObject); + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses + ContainerPerformanceTests; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + ListPerformanceGrid.Cells[1, 0] := 'TList'; + ListPerformanceGrid.Cells[2, 0] := 'TJclArrayList'; + ListPerformanceGrid.Cells[3, 0] := 'TJclLinkedList'; + ListPerformanceGrid.Cells[4, 0] := 'TJclVector'; + ListPerformanceGrid.Cells[0, 1] := 'Add'; + ListPerformanceGrid.Cells[0, 2] := 'Next'; + ListPerformanceGrid.Cells[0, 3] := 'Random'; + ListPerformanceGrid.Cells[0, 4] := 'Insert at 10'; + ListPerformanceGrid.Cells[0, 5] := 'Clear'; + + HashPerformanceGrid.Cells[1, 0] := 'TBucketList'; + HashPerformanceGrid.Cells[2, 0] := 'TJclHashMap'; + HashPerformanceGrid.Cells[3, 0] := 'THashedStringList'; + HashPerformanceGrid.Cells[4, 0] := 'TJclStrStrHashMap'; + HashPerformanceGrid.Cells[0, 1] := 'Add'; + HashPerformanceGrid.Cells[0, 2] := 'Random'; + HashPerformanceGrid.Cells[0, 3] := 'Clear'; +end; + +procedure TMainForm.mnAllTestClick(Sender: TObject); +begin + TestList(ListPerformanceGrid.Cols[1]); + Application.ProcessMessages; + TestJclArrayList(ListPerformanceGrid.Cols[2]); + Application.ProcessMessages; + TestJclLinkedList(ListPerformanceGrid.Cols[3]); + Application.ProcessMessages; + TestJclVector(ListPerformanceGrid.Cols[4]); + Application.ProcessMessages; + + TestBucketList(HashPerformanceGrid.Cols[1]); + Application.ProcessMessages; + TestJclHashMap(HashPerformanceGrid.Cols[2]); + Application.ProcessMessages; + TestHashedStringList(HashPerformanceGrid.Cols[3]); + Application.ProcessMessages; + TestJclStrStrHashMap(HashPerformanceGrid.Cols[4]); +end; + +procedure TMainForm.mnListClick(Sender: TObject); +begin + TestList(ListPerformanceGrid.Cols[1]); +end; + +procedure TMainForm.mnJclArrayListClick(Sender: TObject); +begin + TestJclArrayList(ListPerformanceGrid.Cols[2]); +end; + +procedure TMainForm.mnJclLinkedListClick(Sender: TObject); +begin + TestJclLinkedList(ListPerformanceGrid.Cols[3]); +end; + +procedure TMainForm.mnJclVectorClick(Sender: TObject); +begin + TestJclVector(ListPerformanceGrid.Cols[4]); +end; + +procedure TMainForm.mnBucketListClick(Sender: TObject); +begin + TestBucketList(HashPerformanceGrid.Cols[1]); +end; + +procedure TMainForm.mnJclHashMapClick(Sender: TObject); +begin + TestJclHashMap(HashPerformanceGrid.Cols[2]); +end; + +procedure TMainForm.mnHashedStringListClick(Sender: TObject); +begin + TestHashedStringList(HashPerformanceGrid.Cols[3]); +end; + +procedure TMainForm.mnJclStrStrHashMapClick(Sender: TObject); +begin + TestJclStrStrHashMap(HashPerformanceGrid.Cols[4]); +end; + +procedure TMainForm.Exit1Click(Sender: TObject); +begin + Close; +end; + +end. + diff --git a/official/1.96/examples/common/containers/performance/ContainerPerformanceTests.pas b/official/1.96/examples/common/containers/performance/ContainerPerformanceTests.pas new file mode 100644 index 0000000..3ed09c8 --- /dev/null +++ b/official/1.96/examples/common/containers/performance/ContainerPerformanceTests.pas @@ -0,0 +1,325 @@ +unit ContainerPerformanceTests; + +interface + +uses + Classes; + +procedure TestList(Results: TStrings); +procedure TestJclArrayList(Results: TStrings); +procedure TestJclLinkedList(Results: TStrings); +procedure TestJclVector(Results: TStrings); + +procedure TestBucketList(Results: TStrings); +procedure TestJclHashMap(Results: TStrings); +procedure TestHashedStringList(Results: TStrings); +procedure TestJclStrStrHashMap(Results: TStrings); + +implementation + +{$I jcl.inc} + +uses + SysUtils, Forms, Controls, Math, + {$IFDEF RTL140_UP} + Contnrs, IniFiles, + {$ENDIF RTL140_UP} + JclContainerIntf, JclArrayLists, JclLinkedLists, JclHashMaps, JclVectors; + +const + ResultFormat = '%.1f ms'; + MsecsPerDay = 24 * 60 * 60 * 1000; + +{$IFNDEF RTL140_UP} +const + SNeedRTL140Up = 'requires RTL > 14.0'; +{$ENDIF ~RTL140_UP} + +procedure TestList(Results: TStrings); +var + List: TList; + I, res: Integer; + Start: TDateTime; +begin + Randomize; + Start := Now; + List := TList.Create; + Screen.Cursor := crHourGlass; + try + for I := 0 to 2000000 do + List.Add(Pointer(I)); + Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to List.Count - 1 do + Res := Integer(List[I]); + Results[2] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 200 do + Res := List.IndexOf(Pointer(Random(1000000))); + Results[3] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 100 do + List.Insert(10, Pointer(I)); + Results[4] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + List.Clear; + Results[5] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + finally + List.Free; + Screen.Cursor := crDefault; + end; +end; + +procedure TestJclArrayList(Results: TStrings); +var + List: IJclList; + It: IJclIterator; + I, Res: Integer; + Start: TDateTime; +begin + Randomize; + Screen.Cursor := crHourGlass; + try + Start := Now; + List := TJclArrayList.Create(16, False); + for I := 0 to 2000000 do + List.Add(TObject(I)); + Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + // Fast but Specific ArrayList + //for I := 0 to List.Size - 1 do + // Res := Integer(List.GetObject(I)); + // Slower but same for every IJclList + It := List.First; + while It.HasNext do + I := Integer(It.Next); + Results[2] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 200 do + Res := List.IndexOf(TObject(Random(1000000))); + Results[3] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + It := List.First; + for I := 0 to 10 do + It.Next; + for I := 0 to 100 do + It.Add(TObject(I)); + Results[4] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + List.Clear; + Results[5] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TestJclLinkedList(Results: TStrings); +var + List: IJclList; + I, Res: Integer; + It: IJclIterator; + Start: TDateTime; +begin + Randomize; + Screen.Cursor := crHourGlass; + try + Start := Now; + List := TJclLinkedList.Create(nil, False); + for I := 0 to 2000000 do + List.Add(TObject(I)); + Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + It := List.First; + while It.HasNext do + I := Integer(It.Next); + Results[2] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 200 do + Res := List.IndexOf(TObject(Random(1000000))); + Results[3] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + It := List.First; + for I := 0 to 10 do + It.Next; + for I := 0 to 100 do + It.Add(TObject(I)); + Results[4] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + List.Clear; + Results[5] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TestJclVector(Results: TStrings); +var + List: TJclVector; + I, res: Integer; + Start: TDateTime; +begin + Randomize; + Screen.Cursor := crHourGlass; + Start := Now; + List := TJclVector.Create(16, False); + try + for I := 0 to 2000000 do + List.Add(TObject(I)); + Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to List.Size - 1 do + Res := Integer(List.Items[I]); + Results[2] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 200 do + Res := List.IndexOf(TObject(Random(1000000))); + Results[3] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 10 do + begin + System.Move(List.Items[10], List.Items[10 + 1], + (List.Size - 10) * SizeOf(TObject)); + List.Items[10] := TObject(I); + end; + Results[4] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + List.Clear; + Results[5] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + finally + List.Free; + Screen.Cursor := crDefault; + end; +end; + +procedure TestBucketList(Results: TStrings); +{$IFDEF RTL140_UP} +var + I, Res: Integer; + Start: TDateTime; + List: TBucketList; +begin + Randomize; + Screen.Cursor := crHourGlass; + Start := Now; + List := TBucketList.Create(bl256); + try + for I := 0 to 100000 do + List.Add(TObject(I), TObject(I)); + Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 100000 do + Res := Integer(List.Data[TObject(Random(100000))]); + Results[2] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + List.Clear; + Results[3] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + finally + List.Free; + Screen.Cursor := crDefault; + end; +end; +{$ELSE ~RTL140_UP} +var + I: Integer; +begin + for I := 1 to 3 do + Results[I] := SNeedRTL140Up; +end; +{$ENDIF ~RTL140_UP} + +procedure TestJclHashMap(Results: TStrings); +var + Map: IJclMap; + I, Res: Integer; + Start: TDateTime; +begin + Randomize; + Screen.Cursor := crHourGlass; + try + Start := Now; + Map := JclHashMaps.TJclHashMap.Create(256, False); + for I := 0 to 100000 do + Map.PutValue(TObject(Random(100000)), TObject(I)); + Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 100000 do + Res := Integer(Map.GetValue(TObject(Random(100000)))); + Results[2] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + Map.Clear; + Results[3] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + finally + Screen.Cursor := crDefault; + end; +end; + +function GenId(Value: Integer): string; +begin + Result := IntToStr(Value); +end; + +procedure TestHashedStringList(Results: TStrings); +{$IFDEF RTL140_UP} +var + I: Integer; + Index: Integer; + List: THashedStringList; + Start: TDateTime; +begin + Randomize; + Screen.Cursor := crHourGlass; + Start := Now; + List := THashedStringList.Create; + try + for I := 0 to 100000 do + List.Add(GenId(123)); + Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 100000 do + Index := List.IndexOf(GenId(123)); + Results[2] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + List.Clear; + Results[3] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + finally + List.Free; + Screen.Cursor := crDefault; + end; +end; +{$ELSE ~RTL140_UP} +var + I: Integer; +begin + for I := 1 to 3 do + Results[I] := SNeedRTL140Up; +end; +{$ENDIF ~RTL140_UP} + +procedure TestJclStrStrHashMap(Results: TStrings); +var + Map: IJclStrStrMap; + I: Integer; + Res: string; + Start: TDateTime; +begin + Randomize; + Screen.Cursor := crHourGlass; + try + Start := Now; + Map := TJclStrStrHashMap.Create(256); + for I := 0 to 100000 do + Map.PutValue(GenId(123), ''); + Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + for I := 0 to 100000 do + Res := Map.GetValue(GenId(123)); + Results[2] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + Start := Now; + Map.Clear; + Results[3] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]); + finally + Screen.Cursor := crDefault; + end; +end; + +end. diff --git a/official/1.96/examples/common/containers/trees/TreeExample.dof b/official/1.96/examples/common/containers/trees/TreeExample.dof new file mode 100644 index 0000000..c22fe7f --- /dev/null +++ b/official/1.96/examples/common/containers/trees/TreeExample.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=..\..\..\..\bin diff --git a/official/1.96/examples/common/containers/trees/TreeExample.dpr b/official/1.96/examples/common/containers/trees/TreeExample.dpr new file mode 100644 index 0000000..cb51838 --- /dev/null +++ b/official/1.96/examples/common/containers/trees/TreeExample.dpr @@ -0,0 +1,20 @@ +program TreeExample; + +{$I jcl.inc} + +uses + {$IFDEF MSWINDOWS} + Forms, + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + QForms, + {$ENDIF LINUX} + TreeExampleMain in 'TreeExampleMain.pas' {MainForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/common/containers/trees/TreeExample.res b/official/1.96/examples/common/containers/trees/TreeExample.res new file mode 100644 index 0000000..b38c22a Binary files /dev/null and b/official/1.96/examples/common/containers/trees/TreeExample.res differ diff --git a/official/1.96/examples/common/containers/trees/TreeExampleMain.dfm b/official/1.96/examples/common/containers/trees/TreeExampleMain.dfm new file mode 100644 index 0000000..3402019 --- /dev/null +++ b/official/1.96/examples/common/containers/trees/TreeExampleMain.dfm @@ -0,0 +1,53 @@ +object MainForm: TMainForm + Left = 328 + Top = 237 + Width = 470 + Height = 295 + Caption = 'Binary Tree' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + PixelsPerInch = 96 + TextHeight = 13 + object btnIntfArrayTree: TButton + Left = 72 + Top = 24 + Width = 81 + Height = 25 + Caption = 'IntfBinaryTree' + TabOrder = 1 + OnClick = btnIntfArrayTreeClick + end + object memoResult: TMemo + Left = 230 + Top = 0 + Width = 232 + Height = 268 + Align = alRight + ScrollBars = ssVertical + TabOrder = 2 + end + object btnArrayTree: TButton + Left = 72 + Top = 152 + Width = 81 + Height = 25 + Caption = 'BinaryTree' + TabOrder = 0 + OnClick = btnArrayTreeClick + end + object btnStrBinaryTree: TButton + Left = 72 + Top = 88 + Width = 81 + Height = 25 + Caption = 'StrBinaryTree' + TabOrder = 3 + OnClick = btnStrBinaryTreeClick + end +end diff --git a/official/1.96/examples/common/containers/trees/TreeExampleMain.pas b/official/1.96/examples/common/containers/trees/TreeExampleMain.pas new file mode 100644 index 0000000..77e50f3 --- /dev/null +++ b/official/1.96/examples/common/containers/trees/TreeExampleMain.pas @@ -0,0 +1,142 @@ +unit TreeExampleMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, JclBase; + +type + TMainForm = class(TForm) + btnIntfArrayTree: TButton; + memoResult: TMemo; + btnArrayTree: TButton; + btnStrBinaryTree: TButton; + procedure btnIntfArrayTreeClick(Sender: TObject); + procedure btnArrayTreeClick(Sender: TObject); + procedure btnStrBinaryTreeClick(Sender: TObject); + public + end; + + IIntfInteger = interface + ['{0E32C3C9-5940-4373-B3BA-644473E3F3C2}'] + function GetValue: Integer; + procedure SetValue(AValue: Integer); + property Value: Integer read GetValue write SetValue; + end; + + TIntfInteger = class(TInterfacedObject, IIntfInteger) + private + FValue: Integer; + function GetValue: Integer; + procedure SetValue(AValue: Integer); + public + constructor Create(AValue: Integer); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses + JclContainerIntf, JclAlgorithms, JclBinaryTrees; + +{ TIntfInteger } + +constructor TIntfInteger.Create(AValue: Integer); +begin + inherited Create; + FValue := AValue; +end; + +function TIntfInteger.GetValue: Integer; +begin + Result := FValue; +end; + +procedure TIntfInteger.SetValue(AValue: Integer); +begin + FValue := AValue; +end; + +function IntfIntegerComparator(AIntf1, AIntf2: IInterface): Integer; +begin + Result := (AIntf1 as IIntfInteger).Value - (AIntf2 as IIntfInteger).Value; +end; + +procedure TMainForm.btnIntfArrayTreeClick(Sender: TObject); +var + Tree: IJclIntfTree; + I: Integer; + Obj: IIntfInteger; + It: IJclIntfIterator; +begin + memoResult.Lines.Clear; + Tree := TJclIntfBinaryTree.Create(IntfIntegerComparator); + for I := 0 to 17 do + begin + Obj := TIntfInteger.Create(I); + Tree.Add(Obj); + end; + + if Tree.Contains(TIntfInteger.Create(15)) then + memoResult.Lines.Add('contains 15'); + + Tree.TraverseOrder := toPostOrder; + It := Tree.Last; + while It.HasPrevious do + begin + Obj := It.Previous as IIntfInteger; + memoResult.Lines.Add(IntToStr(Obj.Value)); + end; + + It := Tree.First; + while It.HasNext do + It.Remove; +end; + +procedure TMainForm.btnArrayTreeClick(Sender: TObject); +var + Tree: IJclTree; + I: Integer; + It: IJclIterator; +begin + memoResult.Lines.Clear; + Tree := TJclBinaryTree.Create(JclAlgorithms.IntegerCompare); + for I := 0 to 17 do + Tree.Add(TObject(I)); + + if Tree.Contains(TObject(15)) then + memoResult.Lines.Add('contains 15'); + + Tree.TraverseOrder := toOrder; + It := Tree.First; + while It.HasNext do + memoResult.Lines.Add(IntToStr(Integer(It.Next))); +end; + +procedure TMainForm.btnStrBinaryTreeClick(Sender: TObject); +var + Tree: IJclStrTree; + I: Integer; + It: IJclStrIterator; +begin + memoResult.Lines.Clear; + Tree := TJclStrBinaryTree.Create(JclAlgorithms.StrSimpleCompare); + for I := 0 to 17 do + Tree.Add(Format('%.2d', [I])); + + if Tree.Contains('15') then + memoResult.Lines.Add('contains 15'); + + Tree.TraverseOrder := toOrder; + It := Tree.First; + while It.HasNext do + memoResult.Lines.Add(It.Next); +end; + +end. + diff --git a/official/1.96/examples/common/expreval/ExprEvalExample.dof b/official/1.96/examples/common/expreval/ExprEvalExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/common/expreval/ExprEvalExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/common/expreval/ExprEvalExample.dpr b/official/1.96/examples/common/expreval/ExprEvalExample.dpr new file mode 100644 index 0000000..e3271cd --- /dev/null +++ b/official/1.96/examples/common/expreval/ExprEvalExample.dpr @@ -0,0 +1,16 @@ +program ExprEvalExample; + +uses + Forms, + ExprEvalExampleMain in 'ExprEvalExampleMain.pas' {Form1}, + JclExprEval in '..\..\..\source\common\JclExprEval.pas', + JclStrHashMap in '..\..\..\source\common\JclStrHashMap.pas', + ExprEvalExampleLogic in 'ExprEvalExampleLogic.pas'; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/common/expreval/ExprEvalExample.res b/official/1.96/examples/common/expreval/ExprEvalExample.res new file mode 100644 index 0000000..ff24fa7 Binary files /dev/null and b/official/1.96/examples/common/expreval/ExprEvalExample.res differ diff --git a/official/1.96/examples/common/expreval/ExprEvalExampleLogic.pas b/official/1.96/examples/common/expreval/ExprEvalExampleLogic.pas new file mode 100644 index 0000000..7c258ec --- /dev/null +++ b/official/1.96/examples/common/expreval/ExprEvalExampleLogic.pas @@ -0,0 +1,105 @@ +unit ExprEvalExampleLogic; + +interface + +uses + SysUtils, Classes, JclExprEval; + +procedure Init(Evaluator: TEasyEvaluator; FuncList: TStrings); +function ResultAsText(Evaluator: TEvaluator; const Input: string): string; + +implementation + +uses + JclMath; + +procedure Init(Evaluator: TEasyEvaluator; FuncList: TStrings); +begin + with Evaluator do + begin + // Constants + AddConst('Pi', Pi); + + // Functions + AddFunc('LogBase10', LogBase10); + AddFunc('LogBase2', LogBase2); + AddFunc('LogBaseN', LogBaseN); + AddFunc('ArcCos', ArcCos); + AddFunc('ArcCot', ArcCot); + AddFunc('ArcCsc', ArcCsc); + AddFunc('ArcSec', ArcSec); + AddFunc('ArcSin', ArcSin); + AddFunc('ArcTan', ArcTan); + AddFunc('ArcTan2', ArcTan2); + AddFunc('Cos', Cos); + AddFunc('Cot', Cot); + AddFunc('Coversine', Coversine); + AddFunc('Csc', Csc); + AddFunc('Exsecans', Exsecans); + AddFunc('Haversine', Haversine); + AddFunc('Sec', Sec); + AddFunc('Sin', Sin); + AddFunc('Tan', Tan); + AddFunc('Versine', Versine); + AddFunc('ArcCosH', ArcCosH); + AddFunc('ArcCotH', ArcCotH); + AddFunc('ArcCscH', ArcCscH); + AddFunc('ArcSecH', ArcSecH); + AddFunc('ArcSinH', ArcSinH); + AddFunc('ArcTanH', ArcTanH); + AddFunc('CosH', CosH); + AddFunc('CotH', CotH); + AddFunc('CscH', CscH); + AddFunc('SecH', SecH); + AddFunc('SinH', SinH); + AddFunc('TanH', TanH); + end; + with FuncList do + begin + Add('LogBase10'); + Add('LogBase2'); + Add('LogBaseN'); + Add('ArcCos'); + Add('ArcCot'); + Add('ArcCsc'); + Add('ArcSec'); + Add('ArcSin'); + Add('ArcTan'); + Add('ArcTan2'); + Add('Cos'); + Add('Cot'); + Add('Coversine'); + Add('Csc'); + Add('Exsecans'); + Add('Haversine'); + Add('Sec'); + Add('Sin'); + Add('Tan'); + Add('Versine'); + Add('ArcCosH'); + Add('ArcCotH'); + Add('ArcCscH'); + Add('ArcSecH'); + Add('ArcSinH'); + Add('ArcTanH'); + Add('CosH'); + Add('CotH'); + Add('CscH'); + Add('SecH'); + Add('SinH'); + Add('TanH'); + end; +end; + +function ResultAsText(Evaluator: TEvaluator; const Input: string): string; +begin + try + Result := FloatToStr(Evaluator.Evaluate(Input)); + except + on E: Exception do + Result := E.Message; + end; +end; + + +end. diff --git a/official/1.96/examples/common/expreval/ExprEvalExampleMain.dfm b/official/1.96/examples/common/expreval/ExprEvalExampleMain.dfm new file mode 100644 index 0000000..1f6858b --- /dev/null +++ b/official/1.96/examples/common/expreval/ExprEvalExampleMain.dfm @@ -0,0 +1,71 @@ +object Form1: TForm1 + Left = 222 + Top = 107 + Width = 487 + Height = 357 + Caption = 'JclExprEval Example' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 12 + Top = 12 + Width = 54 + Height = 13 + Caption = 'E&xpression:' + FocusControl = ExpressionInput + end + object Label2: TLabel + Left = 12 + Top = 40 + Width = 49 + Height = 13 + Caption = 'Functions:' + end + object ExpressionInput: TEdit + Left = 80 + Top = 8 + Width = 305 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + end + object Memo1: TMemo + Left = 0 + Top = 60 + Width = 479 + Height = 270 + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 1 + end + object EnterButton: TButton + Left = 396 + Top = 8 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'Evaluate' + Default = True + TabOrder = 2 + OnClick = EnterButtonClick + end + object FuncList: TComboBox + Left = 80 + Top = 36 + Width = 145 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + Sorted = True + TabOrder = 3 + OnClick = FuncListClick + end +end diff --git a/official/1.96/examples/common/expreval/ExprEvalExampleMain.pas b/official/1.96/examples/common/expreval/ExprEvalExampleMain.pas new file mode 100644 index 0000000..ec090c4 --- /dev/null +++ b/official/1.96/examples/common/expreval/ExprEvalExampleMain.pas @@ -0,0 +1,67 @@ +unit ExprEvalExampleMain; + +interface + +uses + Windows, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, + JclExprEval; + +type + TForm1 = class(TForm) + ExpressionInput: TEdit; + Memo1: TMemo; + Label1: TLabel; + EnterButton: TButton; + FuncList: TComboBox; + Label2: TLabel; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure EnterButtonClick(Sender: TObject); + procedure FuncListClick(Sender: TObject); + private + { Private declarations } + FEvaluator: TEasyEvaluator; + FX: Extended; + FY: Extended; + FZ: Extended; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +uses + ExprEvalExampleLogic; + +procedure TForm1.FormCreate(Sender: TObject); +begin + FEvaluator := TEvaluator.Create; + FEvaluator.AddVar('X', FX); + FEvaluator.AddVar('Y', FY); + FEvaluator.AddVar('Z', FZ); + Init(FEvaluator, FuncList.Items); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + FEvaluator.Free; +end; + +procedure TForm1.EnterButtonClick(Sender: TObject); +begin + Memo1.Lines.Add(ResultAsText(FEvaluator as TEvaluator, ExpressionInput.Text)); +end; + +procedure TForm1.FuncListClick(Sender: TObject); +begin + ExpressionInput.Text := ExpressionInput.Text + FuncList.Text; + ActiveControl := ExpressionInput; + ExpressionInput.SelStart := Length(ExpressionInput.Text); +end; + +end. diff --git a/official/1.96/examples/common/expreval/QExprEvalExample.dof b/official/1.96/examples/common/expreval/QExprEvalExample.dof new file mode 100644 index 0000000..abe45c2 --- /dev/null +++ b/official/1.96/examples/common/expreval/QExprEvalExample.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=..\..\..\bin diff --git a/official/1.96/examples/common/expreval/QExprEvalExample.dpr b/official/1.96/examples/common/expreval/QExprEvalExample.dpr new file mode 100644 index 0000000..fdb0edf --- /dev/null +++ b/official/1.96/examples/common/expreval/QExprEvalExample.dpr @@ -0,0 +1,16 @@ +program QExprEvalExample; + +uses + QForms, + JclExprEval in '..\..\..\source\common\JclExprEval.pas', + JclStrHashMap in '..\..\..\source\common\JclStrHashMap.pas', + ExprEvalExampleLogic in 'ExprEvalExampleLogic.pas', + QExprEvalExampleMain in 'QExprEvalExampleMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/common/expreval/QExprEvalExample.res b/official/1.96/examples/common/expreval/QExprEvalExample.res new file mode 100644 index 0000000..ff24fa7 Binary files /dev/null and b/official/1.96/examples/common/expreval/QExprEvalExample.res differ diff --git a/official/1.96/examples/common/expreval/QExprEvalExampleMain.pas b/official/1.96/examples/common/expreval/QExprEvalExampleMain.pas new file mode 100644 index 0000000..7faab6e --- /dev/null +++ b/official/1.96/examples/common/expreval/QExprEvalExampleMain.pas @@ -0,0 +1,62 @@ +unit QExprEvalExampleMain; + +interface + +uses + Types, SysUtils, Classes, + QGraphics, QControls, QForms, QStdCtrls, + JclExprEval; + +type + TForm1 = class(TForm) + ExpressionInput: TEdit; + Memo1: TMemo; + Label1: TLabel; + EnterButton: TButton; + FuncList: TComboBox; + Label2: TLabel; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure EnterButtonClick(Sender: TObject); + procedure FuncListClick(Sender: TObject); + private + { Private declarations } + FEvaluator: TEvaluator; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.XFM} + +uses + ExprEvalExampleLogic; + +procedure TForm1.FormCreate(Sender: TObject); +begin + FEvaluator := TEvaluator.Create; + Init(FEvaluator, FuncList.Items); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + FEvaluator.Free; +end; + +procedure TForm1.EnterButtonClick(Sender: TObject); +begin + Memo1.Lines.Add(ResultAsText(FEvaluator, ExpressionInput.Text)); +end; + +procedure TForm1.FuncListClick(Sender: TObject); +begin + ExpressionInput.Text := ExpressionInput.Text + FuncList.Text; + ActiveControl := ExpressionInput; + ExpressionInput.SelStart := Length(ExpressionInput.Text); +end; + +end. diff --git a/official/1.96/examples/common/expreval/QExprEvalExampleMain.xfm b/official/1.96/examples/common/expreval/QExprEvalExampleMain.xfm new file mode 100644 index 0000000..a4eb14d --- /dev/null +++ b/official/1.96/examples/common/expreval/QExprEvalExampleMain.xfm @@ -0,0 +1,71 @@ +object Form1: TForm1 + Left = 222 + Top = 107 + Width = 487 + Height = 357 + Caption = 'JclExprEval Example' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 12 + Top = 12 + Width = 54 + Height = 13 + Caption = 'E&xpression:' + FocusControl = ExpressionInput + end + object Label2: TLabel + Left = 12 + Top = 40 + Width = 44 + Height = 13 + Caption = 'Functions:' + end + object ExpressionInput: TEdit + Left = 80 + Top = 8 + Width = 305 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + end + object Memo1: TMemo + Left = 0 + Top = 60 + Width = 479 + Height = 270 + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 1 + end + object EnterButton: TButton + Left = 396 + Top = 8 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'Evaluate' + Default = True + TabOrder = 2 + OnClick = EnterButtonClick + end + object FuncList: TComboBox + Left = 80 + Top = 36 + Width = 145 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + Sorted = True + TabOrder = 3 + OnClick = FuncListClick + end +end diff --git a/official/1.96/examples/common/filesearch/QFileSearchDemo.dof b/official/1.96/examples/common/filesearch/QFileSearchDemo.dof new file mode 100644 index 0000000..d447a0b --- /dev/null +++ b/official/1.96/examples/common/filesearch/QFileSearchDemo.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=../../../bin diff --git a/official/1.96/examples/common/filesearch/QFileSearchDemo.dpr b/official/1.96/examples/common/filesearch/QFileSearchDemo.dpr new file mode 100644 index 0000000..f819345 --- /dev/null +++ b/official/1.96/examples/common/filesearch/QFileSearchDemo.dpr @@ -0,0 +1,13 @@ +program QFileSearchDemo; + +uses + QForms, + QFileSearchDemoMain in 'QFileSearchDemoMain.pas' {FileSearchForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TFileSearchForm, FileSearchForm); + Application.Run; +end. diff --git a/official/1.96/examples/common/filesearch/QFileSearchDemo.res b/official/1.96/examples/common/filesearch/QFileSearchDemo.res new file mode 100644 index 0000000..ff24fa7 Binary files /dev/null and b/official/1.96/examples/common/filesearch/QFileSearchDemo.res differ diff --git a/official/1.96/examples/common/filesearch/QFileSearchDemoMain.dfm b/official/1.96/examples/common/filesearch/QFileSearchDemoMain.dfm new file mode 100644 index 0000000..d398aef --- /dev/null +++ b/official/1.96/examples/common/filesearch/QFileSearchDemoMain.dfm @@ -0,0 +1,353 @@ +object FileSearchForm: TFileSearchForm + Left = 258 + Top = 301 + Width = 787 + Height = 508 + HorzScrollBar.Range = 378 + VertScrollBar.Range = 252 + ActiveControl = StartBtn + AutoScroll = False + Caption = 'File Search Demo (TJclFileEnumerator)' + Color = clBtnFace + Constraints.MinHeight = 279 + Constraints.MinWidth = 647 + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlack + Font.Height = 12 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + OldCreateOrder = True + Position = poDefaultPosOnly + Scaled = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object StatusBar: TStatusBar + Left = 0 + Top = 460 + Width = 779 + Height = 21 + Panels = < + item + Alignment = taRightJustify + Width = 100 + end + item + Alignment = taRightJustify + Width = 100 + end + item + Width = 50 + end> + end + object FileList: TListView + Left = 0 + Top = 181 + Width = 779 + Height = 279 + Align = alClient + Columns = < + item + Caption = 'File' + Width = 360 + end + item + Alignment = taRightJustify + AutoSize = True + Caption = 'Size' + end + item + Alignment = taCenter + AutoSize = True + Caption = 'Time' + end + item + Caption = 'Attr.' + Width = 60 + end> + ReadOnly = True + TabOrder = 1 + ViewStyle = vsReport + OnColumnClick = FileListColumnClick + end + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 779 + Height = 49 + Align = alTop + BevelOuter = bvNone + TabOrder = 2 + object Label1: TLabel + Left = 14 + Top = 14 + Width = 16 + Height = 13 + Caption = 'List' + end + object Label2: TLabel + Left = 216 + Top = 14 + Width = 29 + Height = 13 + Caption = 'files in' + end + object RootDirInput: TEdit + Left = 256 + Top = 10 + Width = 248 + Height = 21 + TabOrder = 1 + end + object StartBtn: TButton + Left = 524 + Top = 10 + Width = 61 + Height = 25 + Caption = 'Start' + TabOrder = 2 + OnClick = StartBtnClick + end + object StopBtn: TButton + Left = 596 + Top = 10 + Width = 61 + Height = 25 + Caption = 'Stop' + Enabled = False + TabOrder = 3 + OnClick = StopBtnClick + end + object DetailsBtn: TButton + Left = 668 + Top = 10 + Width = 77 + Height = 25 + Caption = 'More >>' + TabOrder = 4 + OnClick = DetailsBtnClick + end + object FileMaskInput: TEdit + Left = 40 + Top = 10 + Width = 169 + Height = 21 + TabOrder = 0 + Text = '*' + end + end + object DetailsPanel: TPanel + Left = 0 + Top = 49 + Width = 779 + Height = 132 + Align = alTop + BevelOuter = bvNone + TabOrder = 3 + Visible = False + object GroupBox1: TGroupBox + Left = 256 + Top = 0 + Width = 249 + Height = 121 + Caption = 'File attributes' + TabOrder = 0 + object cbReadOnly: TCheckBox + Tag = 1 + Left = 16 + Top = 16 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Read only' + State = cbGrayed + TabOrder = 0 + OnClick = cbFileAttributeClick + end + object cbHidden: TCheckBox + Tag = 2 + Left = 16 + Top = 40 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Hidden' + TabOrder = 1 + OnClick = cbFileAttributeClick + end + object cbSystem: TCheckBox + Tag = 4 + Left = 16 + Top = 64 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'System' + TabOrder = 2 + OnClick = cbFileAttributeClick + end + object cbDirectory: TCheckBox + Tag = 16 + Left = 16 + Top = 88 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Directory' + TabOrder = 3 + OnClick = cbFileAttributeClick + end + object cbSymLink: TCheckBox + Tag = 64 + Left = 136 + Top = 16 + Width = 101 + Height = 21 + AllowGrayed = True + Caption = 'Symbolic link' + State = cbGrayed + TabOrder = 4 + OnClick = cbFileAttributeClick + end + object cbNormal: TCheckBox + Tag = 128 + Left = 136 + Top = 88 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Normal' + State = cbGrayed + TabOrder = 7 + OnClick = cbFileAttributeClick + end + object cbArchive: TCheckBox + Tag = 32 + Left = 136 + Top = 16 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Archive' + State = cbGrayed + TabOrder = 5 + OnClick = cbFileAttributeClick + end + object cbVolumeID: TCheckBox + Tag = 8 + Left = 136 + Top = 40 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Volume ID' + TabOrder = 6 + OnClick = cbFileAttributeClick + end + end + object cbLastChangeAfter: TCheckBox + Left = 524 + Top = 12 + Width = 131 + Height = 30 + Caption = 'Last change after' + TabOrder = 1 + end + object edLastChangeAfter: TEdit + Left = 656 + Top = 16 + Width = 113 + Height = 21 + MaxLength = 10 + TabOrder = 2 + end + object cbLastChangeBefore: TCheckBox + Left = 524 + Top = 36 + Width = 131 + Height = 30 + Caption = 'Last change before' + TabOrder = 3 + end + object edLastChangeBefore: TEdit + Left = 656 + Top = 40 + Width = 113 + Height = 21 + MaxLength = 10 + TabOrder = 4 + end + object cbFileSizeMax: TCheckBox + Left = 524 + Top = 60 + Width = 131 + Height = 30 + Caption = 'Maximum size' + TabOrder = 5 + end + object edFileSizeMax: TEdit + Left = 656 + Top = 64 + Width = 113 + Height = 21 + TabOrder = 6 + Text = '$7FFFFFFFFFFFFFFF' + end + object cbFileSizeMin: TCheckBox + Left = 524 + Top = 84 + Width = 131 + Height = 30 + Caption = 'Minimum size' + TabOrder = 7 + end + object edFileSizeMin: TEdit + Left = 656 + Top = 88 + Width = 113 + Height = 21 + TabOrder = 8 + Text = '0' + end + object IncludeSubDirectories: TCheckBox + Left = 40 + Top = 18 + Width = 157 + Height = 17 + Caption = 'Include sub directories' + Checked = True + State = cbChecked + TabOrder = 9 + OnClick = UpdateIncludeHiddenSubDirs + end + object IncludeHiddenSubDirs: TCheckBox + Left = 40 + Top = 42 + Width = 201 + Height = 17 + Caption = 'Include hidden sub directories' + TabOrder = 10 + OnClick = IncludeHiddenSubDirsClick + end + object cbDisplayLiveUpdate: TCheckBox + Left = 40 + Top = 90 + Width = 189 + Height = 17 + Caption = '&Display live update' + Checked = True + State = cbChecked + TabOrder = 12 + end + object cbCaseInsensitiveSearch: TCheckBox + Left = 40 + Top = 66 + Width = 177 + Height = 17 + Caption = 'Case insensitive search' + TabOrder = 11 + end + end +end diff --git a/official/1.96/examples/common/filesearch/QFileSearchDemoMain.pas b/official/1.96/examples/common/filesearch/QFileSearchDemoMain.pas new file mode 100644 index 0000000..204ce43 --- /dev/null +++ b/official/1.96/examples/common/filesearch/QFileSearchDemoMain.pas @@ -0,0 +1,280 @@ +// +// Robert Rossmair, 2003 +// +unit QFileSearchDemoMain; + +{$INCLUDE jcl.inc} + +interface + +uses + SysUtils, Classes, + Types, Qt, QGraphics, QStdCtrls, QControls, QExtCtrls, QComCtrls, QForms, QMask, + JclStrings, JclFileUtils, QDialogs; + +type + TFileSearchForm = class(TForm) + StatusBar: TStatusBar; + FileList: TListView; + Panel1: TPanel; + Label1: TLabel; + RootDirInput: TEdit; + StartBtn: TButton; + StopBtn: TButton; + Label2: TLabel; + DetailsPanel: TPanel; + GroupBox1: TGroupBox; + cbReadOnly: TCheckBox; + cbHidden: TCheckBox; + cbSystem: TCheckBox; + cbDirectory: TCheckBox; + cbSymLink: TCheckBox; + cbNormal: TCheckBox; + cbArchive: TCheckBox; + DetailsBtn: TButton; + FileMaskInput: TEdit; + cbLastChangeAfter: TCheckBox; + edLastChangeAfter: TEdit; + cbLastChangeBefore: TCheckBox; + edLastChangeBefore: TEdit; + cbFileSizeMax: TCheckBox; + edFileSizeMax: TEdit; + cbFileSizeMin: TCheckBox; + edFileSizeMin: TEdit; + IncludeSubDirectories: TCheckBox; + IncludeHiddenSubDirs: TCheckBox; + cbDisplayLiveUpdate: TCheckBox; + cbCaseInsensitiveSearch: TCheckBox; + SaveBtn: TButton; + SaveDialog: TSaveDialog; + procedure StartBtnClick(Sender: TObject); + procedure StopBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FileListColumnClick(Sender: TObject; Column: TListColumn); + procedure cbFileAttributeClick(Sender: TObject); + procedure UpdateIncludeHiddenSubDirs(Sender: TObject); + procedure IncludeHiddenSubDirsClick(Sender: TObject); + procedure DetailsBtnClick(Sender: TObject); + procedure SaveBtnClick(Sender: TObject); + private + { Private declarations } + FFileEnumerator: TJclFileEnumerator; + FDirCount: Integer; + FColumnIndex: Integer; + FTaskID: TFileSearchTaskID; + FT0: TDateTime; + FSortDirection: TSortDirection; + FFileListLiveUpdate: Boolean; + procedure DirectoryEntered(const Directory: string); + procedure AddFile(const Directory: string; const FileInfo: TSearchRec); + procedure TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean); + end; + +var + FileSearchForm: TFileSearchForm; + +implementation + +{$R *.xfm} + +procedure TFileSearchForm.FormCreate(Sender: TObject); +begin + FFileEnumerator := TJclFileEnumerator.Create; + FFileEnumerator.OnEnterDirectory := DirectoryEntered; + FFileEnumerator.OnTerminateTask := TaskDone; + FileMaskInput.Text := '*.pas;*.dfm;*.xfm;*.dpr;*.dpk*'; + RootDirInput.Text := ExpandFileName(FFileEnumerator.RootDirectory); + edLastChangeAfter.Text := FFileEnumerator.LastChangeAfterAsString; + edLastChangeBefore.Text := FFileEnumerator.LastChangeBeforeAsString; + cbCaseInsensitiveSearch.Checked := not FFileEnumerator.CaseSensitiveSearch; + {$IFDEF MSWINDOWS} + cbSymLink.Visible := False; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + FileList.Columns.Add.Caption := 'Link'; + cbArchive.Visible := False; + {$ENDIF UNIX} +end; + +procedure TFileSearchForm.FormDestroy(Sender: TObject); +begin + FFileEnumerator.Free; + { + FileList.Items.BeginUpdate; + FileList.Items.Clear; + FileList.Items.EndUpdate; + } +end; + +procedure TFileSearchForm.DirectoryEntered(const Directory: string); +begin + Inc(FDirCount); + StatusBar.Panels[0].Text := Format('%d files', [FileList.Items.Count]); + StatusBar.Panels[1].Text := Format('%d directories', [FDirCount]); + StatusBar.Panels[2].Text := Format('Processing %s...', [Directory]); +end; + +procedure TFileSearchForm.AddFile(const Directory: string; const FileInfo: TSearchRec); +var + ListItem: TListItem; + S: string; +begin + ListItem := FileList.Items.Add; + with ListItem do + begin + Caption := Directory + FileInfo.Name; + Str(GetSizeOfFile(FileInfo):13, S); + SubItems.Add(S); + SubItems.Add(FormatDateTime(' yyyy-mm-dd hh:nn:ss ', FileDateToDateTime(FileInfo.Time))); + SubItems.Add(FileAttributesStr(FileInfo)); + {$IFDEF UNIX} + if (FileInfo.Attr and faSymLink) <> 0 then + SubItems.Add(SymbolicLinkTarget(Caption)); + {$ENDIF UNIX} + SubItems.Add(FileGetOwnerName(Caption)); + SubItems.Add(FileGetGroupName(Caption)); + end; +end; + +procedure TFileSearchForm.TaskDone(const ID: TFileSearchTaskID; const Aborted: Boolean); +begin + if not FFileListLiveUpdate then + FileList.Items.EndUpdate; + StatusBar.Panels[0].Text := Format('%d files', [FileList.Items.Count]); + if Aborted then + StatusBar.Panels[2].Text := 'Prematurely aborted.' + else + StatusBar.Panels[2].Text := Format('...finished (%f seconds).', [(Now - FT0) * SecsPerDay]); + FileList.Sorted := True; + StartBtn.Enabled := True; + SaveBtn.Enabled := True; + StopBtn.Enabled := False; + ActiveControl := StartBtn; +end; + +procedure TFileSearchForm.StartBtnClick(Sender: TObject); +begin + RootDirInput.Text := PathCanonicalize(RootDirInput.Text); + + FFileEnumerator.SearchOption[fsLastChangeAfter] := cbLastChangeAfter.Checked; + FFileEnumerator.SearchOption[fsLastChangeBefore] := cbLastChangeBefore.Checked; + if FFileEnumerator.SearchOption[fsLastChangeAfter] then + FFileEnumerator.LastChangeAfterAsString := edLastChangeAfter.Text; + if FFileEnumerator.SearchOption[fsLastChangeBefore] then + FFileEnumerator.LastChangeBeforeAsString := edLastChangeBefore.Text; + FFileEnumerator.RootDirectory := RootDirInput.Text; + FFileEnumerator.FileMask := FileMaskInput.Text; + FFileEnumerator.SearchOption[fsMinSize] := cbFileSizeMin.Checked; + FFileEnumerator.SearchOption[fsMaxSize] := cbFileSizeMax.Checked; + FFileEnumerator.FileSizeMin := StrToInt64(edFileSizeMin.Text); + FFileEnumerator.FileSizeMax := StrToInt64(edFileSizeMax.Text); + FFileEnumerator.IncludeSubDirectories := IncludeSubDirectories.Checked; + FFileEnumerator.IncludeHiddenSubDirectories := IncludeHiddenSubDirs.Checked; + FFileEnumerator.CaseSensitiveSearch := not cbCaseInsensitiveSearch.Checked; + FDirCount := 0; + + StartBtn.Enabled := False; + StopBtn.Enabled := True; + SaveBtn.Enabled := False; + ActiveControl := StopBtn; + + FFileListLiveUpdate := cbDisplayLiveUpdate.Checked; + + FileList.Items.Clear; + if not FFileListLiveUpdate then + FileList.Items.BeginUpdate; + FileList.Sorted := False; + + FT0 := Now; + FTaskID := FFileEnumerator.ForEach(AddFile); +end; + +procedure TFileSearchForm.StopBtnClick(Sender: TObject); +begin + FFileEnumerator.StopTask(FTaskID); +end; + +procedure TFileSearchForm.FileListColumnClick(Sender: TObject; Column: TListColumn); +const + SD: array[TSortDirection] of TSortDirection = (sdDescending, sdAscending); +begin + if FColumnIndex = Column.Index then + begin + FSortDirection := SD[FSortDirection]; + FileList.SortDirection := FSortDirection; + end + else + FColumnIndex := Column.Index; +end; + +procedure TFileSearchForm.cbFileAttributeClick(Sender: TObject); +const + Interest: array[TCheckBoxState] of TAttributeInterest = (aiRejected, aiRequired, aiIgnored); + CBState: array[TAttributeInterest] of TCheckBoxState = (cbGrayed, cbUnchecked, cbChecked); +begin + with FFileEnumerator.AttributeMask do + begin + with Sender as TCheckBox do + Attribute[Tag] := Interest[State]; + cbReadOnly.State := CBState[ReadOnly]; + cbHidden.State := CBState[Hidden]; + cbSystem.State := CBState[System]; + cbDirectory.State := CBState[Directory]; + cbNormal.State := CBState[Normal]; +{$IFDEF UNIX} + cbSymLink.State := CBState[SymLink]; +{$ENDIF def UNIX} +{$IFDEF MSWINDOWS} + cbArchive.State := CBState[Archive]; +{$ENDIF def MSWINDOWS} + end; +end; + +procedure TFileSearchForm.UpdateIncludeHiddenSubDirs(Sender: TObject); +begin + IncludeHiddenSubDirs.AllowGrayed := not IncludeSubDirectories.Checked; + if IncludeSubDirectories.Checked then + begin + if IncludeHiddenSubDirs.State = cbGrayed then + IncludeHiddenSubDirs.State := cbChecked; + end + else + begin + if IncludeHiddenSubDirs.State = cbChecked then + IncludeHiddenSubDirs.State := cbGrayed; + end; +end; + +procedure TFileSearchForm.IncludeHiddenSubDirsClick(Sender: TObject); +begin + if not IncludeSubDirectories.Checked then + if IncludeHiddenSubDirs.State = cbChecked then + IncludeHiddenSubDirs.State := cbUnchecked; +end; + +procedure TFileSearchForm.DetailsBtnClick(Sender: TObject); +const + DetailsBtnCaptions: array[Boolean] of string = ('More >>', 'Less <<'); +begin + DetailsPanel.Visible := not DetailsPanel.Visible; + DetailsBtn.Caption := DetailsBtnCaptions[DetailsPanel.Visible]; +end; + +procedure TFileSearchForm.SaveBtnClick(Sender: TObject); +var + I: Integer; +begin + if SaveDialog.Execute then + with TStringList.Create do + try + for I := 0 to FileList.Items.Count - 1 do + Add(FileList.Items[I].Caption); + SaveToFile(SaveDialog.FileName); + finally + Free; + end; +end; + +end. + diff --git a/official/1.96/examples/common/filesearch/QFileSearchDemoMain.xfm b/official/1.96/examples/common/filesearch/QFileSearchDemoMain.xfm new file mode 100644 index 0000000..a8a3330 --- /dev/null +++ b/official/1.96/examples/common/filesearch/QFileSearchDemoMain.xfm @@ -0,0 +1,378 @@ +object FileSearchForm: TFileSearchForm + Left = 267 + Top = 302 + Width = 787 + Height = 509 + VertScrollBar.Range = 252 + HorzScrollBar.Range = 378 + ActiveControl = StartBtn + AutoScroll = False + Caption = 'File Search Demo (TJclFileEnumerator)' + Color = clButton + Constraints.MinHeight = 279 + Constraints.MinWidth = 647 + Font.Color = clBlack + Font.Height = 12 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentFont = False + Position = poDefaultPosOnly + Scaled = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + object StatusBar: TStatusBar + Left = 0 + Top = 488 + Width = 787 + Height = 21 + Panels = < + item + Alignment = taRightJustify + Width = 100 + end + item + Alignment = taRightJustify + Width = 100 + end + item + end> + end + object FileList: TListView + Left = 0 + Top = 181 + Width = 787 + Height = 307 + Align = alClient + Columns = < + item + Caption = 'File' + Tag = 0 + Width = 360 + end + item + Alignment = taRightJustify + AutoSize = True + Caption = 'Size' + Tag = 0 + Width = 50 + end + item + Alignment = taCenter + AutoSize = True + Caption = 'Time' + Tag = 0 + Width = 50 + end + item + Caption = 'Attr.' + Tag = 0 + Width = 60 + end + item + Caption = 'Owner' + Tag = 0 + Width = 100 + end + item + Caption = 'Group' + Tag = 0 + Width = 50 + end> + ReadOnly = True + ShowColumnSortIndicators = True + Sorted = True + TabOrder = 1 + ViewStyle = vsReport + OnColumnClick = FileListColumnClick + end + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 787 + Height = 49 + Align = alTop + BevelOuter = bvNone + TabOrder = 2 + object Label1: TLabel + Left = 14 + Top = 14 + Width = 16 + Height = 13 + Caption = 'List' + end + object Label2: TLabel + Left = 216 + Top = 14 + Width = 29 + Height = 13 + Caption = 'files in' + end + object RootDirInput: TEdit + Left = 256 + Top = 10 + Width = 248 + Height = 21 + TabOrder = 1 + end + object StartBtn: TButton + Left = 524 + Top = 10 + Width = 47 + Height = 25 + Caption = 'Start' + TabOrder = 2 + OnClick = StartBtnClick + end + object StopBtn: TButton + Left = 576 + Top = 10 + Width = 47 + Height = 25 + Caption = 'Stop' + Enabled = False + TabOrder = 3 + OnClick = StopBtnClick + end + object DetailsBtn: TButton + Left = 692 + Top = 10 + Width = 77 + Height = 25 + Caption = 'More >>' + TabOrder = 5 + OnClick = DetailsBtnClick + end + object FileMaskInput: TEdit + Left = 40 + Top = 10 + Width = 169 + Height = 21 + TabOrder = 0 + Text = '*' + end + object SaveBtn: TButton + Left = 628 + Top = 10 + Width = 47 + Height = 25 + Caption = 'Save...' + Enabled = False + TabOrder = 4 + OnClick = SaveBtnClick + end + end + object DetailsPanel: TPanel + Left = 0 + Top = 49 + Width = 787 + Height = 132 + Align = alTop + BevelOuter = bvNone + TabOrder = 3 + Visible = False + object GroupBox1: TGroupBox + Left = 256 + Top = 0 + Width = 249 + Height = 121 + Caption = 'File attributes' + TabOrder = 0 + object cbReadOnly: TCheckBox + Tag = 1 + Left = 16 + Top = 16 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Read only' + Checked = True + State = cbGrayed + TabOrder = 0 + OnClick = cbFileAttributeClick + end + object cbHidden: TCheckBox + Tag = 2 + Left = 16 + Top = 40 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Hidden' + TabOrder = 1 + OnClick = cbFileAttributeClick + end + object cbSystem: TCheckBox + Tag = 4 + Left = 16 + Top = 64 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'System' + TabOrder = 2 + OnClick = cbFileAttributeClick + end + object cbDirectory: TCheckBox + Tag = 16 + Left = 16 + Top = 88 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Directory' + TabOrder = 3 + OnClick = cbFileAttributeClick + end + object cbSymLink: TCheckBox + Tag = 64 + Left = 136 + Top = 16 + Width = 101 + Height = 21 + AllowGrayed = True + Caption = 'Symbolic link' + Checked = True + State = cbGrayed + TabOrder = 4 + OnClick = cbFileAttributeClick + end + object cbNormal: TCheckBox + Tag = 128 + Left = 136 + Top = 88 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Normal' + Checked = True + State = cbGrayed + TabOrder = 6 + OnClick = cbFileAttributeClick + end + object cbArchive: TCheckBox + Tag = 32 + Left = 136 + Top = 16 + Width = 89 + Height = 21 + AllowGrayed = True + Caption = 'Archive' + Checked = True + State = cbGrayed + TabOrder = 5 + OnClick = cbFileAttributeClick + end + end + object cbLastChangeAfter: TCheckBox + Left = 524 + Top = 12 + Width = 131 + Height = 30 + Caption = 'Last change after' + TabOrder = 1 + end + object edLastChangeAfter: TEdit + Left = 656 + Top = 16 + Width = 113 + Height = 21 + MaxLength = 10 + TabOrder = 2 + end + object cbLastChangeBefore: TCheckBox + Left = 524 + Top = 36 + Width = 131 + Height = 30 + Caption = 'Last change before' + TabOrder = 3 + end + object edLastChangeBefore: TEdit + Left = 656 + Top = 40 + Width = 113 + Height = 21 + MaxLength = 10 + TabOrder = 4 + end + object cbFileSizeMax: TCheckBox + Left = 524 + Top = 60 + Width = 131 + Height = 30 + Caption = 'Maximum size' + TabOrder = 5 + end + object edFileSizeMax: TEdit + Left = 656 + Top = 64 + Width = 113 + Height = 21 + TabOrder = 6 + Text = '$7FFFFFFFFFFFFFFF' + end + object cbFileSizeMin: TCheckBox + Left = 524 + Top = 84 + Width = 131 + Height = 30 + Caption = 'Minimum size' + TabOrder = 7 + end + object edFileSizeMin: TEdit + Left = 656 + Top = 88 + Width = 113 + Height = 21 + TabOrder = 8 + Text = '0' + end + object IncludeSubDirectories: TCheckBox + Left = 40 + Top = 18 + Width = 157 + Height = 17 + Caption = 'Include sub directories' + Checked = True + State = cbChecked + TabOrder = 9 + OnClick = UpdateIncludeHiddenSubDirs + end + object IncludeHiddenSubDirs: TCheckBox + Left = 40 + Top = 42 + Width = 201 + Height = 17 + Caption = 'Include hidden sub directories' + TabOrder = 10 + OnClick = IncludeHiddenSubDirsClick + end + object cbDisplayLiveUpdate: TCheckBox + Left = 40 + Top = 90 + Width = 189 + Height = 17 + Caption = '&Display live update' + TabOrder = 12 + end + object cbCaseInsensitiveSearch: TCheckBox + Left = 40 + Top = 66 + Width = 177 + Height = 17 + Caption = 'Case insensitive search' + TabOrder = 11 + end + end + object SaveDialog: TSaveDialog + FilterIndex = 0 + Height = 0 + Title = 'Save' + Width = 0 + Left = 740 + Top = 36 + end +end diff --git a/official/1.96/examples/common/graphics/QClipLineDemo.dof b/official/1.96/examples/common/graphics/QClipLineDemo.dof new file mode 100644 index 0000000..3d5dc48 --- /dev/null +++ b/official/1.96/examples/common/graphics/QClipLineDemo.dof @@ -0,0 +1,4 @@ +[Directories] +OutputDir=../../../bin +Conditionals=VisualCLX;MATH_SINGLE_PRECISION + diff --git a/official/1.96/examples/common/graphics/QClipLineDemo.dpr b/official/1.96/examples/common/graphics/QClipLineDemo.dpr new file mode 100644 index 0000000..5f0c1bf --- /dev/null +++ b/official/1.96/examples/common/graphics/QClipLineDemo.dpr @@ -0,0 +1,15 @@ +program QClipLineDemo; + +{%ToDo 'ClipLineDemo.todo'} +uses + QStyle, + QForms, + QClipLineDemoMain in 'QClipLineDemoMain.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/common/graphics/QClipLineDemo.res b/official/1.96/examples/common/graphics/QClipLineDemo.res new file mode 100644 index 0000000..0930265 Binary files /dev/null and b/official/1.96/examples/common/graphics/QClipLineDemo.res differ diff --git a/official/1.96/examples/common/graphics/QClipLineDemoMain.dfm b/official/1.96/examples/common/graphics/QClipLineDemoMain.dfm new file mode 100644 index 0000000..3cada53 --- /dev/null +++ b/official/1.96/examples/common/graphics/QClipLineDemoMain.dfm @@ -0,0 +1,17 @@ +object Form1: TForm1 + Left = 198 + Top = 147 + Width = 400 + Height = 400 + Caption = 'ClipLine Demo' + Color = 15790320 + OnCreate = FormCreate + OnPaint = FormPaint + PixelsPerInch = 96 + TextHeight = 13 + object Timer1: TTimer + Enabled = False + Left = 32 + Top = 24 + end +end diff --git a/official/1.96/examples/common/graphics/QClipLineDemoMain.pas b/official/1.96/examples/common/graphics/QClipLineDemoMain.pas new file mode 100644 index 0000000..35de763 --- /dev/null +++ b/official/1.96/examples/common/graphics/QClipLineDemoMain.pas @@ -0,0 +1,94 @@ +unit QClipLineDemoMain; + +{$I jcl.inc} + +interface + +uses + SysUtils, Types, Classes, +{$IFDEF MSWINDOWS} + Windows, +{$ENDIF} +{$IFDEF VisualCLX} + Qt, QGraphics, QControls, QForms, QStdCtrls, QExtCtrls, QTypes, JclQGraphUtils, +{$ENDIF VisualCLX} +{$IFDEF VCL} + Graphics, ExtCtrls, Forms, JclGraphUtils, +{$ENDIF VCL} + JclBase; + +type + TForm1 = class(TForm) + Timer1: TTimer; + procedure FormCreate(Sender: TObject); + procedure FormPaint(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + private + { Private declarations } + R: TRect; + P: TPointArray; + FPenColor: TColor; + FPenColorLight: TColor; + procedure InitLines; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$IFDEF VisualCLX} +{$R *.xfm} +{$ELSE} +{$R *.dfm} +{$ENDIF} + +procedure TForm1.FormCreate(Sender: TObject); +begin + Randomize; + R.Left := 100; + R.Top := 100; + R.Right := 300; + R.Bottom := 300; + SetLength(P, 50); + InitLines; +end; + +procedure TForm1.FormPaint(Sender: TObject); +begin + Canvas.Brush.Color := clWhite; + Canvas.FillRect(R); + Canvas.Pen.Color := FPenColorLight; + Canvas.PolyLine(P); + Canvas.Pen.Color := FPenColor; + DrawPolyLine(Canvas, P, R); +end; + +procedure TForm1.InitLines; +var + i: Integer; + H, S, L: Single; +begin + for i := 0 to Length(P)-1 do + begin + P[i].X := Random(Width); + P[i].Y := Random(Height); + end; + H := Random; + S := Random; + L := 0.4 * Random; + + FPenColor := WinColor(HSLToRGB(H, S, L)); + FPenColorLight := WinColor(HSLToRGB(H, S, 1 - 0.2 * (1 - L))); +end; + +procedure TForm1.Timer1Timer(Sender: TObject); +begin + InitLines; + Refresh; +end; + +end. + diff --git a/official/1.96/examples/common/graphics/QClipLineDemoMain.xfm b/official/1.96/examples/common/graphics/QClipLineDemoMain.xfm new file mode 100644 index 0000000..df54ff9 --- /dev/null +++ b/official/1.96/examples/common/graphics/QClipLineDemoMain.xfm @@ -0,0 +1,19 @@ +object Form1: TForm1 + Left = 198 + Top = 147 + Width = 400 + Height = 400 + Caption = 'ClipLine Demo' + Color = 15790320 + OnCreate = FormCreate + OnPaint = FormPaint + PixelsPerInch = 96 + TextHeight = 13 + TextWidth = 6 + object Timer1: TTimer + Interval = 3000 + OnTimer = Timer1Timer + Left = 32 + Top = 24 + end +end diff --git a/official/1.96/examples/common/graphics/StretchGraphicDemoMain.dfm b/official/1.96/examples/common/graphics/StretchGraphicDemoMain.dfm new file mode 100644 index 0000000..342ce3d --- /dev/null +++ b/official/1.96/examples/common/graphics/StretchGraphicDemoMain.dfm @@ -0,0 +1,218 @@ +object StretchDemoForm: TStretchDemoForm + Left = 255 + Top = 208 + Width = 788 + Height = 609 + VertScrollBar.Range = 19 + ActiveControl = PageControl + AutoScroll = False + Caption = 'JCL Picture Viewer' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = 12 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + KeyPreview = True + Menu = MainMenu + OldCreateOrder = True + Scaled = False + ShowHint = True + OnCreate = FormCreate + OnKeyDown = FormKeyDown + PixelsPerInch = 96 + TextHeight = 13 + object PageControl: TPageControl + Left = 0 + Top = 0 + Width = 780 + Height = 544 + ActivePage = OriginalPage + Align = alClient + TabOrder = 0 + OnChanging = PageControlChanging + object OriginalPage: TTabSheet + Caption = 'Original' + object ScrollBox: TScrollBox + Left = 0 + Top = 0 + Width = 772 + Height = 516 + HorzScrollBar.Tracking = True + VertScrollBar.Tracking = True + Align = alClient + Color = clGray + ParentColor = False + TabOrder = 0 + object OriginalImage: TImage + Left = 0 + Top = 0 + Width = 768 + Height = 512 + AutoSize = True + end + end + end + object StretchedPage: TTabSheet + Caption = 'Resized' + ImageIndex = 1 + OnResize = StretchedPageResize + OnShow = StretchedPageShow + object Bevel1: TBevel + Left = 0 + Top = 0 + Width = 772 + Height = 516 + Align = alClient + end + object StretchedImage: TImage + Left = 1 + Top = 1 + Width = 770 + Height = 513 + Anchors = [akLeft, akTop, akRight, akBottom] + end + end + object FilesPage: TTabSheet + Caption = 'Files' + ImageIndex = 2 + object FileListView: TListView + Left = 0 + Top = 0 + Width = 772 + Height = 516 + Align = alClient + Columns = < + item + AutoSize = True + Caption = 'File' + MaxWidth = 800 + MinWidth = 300 + end + item + Caption = 'Size' + end> + HideSelection = False + TabOrder = 0 + ViewStyle = vsReport + OnClick = FileListViewClick + OnKeyDown = FileListViewKeyDown + end + end + end + object StatusBar: TStatusBar + Left = 0 + Top = 544 + Width = 780 + Height = 19 + Panels = < + item + Width = 120 + end + item + Width = 120 + end + item + Width = 120 + end> + SimplePanel = False + end + object OpenDialog: TOpenDialog + Filter = + 'All (*.jpg;*.jpeg;*.bmp)|*.jpg;*.jpeg;*.bmp|JPEG Image File (*.j' + + 'pg)|*.jpg|JPEG Image File (*.jpeg)|*.jpeg|Bitmaps (*.bmp)|*.bmp' + FilterIndex = 0 + Title = 'Open' + Left = 240 + Top = 68 + end + object MainMenu: TMainMenu + Left = 208 + Top = 68 + object Fil1: TMenuItem + Caption = '&File' + object Open1: TMenuItem + Caption = 'Open...' + OnClick = OpenFile + end + object N1: TMenuItem + Caption = '-' + end + object ExitItem: TMenuItem + Caption = 'E&xit' + OnClick = ExitApp + end + end + object Filter1: TMenuItem + Caption = '&Resampling Filter' + object Box1: TMenuItem + Caption = 'Bo&x' + GroupIndex = 1 + RadioItem = True + OnClick = SelectFilter + end + object Triangle1: TMenuItem + Tag = 1 + Caption = '&Triangle' + GroupIndex = 1 + RadioItem = True + OnClick = SelectFilter + end + object Hermite1: TMenuItem + Tag = 2 + Caption = '&Hermite' + GroupIndex = 1 + RadioItem = True + OnClick = SelectFilter + end + object Bell1: TMenuItem + Tag = 3 + Caption = '&Bell' + GroupIndex = 1 + RadioItem = True + OnClick = SelectFilter + end + object Spline1: TMenuItem + Tag = 4 + Caption = '&Spline' + Checked = True + GroupIndex = 1 + RadioItem = True + OnClick = SelectFilter + end + object Lanczos31: TMenuItem + Tag = 5 + Caption = '&Lanczos 3' + GroupIndex = 1 + RadioItem = True + OnClick = SelectFilter + end + object Mitchell1: TMenuItem + Tag = 6 + Caption = '&Mitchell' + GroupIndex = 1 + RadioItem = True + OnClick = SelectFilter + end + end + object Options1: TMenuItem + Caption = '&Options' + object PreserveAspectRatio1: TMenuItem + Caption = 'Preserve Aspect Ratio' + Checked = True + OnClick = PreserveAspectRatio1Click + end + end + object PrevItem: TMenuItem + Caption = ' &<< ' + Hint = 'Previous file in directory' + OnClick = PrevFile + end + object NextItem: TMenuItem + Caption = ' &>> ' + Hint = 'Next file in directory' + OnClick = NextFile + end + end +end diff --git a/official/1.96/examples/common/graphics/StretchGraphicDemoMain.pas b/official/1.96/examples/common/graphics/StretchGraphicDemoMain.pas new file mode 100644 index 0000000..9dbbecf --- /dev/null +++ b/official/1.96/examples/common/graphics/StretchGraphicDemoMain.pas @@ -0,0 +1,510 @@ +// +// Robert Rossmair, 2002-09-22 +// revised 2005-06-26 +// + +{$I jcl.inc} + +{$IFDEF RTL140_UP} + {$IFDEF VCL} + {$DEFINE HasShellCtrls} // $(Delphi)\Demos\ShellControls\ShellCtrls.pas + {$ENDIF VCL} +{$ENDIF RTL140_UP} + +unit StretchGraphicDemoMain; + +interface + +uses + SysUtils, Classes, + {$IFDEF MSWINDOWS} + Windows, Messages, JPEG, ShellAPI, + {$ENDIF MSWINDOWS} + {$IFDEF VCL} + Graphics, Controls, Forms, + Dialogs, ComCtrls, StdCtrls, Menus, ExtCtrls, ExtDlgs, + JclGraphics, + {$ENDIF VCL} + {$IFDEF VisualCLX} + Qt, QGraphics, QMenus, QTypes, QExtCtrls, QComCtrls, QStdCtrls, + QControls, QForms, QDialogs, + JclQGraphics, + {$ENDIF VisualCLX} + {$IFDEF HasShellCtrls} + {$WARN UNIT_PLATFORM OFF} + ShellCtrls, + {$ENDIF HasShellCtrls} + JclFileUtils; + +type + TStretchDemoForm = class(TForm) + PageControl: TPageControl; + OriginalPage: TTabSheet; + StretchedPage: TTabSheet; + StretchedImage: TImage; + MainMenu: TMainMenu; + Fil1: TMenuItem; + Open1: TMenuItem; + N1: TMenuItem; + ExitItem: TMenuItem; + Filter1: TMenuItem; + Box1: TMenuItem; + Triangle1: TMenuItem; + Hermite1: TMenuItem; + Bell1: TMenuItem; + Spline1: TMenuItem; + Lanczos31: TMenuItem; + Mitchell1: TMenuItem; + Options1: TMenuItem; + PreserveAspectRatio1: TMenuItem; + PrevItem: TMenuItem; + NextItem: TMenuItem; + FilesPage: TTabSheet; + ScrollBox: TScrollBox; + StatusBar: TStatusBar; + Bevel1: TBevel; + OpenDialog: TOpenDialog; + FileListView: TListView; + OriginalImage: TImage; + procedure FormCreate(Sender: TObject); + {$IFDEF VCL} + procedure FormDestroy(Sender: TObject); + {$ENDIF VCL} + procedure OpenFile(Sender: TObject); + procedure SelectFilter(Sender: TObject); + procedure PreserveAspectRatio1Click(Sender: TObject); + procedure ExitApp(Sender: TObject); + procedure PrevFile(Sender: TObject); + procedure NextFile(Sender: TObject); + procedure FileListViewClick(Sender: TObject); + procedure LoadSelected; + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure StretchedPageShow(Sender: TObject); + procedure StretchedPageResize(Sender: TObject); + procedure PageControlChanging(Sender: TObject; + var AllowChange: Boolean); + procedure FileListViewKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + {$IFDEF HasShellCtrls} + procedure ShellChange; + private + FShellChangeNotifier: TShellChangeNotifier; + {$ELSE} + private + {$ENDIF HasShellCtrls} + FLastImagePage: TTabSheet; + FFileName: string; + FDir: string; + FWidth: Integer; + FHeight: Integer; + FStretchTime: LongWord; + FPreserveAspectRatio: Boolean; + FResamplingFilter: TResamplingFilter; + procedure AddToFileList(const Directory: string; const FileInfo: TSearchRec); + procedure FileSearchTerminated(const ID: TFileSearchTaskID; const Aborted: Boolean); + function ChangeDirectory: Boolean; + procedure DoStretch; + procedure LoadFile(const AFileName: string); + procedure InvalidateStretched; + procedure UpdateCaption; + procedure UpdateFileList; + procedure UpdateNavButtons; + procedure UpdateStretched; + function GetFileListIndex: Integer; + procedure SetFileListIndex(const Value: Integer); + procedure SetFileName(const Value: string); + {$IFDEF VCL} + procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DropFiles; + {$ENDIF VCL} + protected + property FileListIndex: Integer read GetFileListIndex write SetFileListIndex; + property FileName: string read FFileName write SetFileName; + end; + +var + StretchDemoForm: TStretchDemoForm; + +implementation + +{$IFDEF VCL} +{$R *.dfm} +{$ENDIF} +{$IFDEF VisualCLX} +{$R *.xfm} +{$ENDIF VisualCLX} + +var + FileMask: string; + +{$IFDEF MSWINDOWS} +type + TWMDropFilesCallback = procedure (const FileName: string) of object; + +procedure ProcessWMDropFiles(var Msg: TWMDropFiles; Callback: TWMDropFilesCallback; DropPoint: PPoint = nil); overload; +var + i: Integer; + FileName: array[0..MAX_PATH] of Char; +begin + try + // in case DropPoint is evaluated by callback method, get it first + if DropPoint <> nil then + DragQueryPoint(Msg.Drop, DropPoint^); + if Assigned(Callback) then + for i := 0 to DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0) - 1 do + begin + DragQueryFile(Msg.Drop, i, FileName, MAX_PATH); + Callback(FileName); + end; + Msg.Result := 0; + finally + DragFinish(Msg.Drop); + end; +end; + +procedure ProcessWMDropFiles(var Msg: TWMDropFiles; FileNames: TStrings; DropPoint: PPoint = nil); overload; +begin + ProcessWMDropFiles(Msg, FileNames.Append, DropPoint); +end; +{$ENDIF MSWINDOWS} + +function IsGraphicFile(const FileName: string): Boolean; overload; +var + Ext: string; +begin + Ext := AnsiLowerCase(ExtractFileExt(FileName)); + Result := (Pos(Ext, FileMask) > 0); +end; + +function IsGraphicFile(const Attr: Integer; const FileInfo: TSearchRec): Boolean; overload; +begin + Result := IsGraphicFile(FileInfo.Name); +end; + +procedure TStretchDemoForm.FormCreate(Sender: TObject); +begin + StretchedPage.Brush.Color := clGray; + {$IFDEF VCL} + ScrollBox.DoubleBuffered := True; + StretchedPage.DoubleBuffered := True; + {$ENDIF VCL} + FileMask := GraphicFileMask(TGraphic); + //Format('%s;%s', [GraphicFileMask(TJPEGImage), GraphicFileMask(TBitmap)]); + OpenDialog.Filter := GraphicFilter(TGraphic); + FResamplingFilter := rfSpline; // rfLanczos3; + FPreserveAspectRatio := True; + UpdateNavButtons; + {$IFDEF HasShellCtrls} + FShellChangeNotifier := TShellChangeNotifier.Create(Self); + with FShellChangeNotifier do + begin + WatchSubTree := False; + OnChange := ShellChange; + NotifyFilters := [ + nfFileNameChange, + nfDirNameChange, + //nfSizeChange, + nfWriteChange, + nfSecurityChange]; + end; + {$ENDIF HasShellCtrls} + {$IFDEF VCL} + DragAcceptFiles(Handle, True); + {$ENDIF VCL} + if ParamCount > 0 then + with OpenDialog do + begin + FileName := ParamStr(1); + InitialDir := ExtractFileDir(FileName); + LoadFile(FileName); + end; +end; + +{$IFDEF VCL} +procedure TStretchDemoForm.FormDestroy(Sender: TObject); +begin + DragAcceptFiles(Handle, False); +end; +{$ENDIF VCL} + +procedure TStretchDemoForm.ExitApp(Sender: TObject); +begin + Close; +end; + +function TStretchDemoForm.ChangeDirectory: Boolean; +var + Dir, D: string; +begin + D := ExtractFileDir(FileName); + Dir := PathAddSeparator(D); + Result := (Dir <> FDir) and (Pos(FDir, Dir) <> 1); + if Result then + begin + FDir := Dir; + FilesPage.Caption := Format('Files in %s', [D]); + OpenDialog.InitialDir := D; + {$IFDEF HasShellCtrls} + FShellChangeNotifier.Root := D; + {$ELSE} + UpdateFileList; + {$ENDIF HasShellCtrls} + end; +end; + +procedure TStretchDemoForm.AddToFileList(const Directory: string; const FileInfo: TSearchRec); +begin + with FileListView.Items.Add do + begin + Caption := Directory + FileInfo.Name; + end; +end; + +procedure TStretchDemoForm.FileSearchTerminated(const ID: TFileSearchTaskID; const Aborted: Boolean); +begin + with FileListView do + Selected := FindCaption(0, FileName, False, True, False); + StatusBar.Panels[0].Text := Format('%d files', [FileListView.Items.Count]); + UpdateNavButtons; +end; + +procedure TStretchDemoForm.UpdateFileList; +begin + FileListView.Items.Clear; + with FileSearch do + begin + FileMask := GraphicFileMask(TGraphic); + RootDirectory := FDir; + OnTerminateTask := FileSearchTerminated; + ForEach(AddToFileList); + end; +end; + +procedure TStretchDemoForm.LoadFile(const AFileName: string); +begin + if not IsGraphicFile(AFileName) then + Exit; + FileName := AFileName; + OriginalImage.Picture.LoadFromFile(FileName); + if not ChangeDirectory then + UpdateNavButtons; + + UpdateCaption; + with FileListView do + Selected := FindCaption(0, FileName, False, True, False); + + StretchedImage.Picture.Graphic := nil; + InvalidateStretched; + if PageControl.ActivePage = FilesPage then + begin + {$IFDEF VCL} + if OriginalImage.Picture.Graphic is TMetaFile then + PageControl.ActivePage := OriginalPage + else + {$ENDIF VCL} + PageControl.ActivePage := FLastImagePage; + FocusControl(PageControl); + end; +end; + +procedure TStretchDemoForm.OpenFile(Sender: TObject); +begin + if OpenDialog.Execute then + LoadFile(OpenDialog.FileName); +end; + +procedure TStretchDemoForm.SelectFilter(Sender: TObject); +begin + with Sender as TMenuItem do + begin + Checked := True; + FResamplingFilter := TResamplingFilter(Tag); + InvalidateStretched; + end; +end; + +procedure TStretchDemoForm.DoStretch; +var + W, H: Integer; + T: LongWord; +begin + with OriginalImage.Picture do + if (Graphic = nil) {$IFDEF VCL} or (Graphic is TMetafile) {$ENDIF} then + Exit; + W := StretchedPage.Width-2; + H := StretchedPage.Height-2; + if FPreserveAspectRatio then + with OriginalImage.Picture.Graphic do + begin + if W * Height > H * Width then + W := H * Width div Height + else + H := W * Height div Width; + end; + if (FWidth <> W) or (FHeight <> H) then + begin + T := GetTickCount; + StretchedImage.Picture.Graphic := nil; + JclGraphics.Stretch(W, H, FResamplingFilter, 0, OriginalImage.Picture.Graphic, + StretchedImage.Picture.Bitmap); + with OriginalImage.Picture do + StatusBar.Panels[0].Text := Format('Original: %d x %d', [Width, Height]); + with StretchedImage.Picture do + StatusBar.Panels[1].Text := Format('Resized: %d x %d', [Width, Height]); + FWidth := W; + FHeight := H; + FStretchTime := GetTickCount - T; + with StretchedImage.Picture do + StatusBar.Panels[2].Text := Format('Resize time: %d msec', [FStretchTime]); + end; +end; + +procedure TStretchDemoForm.PreserveAspectRatio1Click(Sender: TObject); +begin + with Sender as TMenuItem do + begin + Checked := not Checked; + FPreserveAspectRatio := Checked; + InvalidateStretched; + end; +end; + +procedure TStretchDemoForm.LoadSelected; +begin + with FileListView do + if Selected <> nil then + LoadFile(Selected.Caption); +end; + +procedure TStretchDemoForm.PrevFile(Sender: TObject); +begin + if FileListIndex > 0 then + FileListIndex := FileListIndex - 1; + LoadSelected; +end; + +procedure TStretchDemoForm.NextFile(Sender: TObject); +begin + if FileListIndex < FileListView.Items.Count - 1 then + FileListIndex := FileListIndex + 1; + LoadSelected; +end; + +procedure TStretchDemoForm.UpdateCaption; +begin + if FileName <> '' then + Caption := Format('JCL Picture Viewer - %s', [FileName]); +end; + +procedure TStretchDemoForm.UpdateNavButtons; +begin + PrevItem.Enabled := FileListIndex > 0; + NextItem.Enabled := FileListIndex < FileListView.Items.Count - 1; + PrevItem.Enabled := FileListIndex > 0; + NextItem.Enabled := FileListIndex < FileListView.Items.Count - 1; +end; + +procedure TStretchDemoForm.FileListViewClick(Sender: TObject); +begin + LoadSelected; +end; + +procedure TStretchDemoForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +{$IFDEF VCL} +const + Key_Prior = VK_PRIOR; + Key_Next = VK_NEXT; +{$ENDIF VCL} +begin + case Key of + Key_Prior: + begin + PrevFile(Self); + Key := 0; + end; + Key_Next: + begin + NextFile(Self); + Key := 0; + end; + end; +end; + +procedure TStretchDemoForm.StretchedPageShow(Sender: TObject); +begin + UpdateStretched; +end; + +procedure TStretchDemoForm.UpdateStretched; +begin + if StretchedPage.Visible then + DoStretch; +end; + +procedure TStretchDemoForm.StretchedPageResize(Sender: TObject); +begin + UpdateStretched; +end; + +procedure TStretchDemoForm.InvalidateStretched; +begin + FWidth := 0; + FHeight := 0; + UpdateStretched; +end; + +{$IFDEF VCL} +procedure TStretchDemoForm.WMDropFiles(var Msg: TWMDropFiles); +begin + ProcessWMDropFiles(Msg, LoadFile); +end; +{$ENDIF VCL} + +procedure TStretchDemoForm.PageControlChanging(Sender: TObject; + var AllowChange: Boolean); +begin + if PageControl.ActivePage <> FilesPage then + FLastImagePage := PageControl.ActivePage; +end; + +{$IFDEF HasShellCtrls} +procedure TStretchDemoForm.ShellChange; +begin + UpdateFileList; +end; +{$ENDIF HasShellCtrls} + +function TStretchDemoForm.GetFileListIndex: Integer; +begin + Result := -1; + if FileListView.Selected <> nil then + Result := FileListView.Selected.Index; +end; + +procedure TStretchDemoForm.SetFileListIndex(const Value: Integer); +begin + if Value < 0 then + begin + if FileListView.Selected <> nil then + begin + FileListView.Selected.Selected := False; + end; + end + else + FileListView.Items[Value].Selected := True; +end; + +procedure TStretchDemoForm.FileListViewKeyDown(Sender: TObject; + var Key: Word; Shift: TShiftState); +begin + if Key = VK_RETURN then + LoadSelected; +end; + +procedure TStretchDemoForm.SetFileName(const Value: string); +begin + FFileName := PathGetLongName(Value); +end; + +end. diff --git a/official/1.96/examples/common/graphics/StretchGraphicExample.dof b/official/1.96/examples/common/graphics/StretchGraphicExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/common/graphics/StretchGraphicExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/common/graphics/StretchGraphicExample.dpr b/official/1.96/examples/common/graphics/StretchGraphicExample.dpr new file mode 100644 index 0000000..b198df2 --- /dev/null +++ b/official/1.96/examples/common/graphics/StretchGraphicExample.dpr @@ -0,0 +1,13 @@ +program StretchGraphicExample; + +uses + Forms, + StretchGraphicDemoMain in 'StretchGraphicDemoMain.pas' {StretchDemoForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TStretchDemoForm, StretchDemoForm); + Application.Run; +end. diff --git a/official/1.96/examples/common/graphics/StretchGraphicExample.res b/official/1.96/examples/common/graphics/StretchGraphicExample.res new file mode 100644 index 0000000..0930265 Binary files /dev/null and b/official/1.96/examples/common/graphics/StretchGraphicExample.res differ diff --git a/official/1.96/examples/common/multimedia/MidiOutExample.dof b/official/1.96/examples/common/multimedia/MidiOutExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/common/multimedia/MidiOutExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/common/multimedia/MidiOutExample.dpr b/official/1.96/examples/common/multimedia/MidiOutExample.dpr new file mode 100644 index 0000000..ace40cb --- /dev/null +++ b/official/1.96/examples/common/multimedia/MidiOutExample.dpr @@ -0,0 +1,15 @@ +program MidiOutExample; + +uses + Forms, + MidiOutExampleMain in 'MidiOutExampleMain.pas' {Keyboard}, + MidiOutExampleTuningDlg in 'MidiOutExampleTuningDlg.pas' {TuningDialog}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TKeyboard, Keyboard); + Application.CreateForm(TTuningDialog, TuningDialog); + Application.Run; +end. diff --git a/official/1.96/examples/common/multimedia/MidiOutExample.res b/official/1.96/examples/common/multimedia/MidiOutExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/common/multimedia/MidiOutExample.res differ diff --git a/official/1.96/examples/common/multimedia/MidiOutExampleMain.dfm b/official/1.96/examples/common/multimedia/MidiOutExampleMain.dfm new file mode 100644 index 0000000..774a6ae --- /dev/null +++ b/official/1.96/examples/common/multimedia/MidiOutExampleMain.dfm @@ -0,0 +1,489 @@ +object Keyboard: TKeyboard + Left = 145 + Top = 347 + Width = 528 + Height = 243 + HorzScrollBar.Range = 517 + VertScrollBar.Range = 209 + ActiveControl = MidiProgramNum + AutoScroll = False + Caption = 'MIDI Example' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = 11 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + OldCreateOrder = True + Scaled = False + ShowHint = True + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Key48: TSpeedButton + Tag = 48 + Left = 4 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 48 + OnMouseDown = KeyMouseDown + end + object Key50: TSpeedButton + Tag = 50 + Left = 24 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 50 + OnMouseDown = KeyMouseDown + end + object Key52: TSpeedButton + Tag = 52 + Left = 44 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 52 + OnMouseDown = KeyMouseDown + end + object Key53: TSpeedButton + Tag = 53 + Left = 64 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 53 + OnMouseDown = KeyMouseDown + end + object Key49: TSpeedButton + Tag = 49 + Left = 18 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 49 + OnMouseDown = KeyMouseDown + end + object Key51: TSpeedButton + Tag = 51 + Left = 38 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 51 + OnMouseDown = KeyMouseDown + end + object Key55: TSpeedButton + Tag = 55 + Left = 84 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 55 + OnMouseDown = KeyMouseDown + end + object Key57: TSpeedButton + Tag = 57 + Left = 104 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 57 + OnMouseDown = KeyMouseDown + end + object Key59: TSpeedButton + Tag = 59 + Left = 124 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 59 + OnMouseDown = KeyMouseDown + end + object Key54: TSpeedButton + Tag = 54 + Left = 78 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 54 + OnMouseDown = KeyMouseDown + end + object Key56: TSpeedButton + Tag = 56 + Left = 98 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 56 + OnMouseDown = KeyMouseDown + end + object Key58: TSpeedButton + Tag = 58 + Left = 118 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 58 + OnMouseDown = KeyMouseDown + end + object Key60: TSpeedButton + Tag = 60 + Left = 144 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 60 + OnMouseDown = KeyMouseDown + end + object Key62: TSpeedButton + Tag = 62 + Left = 164 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 62 + OnMouseDown = KeyMouseDown + end + object Key64: TSpeedButton + Tag = 64 + Left = 184 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 64 + OnMouseDown = KeyMouseDown + end + object Key65: TSpeedButton + Tag = 65 + Left = 204 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 65 + OnMouseDown = KeyMouseDown + end + object Key61: TSpeedButton + Tag = 61 + Left = 158 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 61 + OnMouseDown = KeyMouseDown + end + object Key63: TSpeedButton + Tag = 63 + Left = 178 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 63 + OnMouseDown = KeyMouseDown + end + object Key67: TSpeedButton + Tag = 67 + Left = 224 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 67 + OnMouseDown = KeyMouseDown + end + object Key69: TSpeedButton + Tag = 69 + Left = 244 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 69 + OnMouseDown = KeyMouseDown + end + object Key71: TSpeedButton + Tag = 71 + Left = 264 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 71 + OnMouseDown = KeyMouseDown + end + object Key66: TSpeedButton + Tag = 66 + Left = 218 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 66 + OnMouseDown = KeyMouseDown + end + object Key68: TSpeedButton + Tag = 68 + Left = 238 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 68 + OnMouseDown = KeyMouseDown + end + object Key70: TSpeedButton + Tag = 70 + Left = 258 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 70 + OnMouseDown = KeyMouseDown + end + object Key72: TSpeedButton + Tag = 72 + Left = 284 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 72 + OnMouseDown = KeyMouseDown + end + object Key74: TSpeedButton + Tag = 74 + Left = 304 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 74 + OnMouseDown = KeyMouseDown + end + object Key76: TSpeedButton + Tag = 76 + Left = 324 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 76 + OnMouseDown = KeyMouseDown + end + object Key77: TSpeedButton + Tag = 77 + Left = 344 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 77 + OnMouseDown = KeyMouseDown + end + object Key73: TSpeedButton + Tag = 73 + Left = 298 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 73 + OnMouseDown = KeyMouseDown + end + object Key75: TSpeedButton + Tag = 75 + Left = 318 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 75 + OnMouseDown = KeyMouseDown + end + object Key79: TSpeedButton + Tag = 79 + Left = 364 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 79 + OnMouseDown = KeyMouseDown + end + object Key81: TSpeedButton + Tag = 81 + Left = 384 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 81 + OnMouseDown = KeyMouseDown + end + object Key83: TSpeedButton + Tag = 83 + Left = 404 + Top = 36 + Width = 21 + Height = 97 + AllowAllUp = True + GroupIndex = 83 + OnMouseDown = KeyMouseDown + end + object Key78: TSpeedButton + Tag = 78 + Left = 358 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 78 + OnMouseDown = KeyMouseDown + end + object Key80: TSpeedButton + Tag = 80 + Left = 378 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 80 + OnMouseDown = KeyMouseDown + end + object Key82: TSpeedButton + Tag = 82 + Left = 398 + Top = 36 + Width = 13 + Height = 61 + AllowAllUp = True + GroupIndex = 82 + OnMouseDown = KeyMouseDown + end + object Label1: TLabel + Left = 440 + Top = 36 + Width = 75 + Height = 13 + Caption = 'MIDI Program #' + end + object Label2: TLabel + Left = 8 + Top = 12 + Width = 43 + Height = 13 + Caption = 'MIDI Out' + end + object Label3: TLabel + Left = 8 + Top = 144 + Width = 58 + Height = 13 + Caption = 'Pitch Wheel' + FocusControl = PitchBender + end + object Label4: TLabel + Left = 8 + Top = 184 + Width = 58 + Height = 13 + Caption = 'Mod. Wheel' + FocusControl = ModWheel + end + object MidiProgramNum: TSpinEdit + Left = 440 + Top = 60 + Width = 77 + Height = 22 + MaxValue = 127 + MinValue = 0 + TabOrder = 0 + Value = 0 + OnChange = MidiProgramNumChange + end + object PitchBender: TTrackBar + Left = 72 + Top = 136 + Width = 441 + Height = 33 + Hint = 'Pitch bender' + Max = 8191 + Min = -8192 + Orientation = trHorizontal + PageSize = 256 + Frequency = 2048 + Position = 0 + SelEnd = 0 + SelStart = 0 + TabOrder = 1 + TickMarks = tmBottomRight + TickStyle = tsAuto + OnChange = PitchBenderChange + end + object btnAllNotesOff: TButton + Left = 440 + Top = 104 + Width = 75 + Height = 25 + Caption = '&All Notes Off' + TabOrder = 2 + OnClick = btnAllNotesOffClick + end + object cbMidiOutSelect: TComboBox + Left = 68 + Top = 8 + Width = 253 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + TabOrder = 3 + OnChange = cbMidiOutSelectChange + end + object ModWheel: TTrackBar + Left = 73 + Top = 176 + Width = 440 + Height = 33 + Hint = 'Pitch bender' + Max = 16383 + Orientation = trHorizontal + PageSize = 256 + Frequency = 2048 + Position = 0 + SelEnd = 0 + SelStart = 0 + TabOrder = 4 + TickMarks = tmBottomRight + TickStyle = tsAuto + OnChange = ModWheelChange + end + object KeyMenu: TPopupMenu + Left = 336 + Top = 8 + object TuningItem: TMenuItem + Caption = 'Tuning...' + OnClick = TuningItemClick + end + end +end diff --git a/official/1.96/examples/common/multimedia/MidiOutExampleMain.pas b/official/1.96/examples/common/multimedia/MidiOutExampleMain.pas new file mode 100644 index 0000000..ed0e4a8 --- /dev/null +++ b/official/1.96/examples/common/multimedia/MidiOutExampleMain.pas @@ -0,0 +1,194 @@ +// +// by Robert Rossmair, June 5 2002 +// +unit MidiOutExampleMain; + +interface + +uses + SysUtils, Classes, Controls, Forms, Menus, StdCtrls, ComCtrls, Buttons, Spin, + JclMIDI; + +type + TKeyboard = class(TForm) + Key48: TSpeedButton; + Key49: TSpeedButton; + Key51: TSpeedButton; + Key50: TSpeedButton; + Key55: TSpeedButton; + Key54: TSpeedButton; + Key53: TSpeedButton; + Key52: TSpeedButton; + Key58: TSpeedButton; + Key56: TSpeedButton; + Key59: TSpeedButton; + Key57: TSpeedButton; + MidiProgramNum: TSpinEdit; + Label1: TLabel; + KeyMenu: TPopupMenu; + TuningItem: TMenuItem; + Key72: TSpeedButton; + Key74: TSpeedButton; + Key76: TSpeedButton; + Key77: TSpeedButton; + Key73: TSpeedButton; + Key75: TSpeedButton; + Key79: TSpeedButton; + Key81: TSpeedButton; + Key83: TSpeedButton; + Key78: TSpeedButton; + Key80: TSpeedButton; + Key82: TSpeedButton; + Key60: TSpeedButton; + Key62: TSpeedButton; + Key64: TSpeedButton; + Key65: TSpeedButton; + Key61: TSpeedButton; + Key63: TSpeedButton; + Key67: TSpeedButton; + Key69: TSpeedButton; + Key71: TSpeedButton; + Key66: TSpeedButton; + Key68: TSpeedButton; + Key70: TSpeedButton; + PitchBender: TTrackBar; + btnAllNotesOff: TButton; + cbMidiOutSelect: TComboBox; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + ModWheel: TTrackBar; + procedure FormCreate(Sender: TObject); + procedure KeyMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure KeyMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure MidiProgramNumChange(Sender: TObject); + procedure TuningItemClick(Sender: TObject); + procedure PitchBenderChange(Sender: TObject); + procedure KeyClick(Sender: TObject); + procedure btnAllNotesOffClick(Sender: TObject); + procedure cbMidiOutSelectChange(Sender: TObject); + procedure ModWheelChange(Sender: TObject); + private + FMidiOut: IJclMidiOut; + FChannel: TMidiChannel; + Keys: array[TMidiNote] of TSpeedButton; + procedure InitKeyboard; + procedure AllNotesOff; + end; + +var + Keyboard: TKeyboard; + +implementation + +uses MidiOutExampleTuningDlg; + +{$R *.dfm} + +procedure TKeyboard.FormCreate(Sender: TObject); +begin + FChannel := 1; + GetMidiOutputs(cbMidiOutSelect.Items); + cbMidiOutSelect.ItemIndex := 0; + cbMidiOutSelectChange(Self); + InitKeyboard; +end; + +procedure TKeyboard.InitKeyboard; +var + Note: TMidiNote; +begin + for Note := Low(Keys) to High(Keys) do + begin + Keys[Note] := FindComponent(Format('Key%d', [Note])) as TSpeedButton; + if Keys[Note] <> nil then + with Keys[Note] do + begin + PopupMenu := KeyMenu; + Hint := Format('MIDI Note #%d'#13#10'%s', [Tag, MidiNoteToStr(Tag)]); + end; + end; +end; + +procedure TKeyboard.AllNotesOff; +var + Note: TMidiNote; +begin + if Assigned(FMidiOut) then + FMidiOut.SwitchAllNotesOff(FChannel); + for Note := Low(Note) to High(Note) do + if Assigned(Keys[Note]) then + Keys[Note].Down := False; +end; + +procedure TKeyboard.KeyMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + if Button = mbLeft then + if (Sender as TSpeedButton).Down then + FMidiOut.SendNoteOff(FChannel, TComponent(Sender).Tag, 127) + else + FMidiOut.SendNoteOn(FChannel, TComponent(Sender).Tag, 127); +end; + +procedure TKeyboard.KeyMouseUp( + Sender: TObject; + Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button = mbLeft then + FMidiOut.SendNoteOff(FChannel, TComponent(Sender).Tag, 127); +end; + +procedure TKeyboard.MidiProgramNumChange(Sender: TObject); +begin + FMidiOut.SendProgramChange(FChannel, MidiProgramNum.Value); +end; + +procedure TKeyboard.TuningItemClick(Sender: TObject); +begin + with TuningDialog do + begin + MIDIKey.Value := KeyMenu.PopupComponent.Tag; + if ShowModal = mrOK then + FMidiOut.SendSingleNoteTuningChange(0, 0, [MidiSingleNoteTuningData(MIDIKey.Value, MIDIFrequency)]); + end; +end; + +procedure TKeyboard.PitchBenderChange(Sender: TObject); +begin + FMidiOut.SendPitchWheelChange(FChannel, PitchBender.Position + MidiPitchWheelCenter); +end; + +procedure TKeyboard.ModWheelChange(Sender: TObject); +begin + FMidiOut.SendModulationWheelChangeHR(FChannel, ModWheel.Position); +end; + +procedure TKeyboard.KeyClick(Sender: TObject); +begin + with Sender as TSpeedButton do + begin + if Down then + FMidiOut.SendNoteOn(FChannel, TComponent(Sender).Tag, 127) + else + FMidiOut.SendNoteOff(FChannel, TComponent(Sender).Tag, 127); + end; +end; + +procedure TKeyboard.btnAllNotesOffClick(Sender: TObject); +begin + AllNotesOff; +end; + +procedure TKeyboard.cbMidiOutSelectChange(Sender: TObject); +begin + AllNotesOff; + FMidiOut := MidiOut(cbMidiOutSelect.ItemIndex); + FMidiOut.SendProgramChange(FChannel, MidiProgramNum.Value); +end; + +end. + diff --git a/official/1.96/examples/common/multimedia/MidiOutExampleTuningDlg.dfm b/official/1.96/examples/common/multimedia/MidiOutExampleTuningDlg.dfm new file mode 100644 index 0000000..f35bbc4 --- /dev/null +++ b/official/1.96/examples/common/multimedia/MidiOutExampleTuningDlg.dfm @@ -0,0 +1,102 @@ +object TuningDialog: TTuningDialog + Left = 245 + Top = 108 + BorderStyle = bsDialog + Caption = 'Tuning' + ClientHeight = 177 + ClientWidth = 313 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = True + Position = poScreenCenter + PixelsPerInch = 96 + TextHeight = 13 + object Bevel1: TBevel + Left = 8 + Top = 8 + Width = 297 + Height = 117 + Shape = bsFrame + end + object MIDIFreqLabel: TLabel + Left = 36 + Top = 56 + Width = 110 + Height = 13 + Caption = '&MIDI relative frequency' + end + object FreqLabel: TLabel + Left = 36 + Top = 84 + Width = 84 + Height = 13 + Caption = 'Frequency [Hertz]' + end + object MIDIKeyLabel: TLabel + Left = 36 + Top = 28 + Width = 81 + Height = 13 + Caption = 'MIDI key number' + end + object NoteLabel: TLabel + Left = 224 + Top = 28 + Width = 49 + Height = 13 + Caption = 'NoteLabel' + end + object OKBtn: TButton + Left = 79 + Top = 140 + Width = 75 + Height = 25 + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 0 + end + object CancelBtn: TButton + Left = 159 + Top = 140 + Width = 75 + Height = 25 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object MIDIFreq: TEdit + Left = 156 + Top = 52 + Width = 121 + Height = 21 + TabOrder = 2 + OnChange = MIDIFreqChange + OnExit = MIDIFreqExit + end + object FreqHertz: TEdit + Left = 156 + Top = 80 + Width = 121 + Height = 21 + TabOrder = 3 + OnChange = FreqHertzChange + OnExit = FreqHertzExit + end + object MIDIKey: TSpinEdit + Left = 156 + Top = 24 + Width = 53 + Height = 22 + MaxValue = 127 + MinValue = 0 + TabOrder = 4 + Value = 0 + OnChange = MIDIKeyChange + end +end diff --git a/official/1.96/examples/common/multimedia/MidiOutExampleTuningDlg.pas b/official/1.96/examples/common/multimedia/MidiOutExampleTuningDlg.pas new file mode 100644 index 0000000..7de83f5 --- /dev/null +++ b/official/1.96/examples/common/multimedia/MidiOutExampleTuningDlg.pas @@ -0,0 +1,170 @@ +// +// Robert Rossmair, 2002 +// +unit MidiOutExampleTuningDlg; + +{$I jcl.inc} + +interface + +uses + Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, + Buttons, ExtCtrls, Spin, + JclMath, JclMidi; + +type + TTuningDialog = class(TForm) + OKBtn: TButton; + CancelBtn: TButton; + Bevel1: TBevel; + MIDIFreq: TEdit; + FreqHertz: TEdit; + MIDIFreqLabel: TLabel; + FreqLabel: TLabel; + MIDIKey: TSpinEdit; + MIDIKeyLabel: TLabel; + NoteLabel: TLabel; + procedure MIDIKeyChange(Sender: TObject); + procedure MIDIFreqChange(Sender: TObject); + procedure FreqHertzChange(Sender: TObject); + procedure MIDIFreqExit(Sender: TObject); + procedure FreqHertzExit(Sender: TObject); + private + FInMIDIFreqChange: Boolean; + FInFreqHertzChange: Boolean; + FChangingFrequency: Boolean; + FChangingMidiFrequency: Boolean; + FFrequency: Single; + FMidiFrequency: Single; + procedure SetFrequency(Value: Single); + procedure SetMidiFrequency(Value: Single); + public + property Frequency: Single read FFrequency write SetFrequency; // Hertz + property MidiFrequency: Single read FMidiFrequency write SetMidiFrequency; + end; + +var + TuningDialog: TTuningDialog; + +implementation + +{$R *.dfm} + +const + HalftonesPerOctave = 12; + MiddleA = 440.0; // Hertz + MidiMiddleA = 69; // A3 = 440 Hertz + Digits = 6; + MIDIFreqMax = 127.99993896; + FreqHertzMin = 8.17579892; + FreqHertzMax = 13289.70346552; + +function Hertz(MIDINote: Extended): Extended; +begin + Hertz := TwoToY((MIDINote - MidiMiddleA) / HalftonesPerOctave) * MiddleA; +end; + +function MIDINote(Hertz: Extended): Extended; +begin + if Hertz < 1.0 then + MIDINote := Low(Integer) + else + MIDINote := LogBase2(Hertz / MiddleA) * HalftonesPerOctave + MidiMiddleA; +end; + +procedure TTuningDialog.MIDIKeyChange(Sender: TObject); +begin + MIDIFrequency := MIDIKey.Value; + NoteLabel.Caption := MidiNoteToStr(MIDIKey.Value); +end; + +procedure TTuningDialog.MIDIFreqChange(Sender: TObject); +var + F: Extended; +begin + if FInFreqHertzChange or (MIDIFreq.Text = '') then + Exit; + FInMIDIFreqChange := True; + try + {$IFDEF COMPILER6_UP} + if TryStrToFloat(MidiFreq.Text, F) then + {$ELSE} + if TextToFloat(PChar(MidiFreq.Text), F, fvExtended) then + {$ENDIF COMPILER6_UP} + MidiFrequency := F; + finally + FInMIDIFreqChange := False; + end; +end; + +procedure TTuningDialog.FreqHertzChange(Sender: TObject); +var + F: Extended; +begin + if FInMIDIFreqChange or (FreqHertz.Text = '') then + Exit; + FInFreqHertzChange := True; + try + {$IFDEF COMPILER6_UP} + if TryStrToFloat(FreqHertz.Text, F) then + {$ELSE} + if TextToFloat(PChar(FreqHertz.Text), F, fvExtended) then + {$ENDIF COMPILER6_UP} + Frequency := F; + finally + FInFreqHertzChange := False; + end; +end; + +procedure TTuningDialog.SetFrequency(Value: Single); +begin + if FChangingFrequency or (Value = Frequency) then + Exit; + FChangingFrequency := True; + try + if Value < FreqHertzMin then + Value := FreqHertzMin + else + if Value > FreqHertzMax then + Value := FreqHertzMax; + FFrequency := Value; + if not FInFreqHertzChange then + FreqHertz.Text := FloatToStrF(Value, ffFixed, 9, Digits); + MidiFrequency := MIDINote(Value); + finally + FChangingFrequency := False; + end; +end; + +procedure TTuningDialog.SetMidiFrequency(Value: Single); +begin + if FChangingMidiFrequency then + // or (Value = MidiFrequency) then + Exit; + if Value < 0 then + Value := 0 + else + if Value > MidiFreqMax then + Value := MidiFreqMax; + FChangingMidiFrequency := True; + try + FMidiFrequency := Value; + if not FInMidiFreqChange then + MIDIFreq.Text := FloatToStrF(Value, ffFixed, 9, Digits); + Frequency := Hertz(Value); + finally + FChangingMidiFrequency := False; + end; +end; + +procedure TTuningDialog.MIDIFreqExit(Sender: TObject); +begin + MIDIFreq.Text := FloatToStrF(MidiFrequency, ffFixed, 9, Digits); +end; + +procedure TTuningDialog.FreqHertzExit(Sender: TObject); +begin + FreqHertz.Text := FloatToStrF(Frequency, ffFixed, 9, Digits); +end; + +end. diff --git a/official/1.96/examples/common/numformat/QNumFormatExample.dof b/official/1.96/examples/common/numformat/QNumFormatExample.dof new file mode 100644 index 0000000..d447a0b --- /dev/null +++ b/official/1.96/examples/common/numformat/QNumFormatExample.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=../../../bin diff --git a/official/1.96/examples/common/numformat/QNumFormatExample.dpr b/official/1.96/examples/common/numformat/QNumFormatExample.dpr new file mode 100644 index 0000000..d85d5e7 --- /dev/null +++ b/official/1.96/examples/common/numformat/QNumFormatExample.dpr @@ -0,0 +1,13 @@ +program QNumFormatExample; + +uses + QForms, + QNumFormatExampleMain in 'QNumFormatExampleMain.pas' {MainForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/common/numformat/QNumFormatExample.res b/official/1.96/examples/common/numformat/QNumFormatExample.res new file mode 100644 index 0000000..ff24fa7 Binary files /dev/null and b/official/1.96/examples/common/numformat/QNumFormatExample.res differ diff --git a/official/1.96/examples/common/numformat/QNumFormatExampleMain.pas b/official/1.96/examples/common/numformat/QNumFormatExampleMain.pas new file mode 100644 index 0000000..e7c3c7b --- /dev/null +++ b/official/1.96/examples/common/numformat/QNumFormatExampleMain.pas @@ -0,0 +1,217 @@ +unit QNumFormatExampleMain; + +interface + +uses + Math, SysUtils, Classes, + Qt, QGraphics, QControls, QForms, QStdCtrls, QComCtrls, + JclSysUtils; + +type + TMainForm = class(TForm) + ValueEdit: TEdit; + EvalBtn: TButton; + Label1: TLabel; + RandBtn: TButton; + PrecisionEdit: TSpinEdit; + Label2: TLabel; + Output: TMemo; + BlockSeparatorSelector: TComboBox; + Label3: TLabel; + Label4: TLabel; + BlockSizeEdit: TSpinEdit; + cbShowPlusSign: TCheckBox; + Label5: TLabel; + ExpDivisionEdit: TSpinEdit; + WidthEdit: TSpinEdit; + Label6: TLabel; + cbZeroPadding: TCheckBox; + Label7: TLabel; + MultiplierSelector: TComboBox; + Label8: TLabel; + FractionDigitsEdit: TSpinEdit; + procedure EvalBtnClick(Sender: TObject); + procedure RandBtnClick(Sender: TObject); + procedure ValueEditChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure BlockSizeEditChanged(Sender: TObject; NewValue: Integer); + procedure BlockSeparatorSelectorChange(Sender: TObject); + procedure PrecisionEditChanged(Sender: TObject; NewValue: Integer); + procedure cbShowPlusSignClick(Sender: TObject); + procedure ExpDivisionEditChanged(Sender: TObject; NewValue: Integer); + procedure WidthEditChanged(Sender: TObject; NewValue: Integer); + procedure cbZeroPaddingClick(Sender: TObject); + procedure MultiplierSelectorChange(Sender: TObject); + procedure FractionDigitsEditChanged(Sender: TObject; + NewValue: Integer); + private + { Private declarations } + FNumFormat: TJclNumericFormat; + procedure Display; + public + { Public declarations } + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.xfm} + +procedure TMainForm.FormCreate(Sender: TObject); +begin + FNumFormat := TJclNumericFormat.Create; + FNumFormat.ExponentDivision := ExpDivisionEdit.Value; + FNumFormat.NumberOfFractionalDigits := FractionDigitsEdit.Value; + FNumFormat.Width := WidthEdit.Value; + FNumFormat.DigitBlockSize := BlockSizeEdit.Value; + BlockSeparatorSelector.Items[0] := FNumFormat.DigitBlockSeparator; + Display; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FNumFormat.Free; +end; + +procedure TMainForm.Display; +var + Base: TNumericSystemBase; + S, Mantissa: string; + Exponent: Integer; + X: Extended; + C: TCaretPos; +begin + if not Assigned(FNumFormat) then + Exit; + X := StrToFloat(ValueEdit.Text); + FNumFormat.Precision := PrecisionEdit.Value; + Output.Lines.BeginUpdate; + try + Output.Lines.Clear; + for Base := Low(TNumericSystemBase) to High(TNumericSystemBase) do + begin + FNumFormat.Base := Base; + FNumFormat.GetMantissaExp(X, Mantissa, Exponent); + if Exponent = 0 then + S := Mantissa + else + S := Format('%s %s %d^%d', [Mantissa, FNumFormat.Multiplier, Base, Exponent]); + Output.Lines.Add(Format('Base %2d: %s', [Base, S])); + end; + C.Line := 0; + C.Col := 0; + Output.CaretPos := C; + finally + Output.Lines.EndUpdate; + end; +end; + +procedure TMainForm.EvalBtnClick(Sender: TObject); +begin + Display; +end; + +procedure TMainForm.RandBtnClick(Sender: TObject); +begin + ValueEdit.Text := FloatToStr(Power(Random * 4 -2, Random(400))); + EvalBtn.Enabled := False; + Display; +end; + +procedure TMainForm.ValueEditChange(Sender: TObject); +begin + EvalBtn.Enabled := True; +end; + +procedure TMainForm.BlockSizeEditChanged(Sender: TObject; NewValue: Integer); +begin + if Assigned(FNumFormat) then + begin + FNumFormat.DigitBlockSize := BlockSizeEdit.Value; + Display; + end; +end; + +procedure TMainForm.BlockSeparatorSelectorChange(Sender: TObject); +begin + if Assigned(FNumFormat) then + begin + FNumFormat.DigitBlockSeparator := AnsiChar(BlockSeparatorSelector.Text[1]); + Display; + end; +end; + +procedure TMainForm.PrecisionEditChanged(Sender: TObject; NewValue: Integer); +begin + if Assigned(FNumFormat) then + begin + FNumFormat.Precision := PrecisionEdit.Value; + Display; + end; +end; + +procedure TMainForm.cbShowPlusSignClick(Sender: TObject); +begin + if Assigned(FNumFormat) then + begin + FNumFormat.ShowPositiveSign := cbShowPlusSign.Checked; + Display; + end; +end; + +procedure TMainForm.ExpDivisionEditChanged(Sender: TObject; + NewValue: Integer); +begin + if Assigned(FNumFormat) then + begin + FNumFormat.ExponentDivision := ExpDivisionEdit.Value; + Display; + end; +end; + +procedure TMainForm.WidthEditChanged(Sender: TObject; NewValue: Integer); +begin + if Assigned(FNumFormat) then + begin + FNumFormat.Width := WidthEdit.Value; + Display; + end; +end; + +procedure TMainForm.cbZeroPaddingClick(Sender: TObject); +begin + if Assigned(FNumFormat) then + begin + if cbZeroPadding.Checked then + FNumFormat.PaddingChar := '0' + else + FNumFormat.PaddingChar := ' '; + Display; + end; +end; + +procedure TMainForm.MultiplierSelectorChange(Sender: TObject); +begin + if Assigned(FNumFormat) then + begin + FNumFormat.Multiplier := MultiplierSelector.Text; + Display; + end; +end; + +procedure TMainForm.FractionDigitsEditChanged(Sender: TObject; + NewValue: Integer); +begin + if Assigned(FNumFormat) then + begin + FNumFormat.NumberOfFractionalDigits := FractionDigitsEdit.Value; + Display; + end; +end; + +initialization + Randomize; +end. diff --git a/official/1.96/examples/common/numformat/QNumFormatExampleMain.xfm b/official/1.96/examples/common/numformat/QNumFormatExampleMain.xfm new file mode 100644 index 0000000..ae6b4d0 --- /dev/null +++ b/official/1.96/examples/common/numformat/QNumFormatExampleMain.xfm @@ -0,0 +1,224 @@ +object MainForm: TMainForm + Left = 234 + Top = 223 + Width = 800 + Height = 581 + VertScrollBar.Range = 576 + HorzScrollBar.Range = 779 + ActiveControl = ValueEdit + Caption = 'TJclNumericFormat Example' + Color = clButton + Font.CharSet = fcsLatin2 + Font.Color = clBlack + Font.Height = 12 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpFixed + Font.Style = [] + Font.Weight = 40 + ParentFont = False + Scaled = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + object Label1: TLabel + Left = 8 + Top = 12 + Width = 78 + Height = 15 + Caption = 'Decimal value' + end + object Label2: TLabel + Left = 320 + Top = 12 + Width = 52 + Height = 15 + Caption = 'Precision' + end + object ValueEdit: TEdit + Left = 100 + Top = 8 + Width = 149 + Height = 23 + TabOrder = 0 + Text = '123456789' + OnChange = ValueEditChange + end + object EvalBtn: TButton + Left = 704 + Top = 8 + Width = 75 + Height = 25 + Caption = 'Evaluate' + TabOrder = 8 + OnClick = EvalBtnClick + end + object RandBtn: TButton + Left = 704 + Top = 36 + Width = 75 + Height = 25 + Caption = 'Random' + TabOrder = 9 + OnClick = RandBtnClick + end + object PrecisionEdit: TSpinEdit + Left = 380 + Top = 8 + Width = 81 + Height = 23 + Max = 64 + Min = 1 + TabOrder = 1 + Value = 9 + OnChanged = PrecisionEditChanged + end + object Output: TMemo + Left = 0 + Top = 120 + Width = 800 + Height = 461 + Align = alBottom + Anchors = [akLeft, akTop, akRight, akBottom] + Font.CharSet = fcsLatin2 + Font.Color = clBlack + Font.Height = 16 + Font.Name = 'Courier' + Font.Pitch = fpFixed + Font.Style = [] + Font.Weight = 40 + ParentFont = False + ScrollBars = ssAutoBoth + TabOrder = 12 + WordWrap = False + end + object BlockSeparatorSelector: TComboBox + Left = 632 + Top = 36 + Width = 57 + Height = 23 + Style = csDropDownList + ItemHeight = 17 + Items.Strings = ( + ',' + ' ' + '|') + ItemIndex = 0 + TabOrder = 13 + Text = ',' + OnChange = BlockSeparatorSelectorChange + end + object Label3: TLabel + Left = 504 + Top = 40 + Width = 109 + Height = 15 + Caption = 'DigitBlockSeparator' + end + object Label4: TLabel + Left = 504 + Top = 68 + Width = 78 + Height = 15 + Caption = 'DigitBlockSize' + end + object BlockSizeEdit: TSpinEdit + Left = 632 + Top = 64 + Width = 57 + Height = 23 + TabOrder = 7 + Value = 3 + OnChanged = BlockSizeEditChanged + end + object cbShowPlusSign: TCheckBox + Left = 100 + Top = 32 + Width = 149 + Height = 31 + Caption = 'Show plus sign' + TabOrder = 10 + OnClick = cbShowPlusSignClick + end + object Label5: TLabel + Left = 276 + Top = 68 + Width = 95 + Height = 15 + Caption = 'ExponentDivision' + end + object ExpDivisionEdit: TSpinEdit + Left = 380 + Top = 64 + Width = 81 + Height = 23 + Max = 12 + Min = 1 + TabOrder = 3 + Value = 3 + OnChanged = ExpDivisionEditChanged + end + object WidthEdit: TSpinEdit + Left = 380 + Top = 92 + Width = 81 + Height = 23 + TabOrder = 4 + Value = 4 + OnChanged = WidthEditChanged + end + object Label6: TLabel + Left = 340 + Top = 96 + Width = 31 + Height = 15 + Caption = 'Width' + end + object cbZeroPadding: TCheckBox + Left = 100 + Top = 64 + Width = 149 + Height = 30 + Caption = 'Zero padding' + TabOrder = 11 + OnClick = cbZeroPaddingClick + end + object Label7: TLabel + Left = 504 + Top = 12 + Width = 49 + Height = 15 + Caption = 'Multiplier' + end + object MultiplierSelector: TComboBox + Left = 632 + Top = 8 + Width = 57 + Height = 23 + Style = csDropDownList + ItemHeight = 17 + Items.Strings = ( + #215 + '*') + ItemIndex = 0 + TabOrder = 18 + Text = #215 + OnChange = MultiplierSelectorChange + end + object Label8: TLabel + Left = 260 + Top = 40 + Width = 111 + Height = 15 + Caption = 'Fractional part digits' + end + object FractionDigitsEdit: TSpinEdit + Left = 380 + Top = 36 + Width = 81 + Height = 23 + Max = 64 + TabOrder = 2 + Value = 6 + OnChanged = FractionDigitsEditChanged + end +end diff --git a/official/1.96/examples/common/pcre/PCREDemo.dof b/official/1.96/examples/common/pcre/PCREDemo.dof new file mode 100644 index 0000000..abe45c2 --- /dev/null +++ b/official/1.96/examples/common/pcre/PCREDemo.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=..\..\..\bin diff --git a/official/1.96/examples/common/pcre/PCREDemo.dpr b/official/1.96/examples/common/pcre/PCREDemo.dpr new file mode 100644 index 0000000..aa4d34c --- /dev/null +++ b/official/1.96/examples/common/pcre/PCREDemo.dpr @@ -0,0 +1,14 @@ +program PCREDemo; + +uses + Forms, + PCREDemoMain in 'PCREDemoMain.pas' {frmMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.Title := 'JclPCRE Demo'; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/official/1.96/examples/common/pcre/PCREDemo.res b/official/1.96/examples/common/pcre/PCREDemo.res new file mode 100644 index 0000000..ff24fa7 Binary files /dev/null and b/official/1.96/examples/common/pcre/PCREDemo.res differ diff --git a/official/1.96/examples/common/pcre/PCREDemoMain.dfm b/official/1.96/examples/common/pcre/PCREDemoMain.dfm new file mode 100644 index 0000000..43d7b99 --- /dev/null +++ b/official/1.96/examples/common/pcre/PCREDemoMain.dfm @@ -0,0 +1,233 @@ +object frmMain: TfrmMain + Left = 300 + Top = 115 + Width = 470 + Height = 370 + Caption = 'JclPCRE Demo' + Color = clBtnFace + Constraints.MinHeight = 370 + Constraints.MinWidth = 470 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 12 + Top = 10 + Width = 96 + Height = 13 + Caption = 'Reg&ular Expression:' + FocusControl = edRegExpr + end + object edRegExpr: TEdit + Left = 12 + Top = 24 + Width = 271 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + OnChange = edRegExprChange + end + object btnFind: TButton + Left = 292 + Top = 24 + Width = 75 + Height = 25 + Action = acFind + Anchors = [akTop, akRight] + TabOrder = 1 + end + object btnFindNext: TButton + Left = 370 + Top = 24 + Width = 75 + Height = 25 + Action = acFindNext + Anchors = [akTop, akRight] + TabOrder = 2 + end + object reFile: TMemo + Left = 12 + Top = 54 + Width = 437 + Height = 180 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Courier New' + Font.Style = [] + HideSelection = False + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 3 + WantReturns = False + WordWrap = False + end + object btnOpen: TButton + Left = 364 + Top = 294 + Width = 75 + Height = 25 + Action = acOpen + Anchors = [akRight, akBottom] + TabOrder = 4 + end + object chkIgnoreCase: TCheckBox + Left = 18 + Top = 244 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Ignore Case' + Checked = True + State = cbChecked + TabOrder = 5 + end + object chkMultiLine: TCheckBox + Left = 18 + Top = 262 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Multi Line' + Checked = True + State = cbChecked + TabOrder = 6 + end + object chkDotAll: TCheckBox + Left = 18 + Top = 280 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Dot All' + TabOrder = 7 + end + object chkExtended: TCheckBox + Left = 18 + Top = 298 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Extended' + TabOrder = 8 + end + object chkAnchored: TCheckBox + Left = 132 + Top = 244 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Anchored' + TabOrder = 9 + end + object chkDollarEndOnly: TCheckBox + Left = 132 + Top = 262 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Dollar End Onl&y' + TabOrder = 10 + end + object chkExtra: TCheckBox + Left = 132 + Top = 280 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Ex&tra' + TabOrder = 11 + end + object chkNotBOL: TCheckBox + Left = 132 + Top = 298 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Not &BOL' + TabOrder = 12 + end + object chkNotEOL: TCheckBox + Left = 246 + Top = 244 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Not EO&L' + TabOrder = 13 + end + object chkUnGreedy: TCheckBox + Left = 246 + Top = 262 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Ungreedy' + Checked = True + State = cbChecked + TabOrder = 14 + end + object chkNotEmpty: TCheckBox + Left = 246 + Top = 280 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Not Em&pty' + Checked = True + State = cbChecked + TabOrder = 15 + end + object chkUTF8: TCheckBox + Left = 246 + Top = 298 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'UTF&8' + TabOrder = 16 + end + object sbMain: TStatusBar + Left = 0 + Top = 324 + Width = 462 + Height = 19 + Panels = < + item + Width = 50 + end> + SimplePanel = False + end + object alMain: TActionList + Left = 144 + Top = 102 + object acFind: TAction + Caption = '&Find' + ShortCut = 16454 + OnExecute = acFindExecute + end + object acFindNext: TAction + Caption = 'Find &Next' + ShortCut = 114 + OnExecute = acFindNextExecute + end + object acOpen: TAction + Caption = '&Open...' + ShortCut = 16463 + OnExecute = acOpenExecute + end + end + object odOpen: TOpenDialog + Left = 240 + Top = 120 + end +end diff --git a/official/1.96/examples/common/pcre/PCREDemoMain.pas b/official/1.96/examples/common/pcre/PCREDemoMain.pas new file mode 100644 index 0000000..4ea5a0a --- /dev/null +++ b/official/1.96/examples/common/pcre/PCREDemoMain.pas @@ -0,0 +1,200 @@ +unit PCREDemoMain; + +interface + +uses + Windows, Messages, + SysUtils, Classes, Forms, Dialogs, ActnList, ComCtrls, StdCtrls, Controls, + JclPCRE; + +type + TfrmMain = class(TForm) + edRegExpr: TEdit; + btnFind: TButton; + btnFindNext: TButton; + Label1: TLabel; + reFile: TMemo; + btnOpen: TButton; + alMain: TActionList; + acFind: TAction; + acFindNext: TAction; + acOpen: TAction; + odOpen: TOpenDialog; + chkIgnoreCase: TCheckBox; + chkMultiLine: TCheckBox; + chkDotAll: TCheckBox; + chkExtended: TCheckBox; + chkAnchored: TCheckBox; + chkDollarEndOnly: TCheckBox; + chkExtra: TCheckBox; + chkNotBOL: TCheckBox; + chkNotEOL: TCheckBox; + chkUnGreedy: TCheckBox; + chkNotEmpty: TCheckBox; + chkUTF8: TCheckBox; + sbMain: TStatusBar; + procedure acOpenExecute(Sender: TObject); + procedure acFindExecute(Sender: TObject); + procedure acFindNextExecute(Sender: TObject); + procedure edRegExprChange(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormCreate(Sender: TObject); + + private + { Private declarations } + RE: TJclAnsiRegEx; + FMatchIndex: integer; + procedure SelectText(Offset: TJclAnsiCaptureOffset); + procedure Match; + function GetUIOptions: TJclAnsiRegExOptions; + procedure UpdateUIOptions; + procedure LoadFromFile(const Filename:string); + protected + procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES; + public + { Public declarations } + end; + +var + frmMain: TfrmMain; + +implementation +uses + ShellAPI; + +{$R *.dfm} + +procedure TfrmMain.acOpenExecute(Sender: TObject); +begin + if odOpen.Execute then + LoadFromFile(odOpen.Filename); +end; + +procedure TfrmMain.acFindExecute(Sender: TObject); +begin + FreeAndNil(RE); + RE := TJclAnsiRegEx.Create; + RE.Options := GetUIOptions; + RE.Compile(edRegExpr.Text, false, false); + FMatchIndex := 1; + Match; +end; + +procedure TfrmMain.acFindNextExecute(Sender: TObject); +begin + if RE = nil then + acFind.Execute + else + Match; +end; + +procedure TfrmMain.SelectText(Offset: TJclAnsiCaptureOffset); +begin + reFile.SelStart := Offset.FirstPos; + reFile.SelLength := Offset.LastPos - Offset.FirstPos; +end; + +procedure TfrmMain.Match; +begin + RE.Options := GetUIOptions; + if not RE.Match(reFile.Lines.Text, FMatchIndex) then + begin + FreeAndNil(RE); + MessageDlg('No matches found', mtInformation, [mbOK], 0); + end + else + begin + SelectText(RE.CaptureOffset[0]); + FMatchIndex := RE.CaptureOffset[0].LastPos; + end; + UpdateUIOptions; +end; + +function TfrmMain.GetUIOptions: TJclAnsiRegExOptions; +begin + Result := []; + if chkIgnoreCase.Checked then + Include(Result, roIgnoreCase); + if chkMultiLine.Checked then + Include(Result, roMultiLine); + if chkDotAll.Checked then + Include(Result, roDotAll); + if chkExtended.Checked then + Include(Result, roExtended); + if chkAnchored.Checked then + Include(Result, roAnchored); + if chkDollarEndOnly.Checked then + Include(Result, roDollarEndOnly); + if chkExtra.Checked then + Include(Result, roExtra); + if chkNotBOL.Checked then + Include(Result, roNotBOL); + if chkNotEOL.Checked then + Include(Result, roNotEOL); + if chkUngreedy.Checked then + Include(Result, roUnGreedy); + if chkNotEmpty.Checked then + Include(Result, roNotEmpty); + if chkUTF8.Checked then + Include(Result, roUTF8); +end; + +procedure TfrmMain.UpdateUIOptions; +var + Options: TJclAnsiRegExOptions; +begin + if RE = nil then Exit; + Options := RE.Options; + chkIgnoreCase.Checked := roIgnoreCase in Options; + chkMultiLine.Checked := roMultiLine in Options; + chkDotAll.Checked := roDotAll in Options; + chkExtended.Checked := roExtended in Options; + chkAnchored.Checked := roAnchored in Options; + chkDollarEndOnly.Checked := roDollarEndOnly in Options; + chkExtra.Checked := roExtra in Options; + chkNotBOL.Checked := roNotBOL in Options; + chkNotEOL.Checked := roNotEOL in Options; + chkUngreedy.Checked := roUnGreedy in Options; + chkNotEmpty.Checked := roNotEmpty in Options; + chkUTF8.Checked := roUTF8 in Options; +end; + +procedure TfrmMain.edRegExprChange(Sender: TObject); +begin + FreeAndNil(RE); +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + FreeAndNil(RE); +end; + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + DragAcceptFiles(Handle, True); +end; + +procedure TfrmMain.WMDropFiles(var Message: TWMDropFiles); +var + i:integer; + buf:array [0..MAX_PATH] of char; +begin + i := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0); + if i > 0 then + try + DragQueryFile(Message.Drop, 0, buf, sizeof(buf)); + if FileExists(buf) then + LoadFromFile(buf); + finally + DragFinish(Message.Drop); + end; +end; + +procedure TfrmMain.LoadFromFile(const Filename: string); +begin + reFile.Lines.LoadFromFile(Filename); + sbMain.Panels[0].Text := ' ' + Filename; +end; + +end. + diff --git a/official/1.96/examples/common/pcre/QPCREDemo.dof b/official/1.96/examples/common/pcre/QPCREDemo.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/common/pcre/QPCREDemo.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/common/pcre/QPCREDemo.dpr b/official/1.96/examples/common/pcre/QPCREDemo.dpr new file mode 100644 index 0000000..7fab4eb --- /dev/null +++ b/official/1.96/examples/common/pcre/QPCREDemo.dpr @@ -0,0 +1,14 @@ +program QPCREDemo; + +uses + QForms, + QPCREDemoMain in 'QPCREDemoMain.pas' {frmMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.Title := 'JclPCRE Demo'; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/official/1.96/examples/common/pcre/QPCREDemo.res b/official/1.96/examples/common/pcre/QPCREDemo.res new file mode 100644 index 0000000..ff24fa7 Binary files /dev/null and b/official/1.96/examples/common/pcre/QPCREDemo.res differ diff --git a/official/1.96/examples/common/pcre/QPCREDemoMain.pas b/official/1.96/examples/common/pcre/QPCREDemoMain.pas new file mode 100644 index 0000000..e030bfd --- /dev/null +++ b/official/1.96/examples/common/pcre/QPCREDemoMain.pas @@ -0,0 +1,176 @@ +unit QPCREDemoMain; + +interface + +uses + Types, SysUtils, Classes, + QGraphics, QControls, QForms, QDialogs, QActnList, QStdCtrls, QComCtrls, + JclPCRE, QExtCtrls; + +type + TfrmMain = class(TForm) + edRegExpr: TEdit; + btnFind: TButton; + btnFindNext: TButton; + Label1: TLabel; + reFile: TMemo; + btnOpen: TButton; + alMain: TActionList; + acFind: TAction; + acFindNext: TAction; + acOpen: TAction; + odOpen: TOpenDialog; + chkIgnoreCase: TCheckBox; + chkMultiLine: TCheckBox; + chkDotAll: TCheckBox; + chkExtended: TCheckBox; + chkAnchored: TCheckBox; + chkDollarEndOnly: TCheckBox; + chkExtra: TCheckBox; + chkNotBOL: TCheckBox; + chkNotEOL: TCheckBox; + chkUnGreedy: TCheckBox; + chkNotEmpty: TCheckBox; + chkUTF8: TCheckBox; + sbMain: TStatusBar; + procedure acOpenExecute(Sender: TObject); + procedure acFindExecute(Sender: TObject); + procedure acFindNextExecute(Sender: TObject); + procedure edRegExprChange(Sender: TObject); + procedure FormDestroy(Sender: TObject); + + private + { Private declarations } + RE: TJclAnsiRegEx; + FMatchIndex: integer; + procedure SelectText(Offset: TJclAnsiCaptureOffset); + procedure Match; + function GetUIOptions: TJclAnsiRegExOptions; + procedure UpdateUIOptions; + procedure LoadFromFile(const Filename:string); + protected + //procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES; + public + { Public declarations } + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.xfm} + +procedure TfrmMain.acOpenExecute(Sender: TObject); +begin + if odOpen.Execute then + LoadFromFile(odOpen.Filename); +end; + +procedure TfrmMain.acFindExecute(Sender: TObject); +begin + FreeAndNil(RE); + RE := TJclAnsiRegEx.Create; + RE.Options := GetUIOptions; + RE.Compile(edRegExpr.Text, false, false); + FMatchIndex := 1; + Match; +end; + +procedure TfrmMain.acFindNextExecute(Sender: TObject); +begin + if RE = nil then + acFind.Execute + else + Match; +end; + +procedure TfrmMain.SelectText(Offset: TJclAnsiCaptureOffset); +begin + reFile.SelStart := Offset.FirstPos; + reFile.SelLength := Offset.LastPos - Offset.FirstPos; +end; + +procedure TfrmMain.Match; +begin + RE.Options := GetUIOptions; + if not RE.Match(reFile.Lines.Text, FMatchIndex) then + begin + FreeAndNil(RE); + MessageDlg('No matches found', mtInformation, [mbOK], 0); + end + else + begin + SelectText(RE.CaptureOffset[0]); + FMatchIndex := RE.CaptureOffset[0].LastPos; + end; + UpdateUIOptions; +end; + +function TfrmMain.GetUIOptions: TJclAnsiRegExOptions; +begin + Result := []; + if chkIgnoreCase.Checked then + Include(Result, roIgnoreCase); + if chkMultiLine.Checked then + Include(Result, roMultiLine); + if chkDotAll.Checked then + Include(Result, roDotAll); + if chkExtended.Checked then + Include(Result, roExtended); + if chkAnchored.Checked then + Include(Result, roAnchored); + if chkDollarEndOnly.Checked then + Include(Result, roDollarEndOnly); + if chkExtra.Checked then + Include(Result, roExtra); + if chkNotBOL.Checked then + Include(Result, roNotBOL); + if chkNotEOL.Checked then + Include(Result, roNotEOL); + if chkUngreedy.Checked then + Include(Result, roUnGreedy); + if chkNotEmpty.Checked then + Include(Result, roNotEmpty); + if chkUTF8.Checked then + Include(Result, roUTF8); +end; + +procedure TfrmMain.UpdateUIOptions; +var + Options: TJclAnsiRegExOptions; +begin + if RE = nil then Exit; + Options := RE.Options; + chkIgnoreCase.Checked := roIgnoreCase in Options; + chkMultiLine.Checked := roMultiLine in Options; + chkDotAll.Checked := roDotAll in Options; + chkExtended.Checked := roExtended in Options; + chkAnchored.Checked := roAnchored in Options; + chkDollarEndOnly.Checked := roDollarEndOnly in Options; + chkExtra.Checked := roExtra in Options; + chkNotBOL.Checked := roNotBOL in Options; + chkNotEOL.Checked := roNotEOL in Options; + chkUngreedy.Checked := roUnGreedy in Options; + chkNotEmpty.Checked := roNotEmpty in Options; + chkUTF8.Checked := roUTF8 in Options; +end; + +procedure TfrmMain.edRegExprChange(Sender: TObject); +begin + FreeAndNil(RE); +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + FreeAndNil(RE); +end; + +procedure TfrmMain.LoadFromFile(const Filename: string); +begin + reFile.Lines.LoadFromFile(Filename); + sbMain.Panels[0].Text := ' ' + Filename; +end; + +end. + diff --git a/official/1.96/examples/common/pcre/QPCREDemoMain.xfm b/official/1.96/examples/common/pcre/QPCREDemoMain.xfm new file mode 100644 index 0000000..711e2d9 --- /dev/null +++ b/official/1.96/examples/common/pcre/QPCREDemoMain.xfm @@ -0,0 +1,239 @@ +object frmMain: TfrmMain + Left = 300 + Top = 115 + Width = 470 + Height = 370 + VertScrollBar.Range = 68 + HorzScrollBar.Range = 343 + ActiveControl = edRegExpr + Caption = 'JclPCRE Demo' + Color = clButton + Constraints.MinHeight = 370 + Constraints.MinWidth = 470 + Font.Color = clText + Font.Height = 11 + Font.Name = 'MS Shell Dlg 2' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentFont = False + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + TextWidth = 6 + object Label1: TLabel + Left = 12 + Top = 10 + Width = 96 + Height = 13 + Caption = 'Reg&ular Expression:' + FocusControl = edRegExpr + end + object edRegExpr: TEdit + Left = 12 + Top = 24 + Width = 271 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + OnChange = edRegExprChange + end + object btnFind: TButton + Left = 292 + Top = 24 + Width = 75 + Height = 25 + Action = acFind + Anchors = [akTop, akRight] + Caption = '&Find' + TabOrder = 1 + end + object btnFindNext: TButton + Left = 370 + Top = 24 + Width = 75 + Height = 25 + Action = acFindNext + Anchors = [akTop, akRight] + Caption = 'Find &Next' + TabOrder = 2 + end + object reFile: TMemo + Left = 12 + Top = 54 + Width = 437 + Height = 180 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Color = clText + Font.Height = 13 + Font.Name = 'Courier New' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 3 + WantReturns = False + WordWrap = False + end + object btnOpen: TButton + Left = 364 + Top = 294 + Width = 75 + Height = 25 + Action = acOpen + Anchors = [akRight, akBottom] + Caption = '&Open...' + TabOrder = 4 + end + object chkIgnoreCase: TCheckBox + Left = 18 + Top = 244 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Ignore Case' + Checked = True + State = cbChecked + TabOrder = 5 + end + object chkMultiLine: TCheckBox + Left = 18 + Top = 262 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Multi Line' + Checked = True + State = cbChecked + TabOrder = 6 + end + object chkDotAll: TCheckBox + Left = 18 + Top = 280 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Dot All' + TabOrder = 7 + end + object chkExtended: TCheckBox + Left = 18 + Top = 298 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Extended' + TabOrder = 8 + end + object chkAnchored: TCheckBox + Left = 132 + Top = 244 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Anchored' + TabOrder = 9 + end + object chkDollarEndOnly: TCheckBox + Left = 132 + Top = 262 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Dollar End Onl&y' + TabOrder = 10 + end + object chkExtra: TCheckBox + Left = 132 + Top = 280 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Ex&tra' + TabOrder = 11 + end + object chkNotBOL: TCheckBox + Left = 132 + Top = 298 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Not &BOL' + TabOrder = 12 + end + object chkNotEOL: TCheckBox + Left = 246 + Top = 244 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Not EO&L' + TabOrder = 13 + end + object chkUnGreedy: TCheckBox + Left = 246 + Top = 262 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = '&Ungreedy' + Checked = True + State = cbChecked + TabOrder = 14 + end + object chkNotEmpty: TCheckBox + Left = 246 + Top = 280 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'Not Em&pty' + Checked = True + State = cbChecked + TabOrder = 15 + end + object chkUTF8: TCheckBox + Left = 246 + Top = 298 + Width = 97 + Height = 17 + Anchors = [akLeft, akBottom] + Caption = 'UTF&8' + TabOrder = 16 + end + object sbMain: TStatusBar + Left = 0 + Top = 351 + Width = 470 + Height = 19 + Panels = < + item + end> + end + object alMain: TActionList + Left = 144 + Top = 102 + object acFind: TAction + Caption = '&Find' + ShortCut = 16454 + OnExecute = acFindExecute + end + object acFindNext: TAction + Caption = 'Find &Next' + ShortCut = 114 + OnExecute = acFindNextExecute + end + object acOpen: TAction + Caption = '&Open...' + ShortCut = 16463 + OnExecute = acOpenExecute + end + end + object odOpen: TOpenDialog + Title = 'Open' + Left = 240 + Top = 120 + end +end diff --git a/official/1.96/examples/common/rtti/QRTTIDemo.dof b/official/1.96/examples/common/rtti/QRTTIDemo.dof new file mode 100644 index 0000000..d447a0b --- /dev/null +++ b/official/1.96/examples/common/rtti/QRTTIDemo.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=../../../bin diff --git a/official/1.96/examples/common/rtti/QRTTIDemo.dpr b/official/1.96/examples/common/rtti/QRTTIDemo.dpr new file mode 100644 index 0000000..90058b3 --- /dev/null +++ b/official/1.96/examples/common/rtti/QRTTIDemo.dpr @@ -0,0 +1,13 @@ +program QRTTIDemo; + +uses + QForms, + QRTTIDemoMain in 'QRTTIDemoMain.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/common/rtti/QRTTIDemo.res b/official/1.96/examples/common/rtti/QRTTIDemo.res new file mode 100644 index 0000000..3f19637 Binary files /dev/null and b/official/1.96/examples/common/rtti/QRTTIDemo.res differ diff --git a/official/1.96/examples/common/rtti/QRTTIDemoMain.pas b/official/1.96/examples/common/rtti/QRTTIDemoMain.pas new file mode 100644 index 0000000..ad3fe0f --- /dev/null +++ b/official/1.96/examples/common/rtti/QRTTIDemoMain.pas @@ -0,0 +1,332 @@ +unit QRTTIDemoMain; + +interface + +{$I jcl.inc} + +uses + SysUtils, Classes, QGraphics, QControls, QForms, QDialogs, + QStdCtrls; + +type + TForm1 = class(TForm) + mmResult: TMemo; + Button1: TButton; + Button2: TButton; + Button3: TButton; + Button4: TButton; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure Button4Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.xfm} + +uses + JclSysUtils, JclRTTI, TypInfo; + +type + TDifficultEvent = procedure(const Sender: TObject; var I: Integer; out Stuff; + IntArr: array of Integer; const VarArray: array of const) of object; + + TLargeEnum = ( + le001, le002, le003, le004, le005, le006, le007, le008, le009, le010, + le011, le012, le013, le014, le015, le016, le017, le018, le019, le020, + le021, le022, le023, le024, le025, le026, le027, le028, le029, le030, + le031, le032, le033, le034, le035, le036, le037, le038, le039, le040, + le041, le042, le043, le044, le045, le046, le047, le048, le049, le050, + le051, le052, le053, le054, le055, le056, le057, le058, le059, le060, + le061, le062, le063, le064, le065, le066, le067, le068, le069, le070, + le071, le072, le073, le074, le075, le076, le077, le078, le079, le080, + le081, le082, le083, le084, le085, le086, le087, le088, le089, le090, + le091, le092, le093, le094, le095, le096, le097, le098, le099, le100, + le101, le102, le103, le104, le105, le106, le107, le108, le109, le110, + le111, le112, le113, le114, le115, le116, le117, le118, le119, le120, + le121, le122, le123, le124, le125, le126, le127, le128, le129, le130, + le131, le132, le133, le134, le135, le136, le137, le138, le139, le140, + le141, le142, le143, le144, le145, le146, le147, le148, le149, le150, + le151, le152, le153, le154, le155, le156, le157, le158, le159, le160); + + TLargeSet = set of TLargeEnum; + TLargeSubEnum = le019 .. le150; + TLargeSubSet = set of TLargeSubEnum; + + TIntRange = 0 .. 112; + + TSetNoEnum = set of (st01, st02, st03, st04); + TSetOfByte = set of Byte; + TInt2Range = 4..11; + TSetOfIntRange = set of TInt2Range; + + TUpcaseRange = 'A' .. 'Z'; + + TMyDouble = Double; + TMyDouble2 = type Double; + + TIntArray = array of Integer; + TIntArray2 = array of array of Integer; + TEnumArray = array of (ar1, ar2, ar3); + TRecArray = array of record x1: Integer; x2: Integer; end; + TSetArray = array of set of (ars1, ars2, ars3); + TSetArray2 = array of array of array of TSetNoEnum; + TWideStrArray = array of Widestring; + +var + MyEnum: PTypeInfo; + MySubRange: PTypeInfo; + MySet: PTypeInfo; + MyCutLowerEnum: PTypeInfo; + +procedure TForm1.Button1Click(Sender: TObject); +var + Writer: IJclInfoWriter; + +begin + mmResult.Lines.Clear; + Writer := TJclInfoStringsWriter.Create(mmResult.Lines, 72); + JclTypeInfo(TypeInfo(Word)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntRange)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeEnum)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSubEnum)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSet)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSubSet)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetNoEnum)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetOfByte)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetOfIntRange)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Single)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Double)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Extended)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Comp)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Currency)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Real)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TDateTime)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TMyDouble)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TMyDouble2)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(ShortString)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TScrollingWinControl)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TDifficultEvent)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(IJclOrdinalRangeTypeInfo)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Int64)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Longword)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntArray)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntArray2)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TEnumArray)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TRecArray)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetArray)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetArray2)).WriteTo(Writer); +end; + +procedure TForm1.Button2Click(Sender: TObject); +var + Writer: IJclInfoWriter; + LargeSubSet: TLargeSubSet; + GUID: TGUID; + +begin + mmResult.Lines.Clear; + Writer := TJclInfoStringsWriter.Create(mmResult.Lines, 72); + Writer.Writeln('Set conversions:'); + Writer.Indent; + try + Writer.Writeln('StrToSet with string=''[le019..le023, le033, le045..le049]'''); + JclStrToSet(TypeInfo(TLargeSubSet), LargeSubSet, '[le019..le023, le033, le045..le049]'); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, True) + ''', with WantRanges=True'); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, False) + ''', with WantRanges=False'); + Writer.Writeln(''); + Writer.Writeln('StrToSet with string='''''); + JclStrToSet(TypeInfo(TLargeSubSet), LargeSubSet, ''); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, True) + ''', with WantRanges=True'); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, False) + ''', with WantRanges=False'); + Writer.Writeln(''); + Writer.Writeln('StrToSet with string=''le019 .. le023,le033 , le045 .. le049 '''); + JclStrToSet(TypeInfo(TLargeSubSet), LargeSubSet, 'le019 .. le023,le033 , le045 .. le049 '); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, True) + ''', with WantRanges=True'); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, False) + ''', with WantRanges=False'); + Writer.Writeln(''); + finally + Writer.Outdent; + end; + Writer.Writeln('GUID conversions:'); + Writer.Indent; + try + Writer.Writeln('GUIDToStr: ' + JclGUIDToString(IJclTypeInfo)); + GUID := JclStringToGUID(JclGUIDToString(IJclTypeInfo)); + Writer.Writeln('StrToGUID: ' + JclGUIDToString(GUID)); + finally + Writer.Outdent; + end; + {$IFDEF COMPILER5_UP} + Writer.Writeln(''); + Writer.Writeln('Integer conversions:'); + Writer.Indent; + try + Writer.Writeln('TypedIntToStr: ' + JclTypedIntToStr(crArrow, TypeInfo(TCursor))); + Writer.Writeln('StrToTypedInt: ' + IntToStr(JclStrToTypedInt('crArrow', TypeInfo(TCursor))) + ' (should be ' + IntToStr(crArrow) + ')'); + Writer.Writeln(''); + Writer.Writeln('TypedIntToStr: ' + JclTypedIntToStr(1, TypeInfo(TCursor))); + Writer.Writeln('StrToTypedInt: ' + IntToStr(JclStrToTypedInt('1', TypeInfo(TCursor))) + ' (should be 1)'); + finally + Writer.Outdent; + end; + {$ENDIF} +end; + +procedure TForm1.Button3Click(Sender: TObject); +var + Writer: IJclInfoWriter; + +begin + mmResult.Lines.Clear; + Writer := TJclInfoStringsWriter.Create(mmResult.Lines, 80); + Writer.Writeln('Declarations:'); + Writer.Indent; + try + JclTypeInfo(TypeInfo(TLargeEnum)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSubEnum)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSet)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetNoEnum)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Byte)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetOfByte)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Char)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TUpcaseRange)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TDifficultEvent)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(IJclBaseInfo)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(IJclTypeInfo)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TDateTime)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TMyDouble)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TMyDouble2)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TScrollingWinControl)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TJclInfoWriter)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TPersistent)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntArray)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntArray2)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TEnumArray)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TRecArray)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetArray)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetArray2)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TWideStrArray)).DeclarationTo(Writer); + finally + Writer.Outdent; + end; +end; + +procedure TForm1.Button4Click(Sender: TObject); +var + Writer: IJclInfoWriter; + +begin + mmResult.Lines.Clear; + Writer := TJclInfoStringsWriter.Create(mmResult.Lines, 80); + Writer.Writeln('JclGenerateEnumType with literals:'); + Writer.Indent; + try + JclTypeInfo(MyEnum).WriteTo(Writer); + Writer.Writeln; + JclTypeInfo(MyEnum).DeclarationTo(Writer); + finally + Writer.Outdent; + end; + Writer.Writeln; + Writer.Writeln('JclGenerateSubRange:'); + Writer.Indent; + try + JclTypeInfo(MySubRange).WriteTo(Writer); + Writer.Writeln; + JclTypeInfo(MySubRange).DeclarationTo(Writer); + finally + Writer.Outdent; + end; + Writer.Writeln; + Writer.Writeln('JclGenerateSetType:'); + Writer.Indent; + try + JclTypeInfo(MySet).WriteTo(Writer); + Writer.Writeln; + JclTypeInfo(MySet).DeclarationTo(Writer); + finally + Writer.Outdent; + end; + Writer.Writeln; + Writer.Writeln('JclGenerateEnumType based on TLargeEnum:'); + Writer.Indent; + try + JclTypeInfo(MyCutLowerEnum).WriteTo(Writer); + Writer.Writeln; + JclTypeInfo(MyCutLowerEnum).DeclarationTo(Writer); + finally + Writer.Outdent; + end; +end; + +initialization + //JclHookIs(JclIsClassByName); + MyEnum := JclGenerateEnumType('MyEnum', ['First value', 'Second value', + 'Third value', 'Fourth value', 'Fifth value']); + MySubRange := JclGenerateSubRange(MyEnum, 'MySubRange', 1, 3); + MySet := JclGenerateSetType(MyEnum, 'MySet'); + MyCutLowerEnum := JclGenerateEnumTypeBasedOn('MyCutLower', TypeInfo(TLargeEnum), + PREFIX_CUT_LOWERCASE); + +end. diff --git a/official/1.96/examples/common/rtti/QRTTIDemoMain.xfm b/official/1.96/examples/common/rtti/QRTTIDemoMain.xfm new file mode 100644 index 0000000..44e1342 --- /dev/null +++ b/official/1.96/examples/common/rtti/QRTTIDemoMain.xfm @@ -0,0 +1,76 @@ +object Form1: TForm1 + Left = 154 + Top = 154 + Width = 1192 + Height = 834 + HorzScrollBar.Range = 315 + ActiveControl = mmResult + Caption = 'Form1' + Color = clButton + Font.Color = clText + Font.Height = 11 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentFont = False + Scaled = False + PixelsPerInch = 96 + object mmResult: TMemo + Left = 0 + Top = 0 + Width = 1184 + Height = 779 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.CharSet = fcsLatin1 + Font.Color = clText + Font.Height = 11 + Font.Name = 'Lucida Console' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentFont = False + ScrollBars = ssVertical + TabOrder = 0 + end + object Button1: TButton + Left = 0 + Top = 782 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Type info' + TabOrder = 1 + OnClick = Button1Click + end + object Button2: TButton + Left = 80 + Top = 782 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Conversions' + TabOrder = 2 + OnClick = Button2Click + end + object Button3: TButton + Left = 160 + Top = 782 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Declarations' + TabOrder = 3 + OnClick = Button3Click + end + object Button4: TButton + Left = 240 + Top = 782 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Custom types' + TabOrder = 4 + OnClick = Button4Click + end +end diff --git a/official/1.96/examples/common/rtti/RTTIDemoMain.dfm b/official/1.96/examples/common/rtti/RTTIDemoMain.dfm new file mode 100644 index 0000000..aefd0f0 --- /dev/null +++ b/official/1.96/examples/common/rtti/RTTIDemoMain.dfm @@ -0,0 +1,71 @@ +object Form1: TForm1 + Left = 98 + Top = 153 + Width = 975 + Height = 466 + Caption = 'Form1' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object mmResult: TMemo + Left = 0 + Top = 0 + Width = 967 + Height = 411 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Lucida Console' + Font.Style = [] + ParentFont = False + ScrollBars = ssVertical + TabOrder = 0 + end + object Button1: TButton + Left = 0 + Top = 414 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Type info' + TabOrder = 1 + OnClick = Button1Click + end + object Button2: TButton + Left = 80 + Top = 414 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Conversions' + TabOrder = 2 + OnClick = Button2Click + end + object Button3: TButton + Left = 160 + Top = 414 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Declarations' + TabOrder = 3 + OnClick = Button3Click + end + object Button4: TButton + Left = 240 + Top = 414 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Custom types' + TabOrder = 4 + OnClick = Button4Click + end +end diff --git a/official/1.96/examples/common/rtti/RTTIDemoMain.pas b/official/1.96/examples/common/rtti/RTTIDemoMain.pas new file mode 100644 index 0000000..d87c17f --- /dev/null +++ b/official/1.96/examples/common/rtti/RTTIDemoMain.pas @@ -0,0 +1,331 @@ +unit RTTIDemoMain; + +interface + +{$I jcl.inc} + +uses + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; + +type + TForm1 = class(TForm) + mmResult: TMemo; + Button1: TButton; + Button2: TButton; + Button3: TButton; + Button4: TButton; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure Button4Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +uses + JclSysUtils, JclRTTI, TypInfo; + +type + TDifficultEvent = procedure(const Sender: TObject; var I: Integer; out Stuff; + IntArr: array of Integer; const VarArray: array of const) of object; + + TLargeEnum = ( + le001, le002, le003, le004, le005, le006, le007, le008, le009, le010, + le011, le012, le013, le014, le015, le016, le017, le018, le019, le020, + le021, le022, le023, le024, le025, le026, le027, le028, le029, le030, + le031, le032, le033, le034, le035, le036, le037, le038, le039, le040, + le041, le042, le043, le044, le045, le046, le047, le048, le049, le050, + le051, le052, le053, le054, le055, le056, le057, le058, le059, le060, + le061, le062, le063, le064, le065, le066, le067, le068, le069, le070, + le071, le072, le073, le074, le075, le076, le077, le078, le079, le080, + le081, le082, le083, le084, le085, le086, le087, le088, le089, le090, + le091, le092, le093, le094, le095, le096, le097, le098, le099, le100, + le101, le102, le103, le104, le105, le106, le107, le108, le109, le110, + le111, le112, le113, le114, le115, le116, le117, le118, le119, le120, + le121, le122, le123, le124, le125, le126, le127, le128, le129, le130, + le131, le132, le133, le134, le135, le136, le137, le138, le139, le140, + le141, le142, le143, le144, le145, le146, le147, le148, le149, le150, + le151, le152, le153, le154, le155, le156, le157, le158, le159, le160); + + TLargeSet = set of TLargeEnum; + TLargeSubEnum = le019 .. le150; + TLargeSubSet = set of TLargeSubEnum; + + TIntRange = 0 .. 112; + + TSetNoEnum = set of (st01, st02, st03, st04); + TSetOfByte = set of Byte; + TInt2Range = 4..11; + TSetOfIntRange = set of TInt2Range; + + TUpcaseRange = 'A' .. 'Z'; + + TMyDouble = Double; + TMyDouble2 = type Double; + + TIntArray = array of Integer; + TIntArray2 = array of array of Integer; + TEnumArray = array of (ar1, ar2, ar3); + TRecArray = array of record x1: Integer; x2: Integer; end; + TSetArray = array of set of (ars1, ars2, ars3); + TSetArray2 = array of array of array of TSetNoEnum; + TWideStrArray = array of Widestring; + +var + MyEnum: PTypeInfo; + MySubRange: PTypeInfo; + MySet: PTypeInfo; + MyCutLowerEnum: PTypeInfo; + +procedure TForm1.Button1Click(Sender: TObject); +var + Writer: IJclInfoWriter; + +begin + mmResult.Lines.Clear; + Writer := TJclInfoStringsWriter.Create(mmResult.Lines, 72); + JclTypeInfo(TypeInfo(Word)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntRange)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeEnum)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSubEnum)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSet)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSubSet)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetNoEnum)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetOfByte)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetOfIntRange)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Single)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Double)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Extended)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Comp)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Currency)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Real)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TDateTime)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TMyDouble)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TMyDouble2)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(ShortString)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TScrollingWinControl)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TDifficultEvent)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(IJclOrdinalRangeTypeInfo)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Int64)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Longword)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntArray)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntArray2)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TEnumArray)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TRecArray)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetArray)).WriteTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetArray2)).WriteTo(Writer); +end; + +procedure TForm1.Button2Click(Sender: TObject); +var + Writer: IJclInfoWriter; + LargeSubSet: TLargeSubSet; + GUID: TGUID; + +begin + mmResult.Lines.Clear; + Writer := TJclInfoStringsWriter.Create(mmResult.Lines, 72); + Writer.Writeln('Set conversions:'); + Writer.Indent; + try + Writer.Writeln('StrToSet with string=''[le019..le023, le033, le045..le049]'''); + JclStrToSet(TypeInfo(TLargeSubSet), LargeSubSet, '[le019..le023, le033, le045..le049]'); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, True) + ''', with WantRanges=True'); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, False) + ''', with WantRanges=False'); + Writer.Writeln(''); + Writer.Writeln('StrToSet with string='''''); + JclStrToSet(TypeInfo(TLargeSubSet), LargeSubSet, ''); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, True) + ''', with WantRanges=True'); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, False) + ''', with WantRanges=False'); + Writer.Writeln(''); + Writer.Writeln('StrToSet with string=''le019 .. le023,le033 , le045 .. le049 '''); + JclStrToSet(TypeInfo(TLargeSubSet), LargeSubSet, 'le019 .. le023,le033 , le045 .. le049 '); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, True) + ''', with WantRanges=True'); + Writer.Writeln('SetToStr of StrToSet = ''' + JclSetToStr(TypeInfo(TLargeSubSet), LargeSubSet, True, False) + ''', with WantRanges=False'); + Writer.Writeln(''); + finally + Writer.Outdent; + end; + Writer.Writeln('GUID conversions:'); + Writer.Indent; + try + Writer.Writeln('GUIDToStr: ' + JclGUIDToString(IJclTypeInfo)); + GUID := JclStringToGUID(JclGUIDToString(IJclTypeInfo)); + Writer.Writeln('StrToGUID: ' + JclGUIDToString(GUID)); + finally + Writer.Outdent; + end; + {$IFDEF COMPILER5_UP} + Writer.Writeln(''); + Writer.Writeln('Integer conversions:'); + Writer.Indent; + try + Writer.Writeln('TypedIntToStr: ' + JclTypedIntToStr(crArrow, TypeInfo(TCursor))); + Writer.Writeln('StrToTypedInt: ' + IntToStr(JclStrToTypedInt('crArrow', TypeInfo(TCursor))) + ' (should be ' + IntToStr(crArrow) + ')'); + Writer.Writeln(''); + Writer.Writeln('TypedIntToStr: ' + JclTypedIntToStr(1, TypeInfo(TCursor))); + Writer.Writeln('StrToTypedInt: ' + IntToStr(JclStrToTypedInt('1', TypeInfo(TCursor))) + ' (should be 1)'); + finally + Writer.Outdent; + end; + {$ENDIF} +end; + +procedure TForm1.Button3Click(Sender: TObject); +var + Writer: IJclInfoWriter; + +begin + mmResult.Lines.Clear; + Writer := TJclInfoStringsWriter.Create(mmResult.Lines, 80); + Writer.Writeln('Declarations:'); + Writer.Indent; + try + JclTypeInfo(TypeInfo(TLargeEnum)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSubEnum)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TLargeSet)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetNoEnum)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Byte)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetOfByte)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(Char)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TUpcaseRange)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TDifficultEvent)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(IJclBaseInfo)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(IJclTypeInfo)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TDateTime)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TMyDouble)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TMyDouble2)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TScrollingWinControl)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TJclInfoWriter)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TPersistent)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntArray)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TIntArray2)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TEnumArray)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TRecArray)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetArray)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TSetArray2)).DeclarationTo(Writer); + Writer.Writeln(''); + JclTypeInfo(TypeInfo(TWideStrArray)).DeclarationTo(Writer); + finally + Writer.Outdent; + end; +end; + +procedure TForm1.Button4Click(Sender: TObject); +var + Writer: IJclInfoWriter; + +begin + mmResult.Lines.Clear; + Writer := TJclInfoStringsWriter.Create(mmResult.Lines, 80); + Writer.Writeln('JclGenerateEnumType with literals:'); + Writer.Indent; + try + JclTypeInfo(MyEnum).WriteTo(Writer); + Writer.Writeln; + JclTypeInfo(MyEnum).DeclarationTo(Writer); + finally + Writer.Outdent; + end; + Writer.Writeln; + Writer.Writeln('JclGenerateSubRange:'); + Writer.Indent; + try + JclTypeInfo(MySubRange).WriteTo(Writer); + Writer.Writeln; + JclTypeInfo(MySubRange).DeclarationTo(Writer); + finally + Writer.Outdent; + end; + Writer.Writeln; + Writer.Writeln('JclGenerateSetType:'); + Writer.Indent; + try + JclTypeInfo(MySet).WriteTo(Writer); + Writer.Writeln; + JclTypeInfo(MySet).DeclarationTo(Writer); + finally + Writer.Outdent; + end; + Writer.Writeln; + Writer.Writeln('JclGenerateEnumType based on TLargeEnum:'); + Writer.Indent; + try + JclTypeInfo(MyCutLowerEnum).WriteTo(Writer); + Writer.Writeln; + JclTypeInfo(MyCutLowerEnum).DeclarationTo(Writer); + finally + Writer.Outdent; + end; +end; + +initialization + //JclHookIs(JclIsClassByName); + MyEnum := JclGenerateEnumType('MyEnum', ['First value', 'Second value', + 'Third value', 'Fourth value', 'Fifth value']); + MySubRange := JclGenerateSubRange(MyEnum, 'MySubRange', 1, 3); + MySet := JclGenerateSetType(MyEnum, 'MySet'); + MyCutLowerEnum := JclGenerateEnumTypeBasedOn('MyCutLower', TypeInfo(TLargeEnum), + PREFIX_CUT_LOWERCASE); + +end. diff --git a/official/1.96/examples/common/rtti/RTTIExample.dof b/official/1.96/examples/common/rtti/RTTIExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/common/rtti/RTTIExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/common/rtti/RTTIExample.dpr b/official/1.96/examples/common/rtti/RTTIExample.dpr new file mode 100644 index 0000000..a7c27ee --- /dev/null +++ b/official/1.96/examples/common/rtti/RTTIExample.dpr @@ -0,0 +1,13 @@ +program RTTIExample; + +uses + Forms, + RTTIDemoMain in 'RTTIDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/common/rtti/RTTIExample.res b/official/1.96/examples/common/rtti/RTTIExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/common/rtti/RTTIExample.res differ diff --git a/official/1.96/examples/common/sysinfo/QEnvironmentExample.dof b/official/1.96/examples/common/sysinfo/QEnvironmentExample.dof new file mode 100644 index 0000000..b13ef5f --- /dev/null +++ b/official/1.96/examples/common/sysinfo/QEnvironmentExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=../../../bin + diff --git a/official/1.96/examples/common/sysinfo/QEnvironmentExample.dpr b/official/1.96/examples/common/sysinfo/QEnvironmentExample.dpr new file mode 100644 index 0000000..32c84c8 --- /dev/null +++ b/official/1.96/examples/common/sysinfo/QEnvironmentExample.dpr @@ -0,0 +1,13 @@ +program QEnvironmentExample; + +uses + QForms, + QEnvironmentExampleMain in 'QEnvironmentExampleMain.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/common/sysinfo/QEnvironmentExample.res b/official/1.96/examples/common/sysinfo/QEnvironmentExample.res new file mode 100644 index 0000000..0930265 Binary files /dev/null and b/official/1.96/examples/common/sysinfo/QEnvironmentExample.res differ diff --git a/official/1.96/examples/common/sysinfo/QEnvironmentExampleMain.pas b/official/1.96/examples/common/sysinfo/QEnvironmentExampleMain.pas new file mode 100644 index 0000000..7235f04 --- /dev/null +++ b/official/1.96/examples/common/sysinfo/QEnvironmentExampleMain.pas @@ -0,0 +1,76 @@ +unit QEnvironmentExampleMain; + +interface + +uses + SysUtils, Classes, QControls, QForms, QComCtrls, + JclSysInfo; + +type + TForm1 = class(TForm) + EnvironmentView: TListView; + procedure FormCreate(Sender: TObject); + procedure EnvironmentGridSetEditText(Sender: TObject; ACol, + ARow: Integer; const Value: WideString); + procedure RefreshBtnClick(Sender: TObject); + private + { Private declarations } + procedure GetEnvironment; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.xfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin + GetEnvironment; +end; + +procedure TForm1.EnvironmentGridSetEditText(Sender: TObject; ACol, + ARow: Integer; const Value: WideString); +var + Key: string; +begin + with EnvironmentView.Items[ARow] do + begin + Key := Caption; + SetEnvironmentVar(Caption, SubItems[0]); + end; +end; + +procedure TForm1.RefreshBtnClick(Sender: TObject); +begin + GetEnvironment; +end; + +procedure TForm1.GetEnvironment; +var + I: Integer; + Key: string; + S: TStringList; +begin + S := TStringList.Create; + try + GetEnvironmentVars(S); + for I := 0 to S.Count - 1 do + begin + Key := S.Names[I]; + with EnvironmentView.Items.Add do + begin + Caption := Key; + SubItems.Add(S.Values[Key]); + end; + end; + finally + S.Free; + end; +end; + +end. + diff --git a/official/1.96/examples/common/sysinfo/QEnvironmentExampleMain.xfm b/official/1.96/examples/common/sysinfo/QEnvironmentExampleMain.xfm new file mode 100644 index 0000000..350efce --- /dev/null +++ b/official/1.96/examples/common/sysinfo/QEnvironmentExampleMain.xfm @@ -0,0 +1,46 @@ +object Form1: TForm1 + Left = 228 + Top = 165 + Width = 729 + Height = 540 + ActiveControl = EnvironmentView + Caption = 'Environment Variables' + Color = clButton + Font.CharSet = fcsLatin2 + Font.Color = clText + Font.Height = 12 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentFont = False + Scaled = False + OnCreate = FormCreate + PixelsPerInch = 96 + object EnvironmentView: TListView + Left = 0 + Top = 0 + Width = 729 + Height = 540 + Align = alClient + Columns = < + item + AutoSize = True + Caption = 'Environment variable' + Tag = 0 + Width = 200 + end + item + AutoSize = True + Caption = 'Value' + Tag = 0 + Width = 500 + end> + RowSelect = True + ReadOnly = True + ShowColumnSortIndicators = True + Sorted = True + TabOrder = 0 + ViewStyle = vsReport + end +end diff --git a/official/1.96/examples/common/textreader/TextReaderDemoMain.dfm b/official/1.96/examples/common/textreader/TextReaderDemoMain.dfm new file mode 100644 index 0000000..8928941 --- /dev/null +++ b/official/1.96/examples/common/textreader/TextReaderDemoMain.dfm @@ -0,0 +1,94 @@ +object MainForm: TMainForm + Left = 275 + Top = 163 + Width = 771 + Height = 641 + Caption = 'TJclMappedTextReader class demo' + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 200 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object ReadLnLabel: TLabel + Left = 200 + Top = 16 + Width = 64 + Height = 13 + Caption = 'ReadLnLabel' + end + object TextListView: TListView + Left = 0 + Top = 40 + Width = 763 + Height = 555 + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = < + item + Caption = 'Text' + Width = 750 + end> + ColumnClick = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + HotTrackStyles = [] + OwnerData = True + ReadOnly = True + RowSelect = True + ParentFont = False + TabOrder = 0 + ViewStyle = vsReport + OnData = TextListViewData + end + object OpenBtn: TButton + Left = 8 + Top = 8 + Width = 75 + Height = 25 + Caption = 'Open file' + TabOrder = 1 + OnClick = OpenBtnClick + end + object StatusBar: TStatusBar + Left = 0 + Top = 595 + Width = 763 + Height = 19 + Panels = < + item + Width = 210 + end + item + Width = 210 + end + item + Width = 50 + end> + SimplePanel = False + end + object ReadLnBtn: TButton + Left = 112 + Top = 8 + Width = 75 + Height = 25 + Caption = 'ReadLn test' + TabOrder = 3 + OnClick = ReadLnBtnClick + end + object OpenDialog: TOpenDialog + Filter = 'Text files (*.txt)|*.txt|All files (*.*)|*.*' + Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 8 + Top = 552 + end +end diff --git a/official/1.96/examples/common/textreader/TextReaderDemoMain.pas b/official/1.96/examples/common/textreader/TextReaderDemoMain.pas new file mode 100644 index 0000000..085cf83 --- /dev/null +++ b/official/1.96/examples/common/textreader/TextReaderDemoMain.pas @@ -0,0 +1,153 @@ +unit TextReaderDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, ComCtrls, StdCtrls, JclFileUtils; + +type + TMainForm = class(TForm) + TextListView: TListView; + OpenDialog: TOpenDialog; + OpenBtn: TButton; + StatusBar: TStatusBar; + ReadLnBtn: TButton; + ReadLnLabel: TLabel; + procedure FormDestroy(Sender: TObject); + procedure TextListViewData(Sender: TObject; Item: TListItem); + procedure OpenBtnClick(Sender: TObject); + procedure ReadLnBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + FFileName: string; + FTextReader: TJclMappedTextReader; + public + procedure ClearLabels; + procedure OpenFile(const FileName: string); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses + JclCounter, JclSysUtils; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + ClearLabels; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FTextReader); +end; + +procedure TMainForm.ClearLabels; +begin + ReadLnLabel.Caption := ''; +end; + +procedure TMainForm.OpenFile(const FileName: string); +var + C: TJclCounter; + LineCount: Integer; + LineCountTime: Extended; +begin + FreeAndNil(FTextReader); + FFileName := ''; + TextListView.Items.Count := 0; + StatusBar.Panels[0].Text := ''; + StatusBar.Panels[1].Text := ''; + ClearLabels; + FTextReader := TJclMappedTextReader.Create(FileName); + FFileName := FileName; + StartCount(C); + LineCount := FTextReader.LineCount; + LineCountTime := StopCount(C); + TextListView.Items.Count := LineCount; + TextListView.Invalidate; + StatusBar.Panels[0].Text := ExtractFileName(FileName); + StatusBar.Panels[1].Text := Format('Lines: %d, Counting time: %.2f ms', [LineCount, LineCountTime * 1000]); +end; + +procedure TMainForm.TextListViewData(Sender: TObject; Item: TListItem); +begin + with Item, FTextReader do + Caption := Lines[Item.Index]; +end; + +procedure TMainForm.OpenBtnClick(Sender: TObject); +begin + with OpenDialog do + begin + FileName := ''; + if Execute then + OpenFile(FileName); + end; +end; + +procedure TMainForm.ReadLnBtnClick(Sender: TObject); +var + C: TJclCounter; + TotalTime, StringListTotalTime, AssignFileTotalTime: Extended; + LineCount, I: Integer; + S: string; + Reader: TJclMappedTextReader; + SL: TStringList; + T: TextFile; +begin + if FFileName = '' then + Exit; + Screen.Cursor := crHourGlass; + try + ClearLabels; + // TJclMappedTextReader + LineCount := 0; + StartCount(C); + Reader := TJclMappedTextReader.Create(FFileName); + try + Reader.GoBegin; + while not Reader.Eof do + begin + S := Reader.ReadLn; + Inc(LineCount); + end; + TotalTime := StopCount(C); + finally + Reader.Free; + end; + // TStringList + SL := TStringList.Create; + try + StartCount(C); + SL.LoadFromFile(FFileName); + for I := 0 to SL.Count - 1 do + S := SL[I]; + StringListTotalTime := StopCount(C); + finally + SL.Free; + end; + // AssignFile + StartCount(C); + AssignFile(T, FFileName); + Reset(T); + while not Eof(T) do + ReadLn(T, S); + AssignFileTotalTime := StopCount(C); + CloseFile(T); + + ReadLnLabel.Caption := Format('Lines: %d, TJclMappedTextReader: %.2f ms, TStringList: %.2f ms, AssignFile: %.2f ms', + [LineCount, TotalTime * 1000, StringListTotalTime * 1000, AssignFileTotalTime * 1000]); + finally + Screen.Cursor := crDefault; + end; +end; + + + +end. diff --git a/official/1.96/examples/common/textreader/TextReaderExample.dof b/official/1.96/examples/common/textreader/TextReaderExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/common/textreader/TextReaderExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/common/textreader/TextReaderExample.dpr b/official/1.96/examples/common/textreader/TextReaderExample.dpr new file mode 100644 index 0000000..e9834f8 --- /dev/null +++ b/official/1.96/examples/common/textreader/TextReaderExample.dpr @@ -0,0 +1,13 @@ +program TextReaderExample; + +uses + Forms, + TextReaderDemoMain in 'TextReaderDemoMain.pas' {MainForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/common/textreader/TextReaderExample.res b/official/1.96/examples/common/textreader/TextReaderExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/common/textreader/TextReaderExample.res differ diff --git a/official/1.96/examples/common/unitversioning/UnitVersioningTest.dof b/official/1.96/examples/common/unitversioning/UnitVersioningTest.dof new file mode 100644 index 0000000..a45efdc --- /dev/null +++ b/official/1.96/examples/common/unitversioning/UnitVersioningTest.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=..\..\..\bin \ No newline at end of file diff --git a/official/1.96/examples/common/unitversioning/UnitVersioningTest.dpr b/official/1.96/examples/common/unitversioning/UnitVersioningTest.dpr new file mode 100644 index 0000000..96b801f --- /dev/null +++ b/official/1.96/examples/common/unitversioning/UnitVersioningTest.dpr @@ -0,0 +1,45 @@ +{**************************************************************************************************} +{ } +{ 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 UnitVersioningTest.dpr. } +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ sample for TUnitVersioning } +{ } +{ Unit owner: Uwe Schuster } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/10/17 13:19:01 $ + +program UnitVersioningTest; + +{$I jcl.inc} + +uses + Forms, + UnitVersioningTestMain in 'UnitVersioningTestMain.pas' {frmUnitVersioningTestMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TfrmUnitVersioningTestMain, frmUnitVersioningTestMain); + Application.Run; +end. diff --git a/official/1.96/examples/common/unitversioning/UnitVersioningTest.res b/official/1.96/examples/common/unitversioning/UnitVersioningTest.res new file mode 100644 index 0000000..b111060 Binary files /dev/null and b/official/1.96/examples/common/unitversioning/UnitVersioningTest.res differ diff --git a/official/1.96/examples/common/unitversioning/UnitVersioningTestDLL.dof b/official/1.96/examples/common/unitversioning/UnitVersioningTestDLL.dof new file mode 100644 index 0000000..a45efdc --- /dev/null +++ b/official/1.96/examples/common/unitversioning/UnitVersioningTestDLL.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=..\..\..\bin \ No newline at end of file diff --git a/official/1.96/examples/common/unitversioning/UnitVersioningTestDLL.dpr b/official/1.96/examples/common/unitversioning/UnitVersioningTestDLL.dpr new file mode 100644 index 0000000..f6d4b1d --- /dev/null +++ b/official/1.96/examples/common/unitversioning/UnitVersioningTestDLL.dpr @@ -0,0 +1,48 @@ +{**************************************************************************************************} +{ } +{ 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 UnitVersioningTestDLL.dpr. } +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ sample for TUnitVersioning } +{ } +{ Unit owner: Uwe Schuster } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/10/17 13:19:01 $ + +library UnitVersioningTestDLL; + +{$I jcl.inc} + +uses + JclUnitVersioning; + +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$RCSfile: UnitVersioningTestDLL.dpr,v $'; + Revision: '$Revision: 1.1 $'; + Date: '$Date: 2005/10/17 13:19:01 $'; + LogPath: ''; + ); + +begin + RegisterUnitVersion(HInstance, UnitVersioning); +end. diff --git a/official/1.96/examples/common/unitversioning/UnitVersioningTestMain.dfm b/official/1.96/examples/common/unitversioning/UnitVersioningTestMain.dfm new file mode 100644 index 0000000..3f880f1 --- /dev/null +++ b/official/1.96/examples/common/unitversioning/UnitVersioningTestMain.dfm @@ -0,0 +1,91 @@ +object frmUnitVersioningTestMain: TfrmUnitVersioningTestMain + Left = 192 + Top = 137 + Width = 703 + Height = 480 + Caption = 'UnitVersioning Test' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object tv: TTreeView + Left = 0 + Top = 73 + Width = 695 + Height = 380 + Align = alClient + Indent = 19 + TabOrder = 0 + end + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 695 + Height = 73 + Align = alTop + BevelOuter = bvNone + TabOrder = 1 + object btnTestDummyProvider: TButton + Left = 152 + Top = 8 + Width = 121 + Height = 25 + Caption = 'Test Dummy Provider' + TabOrder = 0 + OnClick = btnTestDummyProviderClick + end + object btnTestGetLocationInfoStr: TButton + Left = 280 + Top = 8 + Width = 129 + Height = 25 + Caption = 'Test GetLocationInfoStr' + TabOrder = 1 + OnClick = btnTestGetLocationInfoStrClick + end + object btnShowUVContent: TButton + Left = 8 + Top = 40 + Width = 153 + Height = 25 + Caption = 'Show UnitVersioning content' + TabOrder = 2 + OnClick = btnShowUVContentClick + end + object btnTestFindMethods: TButton + Left = 8 + Top = 8 + Width = 137 + Height = 25 + Caption = 'Test IndexOf and FindUnit' + TabOrder = 3 + OnClick = btnTestFindMethodsClick + end + object btnLoadDLL: TButton + Left = 168 + Top = 40 + Width = 75 + Height = 25 + Caption = 'Load DLL' + TabOrder = 4 + OnClick = btnLoadDLLClick + end + object btnInsertSection: TButton + Left = 248 + Top = 40 + Width = 137 + Height = 25 + Caption = 'Insert info section into DLL' + TabOrder = 5 + OnClick = btnInsertSectionClick + end + end +end diff --git a/official/1.96/examples/common/unitversioning/UnitVersioningTestMain.pas b/official/1.96/examples/common/unitversioning/UnitVersioningTestMain.pas new file mode 100644 index 0000000..591bbf2 --- /dev/null +++ b/official/1.96/examples/common/unitversioning/UnitVersioningTestMain.pas @@ -0,0 +1,301 @@ +{**************************************************************************************************} +{ } +{ 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 UnitVersioningTestMain.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) } +{ } +{**************************************************************************************************} +{ } +{ sample for TUnitVersioning } +{ } +{ Unit owner: Uwe Schuster } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/10/17 13:19:01 $ +// For history see end of file + +unit UnitVersioningTestMain; + +{$I jcl.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls, ExtCtrls, JclUnitVersioning, JclUnitVersioningProviders, + JclDebug, JclFileUtils; + +type + TfrmUnitVersioningTestMain = class(TForm) + tv: TTreeView; + Panel1: TPanel; + btnTestDummyProvider: TButton; + btnTestGetLocationInfoStr: TButton; + btnShowUVContent: TButton; + btnTestFindMethods: TButton; + btnLoadDLL: TButton; + btnInsertSection: TButton; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnTestFindMethodsClick(Sender: TObject); + procedure btnTestDummyProviderClick(Sender: TObject); + procedure btnTestGetLocationInfoStrClick(Sender: TObject); + procedure btnShowUVContentClick(Sender: TObject); + procedure btnLoadDLLClick(Sender: TObject); + procedure btnInsertSectionClick(Sender: TObject); + private + { Private declarations } + FFindMethodsInfoPtrs: TList; + TestDLLHandle: THandle; + procedure FreeTestDLL; + public + { Public declarations } + end; + +var + frmUnitVersioningTestMain: TfrmUnitVersioningTestMain; + +implementation + +{$R *.dfm} + +const + TestDLLFileName = 'UnitVersioningTestDLL.dll'; + +procedure TfrmUnitVersioningTestMain.FormCreate(Sender: TObject); +begin + FFindMethodsInfoPtrs := TList.Create; +end; + +procedure TfrmUnitVersioningTestMain.FormDestroy(Sender: TObject); +var + I: Integer; +begin + for I := 0 to FFindMethodsInfoPtrs.Count - 1 do + Dispose(FFindMethodsInfoPtrs[I]); + FFindMethodsInfoPtrs.Free; + FreeTestDLL; +end; + +procedure TfrmUnitVersioningTestMain.FreeTestDLL; +begin + if TestDLLHandle <> 0 then + begin + if FreeLibrary(TestDLLHandle) then + TestDLLHandle := 0; + end; +end; + +procedure TfrmUnitVersioningTestMain.btnTestFindMethodsClick(Sender: TObject); +const MaxCnt = 1000; +var + UnitVersioning: TUnitVersioning; + I, Idx: Integer; + UnitVersionInfoPtr: PUnitVersionInfo; +begin + UnitVersioning := GetUnitVersioning; + for I := 1 to MaxCnt do + begin + New(UnitVersionInfoPtr); + with UnitVersionInfoPtr^ do + begin + RCSfile := Format('unit%d.pas', [I]); + Revision := ''; + Date := ''; + LogPath := ''; + Extra := ''; + Data := nil; + end; + FFindMethodsInfoPtrs.Add(UnitVersionInfoPtr); + RegisterUnitVersion(HInstance, UnitVersionInfoPtr^); + end; + if MaxCnt >= 500 then + begin + Idx := UnitVersioning.IndexOf('unit500.pas'); + if Idx <> -1 then + ShowMessage(Format('IndexOf %s = %d', [UnitVersioning.Items[Idx].RCSfile, Idx])) + else + ShowMessage('IndexOf failed'); + end; + if MaxCnt >= 600 then + begin + if Assigned(UnitVersioning.FindUnit('unit600.pas')) then + ShowMessage('FindUnit ' + UnitVersioning.FindUnit('unit600.pas').RCSfile) + else + ShowMessage('FindUnit failed'); + end; +end; + +type + TDummyUnitVersioningProvider = class(TCustomUnitVersioningProvider) + private + FUV: PUnitVersionInfo; + public + constructor Create; override; + destructor Destroy; override; + procedure LoadModuleUnitVersioningInfo(Instance: THandle); override; + end; + +constructor TDummyUnitVersioningProvider.Create; +begin + inherited Create; + FUV := nil; +end; + +destructor TDummyUnitVersioningProvider.Destroy; +begin + if Assigned(FUV) then + Dispose(FUV); + inherited Destroy; +end; + +procedure TDummyUnitVersioningProvider.LoadModuleUnitVersioningInfo(Instance: THandle); +begin + if (Instance = HInstance) and not Assigned(FUV) then + begin + New(FUV); + FUV^.RCSfile := 'DummyUnit.pas'; + FUV^.Revision := '0.12'; + FUV^.Date := ''; + FUV^.LogPath := ''; + FUV^.Extra := ''; + FUV^.Data := nil; + RegisterUnitVersion(Instance, FUV^); + end; +end; + +procedure TfrmUnitVersioningTestMain.btnTestDummyProviderClick(Sender: TObject); +var + UnitVersioning: TUnitVersioning; + Idx: Integer; +begin + UnitVersioning := GetUnitVersioning; + UnitVersioning.RegisterProvider(TDummyUnitVersioningProvider); + UnitVersioning.LoadModuleUnitVersioningInfo(HInstance); + Idx := UnitVersioning.IndexOf('DummyUnit.pas'); + if Idx <> -1 then + ShowMessage(Format('IndexOf %s=%d Revision=%s', [UnitVersioning.Items[Idx].RCSfile, + Idx, UnitVersioning.Items[Idx].Revision])) + else + ShowMessage('DummyProvider Test failed'); +end; + +procedure TfrmUnitVersioningTestMain.btnTestGetLocationInfoStrClick(Sender: TObject); +var + S: string; +begin + S := GetLocationInfoStr(@TUnitVersioning.LoadModuleUnitVersioningInfo, + False, True, True, False); + ShowMessage(S); +end; + +procedure TfrmUnitVersioningTestMain.btnShowUVContentClick(Sender: TObject); +var + I, J: Integer; + UnitVersioning: TUnitVersioning; + tnModule: TTreeNode; + LongFileName: string; +begin + UnitVersioning := GetUnitVersioning; + UnitVersioning.RegisterProvider(TJclDefaultUnitVersioningProvider); + for I := 0 to Pred(UnitVersioning.ModuleCount) do + UnitVersioning.LoadModuleUnitVersioningInfo(UnitVersioning.Modules[I].Instance); + tv.Items.BeginUpdate; + try + tv.Items.Clear; + for I := 0 to Pred(UnitVersioning.ModuleCount) do + begin + tnModule := tv.Items.Add(nil, Format('%s [%d units]', + [GetModulePath(UnitVersioning.Modules[I].Instance), UnitVersioning.Modules[I].Count])); + for J := 0 to Pred(UnitVersioning.Modules[I].Count) do + with UnitVersioning.Modules[I][J] do + begin + LongFileName := LogPath; + if LongFileName <> '' then + LongFileName := PathAddSeparator(LongFileName); + LongFileName := LongFileName + RCSfile; + tv.Items.AddChild(tnModule, Format('%s %s %s', [LongFileName, Revision, Date])); + end; + end; + finally + tv.Items.EndUpdate; + end; +end; + +procedure TfrmUnitVersioningTestMain.btnLoadDLLClick(Sender: TObject); +begin + if TestDLLHandle = 0 then + begin + TestDLLHandle := LoadLibrary(TestDLLFileName); + if TestDLLHandle = 0 then + ShowMessage(Format('Could not load %s', [TestDLLFileName])); + end; +end; + +procedure TfrmUnitVersioningTestMain.btnInsertSectionClick(Sender: TObject); +var + TestStream: TMemoryStream; + UnitList: TJclUnitVersioningList; + UnitVersionInfo: TUnitVersionInfo; + I: Integer; +begin + FreeTestDLL; + if TestDLLHandle = 0 then + begin + TestStream := TMemoryStream.Create; + try + UnitList := TJclUnitVersioningList.Create; + try + for I := 1 to 20 do + begin + with UnitVersionInfo do + begin + RCSfile := Format('unit%d.pas', [I]); + Revision := Format('0.%d', [I]); + Date := ''; + LogPath := ''; + Extra := ''; + Data := nil; + end; + UnitList.Add(UnitVersionInfo); + end; + if not InsertUnitVersioningSection(TestDLLFileName, UnitList) then + ShowMessage(Format('Inserting UnitVersion information section into %s failed', + [TestDLLFileName])); + finally + UnitList.Free; + end; + finally + TestStream.Free; + end; + end + else + ShowMessage('Can''t insert section - DLL still loaded and unload failed...'); +end; + +// History: + +// $Log: UnitVersioningTestMain.pas,v $ +// Revision 1.1 2005/10/17 13:19:01 rrossmair +// - moved over from examples\vcl\* +// +// Revision 1.1 2005/03/07 18:47:42 uschuster +// new example for UnitVersioning +// + +end. diff --git a/official/1.96/examples/dotnet/JCLNetDemo/AssemblyInfo.cs b/official/1.96/examples/dotnet/JCLNetDemo/AssemblyInfo.cs new file mode 100644 index 0000000..b67641b --- /dev/null +++ b/official/1.96/examples/dotnet/JCLNetDemo/AssemblyInfo.cs @@ -0,0 +1,67 @@ +using System.Reflection; +using System.Runtime.CompilerServices; +using System.Runtime.InteropServices; + +// +// Die allgemeinen Assemblierungsinformationen werden durch die folgenden +// Attribute gesteuert. Ändern Sie die Attributwerte, um die zu einer +// Assemblierung gehörenden Informationen zu modifizieren. +// +[assembly: AssemblyTitle("")] +[assembly: AssemblyDescription("")] +[assembly: AssemblyConfiguration("")] +[assembly: AssemblyCompany("")] +[assembly: AssemblyProduct("")] +[assembly: AssemblyCopyright("")] +[assembly: AssemblyTrademark("")] +[assembly: AssemblyCulture("")] + +// Die Versionsinformation einer Assemblierung enthält die folgenden vier Werte: +// Hauptversion +// Nebenversion +// Build-Nummer +// Revision +// Sie können alle vier Werte festlegen oder für Revision und Build-Nummer die +// Standardwerte mit '*' - wie nachfolgend gezeigt - verwenden: + +[assembly: AssemblyVersion("1.0.*")] + +// +// Zum Signieren einer Assemblierung müssen Sie einen Schlüssel angeben. Weitere Informationen +// über das Signieren von Assemblierungen finden Sie in der Microsoft .NET Framework-Dokumentation. +// Mit den folgenden Attributen steuern Sie, welcher Schlüssel für die Signatur verwendet wird. +// Hinweise: +// (*) Wenn kein Schlüssel angegeben wird, ist die Assemblierung nicht signiert. +// (*) KeyName verweist auf einen Schlüssel, der im Crypto Service Provider +// (CSP) auf Ihrem Rechner installiert wurde. KeyFile verweist auf eine +// Datei, die einen Schlüssel enthält. +// (*) Wenn sowohl der KeyFile- als auch der KeyName-Wert angegeben ist, wird +// die folgende Verarbeitung durchgeführt: +// (1) Wenn KeyName in dem CSP gefunden wird, wird dieser Schlüssel verwendet. +// (2) Wenn KeyName nicht, aber KeyFile vorhanden ist, wird der Schlüssel +// in KeyFile im CSP installiert und verwendet. +// (*) Ein KeyFile können Sie mit dem Utility sn.exe (Starker Name) erzeugen. +// Der Speicherort von KeyFile sollte relativ zum Projektausgabeverzeichnis +// %Projektverzeichnis%\bin\ angegeben werden. Wenn sich Ihr +// KeyFile z.B. im Projektverzeichnis befindet, würden Sie das Attribut +// AssemblyKeyFile folgendermaßen festlegen: +// [assembly: AssemblyKeyFile("..\\..\\mykey.snk")] +// (*) Verzögerte Signatur ist eine erweiterte Option; nähere Informationen +// dazu finden Sie in der Microsoft .NET Framework-Dokumentation. +// +[assembly: AssemblyDelaySign(false)] +[assembly: AssemblyKeyFile("")] +[assembly: AssemblyKeyName("")] + +// +// Verwenden Sie die folgenden Attribute zur Steuerung der COM-Sichtbarkeit Ihrer Assemblierung. +// Standardmäßig ist die gesamte Assemblierung für COM sichtbar. Die Einstellung false für ComVisible +// ist die für Ihre Assemblierung empfohlene Vorgabe. Um dann eine Klasse und ein Interface für COM +// bereitzustellen, setzen Sie jeweils ComVisible auf true. Es wird auch empfohlen das Attribut +// Guid hinzuzufügen. +// + +[assembly: ComVisible(false)] +//[assembly: Guid("")] +//[assembly: TypeLibVersion(1, 0)] + diff --git a/official/1.96/examples/dotnet/JCLNetDemo/JCLNet.FrmMain.resources b/official/1.96/examples/dotnet/JCLNetDemo/JCLNet.FrmMain.resources new file mode 100644 index 0000000..791098b Binary files /dev/null and b/official/1.96/examples/dotnet/JCLNetDemo/JCLNet.FrmMain.resources differ diff --git a/official/1.96/examples/dotnet/JCLNetDemo/JCLNet.WinForm.resources b/official/1.96/examples/dotnet/JCLNetDemo/JCLNet.WinForm.resources new file mode 100644 index 0000000..35b0574 Binary files /dev/null and b/official/1.96/examples/dotnet/JCLNetDemo/JCLNet.WinForm.resources differ diff --git a/official/1.96/examples/dotnet/JCLNetDemo/JCLNet.bdsproj b/official/1.96/examples/dotnet/JCLNetDemo/JCLNet.bdsproj new file mode 100644 index 0000000..018f089 --- /dev/null +++ b/official/1.96/examples/dotnet/JCLNetDemo/JCLNet.bdsproj @@ -0,0 +1,102 @@ + + + + + + + + + + + + + Debug + + + + 4 + False + + JCLNet + False + True + False + False + False + TRACE + + Windows + + 285212672 + False + bin\Release + + + + False + + + + + False + + False + False + + IIS + + + + + + + + 4 + True + + JCLNet + True + False + False + False + False + TRACE;DEBUG + + Windows + + 285212672 + False + bin\Debug + + + + False + + + + + False + + False + False + + IIS + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/examples/dotnet/JCLNetDemo/WinForm.cs b/official/1.96/examples/dotnet/JCLNetDemo/WinForm.cs new file mode 100644 index 0000000..4d5c6b7 --- /dev/null +++ b/official/1.96/examples/dotnet/JCLNetDemo/WinForm.cs @@ -0,0 +1,254 @@ +using System; +using System.Drawing; +using System.Collections; +using System.ComponentModel; +using System.Windows.Forms; +using System.Data; + +using Jedi.Jcl; +using Jedi.Jcl.Units; + +using Borland.Delphi; +using Borland.Delphi.Units; + +using Borland.Vcl; +using Borland.Vcl.Units; + +namespace JCLNet +{ + /// + /// Zusammenfassende Beschreibung für FrmMain. + /// + public class FrmMain : System.Windows.Forms.Form + { + /// + /// Erforderliche Designer-Variable. + /// + private System.ComponentModel.Container components = null; + private System.Windows.Forms.TabControl tcDemos; + private System.Windows.Forms.TabPage tpSysInfo; + private System.Windows.Forms.Button btnListProcesses; + private System.Windows.Forms.TextBox tbProcesses; + private System.Windows.Forms.ListView lvSpecialDirectories; + private System.Windows.Forms.Button btnSpecialDirectories; + private System.Windows.Forms.ColumnHeader columnHeader1; + private System.Windows.Forms.ColumnHeader columnHeader2; + private System.Windows.Forms.Label lbIpAddress; + private System.Windows.Forms.Label lbComputerName; + private System.Windows.Forms.Button btnQuit; + + public FrmMain() + { + // + // Erforderlich für die Unterstützung des Windows-Form-Designer + // + InitializeComponent(); + + // + // TODO: Konstruktorcode nach dem Aufruf von InitializeComponent hinzufügen + // + } + + /// + /// Ressourcen nach der Verwendung bereinigen + /// + protected override void Dispose(bool disposing) + { + if (disposing) + { + if (components != null) + { + components.Dispose(); + } + } + base.Dispose(disposing); + } + + #region Vom Windows Form-Designer erzeugter Code + /// + /// Erforderliche Methode zur Unterstützung des Designers - + /// ändern Sie die Methode nicht mit dem Quelltext-Editor + /// + private void InitializeComponent() + { + this.tcDemos = new System.Windows.Forms.TabControl(); + this.tpSysInfo = new System.Windows.Forms.TabPage(); + this.lbComputerName = new System.Windows.Forms.Label(); + this.lbIpAddress = new System.Windows.Forms.Label(); + this.btnSpecialDirectories = new System.Windows.Forms.Button(); + this.lvSpecialDirectories = new System.Windows.Forms.ListView(); + this.columnHeader1 = new System.Windows.Forms.ColumnHeader(); + this.columnHeader2 = new System.Windows.Forms.ColumnHeader(); + this.tbProcesses = new System.Windows.Forms.TextBox(); + this.btnListProcesses = new System.Windows.Forms.Button(); + this.btnQuit = new System.Windows.Forms.Button(); + this.tcDemos.SuspendLayout(); + this.tpSysInfo.SuspendLayout(); + this.SuspendLayout(); + // + // tcDemos + // + this.tcDemos.Controls.Add(this.tpSysInfo); + this.tcDemos.Location = new System.Drawing.Point(8, 8); + this.tcDemos.Name = "tcDemos"; + this.tcDemos.SelectedIndex = 0; + this.tcDemos.Size = new System.Drawing.Size(712, 520); + this.tcDemos.TabIndex = 2; + // + // tpSysInfo + // + this.tpSysInfo.Controls.Add(this.lbComputerName); + this.tpSysInfo.Controls.Add(this.lbIpAddress); + this.tpSysInfo.Controls.Add(this.btnSpecialDirectories); + this.tpSysInfo.Controls.Add(this.lvSpecialDirectories); + this.tpSysInfo.Controls.Add(this.tbProcesses); + this.tpSysInfo.Controls.Add(this.btnListProcesses); + this.tpSysInfo.Location = new System.Drawing.Point(4, 22); + this.tpSysInfo.Name = "tpSysInfo"; + this.tpSysInfo.Size = new System.Drawing.Size(704, 494); + this.tpSysInfo.TabIndex = 0; + this.tpSysInfo.Text = "Jedi.Jcl.JclSysInfo"; + // + // lbComputerName + // + this.lbComputerName.Location = new System.Drawing.Point(16, 384); + this.lbComputerName.Name = "lbComputerName"; + this.lbComputerName.Size = new System.Drawing.Size(208, 16); + this.lbComputerName.TabIndex = 7; + this.lbComputerName.Text = "ComputerName"; + // + // lbIpAddress + // + this.lbIpAddress.Location = new System.Drawing.Point(16, 360); + this.lbIpAddress.Name = "lbIpAddress"; + this.lbIpAddress.Size = new System.Drawing.Size(136, 16); + this.lbIpAddress.TabIndex = 6; + this.lbIpAddress.Text = "IPAddress"; + // + // btnSpecialDirectories + // + this.btnSpecialDirectories.Location = new System.Drawing.Point(560, 152); + this.btnSpecialDirectories.Name = "btnSpecialDirectories"; + this.btnSpecialDirectories.Size = new System.Drawing.Size(136, 23); + this.btnSpecialDirectories.TabIndex = 5; + this.btnSpecialDirectories.Text = "Show Special Directories"; + this.btnSpecialDirectories.Click += new System.EventHandler(this.btnSpecialDirectories_Click); + // + // lvSpecialDirectories + // + this.lvSpecialDirectories.Columns.AddRange(new System.Windows.Forms.ColumnHeader[] { + this.columnHeader1, + this.columnHeader2}); + this.lvSpecialDirectories.Location = new System.Drawing.Point(8, 16); + this.lvSpecialDirectories.Name = "lvSpecialDirectories"; + this.lvSpecialDirectories.Size = new System.Drawing.Size(688, 136); + this.lvSpecialDirectories.TabIndex = 4; + this.lvSpecialDirectories.View = System.Windows.Forms.View.Details; + // + // columnHeader1 + // + this.columnHeader1.Text = "Name"; + this.columnHeader1.Width = 100; + // + // columnHeader2 + // + this.columnHeader2.Text = "Directory"; + this.columnHeader2.Width = 450; + // + // tbProcesses + // + this.tbProcesses.Location = new System.Drawing.Point(8, 184); + this.tbProcesses.Multiline = true; + this.tbProcesses.Name = "tbProcesses"; + this.tbProcesses.Size = new System.Drawing.Size(688, 168); + this.tbProcesses.TabIndex = 3; + this.tbProcesses.Text = ""; + // + // btnListProcesses + // + this.btnListProcesses.Location = new System.Drawing.Point(560, 352); + this.btnListProcesses.Name = "btnListProcesses"; + this.btnListProcesses.Size = new System.Drawing.Size(136, 23); + this.btnListProcesses.TabIndex = 2; + this.btnListProcesses.Text = "List Processes"; + this.btnListProcesses.Click += new System.EventHandler(this.btnListProcesses_Click); + // + // btnQuit + // + this.btnQuit.Location = new System.Drawing.Point(640, 536); + this.btnQuit.Name = "btnQuit"; + this.btnQuit.TabIndex = 3; + this.btnQuit.Text = "&Quit"; + this.btnQuit.Click += new System.EventHandler(this.btnQuit_Click); + // + // FrmMain + // + this.AutoScaleBaseSize = new System.Drawing.Size(5, 13); + this.ClientSize = new System.Drawing.Size(728, 566); + this.Controls.Add(this.btnQuit); + this.Controls.Add(this.tcDemos); + this.Name = "FrmMain"; + this.Text = "JCL.NET Demo application"; + this.Load += new System.EventHandler(this.FrmMain_Load); + this.tcDemos.ResumeLayout(false); + this.tpSysInfo.ResumeLayout(false); + this.ResumeLayout(false); + } + #endregion + + /// + /// Der Haupteintrittspunkt für die Anwendung. + /// + [STAThread] + static void Main() + { + Application.Run(new FrmMain()); + } + + private void btnListProcesses_Click(object sender, System.EventArgs e) + { + TStrings list = new TStringList(); + JclSysInfo.RunningProcessesList(list, true); + tbProcesses.Lines = JclStrings.ArrayOf(list); + } + + private void btnSpecialDirectories_Click(object sender, System.EventArgs e) + { + lvSpecialDirectories.Items.Clear(); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"AppdataFolder", JclSysInfo.GetAppdataFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"CommonAppdataFolder", JclSysInfo.GetCommonAppdataFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"CommonDesktopdirectoryFolder", JclSysInfo.GetCommonDesktopdirectoryFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"CommonFavoritesFolder", JclSysInfo.GetCommonFavoritesFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"CommonProgramsFolder", JclSysInfo.GetCommonProgramsFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"CookiesFolder", JclSysInfo.GetCookiesFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"CurrentFolder", JclSysInfo.GetCurrentFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"DesktopDirectoryFolder", JclSysInfo.GetDesktopDirectoryFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"DesktopFolder", JclSysInfo.GetDesktopFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"FavoritesFolder", JclSysInfo.GetFavoritesFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"HistoryFolder", JclSysInfo.GetHistoryFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"InternetCacheFolder", JclSysInfo.GetInternetCacheFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"PersonalFolder", JclSysInfo.GetPersonalFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"ProgramFilesFolder", JclSysInfo.GetProgramFilesFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"ProgramsFolder", JclSysInfo.GetProgramsFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"RecentFolder", JclSysInfo.GetRecentFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"SendToFolder", JclSysInfo.GetSendToFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"StartmenuFolder", JclSysInfo.GetStartmenuFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"StartupFolder", JclSysInfo.GetStartupFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"TemplatesFolder", JclSysInfo.GetTemplatesFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"WindowsSystemFolder", JclSysInfo.GetWindowsSystemFolder()})); + lvSpecialDirectories.Items.Add(new ListViewItem(new string[] {"WindowsTempFolder", JclSysInfo.GetWindowsTempFolder()})); + } + + private void FrmMain_Load(object sender, System.EventArgs e) + { + lbIpAddress.Text = "IP: " + JclSysInfo.GetIPAddress(JclSysInfo.GetLocalComputerName()); + lbComputerName.Text = "Machine Name: " + JclSysInfo.GetLocalComputerName(); + } + + private void btnQuit_Click(object sender, System.EventArgs e) + { + Application.Exit(); + } + + } +} diff --git a/official/1.96/examples/dotnet/JCLNetDemo/WinForm.resx b/official/1.96/examples/dotnet/JCLNetDemo/WinForm.resx new file mode 100644 index 0000000..d42084d --- /dev/null +++ b/official/1.96/examples/dotnet/JCLNetDemo/WinForm.resx @@ -0,0 +1,202 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + text/microsoft-resx + + + 1.3 + + + System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 + + + True + + + False + + + True + + + Private + + + 8, 8 + + + False + + + True + + + True + + + Private + + + 8, 8 + + + False + + + Private + + + False + + + Private + + + False + + + Private + + + False + + + Private + + + Private + + + Private + + + False + + + Private + + + False + + + Private + + + False + + + Private + + + False + + + (Default) + + + False + + + False + + + 8, 8 + + + True + + + 80 + + + True + + diff --git a/official/1.96/examples/k3.exc b/official/1.96/examples/k3.exc new file mode 100644 index 0000000..b273594 --- /dev/null +++ b/official/1.96/examples/k3.exc @@ -0,0 +1,48 @@ +windows/ntfs/JEDISoftLinks.dpr +windows/appinst/AppInstExample.dpr +windows/appinst/SingleInstExample.dpr +windows/asuser/CreateProcAsUserExample.dpr +windows/clr/ClrDemo.dpr +windows/debug/framestrack/FramesTrackExample.dpr +windows/debug/sourceloc/SourceLocExample.dpr +windows/debug/stacktrack/StackTrackDLLsComLibrary.dpr +windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dpr +windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dpr +windows/debug/stacktrack/StackTrackExample.dpr +windows/debug/stacktrack/StackTrackDLLsExample.dpr +windows/debug/threadexcept/ThreadExceptExample.dpr +windows/delphitools/dependencyviewer/DependView.dpr +windows/delphitools/peviewer/PeViewer.dpr +windows/delphitools/resfix/ResFix.dpr +windows/delphitools/screenjpg/ScreenJPG.dpr +windows/delphitools/toolhelpview/ToolHelpViewer.dpr +windows/edisdk/EDICOMExample.dpr +windows/edisdk/comserver/EDISDK.dpr +windows/fileversion/VerInfoExample.dpr +windows/lanman/LanManExample.dpr +windows/locales/LocalesExample.dpr +windows/mapi/MapiExample.dpr +windows/mapi/ReadMailExample.dpr +windows/multimedia/MultiMediaExample.dpr +windows/ntservice/NtSvcExample.dpr +windows/peimage/ApiHookExample.dpr +windows/peimage/PeFuncExample.dpr +windows/peimage/UnmangleNameExample.dpr +windows/registry/RegistryExample.dpr +windows/structstorage/StructStorageExample.dpr +windows/sysinfo/SysInfoExample.dpr +windows/tasks/TaskDemo.dpr +windows/ConsoleExamples.dpr +common/pcre/PCREDemo.dpr +common/expreval/ExprEvalExample.dpr +common/containers/algorithms/AlgorithmsExample.dpr +common/containers/hashing/HashingExample.dpr +common/containers/lists/ListExample.dpr +common/containers/performance/ContainerPerformance.dpr +common/containers/trees/TreeExample.dpr +common/graphics/StretchGraphicExample.dpr +common/multimedia/MidiOutExample.dpr +common/rtti/RTTIExample.dpr +common/textreader/TextReaderExample.dpr +common/unitversioning/UnitVersioningTest.dpr +common/unitversioning/UnitVersioningTestDLL.dpr \ No newline at end of file diff --git a/official/1.96/examples/visclx.exc b/official/1.96/examples/visclx.exc new file mode 100644 index 0000000..3834812 --- /dev/null +++ b/official/1.96/examples/visclx.exc @@ -0,0 +1,7 @@ +common\pcre\QPCREDemo.dpr +common\expreval\QExprEvalExample.dpr +common\filesearch\QFileSearchDemo.dpr +common\graphics\QClipLineDemo.dpr +common\numformat\QNumFormatExample.dpr +common\rtti\QRTTIDemo.dpr +common\sysinfo\QEnvironmentExample.dpr diff --git a/official/1.96/examples/windows/ConsoleExamples.dof b/official/1.96/examples/windows/ConsoleExamples.dof new file mode 100644 index 0000000..27cbb59 --- /dev/null +++ b/official/1.96/examples/windows/ConsoleExamples.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\bin +SearchPath=$(DELPHI)\Lib\Debug; diff --git a/official/1.96/examples/windows/ConsoleExamples.dpr b/official/1.96/examples/windows/ConsoleExamples.dpr new file mode 100644 index 0000000..f0586fa --- /dev/null +++ b/official/1.96/examples/windows/ConsoleExamples.dpr @@ -0,0 +1,405 @@ +{$I jcl.inc} +{$IFDEF SUPPORTS_PLATFORM_WARNINGS} + {$WARN SYMBOL_PLATFORM OFF} +{$ENDIF SUPPORTS_PLATFORM_WARNINGS} + +program ConsoleExamples; +{$APPTYPE CONSOLE} +uses + SysUtils, + Windows, + TypInfo, + JclConsole; + +type + TCPInfoEx = packed record + MaxCharSize: DWORD; + DefaultChar: array[0..MAX_DEFAULTCHAR-1] of Byte; + LeadByte: array[0..MAX_LEADBYTES-1] of Byte; + UnicodeDefaultChar: WideChar; + CodePage: DWORD; + CodePageName: array[0..MAX_PATH-1] of Char; + end; + +function GetCPInfoEx(CodePage, dwFlags: DWORD; var lpCPInfoEx: TCPInfoEx): BOOL; stdcall; + external 'kernel32.dll' name 'GetCPInfoExA'; + +procedure ShowConsoleInfo(const Console: TJclConsole); + function CodePageToName(CodePage: DWORD): string; + var + CpInfo: TCPInfoEx; + begin + Win32Check(GetCPInfoEx(CodePage, 0, CpInfo)); + Result := CpInfo.CodePageName; + end; +begin + Assert(TJclConsole.IsConsole(GetModuleHandle(nil))); + Assert(TJclConsole.IsConsole(ParamStr(0))); + + Console.ActiveScreen.WriteLn('Old Windows Title : ' + Console.Title); + Console.Title := 'Information of the Default Output Screen Buffer'; + Console.ActiveScreen.WriteLn('New Windows Title : ' + Console.Title); + Console.ActiveScreen.WriteLn(Format('Input Code Page : %s', [CodePageToName(Console.InputCodePage)])); + Console.ActiveScreen.WriteLn(Format('Output Code Page : %s', [CodePageToName(Console.OutputCodePage)])); +end; + +procedure ShowScreenInfo(const ScrBuf: TJclScreenBuffer); + function ModeToString: string; + var + AMode: TJclConsoleOutputMode; + begin + for AMode:=Low(TJclConsoleOutputMode) to High(TJclConsoleOutputMode) do + begin + if AMode in ScrBuf.Mode then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + GetEnumName(TypeInfo(TJclConsoleOutputMode), Integer(AMode)); + end; + end; + end; +var + OldMode: TJclConsoleOutputModes; + Attr: IJclScreenTextAttribute; +begin + ScrBuf.WriteLn; + ScrBuf.WriteLn(Format('Handle: 0x%.8x', [ScrBuf.Handle])); + ScrBuf.Writeln('Old Mode : ' + ModeToString); + OldMode := ScrBuf.Mode; + ScrBuf.Mode := ScrBuf.Mode - [omWrapAtEol]; + ScrBuf.Write('New Mode : ' + ModeToString); + Readln; + ScrBuf.Mode := OldMode; + + ScrBuf.WriteLn(Format('Old Size: (%d, %d)', [ScrBuf.Width, ScrBuf.Height])); + ScrBuf.Width := ScrBuf.Width * 2; + ScrBuf.Write(Format('New Size: (%d, %d)', [ScrBuf.Width, ScrBuf.Height])); + Readln; + ScrBuf.Width := ScrBuf.Width div 2; + + Attr := TJclScreenTextAttribute.Create(fclYellow, bclBlue, True, False, + [fsGridHorizontal, fsUnderscore]); + + ScrBuf.Write('Top', thaCenter, tvaTop, Attr); + ScrBuf.Write('Bottom', thaCenter, tvaBottom, Attr); + ScrBuf.Write('Left', thaLeft, tvaCenter, Attr); + ScrBuf.Write('Right', thaRight, tvaCenter, Attr); + ScrBuf.Write('Center', thaCenter, tvaCenter, Attr); +end; + +procedure ShowCursorInfo(const ScrBuf: TJclScreenBuffer); +const + BoolName: array[Boolean] of string = ('Hide', 'Show'); +var + OldPos: TCoord; + OldSize: TJclScreenCursorSize; +begin + ScrBuf.WriteLn; + ScrBuf.WriteLn(Format('Cursor Position: (%d, %d)', [ScrBuf.Cursor.Position.X, ScrBuf.Cursor.Position.Y])); + OldPos := ScrBuf.Cursor.Position; + ScrBuf.Cursor.MoveTo(ScrBuf.Window.Left, ScrBuf.Window.Top); + ScrBuf.Write(Format('(%d, %d)', [ScrBuf.Cursor.Position.X, ScrBuf.Cursor.Position.Y])); + ScrBuf.Cursor.Position := OldPos; + Readln; + ScrBuf.WriteLn('Left-Top corner :' + ScrBuf.ReadLn(0, 0)); + + ScrBuf.WriteLn(Format('Old Cursor Size: %d', [ScrBuf.Cursor.Size])); + OldSize := ScrBuf.Cursor.Size; ScrBuf.Cursor.Size := 100; + ScrBuf.Write(Format('New Cursor Size: %d', [ScrBuf.Cursor.Size])); + Readln; + ScrBuf.Cursor.Size := OldSize; + + ScrBuf.WriteLn('Visible of Cursor: ' + BoolName[ScrBuf.Cursor.Visible]); + ScrBuf.Cursor.Visible := False; + ScrBuf.Write('Hidden Cursor: ' + BoolName[ScrBuf.Cursor.Visible]); + Readln; + ScrBuf.Cursor.Visible := True; +end; + +procedure ShowWindowInfo(const ScrBuf: TJclScreenBuffer); +var + OldPos, OldSize: TCoord; +begin + ScrBuf.WriteLn; + ScrBuf.WriteLn(Format('Largest Console Size : (%d, %d)', + [ScrBuf.Window.MaxConsoleWindowSize.X, ScrBuf.Window.MaxConsoleWindowSize.Y])); + ScrBuf.WriteLn(Format('Largest Window Size : (%d, %d)', + [ScrBuf.Window.MaxWindow.X, ScrBuf.Window.MaxWindow.Y])); + + ScrBuf.WriteLn(Format('Old Window Position : (%d, %d)', [ScrBuf.Window.Left, ScrBuf.Window.Top])); + OldPos := ScrBuf.Window.Position; + ScrBuf.Window.Left := 0; + ScrBuf.Window.Top := 0; + ScrBuf.Write(Format('New Window Position : (%d, %d)', [ScrBuf.Window.Left, ScrBuf.Window.Top])); + Readln; + ScrBuf.Window.Position := OldPos; + + ScrBuf.WriteLn(Format('Old Window Size : (%d, %d)', [ScrBuf.Window.Width, ScrBuf.Window.Height])); + OldSize := ScrBuf.Window.Size; + ScrBuf.Window.Width := ScrBuf.Window.Width div 2; + ScrBuf.Window.Height := ScrBuf.Window.Height div 2; + ScrBuf.Write(Format('New Window Size : (%d, %d)', [ScrBuf.Window.Width, ScrBuf.Window.Height])); + Readln; + ScrBuf.Window.Size := OldSize; + + ScrBuf.Write(Format('Scroll up %d line: ', [ScrBuf.Window.Top])); + Readln; + OldPos := ScrBuf.Window.Position; + ScrBuf.Window.Scroll(0, -ScrBuf.Window.Top); + Readln; + ScrBuf.Window.Position := OldPos; +end; + +procedure ShowTextAttributeInfo(const ScrBuf: TJclScreenBuffer); + function StyleToString: string; + var + AStyle: TJclScreenFontStyle; + begin + for AStyle:=Low(TJclScreenFontStyle) to High(TJclScreenFontStyle) do + begin + if AStyle in ScrBuf.Font.Style then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + GetEnumName(TypeInfo(TJclScreenFontStyle), Integer(AStyle)); + end; + end; + end; +const + HighlightName: array[Boolean] of string = ('', ' [Highlight]'); +var + OldTextAttribute: Word; +begin + ScrBuf.WriteLn('Old Font Color : ' + + GetEnumName(TypeInfo(TJclScreenFontColor), Integer(ScrBuf.Font.Color)) + + HighlightName[ScrBuf.Font.Highlight]); + ScrBuf.WriteLn('Old Back Color : ' + + GetEnumName(TypeInfo(TJclScreenBackColor), Integer(ScrBuf.Font.BgColor)) + + HighlightName[ScrBuf.Font.BgHighlight]); + ScrBuf.Writeln('Old Font Style : ' + StyleToString); + OldTextAttribute := ScrBuf.Font.TextAttribute; + ScrBuf.Font.Color := fclYellow; + ScrBuf.Font.Highlight := True; + ScrBuf.Font.BgColor := bclBlue; + ScrBuf.Font.Style := ScrBuf.Font.Style + [fsUnderscore]; + ScrBuf.WriteLn('New Font Color : ' + + GetEnumName(TypeInfo(TJclScreenFontColor), Integer(ScrBuf.Font.Color)) + + HighlightName[ScrBuf.Font.Highlight]); + ScrBuf.WriteLn('New Back Color : ' + + GetEnumName(TypeInfo(TJclScreenBackColor), Integer(ScrBuf.Font.BgColor)) + + HighlightName[ScrBuf.Font.BgHighlight]); + ScrBuf.Write('New Font Style : ' + StyleToString); + ScrBuf.Font.TextAttribute := OldTextAttribute; + ScrBuf.Writeln; +end; + +{ TCtrlEventHandler } + +type + TCtrlEventHandler = class + private + FConsole: TJclConsole; + FTerminated: Boolean; + protected + procedure OnCtrlC(Sender: TObject); + procedure OnCtrlBreak(Sender: TObject); + procedure OnClose(Sender: TObject); + procedure OnLogOff(Sender: TObject); + procedure OnShutdown(Sender: TObject); + + procedure Terminate; + public + constructor Create(AConsole: TJclConsole); + + property Console: TJclConsole read FConsole; + property Terminated: Boolean read FTerminated; + end; + +constructor TCtrlEventHandler.Create(AConsole: TJclConsole); +begin + FConsole := AConsole; + FTerminated := False; + + Console.OnCtrlC := OnCtrlC; + Console.OnCtrlBreak := OnCtrlBreak; + Console.OnClose := OnClose; + Console.OnLogOff := OnLogOff; + Console.OnShutdown := OnShutdown; +end; + +procedure TCtrlEventHandler.Terminate; +var + Evt: TInputRecord; +begin + Sleep(1000); + + FTerminated := True; + + Evt.EventType := FOCUS_EVENT; + Evt.Event.FocusEvent.bSetFocus := False; + FConsole.Input.PutEvent(Evt); +end; + +procedure TCtrlEventHandler.OnCtrlC(Sender: TObject); +begin + Console.ActiveScreen.Writeln('Ctrl Event: Ctrl-C'); +end; + +procedure TCtrlEventHandler.OnCtrlBreak(Sender: TObject); +begin + Console.ActiveScreen.Writeln('Ctrl Event: Ctrl-Break'); +end; + +procedure TCtrlEventHandler.OnClose(Sender: TObject); +begin + Console.ActiveScreen.Writeln('Ctrl Event: Close'); + Terminate; +end; + +procedure TCtrlEventHandler.OnLogOff(Sender: TObject); +begin + Console.ActiveScreen.Writeln('Ctrl Event: Logoff'); + Terminate; +end; + +procedure TCtrlEventHandler.OnShutdown(Sender: TObject); +begin + Console.ActiveScreen.Writeln('Ctrl Event: Shutdown'); + Terminate; +end; + +procedure ShowInputInfo(const InputBuf: TJclInputBuffer); + function ModeToString: string; + var + AMode: TJclConsoleInputMode; + begin + for AMode:=Low(TJclConsoleInputMode) to High(TJclConsoleInputMode) do + begin + if AMode in InputBuf.Mode then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + GetEnumName(TypeInfo(TJclConsoleInputMode), Integer(AMode)); + end; + end; + end; + + procedure AddEvent; + var + ir: TInputRecord; + begin + ir.EventType := MENU_EVENT; + ir.Event.MenuEvent.dwCommandId := 111; + InputBuf.PutEvent(ir); + end; +const + MOUSE_CLICKED = 0; + MOUSE_WHEELED = 3; + KeyDownBoolName: array[Boolean] of string = ('released', 'pressed'); + SetFocusBoolName: array[Boolean] of string = ('deactivated', 'activated'); +var + I: DWORD; + OldPos: TCoord; + CtrlEvt: TCtrlEventHandler; + ScrBuf: TJclScreenBuffer; +begin + ScrBuf := InputBuf.Console.ActiveScreen; + ScrBuf.WriteLn(Format('Input Event Count : %d', [InputBuf.EventCount])); + + InputBuf.Mode := [imProcessed, imWindow, imMouse]; + ScrBuf.Writeln('Input Mode : ' + ModeToString); + + InputBuf.Clear; + + AddEvent; + + CtrlEvt := TCtrlEventHandler.Create(InputBuf.Console); + try + ScrBuf.WriteLn('Press [q] to break the loop...'); + while not CtrlEvt.Terminated and InputBuf.WaitEvent do + begin + with InputBuf.GetEvent do + case EventType of + KEY_EVENT: + begin + ScrBuf.WriteLn(Format('Key (%s)$%.2x is %s %d times', + [Event.KeyEvent.AsciiChar, Event.KeyEvent.wVirtualKeyCode, + KeyDownBoolName[Event.KeyEvent.bKeyDown], Event.KeyEvent.wRepeatCount])); + + if Event.KeyEvent.AsciiChar = 'q' then + Break; + end; + _MOUSE_EVENT: + begin + case Event.MouseEvent.dwEventFlags of + MOUSE_CLICKED: + begin + for I:= 1 to TJclConsole.MouseButtonCount do + if (Event.MouseEvent.dwButtonState and (1 shl (I - 1))) <> 0 then + begin + ScrBuf.Write(Format('Mouse %d button click at', [I])); + Break; + end; + if I > TJclConsole.MouseButtonCount then + ScrBuf.Write('Mouse button released at'); + end; + DOUBLE_CLICK: + ScrBuf.Write('Mouse double-click at'); + MOUSE_MOVED: + begin + if (OldPos.X <> Event.MouseEvent.dwMousePosition.X) or + (OldPos.Y <> Event.MouseEvent.dwMousePosition.Y) then + begin + ScrBuf.Write('Mouse move to'); + OldPos := Event.MouseEvent.dwMousePosition; + end + else + Continue; + end; + MOUSE_WHEELED: + ScrBuf.Write('Mouse wheeled at'); + else + ScrBuf.Write('Mouse unknown action at'); + end; + + ScrBuf.WriteLn(Format(' (%d, %d) ', [Event.MouseEvent.dwMousePosition.X, Event.MouseEvent.dwMousePosition.Y])); + end; + WINDOW_BUFFER_SIZE_EVENT: + ScrBuf.WriteLn(Format('Screen buffer size is change to (%d, %d)', + [Event.WindowBufferSizeEvent.dwSize.X, Event.WindowBufferSizeEvent.dwSize.Y])); + MENU_EVENT: + ScrBuf.WriteLn(Format('Menu command %d is selected', [Event.MenuEvent.dwCommandId])); + FOCUS_EVENT: + ScrBuf.Writeln('Console window is ' + SetFocusBoolName[Event.FocusEvent.bSetFocus]); + else + ScrBuf.WriteLn(Format('Unknown event - %d', [EventType])); + end; + end; + finally + FreeAndNil(CtrlEvt); + end; +end; + +var + ScrBuf, NewScrBuf: TJclScreenBuffer; +begin + ShowConsoleInfo(TJclConsole.Default); + + ScrBuf := TJclConsole.Default.ActiveScreen; + + ShowScreenInfo(ScrBuf); + ShowCursorInfo(ScrBuf); + ShowWindowInfo(ScrBuf); + + ScrBuf.Clear; + + NewScrBuf := TJclConsole.Default.Add; + ShowTextAttributeInfo(NewScrBuf); + TJclConsole.Default.ActiveScreen := NewScrBuf; + + ShowInputInfo(TJclConsole.Default.Input); + + NewScrBuf.Clear; + + TJclConsole.Default.ActiveScreen := ScrBuf; +end. diff --git a/official/1.96/examples/windows/appinst/AppInstDemoMain.dfm b/official/1.96/examples/windows/appinst/AppInstDemoMain.dfm new file mode 100644 index 0000000..5a11a5c --- /dev/null +++ b/official/1.96/examples/windows/appinst/AppInstDemoMain.dfm @@ -0,0 +1,131 @@ +object Form1: TForm1 + Left = 204 + Top = 125 + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsSingle + Caption = 'JclAppInst demo' + ClientHeight = 365 + ClientWidth = 329 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poDefaultPosOnly + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 256 + Top = 8 + Width = 65 + Height = 97 + Alignment = taCenter + AutoSize = False + Caption = '0' + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -96 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + Layout = tlCenter + end + object InstancesListView: TListView + Left = 0 + Top = 0 + Width = 241 + Height = 177 + Columns = < + item + Caption = 'Number' + end + item + Alignment = taRightJustify + Caption = 'ProcessID' + Width = 70 + end + item + Alignment = taRightJustify + Caption = 'Application HWND' + Width = 110 + end> + ColumnClick = False + HideSelection = False + ReadOnly = True + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + OnDblClick = SwitchBtnClick + end + object SwitchBtn: TButton + Left = 248 + Top = 120 + Width = 75 + Height = 25 + Caption = 'Switch to' + TabOrder = 1 + OnClick = SwitchBtnClick + end + object MsgBtn: TButton + Left = 248 + Top = 152 + Width = 75 + Height = 25 + Caption = 'Message' + TabOrder = 2 + OnClick = MsgBtnClick + end + object Memo1: TMemo + Left = 0 + Top = 184 + Width = 241 + Height = 177 + Lines.Strings = ( + 'Enter a text') + TabOrder = 3 + OnChange = Memo1Change + end + object SendBtn: TButton + Left = 248 + Top = 336 + Width = 75 + Height = 25 + Caption = 'Send' + TabOrder = 4 + OnClick = SendBtnClick + end + object AutoUpdateCheckBox: TCheckBox + Left = 248 + Top = 304 + Width = 97 + Height = 17 + Caption = 'Auto update' + TabOrder = 5 + end + object ColorDialog1: TColorDialog + Ctl3D = True + CustomColors.Strings = ( + 'ColorA=FFFFFFFF' + 'ColorB=FFFFFFFF' + 'ColorC=FFFFFFFF' + 'ColorD=FFFFFFFF' + 'ColorE=FFFFFFFF' + 'ColorF=FFFFFFFF' + 'ColorG=FFFFFFFF' + 'ColorH=FFFFFFFF' + 'ColorI=FFFFFFFF' + 'ColorJ=FFFFFFFF' + 'ColorK=FFFFFFFF' + 'ColorL=FFFFFFFF' + 'ColorM=FFFFFFFF' + 'ColorN=FFFFFFFF' + 'ColorO=FFFFFFFF' + 'ColorP=FFFFFFFF') + Options = [cdPreventFullOpen] + Left = 8 + Top = 144 + end +end diff --git a/official/1.96/examples/windows/appinst/AppInstDemoMain.pas b/official/1.96/examples/windows/appinst/AppInstDemoMain.pas new file mode 100644 index 0000000..422071b --- /dev/null +++ b/official/1.96/examples/windows/appinst/AppInstDemoMain.pas @@ -0,0 +1,169 @@ +unit AppInstDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + JclAppInst, ComCtrls, StdCtrls; + +type + TForm1 = class(TForm) + InstancesListView: TListView; + Label1: TLabel; + SwitchBtn: TButton; + MsgBtn: TButton; + ColorDialog1: TColorDialog; + Memo1: TMemo; + SendBtn: TButton; + AutoUpdateCheckBox: TCheckBox; + procedure FormCreate(Sender: TObject); + procedure SwitchBtnClick(Sender: TObject); + procedure MsgBtnClick(Sender: TObject); + procedure SendBtnClick(Sender: TObject); + procedure Memo1Change(Sender: TObject); + private + procedure BuildInstancesList; + procedure ApplicationEvents1Message(var Msg: TMsg; var Handled: Boolean); + public + procedure WndProc(var Message: TMessage); override; + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +const + MaxAllowedInstances = 3; + + MyDataKind = 1; + +{ TForm1 } + +procedure TForm1.BuildInstancesList; +var + I, CurrIndex: Integer; +begin + with InstancesListView, JclAppInstances do + begin + Items.BeginUpdate; + Items.Clear; + for I := 0 to InstanceCount -1 do + with Items.Add do + begin + Caption := IntToStr(I + 1); + SubItems.Add(Format('%.8x', [ProcessIDs[I]])); + SubItems.Add(Format('%.8x', [AppWnds[I]])); + end; + CurrIndex := InstanceIndex[GetCurrentProcessId]; + Selected := Items[CurrIndex]; + Items.EndUpdate; + end; + Label1.Caption := IntToStr(CurrIndex + 1); +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + Application.OnMessage := ApplicationEvents1Message; + BuildInstancesList; +end; + +procedure TForm1.ApplicationEvents1Message(var Msg: TMsg; var Handled: Boolean); +begin + // AI_* messages handler. These messages are automatically send to all instances + // of the application. + with Msg do + if (hwnd = 0) and (message = JclAppInstances.MessageID) then + begin + case wParam of + AI_INSTANCECREATED, AI_INSTANCEDESTROYED: + BuildInstancesList; + AI_USERMSG: + Label1.Font.Color := TColor(lParam); + end; + Handled := True; + end; +end; + +procedure TForm1.SwitchBtnClick(Sender: TObject); +begin + JclAppInstances.SwitchTo(InstancesListView.Selected.Index); +end; + +procedure TForm1.MsgBtnClick(Sender: TObject); +begin + with ColorDialog1 do + begin + Color := Label1.Font.Color; + if Execute then + JclAppInstances.UserNotify(Color); + end; +end; + +procedure TForm1.SendBtnClick(Sender: TObject); +begin + // TForm.ClassName matches window class name. It sends the data to all windows + // belonging instances of this application. The last parameter identifies the + // 'TForm1' (ClassName) window of this instance. + JclAppInstances.SendStrings(ClassName, MyDataKind, Memo1.Lines, Handle); +end; + +var + MemoChanging: Boolean; + +procedure TForm1.WndProc(var Message: TMessage); +begin + // Interprocess communication handler. + + // First check whether we can safely read TForm.Handle property ... + if HandleAllocated and not (csDestroying in ComponentState) then + begin + // ... then whether it is our message. The last paramter tells to ignore the + // message sent from window of this instance + case ReadMessageCheck(Message, Handle) of + MyDataKind: // It is our data + begin + MemoChanging := True; // prevent deadlock, TMemo.OnChange is also fired now + Memo1.Lines.BeginUpdate; + try + // Read TStrings from the message + ReadMessageStrings(Message, Memo1.Lines) + finally + Memo1.Lines.EndUpdate; + MemoChanging := False; + end; + end; + else + inherited; + end; + end + else + inherited; +end; + +procedure TForm1.Memo1Change(Sender: TObject); +begin + if not MemoChanging and AutoUpdateCheckBox.Checked then + SendBtnClick(nil); +end; + +initialization + + with JclAppInstances do + // CheckInstance returns False if current instance number is greater than + // MaxAllowedInstances constant + if not CheckInstance(MaxAllowedInstances) then + begin + // Switch to the first instance of the application + SwitchTo(0); + // Close this instance + KillInstance; + end; + + // Note: For preventing more than one instance of the application you can put + // simple JclAppInstances.CheckSingleInstance line to initialization section + // instead of code above + +end. diff --git a/official/1.96/examples/windows/appinst/AppInstExample.dof b/official/1.96/examples/windows/appinst/AppInstExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/appinst/AppInstExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/appinst/AppInstExample.dpr b/official/1.96/examples/windows/appinst/AppInstExample.dpr new file mode 100644 index 0000000..356a33a --- /dev/null +++ b/official/1.96/examples/windows/appinst/AppInstExample.dpr @@ -0,0 +1,13 @@ +program AppInstExample; + +uses + Forms, + AppInstDemoMain in 'AppInstDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/appinst/AppInstExample.res b/official/1.96/examples/windows/appinst/AppInstExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/appinst/AppInstExample.res differ diff --git a/official/1.96/examples/windows/appinst/SingleInstDemoMain.dfm b/official/1.96/examples/windows/appinst/SingleInstDemoMain.dfm new file mode 100644 index 0000000..806d53f --- /dev/null +++ b/official/1.96/examples/windows/appinst/SingleInstDemoMain.dfm @@ -0,0 +1,25 @@ +object Form1: TForm1 + Left = 194 + Top = 107 + Width = 278 + Height = 181 + Caption = 'Single application instance only' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object DialogBtn: TButton + Left = 72 + Top = 48 + Width = 113 + Height = 25 + Caption = 'Show modal dialog' + TabOrder = 0 + OnClick = DialogBtnClick + end +end diff --git a/official/1.96/examples/windows/appinst/SingleInstDemoMain.pas b/official/1.96/examples/windows/appinst/SingleInstDemoMain.pas new file mode 100644 index 0000000..1344a63 --- /dev/null +++ b/official/1.96/examples/windows/appinst/SingleInstDemoMain.pas @@ -0,0 +1,34 @@ +unit SingleInstDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls; + +type + TForm1 = class(TForm) + DialogBtn: TButton; + procedure DialogBtnClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +// See Project file source (SingleInstExample.dpr) for added single instance +// checking code. + +procedure TForm1.DialogBtnClick(Sender: TObject); +begin + ShowMessage('This is a modal dialog.'); +end; + +end. diff --git a/official/1.96/examples/windows/appinst/SingleInstExample.dof b/official/1.96/examples/windows/appinst/SingleInstExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/appinst/SingleInstExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/appinst/SingleInstExample.dpr b/official/1.96/examples/windows/appinst/SingleInstExample.dpr new file mode 100644 index 0000000..9db90b5 --- /dev/null +++ b/official/1.96/examples/windows/appinst/SingleInstExample.dpr @@ -0,0 +1,15 @@ +program SingleInstExample; + +uses + JclAppInst, // Added JclAppInst unit + Forms, + SingleInstDemoMain in 'SingleInstDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + JclAppInstances.CheckSingleInstance; // Added instance checking + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/appinst/SingleInstExample.res b/official/1.96/examples/windows/appinst/SingleInstExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/appinst/SingleInstExample.res differ diff --git a/official/1.96/examples/windows/asuser/CreateProcAsUserDemoMain.dfm b/official/1.96/examples/windows/asuser/CreateProcAsUserDemoMain.dfm new file mode 100644 index 0000000..daf5241 --- /dev/null +++ b/official/1.96/examples/windows/asuser/CreateProcAsUserDemoMain.dfm @@ -0,0 +1,194 @@ +object Form1: TForm1 + Left = 386 + Top = 230 + Width = 398 + Height = 370 + Caption = 'CreateProcAsUser Demo' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 8 + Top = 8 + Width = 47 + Height = 13 + Caption = 'Domain:' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object Label2: TLabel + Left = 136 + Top = 8 + Width = 61 + Height = 13 + Caption = 'Username:' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object Label3: TLabel + Left = 264 + Top = 8 + Width = 59 + Height = 13 + Caption = 'Password:' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object Label4: TLabel + Left = 8 + Top = 52 + Width = 83 + Height = 13 + Caption = 'Command line:' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object Label5: TLabel + Left = 8 + Top = 104 + Width = 75 + Height = 13 + Caption = 'Environment:' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object edtDomain: TEdit + Left = 8 + Top = 24 + Width = 121 + Height = 21 + TabOrder = 0 + end + object edtUserName: TEdit + Left = 136 + Top = 24 + Width = 121 + Height = 21 + TabOrder = 1 + end + object edtPassword: TEdit + Left = 264 + Top = 24 + Width = 121 + Height = 21 + TabOrder = 2 + end + object edtCommandLine: TEdit + Left = 8 + Top = 68 + Width = 377 + Height = 21 + TabOrder = 3 + end + object btnCreateProcAsUser: TButton + Left = 8 + Top = 312 + Width = 129 + Height = 25 + Caption = 'Create Process As User' + Default = True + TabOrder = 4 + OnClick = btnCreateProcAsUserClick + end + object btnCreateProcAsUserEx: TButton + Left = 148 + Top = 312 + Width = 145 + Height = 25 + Caption = 'Create Process As User Ex' + TabOrder = 5 + OnClick = btnCreateProcAsUserExClick + end + object lbEnvironment: TListBox + Left = 8 + Top = 120 + Width = 193 + Height = 141 + ItemHeight = 13 + TabOrder = 6 + end + object edtEnvString: TEdit + Left = 216 + Top = 120 + Width = 165 + Height = 21 + TabOrder = 7 + end + object btnAddEnvString: TButton + Left = 216 + Top = 148 + Width = 75 + Height = 25 + Caption = 'Add' + TabOrder = 8 + OnClick = btnAddEnvStringClick + end + object btnRemoveEnvString: TButton + Left = 216 + Top = 176 + Width = 75 + Height = 25 + Caption = 'Remove' + TabOrder = 9 + OnClick = btnRemoveEnvStringClick + end + object btnClearEnvStrings: TButton + Left = 216 + Top = 204 + Width = 75 + Height = 25 + Caption = 'Clear' + TabOrder = 10 + OnClick = btnClearEnvStringsClick + end + object chkEnvAdditional: TCheckBox + Left = 216 + Top = 236 + Width = 97 + Height = 17 + Caption = 'Additional' + TabOrder = 11 + end + object chkEnvCurrentUser: TCheckBox + Left = 216 + Top = 256 + Width = 97 + Height = 17 + Caption = 'Current User' + TabOrder = 12 + end + object chkEnvLocalMachine: TCheckBox + Left = 216 + Top = 276 + Width = 97 + Height = 17 + Caption = 'Local Machine' + TabOrder = 13 + end +end diff --git a/official/1.96/examples/windows/asuser/CreateProcAsUserDemoMain.pas b/official/1.96/examples/windows/asuser/CreateProcAsUserDemoMain.pas new file mode 100644 index 0000000..1b84f54 --- /dev/null +++ b/official/1.96/examples/windows/asuser/CreateProcAsUserDemoMain.pas @@ -0,0 +1,93 @@ +unit CreateProcAsUserDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls; + +type + TForm1 = class(TForm) + edtDomain: TEdit; + Label1: TLabel; + edtUserName: TEdit; + Label2: TLabel; + edtPassword: TEdit; + Label3: TLabel; + edtCommandLine: TEdit; + Label4: TLabel; + btnCreateProcAsUser: TButton; + btnCreateProcAsUserEx: TButton; + lbEnvironment: TListBox; + Label5: TLabel; + edtEnvString: TEdit; + btnAddEnvString: TButton; + btnRemoveEnvString: TButton; + btnClearEnvStrings: TButton; + chkEnvAdditional: TCheckBox; + chkEnvCurrentUser: TCheckBox; + chkEnvLocalMachine: TCheckBox; + procedure btnAddEnvStringClick(Sender: TObject); + procedure btnClearEnvStringsClick(Sender: TObject); + procedure btnRemoveEnvStringClick(Sender: TObject); + procedure btnCreateProcAsUserClick(Sender: TObject); + procedure btnCreateProcAsUserExClick(Sender: TObject); + private + public + end; + +var + Form1: TForm1; + +implementation + +uses + JclMiscel, JclStrings, JclSysInfo; + +{$R *.dfm} + +procedure TForm1.btnAddEnvStringClick(Sender: TObject); +begin + lbEnvironment.Items.Add(edtEnvString.Text); +end; + +procedure TForm1.btnClearEnvStringsClick(Sender: TObject); +begin + lbEnvironment.Items.Clear; +end; + +procedure TForm1.btnRemoveEnvStringClick(Sender: TObject); +var + I: Integer; +begin + for I := lbEnvironment.Items.Count - 1 downto 0 do + if lbEnvironment.Selected[I] then + lbEnvironment.Items.Delete(I); +end; + +procedure TForm1.btnCreateProcAsUserClick(Sender: TObject); +begin + CreateProcAsUser(edtDomain.Text, edtUserName.Text, + edtPassWord.Text, edtCommandline.Text); +end; + +procedure TForm1.btnCreateProcAsUserExClick(Sender: TObject); +var + Env: PChar; + EnvOptions: TEnvironmentOptions; +begin + EnvOptions := []; + if chkEnvAdditional.Checked then + EnvOptions := EnvOptions + [eoAdditional]; + if chkEnvCurrentUser.Checked then + EnvOptions := EnvOptions + [eoCurrentUser]; + if chkEnvLocalMachine.Checked then + EnvOptions := EnvOptions + [eoLocalMachine]; + + Env := CreateEnvironmentBlock(EnvOptions, lbEnvironment.Items); + CreateProcAsUserEx(edtDomain.Text, edtUserName.Text, + edtPassWord.Text, edtCommandline.Text, Env); + DestroyEnvironmentBlock(Env); +end; + +end. diff --git a/official/1.96/examples/windows/asuser/CreateProcAsUserExample.dof b/official/1.96/examples/windows/asuser/CreateProcAsUserExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/asuser/CreateProcAsUserExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/asuser/CreateProcAsUserExample.dpr b/official/1.96/examples/windows/asuser/CreateProcAsUserExample.dpr new file mode 100644 index 0000000..254459c --- /dev/null +++ b/official/1.96/examples/windows/asuser/CreateProcAsUserExample.dpr @@ -0,0 +1,13 @@ +program CreateProcAsUserExample; + +uses + Forms, + CreateProcAsUserDemoMain in 'CreateProcAsUserDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/asuser/CreateProcAsUserExample.res b/official/1.96/examples/windows/asuser/CreateProcAsUserExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/asuser/CreateProcAsUserExample.res differ diff --git a/official/1.96/examples/windows/clr/ClrDemo.dof b/official/1.96/examples/windows/clr/ClrDemo.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemo.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/clr/ClrDemo.dpr b/official/1.96/examples/windows/clr/ClrDemo.dpr new file mode 100644 index 0000000..2522479 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemo.dpr @@ -0,0 +1,21 @@ +program ClrDemo; + +uses + Forms, + ClrDemoMain in 'ClrDemoMain.pas' {frmMain}, + ClrDemoAbstractFrame in 'ClrDemoAbstractFrame.pas' {frmAbstract: TFrame}, + ClrDemoMetaDataFrame in 'ClrDemoMetaDataFrame.pas' {frmMetadata: TFrame}, + ClrDemoStringsForm in 'ClrDemoStringsForm.pas' {frmStrings}, + ClrDemoGuidForm in 'ClrDemoGuidForm.pas' {frmGuid}, + ClrDemoBlobForm in 'ClrDemoBlobForm.pas' {frmBlobs}, + ClrDemoTableForm in 'ClrDemoTableForm.pas' {frmTable}, + ClrDemoUserStringsForm in 'ClrDemoUserStringsForm.pas' {frmUserStrings}, + ClrDemoCLRFrame in 'ClrDemoCLRFrame.pas' {frmCLR: TFrame}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/official/1.96/examples/windows/clr/ClrDemo.res b/official/1.96/examples/windows/clr/ClrDemo.res new file mode 100644 index 0000000..82939cc Binary files /dev/null and b/official/1.96/examples/windows/clr/ClrDemo.res differ diff --git a/official/1.96/examples/windows/clr/ClrDemoAbstractFrame.dfm b/official/1.96/examples/windows/clr/ClrDemoAbstractFrame.dfm new file mode 100644 index 0000000..8252c1c --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoAbstractFrame.dfm @@ -0,0 +1,7 @@ +object frmAbstract: TfrmAbstract + Left = 0 + Top = 0 + Width = 320 + Height = 240 + TabOrder = 0 +end diff --git a/official/1.96/examples/windows/clr/ClrDemoAbstractFrame.pas b/official/1.96/examples/windows/clr/ClrDemoAbstractFrame.pas new file mode 100644 index 0000000..2c49099 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoAbstractFrame.pas @@ -0,0 +1,105 @@ +unit ClrDemoAbstractFrame; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, JclCLR; + +type + TfrmAbstract = class(TFrame) + public + procedure ShowInfo(const ACLR: TJclCLRHeaderEx); virtual; abstract; + + class procedure DumpBuf(const Ptr: Pointer; const Size: Integer; + const memDump: TMemo; const Base: DWORD = 0; + const AutoClear: Boolean = True); overload; + class procedure DumpBuf(const Blob: TJclCLRBlobRecord; const memDump: TMemo; + const AutoClear: Boolean = False); overload; + end; + +implementation + +{$R *.DFM} + +uses + JclStrings; + +{ TfrmAbstract } + +class procedure TfrmAbstract.DumpBuf(const Ptr: Pointer; const Size: Integer; + const memDump: TMemo; const Base: DWORD; const AutoClear: Boolean); +const + WIDE_LINE_WIDTH = 76; + THIN_LINE_WIDTH = 44; +var + I, ByteCount, LineWidth: Integer; + pch: PChar; + DumpStr: string; +begin + if AutoClear then memDump.Clear; + + ByteCount := 0; + pch := Ptr; + + with TCanvas.Create do + try + Handle := GetDC(memDump.Handle); + Font.Name := 'Fixedsys'; + Font.Size := 12; + if (TextWidth('?')*WIDE_LINE_WIDTH) < memDump.ClientWidth then + LineWidth := 16 + else if (TextWidth('?')*THIN_LINE_WIDTH) < memDump.ClientWidth then + LineWidth := 8 + else + LineWidth := 4; + finally + Free; + end; + + with memDump.Lines do + try + BeginUpdate; + + while ByteCount < Size do + begin + DumpStr := IntToHex(Base + DWord(ByteCount), 8) + ': '; + for I:=0 to LineWidth-1 do + begin + if ((Size - ByteCount) > LineWidth) or ((Size - ByteCount) > I) then + DumpStr := DumpStr + IntToHex(Integer(pch[ByteCount+I]), 2) + ' ' + else + DumpStr := DumpStr + ' '; + end; + + DumpStr := DumpStr + '; '; + + for I:=0 to LineWidth-1 do + begin + if ((Size - ByteCount) > LineWidth) or ((Size - ByteCount) > I) then + begin + if CharIsAlphaNum(Char(pch[ByteCount+I])) then + DumpStr := DumpStr + pch[ByteCount+I] + else + DumpStr := DumpStr + '.' + end + else + DumpStr := DumpStr + ' '; + end; + + Add(DumpStr); + Inc(ByteCount, LineWidth); + end; + finally + EndUpdate; + end; + memDump.Perform(WM_VSCROLL, SB_TOP, 0); +end; + +class procedure TfrmAbstract.DumpBuf(const Blob: TJclCLRBlobRecord; + const memDump: TMemo; const AutoClear: Boolean); +begin + TfrmAbstract.DumpBuf(Blob.Memory, Blob.Size, memDump, Blob.Offset, AutoClear); +end; + +end. diff --git a/official/1.96/examples/windows/clr/ClrDemoBlobForm.dfm b/official/1.96/examples/windows/clr/ClrDemoBlobForm.dfm new file mode 100644 index 0000000..cd4bb39 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoBlobForm.dfm @@ -0,0 +1,71 @@ +object frmBlobs: TfrmBlobs + Left = 414 + Top = 406 + BorderStyle = bsDialog + Caption = 'Blob Stream' + ClientHeight = 273 + ClientWidth = 392 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poMainFormCenter + PixelsPerInch = 96 + TextHeight = 13 + object btnOK: TBitBtn + Left = 159 + Top = 240 + Width = 75 + Height = 25 + TabOrder = 0 + Kind = bkOK + end + object lstBlobs: TListView + Left = 8 + Top = 8 + Width = 377 + Height = 105 + Columns = < + item + Caption = 'Index' + Width = 40 + end + item + Alignment = taCenter + Caption = 'Offset' + Width = 80 + end + item + Caption = 'Size' + Width = 64 + end> + GridLines = True + OwnerData = True + ReadOnly = True + RowSelect = True + TabOrder = 1 + ViewStyle = vsReport + OnData = lstBlobsData + OnSelectItem = lstBlobsSelectItem + end + object memDump: TMemo + Left = 8 + Top = 120 + Width = 377 + Height = 113 + Color = clInactiveBorder + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Fixedsys' + Font.Style = [] + ImeName = #32043#20809#25340#38899#36755#20837#27861'2.2'#29256 + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 2 + end +end diff --git a/official/1.96/examples/windows/clr/ClrDemoBlobForm.pas b/official/1.96/examples/windows/clr/ClrDemoBlobForm.pas new file mode 100644 index 0000000..ef8bf69 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoBlobForm.pas @@ -0,0 +1,71 @@ +unit ClrDemoBlobForm; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + JclCLR, StdCtrls, Buttons, ComCtrls; + +type + TfrmBlobs = class(TForm) + btnOK: TBitBtn; + lstBlobs: TListView; + memDump: TMemo; + procedure lstBlobsSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure lstBlobsData(Sender: TObject; Item: TListItem); + private + FStream: TJclCLRBlobStream; + procedure ShowBlobs(const AStream: TJclCLRBlobStream); + public + class procedure Execute(const AStream: TJclCLRBlobStream); + end; + +var + frmBlobs: TfrmBlobs; + +implementation + +uses ClrDemoAbstractFrame; + +{$R *.DFM} + +{ TfrmBlobs } + +class procedure TfrmBlobs.Execute(const AStream: TJclCLRBlobStream); +begin + with TfrmBlobs.Create(nil) do + try + ShowBlobs(AStream); + ShowModal; + finally + Free; + end; +end; + +procedure TfrmBlobs.ShowBlobs(const AStream: TJclCLRBlobStream); +begin + FStream := AStream; + lstBlobs.Items.Count := FStream.BlobCount; +end; + +procedure TfrmBlobs.lstBlobsSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); +begin + if Selected then + with TJclCLRBlobRecord(Item.Data) do + TfrmAbstract.DumpBuf(Memory, Size, memDump, + FStream.Offset + DWORD(Memory) - DWORD(FStream.Data)); +end; + +procedure TfrmBlobs.lstBlobsData(Sender: TObject; Item: TListItem); +begin + Item.Caption := IntToStr(Item.Index); + Item.Data := FStream.Blobs[Item.Index]; + + Item.SubItems.Add('$' + + IntToHex(FStream.Blobs[Item.Index].Offset, 8)); + Item.SubItems.Add(IntToStr(FStream.Blobs[Item.Index].Size)); +end; + +end. diff --git a/official/1.96/examples/windows/clr/ClrDemoCLRFrame.dfm b/official/1.96/examples/windows/clr/ClrDemoCLRFrame.dfm new file mode 100644 index 0000000..99dd6f2 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoCLRFrame.dfm @@ -0,0 +1,184 @@ +inherited frmCLR: TfrmCLR + Width = 422 + Height = 325 + object PC: TPageControl + Left = 0 + Top = 89 + Width = 422 + Height = 236 + ActivePage = tsStrongNameSign + Align = alClient + TabOrder = 0 + object tsStrongNameSign: TTabSheet + Caption = 'Strong Name Signature' + object memStrongNameSign: TMemo + Left = 0 + Top = 0 + Width = 414 + Height = 208 + TabStop = False + Align = alClient + Color = clInactiveBorder + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Fixedsys' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + end + end + object tsResources: TTabSheet + Caption = 'Resources' + ImageIndex = 1 + object memResources: TMemo + Left = 0 + Top = 105 + Width = 414 + Height = 103 + TabStop = False + Align = alClient + Color = clInactiveBorder + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Fixedsys' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + end + object lstResources: TListView + Left = 0 + Top = 0 + Width = 414 + Height = 105 + Align = alTop + Columns = < + item + Caption = 'Index' + Width = 40 + end + item + Alignment = taCenter + Caption = 'Offset' + Width = 80 + end + item + Alignment = taCenter + Caption = 'RVA' + Width = 80 + end + item + Caption = 'Size' + Width = 64 + end> + ReadOnly = True + RowSelect = True + TabOrder = 1 + ViewStyle = vsReport + OnSelectItem = lstResourcesSelectItem + end + end + object tsVTableFixup: TTabSheet + Caption = 'VTable Fixups' + ImageIndex = 2 + object lstVTableFixups: TListView + Left = 0 + Top = 0 + Width = 414 + Height = 208 + Align = alClient + Columns = < + item + Caption = 'Index' + Width = 40 + end + item + Alignment = taCenter + Caption = 'Offset' + Width = 80 + end + item + Caption = 'Count' + Width = 40 + end + item + Caption = 'Flags' + Width = 200 + end> + ReadOnly = True + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + end + end + end + object pnlTop: TPanel + Left = 0 + Top = 0 + Width = 422 + Height = 89 + Align = alTop + BevelOuter = bvNone + TabOrder = 1 + object lblVer: TLabel + Left = 8 + Top = 16 + Width = 108 + Height = 13 + Caption = 'Required CLR Version:' + end + object lblEntryPointToken: TLabel + Left = 8 + Top = 56 + Width = 88 + Height = 13 + Caption = 'Entry Point Token:' + end + object edtVer: TEdit + Left = 120 + Top = 12 + Width = 121 + Height = 21 + Color = clInactiveBorder + ReadOnly = True + TabOrder = 0 + end + object boxFlags: TGroupBox + Left = 256 + Top = 0 + Width = 145 + Height = 81 + Caption = 'Image Runtime Flags' + TabOrder = 1 + object lstFlags: TCheckListBox + Left = 8 + Top = 16 + Width = 129 + Height = 57 + TabStop = False + Color = clInactiveBorder + ItemHeight = 13 + Items.Strings = ( + 'IL Only' + '32bit Required' + 'Strong Name Signed' + 'Track Debug Data') + TabOrder = 0 + end + end + object edtEntryPointToken: TEdit + Left = 120 + Top = 52 + Width = 121 + Height = 21 + Color = clInactiveBorder + ReadOnly = True + TabOrder = 2 + end + end +end diff --git a/official/1.96/examples/windows/clr/ClrDemoCLRFrame.pas b/official/1.96/examples/windows/clr/ClrDemoCLRFrame.pas new file mode 100644 index 0000000..38da0e0 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoCLRFrame.pas @@ -0,0 +1,183 @@ +unit ClrDemoCLRFrame; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ClrDemoAbstractFrame, StdCtrls, JclCLR, CheckLst, ExtCtrls, ComCtrls; + +type + TfrmCLR = class (TfrmAbstract) + boxFlags: TGroupBox; + edtEntryPointToken: TEdit; + edtVer: TEdit; + lblEntryPointToken: TLabel; + lblVer: TLabel; + lstFlags: TCheckListBox; + lstResources: TListView; + lstVTableFixups: TListView; + memResources: TMemo; + memStrongNameSign: TMemo; + PC: TPageControl; + pnlTop: TPanel; + tsResources: TTabSheet; + tsStrongNameSign: TTabSheet; + tsVTableFixup: TTabSheet; + procedure lstResourcesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); + private + FCLR: TJclClrHeaderEx; + public + procedure ShowInfo(const ACLR: TJclCLRHeaderEx); override; + end; + +var + frmCLR: TfrmCLR; + +implementation + +{$R *.DFM} + +uses + Math, TypInfo, JclMetadata; + +{ TfrmCLR } + +{ +*********************************** TfrmCLR ************************************ +} +procedure TfrmCLR.lstResourcesSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); +begin + if Selected then + with TJclCLRResourceRecord(Item.Data) do + DumpBuf(Memory, Size, memResources, RVA); +end; + +procedure TfrmCLR.ShowInfo(const ACLR: TJclCLRHeaderEx); + + procedure UpdateFlags; + var + AFlag: TJclClrImageFlag; + begin + for AFlag:=Low(TJclClrImageFlag) to High(TJclClrImageFlag) do + begin + lstFlags.Checked[Integer(AFlag)] := AFlag in ACLR.Flags; + lstFlags.ItemEnabled[Integer(AFlag)] := False; + end; + end; + + procedure UpdateEntryPointToken; + var + AMethod: TJclCLRTableMethodDefRow; + ATypeDef: TJclCLRTableTypeDefRow; + begin + if Assigned(ACLR.EntryPointToken) then + begin + if ACLR.EntryPointToken is TJclCLRTableMethodDefRow then + begin + AMethod := ACLR.EntryPointToken as TJclCLRTableMethodDefRow; + if AMethod.ParentToken is TJclCLRTableTypeDefRow then + begin + ATypeDef := AMethod.ParentToken as TJclCLRTableTypeDefRow; + edtEntryPointToken.Text := ATypeDef.Namespace + '.' + ATypeDef.Name + '.' + AMethod.Name; + end + else + edtEntryPointToken.Text := AMethod.Name; + end + else if ACLR.EntryPointToken is TJclCLRTableFileRow then + edtEntryPointToken.Text := 'External file' + else + edtEntryPointToken.Text := '$' + IntToHex(ACLR.Header.EntryPointToken, 8); + end + else + edtEntryPointToken.Text := '(none)'; + end; + + procedure UpdateStrongNameSign; + begin + if ACLR.HasStrongNameSignature then + with ACLR.StrongNameSignature, ACLR.Header.StrongNameSignature do + DumpBuf(Memory, Size, memStrongNameSign, + VirtualAddress-ACLR.Image.RvaToSection(VirtualAddress).PointerToRawData) + else + memStrongNameSign.Clear; + end; + + procedure UpdateResources; + var + I: Integer; + begin + with lstResources.Items do + try + BeginUpdate; + Clear; + + if ACLR.HasResources then + for I:=0 to ACLR.ResourceCount-1 do + with Add do + begin + Caption := IntToStr(I); + Data := ACLR.Resources[I]; + with ACLR.Resources[I] do + begin + SubItems.Add('$' + IntToHex(Offset, 8)); + SubItems.Add('$' + IntToHex(RVA, 8)); + SubItems.Add(IntToStr(Size)); + end; + end + else + memResources.Clear; + finally + EndUpdate; + end; + end; + + function FormatVTableKinds(const Kinds: TJclClrVTableKinds): string; + var + AKind: TJclClrVTableKind; + begin + Result := ''; + for AKind:=Low(TJclClrVTableKind) to High(TJclClrVTableKind) do + if AKind in Kinds then + Result := Result + GetEnumName(TypeInfo(TJclClrVTableKind), Integer(AKind)) + ' '; + end; + + procedure UpdateVTableFixups; + var + I: Integer; + begin + with lstVTableFixups.Items do + try + BeginUpdate; + Clear; + if ACLR.HasVTableFixup then + for I:=0 to ACLR.VTableFixupCount-1 do + with Add do + begin + Caption := IntToStr(I); + Data := ACLR.VTableFixups[I]; + with ACLR.VTableFixups[I] do + begin + SubItems.Add('$' + IntToHex(RVA, 8)); + SubItems.Add(IntToStr(Count)); + SubItems.Add(FormatVTableKinds(Kinds)); + end; + end; + finally + EndUpdate; + end; + end; + +begin + FCLR := ACLR; + + edtVer.Text := ACLR.VersionString; + UpdateEntryPointToken; + UpdateFlags; + UpdateStrongNameSign; + UpdateResources; + UpdateVTableFixups; +end; + +end. + diff --git a/official/1.96/examples/windows/clr/ClrDemoGuidForm.dfm b/official/1.96/examples/windows/clr/ClrDemoGuidForm.dfm new file mode 100644 index 0000000..252c632 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoGuidForm.dfm @@ -0,0 +1,48 @@ +object frmGuid: TfrmGuid + Left = 339 + Top = 225 + BorderStyle = bsDialog + Caption = 'Guid Stream' + ClientHeight = 273 + ClientWidth = 392 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poMainFormCenter + PixelsPerInch = 96 + TextHeight = 13 + object btnOK: TBitBtn + Left = 159 + Top = 240 + Width = 75 + Height = 25 + TabOrder = 0 + Kind = bkOK + end + object lstGuids: TListView + Left = 8 + Top = 8 + Width = 377 + Height = 225 + Columns = < + item + Caption = 'Index' + Width = 40 + end + item + Caption = 'GUID' + Width = 320 + end> + GridLines = True + OwnerData = True + ReadOnly = True + RowSelect = True + TabOrder = 1 + ViewStyle = vsReport + OnData = lstGuidsData + end +end diff --git a/official/1.96/examples/windows/clr/ClrDemoGuidForm.pas b/official/1.96/examples/windows/clr/ClrDemoGuidForm.pas new file mode 100644 index 0000000..0814a97 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoGuidForm.pas @@ -0,0 +1,53 @@ +unit ClrDemoGuidForm; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, StdCtrls, Buttons, JclCLR; + +type + TfrmGuid = class(TForm) + btnOK: TBitBtn; + lstGuids: TListView; + procedure lstGuidsData(Sender: TObject; Item: TListItem); + private + FStream: TJclCLRGuidStream; + procedure ShowGuids(const AStream: TJclCLRGuidStream); + public + class procedure Execute(const AStream: TJclCLRGuidStream); + end; + +implementation + +{$R *.DFM} + +uses + ComObj; + +{ TfrmGuid } + +class procedure TfrmGuid.Execute(const AStream: TJclCLRGuidStream); +begin + with TfrmGuid.Create(nil) do + try + ShowGuids(AStream); + ShowModal; + finally + Free; + end; +end; + +procedure TfrmGuid.ShowGuids(const AStream: TJclCLRGuidStream); +begin + FStream := AStream; + lstGuids.Items.Count := FStream.GuidCount; +end; + +procedure TfrmGuid.lstGuidsData(Sender: TObject; Item: TListItem); +begin + Item.Caption := IntToStr(Item.Index); + Item.SubItems.Add(GUIDToString(FStream.Guids[Item.Index])); +end; + +end. diff --git a/official/1.96/examples/windows/clr/ClrDemoMain.dfm b/official/1.96/examples/windows/clr/ClrDemoMain.dfm new file mode 100644 index 0000000..4566ad1 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoMain.dfm @@ -0,0 +1,171 @@ +object frmMain: TfrmMain + Left = 274 + Top = 241 + Width = 696 + Height = 480 + Caption = 'Microsoft .Net Framework CLR Demo' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Menu = mnuMain + OldCreateOrder = False + Position = poDesktopCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object barStatus: TStatusBar + Left = 0 + Top = 415 + Width = 688 + Height = 19 + Panels = <> + end + object PC: TPageControl + Left = 0 + Top = 0 + Width = 688 + Height = 415 + ActivePage = tsCLR + Align = alClient + TabOrder = 1 + OnChange = PCChange + object tsCLR: TTabSheet + Caption = 'CLR' + inline frmCLR: TfrmCLR + Left = 0 + Top = 0 + Width = 680 + Height = 387 + Align = alClient + TabOrder = 0 + inherited PC: TPageControl + Width = 680 + Height = 298 + inherited tsStrongNameSign: TTabSheet + inherited memStrongNameSign: TMemo + Width = 672 + Height = 270 + end + end + end + inherited pnlTop: TPanel + Width = 680 + end + end + end + object tsMetadata: TTabSheet + Caption = 'Metadata' + ImageIndex = 1 + inline frmMetadata: TfrmMetadata + Left = 0 + Top = 0 + Width = 680 + Height = 387 + Align = alClient + TabOrder = 0 + inherited pnlVer: TPanel + Width = 680 + end + inherited lstStream: TListView + Width = 680 + Height = 355 + PopupMenu = popMetadataStream + OnDblClick = frmMetadatalstStreamDblClick + end + end + end + end + object lstActions: TActionList + Left = 24 + Top = 144 + object actFileExit: TAction + Category = 'File' + Caption = 'E&xit' + ShortCut = 32883 + OnExecute = actFileExitExecute + end + object actFileOpen: TAction + Category = 'File' + Caption = '&Open' + ShortCut = 16463 + OnExecute = actFileOpenExecute + end + object actHelpAbout: TAction + Category = 'Help' + Caption = '&About' + ShortCut = 112 + OnExecute = actHelpAboutExecute + end + object actViewStreamData: TAction + Category = 'View' + Caption = 'Stream &Data' + OnExecute = actViewStreamDataExecute + OnUpdate = actViewStreamDataUpdate + end + object actFileDump: TAction + Category = 'File' + Caption = 'Dump IL...' + ShortCut = 16452 + OnExecute = actFileDumpExecute + OnUpdate = actFileDumpUpdate + end + end + object mnuMain: TMainMenu + Left = 88 + Top = 144 + object mnuFile: TMenuItem + Caption = '&File' + object mnuFileOpen: TMenuItem + Action = actFileOpen + end + object mnuFileDump: TMenuItem + Action = actFileDump + end + object mnuFileLine0: TMenuItem + Caption = '-' + end + object mnuFileExit: TMenuItem + Action = actFileExit + end + end + object mnuView: TMenuItem + Caption = '&View' + object mnuViewStreamData: TMenuItem + Action = actViewStreamData + end + end + object mnuHelp: TMenuItem + Caption = '&Help' + object mnuFileAbout: TMenuItem + Action = actHelpAbout + end + end + end + object dlgOpen: TOpenDialog + Filter = 'Executable Files (*.exe;*.dll)|*.exe;*.dll|All Files (*.*)|*.*' + Title = 'Select a file to browse' + Left = 152 + Top = 144 + end + object popMetadataStream: TPopupMenu + Left = 236 + Top = 144 + object popViewStreamData: TMenuItem + Action = actViewStreamData + end + end + object dlgSave: TSaveDialog + DefaultExt = '.il' + Filter = + 'IL Source Files (*.il)|*.il|Text Files (*.txt)|*.txt|All Files (' + + '*.*)|*.*' + Options = [ofHideReadOnly, ofPathMustExist, ofEnableSizing] + Title = 'Dump Metadata to IL Source File' + Left = 320 + Top = 144 + end +end diff --git a/official/1.96/examples/windows/clr/ClrDemoMain.pas b/official/1.96/examples/windows/clr/ClrDemoMain.pas new file mode 100644 index 0000000..a0687c3 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoMain.pas @@ -0,0 +1,195 @@ +unit ClrDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ActnList, Menus, ComCtrls, ClrDemoAbstractFrame, + JclPeImage, JclCLR, ClrDemoMetaDataFrame, ClrDemoCLRFrame; + +type + TfrmMain = class(TForm) + lstActions: TActionList; + actFileExit: TAction; + actFileOpen: TAction; + actHelpAbout: TAction; + mnuMain: TMainMenu; + mnuFile: TMenuItem; + mnuFileOpen: TMenuItem; + mnuFileLine0: TMenuItem; + mnuFileExit: TMenuItem; + mnuHelp: TMenuItem; + mnuFileAbout: TMenuItem; + dlgOpen: TOpenDialog; + barStatus: TStatusBar; + PC: TPageControl; + tsMetadata: TTabSheet; + frmMetadata: TfrmMetadata; + popMetadataStream: TPopupMenu; + actViewStreamData: TAction; + popViewStreamData: TMenuItem; + mnuView: TMenuItem; + mnuViewStreamData: TMenuItem; + tsCLR: TTabSheet; + frmCLR: TfrmCLR; + actFileDump: TAction; + dlgSave: TSaveDialog; + mnuFileDump: TMenuItem; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure actFileExitExecute(Sender: TObject); + procedure actHelpAboutExecute(Sender: TObject); + procedure actFileOpenExecute(Sender: TObject); + procedure PCChange(Sender: TObject); + procedure actViewStreamDataUpdate(Sender: TObject); + procedure actViewStreamDataExecute(Sender: TObject); + procedure frmMetadatalstStreamDblClick(Sender: TObject); + procedure actFileDumpExecute(Sender: TObject); + procedure actFileDumpUpdate(Sender: TObject); + private + m_Image: TJclPeImage; + m_CLR: TJclCLRHeaderEx; + + function GetActiveFrame: TfrmAbstract; + public + { Public declarations } + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.DFM} + +uses + ShellApi, ClrDemoStringsForm, ClrDemoGuidForm, ClrDemoBlobForm, + ClrDemoTableForm, ClrDemoUserStringsForm; + +const + CRLF = #10#13; + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + m_Image := nil; + m_CLR := nil; +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + FreeAndNil(m_CLR); + FreeAndNil(m_Image); +end; + +function TfrmMain.GetActiveFrame: TfrmAbstract; +var + I: Integer; +begin + if Assigned(PC.ActivePage) then + with PC.ActivePage do + for I:=0 to ControlCount-1 do + if Controls[0].InheritsFrom(TfrmAbstract) then + begin + Result := TfrmAbstract(Controls[0]); + Exit; + end; + + raise Exception.Create('No frame was active!'); +end; + +procedure TfrmMain.actFileExitExecute(Sender: TObject); +begin + Close; +end; + +procedure TfrmMain.actHelpAboutExecute(Sender: TObject); +begin + ShellAbout(Handle, PChar(Caption), + PChar('JEDI Code Library (JCL)' + CRLF + 'http://delphi-jedi.org/'), + Application.Icon.Handle); +end; + +procedure TfrmMain.actFileOpenExecute(Sender: TObject); +var + Img: TJclPeImage; +begin + if dlgOpen.Execute then + begin + Img := TJclPeImage.Create; + Img.FileName := dlgOpen.FileName; + + if Img.IsCLR then + begin + FreeAndNil(m_Image); + m_Image := Img; + + FreeAndNil(m_CLR); + m_CLR := TJclCLRHeaderEx.Create(m_Image); + GetActiveFrame.ShowInfo(m_CLR); + end + else + begin + FreeAndNil(Img); + MessageDlg(Format('The file %s is not a CLR file', [dlgOpen.FileName]), mtWarning, [mbOK], 0); + end; + end; +end; + +procedure TfrmMain.PCChange(Sender: TObject); +begin + if Assigned(m_CLR) then + GetActiveFrame.ShowInfo(m_CLR); +end; + +procedure TfrmMain.actViewStreamDataUpdate(Sender: TObject); +begin + with frmMetadata.lstStream do + TAction(Sender).Enabled := Assigned(Selected) and + ((TObject(Selected.Data).ClassType = TJclCLRStringsStream) or + (TObject(Selected.Data).ClassType = TJclCLRGuidStream) or + (TObject(Selected.Data).ClassType = TJclCLRUserStringStream) or + (TObject(Selected.Data).ClassType = TJclCLRBlobStream) or + (TObject(Selected.Data).ClassType = TJclCLRTableStream)); +end; + +procedure TfrmMain.actViewStreamDataExecute(Sender: TObject); +begin + with frmMetadata.lstStream do + if TObject(Selected.Data).ClassType = TJclCLRStringsStream then + TfrmStrings.Execute(Selected.Data) + else if TObject(Selected.Data).ClassType = TJclCLRGuidStream then + TfrmGuid.Execute(Selected.Data) + else if TObject(Selected.Data).ClassType = TJclCLRUserStringStream then + TfrmUserStrings.Execute(Selected.Data) + else if TObject(Selected.Data).ClassType = TJclCLRBlobStream then + TfrmBlobs.Execute(Selected.Data) + else if TObject(Selected.Data).ClassType = TJclCLRTableStream then + TfrmTable.Execute(Selected.Data); +end; + +procedure TfrmMain.frmMetadatalstStreamDblClick(Sender: TObject); +begin + if actViewStreamData.Enabled then + actViewStreamDataExecute(Sender); +end; + +procedure TfrmMain.actFileDumpExecute(Sender: TObject); +begin + dlgSave.InitialDir := ExtractFilePath(m_Image.FileName); + dlgSave.FileName := ExtractFileName(ChangeFileExt(m_Image.FileName, '.il')); + if dlgSave.Execute then + with TStringList.Create do + try + Text := m_CLR.DumpIL; + SaveToFile(dlgSave.FileName); + finally + Free; + end; +end; + +procedure TfrmMain.actFileDumpUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(m_CLR); +end; + +end. diff --git a/official/1.96/examples/windows/clr/ClrDemoMetaDataFrame.dfm b/official/1.96/examples/windows/clr/ClrDemoMetaDataFrame.dfm new file mode 100644 index 0000000..da945dc --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoMetaDataFrame.dfm @@ -0,0 +1,70 @@ +inherited frmMetadata: TfrmMetadata + Width = 374 + Height = 276 + object pnlVer: TPanel + Left = 0 + Top = 0 + Width = 374 + Height = 32 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + object lblVer: TLabel + Left = 8 + Top = 8 + Width = 38 + Height = 13 + Caption = 'Version:' + end + object lblVerStr: TLabel + Left = 160 + Top = 8 + Width = 68 + Height = 13 + Caption = 'Version String:' + end + object edtVer: TEdit + Left = 56 + Top = 4 + Width = 89 + Height = 21 + Color = clInactiveBorder + ReadOnly = True + TabOrder = 0 + end + object edtVerStr: TEdit + Left = 240 + Top = 4 + Width = 89 + Height = 21 + Color = clInactiveBorder + ReadOnly = True + TabOrder = 1 + end + end + object lstStream: TListView + Left = 0 + Top = 32 + Width = 374 + Height = 244 + Align = alClient + Columns = < + item + AutoSize = True + Caption = 'Name' + end + item + AutoSize = True + Caption = 'Offset' + end + item + AutoSize = True + Caption = 'Size' + end> + GridLines = True + ReadOnly = True + RowSelect = True + TabOrder = 1 + ViewStyle = vsReport + end +end diff --git a/official/1.96/examples/windows/clr/ClrDemoMetaDataFrame.pas b/official/1.96/examples/windows/clr/ClrDemoMetaDataFrame.pas new file mode 100644 index 0000000..e1e4264 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoMetaDataFrame.pas @@ -0,0 +1,56 @@ +unit ClrDemoMetaDataFrame; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ClrDemoAbstractFrame, JclCLR, StdCtrls, ComCtrls, ExtCtrls, Menus; + +type + TfrmMetadata = class(TfrmAbstract) + pnlVer: TPanel; + lblVer: TLabel; + edtVer: TEdit; + edtVerStr: TEdit; + lblVerStr: TLabel; + lstStream: TListView; + private + { Private declarations } + public + procedure ShowInfo(const ACLR: TJclCLRHeaderEx); override; + end; + +var + frmMetadata: TfrmMetadata; + +implementation + +{$R *.DFM} + +{ TfrmMetadata } + +procedure TfrmMetadata.ShowInfo(const ACLR: TJclCLRHeaderEx); +var + I: Integer; +begin + with ACLR.Metadata do + begin + edtVer.Text := Version; + edtVerStr.Text := VersionString; + + with lstStream.Items do + begin + Clear; + for I:=0 to StreamCount-1 do + with Add do + begin + Caption := Streams[I].Name; + Data := Streams[I]; + SubItems.Add('$' + IntToHex(Streams[I].Offset, 8)); + SubItems.Add(IntToStr(Streams[I].Size)); + end; + end; + end; +end; + +end. diff --git a/official/1.96/examples/windows/clr/ClrDemoStringsForm.dfm b/official/1.96/examples/windows/clr/ClrDemoStringsForm.dfm new file mode 100644 index 0000000..6803682 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoStringsForm.dfm @@ -0,0 +1,52 @@ +object frmStrings: TfrmStrings + Left = 291 + Top = 205 + BorderStyle = bsDialog + Caption = 'Strings Stream' + ClientHeight = 273 + ClientWidth = 392 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poMainFormCenter + PixelsPerInch = 96 + TextHeight = 13 + object lstStrings: TListView + Left = 8 + Top = 8 + Width = 377 + Height = 225 + Columns = < + item + Caption = 'Index' + Width = 40 + end + item + Caption = 'Offset' + Width = 64 + end + item + Caption = 'String' + Width = 315 + end> + GridLines = True + OwnerData = True + ReadOnly = True + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + OnData = lstStringsData + end + object btnOK: TBitBtn + Left = 158 + Top = 240 + Width = 75 + Height = 25 + TabOrder = 1 + Kind = bkOK + end +end diff --git a/official/1.96/examples/windows/clr/ClrDemoStringsForm.pas b/official/1.96/examples/windows/clr/ClrDemoStringsForm.pas new file mode 100644 index 0000000..a9364bf --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoStringsForm.pas @@ -0,0 +1,54 @@ +unit ClrDemoStringsForm; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Buttons, ComCtrls, JclCLR; + +type + TfrmStrings = class(TForm) + lstStrings: TListView; + btnOK: TBitBtn; + procedure lstStringsData(Sender: TObject; Item: TListItem); + private + FStream: TJclCLRStringsStream; + procedure ShowStrings(const AStream: TJclCLRStringsStream); + public + class procedure Execute(const AStream: TJclCLRStringsStream); + end; + +implementation + +{$R *.DFM} + +uses + JclUnicode; + +{ TfrmStrings } + +class procedure TfrmStrings.Execute(const AStream: TJclCLRStringsStream); +begin + with TfrmStrings.Create(nil) do + try + ShowStrings(AStream); + ShowModal; + finally + Free; + end; +end; + +procedure TfrmStrings.ShowStrings(const AStream: TJclCLRStringsStream); +begin + FStream := AStream; + lstStrings.Items.Count := FStream.StringCount; +end; + +procedure TfrmStrings.lstStringsData(Sender: TObject; Item: TListItem); +begin + Item.Caption := IntToStr(Item.Index); + Item.SubItems.Add(IntToHex(FStream.Offsets[Item.Index], 8)); + Item.SubItems.Add(FStream.Strings[Item.Index]); +end; + +end. diff --git a/official/1.96/examples/windows/clr/ClrDemoTableForm.dfm b/official/1.96/examples/windows/clr/ClrDemoTableForm.dfm new file mode 100644 index 0000000..1106400 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoTableForm.dfm @@ -0,0 +1,102 @@ +object frmTable: TfrmTable + Left = 384 + Top = 245 + BorderStyle = bsDialog + Caption = 'Table Stream' + ClientHeight = 453 + ClientWidth = 632 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poMainFormCenter + PixelsPerInch = 96 + TextHeight = 13 + object lblVer: TLabel + Left = 8 + Top = 8 + Width = 119 + Height = 13 + Caption = 'Table Schemata Version:' + end + object edtVer: TEdit + Left = 136 + Top = 4 + Width = 57 + Height = 21 + Color = clInactiveBorder + ReadOnly = True + TabOrder = 0 + end + object btnOK: TBitBtn + Left = 278 + Top = 424 + Width = 75 + Height = 25 + TabOrder = 1 + Kind = bkOK + end + object lstTables: TListView + Left = 8 + Top = 32 + Width = 617 + Height = 193 + Columns = < + item + Caption = 'Index' + Width = 40 + end + item + Alignment = taCenter + Caption = 'Rows' + Width = 40 + end + item + Alignment = taCenter + Caption = 'Offset' + Width = 76 + end + item + Caption = 'Size' + Width = 40 + end + item + Caption = 'Type' + Width = 200 + end> + GridLines = True + ReadOnly = True + RowSelect = True + TabOrder = 2 + ViewStyle = vsReport + OnSelectItem = lstTablesSelectItem + end + object memDump: TMemo + Left = 8 + Top = 232 + Width = 617 + Height = 185 + Color = clInactiveBorder + Font.Charset = GB2312_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Fixedsys' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 3 + end + object btnDumpIL: TButton + Left = 200 + Top = 4 + Width = 75 + Height = 25 + Caption = 'Dump IL' + TabOrder = 4 + OnClick = btnDumpILClick + end +end diff --git a/official/1.96/examples/windows/clr/ClrDemoTableForm.pas b/official/1.96/examples/windows/clr/ClrDemoTableForm.pas new file mode 100644 index 0000000..64cdc5d --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoTableForm.pas @@ -0,0 +1,598 @@ +unit ClrDemoTableForm; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Buttons, ComCtrls, JclClr, JclMetadata; + +type + TDumpLineKind = (lkWide, lkThin, lkEmpty); + + TfrmTable = class(TForm) + lblVer: TLabel; + edtVer: TEdit; + btnOK: TBitBtn; + lstTables: TListView; + memDump: TMemo; + btnDumpIL: TButton; + procedure lstTablesSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure btnDumpILClick(Sender: TObject); + private + FStream: TJclClrTableStream; + + procedure Dump(const Msg: string); overload; + procedure Dump(const FmtMsg: string; const Args: array of const); overload; + procedure Dump(const Msg: string; const Blob: TJclClrBlobRecord); overload; + procedure Dump(const LineKind: TDumpLineKind); overload; + procedure ShowTables(const AStream: TJclClrTableStream); + procedure DumpTable(const ATable: TJclClrTableAssembly); overload; + procedure DumpTable(const ATable: TJclClrTableAssemblyRef); overload; + procedure DumpTable(const ATable: TJclClrTableAssemblyOS); overload; + procedure DumpTable(const ATable: TJclClrTableAssemblyProcessor); overload; + procedure DumpTable(const ATable: TJclClrTableModule); overload; + procedure DumpTable(const ATable: TJclClrTableModuleRef); overload; + procedure DumpTable(const ATable: TJclClrTableFieldDef); overload; + procedure DumpTable(const ATable: TJclClrTableMemberRef); overload; + procedure DumpTable(const ATable: TJclClrTableCustomAttribute); overload; + procedure DumpTable(const ATable: TJclClrTableMethodDef); overload; + procedure DumpTable(const ATable: TJclClrTableTypeDef); overload; + procedure DumpTable(const ATable: TJclClrTableTypeRef); overload; + procedure DumpTable(const ATable: TJclClrTablePropertyDef); overload; + procedure DumpTable(const ATable: TJclClrTableManifestResource); overload; + procedure DumpTable(const ATable: TJclClrTableFile); overload; + procedure DumpTable(const ATable: TJclClrTableParamDef); overload; + procedure DumpTable(const ATable: TJclClrTableExportedType); overload; + public + class procedure Execute(const AStream: TJclClrTableStream); + end; + +implementation + +{$R *.DFM} + +{$DEFINE USE_JWA} + +uses + ComObj, TypInfo, ClrDemoAbstractFrame, +{$IFDEF USE_JWA} + JwaWinCrypt, JwaWinNT, +{$ENDIF} + JclStrings, ClrDemoMain; + +{ TfrmTable } + +class procedure TfrmTable.Execute(const AStream: TJclClrTableStream); +begin + with TfrmTable.Create(nil) do + try + ShowTables(AStream); + ShowModal; + finally + Free; + end; +end; + +procedure TfrmTable.Dump(const Msg: string); +begin + memDump.Lines.Add(Msg); +end; + +procedure TfrmTable.Dump(const FmtMsg: string; const Args: array of const); +begin + Dump(Format(FmtMsg, Args)); +end; + +procedure TfrmTable.Dump(const Msg: string; const Blob: TJclClrBlobRecord); +begin + Dump(Msg); + TfrmAbstract.DumpBuf(Blob, memDump); +end; + +procedure TfrmTable.Dump(const LineKind: TDumpLineKind); +begin + case LineKind of + lkWide: Dump('========================================'); + lkThin: Dump('----------------------------------------'); + lkEmpty: Dump(''); + end; +end; + +procedure TfrmTable.ShowTables(const AStream: TJclClrTableStream); +var + AKind: TJclClrTableKind; +begin + FStream := AStream; + edtVer.Text := AStream.VersionString; + with lstTables.Items do + begin + BeginUpdate; + try + Clear; + for AKind:=Low(TJclClrTableKind) to High(TJclClrTableKind) do + if Assigned(AStream.Tables[AKind]) then + with AStream.Tables[AKind], Add do + begin + Caption := IntToStr(Count); + Data := AStream.Tables[AKind]; + SubItems.Add(IntToStr(RowCount)); + SubItems.Add('$' + IntToHex(Offset, 8)); + SubItems.Add(IntToStr(Size)); + SubItems.Add(Copy(AStream.Tables[AKind].ClassName, StrLen('TJclClrTable')+1, MaxWord)); + end; + finally + EndUpdate; + end; + end; +end; + +procedure TfrmTable.lstTablesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); +var + ATable: TJclClrTable; +begin + if Selected then + begin + ATable := TJclClrTable(Item.Data); + memDump.Clear; + + if ATable.ClassType = TJclClrTableAssembly then + DumpTable(TJclClrTableAssembly(ATable)) + else if ATable.ClassType = TJclClrTableAssemblyRef then + DumpTable(TJclClrTableAssemblyRef(ATable)) + else if ATable.ClassType = TJclClrTableAssemblyOS then + DumpTable(TJclClrTableAssemblyOS(ATable)) + else if ATable.ClassType = TJclClrTableAssemblyProcessor then + DumpTable(TJclClrTableAssemblyProcessor(ATable)) + else if ATable.ClassType = TJclClrTableModule then + DumpTable(TJclClrTableModule(ATable)) + else if ATable.ClassType = TJclClrTableModuleRef then + DumpTable(TJclClrTableModuleRef(ATable)) + else if ATable.ClassType = TJclClrTableTypeDef then + DumpTable(TJclClrTableTypeDef(ATable)) + else if ATable.ClassType = TJclClrTableTypeRef then + DumpTable(TJclClrTableTypeRef(ATable)) + else if ATable.ClassType = TJclClrTableMethodDef then + DumpTable(TJclClrTableMethodDef(ATable)) + else if ATable.ClassType = TJclClrTableFieldDef then + DumpTable(TJclClrTableFieldDef(ATable)) + else if ATable.ClassType = TJclClrTableMemberRef then + DumpTable(TJclClrTableMemberRef(ATable)) + else if ATable.ClassType = TJclClrTableCustomAttribute then + DumpTable(TJclClrTableCustomAttribute(ATable)) + else if ATable.ClassType = TJclClrTableParamDef then + DumpTable(TJclClrTableParamDef(ATable)) + else if ATable.ClassType = TJclClrTablePropertyDef then + DumpTable(TJclClrTablePropertyDef(ATable)) + else if ATable.ClassType = TJclClrTableFile then + DumpTable(TJclClrTableFile(ATable)) + else if ATable.ClassType = TJclClrTableManifestResource then + DumpTable(TJclClrTableManifestResource(ATable)) + else if ATable.ClassType = TJclClrTableExportedType then + DumpTable(TJclClrTableExportedType(ATable)); + + memDump.Perform(WM_VSCROLL, SB_TOP, 0); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableAssembly); + function GetHashAlgName(const HashAlgId: DWORD): string; + begin + {$IFDEF USE_JWA} + case HashAlgId of + CALG_MD2: Result := 'MD2'; + CALG_MD4: Result := 'MD4'; + CALG_MD5: Result := 'MD5'; + CALG_SHA1: Result := 'SHA1'; + CALG_MAC: Result := 'MAC'; + else + Result := IntToHex(HashAlgId, 8); + end; + {$ELSE} + Result := IntToHex(HashAlgId, 8); + {$ENDIF} + end; +var + AFlag: TJclClrAssemblyFlag; + FlagMsg: string; +begin + Assert(ATable.RowCount = 1); + with ATable[0] do + begin + Dump('Name: ' + Name); + Dump('Version: ' + Version); + FlagMsg := 'Flag: '; + for AFlag := Low(TJclClrAssemblyFlag) to High(TJclClrAssemblyFlag) do + if AFlag in Flags then + FlagMsg := FlagMsg + + GetEnumName(TypeInfo(TJclClrAssemblyFlag), Integer(AFlag)) + ' '; + Dump(FlagMsg); + if CultureOffset <> 0 then + Dump('Culture: ' + Culture); + Dump('Hash Algorithm: ' + GetHashAlgName(HashAlgId)); + if Assigned(PublicKey) then + Dump('Public Key: ', PublicKey); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableAssemblyRef); +var + I: Integer; + AFlag: TJclClrAssemblyFlag; + FlagMsg: string; + Assembly: TJclClrTableAssemblyRefRow; +begin + for I:=0 to ATable.RowCount-1 do + begin + Assembly := ATable[I]; + Dump('Name: ' + Assembly.Name); + Dump('Version: ' + Assembly.Version); + FlagMsg := 'Flag: '; + for AFlag := Low(TJclClrAssemblyFlag) to High(TJclClrAssemblyFlag) do + if AFlag in Assembly.Flags then + FlagMsg := FlagMsg + + GetEnumName(TypeInfo(TJclClrAssemblyFlag), Integer(AFlag)) + ' '; + Dump(FlagMsg); + if Assembly.CultureOffset <> 0 then + Dump('Culture: ' + Assembly.Culture); + if Assigned(Assembly.PublicKeyOrToken) then + Dump('Public Key or Token: ', Assembly.PublicKeyOrToken); + if Assigned(Assembly.HashValue) then + Dump('Hash Value: ', Assembly.HashValue); + Dump(lkWide); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableAssemblyOS); + function GetOSName(const PlatformID: DWORD): string; + begin + case PlatformID of + VER_PLATFORM_WIN32s: Result := 'Win32s'; + VER_PLATFORM_WIN32_WINDOWS: Result := 'Windows'; + VER_PLATFORM_WIN32_NT: Result := 'WinNT'; + else + Result := IntToHex(PlatformID, 8); + end; + end; +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + begin + Dump('OS : ' + GetOSName(ATable[I].PlatformID)); + Dump('Version: ' + ATable[I].Version); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableAssemblyProcessor); + function GetProcessName(const Processor: DWORD): string; + begin + {$IFDEF USE_JWA} + case Processor of + PROCESSOR_INTEL_386: Result := 'Intel 386'; + PROCESSOR_INTEL_486: Result := 'Intel 486'; + PROCESSOR_INTEL_PENTIUM: Result := 'Intel Pentium'; + PROCESSOR_INTEL_IA64: Result := 'Intel IA64'; + PROCESSOR_MIPS_R4000: Result := 'MIPS R4000'; + PROCESSOR_ALPHA_21064: Result := 'Alpha 21064'; + PROCESSOR_PPC_601: Result := 'Power PC 601'; + PROCESSOR_PPC_603: Result := 'Power PC 603'; + PROCESSOR_PPC_604: Result := 'Power PC 604'; + PROCESSOR_PPC_620: Result := 'Power PC 620'; + PROCESSOR_OPTIL: Result := 'MS IL'; + else + Result := IntToStr(Processor) + ' [' + IntToHex(Processor, 8) + ']'; + end; + {$ELSE} + Result := IntToStr(Processor) + ' [' + IntToHex(Processor, 8) + ']'; + {$ENDIF} + end; +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + begin + Dump('Processor : ' + GetProcessName(ATable[I].Processor)); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableModule); +begin + Assert(ATable.RowCount = 1); + with ATable[0] do + begin + Dump('Name : %s', [Name]); + Dump('Mvid : %s', [GUIDToString(Mvid)]); + if HasEncId then + Dump('EncId : %s', [GUIDToString(EncId)]); + if HasEncBaseId then + Dump('EncBaseId: %s', [GUIDToString(EncBaseId)]); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableModuleRef); +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + Dump('Name : ' + ATable[I].Name); +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableTypeDef); +const + ClassSemanticsNames: array[TJclClrClassSemantics] of string = + ('.class', 'interface'); + TypeVisibilityNames: array[TJclClrTypeVisibility] of string = + ('private', 'public', 'nested public', 'nested private', 'nested family', + 'nested assembly', 'nested famandassem', 'nested famorassem'); + AbstractNames: array[Boolean] of string = ('', 'abstract '); + ClassLayoutNames: array[TJclClrClassLayout] of string = + ('auto', 'sequential', 'explicit'); + StringFormattingNames: array[TJclClrStringFormatting] of string = + ('ansi', 'unicode', 'autochar'); + ImportNames: array[Boolean] of string = ('', 'import '); + SerializableNames: array[Boolean] of string = ('', 'serializable'); + SealedNames: array[Boolean] of string = ('', 'sealed '); + SpecialNameNames: array[Boolean] of string = ('', 'specialname '); + BeforeFieldInitNames: array[Boolean] of string = ('', 'beforefieldinit '); + RTSpecialNameNames: array[Boolean] of string = ('', 'rtspecialname '); + HasSecurityNames: array[Boolean] of string = ('', 'HasSecurity '); +var + I, J: Integer; +begin + for I:=0 to ATable.RowCount-1 do + with ATable.Rows[I] do + begin + Dump('%s %s %s%s %s %s%s%s%s%s%s%s%s', + [ClassSemanticsNames[ClassSemantics], + TypeVisibilityNames[Visibility], + AbstractNames[taAbstract in Attributes], + ClassLayoutNames[ClassLayout], + StringFormattingNames[StringFormatting], + ImportNames[taImport in Attributes], + SerializableNames[taSerializable in Attributes], + SealedNames[taSealed in Attributes], + SpecialNameNames[taSpecialName in Attributes], + BeforeFieldInitNames[taBeforeFieldInit in Attributes], + RTSpecialNameNames[taRTSpecialName in Attributes], + HasSecurityNames[taHasSecurity in Attributes], + FullName]); + + if HasField then + for J:=0 to FieldCount-1 do + Dump(' .field %s', [Fields[J].Name]); + + if HasMethod then + for J:=0 to MethodCount-1 do + Dump(' .method %s', [Methods[J].Name]); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableTypeRef); +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + Dump('%s.%s', [ATable.Rows[I].Namespace, ATable.Rows[I].Name]) +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableMethodDef); +var + I, J: Integer; + AttrStr, ParamStr: string; +begin + for I:=0 to ATable.RowCount-1 do + with ATable.Rows[I] do + begin + if HasParam then + begin + ParamStr := ''; + for J:=0 to ParamCount-1 do + begin + if ParamStr <> '' then + ParamStr := ParamStr + ', '; + if Params[J].Flags <> [] then + begin + AttrStr := ''; + if pkIn in Params[J].Flags then + AttrStr := AttrStr + 'In'; + if pkOut in Params[J].Flags then + begin + if AttrStr <> '' then + AttrStr := AttrStr + ', '; + AttrStr := AttrStr + 'Out'; + end; + if pkOptional in Params[J].Flags then + begin + if AttrStr <> '' then + AttrStr := AttrStr + ', '; + AttrStr := AttrStr + 'Opt'; + end; + if pkHasDefault in Params[J].Flags then + begin + if AttrStr <> '' then + AttrStr := AttrStr + ', '; + AttrStr := AttrStr + 'Default'; + end; + if pkHasFieldMarshal in Params[J].Flags then + begin + if AttrStr <> '' then + AttrStr := AttrStr + ', '; + AttrStr := AttrStr + 'Marshal'; + end; + ParamStr := ParamStr + '[' + AttrStr + '] '; + end; + ParamStr := ParamStr + Params[J].Name; + end; + end; + if Assigned(MethodBody) then + begin + Dump('%s.%s::%s(%s) @ %p:%d', [ParentToken.Namespace, ParentToken.Name, Name, ParamStr, Pointer(RVA), MethodBody.Size]); + TfrmAbstract.DumpBuf(MethodBody.Code, MethodBody.Size, memDump, DWORD(MethodBody.Code), False); + end + else + begin + Dump('%s.%s::%s(%s)', [ParentToken.Namespace, ParentToken.Name, Name, ParamStr]); + end; + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableFieldDef); +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + Dump('%s', [ATable.Rows[I].Name]) +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableMemberRef); +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + Dump('%s', [ATable.Rows[I].Name]) +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableCustomAttribute); + function GetParent(const Attr: TJclClrTableCustomAttributeRow): string; + var + ARow: TJclClrTableRow; + begin + ARow := Attr.Parent; + if ARow is TJclClrTableAssemblyRow then + with ARow as TJclClrTableAssemblyRow do + Result := Name + else if ARow is TJclClrTableTypeDefRow then + with ARow as TJclClrTableTypeDefRow do + Result := Namespace + '.' + Name + else if ARow is TJclClrTableTypeRefRow then + with ARow as TJclClrTableTypeRefRow do + Result := Namespace + '.' + Name + else if ARow is TJclClrTableMethodDefRow then + with ARow as TJclClrTableMethodDefRow do + Result := Name + else if ARow is TJclClrTableParamDefRow then + with ARow as TJclClrTableParamDefRow do + Result := Method.ParentToken.Namespace + '.' + Method.ParentToken.Name + '::' + + Method.Name + '(..., ' + Name + ', ...)' + else + Result := 'Unknown Parent'; + + Result := Result + ' <' + Copy(ARow.ClassName, Length('TJclClrTable')+1, + Length(ARow.ClassName)-Length('TJclClrTable')-Length('Row')) + + '> [' + IntToHex(Attr.ParentIdx, 8) + ']'; + end; + function GetMethod(const Attr: TJclClrTableCustomAttributeRow): string; + function GetParentClassName(const ParentClass: TJclClrTableRow): string; + begin + if ParentClass is TJclClrTableTypeRefRow then + with ParentClass as TJclClrTableTypeRefRow do + Result := Namespace + '.' + Name + else if ParentClass is TJclClrTableModuleRefRow then + with ParentClass as TJclClrTableModuleRefRow do + Result := Name + else if ParentClass is TJclClrTableMethodDefRow then + with ParentClass as TJclClrTableMethodDefRow do + Result := Name + else if ParentClass is TJclClrTableTypeSpecRow then + Result := '' + else if ParentClass is TJclClrTableTypeDefRow then + with ParentClass as TJclClrTableTypeDefRow do + Result := Namespace + '.' + Name + else + Result := 'Unknown Class - ' + ParentClass.ClassName; + end; + var + AMethod: TJclClrTableRow; + begin + AMethod := Attr.Method; + if AMethod is TJclClrTableMethodDefRow then + with AMethod as TJclClrTableMethodDefRow do + Result := ParentToken.Namespace + '.' + ParentToken.Name + ' :: ' + Name + else if AMethod is TJclClrTableMemberRefRow then + with AMethod as TJclClrTableMemberRefRow do + Result := GetParentClassName(ParentClass) + '::' + Name + else + Result := 'Unknown method type - ' + IntToHex(Attr.ParentIdx, 8); + + Result := Result + ' <' + Copy(AMethod.ClassName, Length('TJclClrTable')+1, + Length(AMethod.ClassName)-Length('TJclClrTable')-Length('Row')) + + '> [' + IntToHex(Attr.TypeIdx, 8) + ']'; + end; +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + begin + Dump('Parent: ' + GetParent(ATable[I])); + Dump('Method: ' + GetMethod(ATable[I])); + Dump('Value: ', ATable[I].Value); + Dump(lkWide); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableParamDef); +var + I: Integer; + Attr: string; +begin + for I:=0 to ATable.RowCount-1 do + begin + Attr := ''; + if pkIn in ATable.Rows[I].Flags then + Attr := Attr + 'In '; + if pkOut in ATable.Rows[I].Flags then + Attr := Attr + 'Out '; + if pkOptional in ATable.Rows[I].Flags then + Attr := Attr + 'Opt '; + if pkHasDefault in ATable.Rows[I].Flags then + Attr := Attr + 'Default '; + if pkHasFieldMarshal in ATable.Rows[I].Flags then + Attr := Attr + 'Marshal '; + + Dump('%s %s', [ATable.Rows[I].Name, Attr]); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTablePropertyDef); +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + Dump('%s', [ATable.Rows[I].Name]) +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableManifestResource); +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + Dump('%s', [ATable.Rows[I].Name]) +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableFile); +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + begin + Dump('File Name: ' + ATable[I].Name); + Dump('Contains Metadata: ' + BooleanToStr(ATable[I].ContainsMetadata)); + Dump('Hash Value: ', ATable[I].HashValue); + end; +end; + +procedure TfrmTable.DumpTable(const ATable: TJclClrTableExportedType); +var + I: Integer; +begin + for I:=0 to ATable.RowCount-1 do + Dump(ATable[I].TypeNamespace + '.' + ATable[I].TypeName); +end; + +procedure TfrmTable.btnDumpILClick(Sender: TObject); +begin + frmMain.actFileDump.Execute; +end; + +end. diff --git a/official/1.96/examples/windows/clr/ClrDemoUserStringsForm.dfm b/official/1.96/examples/windows/clr/ClrDemoUserStringsForm.dfm new file mode 100644 index 0000000..9630d9b --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoUserStringsForm.dfm @@ -0,0 +1,52 @@ +object frmUserStrings: TfrmUserStrings + Left = 299 + Top = 296 + BorderStyle = bsDialog + Caption = 'User String Stream' + ClientHeight = 273 + ClientWidth = 392 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = True + Position = poMainFormCenter + PixelsPerInch = 96 + TextHeight = 13 + object lstStrings: TListView + Left = 8 + Top = 8 + Width = 377 + Height = 225 + Columns = < + item + Caption = 'Index' + Width = 40 + end + item + Caption = 'Offset' + Width = 64 + end + item + Caption = 'String' + Width = 315 + end> + GridLines = True + OwnerData = True + ReadOnly = True + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + OnData = lstStringsData + end + object btnOK: TBitBtn + Left = 158 + Top = 240 + Width = 75 + Height = 25 + TabOrder = 1 + Kind = bkOK + end +end diff --git a/official/1.96/examples/windows/clr/ClrDemoUserStringsForm.pas b/official/1.96/examples/windows/clr/ClrDemoUserStringsForm.pas new file mode 100644 index 0000000..8bde438 --- /dev/null +++ b/official/1.96/examples/windows/clr/ClrDemoUserStringsForm.pas @@ -0,0 +1,54 @@ +unit ClrDemoUserStringsForm; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ClrDemoStringsForm, StdCtrls, Buttons, ComCtrls, JclCLR; + +type + TfrmUserStrings = class(TForm) + lstStrings: TListView; + btnOK: TBitBtn; + procedure lstStringsData(Sender: TObject; Item: TListItem); + private + FStream: TJclCLRUserStringStream; + procedure ShowStrings(const AStream: TJclCLRUserStringStream); + public + class procedure Execute(const AStream: TJclCLRUserStringStream); + end; + +var + frmUserStrings: TfrmUserStrings; + +implementation + +{$R *.DFM} + +{ TfrmUserStrings } + +class procedure TfrmUserStrings.Execute(const AStream: TJclCLRUserStringStream); +begin + with TfrmUserStrings.Create(nil) do + try + ShowStrings(AStream); + ShowModal; + finally + Free; + end; +end; + +procedure TfrmUserStrings.ShowStrings(const AStream: TJclCLRUserStringStream); +begin + FStream := AStream; + lstStrings.Items.Count := FStream.StringCount; +end; + +procedure TfrmUserStrings.lstStringsData(Sender: TObject; Item: TListItem); +begin + Item.Caption := IntToStr(Item.Index); + Item.SubItems.Add(IntToHex(FStream.Offsets[Item.Index], 8)); + Item.SubItems.Add(FStream.Strings[Item.Index]); +end; + +end. diff --git a/official/1.96/examples/windows/debug/framestrack/FramesTrackDemoMain.dfm b/official/1.96/examples/windows/debug/framestrack/FramesTrackDemoMain.dfm new file mode 100644 index 0000000..1e46d67 --- /dev/null +++ b/official/1.96/examples/windows/debug/framestrack/FramesTrackDemoMain.dfm @@ -0,0 +1,91 @@ +object Form1: TForm1 + Left = 192 + Top = 136 + Width = 790 + Height = 500 + Caption = 'Exception frame tracking example' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object mmLog: TMemo + Left = 172 + Top = 32 + Width = 610 + Height = 441 + Anchors = [akLeft, akTop, akRight, akBottom] + ScrollBars = ssBoth + TabOrder = 0 + WordWrap = False + end + object Button1: TButton + Left = 4 + Top = 32 + Width = 165 + Height = 25 + Caption = 'Assign to PChar(nil)' + TabOrder = 1 + OnClick = Button1Click + end + object Button2: TButton + Left = 4 + Top = 60 + Width = 165 + Height = 25 + Caption = 'try ... except' + TabOrder = 2 + OnClick = Button2Click + end + object Button3: TButton + Left = 4 + Top = 88 + Width = 165 + Height = 25 + Caption = 'try except on.... else' + TabOrder = 3 + OnClick = Button3Click + end + object Button4: TButton + Left = 4 + Top = 116 + Width = 165 + Height = 25 + Caption = 'try ... finally' + TabOrder = 4 + OnClick = Button4Click + end + object Button5: TButton + Left = 4 + Top = 144 + Width = 165 + Height = 25 + Caption = 'try try ... finally except' + TabOrder = 5 + OnClick = Button5Click + end + object chkShowAllFrames: TCheckBox + Left = 180 + Top = 8 + Width = 145 + Height = 17 + Caption = 'Show all exception frames' + TabOrder = 6 + end + object Button6: TButton + Left = 704 + Top = 4 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'Clear' + TabOrder = 7 + OnClick = Button6Click + end +end diff --git a/official/1.96/examples/windows/debug/framestrack/FramesTrackDemoMain.pas b/official/1.96/examples/windows/debug/framestrack/FramesTrackDemoMain.pas new file mode 100644 index 0000000..f7f4966 --- /dev/null +++ b/official/1.96/examples/windows/debug/framestrack/FramesTrackDemoMain.pas @@ -0,0 +1,186 @@ +unit FramesTrackDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls; + +type + TForm1 = class(TForm) + mmLog: TMemo; + Button1: TButton; + Button2: TButton; + Button3: TButton; + Button4: TButton; + Button5: TButton; + chkShowAllFrames: TCheckBox; + Button6: TButton; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure Button1Click(Sender: TObject); + procedure Button6Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure Button4Click(Sender: TObject); + procedure Button5Click(Sender: TObject); + private + { Private declarations } + procedure LogException(ExceptObj: TObject; ExceptAddr: Pointer; IsOS: Boolean); + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +uses + JclDebug, JclHookExcept, TypInfo; + +procedure TForm1.LogException(ExceptObj: TObject; ExceptAddr: Pointer; IsOS: Boolean); +var + TmpS: string; + ModInfo: TJclLocationInfo; + I: Integer; + ExceptionHandled: Boolean; + HandlerLocation: Pointer; + ExceptFrame: TJclExceptFrame; + +begin + TmpS := 'Exception ' + ExceptObj.ClassName; + if ExceptObj is Exception then + TmpS := TmpS + ': ' + Exception(ExceptObj).Message; + if IsOS then + TmpS := TmpS + ' (OS Exception)'; + mmLog.Lines.Add(TmpS); + ModInfo := GetLocationInfo(ExceptAddr); + mmLog.Lines.Add(Format( + ' Exception occured at $%p (Module "%s", Procedure "%s", Unit "%s", Line %d)', + [ModInfo.Address, + ModInfo.UnitName, + ModInfo.ProcedureName, + ModInfo.SourceName, + ModInfo.LineNumber])); + if stExceptFrame in JclStackTrackingOptions then + begin + mmLog.Lines.Add(' Except frame-dump:'); + I := 0; + ExceptionHandled := False; + while (chkShowAllFrames.Checked or not ExceptionHandled) and + (I < JclLastExceptFrameList.Count) do + begin + ExceptFrame := JclLastExceptFrameList.Items[I]; + ExceptionHandled := ExceptFrame.HandlerInfo(ExceptObj, HandlerLocation); + if (ExceptFrame.FrameKind = efkFinally) or + (ExceptFrame.FrameKind = efkUnknown) or + not ExceptionHandled then + HandlerLocation := ExceptFrame.CodeLocation; + ModInfo := GetLocationInfo(HandlerLocation); + TmpS := Format( + ' Frame at $%p (type: %s', + [ExceptFrame.ExcFrame, + GetEnumName(TypeInfo(TExceptFrameKind), Ord(ExceptFrame.FrameKind))]); + if ExceptionHandled then + TmpS := TmpS + ', handles exception)' + else + TmpS := TmpS + ')'; + mmLog.Lines.Add(TmpS); + if ExceptionHandled then + mmLog.Lines.Add(Format( + ' Handler at $%p', + [HandlerLocation])) + else + mmLog.Lines.Add(Format( + ' Code at $%p', + [HandlerLocation])); + mmLog.Lines.Add(Format( + ' Module "%s", Procedure "%s", Unit "%s", Line %d', + [ModInfo.UnitName, + ModInfo.ProcedureName, + ModInfo.SourceName, + ModInfo.LineNumber])); + Inc(I); + end; + end; + mmLog.Lines.Add(''); +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + JclAddExceptNotifier(Form1.LogException); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + JclRemoveExceptNotifier(Form1.LogException); +end; + +procedure TForm1.Button1Click(Sender: TObject); +begin + mmLog.Lines.Add(TButton(Sender).Caption); + PChar(nil)^ := 'a'; +end; + +procedure TForm1.Button6Click(Sender: TObject); +begin + mmLog.Lines.Clear; +end; + +procedure TForm1.Button2Click(Sender: TObject); +begin + mmLog.Lines.Add(TButton(Sender).Caption); + try + PChar(nil)^ := 'a'; + except + end; +end; + +procedure TForm1.Button3Click(Sender: TObject); +begin + mmLog.Lines.Add(TButton(Sender).Caption); + try + PChar(nil)^ := 'a'; + except + on E: EConvertError do + ShowMessage('EConvertError or descendant'); + on E: ERangeError do + ShowMessage('ERangeError or descendant'); + else + ShowMessage('Not EConvertError and not ERangeError') + end; +end; + +procedure TForm1.Button4Click(Sender: TObject); +begin + mmLog.Lines.Add(TButton(Sender).Caption); + try + PChar(nil)^ := 'a'; + finally + ShowMessage('finally!'); + end; +end; + +procedure TForm1.Button5Click(Sender: TObject); +begin + mmLog.Lines.Add(TButton(Sender).Caption); + try + try + PChar(nil)^ := 'a'; + finally + ShowMessage('Finally!'); + end; + except + ShowMessage('Except!'); + end; +end; + +initialization + + JclStackTrackingOptions := JclStackTrackingOptions + [stExceptFrame]; + JclStartExceptionTracking; + +end. diff --git a/official/1.96/examples/windows/debug/framestrack/FramesTrackExample.dof b/official/1.96/examples/windows/debug/framestrack/FramesTrackExample.dof new file mode 100644 index 0000000..e957ac9 --- /dev/null +++ b/official/1.96/examples/windows/debug/framestrack/FramesTrackExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin + diff --git a/official/1.96/examples/windows/debug/framestrack/FramesTrackExample.dpr b/official/1.96/examples/windows/debug/framestrack/FramesTrackExample.dpr new file mode 100644 index 0000000..9761204 --- /dev/null +++ b/official/1.96/examples/windows/debug/framestrack/FramesTrackExample.dpr @@ -0,0 +1,13 @@ +program FramesTrackExample; + +uses + Forms, + FramesTrackDemoMain in 'FramesTrackDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/debug/framestrack/FramesTrackExample.res b/official/1.96/examples/windows/debug/framestrack/FramesTrackExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/debug/framestrack/FramesTrackExample.res differ diff --git a/official/1.96/examples/windows/debug/sourceloc/SourceLocDemoMain.dfm b/official/1.96/examples/windows/debug/sourceloc/SourceLocDemoMain.dfm new file mode 100644 index 0000000..3496966 --- /dev/null +++ b/official/1.96/examples/windows/debug/sourceloc/SourceLocDemoMain.dfm @@ -0,0 +1,134 @@ +object Form1: TForm1 + Left = 192 + Top = 107 + Width = 646 + Height = 511 + Caption = 'JclDebug Source location example' + Color = clBtnFace + Constraints.MinHeight = 300 + Constraints.MinWidth = 600 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 16 + Top = 40 + Width = 29 + Height = 13 + Caption = 'Level:' + FocusControl = LevelSpinEdit + end + object Label2: TLabel + Left = 136 + Top = 40 + Width = 67 + Height = 13 + Caption = 'Address (hex):' + FocusControl = AddrEdit + end + object Memo1: TMemo + Left = 0 + Top = 88 + Width = 638 + Height = 396 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 0 + WordWrap = False + end + object CallerBtn: TButton + Left = 16 + Top = 8 + Width = 89 + Height = 25 + Caption = 'Caller()' + TabOrder = 1 + OnClick = CallerBtnClick + end + object LevelSpinEdit: TSpinEdit + Left = 16 + Top = 56 + Width = 89 + Height = 22 + MaxValue = 20 + MinValue = 0 + TabOrder = 2 + Value = 0 + end + object AddrBtn: TButton + Left = 136 + Top = 8 + Width = 89 + Height = 25 + Caption = 'Address lookup' + TabOrder = 3 + OnClick = AddrBtnClick + end + object AddrEdit: TEdit + Left = 136 + Top = 56 + Width = 89 + Height = 21 + CharCase = ecUpperCase + MaxLength = 8 + TabOrder = 4 + Text = 'ADDREDIT' + end + object StackBtn: TButton + Left = 256 + Top = 8 + Width = 89 + Height = 25 + Caption = 'Stack dump' + TabOrder = 5 + OnClick = StackBtnClick + end + object TraceLocBtn: TButton + Left = 368 + Top = 8 + Width = 89 + Height = 25 + Caption = 'TraceLoc("text")' + TabOrder = 6 + OnClick = TraceLocBtnClick + end + object ProcBtn: TButton + Left = 480 + Top = 8 + Width = 81 + Height = 25 + Caption = '__PROC__' + TabOrder = 8 + OnClick = ProcBtnClick + end + object ModuleBtn: TButton + Left = 480 + Top = 48 + Width = 81 + Height = 25 + Caption = '__MODULE__' + TabOrder = 9 + OnClick = ModuleBtnClick + end + object RawCheckBox: TCheckBox + Left = 256 + Top = 40 + Width = 89 + Height = 17 + Caption = 'Raw' + TabOrder = 7 + end +end diff --git a/official/1.96/examples/windows/debug/sourceloc/SourceLocDemoMain.pas b/official/1.96/examples/windows/debug/sourceloc/SourceLocDemoMain.pas new file mode 100644 index 0000000..5b5c14b --- /dev/null +++ b/official/1.96/examples/windows/debug/sourceloc/SourceLocDemoMain.pas @@ -0,0 +1,124 @@ +unit SourceLocDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Spin; + +type + TForm1 = class(TForm) + Memo1: TMemo; + CallerBtn: TButton; + LevelSpinEdit: TSpinEdit; + AddrBtn: TButton; + AddrEdit: TEdit; + StackBtn: TButton; + Label1: TLabel; + Label2: TLabel; + TraceLocBtn: TButton; + ProcBtn: TButton; + ModuleBtn: TButton; + RawCheckBox: TCheckBox; + procedure CallerBtnClick(Sender: TObject); + procedure AddrBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure StackBtnClick(Sender: TObject); + procedure TraceLocBtnClick(Sender: TObject); + procedure ProcBtnClick(Sender: TObject); + procedure ModuleBtnClick(Sender: TObject); + private + { Private declarations } + public + procedure ReportLocation(Addr: Pointer); + procedure ReportTime(T: Extended); + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +uses + JclCounter, JclDebug; + +procedure TForm1.FormCreate(Sender: TObject); +var + P: Pointer; +begin + P := @TForm1.AddrBtnClick; + AddrEdit.Text := IntToHex(Integer(P), 8); +end; + +procedure TForm1.ReportLocation(Addr: Pointer); +var + C: TJclCounter; + S: string; + T: Extended; +begin + StartCount(C); + S := GetLocationInfoStr(Addr, False, True, True); + T := StopCount(C); + Memo1.Lines.Add(S); + ReportTime(T); +end; + +procedure TForm1.ReportTime(T: Extended); +begin + Memo1.Lines.Add(Format('Time: %4.3f ms'#13#10, [T * 1000])); +end; + +procedure TForm1.CallerBtnClick(Sender: TObject); +begin + ReportLocation(Caller(LevelSpinEdit.Value)); +end; + +procedure TForm1.AddrBtnClick(Sender: TObject); +var + Addr: Pointer; +begin + Addr := Pointer(StrToInt('$' + Trim(AddrEdit.Text))); + ReportLocation(Addr); +end; + +procedure TForm1.StackBtnClick(Sender: TObject); +var + C: TJclCounter; + T: Extended; + SL: TStringList; +begin + SL := TStringList.Create; + try + StartCount(C); + with TJclStackInfoList.Create(RawCheckBox.Checked, 0, nil) do + try + AddToStrings(SL, False, True, True); + T := StopCount(C); + Memo1.Lines.AddStrings(SL); + ReportTime(T); + finally + Free; + end; + finally + SL.Free; + end; +end; + +procedure TForm1.TraceLocBtnClick(Sender: TObject); +begin + TraceLoc('text'); +end; + +procedure TForm1.ProcBtnClick(Sender: TObject); +begin + ShowMessage(ProcByLevel); +end; + +procedure TForm1.ModuleBtnClick(Sender: TObject); +begin + ShowMessage(ModuleByLevel); +end; + +end. diff --git a/official/1.96/examples/windows/debug/sourceloc/SourceLocExample.dof b/official/1.96/examples/windows/debug/sourceloc/SourceLocExample.dof new file mode 100644 index 0000000..e957ac9 --- /dev/null +++ b/official/1.96/examples/windows/debug/sourceloc/SourceLocExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin + diff --git a/official/1.96/examples/windows/debug/sourceloc/SourceLocExample.dpr b/official/1.96/examples/windows/debug/sourceloc/SourceLocExample.dpr new file mode 100644 index 0000000..e419489 --- /dev/null +++ b/official/1.96/examples/windows/debug/sourceloc/SourceLocExample.dpr @@ -0,0 +1,13 @@ +program SourceLocExample; + +uses + Forms, + SourceLocDemoMain in 'SourceLocDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/debug/sourceloc/SourceLocExample.res b/official/1.96/examples/windows/debug/sourceloc/SourceLocExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/debug/sourceloc/SourceLocExample.res differ diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.bdsproj b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.bdsproj new file mode 100644 index 0000000..32e0e8f --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.bdsproj @@ -0,0 +1,175 @@ + + + + + + + + + + + + StackTrackDLLsComLibrary.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + True + True + True + + + + 0 + 0 + False + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + ..\..\..\..\bin + + + + + + HOOK_DLL_EXCEPTIONS + + False + + + + + + False + + + True + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dof b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dof new file mode 100644 index 0000000..18ab99a --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin +Conditionals=HOOK_DLL_EXCEPTIONS diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dpr b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dpr new file mode 100644 index 0000000..3880412 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dpr @@ -0,0 +1,20 @@ +library StackTrackDLLsComLibrary; + +uses + ComServ, JclHookExcept, + StackTrackDLLsComLibrary_TLB in 'StackTrackDLLsComLibrary_TLB.pas', + StackTrackDLLsComUnit in 'StackTrackDLLsComUnit.pas' {StackTrackDllsTest: CoClass}; + +exports + DllGetClassObject, + DllCanUnloadNow, + DllRegisterServer, + DllUnregisterServer; + +{$R *.TLB} + +{$R *.RES} + +begin + JclInitializeLibrariesHookExcept; +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.res b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.res differ diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.tlb b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.tlb new file mode 100644 index 0000000..ce1f5db Binary files /dev/null and b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.tlb differ diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary_TLB.pas b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary_TLB.pas new file mode 100644 index 0000000..8b45d5b --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary_TLB.pas @@ -0,0 +1,97 @@ +unit StackTrackDLLsComLibrary_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: 1.1 $ +// File generated on 1.8.2005 02:48:29 from Type Library described below. + +// ************************************************************************ // +// Type Lib: D:\Quellen\jedi\jcl\examples\vcl\debug\stacktrack\StackTrackDLLsComLibrary.tlb (1) +// IID\LCID: {D4935E5D-790E-48CA-B360-0165C1305153}\0 +// Helpfile: +// DepndLst: +// (1) v2.0 stdole, (F:\WINNT\system32\stdole2.tlb) +// (2) v4.0 StdVCL, (F:\WINNT\system32\STDVCL40.DLL) +// ************************************************************************ // +{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. +interface + +uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL; + +// *********************************************************************// +// 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 + StackTrackDLLsComLibraryMajorVersion = 1; + StackTrackDLLsComLibraryMinorVersion = 0; + + LIBID_StackTrackDLLsComLibrary: TGUID = '{D4935E5D-790E-48CA-B360-0165C1305153}'; + + IID_IStackTrackDllsTest: TGUID = '{26473046-CCEB-4671-9AB1-2216EF4D2164}'; + CLASS_StackTrackDllsTest: TGUID = '{DA3AEC52-1481-4119-B140-2157C7ADEC5B}'; +type + +// *********************************************************************// +// Forward declaration of types defined in TypeLibrary +// *********************************************************************// + IStackTrackDllsTest = interface; + +// *********************************************************************// +// Declaration of CoClasses defined in Type Library +// (NOTE: Here we map each CoClass to its Default Interface) +// *********************************************************************// + StackTrackDllsTest = IStackTrackDllsTest; + + +// *********************************************************************// +// Interface: IStackTrackDllsTest +// Flags: (256) OleAutomation +// GUID: {26473046-CCEB-4671-9AB1-2216EF4D2164} +// *********************************************************************// + IStackTrackDllsTest = interface(IUnknown) + ['{26473046-CCEB-4671-9AB1-2216EF4D2164}'] + function Error1: HResult; stdcall; + function Error2: HResult; stdcall; + end; + +// *********************************************************************// +// The Class CoStackTrackDllsTest provides a Create and CreateRemote method to +// create instances of the default interface IStackTrackDllsTest exposed by +// the CoClass StackTrackDllsTest. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoStackTrackDllsTest = class + class function Create: IStackTrackDllsTest; + class function CreateRemote(const MachineName: string): IStackTrackDllsTest; + end; + +implementation + +uses ComObj; + +class function CoStackTrackDllsTest.Create: IStackTrackDllsTest; +begin + Result := CreateComObject(CLASS_StackTrackDllsTest) as IStackTrackDllsTest; +end; + +class function CoStackTrackDllsTest.CreateRemote(const MachineName: string): IStackTrackDllsTest; +begin + Result := CreateRemoteComObject(MachineName, CLASS_StackTrackDllsTest) as IStackTrackDllsTest; +end; + +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComUnit.pas b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComUnit.pas new file mode 100644 index 0000000..d4c37f9 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsComUnit.pas @@ -0,0 +1,38 @@ +unit StackTrackDLLsComUnit; + +interface + +uses + Windows, ActiveX, Classes, ComObj, StackTrackDLLsComLibrary_TLB, StdVcl; + +type + TStackTrackDllsTest = class(TTypedComObject, IStackTrackDllsTest) + protected + function Error1: HResult; stdcall; + function Error2: HResult; stdcall; + end; + +implementation + +uses ComServ, SysUtils; + +procedure Error1_1; +begin + StrToInt('x'); +end; + +function TStackTrackDllsTest.Error1: HResult; +begin + Error1_1; + Result := S_FALSE; +end; + +function TStackTrackDllsTest.Error2: HResult; +begin + raise Exception.Create('Exception from IDllExceptTestObject.Error2'); +end; + +initialization + TTypedComObjectFactory.Create(ComServer, TStackTrackDllsTest, Class_StackTrackDllsTest, + ciMultiInstance, tmApartment); +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.dfm b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.dfm new file mode 100644 index 0000000..bf364b7 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.dfm @@ -0,0 +1,115 @@ +object MainForm: TMainForm + Left = 555 + Top = 318 + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsSingle + Caption = 'Exceptions in DLLs example' + ClientHeight = 296 + ClientWidth = 235 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object StaticLibGroupBox: TGroupBox + Left = 8 + Top = 8 + Width = 217 + Height = 65 + Caption = 'Statically linked library' + TabOrder = 0 + object StaticLibError1Btn: TButton + Left = 23 + Top = 24 + Width = 75 + Height = 25 + Caption = 'Error1' + TabOrder = 0 + OnClick = StaticLibError1BtnClick + end + object StaticLibError2Btn: TButton + Left = 119 + Top = 24 + Width = 75 + Height = 25 + Caption = 'Error2' + TabOrder = 1 + OnClick = StaticLibError2BtnClick + end + end + object ComObjGroupBox: TGroupBox + Left = 8 + Top = 216 + Width = 217 + Height = 65 + Caption = 'COM object' + TabOrder = 1 + object ComObjErr1Btn: TButton + Left = 23 + Top = 24 + Width = 75 + Height = 25 + Caption = 'Error1' + TabOrder = 0 + OnClick = ComObjErr1BtnClick + end + object ComObjErr2Btn: TButton + Left = 119 + Top = 24 + Width = 75 + Height = 25 + Caption = 'Error2' + TabOrder = 1 + OnClick = ComObjErr2BtnClick + end + end + object DynLibGroupBox: TGroupBox + Left = 8 + Top = 88 + Width = 217 + Height = 113 + Caption = 'Dynamically linked library' + TabOrder = 2 + object DynamicLibError1Btn: TButton + Left = 23 + Top = 64 + Width = 75 + Height = 25 + Caption = 'Error1' + TabOrder = 0 + OnClick = DynamicLibError1BtnClick + end + object DynamicLibError2Btn: TButton + Left = 119 + Top = 64 + Width = 75 + Height = 25 + Caption = 'Error2' + TabOrder = 1 + OnClick = DynamicLibError2BtnClick + end + object LoadLibBtn: TButton + Left = 23 + Top = 24 + Width = 75 + Height = 25 + Caption = 'Load' + TabOrder = 2 + OnClick = LoadLibBtnClick + end + object FreeLibBtn: TButton + Left = 119 + Top = 24 + Width = 75 + Height = 25 + Caption = 'Free' + TabOrder = 3 + OnClick = FreeLibBtnClick + end + end +end diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.pas b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.pas new file mode 100644 index 0000000..cde7fe8 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.pas @@ -0,0 +1,130 @@ +unit StackTrackDLLsDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls; + +type + TMainForm = class(TForm) + StaticLibError1Btn: TButton; + StaticLibError2Btn: TButton; + StaticLibGroupBox: TGroupBox; + ComObjGroupBox: TGroupBox; + ComObjErr1Btn: TButton; + ComObjErr2Btn: TButton; + DynLibGroupBox: TGroupBox; + DynamicLibError1Btn: TButton; + DynamicLibError2Btn: TButton; + LoadLibBtn: TButton; + FreeLibBtn: TButton; + procedure StaticLibError1BtnClick(Sender: TObject); + procedure StaticLibError2BtnClick(Sender: TObject); + procedure ComObjErr1BtnClick(Sender: TObject); + procedure ComObjErr2BtnClick(Sender: TObject); + procedure DynamicLibError1BtnClick(Sender: TObject); + procedure DynamicLibError2BtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure LoadLibBtnClick(Sender: TObject); + procedure FreeLibBtnClick(Sender: TObject); + private + FLibHandle: THandle; + public + procedure UpdateButtons; + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses + JclBase, StackTrackDLLsComLibrary_TLB; + +const + StaticLibrary = 'StackTrackDLLsStaticLibrary.dll'; + DynamicLibrary = 'StackTrackDLLsDynamicLibrary.dll'; + +procedure Error1; stdcall; external StaticLibrary; +procedure Error2; stdcall; external StaticLibrary; + +{ TMainForm } + +procedure TMainForm.FormCreate(Sender: TObject); +begin + UpdateButtons; +end; + +procedure TMainForm.StaticLibError1BtnClick(Sender: TObject); +begin + Error1; +end; + +procedure TMainForm.StaticLibError2BtnClick(Sender: TObject); +begin + Error2; +end; + +procedure TMainForm.ComObjErr1BtnClick(Sender: TObject); +var + I: IStackTrackDllsTest; +begin + I := CoStackTrackDllsTest.Create; + I.Error1; +end; + +procedure TMainForm.ComObjErr2BtnClick(Sender: TObject); +var + I: IStackTrackDllsTest; +begin + I := CoStackTrackDllsTest.Create; + I.Error2; +end; + +procedure TMainForm.LoadLibBtnClick(Sender: TObject); +begin + FLibHandle := LoadLibrary(DynamicLibrary); + UpdateButtons; + if FLibHandle = 0 then + RaiseLastOSError; +end; + +procedure TMainForm.FreeLibBtnClick(Sender: TObject); +begin + FreeLibrary(FLibHandle); + FLibHandle := 0; + UpdateButtons; +end; + +procedure TMainForm.DynamicLibError1BtnClick(Sender: TObject); +var + _Error1: procedure; stdcall; +begin + @_Error1 := GetProcAddress(FLibHandle, 'Error1'); + if not Assigned(_Error1) then + RaiseLastOSError; + _Error1; +end; + +procedure TMainForm.DynamicLibError2BtnClick(Sender: TObject); +var + _Error2: procedure; stdcall; +begin + @_Error2 := GetProcAddress(FLibHandle, 'Error2'); + if not Assigned(_Error2) then + RaiseLastOSError; + _Error2; +end; + +procedure TMainForm.UpdateButtons; +begin + LoadLibBtn.Enabled := (FLibHandle = 0); + FreeLibBtn.Enabled := (FLibHandle <> 0); + DynamicLibError1Btn.Enabled := (FLibHandle <> 0); + DynamicLibError2Btn.Enabled := (FLibHandle <> 0); +end; + +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.bdsproj b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.bdsproj new file mode 100644 index 0000000..dcc7f08 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.bdsproj @@ -0,0 +1,175 @@ + + + + + + + + + + + + StackTrackDLLsDynamicLibrary.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + True + True + True + + + + 0 + 0 + False + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + ..\..\..\..\bin + + + + + + HOOK_DLL_EXCEPTIONS + + False + + + + + + False + + + True + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dof b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dof new file mode 100644 index 0000000..18ab99a --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin +Conditionals=HOOK_DLL_EXCEPTIONS diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dpr b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dpr new file mode 100644 index 0000000..6470da7 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dpr @@ -0,0 +1,15 @@ +library StackTrackDLLsDynamicLibrary; + +uses + SysUtils, + JclHookExcept, + StackTrackDLLsDynamicUnit in 'StackTrackDLLsDynamicUnit.pas'; + +{$R *.res} + +exports + Error1, Error2; + +begin + JclInitializeLibrariesHookExcept; +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.res b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.res differ diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicUnit.pas b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicUnit.pas new file mode 100644 index 0000000..2b92f16 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsDynamicUnit.pas @@ -0,0 +1,28 @@ +unit StackTrackDLLsDynamicUnit; + +interface + +procedure Error1; stdcall; +procedure Error2; stdcall; + +implementation + +uses + SysUtils; + +procedure Error1_1; +begin + StrToInt('x'); +end; + +procedure Error1; stdcall; +begin + Error1_1; +end; + +procedure Error2; stdcall; +begin + raise Exception.Create('Exception from StaticLibrary.dll'); +end; + +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.bdsproj b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.bdsproj new file mode 100644 index 0000000..ef3bf94 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.bdsproj @@ -0,0 +1,175 @@ + + + + + + + + + + + + StackTrackDLLsExample.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + True + True + True + + + + 0 + 0 + False + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + ..\..\..\..\bin + + + + + + HOOK_DLL_EXCEPTIONS + + False + + + + + + False + + + True + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.dof b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.dof new file mode 100644 index 0000000..18ab99a --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin +Conditionals=HOOK_DLL_EXCEPTIONS diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.dpr b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.dpr new file mode 100644 index 0000000..4653f89 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.dpr @@ -0,0 +1,14 @@ +program StackTrackDLLsExample; + +uses + Forms, + StackTrackDLLsDemoMain in 'StackTrackDLLsDemoMain.pas' {MainForm}, + ExceptDlg in '..\..\..\..\experts\debug\dialog\ExceptDlg.pas' {ExceptionDialog}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.res b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsExample.res differ diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.bdsproj b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.bdsproj new file mode 100644 index 0000000..cbba2ac --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.bdsproj @@ -0,0 +1,175 @@ + + + + + + + + + + + + StackTrackDLLsStaticLibrary.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + True + True + True + + + + 0 + 0 + False + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + ..\..\..\..\bin + + + + + + HOOK_DLL_EXCEPTIONS + + False + + + + + + False + + + True + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dof b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dof new file mode 100644 index 0000000..18ab99a --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin +Conditionals=HOOK_DLL_EXCEPTIONS diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dpr b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dpr new file mode 100644 index 0000000..2584a09 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dpr @@ -0,0 +1,15 @@ +library StackTrackDLLsStaticLibrary; + +uses + SysUtils, + JclHookExcept, + StackTrackDLLsStaticUnit in 'StackTrackDLLsStaticUnit.pas'; + +{$R *.res} + +exports + Error1, Error2; + +begin + JclInitializeLibrariesHookExcept; +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.res b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.res differ diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticUnit.pas b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticUnit.pas new file mode 100644 index 0000000..3b3922e --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDLLsStaticUnit.pas @@ -0,0 +1,28 @@ +unit StackTrackDLLsStaticUnit; + +interface + +procedure Error1; stdcall; +procedure Error2; stdcall; + +implementation + +uses + SysUtils; + +procedure Error1_1; +begin + StrToInt('x'); +end; + +procedure Error1; stdcall; +begin + Error1_1; +end; + +procedure Error2; stdcall; +begin + raise Exception.Create('Exception from StaticLibrary.dll'); +end; + +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDemoMain.dfm b/official/1.96/examples/windows/debug/stacktrack/StackTrackDemoMain.dfm new file mode 100644 index 0000000..a81ff1c --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDemoMain.dfm @@ -0,0 +1,95 @@ +object MainForm: TMainForm + Left = 342 + Top = 197 + Width = 614 + Height = 523 + Caption = 'Tracking unhandled exceptions in VCL application' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 0 + Top = 64 + Width = 64 + Height = 13 + Caption = '&Exception log' + FocusControl = ExceptionLogMemo + end + object ExceptionLogMemo: TMemo + Left = 0 + Top = 80 + Width = 606 + Height = 416 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 0 + WordWrap = False + end + object Button1: TButton + Left = 8 + Top = 8 + Width = 75 + Height = 25 + Caption = 'Error1' + TabOrder = 1 + OnClick = Button1Click + end + object Button2: TButton + Left = 88 + Top = 8 + Width = 75 + Height = 25 + Caption = 'Error2' + TabOrder = 2 + OnClick = Button2Click + end + object Button3: TButton + Left = 168 + Top = 8 + Width = 75 + Height = 25 + Caption = 'Error3' + TabOrder = 3 + OnClick = Button3Click + end + object ListBox1: TListBox + Left = 472 + Top = 8 + Width = 73 + Height = 49 + ItemHeight = 13 + TabOrder = 4 + Visible = False + end + object Button4: TButton + Left = 248 + Top = 8 + Width = 75 + Height = 25 + Caption = 'Error4' + TabOrder = 5 + OnClick = Button4Click + end + object ApplicationEvents: TApplicationEvents + OnException = ApplicationEventsException + Left = 8 + Top = 440 + end + object ActionList1: TActionList + Left = 440 + Top = 8 + end +end diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackDemoMain.pas b/official/1.96/examples/windows/debug/stacktrack/StackTrackDemoMain.pas new file mode 100644 index 0000000..93cec82 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackDemoMain.pas @@ -0,0 +1,110 @@ +unit StackTrackDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, AppEvnts, ActnList; + +type + TMainForm = class(TForm) + ExceptionLogMemo: TMemo; + Button1: TButton; + Button2: TButton; + Button3: TButton; + ListBox1: TListBox; + Button4: TButton; + ApplicationEvents: TApplicationEvents; + Label1: TLabel; + ActionList1: TActionList; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure Button4Click(Sender: TObject); + procedure ApplicationEventsException(Sender: TObject; E: Exception); + private + { Private declarations } + public + { Public declarations } + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.DFM} + +uses + JclDebug; + +{ TMainForm } + +//-------------------------------------------------------------------------------------------------- +// Simulation of various unhandled exceptions +//-------------------------------------------------------------------------------------------------- + +procedure TMainForm.Button1Click(Sender: TObject); +begin + PInteger(nil)^ := 0; +end; + +procedure TMainForm.Button2Click(Sender: TObject); +begin + ListBox1.Items[1] := 'a'; +end; + +procedure AAA; +begin + PInteger(nil)^ := 0; +end; + +procedure TMainForm.Button3Click(Sender: TObject); +begin + AAA; +end; + +procedure TMainForm.Button4Click(Sender: TObject); +begin + ActionList1.Actions[0].Execute; +end; + +//-------------------------------------------------------------------------------------------------- +// Simple VCL application unhandled exception handler using JclDebug +//-------------------------------------------------------------------------------------------------- + +procedure TMainForm.ApplicationEventsException(Sender: TObject; E: Exception); +begin + // Log time stamp + ExceptionLogMemo.Lines.Add(DateTimeToStr(Now)); + + // Log unhandled exception stack info to ExceptionLogMemo + JclLastExceptStackListToStrings(ExceptionLogMemo.Lines, False, True, True, False); + + // Insert empty line + ExceptionLogMemo.Lines.Add(''); + + // Display default VCL unhandled exception dialog + Application.ShowException(E); +end; + +//-------------------------------------------------------------------------------------------------- +// JclDebug initialization and finalization for VCL application +//-------------------------------------------------------------------------------------------------- + +initialization + + // Enable raw mode (default mode uses stack frames which aren't always generated by the compiler) + Include(JclStackTrackingOptions, stRawMode); + // Disable stack tracking in dynamically loaded modules (it makes stack tracking code a bit faster) + Include(JclStackTrackingOptions, stStaticModuleList); + + // Initialize Exception tracking + JclStartExceptionTracking; + +finalization + + // Uninitialize Exception tracking + JclStopExceptionTracking; + +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.bdsproj b/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.bdsproj new file mode 100644 index 0000000..c75588d --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.bdsproj @@ -0,0 +1,175 @@ + + + + + + + + + + + + StackTrackExample.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + True + True + True + + + + 0 + 0 + False + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + ..\..\..\..\bin + + + + + + HOOK_DLL_EXCEPTIONS + + False + + + + + + False + + + True + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.dof b/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.dof new file mode 100644 index 0000000..18ab99a --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin +Conditionals=HOOK_DLL_EXCEPTIONS diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.dpr b/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.dpr new file mode 100644 index 0000000..a5062b9 --- /dev/null +++ b/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.dpr @@ -0,0 +1,13 @@ +program StackTrackExample; + +uses + Forms, + StackTrackDemoMain in 'StackTrackDemoMain.pas' {MainForm}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.res b/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/debug/stacktrack/StackTrackExample.res differ diff --git a/official/1.96/examples/windows/debug/threadexcept/ThreadExceptDemoMain.dfm b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptDemoMain.dfm new file mode 100644 index 0000000..6e7b376 --- /dev/null +++ b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptDemoMain.dfm @@ -0,0 +1,93 @@ +object MainForm: TMainForm + Left = 286 + Top = 169 + Caption = + 'Exception tracking in threads and IDE Thread Status window exten' + + 'sion demo' + ClientHeight = 557 + ClientWidth = 715 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 8 + Top = 8 + Width = 63 + Height = 13 + Caption = 'Thread name' + FocusControl = ThreadNameEdit + end + object Label2: TLabel + Left = 8 + Top = 248 + Width = 55 + Height = 13 + Caption = 'Exceprtions' + end + object MessageRichEdit: TRichEdit + Left = 8 + Top = 264 + Width = 697 + Height = 289 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + PlainText = True + ReadOnly = True + TabOrder = 0 + WordWrap = False + end + object ThreadsRichEdit: TRichEdit + Left = 168 + Top = 8 + Width = 537 + Height = 249 + Anchors = [akLeft, akTop, akRight] + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + PlainText = True + ReadOnly = True + TabOrder = 1 + WordWrap = False + end + object CreateThreadBtn: TButton + Left = 8 + Top = 56 + Width = 75 + Height = 25 + Caption = 'Create Thread' + TabOrder = 2 + OnClick = CreateThreadBtnClick + end + object ThreadNameEdit: TEdit + Left = 8 + Top = 24 + Width = 121 + Height = 21 + TabOrder = 3 + end + object ListThreadsBtn: TButton + Left = 8 + Top = 96 + Width = 75 + Height = 25 + Caption = 'List Threads' + TabOrder = 4 + OnClick = ListThreadsBtnClick + end +end diff --git a/official/1.96/examples/windows/debug/threadexcept/ThreadExceptDemoMain.pas b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptDemoMain.pas new file mode 100644 index 0000000..10b523e --- /dev/null +++ b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptDemoMain.pas @@ -0,0 +1,166 @@ +unit ThreadExceptDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ComCtrls, JclDebug; + +type + TDemoThread = class(TJclDebugThread) + private + procedure SomeErrorHere; + protected + procedure Execute; override; + end; + + TMainForm = class(TForm) + MessageRichEdit: TRichEdit; + ThreadsRichEdit: TRichEdit; + CreateThreadBtn: TButton; + ThreadNameEdit: TEdit; + ListThreadsBtn: TButton; + Label1: TLabel; + Label2: TLabel; + procedure FormCreate(Sender: TObject); + procedure CreateThreadBtnClick(Sender: TObject); + procedure ListThreadsBtnClick(Sender: TObject); + private + procedure DoThreadSyncException(Thread: TJclDebugThread); + procedure DoThreadRegistered(ThreadID: DWORD); + procedure DoThreadUnregistered(ThreadID: DWORD); + public + ThreadCnt: Integer; + function GetNewThreadName: string; + procedure ScrollDownRichEdit(RichEdit: TRichEdit); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +{ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! } +{ } +{ You have to install ThreadNameExpert package located in "\experts\debug\threadnames" } +{ } +{ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! } + +{$DEFINE IdeThreadStatusWindowExtension} + +{$IFDEF IdeThreadStatusWindowExtension} +uses + JclIdeThreadStatus; +{$ENDIF} + +{ TDemoThread } + +procedure TDemoThread.Execute; +var + I: Integer; +begin + try + I := 0; + while not Terminated and (I < 5) do + begin + Sleep(2000); + MessageBeep(0); + try + SomeErrorHere; + except + HandleException; + end; + Inc(I); + {$IFDEF IdeThreadStatusWindowExtension} + // You can change Thread Name displayed in Thread Status Window in code. This does not change + // TDemoThread.ThreadName property value + // ChangeThreadName(Self, Format('I = %d', [I])); + {$ENDIF} + end; + except + HandleException; + end; +end; + +procedure TDemoThread.SomeErrorHere; +begin + // Set Breakpoint on "begin", uncheck "Break" and check "Ingore subsequent exceptions" in + // dialog advanced breakpoint actions + StrToInt('x'); +end; + +{ TMainForm } + +procedure TMainForm.DoThreadRegistered(ThreadID: DWORD); +begin + ThreadsRichEdit.Lines.Add(Format('Thread registered: %s', [JclDebugThreadList.ThreadInfos[ThreadID]])); + ScrollDownRichEdit(ThreadsRichEdit); +end; + +procedure TMainForm.DoThreadSyncException(Thread: TJclDebugThread); +begin + MessageRichEdit.Lines.Add(Format('Exception in thread: %s', [Thread.ThreadInfo])); + // Note: JclLastExceptStackList always returns list for *current* thread ID. To simplify getting the + // stack of thread where an exception occured JclLastExceptStackList returns stack of the thread instead + // of current thread when called *within* the JclDebugThreadList.OnSyncException handler. This is the + // *only* exception to the behavior of JclLastExceptStackList described above. + JclLastExceptStackList.AddToStrings(MessageRichEdit.Lines, False, True, True); + ScrollDownRichEdit(MessageRichEdit); +end; + +procedure TMainForm.DoThreadUnregistered(ThreadID: DWORD); +begin + ThreadsRichEdit.Lines.Add(Format('Thread unregistered: %s', [JclDebugThreadList.ThreadInfos[ThreadID]])); + ScrollDownRichEdit(ThreadsRichEdit); +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + with JclDebugThreadList do + begin + OnSyncException := DoThreadSyncException; + OnThreadRegistered := DoThreadRegistered; + OnThreadUnregistered := DoThreadUnregistered; + end; + ThreadNameEdit.Text := GetNewThreadName; +end; + +function TMainForm.GetNewThreadName: string; +begin + Inc(ThreadCnt); + Result := Format('Thread%d', [ThreadCnt]); +end; + +procedure TMainForm.CreateThreadBtnClick(Sender: TObject); +var + DemoThread: TDemoThread; +begin + DemoThread := TDemoThread.Create(True, ThreadNameEdit.Text); + DemoThread.FreeOnTerminate := True; + DemoThread.Resume; + ThreadNameEdit.Text := GetNewThreadName; +end; + +procedure TMainForm.ListThreadsBtnClick(Sender: TObject); +var + I: Integer; +begin + ThreadsRichEdit.Lines.Add('List of registered threads:'); + with JclDebugThreadList do + for I := 0 to ThreadIDCount - 1 do + ThreadsRichEdit.Lines.Add(ThreadInfos[ThreadIDs[I]]); + ScrollDownRichEdit(ThreadsRichEdit); +end; + +procedure TMainForm.ScrollDownRichEdit(RichEdit: TRichEdit); +begin + SendMessage(RichEdit.Handle, EM_SCROLLCARET, 0, 0); +end; + +initialization + Include(JclStackTrackingOptions, stRawMode); + JclStartExceptionTracking; + +end. diff --git a/official/1.96/examples/windows/debug/threadexcept/ThreadExceptExample.dof b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptExample.dof new file mode 100644 index 0000000..9acd2cf --- /dev/null +++ b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptExample.dof @@ -0,0 +1,4 @@ +[Directories] +OutputDir=../../../../bin + + diff --git a/official/1.96/examples/windows/debug/threadexcept/ThreadExceptExample.dpr b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptExample.dpr new file mode 100644 index 0000000..43424c8 --- /dev/null +++ b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptExample.dpr @@ -0,0 +1,17 @@ +program ThreadExceptExample; + +uses + Forms, + JclOTAResources in '..\..\..\..\experts\common\JclOTAResources.pas', + JclOTAConsts in '..\..\..\..\experts\common\JclOTAConsts.pas', + JclIdeThreadStatus in '..\..\..\..\experts\debug\threadnames\JclIdeThreadStatus.pas', + ThreadExpertSharedNames in '..\..\..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas', + ThreadExceptDemoMain in 'ThreadExceptDemoMain.pas' {MainForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/debug/threadexcept/ThreadExceptExample.res b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/debug/threadexcept/ThreadExceptExample.res differ diff --git a/official/1.96/examples/windows/delphitools/DelphiToolsGroup.bpg b/official/1.96/examples/windows/delphitools/DelphiToolsGroup.bpg new file mode 100644 index 0000000..7a36fb3 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/DelphiToolsGroup.bpg @@ -0,0 +1,33 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = DependView.exe PeViewer.exe ToolHelpViewer.exe ResFix.exe \ + ScreenJPG.exe +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +DependView.exe: DependencyViewer\DependView.dpr + $(DCC) + +PeViewer.exe: PeViewer\PeViewer.dpr + $(DCC) + +ToolHelpViewer.exe: ToolHelpView\ToolHelpViewer.dpr + $(DCC) + +ResFix.exe: ResFix\ResFix.dpr + $(DCC) + +ScreenJPG.exe: ScreenJPG\ScreenJPG.dpr + $(DCC) + + diff --git a/official/1.96/examples/windows/delphitools/Readme.txt b/official/1.96/examples/windows/delphitools/Readme.txt new file mode 100644 index 0000000..ad67294 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/Readme.txt @@ -0,0 +1,24 @@ +------------------------------------------------------------------------------- +* DELPHI OPEN SOURCE TOOLS 0.5.4 * +------------------------------------------------------------------------------- + +License: +-------- + +Mozilla Public License Ver. 1.1 +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. + + +Source code: +------------ + +The source code of these tools is intended for Delphi 5.01 (Update Pack #1 is +*required* due some fixes in the VCL) or Delphi 6.02. You will also need JEDI +Code Libary: + +Delphi Tools : http://www.volweb.cz/pvones/delphi +JEDI Code Library: http://delphi-jedi.org/Jedi:CODELIBJCL diff --git a/official/1.96/examples/windows/delphitools/common/About.dfm b/official/1.96/examples/windows/delphitools/common/About.dfm new file mode 100644 index 0000000..b4ca5ee --- /dev/null +++ b/official/1.96/examples/windows/delphitools/common/About.dfm @@ -0,0 +1,74 @@ +object AboutBox: TAboutBox + Left = 306 + Top = 208 + BorderStyle = bsDialog + Caption = 'About ...' + ClientHeight = 164 + ClientWidth = 258 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + ShowHint = True + OnCreate = FormCreate + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object IconPaintBox: TPaintBox + Left = 8 + Top = 8 + Width = 32 + Height = 32 + OnPaint = IconPaintBoxPaint + end + object Bevel1: TBevel + Left = 56 + Top = 121 + Width = 193 + Height = 14 + Anchors = [akLeft, akRight, akBottom] + Shape = bsTopLine + end + object ProductNameLabel: TLabel + Left = 56 + Top = 16 + Width = 108 + Height = 13 + Caption = 'ProductNameLabel' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + end + object VersionLabel: TLabel + Left = 56 + Top = 40 + Width = 61 + Height = 13 + Caption = 'VersionLabel' + end + object CompanyLabel: TLabel + Left = 56 + Top = 64 + Width = 70 + Height = 13 + Caption = 'CompanyLabel' + end + object OkBtn: TButton + Left = 174 + Top = 133 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 0 + end +end diff --git a/official/1.96/examples/windows/delphitools/common/About.pas b/official/1.96/examples/windows/delphitools/common/About.pas new file mode 100644 index 0000000..8900696 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/common/About.pas @@ -0,0 +1,187 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 About.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit About; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls; + +type + TAboutBox = class(TForm) + IconPaintBox: TPaintBox; + OkBtn: TButton; + Bevel1: TBevel; + ProductNameLabel: TLabel; + VersionLabel: TLabel; + CompanyLabel: TLabel; + procedure FormCreate(Sender: TObject); + procedure IconPaintBoxPaint(Sender: TObject); + procedure FormShow(Sender: TObject); + private + FLinks: array of string; + FURLSpacing: Integer; + procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; + procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; + function GetLinkCaption(Index: Integer): string; + function GetLinkURL(Index: Integer): string; + procedure OpenURL(const UrlName: String); + procedure UpdateLinkLabel(L: LPARAM; Activate: Boolean); + procedure UrlLinkLabelClick(Sender: TObject); + end; + +procedure ShowAbout(const Links: array of string; Spacing: Integer = 20); + +var + AboutBox: TAboutBox; + +implementation + +{$R *.DFM} + +uses + ShellAPI, JclFileUtils; + +procedure ShowAbout(const Links: array of string; Spacing: Integer); +var + I: Integer; +begin + with TAboutBox.Create(Application) do + try + SetLength(FLinks, High(Links) + 1); + for I := Low(Links) to High(Links) do + FLinks[I] := Links[I]; + FURLSpacing := Spacing; + ShowModal; + finally + Free; + end; +end; + +{ TAboutBox } + +procedure TAboutBox.CMMouseEnter(var Message: TMessage); +begin + inherited; + UpdateLinkLabel(Message.LParam, True); +end; + +procedure TAboutBox.CMMouseLeave(var Message: TMessage); +begin + inherited; + UpdateLinkLabel(Message.LParam, False); +end; + +procedure TAboutBox.FormCreate(Sender: TObject); +begin + with IconPaintBox do + begin + Width := GetSystemMetrics(SM_CXICON); + Height := GetSystemMetrics(SM_CYICON); + end; + with TJclFileVersionInfo.Create(Application.ExeName) do + try + ProductNameLabel.Caption := ProductName; + VersionLabel.Caption := Format('Version: %s', [ProductVersion]); + CompanyLabel.Caption := LegalCopyright; + finally + Free; + end; +end; + +procedure TAboutBox.FormShow(Sender: TObject); +var + I: Integer; +begin + I := Length(FLinks) * FURLSpacing - 20; + if I > 0 then Height := Height + I; + for I := 0 to Length(FLinks) - 1 do + with TLabel.Create(Self) do + begin + Parent := Self; + SetBounds(CompanyLabel.Left, I * FURLSpacing + CompanyLabel.Top + 25, 0, 0); + Caption := GetLinkCaption(I); + Cursor := crHandPoint; + Font.Color := clBlue; + Font.Style := [fsUnderline]; + Hint := GetLinkURL(I); + Tag := I + 1; + OnClick := UrlLinkLabelClick; + end; +end; + +function TAboutBox.GetLinkCaption(Index: Integer): string; +begin + Result := FLinks[Index]; + Result := Copy(Result, 1, Pos(';', Result) - 1); +end; + +function TAboutBox.GetLinkURL(Index: Integer): string; +begin + Result := FLinks[Index]; + Delete(Result, 1, Pos(';', Result)); +end; + +procedure TAboutBox.IconPaintBoxPaint(Sender: TObject); +begin + IconPaintBox.Canvas.Draw(0, 0, Application.Icon); +end; + +procedure TAboutBox.OpenURL(const UrlName: String); +var + Sei: TShellExecuteInfo; +begin + ZeroMemory(@Sei, Sizeof(Sei)); + Sei.cbSize := Sizeof(Sei); + Sei.Wnd := Application.Handle; + Sei.lpFile := PChar(UrlName); + Sei.nShow := SW_SHOWNORMAL; + ShellExecuteEx(@Sei); +end; + +procedure TAboutBox.UpdateLinkLabel(L: LPARAM; Activate: Boolean); +begin + if (TObject(L) is TLabel) and (TLabel(L).Tag > 0) then + with TLabel(L).Font do + if Activate then Color := clPurple else Color := clBlue; +end; + +procedure TAboutBox.UrlLinkLabelClick(Sender: TObject); +begin + OpenURL(GetLinkURL(TLabel(Sender).Tag - 1)); +end; + +// History: + +// $Log: About.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/common/D6MdiMsgFix.pas b/official/1.96/examples/windows/delphitools/common/D6MdiMsgFix.pas new file mode 100644 index 0000000..1912e4c --- /dev/null +++ b/official/1.96/examples/windows/delphitools/common/D6MdiMsgFix.pas @@ -0,0 +1,92 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 D6MdiMsgFix.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit D6MdiMsgFix; + +interface + +{$I jcl.inc} + +implementation + +{$IFDEF DELPHI6} + +uses + Windows, Classes, SysUtils, Forms, AppEvnts; + +type + TFixApplicationEvents = class(TCustomApplicationEvents) + protected + procedure ApplicationEventsMessage(var Msg: TMsg; var Handled: Boolean); + public + constructor Create(AOwner: TComponent); override; + end; + + TApplicationAccess = class(TApplication); + +var + FixApplicationEvents: TFixApplicationEvents; + +{ TFixApplicationEvents } + +procedure TFixApplicationEvents.ApplicationEventsMessage(var Msg: TMsg; var Handled: Boolean); +begin + with Application do + if Assigned(MainForm) and (MainForm.FormStyle = fsMDIForm) and + Assigned(Screen.ActiveForm) and (Screen.ActiveForm.FormStyle <> fsMdiChild) then + begin + Handled := True; + with TApplicationAccess(Application) do + if not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then + begin + // prevent to call buggy TApplication.IsMDIMsg method, handle message here + TranslateMessage(Msg); + DispatchMessage(Msg); + end; + end; +end; + +constructor TFixApplicationEvents.Create(AOwner: TComponent); +begin + inherited; + OnMessage := ApplicationEventsMessage; +end; + +initialization + FixApplicationEvents := TFixApplicationEvents.Create(nil); + +finalization + FreeAndNil(FixApplicationEvents); + +{$ENDIF DELPHI6} + +// History: + +// $Log: D6MdiMsgFix.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/common/FindDlg.dfm b/official/1.96/examples/windows/delphitools/common/FindDlg.dfm new file mode 100644 index 0000000..ad3da51 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/common/FindDlg.dfm @@ -0,0 +1,107 @@ +object FindTextForm: TFindTextForm + Left = 305 + Top = 226 + ActiveControl = SearchTextEdit + BorderStyle = bsDialog + Caption = 'Find text' + ClientHeight = 110 + ClientWidth = 346 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + PixelsPerInch = 96 + TextHeight = 13 + object FindBtn: TButton + Left = 264 + Top = 8 + Width = 75 + Height = 25 + Caption = '&Find' + Default = True + TabOrder = 0 + OnClick = FindBtnClick + end + object CancelBtn: TButton + Left = 264 + Top = 40 + Width = 75 + Height = 25 + Cancel = True + Caption = '&Cancel' + ModalResult = 2 + TabOrder = 1 + end + object ProgressBar1: TProgressBar + Left = 8 + Top = 96 + Width = 329 + Height = 9 + Min = 0 + Max = 100 + Step = 20 + TabOrder = 2 + Visible = False + end + object GroupBox1: TGroupBox + Left = 8 + Top = 0 + Width = 249 + Height = 89 + TabOrder = 3 + object Label1: TLabel + Left = 8 + Top = 20 + Width = 56 + Height = 13 + Caption = '&Text to find:' + FocusControl = SearchTextEdit + end + object Label2: TLabel + Left = 8 + Top = 44 + Width = 38 + Height = 13 + Caption = 'C&olumn:' + FocusControl = ColumnComboBox + end + object SearchTextEdit: TEdit + Left = 72 + Top = 16 + Width = 169 + Height = 21 + TabOrder = 0 + end + object ColumnComboBox: TComboBox + Left = 72 + Top = 40 + Width = 169 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + TabOrder = 1 + end + object CaseCheckBox: TCheckBox + Left = 72 + Top = 64 + Width = 81 + Height = 17 + Caption = '&Ignore case' + Checked = True + State = cbChecked + TabOrder = 2 + end + object ExactCheckBox: TCheckBox + Left = 160 + Top = 64 + Width = 81 + Height = 17 + Caption = '&Exact match' + TabOrder = 3 + end + end +end diff --git a/official/1.96/examples/windows/delphitools/common/FindDlg.pas b/official/1.96/examples/windows/delphitools/common/FindDlg.pas new file mode 100644 index 0000000..b95ee69 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/common/FindDlg.pas @@ -0,0 +1,209 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 D6MdiMsgFix.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit FindDlg; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls; + +type + TFindTextForm = class(TForm) + FindBtn: TButton; + CancelBtn: TButton; + ProgressBar1: TProgressBar; + GroupBox1: TGroupBox; + Label1: TLabel; + SearchTextEdit: TEdit; + ColumnComboBox: TComboBox; + Label2: TLabel; + CaseCheckBox: TCheckBox; + ExactCheckBox: TCheckBox; + procedure FindBtnClick(Sender: TObject); + private + FListView: TListView; + procedure SetListView(const Value: TListView); + public + function Find: Boolean; + class function CanExecuteFind: Boolean; + property ListView: TListView read FListView write SetListView; + end; + +function ShowFindDialog(AListView: TListView): Boolean; + +var + FindTextForm: TFindTextForm; + +implementation + +{$R *.DFM} + +resourcestring + RsAllColumns = '[all columns]'; + +function ShowFindDialog(AListView: TListView): Boolean; +begin + with TFindTextForm.Create(Application) do + try + ListView := AListView; + Result := ShowModal = mrOk; + finally + Free; + end; +end; + +{ TFindForm } + +function TFindTextForm.Find: Boolean; +var + R, C, FindColumn, ColCount, FoundRow: Integer; + IgnoreCase, ExactMatch: Boolean; + SearchText: string; + + + function CompareColumnText(ColumnIndex: Integer): Boolean; + var + Text: string; + begin + with FListView.Items[R] do + if ColumnIndex = 0 then + Text := Caption + else + Text := SubItems[ColumnIndex - 1]; + if IgnoreCase then + Text := AnsiUpperCase(Text); + if ExactMatch then + Result := (SearchText = Text) + else + Result := (Pos(SearchText, Text) > 0); + if Result then + FoundRow := R; + end; + +begin + SearchTextEdit.Enabled := False; + ColumnComboBox.Enabled := False; + CaseCheckBox.Enabled := False; + ExactCheckBox.Enabled := False; + GroupBox1.Enabled := False; + FindBtn.Enabled := False; + CancelBtn.Enabled := False; + Update; + Result := False; + with FListView do + begin + if ItemFocused = nil then + begin + ItemFocused := Items[0]; + ItemFocused.MakeVisible(False); + end; + ProgressBar1.Max := Items.Count; + ProgressBar1.Min := ItemFocused.Index; + ProgressBar1.Position := ItemFocused.Index; + ProgressBar1.Visible := True; + FindColumn := ColumnComboBox.ItemIndex - 1; + ColCount := Columns.Count; + FoundRow := -1; + IgnoreCase := CaseCheckBox.Checked; + ExactMatch := ExactCheckBox.Checked; + if IgnoreCase then + SearchText := AnsiUpperCase(SearchTextEdit.Text) + else + SearchText := SearchTextEdit.Text; + for R := ItemFocused.Index + 1 to Items.Count - 1 do + begin + if FindColumn = -1 then + for C := 0 to ColCount - 1 do + CompareColumnText(C) + else + CompareColumnText(FindColumn); + if R mod ProgressBar1.Step = 0 then + ProgressBar1.StepIt; + if FoundRow > -1 then + begin + Result := True; + if Selected <> nil then + Selected.Selected := False; + ItemFocused := Items[FoundRow]; + Selected := ItemFocused; + ItemFocused.MakeVisible(False); + Break; + end; + end; + end; + SearchTextEdit.Enabled := True; + ColumnComboBox.Enabled := True; + CaseCheckBox.Enabled := True; + ExactCheckBox.Enabled := True; + GroupBox1.Enabled := True; + ProgressBar1.Visible := False; + FindBtn.Enabled := True; + CancelBtn.Enabled := True; + SearchTextEdit.SetFocus; +end; + +procedure TFindTextForm.SetListView(const Value: TListView); +var + I: Integer; +begin + FListView := Value; + ColumnComboBox.Items.BeginUpdate; + ColumnComboBox.Items.Clear; + ColumnComboBox.Items.Add(RsAllColumns); + for I := 0 to FListView.Columns.Count - 1 do + ColumnComboBox.Items.Add(FListView.Columns[I].Caption); + ColumnComboBox.Items.EndUpdate; + ColumnComboBox.ItemIndex := 0; +end; + +procedure TFindTextForm.FindBtnClick(Sender: TObject); +begin + Find; +end; + +class function TFindTextForm.CanExecuteFind: Boolean; +var + LV: TListView; +begin + Result := (Screen.Activecontrol is TListView); + if Result then + begin + LV := TListView(Screen.Activecontrol); + Result := (LV.Items.Count > 0) and not LV.HideSelection; + end; +end; + +// History: + +// $Log: FindDlg.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/common/SHDocVw_TLB.pas b/official/1.96/examples/windows/delphitools/common/SHDocVw_TLB.pas new file mode 100644 index 0000000..5352101 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/common/SHDocVw_TLB.pas @@ -0,0 +1,1931 @@ +unit SHDocVw_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: 1.1 $ +// File generated on 12.3.2002 14:05:12 from Type Library described below. + +// ************************************************************************ // +// Type Lib: C:\WINDOWS\SYSTEM\SHDOCVW.DLL (1) +// LIBID: {EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B} +// LCID: 0 +// Helpfile: +// DepndLst: +// (1) v2.0 stdole, (C:\WINDOWS\SYSTEM\stdole2.tlb) +// (2) v4.0 StdVCL, (C:\WINDOWS\SYSTEM\stdvcl40.dll) +// Errors: +// Hint: Member 'Type' of 'IWebBrowser' changed to 'Type_' +// Hint: Parameter 'Type' of IWebBrowser.Type changed to 'Type_' +// Hint: Parameter 'Property' of DWebBrowserEvents.PropertyChange changed to 'Property_' +// Hint: Parameter 'Property' of IWebBrowserApp.PutProperty changed to 'Property_' +// Hint: Parameter 'Property' of IWebBrowserApp.GetProperty changed to 'Property_' +// Hint: Parameter 'Type' of IShellUIHelper.AddDesktopComponent changed to 'Type_' +// Hint: Parameter 'var' of IShellNameSpace.Expand changed to 'var_' +// ************************************************************************ // +{$I jcl.inc} +{$I windowsonly.inc} + +{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. +{$WRITEABLECONST ON} + +interface + +{$IFDEF DELPHI6_UP} + {$VARPROPSETTER ON} +{$ENDIF} + +uses + Windows, ActiveX, Classes, Graphics, OleCtrls, + {$IFDEF DELPHI5_UP} + OleServer, + {$ENDIF} + {$IFDEF DELPHI6_UP} + Variants, + {$ENDIF} + StdVCL; + + + +// *********************************************************************// +// 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 + SHDocVwMajorVersion = 1; + SHDocVwMinorVersion = 1; + + LIBID_SHDocVw: TGUID = '{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}'; + + IID_IWebBrowser: TGUID = '{EAB22AC1-30C1-11CF-A7EB-0000C05BAE0B}'; + DIID_DWebBrowserEvents: TGUID = '{EAB22AC2-30C1-11CF-A7EB-0000C05BAE0B}'; + IID_IWebBrowserApp: TGUID = '{0002DF05-0000-0000-C000-000000000046}'; + IID_IWebBrowser2: TGUID = '{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}'; + DIID_DWebBrowserEvents2: TGUID = '{34A715A0-6587-11D0-924A-0020AFC7AC4D}'; + CLASS_WebBrowser_V1: TGUID = '{EAB22AC3-30C1-11CF-A7EB-0000C05BAE0B}'; + CLASS_WebBrowser: TGUID = '{8856F961-340A-11D0-A96B-00C04FD705A2}'; + CLASS_InternetExplorer: TGUID = '{0002DF01-0000-0000-C000-000000000046}'; + CLASS_ShellBrowserWindow: TGUID = '{C08AFD90-F2A1-11D1-8455-00A0C91F3880}'; + DIID_DShellWindowsEvents: TGUID = '{FE4106E0-399A-11D0-A48C-00A0C90A8F39}'; + IID_IShellWindows: TGUID = '{85CB6900-4D95-11CF-960C-0080C7F4EE85}'; + CLASS_ShellWindows: TGUID = '{9BA05972-F6A8-11CF-A442-00A0C90A8F39}'; + IID_IShellUIHelper: TGUID = '{729FE2F8-1EA8-11D1-8F85-00C04FC2FBE1}'; + CLASS_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}'; + DIID_DShellNameSpaceEvents: TGUID = '{55136806-B2DE-11D1-B9F2-00A0C98BC547}'; + IID_IShellFavoritesNameSpace: TGUID = '{55136804-B2DE-11D1-B9F2-00A0C98BC547}'; + IID_IShellNameSpace: TGUID = '{E572D3C9-37BE-4AE2-825D-D521763E3108}'; + CLASS_ShellNameSpace: TGUID = '{55136805-B2DE-11D1-B9F2-00A0C98BC547}'; + IID_IScriptErrorList: TGUID = '{F3470F24-15FD-11D2-BB2E-00805FF7EFCA}'; + CLASS_CScriptErrorList: TGUID = '{EFD01300-160F-11D2-BB2E-00805FF7EFCA}'; + IID_ISearch: TGUID = '{BA9239A4-3DD5-11D2-BF8B-00C04FB93661}'; + IID_ISearches: TGUID = '{47C922A2-3DD5-11D2-BF8B-00C04FB93661}'; + IID_ISearchAssistantOC: TGUID = '{72423E8F-8011-11D2-BE79-00A0C9A83DA1}'; + IID_ISearchAssistantOC2: TGUID = '{72423E8F-8011-11D2-BE79-00A0C9A83DA2}'; + DIID__SearchAssistantEvents: TGUID = '{1611FDDA-445B-11D2-85DE-00C04FA35C89}'; + CLASS_SearchAssistantOC: TGUID = '{B45FF030-4447-11D2-85DE-00C04FA35C89}'; + +// *********************************************************************// +// Declaration of Enumerations defined in Type Library +// *********************************************************************// +// Constants for enum CommandStateChangeConstants +type + CommandStateChangeConstants = TOleEnum; +const + CSC_UPDATECOMMANDS = $FFFFFFFF; + CSC_NAVIGATEFORWARD = $00000001; + CSC_NAVIGATEBACK = $00000002; + +// Constants for enum OLECMDID +type + OLECMDID = TOleEnum; +const + OLECMDID_OPEN = $00000001; + OLECMDID_NEW = $00000002; + OLECMDID_SAVE = $00000003; + OLECMDID_SAVEAS = $00000004; + OLECMDID_SAVECOPYAS = $00000005; + OLECMDID_PRINT = $00000006; + OLECMDID_PRINTPREVIEW = $00000007; + OLECMDID_PAGESETUP = $00000008; + OLECMDID_SPELL = $00000009; + OLECMDID_PROPERTIES = $0000000A; + OLECMDID_CUT = $0000000B; + OLECMDID_COPY = $0000000C; + OLECMDID_PASTE = $0000000D; + OLECMDID_PASTESPECIAL = $0000000E; + OLECMDID_UNDO = $0000000F; + OLECMDID_REDO = $00000010; + OLECMDID_SELECTALL = $00000011; + OLECMDID_CLEARSELECTION = $00000012; + OLECMDID_ZOOM = $00000013; + OLECMDID_GETZOOMRANGE = $00000014; + OLECMDID_UPDATECOMMANDS = $00000015; + OLECMDID_REFRESH = $00000016; + OLECMDID_STOP = $00000017; + OLECMDID_HIDETOOLBARS = $00000018; + OLECMDID_SETPROGRESSMAX = $00000019; + OLECMDID_SETPROGRESSPOS = $0000001A; + OLECMDID_SETPROGRESSTEXT = $0000001B; + OLECMDID_SETTITLE = $0000001C; + OLECMDID_SETDOWNLOADSTATE = $0000001D; + OLECMDID_STOPDOWNLOAD = $0000001E; + OLECMDID_ONTOOLBARACTIVATED = $0000001F; + OLECMDID_FIND = $00000020; + OLECMDID_DELETE = $00000021; + OLECMDID_HTTPEQUIV = $00000022; + OLECMDID_HTTPEQUIV_DONE = $00000023; + OLECMDID_ENABLE_INTERACTION = $00000024; + OLECMDID_ONUNLOAD = $00000025; + OLECMDID_PROPERTYBAG2 = $00000026; + OLECMDID_PREREFRESH = $00000027; + OLECMDID_SHOWSCRIPTERROR = $00000028; + OLECMDID_SHOWMESSAGE = $00000029; + OLECMDID_SHOWFIND = $0000002A; + OLECMDID_SHOWPAGESETUP = $0000002B; + OLECMDID_SHOWPRINT = $0000002C; + OLECMDID_CLOSE = $0000002D; + OLECMDID_ALLOWUILESSSAVEAS = $0000002E; + OLECMDID_DONTDOWNLOADCSS = $0000002F; + OLECMDID_UPDATEPAGESTATUS = $00000030; + +// Constants for enum OLECMDF +type + OLECMDF = TOleEnum; +const + OLECMDF_SUPPORTED = $00000001; + OLECMDF_ENABLED = $00000002; + OLECMDF_LATCHED = $00000004; + OLECMDF_NINCHED = $00000008; + OLECMDF_INVISIBLE = $00000010; + OLECMDF_DEFHIDEONCTXTMENU = $00000020; + +// Constants for enum OLECMDEXECOPT +type + OLECMDEXECOPT = TOleEnum; +const + OLECMDEXECOPT_DODEFAULT = $00000000; + OLECMDEXECOPT_PROMPTUSER = $00000001; + OLECMDEXECOPT_DONTPROMPTUSER = $00000002; + OLECMDEXECOPT_SHOWHELP = $00000003; + +// Constants for enum tagREADYSTATE +type + tagREADYSTATE = TOleEnum; +const + READYSTATE_UNINITIALIZED = $00000000; + READYSTATE_LOADING = $00000001; + READYSTATE_LOADED = $00000002; + READYSTATE_INTERACTIVE = $00000003; + READYSTATE_COMPLETE = $00000004; + +// Constants for enum SecureLockIconConstants +type + SecureLockIconConstants = TOleEnum; +const + secureLockIconUnsecure = $00000000; + secureLockIconMixed = $00000001; + secureLockIconSecureUnknownBits = $00000002; + secureLockIconSecure40Bit = $00000003; + secureLockIconSecure56Bit = $00000004; + secureLockIconSecureFortezza = $00000005; + secureLockIconSecure128Bit = $00000006; + +// Constants for enum ShellWindowTypeConstants +type + ShellWindowTypeConstants = TOleEnum; +const + SWC_EXPLORER = $00000000; + SWC_BROWSER = $00000001; + SWC_3RDPARTY = $00000002; + SWC_CALLBACK = $00000004; + +// Constants for enum ShellWindowFindWindowOptions +type + ShellWindowFindWindowOptions = TOleEnum; +const + SWFO_NEEDDISPATCH = $00000001; + SWFO_INCLUDEPENDING = $00000002; + SWFO_COOKIEPASSED = $00000004; + +type + +// *********************************************************************// +// Forward declaration of types defined in TypeLibrary +// *********************************************************************// + IWebBrowser = interface; + IWebBrowserDisp = dispinterface; + DWebBrowserEvents = dispinterface; + IWebBrowserApp = interface; + IWebBrowserAppDisp = dispinterface; + IWebBrowser2 = interface; + IWebBrowser2Disp = dispinterface; + DWebBrowserEvents2 = dispinterface; + DShellWindowsEvents = dispinterface; + IShellWindows = interface; + IShellWindowsDisp = dispinterface; + IShellUIHelper = interface; + IShellUIHelperDisp = dispinterface; + DShellNameSpaceEvents = dispinterface; + IShellFavoritesNameSpace = interface; + IShellFavoritesNameSpaceDisp = dispinterface; + IShellNameSpace = interface; + IShellNameSpaceDisp = dispinterface; + IScriptErrorList = interface; + IScriptErrorListDisp = dispinterface; + ISearch = interface; + ISearchDisp = dispinterface; + ISearches = interface; + ISearchesDisp = dispinterface; + ISearchAssistantOC = interface; + ISearchAssistantOCDisp = dispinterface; + ISearchAssistantOC2 = interface; + ISearchAssistantOC2Disp = dispinterface; + _SearchAssistantEvents = dispinterface; + +// *********************************************************************// +// Declaration of CoClasses defined in Type Library +// (NOTE: Here we map each CoClass to its Default Interface) +// *********************************************************************// + WebBrowser_V1 = IWebBrowser; + WebBrowser = IWebBrowser2; + InternetExplorer = IWebBrowser2; + ShellBrowserWindow = IWebBrowser2; + ShellWindows = IShellWindows; + ShellUIHelper = IShellUIHelper; + ShellNameSpace = IShellNameSpace; + CScriptErrorList = IScriptErrorList; + SearchAssistantOC = ISearchAssistantOC2; + + +// *********************************************************************// +// Declaration of structures, unions and aliases. +// *********************************************************************// + POleVariant1 = ^OleVariant; {*} + + +// *********************************************************************// +// Interface: IWebBrowser +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EAB22AC1-30C1-11CF-A7EB-0000C05BAE0B} +// *********************************************************************// + IWebBrowser = interface(IDispatch) + ['{EAB22AC1-30C1-11CF-A7EB-0000C05BAE0B}'] + procedure GoBack; safecall; + procedure GoForward; safecall; + procedure GoHome; safecall; + procedure GoSearch; safecall; + procedure Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); safecall; + procedure Refresh; safecall; + procedure Refresh2(var Level: OleVariant); safecall; + procedure Stop; safecall; + function Get_Application: IDispatch; safecall; + function Get_Parent: IDispatch; safecall; + function Get_Container: IDispatch; safecall; + function Get_Document: IDispatch; safecall; + function Get_TopLevelContainer: WordBool; safecall; + function Get_Type_: WideString; safecall; + function Get_Left: Integer; safecall; + procedure Set_Left(pl: Integer); safecall; + function Get_Top: Integer; safecall; + procedure Set_Top(pl: Integer); safecall; + function Get_Width: Integer; safecall; + procedure Set_Width(pl: Integer); safecall; + function Get_Height: Integer; safecall; + procedure Set_Height(pl: Integer); safecall; + function Get_LocationName: WideString; safecall; + function Get_LocationURL: WideString; safecall; + function Get_Busy: WordBool; safecall; + property Application: IDispatch read Get_Application; + property Parent: IDispatch read Get_Parent; + property Container: IDispatch read Get_Container; + property Document: IDispatch read Get_Document; + property TopLevelContainer: WordBool read Get_TopLevelContainer; + property Type_: WideString read Get_Type_; + property Left: Integer read Get_Left write Set_Left; + property Top: Integer read Get_Top write Set_Top; + property Width: Integer read Get_Width write Set_Width; + property Height: Integer read Get_Height write Set_Height; + property LocationName: WideString read Get_LocationName; + property LocationURL: WideString read Get_LocationURL; + property Busy: WordBool read Get_Busy; + end; + +// *********************************************************************// +// DispIntf: IWebBrowserDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {EAB22AC1-30C1-11CF-A7EB-0000C05BAE0B} +// *********************************************************************// + IWebBrowserDisp = dispinterface + ['{EAB22AC1-30C1-11CF-A7EB-0000C05BAE0B}'] + procedure GoBack; dispid 100; + procedure GoForward; dispid 101; + procedure GoHome; dispid 102; + procedure GoSearch; dispid 103; + procedure Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); dispid 104; + procedure Refresh; dispid -550; + procedure Refresh2(var Level: OleVariant); dispid 105; + procedure Stop; dispid 106; + property Application: IDispatch readonly dispid 200; + property Parent: IDispatch readonly dispid 201; + property Container: IDispatch readonly dispid 202; + property Document: IDispatch readonly dispid 203; + property TopLevelContainer: WordBool readonly dispid 204; + property Type_: WideString readonly dispid 205; + property Left: Integer dispid 206; + property Top: Integer dispid 207; + property Width: Integer dispid 208; + property Height: Integer dispid 209; + property LocationName: WideString readonly dispid 210; + property LocationURL: WideString readonly dispid 211; + property Busy: WordBool readonly dispid 212; + end; + +// *********************************************************************// +// DispIntf: DWebBrowserEvents +// Flags: (4112) Hidden Dispatchable +// GUID: {EAB22AC2-30C1-11CF-A7EB-0000C05BAE0B} +// *********************************************************************// + DWebBrowserEvents = dispinterface + ['{EAB22AC2-30C1-11CF-A7EB-0000C05BAE0B}'] + procedure BeforeNavigate(const URL: WideString; Flags: Integer; + const TargetFrameName: WideString; var PostData: OleVariant; + const Headers: WideString; var Cancel: WordBool); dispid 100; + procedure NavigateComplete(const URL: WideString); dispid 101; + procedure StatusTextChange(const Text: WideString); dispid 102; + procedure ProgressChange(Progress: Integer; ProgressMax: Integer); dispid 108; + procedure DownloadComplete; dispid 104; + procedure CommandStateChange(Command: Integer; Enable: WordBool); dispid 105; + procedure DownloadBegin; dispid 106; + procedure NewWindow(const URL: WideString; Flags: Integer; const TargetFrameName: WideString; + var PostData: OleVariant; const Headers: WideString; var Processed: WordBool); dispid 107; + procedure TitleChange(const Text: WideString); dispid 113; + procedure FrameBeforeNavigate(const URL: WideString; Flags: Integer; + const TargetFrameName: WideString; var PostData: OleVariant; + const Headers: WideString; var Cancel: WordBool); dispid 200; + procedure FrameNavigateComplete(const URL: WideString); dispid 201; + procedure FrameNewWindow(const URL: WideString; Flags: Integer; + const TargetFrameName: WideString; var PostData: OleVariant; + const Headers: WideString; var Processed: WordBool); dispid 204; + procedure Quit(var Cancel: WordBool); dispid 103; + procedure WindowMove; dispid 109; + procedure WindowResize; dispid 110; + procedure WindowActivate; dispid 111; + procedure PropertyChange(const Property_: WideString); dispid 112; + end; + +// *********************************************************************// +// Interface: IWebBrowserApp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0002DF05-0000-0000-C000-000000000046} +// *********************************************************************// + IWebBrowserApp = interface(IWebBrowser) + ['{0002DF05-0000-0000-C000-000000000046}'] + procedure Quit; safecall; + procedure ClientToWindow(var pcx: SYSINT; var pcy: SYSINT); safecall; + procedure PutProperty(const Property_: WideString; vtValue: OleVariant); safecall; + function GetProperty(const Property_: WideString): OleVariant; safecall; + function Get_Name: WideString; safecall; + function Get_HWND: Integer; safecall; + function Get_FullName: WideString; safecall; + function Get_Path: WideString; safecall; + function Get_Visible: WordBool; safecall; + procedure Set_Visible(pBool: WordBool); safecall; + function Get_StatusBar: WordBool; safecall; + procedure Set_StatusBar(pBool: WordBool); safecall; + function Get_StatusText: WideString; safecall; + procedure Set_StatusText(const StatusText: WideString); safecall; + function Get_ToolBar: SYSINT; safecall; + procedure Set_ToolBar(Value: SYSINT); safecall; + function Get_MenuBar: WordBool; safecall; + procedure Set_MenuBar(Value: WordBool); safecall; + function Get_FullScreen: WordBool; safecall; + procedure Set_FullScreen(pbFullScreen: WordBool); safecall; + property Name: WideString read Get_Name; + property HWND: Integer read Get_HWND; + property FullName: WideString read Get_FullName; + property Path: WideString read Get_Path; + property Visible: WordBool read Get_Visible write Set_Visible; + property StatusBar: WordBool read Get_StatusBar write Set_StatusBar; + property StatusText: WideString read Get_StatusText write Set_StatusText; + property ToolBar: SYSINT read Get_ToolBar write Set_ToolBar; + property MenuBar: WordBool read Get_MenuBar write Set_MenuBar; + property FullScreen: WordBool read Get_FullScreen write Set_FullScreen; + end; + +// *********************************************************************// +// DispIntf: IWebBrowserAppDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {0002DF05-0000-0000-C000-000000000046} +// *********************************************************************// + IWebBrowserAppDisp = dispinterface + ['{0002DF05-0000-0000-C000-000000000046}'] + procedure Quit; dispid 300; + procedure ClientToWindow(var pcx: SYSINT; var pcy: SYSINT); dispid 301; + procedure PutProperty(const Property_: WideString; vtValue: OleVariant); dispid 302; + function GetProperty(const Property_: WideString): OleVariant; dispid 303; + property Name: WideString readonly dispid 0; + property HWND: Integer readonly dispid -515; + property FullName: WideString readonly dispid 400; + property Path: WideString readonly dispid 401; + property Visible: WordBool dispid 402; + property StatusBar: WordBool dispid 403; + property StatusText: WideString dispid 404; + property ToolBar: SYSINT dispid 405; + property MenuBar: WordBool dispid 406; + property FullScreen: WordBool dispid 407; + procedure GoBack; dispid 100; + procedure GoForward; dispid 101; + procedure GoHome; dispid 102; + procedure GoSearch; dispid 103; + procedure Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); dispid 104; + procedure Refresh; dispid -550; + procedure Refresh2(var Level: OleVariant); dispid 105; + procedure Stop; dispid 106; + property Application: IDispatch readonly dispid 200; + property Parent: IDispatch readonly dispid 201; + property Container: IDispatch readonly dispid 202; + property Document: IDispatch readonly dispid 203; + property TopLevelContainer: WordBool readonly dispid 204; + property Type_: WideString readonly dispid 205; + property Left: Integer dispid 206; + property Top: Integer dispid 207; + property Width: Integer dispid 208; + property Height: Integer dispid 209; + property LocationName: WideString readonly dispid 210; + property LocationURL: WideString readonly dispid 211; + property Busy: WordBool readonly dispid 212; + end; + +// *********************************************************************// +// Interface: IWebBrowser2 +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D30C1661-CDAF-11D0-8A3E-00C04FC9E26E} +// *********************************************************************// + IWebBrowser2 = interface(IWebBrowserApp) + ['{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}'] + procedure Navigate2(var URL: OleVariant; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); safecall; + function QueryStatusWB(cmdID: OLECMDID): OLECMDF; safecall; + procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn: OleVariant; + var pvaOut: OleVariant); safecall; + procedure ShowBrowserBar(var pvaClsid: OleVariant; var pvarShow: OleVariant; + var pvarSize: OleVariant); safecall; + function Get_ReadyState: tagREADYSTATE; safecall; + function Get_Offline: WordBool; safecall; + procedure Set_Offline(pbOffline: WordBool); safecall; + function Get_Silent: WordBool; safecall; + procedure Set_Silent(pbSilent: WordBool); safecall; + function Get_RegisterAsBrowser: WordBool; safecall; + procedure Set_RegisterAsBrowser(pbRegister: WordBool); safecall; + function Get_RegisterAsDropTarget: WordBool; safecall; + procedure Set_RegisterAsDropTarget(pbRegister: WordBool); safecall; + function Get_TheaterMode: WordBool; safecall; + procedure Set_TheaterMode(pbRegister: WordBool); safecall; + function Get_AddressBar: WordBool; safecall; + procedure Set_AddressBar(Value: WordBool); safecall; + function Get_Resizable: WordBool; safecall; + procedure Set_Resizable(Value: WordBool); safecall; + property ReadyState: tagREADYSTATE read Get_ReadyState; + property Offline: WordBool read Get_Offline write Set_Offline; + property Silent: WordBool read Get_Silent write Set_Silent; + property RegisterAsBrowser: WordBool read Get_RegisterAsBrowser write Set_RegisterAsBrowser; + property RegisterAsDropTarget: WordBool read Get_RegisterAsDropTarget write Set_RegisterAsDropTarget; + property TheaterMode: WordBool read Get_TheaterMode write Set_TheaterMode; + property AddressBar: WordBool read Get_AddressBar write Set_AddressBar; + property Resizable: WordBool read Get_Resizable write Set_Resizable; + end; + +// *********************************************************************// +// DispIntf: IWebBrowser2Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {D30C1661-CDAF-11D0-8A3E-00C04FC9E26E} +// *********************************************************************// + IWebBrowser2Disp = dispinterface + ['{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}'] + procedure Navigate2(var URL: OleVariant; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); dispid 500; + function QueryStatusWB(cmdID: OLECMDID): OLECMDF; dispid 501; + procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn: OleVariant; + var pvaOut: OleVariant); dispid 502; + procedure ShowBrowserBar(var pvaClsid: OleVariant; var pvarShow: OleVariant; + var pvarSize: OleVariant); dispid 503; + property ReadyState: tagREADYSTATE readonly dispid -525; + property Offline: WordBool dispid 550; + property Silent: WordBool dispid 551; + property RegisterAsBrowser: WordBool dispid 552; + property RegisterAsDropTarget: WordBool dispid 553; + property TheaterMode: WordBool dispid 554; + property AddressBar: WordBool dispid 555; + property Resizable: WordBool dispid 556; + procedure Quit; dispid 300; + procedure ClientToWindow(var pcx: SYSINT; var pcy: SYSINT); dispid 301; + procedure PutProperty(const Property_: WideString; vtValue: OleVariant); dispid 302; + function GetProperty(const Property_: WideString): OleVariant; dispid 303; + property Name: WideString readonly dispid 0; + property HWND: Integer readonly dispid -515; + property FullName: WideString readonly dispid 400; + property Path: WideString readonly dispid 401; + property Visible: WordBool dispid 402; + property StatusBar: WordBool dispid 403; + property StatusText: WideString dispid 404; + property ToolBar: SYSINT dispid 405; + property MenuBar: WordBool dispid 406; + property FullScreen: WordBool dispid 407; + procedure GoBack; dispid 100; + procedure GoForward; dispid 101; + procedure GoHome; dispid 102; + procedure GoSearch; dispid 103; + procedure Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); dispid 104; + procedure Refresh; dispid -550; + procedure Refresh2(var Level: OleVariant); dispid 105; + procedure Stop; dispid 106; + property Application: IDispatch readonly dispid 200; + property Parent: IDispatch readonly dispid 201; + property Container: IDispatch readonly dispid 202; + property Document: IDispatch readonly dispid 203; + property TopLevelContainer: WordBool readonly dispid 204; + property Type_: WideString readonly dispid 205; + property Left: Integer dispid 206; + property Top: Integer dispid 207; + property Width: Integer dispid 208; + property Height: Integer dispid 209; + property LocationName: WideString readonly dispid 210; + property LocationURL: WideString readonly dispid 211; + property Busy: WordBool readonly dispid 212; + end; + +// *********************************************************************// +// DispIntf: DWebBrowserEvents2 +// Flags: (4112) Hidden Dispatchable +// GUID: {34A715A0-6587-11D0-924A-0020AFC7AC4D} +// *********************************************************************// + DWebBrowserEvents2 = dispinterface + ['{34A715A0-6587-11D0-924A-0020AFC7AC4D}'] + procedure StatusTextChange(const Text: WideString); dispid 102; + procedure ProgressChange(Progress: Integer; ProgressMax: Integer); dispid 108; + procedure CommandStateChange(Command: Integer; Enable: WordBool); dispid 105; + procedure DownloadBegin; dispid 106; + procedure DownloadComplete; dispid 104; + procedure TitleChange(const Text: WideString); dispid 113; + procedure PropertyChange(const szProperty: WideString); dispid 112; + procedure BeforeNavigate2(const pDisp: IDispatch; var URL: OleVariant; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant; var Cancel: WordBool); dispid 250; + procedure NewWindow2(var ppDisp: IDispatch; var Cancel: WordBool); dispid 251; + procedure NavigateComplete2(const pDisp: IDispatch; var URL: OleVariant); dispid 252; + procedure DocumentComplete(const pDisp: IDispatch; var URL: OleVariant); dispid 259; + procedure OnQuit; dispid 253; + procedure OnVisible(Visible: WordBool); dispid 254; + procedure OnToolBar(ToolBar: WordBool); dispid 255; + procedure OnMenuBar(MenuBar: WordBool); dispid 256; + procedure OnStatusBar(StatusBar: WordBool); dispid 257; + procedure OnFullScreen(FullScreen: WordBool); dispid 258; + procedure OnTheaterMode(TheaterMode: WordBool); dispid 260; + procedure WindowSetResizable(Resizable: WordBool); dispid 262; + procedure WindowSetLeft(Left: Integer); dispid 264; + procedure WindowSetTop(Top: Integer); dispid 265; + procedure WindowSetWidth(Width: Integer); dispid 266; + procedure WindowSetHeight(Height: Integer); dispid 267; + procedure WindowClosing(IsChildWindow: WordBool; var Cancel: WordBool); dispid 263; + procedure ClientToHostWindow(var CX: Integer; var CY: Integer); dispid 268; + procedure SetSecureLockIcon(SecureLockIcon: Integer); dispid 269; + procedure FileDownload(var Cancel: WordBool); dispid 270; + end; + +// *********************************************************************// +// DispIntf: DShellWindowsEvents +// Flags: (4096) Dispatchable +// GUID: {FE4106E0-399A-11D0-A48C-00A0C90A8F39} +// *********************************************************************// + DShellWindowsEvents = dispinterface + ['{FE4106E0-399A-11D0-A48C-00A0C90A8F39}'] + procedure WindowRegistered(lCookie: Integer); dispid 200; + procedure WindowRevoked(lCookie: Integer); dispid 201; + end; + +// *********************************************************************// +// Interface: IShellWindows +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {85CB6900-4D95-11CF-960C-0080C7F4EE85} +// *********************************************************************// + IShellWindows = interface(IDispatch) + ['{85CB6900-4D95-11CF-960C-0080C7F4EE85}'] + function Get_Count: Integer; safecall; + function Item(index: OleVariant): IDispatch; safecall; + function _NewEnum: IUnknown; safecall; + procedure Register(const pid: IDispatch; HWND: Integer; swClass: SYSINT; out plCookie: Integer); safecall; + procedure RegisterPending(lThreadId: Integer; var pvarloc: OleVariant; + var pvarlocRoot: OleVariant; swClass: SYSINT; out plCookie: Integer); safecall; + procedure Revoke(lCookie: Integer); safecall; + procedure OnNavigate(lCookie: Integer; var pvarloc: OleVariant); safecall; + procedure OnActivated(lCookie: Integer; fActive: WordBool); safecall; + function FindWindowSW(var pvarloc: OleVariant; var pvarlocRoot: OleVariant; swClass: SYSINT; + out pHWND: Integer; swfwOptions: SYSINT): IDispatch; safecall; + procedure OnCreated(lCookie: Integer; const punk: IUnknown); safecall; + procedure ProcessAttachDetach(fAttach: WordBool); safecall; + property Count: Integer read Get_Count; + end; + +// *********************************************************************// +// DispIntf: IShellWindowsDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {85CB6900-4D95-11CF-960C-0080C7F4EE85} +// *********************************************************************// + IShellWindowsDisp = dispinterface + ['{85CB6900-4D95-11CF-960C-0080C7F4EE85}'] + property Count: Integer readonly dispid 1610743808; + function Item(index: OleVariant): IDispatch; dispid 0; + function _NewEnum: IUnknown; dispid -4; + procedure Register(const pid: IDispatch; HWND: Integer; swClass: SYSINT; out plCookie: Integer); dispid 1610743811; + procedure RegisterPending(lThreadId: Integer; var pvarloc: OleVariant; + var pvarlocRoot: OleVariant; swClass: SYSINT; out plCookie: Integer); dispid 1610743812; + procedure Revoke(lCookie: Integer); dispid 1610743813; + procedure OnNavigate(lCookie: Integer; var pvarloc: OleVariant); dispid 1610743814; + procedure OnActivated(lCookie: Integer; fActive: WordBool); dispid 1610743815; + function FindWindowSW(var pvarloc: OleVariant; var pvarlocRoot: OleVariant; swClass: SYSINT; + out pHWND: Integer; swfwOptions: SYSINT): IDispatch; dispid 1610743816; + procedure OnCreated(lCookie: Integer; const punk: IUnknown); dispid 1610743817; + procedure ProcessAttachDetach(fAttach: WordBool); dispid 1610743818; + end; + +// *********************************************************************// +// Interface: IShellUIHelper +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {729FE2F8-1EA8-11D1-8F85-00C04FC2FBE1} +// *********************************************************************// + IShellUIHelper = interface(IDispatch) + ['{729FE2F8-1EA8-11D1-8F85-00C04FC2FBE1}'] + procedure ResetFirstBootMode; safecall; + procedure ResetSafeMode; safecall; + procedure RefreshOfflineDesktop; safecall; + procedure AddFavorite(const URL: WideString; var Title: OleVariant); safecall; + procedure AddChannel(const URL: WideString); safecall; + procedure AddDesktopComponent(const URL: WideString; const Type_: WideString; + var Left: OleVariant; var Top: OleVariant; var Width: OleVariant; + var Height: OleVariant); safecall; + function IsSubscribed(const URL: WideString): WordBool; safecall; + procedure NavigateAndFind(const URL: WideString; const strQuery: WideString; + var varTargetFrame: OleVariant); safecall; + procedure ImportExportFavorites(fImport: WordBool; const strImpExpPath: WideString); safecall; + procedure AutoCompleteSaveForm(var Form: OleVariant); safecall; + procedure AutoScan(const strSearch: WideString; const strFailureUrl: WideString; + var pvarTargetFrame: OleVariant); safecall; + procedure AutoCompleteAttach(var Reserved: OleVariant); safecall; + function ShowBrowserUI(const bstrName: WideString; var pvarIn: OleVariant): OleVariant; safecall; + end; + +// *********************************************************************// +// DispIntf: IShellUIHelperDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {729FE2F8-1EA8-11D1-8F85-00C04FC2FBE1} +// *********************************************************************// + IShellUIHelperDisp = dispinterface + ['{729FE2F8-1EA8-11D1-8F85-00C04FC2FBE1}'] + procedure ResetFirstBootMode; dispid 1; + procedure ResetSafeMode; dispid 2; + procedure RefreshOfflineDesktop; dispid 3; + procedure AddFavorite(const URL: WideString; var Title: OleVariant); dispid 4; + procedure AddChannel(const URL: WideString); dispid 5; + procedure AddDesktopComponent(const URL: WideString; const Type_: WideString; + var Left: OleVariant; var Top: OleVariant; var Width: OleVariant; + var Height: OleVariant); dispid 6; + function IsSubscribed(const URL: WideString): WordBool; dispid 7; + procedure NavigateAndFind(const URL: WideString; const strQuery: WideString; + var varTargetFrame: OleVariant); dispid 8; + procedure ImportExportFavorites(fImport: WordBool; const strImpExpPath: WideString); dispid 9; + procedure AutoCompleteSaveForm(var Form: OleVariant); dispid 10; + procedure AutoScan(const strSearch: WideString; const strFailureUrl: WideString; + var pvarTargetFrame: OleVariant); dispid 11; + procedure AutoCompleteAttach(var Reserved: OleVariant); dispid 12; + function ShowBrowserUI(const bstrName: WideString; var pvarIn: OleVariant): OleVariant; dispid 13; + end; + +// *********************************************************************// +// DispIntf: DShellNameSpaceEvents +// Flags: (4096) Dispatchable +// GUID: {55136806-B2DE-11D1-B9F2-00A0C98BC547} +// *********************************************************************// + DShellNameSpaceEvents = dispinterface + ['{55136806-B2DE-11D1-B9F2-00A0C98BC547}'] + procedure FavoritesSelectionChange(cItems: Integer; hItem: Integer; const strName: WideString; + const strUrl: WideString; cVisits: Integer; + const strDate: WideString; fAvailableOffline: Integer); dispid 1; + procedure SelectionChange; dispid 2; + procedure DoubleClick; dispid 3; + procedure Initialized; dispid 4; + end; + +// *********************************************************************// +// Interface: IShellFavoritesNameSpace +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {55136804-B2DE-11D1-B9F2-00A0C98BC547} +// *********************************************************************// + IShellFavoritesNameSpace = interface(IDispatch) + ['{55136804-B2DE-11D1-B9F2-00A0C98BC547}'] + procedure MoveSelectionUp; safecall; + procedure MoveSelectionDown; safecall; + procedure ResetSort; safecall; + procedure NewFolder; safecall; + procedure Synchronize; safecall; + procedure Import; safecall; + procedure Export; safecall; + procedure InvokeContextMenuCommand(const strCommand: WideString); safecall; + procedure MoveSelectionTo; safecall; + function Get_SubscriptionsEnabled: WordBool; safecall; + function CreateSubscriptionForSelection: WordBool; safecall; + function DeleteSubscriptionForSelection: WordBool; safecall; + procedure SetRoot(const bstrFullPath: WideString); safecall; + property SubscriptionsEnabled: WordBool read Get_SubscriptionsEnabled; + end; + +// *********************************************************************// +// DispIntf: IShellFavoritesNameSpaceDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {55136804-B2DE-11D1-B9F2-00A0C98BC547} +// *********************************************************************// + IShellFavoritesNameSpaceDisp = dispinterface + ['{55136804-B2DE-11D1-B9F2-00A0C98BC547}'] + procedure MoveSelectionUp; dispid 1; + procedure MoveSelectionDown; dispid 2; + procedure ResetSort; dispid 3; + procedure NewFolder; dispid 4; + procedure Synchronize; dispid 5; + procedure Import; dispid 6; + procedure Export; dispid 7; + procedure InvokeContextMenuCommand(const strCommand: WideString); dispid 8; + procedure MoveSelectionTo; dispid 9; + property SubscriptionsEnabled: WordBool readonly dispid 10; + function CreateSubscriptionForSelection: WordBool; dispid 11; + function DeleteSubscriptionForSelection: WordBool; dispid 12; + procedure SetRoot(const bstrFullPath: WideString); dispid 13; + end; + +// *********************************************************************// +// Interface: IShellNameSpace +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E572D3C9-37BE-4AE2-825D-D521763E3108} +// *********************************************************************// + IShellNameSpace = interface(IShellFavoritesNameSpace) + ['{E572D3C9-37BE-4AE2-825D-D521763E3108}'] + function Get_EnumOptions: Integer; safecall; + procedure Set_EnumOptions(pgrfEnumFlags: Integer); safecall; + function Get_SelectedItem: IDispatch; safecall; + procedure Set_SelectedItem(const pItem: IDispatch); safecall; + function Get_Root: OleVariant; safecall; + procedure Set_Root(pvar: OleVariant); safecall; + function Get_Depth: SYSINT; safecall; + procedure Set_Depth(piDepth: SYSINT); safecall; + function Get_Mode: SYSUINT; safecall; + procedure Set_Mode(puMode: SYSUINT); safecall; + function Get_Flags: LongWord; safecall; + procedure Set_Flags(pdwFlags: LongWord); safecall; + procedure Set_TVFlags(dwFlags: LongWord); safecall; + function Get_TVFlags: LongWord; safecall; + function Get_Columns: WideString; safecall; + procedure Set_Columns(const bstrColumns: WideString); safecall; + function Get_CountViewTypes: SYSINT; safecall; + procedure SetViewType(iType: SYSINT); safecall; + function SelectedItems: IDispatch; safecall; + procedure Expand(var_: OleVariant; iDepth: SYSINT); safecall; + procedure UnselectAll; safecall; + property EnumOptions: Integer read Get_EnumOptions write Set_EnumOptions; + property SelectedItem: IDispatch read Get_SelectedItem write Set_SelectedItem; + property Root: OleVariant read Get_Root write Set_Root; + property Depth: SYSINT read Get_Depth write Set_Depth; + property Mode: SYSUINT read Get_Mode write Set_Mode; + property Flags: LongWord read Get_Flags write Set_Flags; + property TVFlags: LongWord read Get_TVFlags write Set_TVFlags; + property Columns: WideString read Get_Columns write Set_Columns; + property CountViewTypes: SYSINT read Get_CountViewTypes; + end; + +// *********************************************************************// +// DispIntf: IShellNameSpaceDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E572D3C9-37BE-4AE2-825D-D521763E3108} +// *********************************************************************// + IShellNameSpaceDisp = dispinterface + ['{E572D3C9-37BE-4AE2-825D-D521763E3108}'] + property EnumOptions: Integer dispid 14; + property SelectedItem: IDispatch dispid 15; + property Root: OleVariant dispid 16; + property Depth: SYSINT dispid 17; + property Mode: SYSUINT dispid 18; + property Flags: LongWord dispid 19; + property TVFlags: LongWord dispid 20; + property Columns: WideString dispid 21; + property CountViewTypes: SYSINT readonly dispid 22; + procedure SetViewType(iType: SYSINT); dispid 23; + function SelectedItems: IDispatch; dispid 24; + procedure Expand(var_: OleVariant; iDepth: SYSINT); dispid 25; + procedure UnselectAll; dispid 26; + procedure MoveSelectionUp; dispid 1; + procedure MoveSelectionDown; dispid 2; + procedure ResetSort; dispid 3; + procedure NewFolder; dispid 4; + procedure Synchronize; dispid 5; + procedure Import; dispid 6; + procedure Export; dispid 7; + procedure InvokeContextMenuCommand(const strCommand: WideString); dispid 8; + procedure MoveSelectionTo; dispid 9; + property SubscriptionsEnabled: WordBool readonly dispid 10; + function CreateSubscriptionForSelection: WordBool; dispid 11; + function DeleteSubscriptionForSelection: WordBool; dispid 12; + procedure SetRoot(const bstrFullPath: WideString); dispid 13; + end; + +// *********************************************************************// +// Interface: IScriptErrorList +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F3470F24-15FD-11D2-BB2E-00805FF7EFCA} +// *********************************************************************// + IScriptErrorList = interface(IDispatch) + ['{F3470F24-15FD-11D2-BB2E-00805FF7EFCA}'] + procedure advanceError; safecall; + procedure retreatError; safecall; + function canAdvanceError: Integer; safecall; + function canRetreatError: Integer; safecall; + function getErrorLine: Integer; safecall; + function getErrorChar: Integer; safecall; + function getErrorCode: Integer; safecall; + function getErrorMsg: WideString; safecall; + function getErrorUrl: WideString; safecall; + function getAlwaysShowLockState: Integer; safecall; + function getDetailsPaneOpen: Integer; safecall; + procedure setDetailsPaneOpen(fDetailsPaneOpen: Integer); safecall; + function getPerErrorDisplay: Integer; safecall; + procedure setPerErrorDisplay(fPerErrorDisplay: Integer); safecall; + end; + +// *********************************************************************// +// DispIntf: IScriptErrorListDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {F3470F24-15FD-11D2-BB2E-00805FF7EFCA} +// *********************************************************************// + IScriptErrorListDisp = dispinterface + ['{F3470F24-15FD-11D2-BB2E-00805FF7EFCA}'] + procedure advanceError; dispid 10; + procedure retreatError; dispid 11; + function canAdvanceError: Integer; dispid 12; + function canRetreatError: Integer; dispid 13; + function getErrorLine: Integer; dispid 14; + function getErrorChar: Integer; dispid 15; + function getErrorCode: Integer; dispid 16; + function getErrorMsg: WideString; dispid 17; + function getErrorUrl: WideString; dispid 18; + function getAlwaysShowLockState: Integer; dispid 23; + function getDetailsPaneOpen: Integer; dispid 19; + procedure setDetailsPaneOpen(fDetailsPaneOpen: Integer); dispid 20; + function getPerErrorDisplay: Integer; dispid 21; + procedure setPerErrorDisplay(fPerErrorDisplay: Integer); dispid 22; + end; + +// *********************************************************************// +// Interface: ISearch +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BA9239A4-3DD5-11D2-BF8B-00C04FB93661} +// *********************************************************************// + ISearch = interface(IDispatch) + ['{BA9239A4-3DD5-11D2-BF8B-00C04FB93661}'] + function Get_Title: WideString; safecall; + function Get_Id: WideString; safecall; + function Get_URL: WideString; safecall; + property Title: WideString read Get_Title; + property Id: WideString read Get_Id; + property URL: WideString read Get_URL; + end; + +// *********************************************************************// +// DispIntf: ISearchDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {BA9239A4-3DD5-11D2-BF8B-00C04FB93661} +// *********************************************************************// + ISearchDisp = dispinterface + ['{BA9239A4-3DD5-11D2-BF8B-00C04FB93661}'] + property Title: WideString readonly dispid 1610743808; + property Id: WideString readonly dispid 1610743809; + property URL: WideString readonly dispid 1610743810; + end; + +// *********************************************************************// +// Interface: ISearches +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {47C922A2-3DD5-11D2-BF8B-00C04FB93661} +// *********************************************************************// + ISearches = interface(IDispatch) + ['{47C922A2-3DD5-11D2-BF8B-00C04FB93661}'] + function Get_Count: Integer; safecall; + function Get_Default: WideString; safecall; + function Item(index: OleVariant): ISearch; safecall; + function _NewEnum: IUnknown; safecall; + property Count: Integer read Get_Count; + property Default: WideString read Get_Default; + end; + +// *********************************************************************// +// DispIntf: ISearchesDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {47C922A2-3DD5-11D2-BF8B-00C04FB93661} +// *********************************************************************// + ISearchesDisp = dispinterface + ['{47C922A2-3DD5-11D2-BF8B-00C04FB93661}'] + property Count: Integer readonly dispid 1610743808; + property Default: WideString readonly dispid 1610743809; + function Item(index: OleVariant): ISearch; dispid 1610743810; + function _NewEnum: IUnknown; dispid -4; + end; + +// *********************************************************************// +// Interface: ISearchAssistantOC +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {72423E8F-8011-11D2-BE79-00A0C9A83DA1} +// *********************************************************************// + ISearchAssistantOC = interface(IDispatch) + ['{72423E8F-8011-11D2-BE79-00A0C9A83DA1}'] + procedure AddNextMenuItem(const bstrText: WideString; idItem: Integer); safecall; + procedure SetDefaultSearchUrl(const bstrUrl: WideString); safecall; + procedure NavigateToDefaultSearch; safecall; + function IsRestricted(const bstrGuid: WideString): WordBool; safecall; + function Get_ShellFeaturesEnabled: WordBool; safecall; + function Get_SearchAssistantDefault: WordBool; safecall; + function Get_Searches: ISearches; safecall; + function Get_InWebFolder: WordBool; safecall; + procedure PutProperty(bPerLocale: WordBool; const bstrName: WideString; + const bstrValue: WideString); safecall; + function GetProperty(bPerLocale: WordBool; const bstrName: WideString): WideString; safecall; + procedure Set_EventHandled(Param1: WordBool); safecall; + procedure ResetNextMenu; safecall; + procedure FindOnWeb; safecall; + procedure FindFilesOrFolders; safecall; + procedure FindComputer; safecall; + procedure FindPrinter; safecall; + procedure FindPeople; safecall; + function GetSearchAssistantURL(bSubstitute: WordBool; bCustomize: WordBool): WideString; safecall; + procedure NotifySearchSettingsChanged; safecall; + procedure Set_ASProvider(const pProvider: WideString); safecall; + function Get_ASProvider: WideString; safecall; + procedure Set_ASSetting(pSetting: SYSINT); safecall; + function Get_ASSetting: SYSINT; safecall; + procedure NETDetectNextNavigate; safecall; + procedure PutFindText(const FindText: WideString); safecall; + function Get_Version: SYSINT; safecall; + function EncodeString(const bstrValue: WideString; const bstrCharSet: WideString; + bUseUTF8: WordBool): WideString; safecall; + property ShellFeaturesEnabled: WordBool read Get_ShellFeaturesEnabled; + property SearchAssistantDefault: WordBool read Get_SearchAssistantDefault; + property Searches: ISearches read Get_Searches; + property InWebFolder: WordBool read Get_InWebFolder; + property EventHandled: WordBool write Set_EventHandled; + property ASProvider: WideString read Get_ASProvider write Set_ASProvider; + property ASSetting: SYSINT read Get_ASSetting write Set_ASSetting; + property Version: SYSINT read Get_Version; + end; + +// *********************************************************************// +// DispIntf: ISearchAssistantOCDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {72423E8F-8011-11D2-BE79-00A0C9A83DA1} +// *********************************************************************// + ISearchAssistantOCDisp = dispinterface + ['{72423E8F-8011-11D2-BE79-00A0C9A83DA1}'] + procedure AddNextMenuItem(const bstrText: WideString; idItem: Integer); dispid 1; + procedure SetDefaultSearchUrl(const bstrUrl: WideString); dispid 2; + procedure NavigateToDefaultSearch; dispid 3; + function IsRestricted(const bstrGuid: WideString): WordBool; dispid 4; + property ShellFeaturesEnabled: WordBool readonly dispid 5; + property SearchAssistantDefault: WordBool readonly dispid 6; + property Searches: ISearches readonly dispid 7; + property InWebFolder: WordBool readonly dispid 8; + procedure PutProperty(bPerLocale: WordBool; const bstrName: WideString; + const bstrValue: WideString); dispid 9; + function GetProperty(bPerLocale: WordBool; const bstrName: WideString): WideString; dispid 10; + property EventHandled: WordBool writeonly dispid 11; + procedure ResetNextMenu; dispid 12; + procedure FindOnWeb; dispid 13; + procedure FindFilesOrFolders; dispid 14; + procedure FindComputer; dispid 15; + procedure FindPrinter; dispid 16; + procedure FindPeople; dispid 17; + function GetSearchAssistantURL(bSubstitute: WordBool; bCustomize: WordBool): WideString; dispid 18; + procedure NotifySearchSettingsChanged; dispid 19; + property ASProvider: WideString dispid 20; + property ASSetting: SYSINT dispid 21; + procedure NETDetectNextNavigate; dispid 22; + procedure PutFindText(const FindText: WideString); dispid 23; + property Version: SYSINT readonly dispid 24; + function EncodeString(const bstrValue: WideString; const bstrCharSet: WideString; + bUseUTF8: WordBool): WideString; dispid 25; + end; + +// *********************************************************************// +// Interface: ISearchAssistantOC2 +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {72423E8F-8011-11D2-BE79-00A0C9A83DA2} +// *********************************************************************// + ISearchAssistantOC2 = interface(ISearchAssistantOC) + ['{72423E8F-8011-11D2-BE79-00A0C9A83DA2}'] + function Get_ShowFindPrinter: WordBool; safecall; + property ShowFindPrinter: WordBool read Get_ShowFindPrinter; + end; + +// *********************************************************************// +// DispIntf: ISearchAssistantOC2Disp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {72423E8F-8011-11D2-BE79-00A0C9A83DA2} +// *********************************************************************// + ISearchAssistantOC2Disp = dispinterface + ['{72423E8F-8011-11D2-BE79-00A0C9A83DA2}'] + property ShowFindPrinter: WordBool readonly dispid 26; + procedure AddNextMenuItem(const bstrText: WideString; idItem: Integer); dispid 1; + procedure SetDefaultSearchUrl(const bstrUrl: WideString); dispid 2; + procedure NavigateToDefaultSearch; dispid 3; + function IsRestricted(const bstrGuid: WideString): WordBool; dispid 4; + property ShellFeaturesEnabled: WordBool readonly dispid 5; + property SearchAssistantDefault: WordBool readonly dispid 6; + property Searches: ISearches readonly dispid 7; + property InWebFolder: WordBool readonly dispid 8; + procedure PutProperty(bPerLocale: WordBool; const bstrName: WideString; + const bstrValue: WideString); dispid 9; + function GetProperty(bPerLocale: WordBool; const bstrName: WideString): WideString; dispid 10; + property EventHandled: WordBool writeonly dispid 11; + procedure ResetNextMenu; dispid 12; + procedure FindOnWeb; dispid 13; + procedure FindFilesOrFolders; dispid 14; + procedure FindComputer; dispid 15; + procedure FindPrinter; dispid 16; + procedure FindPeople; dispid 17; + function GetSearchAssistantURL(bSubstitute: WordBool; bCustomize: WordBool): WideString; dispid 18; + procedure NotifySearchSettingsChanged; dispid 19; + property ASProvider: WideString dispid 20; + property ASSetting: SYSINT dispid 21; + procedure NETDetectNextNavigate; dispid 22; + procedure PutFindText(const FindText: WideString); dispid 23; + property Version: SYSINT readonly dispid 24; + function EncodeString(const bstrValue: WideString; const bstrCharSet: WideString; + bUseUTF8: WordBool): WideString; dispid 25; + end; + +// *********************************************************************// +// DispIntf: _SearchAssistantEvents +// Flags: (4112) Hidden Dispatchable +// GUID: {1611FDDA-445B-11D2-85DE-00C04FA35C89} +// *********************************************************************// + _SearchAssistantEvents = dispinterface + ['{1611FDDA-445B-11D2-85DE-00C04FA35C89}'] + procedure OnNextMenuSelect(idItem: Integer); dispid 1; + procedure OnNewSearch; dispid 2; + end; + + +// *********************************************************************// +// OLE Control Proxy class declaration +// Control Name : TWebBrowser_V1 +// Help String : WebBrowser Control +// Default Interface: IWebBrowser +// Def. Intf. DISP? : No +// Event Interface: DWebBrowserEvents +// TypeFlags : (34) CanCreate Control +// *********************************************************************// + TWebBrowser_V1BeforeNavigate = procedure(Sender: TObject; const URL: WideString; Flags: Integer; + const TargetFrameName: WideString; + var PostData: OleVariant; + const Headers: WideString; + var Cancel: WordBool) of object; + TWebBrowser_V1NavigateComplete = procedure(Sender: TObject; const URL: WideString) of object; + TWebBrowser_V1StatusTextChange = procedure(Sender: TObject; const Text: WideString) of object; + TWebBrowser_V1ProgressChange = procedure(Sender: TObject; Progress: Integer; ProgressMax: Integer) of object; + TWebBrowser_V1CommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object; + TWebBrowser_V1NewWindow = procedure(Sender: TObject; const URL: WideString; Flags: Integer; + const TargetFrameName: WideString; + var PostData: OleVariant; + const Headers: WideString; + var Processed: WordBool) of object; + TWebBrowser_V1TitleChange = procedure(Sender: TObject; const Text: WideString) of object; + TWebBrowser_V1FrameBeforeNavigate = procedure(Sender: TObject; const URL: WideString; + Flags: Integer; + const TargetFrameName: WideString; + var PostData: OleVariant; + const Headers: WideString; + var Cancel: WordBool) of object; + TWebBrowser_V1FrameNavigateComplete = procedure(Sender: TObject; const URL: WideString) of object; + TWebBrowser_V1FrameNewWindow = procedure(Sender: TObject; const URL: WideString; Flags: Integer; + const TargetFrameName: WideString; + var PostData: OleVariant; + const Headers: WideString; + var Processed: WordBool) of object; + TWebBrowser_V1Quit = procedure(Sender: TObject; var Cancel: WordBool) of object; + TWebBrowser_V1PropertyChange = procedure(Sender: TObject; const Property_: WideString) of object; + + TWebBrowser_V1 = class(TOleControl) + private + FOnBeforeNavigate: TWebBrowser_V1BeforeNavigate; + FOnNavigateComplete: TWebBrowser_V1NavigateComplete; + FOnStatusTextChange: TWebBrowser_V1StatusTextChange; + FOnProgressChange: TWebBrowser_V1ProgressChange; + FOnDownloadComplete: TNotifyEvent; + FOnCommandStateChange: TWebBrowser_V1CommandStateChange; + FOnDownloadBegin: TNotifyEvent; + FOnNewWindow: TWebBrowser_V1NewWindow; + FOnTitleChange: TWebBrowser_V1TitleChange; + FOnFrameBeforeNavigate: TWebBrowser_V1FrameBeforeNavigate; + FOnFrameNavigateComplete: TWebBrowser_V1FrameNavigateComplete; + FOnFrameNewWindow: TWebBrowser_V1FrameNewWindow; + FOnQuit: TWebBrowser_V1Quit; + FOnWindowMove: TNotifyEvent; + FOnWindowResize: TNotifyEvent; + FOnWindowActivate: TNotifyEvent; + FOnPropertyChange: TWebBrowser_V1PropertyChange; + FIntf: IWebBrowser; + function GetControlInterface: IWebBrowser; + protected + procedure CreateControl; + procedure InitControlData; override; + function Get_Application: IDispatch; + function Get_Parent: IDispatch; + function Get_Container: IDispatch; + function Get_Document: IDispatch; + public + procedure GoBack; + procedure GoForward; + procedure GoHome; + procedure GoSearch; + procedure Navigate(const URL: WideString); overload; + procedure Navigate(const URL: WideString; var Flags: OleVariant); overload; + procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName: OleVariant); overload; + procedure Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant); overload; + procedure Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); overload; + procedure Refresh; + procedure Refresh2; overload; + procedure Refresh2(var Level: OleVariant); overload; + procedure Stop; + property ControlInterface: IWebBrowser read GetControlInterface; + property DefaultInterface: IWebBrowser read GetControlInterface; + property Application: IDispatch index 200 read GetIDispatchProp; + property Parent: IDispatch index 201 read GetIDispatchProp; + property Container: IDispatch index 202 read GetIDispatchProp; + property Document: IDispatch index 203 read GetIDispatchProp; + property TopLevelContainer: WordBool index 204 read GetWordBoolProp; + property Type_: WideString index 205 read GetWideStringProp; + property LocationName: WideString index 210 read GetWideStringProp; + property LocationURL: WideString index 211 read GetWideStringProp; + property Busy: WordBool index 212 read GetWordBoolProp; + published + property TabStop; + property Align; + property DragCursor; + property DragMode; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property Visible; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnStartDrag; + property OnBeforeNavigate: TWebBrowser_V1BeforeNavigate read FOnBeforeNavigate write FOnBeforeNavigate; + property OnNavigateComplete: TWebBrowser_V1NavigateComplete read FOnNavigateComplete write FOnNavigateComplete; + property OnStatusTextChange: TWebBrowser_V1StatusTextChange read FOnStatusTextChange write FOnStatusTextChange; + property OnProgressChange: TWebBrowser_V1ProgressChange read FOnProgressChange write FOnProgressChange; + property OnDownloadComplete: TNotifyEvent read FOnDownloadComplete write FOnDownloadComplete; + property OnCommandStateChange: TWebBrowser_V1CommandStateChange read FOnCommandStateChange write FOnCommandStateChange; + property OnDownloadBegin: TNotifyEvent read FOnDownloadBegin write FOnDownloadBegin; + property OnNewWindow: TWebBrowser_V1NewWindow read FOnNewWindow write FOnNewWindow; + property OnTitleChange: TWebBrowser_V1TitleChange read FOnTitleChange write FOnTitleChange; + property OnFrameBeforeNavigate: TWebBrowser_V1FrameBeforeNavigate read FOnFrameBeforeNavigate write FOnFrameBeforeNavigate; + property OnFrameNavigateComplete: TWebBrowser_V1FrameNavigateComplete read FOnFrameNavigateComplete write FOnFrameNavigateComplete; + property OnFrameNewWindow: TWebBrowser_V1FrameNewWindow read FOnFrameNewWindow write FOnFrameNewWindow; + property OnQuit: TWebBrowser_V1Quit read FOnQuit write FOnQuit; + property OnWindowMove: TNotifyEvent read FOnWindowMove write FOnWindowMove; + property OnWindowResize: TNotifyEvent read FOnWindowResize write FOnWindowResize; + property OnWindowActivate: TNotifyEvent read FOnWindowActivate write FOnWindowActivate; + property OnPropertyChange: TWebBrowser_V1PropertyChange read FOnPropertyChange write FOnPropertyChange; + end; + + +// *********************************************************************// +// OLE Control Proxy class declaration +// Control Name : TWebBrowser +// Help String : WebBrowser Control +// Default Interface: IWebBrowser2 +// Def. Intf. DISP? : No +// Event Interface: DWebBrowserEvents2 +// TypeFlags : (34) CanCreate Control +// *********************************************************************// + TWebBrowserStatusTextChange = procedure(Sender: TObject; const Text: WideString) of object; + TWebBrowserProgressChange = procedure(Sender: TObject; Progress: Integer; ProgressMax: Integer) of object; + TWebBrowserCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object; + TWebBrowserTitleChange = procedure(Sender: TObject; const Text: WideString) of object; + TWebBrowserPropertyChange = procedure(Sender: TObject; const szProperty: WideString) of object; + TWebBrowserBeforeNavigate2 = procedure(Sender: TObject; const pDisp: IDispatch; + var URL: OleVariant; + var Flags: OleVariant; + var TargetFrameName: OleVariant; + var PostData: OleVariant; + var Headers: OleVariant; + var Cancel: WordBool) of object; + TWebBrowserNewWindow2 = procedure(Sender: TObject; var ppDisp: IDispatch; var Cancel: WordBool) of object; + TWebBrowserNavigateComplete2 = procedure(Sender: TObject; const pDisp: IDispatch; + var URL: OleVariant) of object; + TWebBrowserDocumentComplete = procedure(Sender: TObject; const pDisp: IDispatch; + var URL: OleVariant) of object; + TWebBrowserOnVisible = procedure(Sender: TObject; Visible: WordBool) of object; + TWebBrowserOnToolBar = procedure(Sender: TObject; ToolBar: WordBool) of object; + TWebBrowserOnMenuBar = procedure(Sender: TObject; MenuBar: WordBool) of object; + TWebBrowserOnStatusBar = procedure(Sender: TObject; StatusBar: WordBool) of object; + TWebBrowserOnFullScreen = procedure(Sender: TObject; FullScreen: WordBool) of object; + TWebBrowserOnTheaterMode = procedure(Sender: TObject; TheaterMode: WordBool) of object; + TWebBrowserWindowSetResizable = procedure(Sender: TObject; Resizable: WordBool) of object; + TWebBrowserWindowSetLeft = procedure(Sender: TObject; Left: Integer) of object; + TWebBrowserWindowSetTop = procedure(Sender: TObject; Top: Integer) of object; + TWebBrowserWindowSetWidth = procedure(Sender: TObject; Width: Integer) of object; + TWebBrowserWindowSetHeight = procedure(Sender: TObject; Height: Integer) of object; + TWebBrowserWindowClosing = procedure(Sender: TObject; IsChildWindow: WordBool; + var Cancel: WordBool) of object; + TWebBrowserClientToHostWindow = procedure(Sender: TObject; var CX: Integer; var CY: Integer) of object; + TWebBrowserSetSecureLockIcon = procedure(Sender: TObject; SecureLockIcon: Integer) of object; + TWebBrowserFileDownload = procedure(Sender: TObject; var Cancel: WordBool) of object; + + TWebBrowser = class(TOleControl) + private + FOnStatusTextChange: TWebBrowserStatusTextChange; + FOnProgressChange: TWebBrowserProgressChange; + FOnCommandStateChange: TWebBrowserCommandStateChange; + FOnDownloadBegin: TNotifyEvent; + FOnDownloadComplete: TNotifyEvent; + FOnTitleChange: TWebBrowserTitleChange; + FOnPropertyChange: TWebBrowserPropertyChange; + FOnBeforeNavigate2: TWebBrowserBeforeNavigate2; + FOnNewWindow2: TWebBrowserNewWindow2; + FOnNavigateComplete2: TWebBrowserNavigateComplete2; + FOnDocumentComplete: TWebBrowserDocumentComplete; + FOnQuit: TNotifyEvent; + FOnVisible: TWebBrowserOnVisible; + FOnToolBar: TWebBrowserOnToolBar; + FOnMenuBar: TWebBrowserOnMenuBar; + FOnStatusBar: TWebBrowserOnStatusBar; + FOnFullScreen: TWebBrowserOnFullScreen; + FOnTheaterMode: TWebBrowserOnTheaterMode; + FOnWindowSetResizable: TWebBrowserWindowSetResizable; + FOnWindowSetLeft: TWebBrowserWindowSetLeft; + FOnWindowSetTop: TWebBrowserWindowSetTop; + FOnWindowSetWidth: TWebBrowserWindowSetWidth; + FOnWindowSetHeight: TWebBrowserWindowSetHeight; + FOnWindowClosing: TWebBrowserWindowClosing; + FOnClientToHostWindow: TWebBrowserClientToHostWindow; + FOnSetSecureLockIcon: TWebBrowserSetSecureLockIcon; + FOnFileDownload: TWebBrowserFileDownload; + FIntf: IWebBrowser2; + function GetControlInterface: IWebBrowser2; + protected + procedure CreateControl; + procedure InitControlData; override; + function Get_Application: IDispatch; + function Get_Parent: IDispatch; + function Get_Container: IDispatch; + function Get_Document: IDispatch; + public + procedure GoBack; + procedure GoForward; + procedure GoHome; + procedure GoSearch; + procedure Navigate(const URL: WideString); overload; + procedure Navigate(const URL: WideString; var Flags: OleVariant); overload; + procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName: OleVariant); overload; + procedure Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant); overload; + procedure Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); overload; + procedure Refresh; + procedure Refresh2; overload; + procedure Refresh2(var Level: OleVariant); overload; + procedure Stop; + procedure Quit; + procedure ClientToWindow(var pcx: SYSINT; var pcy: SYSINT); + procedure PutProperty(const Property_: WideString; vtValue: OleVariant); + function GetProperty(const Property_: WideString): OleVariant; + procedure Navigate2(var URL: OleVariant); overload; + procedure Navigate2(var URL: OleVariant; var Flags: OleVariant); overload; + procedure Navigate2(var URL: OleVariant; var Flags: OleVariant; var TargetFrameName: OleVariant); overload; + procedure Navigate2(var URL: OleVariant; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant); overload; + procedure Navigate2(var URL: OleVariant; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); overload; + function QueryStatusWB(cmdID: OLECMDID): OLECMDF; + procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT); overload; + procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn: OleVariant); overload; + procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn: OleVariant; + var pvaOut: OleVariant); overload; + procedure ShowBrowserBar(var pvaClsid: OleVariant); overload; + procedure ShowBrowserBar(var pvaClsid: OleVariant; var pvarShow: OleVariant); overload; + procedure ShowBrowserBar(var pvaClsid: OleVariant; var pvarShow: OleVariant; + var pvarSize: OleVariant); overload; + property ControlInterface: IWebBrowser2 read GetControlInterface; + property DefaultInterface: IWebBrowser2 read GetControlInterface; + property Application: IDispatch index 200 read GetIDispatchProp; + property Parent: IDispatch index 201 read GetIDispatchProp; + property Container: IDispatch index 202 read GetIDispatchProp; + property Document: IDispatch index 203 read GetIDispatchProp; + property TopLevelContainer: WordBool index 204 read GetWordBoolProp; + property Type_: WideString index 205 read GetWideStringProp; + property LocationName: WideString index 210 read GetWideStringProp; + property LocationURL: WideString index 211 read GetWideStringProp; + property Busy: WordBool index 212 read GetWordBoolProp; + property Name: WideString index 0 read GetWideStringProp; + property HWND: Integer index -515 read GetIntegerProp; + property FullName: WideString index 400 read GetWideStringProp; + property Path: WideString index 401 read GetWideStringProp; + property ReadyState: TOleEnum index -525 read GetTOleEnumProp; + published + property TabStop; + property Align; + property DragCursor; + property DragMode; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property TabOrder; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnEnter; + property OnExit; + property OnStartDrag; + property Visible: WordBool index 402 read GetWordBoolProp write SetWordBoolProp stored False; + property StatusBar: WordBool index 403 read GetWordBoolProp write SetWordBoolProp stored False; + property StatusText: WideString index 404 read GetWideStringProp write SetWideStringProp stored False; + property ToolBar: Integer index 405 read GetIntegerProp write SetIntegerProp stored False; + property MenuBar: WordBool index 406 read GetWordBoolProp write SetWordBoolProp stored False; + property FullScreen: WordBool index 407 read GetWordBoolProp write SetWordBoolProp stored False; + property Offline: WordBool index 550 read GetWordBoolProp write SetWordBoolProp stored False; + property Silent: WordBool index 551 read GetWordBoolProp write SetWordBoolProp stored False; + property RegisterAsBrowser: WordBool index 552 read GetWordBoolProp write SetWordBoolProp stored False; + property RegisterAsDropTarget: WordBool index 553 read GetWordBoolProp write SetWordBoolProp stored False; + property TheaterMode: WordBool index 554 read GetWordBoolProp write SetWordBoolProp stored False; + property AddressBar: WordBool index 555 read GetWordBoolProp write SetWordBoolProp stored False; + property Resizable: WordBool index 556 read GetWordBoolProp write SetWordBoolProp stored False; + property OnStatusTextChange: TWebBrowserStatusTextChange read FOnStatusTextChange write FOnStatusTextChange; + property OnProgressChange: TWebBrowserProgressChange read FOnProgressChange write FOnProgressChange; + property OnCommandStateChange: TWebBrowserCommandStateChange read FOnCommandStateChange write FOnCommandStateChange; + property OnDownloadBegin: TNotifyEvent read FOnDownloadBegin write FOnDownloadBegin; + property OnDownloadComplete: TNotifyEvent read FOnDownloadComplete write FOnDownloadComplete; + property OnTitleChange: TWebBrowserTitleChange read FOnTitleChange write FOnTitleChange; + property OnPropertyChange: TWebBrowserPropertyChange read FOnPropertyChange write FOnPropertyChange; + property OnBeforeNavigate2: TWebBrowserBeforeNavigate2 read FOnBeforeNavigate2 write FOnBeforeNavigate2; + property OnNewWindow2: TWebBrowserNewWindow2 read FOnNewWindow2 write FOnNewWindow2; + property OnNavigateComplete2: TWebBrowserNavigateComplete2 read FOnNavigateComplete2 write FOnNavigateComplete2; + property OnDocumentComplete: TWebBrowserDocumentComplete read FOnDocumentComplete write FOnDocumentComplete; + property OnQuit: TNotifyEvent read FOnQuit write FOnQuit; + property OnVisible: TWebBrowserOnVisible read FOnVisible write FOnVisible; + property OnToolBar: TWebBrowserOnToolBar read FOnToolBar write FOnToolBar; + property OnMenuBar: TWebBrowserOnMenuBar read FOnMenuBar write FOnMenuBar; + property OnStatusBar: TWebBrowserOnStatusBar read FOnStatusBar write FOnStatusBar; + property OnFullScreen: TWebBrowserOnFullScreen read FOnFullScreen write FOnFullScreen; + property OnTheaterMode: TWebBrowserOnTheaterMode read FOnTheaterMode write FOnTheaterMode; + property OnWindowSetResizable: TWebBrowserWindowSetResizable read FOnWindowSetResizable write FOnWindowSetResizable; + property OnWindowSetLeft: TWebBrowserWindowSetLeft read FOnWindowSetLeft write FOnWindowSetLeft; + property OnWindowSetTop: TWebBrowserWindowSetTop read FOnWindowSetTop write FOnWindowSetTop; + property OnWindowSetWidth: TWebBrowserWindowSetWidth read FOnWindowSetWidth write FOnWindowSetWidth; + property OnWindowSetHeight: TWebBrowserWindowSetHeight read FOnWindowSetHeight write FOnWindowSetHeight; + property OnWindowClosing: TWebBrowserWindowClosing read FOnWindowClosing write FOnWindowClosing; + property OnClientToHostWindow: TWebBrowserClientToHostWindow read FOnClientToHostWindow write FOnClientToHostWindow; + property OnSetSecureLockIcon: TWebBrowserSetSecureLockIcon read FOnSetSecureLockIcon write FOnSetSecureLockIcon; + property OnFileDownload: TWebBrowserFileDownload read FOnFileDownload write FOnFileDownload; + end; + +// *********************************************************************// +// The Class CoInternetExplorer provides a Create and CreateRemote method to +// create instances of the default interface IWebBrowser2 exposed by +// the CoClass InternetExplorer. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoInternetExplorer = class + class function Create: IWebBrowser2; + class function CreateRemote(const MachineName: string): IWebBrowser2; + end; + +// *********************************************************************// +// The Class CoShellBrowserWindow provides a Create and CreateRemote method to +// create instances of the default interface IWebBrowser2 exposed by +// the CoClass ShellBrowserWindow. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoShellBrowserWindow = class + class function Create: IWebBrowser2; + class function CreateRemote(const MachineName: string): IWebBrowser2; + end; + +// *********************************************************************// +// The Class CoShellWindows provides a Create and CreateRemote method to +// create instances of the default interface IShellWindows exposed by +// the CoClass ShellWindows. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoShellWindows = class + class function Create: IShellWindows; + class function CreateRemote(const MachineName: string): IShellWindows; + end; + +// *********************************************************************// +// The Class CoShellUIHelper provides a Create and CreateRemote method to +// create instances of the default interface IShellUIHelper exposed by +// the CoClass ShellUIHelper. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoShellUIHelper = class + class function Create: IShellUIHelper; + class function CreateRemote(const MachineName: string): IShellUIHelper; + end; + +// *********************************************************************// +// The Class CoShellNameSpace provides a Create and CreateRemote method to +// create instances of the default interface IShellNameSpace exposed by +// the CoClass ShellNameSpace. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoShellNameSpace = class + class function Create: IShellNameSpace; + class function CreateRemote(const MachineName: string): IShellNameSpace; + end; + +// *********************************************************************// +// The Class CoCScriptErrorList provides a Create and CreateRemote method to +// create instances of the default interface IScriptErrorList exposed by +// the CoClass CScriptErrorList. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoCScriptErrorList = class + class function Create: IScriptErrorList; + class function CreateRemote(const MachineName: string): IScriptErrorList; + end; + +// *********************************************************************// +// The Class CoSearchAssistantOC provides a Create and CreateRemote method to +// create instances of the default interface ISearchAssistantOC2 exposed by +// the CoClass SearchAssistantOC. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoSearchAssistantOC = class + class function Create: ISearchAssistantOC2; + class function CreateRemote(const MachineName: string): ISearchAssistantOC2; + end; + +procedure Register; + +resourcestring + dtlServerPage = 'ActiveX'; + +implementation + +uses ComObj; + +procedure TWebBrowser_V1.InitControlData; +const + CEventDispIDs: array [0..16] of DWORD = ( + $00000064, $00000065, $00000066, $0000006C, $00000068, $00000069, + $0000006A, $0000006B, $00000071, $000000C8, $000000C9, $000000CC, + $00000067, $0000006D, $0000006E, $0000006F, $00000070); + CControlData: TControlData2 = ( + ClassID: '{EAB22AC3-30C1-11CF-A7EB-0000C05BAE0B}'; + EventIID: '{EAB22AC2-30C1-11CF-A7EB-0000C05BAE0B}'; + EventCount: 17; + EventDispIDs: @CEventDispIDs; + LicenseKey: nil (*HR:$80040154*); + Flags: $00000000; + Version: 401); +begin + ControlData := @CControlData; + TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnBeforeNavigate) - Cardinal(Self); +end; + +procedure TWebBrowser_V1.CreateControl; + + procedure DoCreate; + begin + FIntf := IUnknown(OleObject) as IWebBrowser; + end; + +begin + if FIntf = nil then DoCreate; +end; + +function TWebBrowser_V1.GetControlInterface: IWebBrowser; +begin + CreateControl; + Result := FIntf; +end; + +function TWebBrowser_V1.Get_Application: IDispatch; +begin + Result := DefaultInterface.Application; +end; + +function TWebBrowser_V1.Get_Parent: IDispatch; +begin + Result := DefaultInterface.Parent; +end; + +function TWebBrowser_V1.Get_Container: IDispatch; +begin + Result := DefaultInterface.Container; +end; + +function TWebBrowser_V1.Get_Document: IDispatch; +begin + Result := DefaultInterface.Document; +end; + +procedure TWebBrowser_V1.GoBack; +begin + DefaultInterface.GoBack; +end; + +procedure TWebBrowser_V1.GoForward; +begin + DefaultInterface.GoForward; +end; + +procedure TWebBrowser_V1.GoHome; +begin + DefaultInterface.GoHome; +end; + +procedure TWebBrowser_V1.GoSearch; +begin + DefaultInterface.GoSearch; +end; + +procedure TWebBrowser_V1.Navigate(const URL: WideString); +begin + DefaultInterface.Navigate(URL, EmptyParam, EmptyParam, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser_V1.Navigate(const URL: WideString; var Flags: OleVariant); +begin + DefaultInterface.Navigate(URL, Flags, EmptyParam, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser_V1.Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant); +begin + DefaultInterface.Navigate(URL, Flags, TargetFrameName, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser_V1.Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant); +begin + DefaultInterface.Navigate(URL, Flags, TargetFrameName, PostData, EmptyParam); +end; + +procedure TWebBrowser_V1.Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); +begin + DefaultInterface.Navigate(URL, Flags, TargetFrameName, PostData, Headers); +end; + +procedure TWebBrowser_V1.Refresh; +begin + DefaultInterface.Refresh; +end; + +procedure TWebBrowser_V1.Refresh2; +begin + DefaultInterface.Refresh2(EmptyParam); +end; + +procedure TWebBrowser_V1.Refresh2(var Level: OleVariant); +begin + DefaultInterface.Refresh2(Level); +end; + +procedure TWebBrowser_V1.Stop; +begin + DefaultInterface.Stop; +end; + +procedure TWebBrowser.InitControlData; +const + CEventDispIDs: array [0..26] of DWORD = ( + $00000066, $0000006C, $00000069, $0000006A, $00000068, $00000071, + $00000070, $000000FA, $000000FB, $000000FC, $00000103, $000000FD, + $000000FE, $000000FF, $00000100, $00000101, $00000102, $00000104, + $00000106, $00000108, $00000109, $0000010A, $0000010B, $00000107, + $0000010C, $0000010D, $0000010E); + CControlData: TControlData2 = ( + ClassID: '{8856F961-340A-11D0-A96B-00C04FD705A2}'; + EventIID: '{34A715A0-6587-11D0-924A-0020AFC7AC4D}'; + EventCount: 27; + EventDispIDs: @CEventDispIDs; + LicenseKey: nil (*HR:$80040154*); + Flags: $00000000; + Version: 401); +begin + ControlData := @CControlData; + TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnStatusTextChange) - Cardinal(Self); +end; + +procedure TWebBrowser.CreateControl; + + procedure DoCreate; + begin + FIntf := IUnknown(OleObject) as IWebBrowser2; + end; + +begin + if FIntf = nil then DoCreate; +end; + +function TWebBrowser.GetControlInterface: IWebBrowser2; +begin + CreateControl; + Result := FIntf; +end; + +function TWebBrowser.Get_Application: IDispatch; +begin + Result := DefaultInterface.Application; +end; + +function TWebBrowser.Get_Parent: IDispatch; +begin + Result := DefaultInterface.Parent; +end; + +function TWebBrowser.Get_Container: IDispatch; +begin + Result := DefaultInterface.Container; +end; + +function TWebBrowser.Get_Document: IDispatch; +begin + Result := DefaultInterface.Document; +end; + +procedure TWebBrowser.GoBack; +begin + DefaultInterface.GoBack; +end; + +procedure TWebBrowser.GoForward; +begin + DefaultInterface.GoForward; +end; + +procedure TWebBrowser.GoHome; +begin + DefaultInterface.GoHome; +end; + +procedure TWebBrowser.GoSearch; +begin + DefaultInterface.GoSearch; +end; + +procedure TWebBrowser.Navigate(const URL: WideString); +begin + DefaultInterface.Navigate(URL, EmptyParam, EmptyParam, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser.Navigate(const URL: WideString; var Flags: OleVariant); +begin + DefaultInterface.Navigate(URL, Flags, EmptyParam, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser.Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant); +begin + DefaultInterface.Navigate(URL, Flags, TargetFrameName, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser.Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant); +begin + DefaultInterface.Navigate(URL, Flags, TargetFrameName, PostData, EmptyParam); +end; + +procedure TWebBrowser.Navigate(const URL: WideString; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); +begin + DefaultInterface.Navigate(URL, Flags, TargetFrameName, PostData, Headers); +end; + +procedure TWebBrowser.Refresh; +begin + DefaultInterface.Refresh; +end; + +procedure TWebBrowser.Refresh2; +begin + DefaultInterface.Refresh2(EmptyParam); +end; + +procedure TWebBrowser.Refresh2(var Level: OleVariant); +begin + DefaultInterface.Refresh2(Level); +end; + +procedure TWebBrowser.Stop; +begin + DefaultInterface.Stop; +end; + +procedure TWebBrowser.Quit; +begin + DefaultInterface.Quit; +end; + +procedure TWebBrowser.ClientToWindow(var pcx: SYSINT; var pcy: SYSINT); +begin + DefaultInterface.ClientToWindow(pcx, pcy); +end; + +procedure TWebBrowser.PutProperty(const Property_: WideString; vtValue: OleVariant); +begin + DefaultInterface.PutProperty(Property_, vtValue); +end; + +function TWebBrowser.GetProperty(const Property_: WideString): OleVariant; +begin + Result := DefaultInterface.GetProperty(Property_); +end; + +procedure TWebBrowser.Navigate2(var URL: OleVariant); +begin + DefaultInterface.Navigate2(URL, EmptyParam, EmptyParam, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser.Navigate2(var URL: OleVariant; var Flags: OleVariant); +begin + DefaultInterface.Navigate2(URL, Flags, EmptyParam, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser.Navigate2(var URL: OleVariant; var Flags: OleVariant; + var TargetFrameName: OleVariant); +begin + DefaultInterface.Navigate2(URL, Flags, TargetFrameName, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser.Navigate2(var URL: OleVariant; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant); +begin + DefaultInterface.Navigate2(URL, Flags, TargetFrameName, PostData, EmptyParam); +end; + +procedure TWebBrowser.Navigate2(var URL: OleVariant; var Flags: OleVariant; + var TargetFrameName: OleVariant; var PostData: OleVariant; + var Headers: OleVariant); +begin + DefaultInterface.Navigate2(URL, Flags, TargetFrameName, PostData, Headers); +end; + +function TWebBrowser.QueryStatusWB(cmdID: OLECMDID): OLECMDF; +begin + Result := DefaultInterface.QueryStatusWB(cmdID); +end; + +procedure TWebBrowser.ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT); +begin + DefaultInterface.ExecWB(cmdID, cmdexecopt, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser.ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn: OleVariant); +begin + DefaultInterface.ExecWB(cmdID, cmdexecopt, pvaIn, EmptyParam); +end; + +procedure TWebBrowser.ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn: OleVariant; + var pvaOut: OleVariant); +begin + DefaultInterface.ExecWB(cmdID, cmdexecopt, pvaIn, pvaOut); +end; + +procedure TWebBrowser.ShowBrowserBar(var pvaClsid: OleVariant); +begin + DefaultInterface.ShowBrowserBar(pvaClsid, EmptyParam, EmptyParam); +end; + +procedure TWebBrowser.ShowBrowserBar(var pvaClsid: OleVariant; var pvarShow: OleVariant); +begin + DefaultInterface.ShowBrowserBar(pvaClsid, pvarShow, EmptyParam); +end; + +procedure TWebBrowser.ShowBrowserBar(var pvaClsid: OleVariant; var pvarShow: OleVariant; + var pvarSize: OleVariant); +begin + DefaultInterface.ShowBrowserBar(pvaClsid, pvarShow, pvarSize); +end; + +class function CoInternetExplorer.Create: IWebBrowser2; +begin + Result := CreateComObject(CLASS_InternetExplorer) as IWebBrowser2; +end; + +class function CoInternetExplorer.CreateRemote(const MachineName: string): IWebBrowser2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_InternetExplorer) as IWebBrowser2; +end; + +class function CoShellBrowserWindow.Create: IWebBrowser2; +begin + Result := CreateComObject(CLASS_ShellBrowserWindow) as IWebBrowser2; +end; + +class function CoShellBrowserWindow.CreateRemote(const MachineName: string): IWebBrowser2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ShellBrowserWindow) as IWebBrowser2; +end; + +class function CoShellWindows.Create: IShellWindows; +begin + Result := CreateComObject(CLASS_ShellWindows) as IShellWindows; +end; + +class function CoShellWindows.CreateRemote(const MachineName: string): IShellWindows; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ShellWindows) as IShellWindows; +end; + +class function CoShellUIHelper.Create: IShellUIHelper; +begin + Result := CreateComObject(CLASS_ShellUIHelper) as IShellUIHelper; +end; + +class function CoShellUIHelper.CreateRemote(const MachineName: string): IShellUIHelper; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ShellUIHelper) as IShellUIHelper; +end; + +class function CoShellNameSpace.Create: IShellNameSpace; +begin + Result := CreateComObject(CLASS_ShellNameSpace) as IShellNameSpace; +end; + +class function CoShellNameSpace.CreateRemote(const MachineName: string): IShellNameSpace; +begin + Result := CreateRemoteComObject(MachineName, CLASS_ShellNameSpace) as IShellNameSpace; +end; + +class function CoCScriptErrorList.Create: IScriptErrorList; +begin + Result := CreateComObject(CLASS_CScriptErrorList) as IScriptErrorList; +end; + +class function CoCScriptErrorList.CreateRemote(const MachineName: string): IScriptErrorList; +begin + Result := CreateRemoteComObject(MachineName, CLASS_CScriptErrorList) as IScriptErrorList; +end; + +class function CoSearchAssistantOC.Create: ISearchAssistantOC2; +begin + Result := CreateComObject(CLASS_SearchAssistantOC) as ISearchAssistantOC2; +end; + +class function CoSearchAssistantOC.CreateRemote(const MachineName: string): ISearchAssistantOC2; +begin + Result := CreateRemoteComObject(MachineName, CLASS_SearchAssistantOC) as ISearchAssistantOC2; +end; + +procedure Register; +begin + RegisterComponents('ActiveX',[TWebBrowser_V1, TWebBrowser]); +end; + +end. diff --git a/official/1.96/examples/windows/delphitools/common/ToolsUtils.pas b/official/1.96/examples/windows/delphitools/common/ToolsUtils.pas new file mode 100644 index 0000000..b7352ae --- /dev/null +++ b/official/1.96/examples/windows/delphitools/common/ToolsUtils.pas @@ -0,0 +1,371 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 ToolsUtils.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 13:03:49 $ } +{ } +{**************************************************************************************************} + +unit ToolsUtils; + +{$I JCL.INC} + +interface + +uses + Windows, Classes, SysUtils, ComCtrls, Math, ComObj, ActiveX, Controls, Forms, + ImageHlp, JclFileUtils, JclStrings, JclSysInfo, JclRegistry, JclShell; + +const + PeViewerClassName = 'PeViewer.PeViewerControl'; + +function CreateOrGetOleObject(const ClassName: string): IDispatch; + +function FmtStrToInt(S: string): Integer; + +function GetImageBase(const FileName: TFileName): DWORD; + +function IntToExtended(I: Integer): Extended; + +function InfoTipVersionString(const FileName: TFileName): string; + +function IsPeViewerRegistred: Boolean; + +procedure LVColumnClick(Column: TListColumn); + +procedure LVCompare(ListView: TListView; Item1, Item2: TListItem; var Compare: Integer); + +procedure ListViewFocusFirstItem(ListView: TListView); + +procedure ListViewSelectAll(ListView: TListView; Deselect: Boolean = False); + +procedure ListViewToStrings(ListView: TListView; Strings: TStrings; + SelectedOnly: Boolean = False; Headers: Boolean = True); + +function MessBox(const Text: string; Flags: Word): Integer; + +function MessBoxFmt(const Fmt: string; const Args: array of const; Flags: Word): Integer; + +function SafeSubItemString(Item: TListItem; SubItemIndex: Integer): string; + +procedure SendEmail; + +procedure ShowToolsAboutBox; + +function Win32HelpFileName: TFileName; + +procedure Fix_ListViewBeforeClose(Form: TForm); + +procedure D4FixCoolBarResizePaint(CoolBar: TObject); + +implementation + +uses + About, CommCtrl, JclPeImage; + +resourcestring + RsJCLLink = 'Jedi Code Library;http://delphi-jedi.org/Jedi:CODELIBJCL'; + RsEmailAddress = 'mailto:petr.v@mujmail.cz?subject=[Delphi Tools]'; + +function StrEmpty(const S: AnsiString): Boolean; +begin + Result := Length(Trim(S)) = 0; +end; + +function CreateOrGetOleObject(const ClassName: string): IDispatch; +var + ClassID: TCLSID; + Res: HResult; + Unknown: IUnknown; +begin + ClassID := ProgIDToClassID(ClassName); + Res := GetActiveObject(ClassID, nil, Unknown); + if Succeeded(Res) then + OleCheck(Unknown.QueryInterface(IDispatch, Result)) + else + begin + if Res <> MK_E_UNAVAILABLE then OleError(Res); + OleCheck(CoCreateInstance(ClassID, nil, CLSCTX_INPROC_SERVER or + CLSCTX_LOCAL_SERVER, IDispatch, Result)); + end; +end; + +function FmtStrToInt(S: string): Integer; +var + I: Integer; +begin + I := 1; + while I <= Length(S) do + if not (S[I] in ['0'..'9', '-']) then Delete(S, I, 1) else Inc(I); + Result := StrToIntDef(S, 0); +end; + +function GetImageBase(const FileName: TFileName): DWORD; +var + NtHeaders: TImageNtHeaders; +begin + if PeGetNtHeaders(FileName, NtHeaders) then + Result := NtHeaders.OptionalHeader.ImageBase + else + Result := 0; +end; + +function IntToExtended(I: Integer): Extended; +begin + Result := I; +end; + +function InfoTipVersionString(const FileName: TFileName): string; +begin + Result := ''; + if VersionResourceAvailable(FileName) then + try + with TJclFileVersionInfo.Create(FileName) do + try + if not StrEmpty(FileVersion) then Result := FileVersion; + if not StrEmpty(FileDescription) then + Result := Format('%s'#13#10'%s', [Result, FileDescription]) + finally + Free; + end; + except + end; +end; + +function IsPeViewerRegistred: Boolean; +begin + Result := RegReadStringDef(HKEY_CLASSES_ROOT, PeViewerClassName, '', '') <> ''; +end; + +procedure LVColumnClick(Column: TListColumn); +var + ColIndex: Integer; + ListView: TListView; +begin + ListView := TListColumns(Column.Collection).Owner as TListView; + ColIndex := Column.Index; + with ListView do + begin + if Tag and $FF = ColIndex then + Tag := Tag xor $100 + else + Tag := ColIndex; + AlphaSort; + if Selected <> nil then Selected.MakeVisible(False); + end; +end; + +procedure LVCompare(ListView: TListView; Item1, Item2: TListItem; var Compare: Integer); +var + ColIndex: Integer; +begin + with ListView do + begin + ColIndex := Tag and $FF - 1; + if Columns[ColIndex + 1].Alignment = taLeftJustify then + begin + if ColIndex = -1 then + Compare := AnsiCompareText(Item1.Caption, Item2.Caption) + else + Compare := AnsiCompareText(Item1.SubItems[ColIndex], Item2.SubItems[ColIndex]); + end else + begin + if ColIndex = -1 then + Compare := FmtStrToInt(Item1.Caption) - FmtStrToInt(Item2.Caption) + else + Compare := FmtStrToInt(Item1.SubItems[ColIndex]) - FmtStrToInt(Item2.SubItems[ColIndex]); + end; + if Tag and $100 <> 0 then Compare := -Compare; + end; +end; + +procedure ListViewFocusFirstItem(ListView: TListView); +begin + with ListView do + if Items.Count > 0 then + begin + ItemFocused := Items[0]; + ItemFocused.Selected := True; + ItemFocused.MakeVisible(False); + end; +end; + +procedure ListViewSelectAll(ListView: TListView; Deselect: Boolean); +var + I: Integer; + H: THandle; + Data: Integer; + SaveOnSelectItem: TLVSelectItemEvent; +begin + with ListView do if MultiSelect then + begin + Items.BeginUpdate; + SaveOnSelectItem := OnSelectItem; + Screen.Cursor := crHourGlass; + try + H := Handle; + OnSelectItem := nil; + if Deselect then Data := 0 else Data := LVIS_SELECTED; + for I := 0 to Items.Count - 1 do + ListView_SetItemState(H, I, Data, LVIS_SELECTED); + finally + OnSelectItem := SaveOnSelectItem; + Items.EndUpdate; + Screen.Cursor := crDefault; + end; + end; +end; + +procedure ListViewToStrings(ListView: TListView; Strings: TStrings; + SelectedOnly: Boolean = False; Headers: Boolean = True); +var + R, C: Integer; + ColWidths: array of Word; + S: String; + + procedure AddLine; +begin + Strings.Add(TrimRight(S)); +end; + + function MakeCellStr(const Text: String; Index: Integer): String; +begin + with ListView.Columns[Index] do + if Alignment = taLeftJustify then + Result := StrPadRight(Text, ColWidths[Index] + 1) + else + Result := StrPadLeft(Text, ColWidths[Index]) + ' '; +end; + +begin + SetLength(S, 256); + with ListView do + begin + SetLength(ColWidths, Columns.Count); + if Headers then + for C := 0 to Columns.Count - 1 do + ColWidths[C] := Length(Trim(Columns[C].Caption)); + for R := 0 to Items.Count - 1 do + if not SelectedOnly or Items[R].Selected then + begin + ColWidths[0] := Max(ColWidths[0], Length(Trim(Items[R].Caption))); + for C := 0 to Items[R].SubItems.Count - 1 do + ColWidths[C + 1] := Max(ColWidths[C + 1], Length(Trim(Items[R].SubItems[C]))); + end; + Strings.BeginUpdate; + try + if Headers then + with Columns do + begin + S := ''; + for C := 0 to Count - 1 do + S := S + MakeCellStr(Items[C].Caption, C); + AddLine; + S := ''; + for C := 0 to Count - 1 do + S := S + StringOfChar('-', ColWidths[C]) + ' '; + AddLine; + end; + for R := 0 to Items.Count - 1 do + if not SelectedOnly or Items[R].Selected then + with Items[R] do + begin + S := MakeCellStr(Caption, 0); + for C := 0 to Min(SubItems.Count, Columns.Count - 1) - 1 do + S := S + MakeCellStr(SubItems[C], C + 1); + AddLine; + end; + finally + Strings.EndUpdate; + end; + end; +end; + +function MessBox(const Text: string; Flags: Word): Integer; +begin + with Application do Result := MessageBox(PChar(Text), PChar(Title), Flags); +end; + +function MessBoxFmt(const Fmt: string; const Args: array of const; Flags: Word): Integer; +begin + Result := MessBox(Format(Fmt, Args), Flags); +end; + +function SafeSubItemString(Item: TListItem; SubItemIndex: Integer): string; +begin + if Item.SubItems.Count > SubItemIndex then + Result := Item.SubItems[SubItemIndex] + else + Result := '' +end; + +procedure SendEmail; +begin + ShellExecEx(RsEmailAddress); +end; + +procedure ShowToolsAboutBox; +begin + ShowAbout([RsJCLLink], 18); +end; + +function Win32HelpFileName: TFileName; +begin + Result := RegReadStringDef(HKEY_LOCAL_MACHINE, + 'SOFTWARE\Borland\Borland Shared\MSHelp', 'RootDir', '') + '\Win32.hlp'; + if not FileExists(Result) then Result := ''; +end; + +procedure Fix_ListViewBeforeClose(Form: TForm); +var + I: Integer; +begin + with Form do + for I := 0 to ComponentCount - 1 do + if Components[I] is TListView then + with TListView(Components[I]) do + if OwnerData then Items.Count := 0; +end; + +procedure D4FixCoolBarResizePaint(CoolBar: TObject); +{$IFDEF DELPHI4} +var + R: TRect; +begin + with CoolBar as TCoolBar do + begin + R := ClientRect; + R.Left := R.Right - 8; + InvalidateRect(Handle, @R, True); + end; +end; +{$ELSE} +begin +end; +{$ENDIF} + +// History: + +// $Log: ToolsUtils.pas,v $ +// Revision 1.2 2005/10/27 13:03:49 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/dependencyviewer/DependView.dof b/official/1.96/examples/windows/delphitools/dependencyviewer/DependView.dof new file mode 100644 index 0000000..c585742 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/dependencyviewer/DependView.dof @@ -0,0 +1,134 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir=..\..\..\..\bin +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=..\..\..\..\source;..\..\..\..\source\common;..\..\..\..\source\windows;..\..\..\..\source\vcl +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=0 +MinorVer=5 +Release=4 +Build=9 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1033 +CodePage=1252 +[Version Info Keys] +CompanyName=Petr Vones +FileDescription=Dependency Viewer +FileVersion=0.5.4.9 +InternalName=DEPENDVIEW +LegalCopyright=(c) 2002 Petr Vones +LegalTrademarks= +OriginalFilename=DEPENDVIEW.EXE +ProductName=Dependency Viewer +ProductVersion=0.5.4 diff --git a/official/1.96/examples/windows/delphitools/dependencyviewer/DependView.dpr b/official/1.96/examples/windows/delphitools/dependencyviewer/DependView.dpr new file mode 100644 index 0000000..515773e --- /dev/null +++ b/official/1.96/examples/windows/delphitools/dependencyviewer/DependView.dpr @@ -0,0 +1,21 @@ +program DependView; + +uses + Forms, + SysUtils, + D6MdiMsgFix in '..\Common\D6MdiMsgFix.pas', + DependViewMain in 'DependViewMain.pas' {MainForm}, + FileViewer in 'FileViewer.pas' {FileViewerChild}, + ToolsUtils in '..\Common\ToolsUtils.pas', + About in '..\Common\About.pas' {AboutBox}, + FindDlg in '..\Common\FindDlg.pas' {FindTextForm}, + ExceptDlg in '..\..\..\..\experts\debug\dialog\ExceptDlg.pas' {ExceptionDialog}; + +{$R *.RES} + +begin + Application.Initialize; + Application.Title := 'Dependency Viewer'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/delphitools/dependencyviewer/DependView.res b/official/1.96/examples/windows/delphitools/dependencyviewer/DependView.res new file mode 100644 index 0000000..e3af773 Binary files /dev/null and b/official/1.96/examples/windows/delphitools/dependencyviewer/DependView.res differ diff --git a/official/1.96/examples/windows/delphitools/dependencyviewer/DependViewMain.dfm b/official/1.96/examples/windows/delphitools/dependencyviewer/DependViewMain.dfm new file mode 100644 index 0000000..b7fab92 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/dependencyviewer/DependViewMain.dfm @@ -0,0 +1,1393 @@ +object MainForm: TMainForm + Left = 192 + Top = 107 + Width = 544 + Height = 375 + Caption = 'Dependency Viewer' + Color = clAppWorkSpace + Constraints.MinHeight = 250 + Constraints.MinWidth = 350 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + FormStyle = fsMDIForm + Menu = MainMenu + OldCreateOrder = False + Position = poDefault + ShowHint = True + Visible = True + WindowMenu = Window1 + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object CoolBar1: TCoolBar + Left = 0 + Top = 0 + Width = 536 + Height = 26 + AutoSize = True + Bands = < + item + Control = ToolBar1 + ImageIndex = -1 + MinHeight = 22 + Width = 532 + end> + Color = clBtnFace + ParentColor = False + OnResize = CoolBar1Resize + object ToolBar1: TToolBar + Left = 9 + Top = 0 + Width = 519 + Height = 22 + AutoSize = True + Caption = 'ToolBar1' + EdgeBorders = [] + Flat = True + Images = ToolbarImagesList + TabOrder = 0 + object ToolButton1: TToolButton + Left = 0 + Top = 0 + Action = Open1 + end + object ToolButton10: TToolButton + Left = 23 + Top = 0 + Width = 8 + Caption = 'ToolButton10' + ImageIndex = 18 + Style = tbsSeparator + end + object ToolButton8: TToolButton + Left = 31 + Top = 0 + Action = Copy1 + end + object ToolButton9: TToolButton + Left = 54 + Top = 0 + Action = Save1 + end + object ToolButton6: TToolButton + Left = 77 + Top = 0 + Action = Find1 + end + object ToolButton7: TToolButton + Left = 100 + Top = 0 + Width = 8 + Caption = 'ToolButton7' + ImageIndex = 19 + Style = tbsSeparator + end + object ToolButton2: TToolButton + Left = 108 + Top = 0 + Action = DumpPe1 + end + object ToolButton12: TToolButton + Left = 131 + Top = 0 + Action = Win32Help1 + end + object ToolButton11: TToolButton + Left = 154 + Top = 0 + Width = 8 + Caption = 'ToolButton11' + ImageIndex = 18 + Style = tbsSeparator + end + object ToolButton3: TToolButton + Left = 162 + Top = 0 + Action = WindowCascade1 + end + object ToolButton4: TToolButton + Left = 185 + Top = 0 + Action = WindowTileHorizontal1 + end + object ToolButton5: TToolButton + Left = 208 + Top = 0 + Action = WindowTileVertical1 + end + end + end + object StatusBar: TStatusBar + Left = 0 + Top = 302 + Width = 536 + Height = 19 + Panels = < + item + Width = 50 + end> + end + object MainMenu: TMainMenu + Images = ToolbarImagesList + Left = 8 + Top = 272 + object File1: TMenuItem + Caption = 'File' + object Open2: TMenuItem + Action = Open1 + end + object Save2: TMenuItem + Action = Save1 + end + object N3: TMenuItem + Caption = '-' + end + object DumpPEfile1: TMenuItem + Action = DumpPe1 + end + object N1: TMenuItem + Caption = '-' + end + object Exit2: TMenuItem + Action = Exit1 + end + end + object Edit1: TMenuItem + Caption = 'Edit' + object Copy2: TMenuItem + Action = Copy1 + end + object Selectall2: TMenuItem + Action = SelectAll1 + end + object N4: TMenuItem + Caption = '-' + end + object Findtext1: TMenuItem + Action = Find1 + end + end + object Window1: TMenuItem + Caption = 'Window' + object Cascade1: TMenuItem + Action = WindowCascade1 + end + object TileHorizontally1: TMenuItem + Action = WindowTileHorizontal1 + end + object TileVertically1: TMenuItem + Action = WindowTileVertical1 + end + end + object Help1: TMenuItem + Caption = 'Help' + object Win32helpkeyword1: TMenuItem + Action = Win32Help1 + end + object N2: TMenuItem + Caption = '-' + end + object Sendamessage1: TMenuItem + Action = SendMail1 + end + object About2: TMenuItem + Action = About1 + end + end + end + object ActionList1: TActionList + Images = ToolbarImagesList + Left = 40 + Top = 272 + object Exit1: TAction + Caption = 'Exit' + Hint = 'Exit application' + ImageIndex = 2 + OnExecute = Exit1Execute + end + object Open1: TAction + Caption = 'Open...' + Hint = 'Open a file' + ImageIndex = 0 + ShortCut = 16463 + OnExecute = Open1Execute + end + object WindowCascade1: TWindowCascade + Category = 'Window' + Caption = 'Cascade' + Hint = 'Cascade' + ImageIndex = 5 + end + object WindowTileHorizontal1: TWindowTileHorizontal + Category = 'Window' + Caption = 'Tile Horizontally' + Hint = 'Tile Horizontally' + ImageIndex = 6 + end + object WindowTileVertical1: TWindowTileVertical + Category = 'Window' + Caption = 'Tile Vertically' + Hint = 'Tile Vertically' + ImageIndex = 7 + end + object Copy1: TAction + Caption = 'Copy' + Hint = 'Copy to clipboard' + ImageIndex = 4 + ShortCut = 16451 + OnExecute = Copy1Execute + OnUpdate = Copy1Update + end + object Save1: TAction + Tag = 1 + Caption = 'Save...' + Hint = 'Save to text file' + ImageIndex = 3 + ShortCut = 16467 + OnExecute = Copy1Execute + OnUpdate = Copy1Update + end + object SelectAll1: TAction + Caption = 'Select all' + Hint = 'Select all rows' + ImageIndex = 8 + ShortCut = 16449 + OnExecute = SelectAll1Execute + OnUpdate = SelectAll1Update + end + object Win32Help1: TAction + Caption = 'Find in Win32 API help' + Hint = 'Find in Win32 API help' + ImageIndex = 1 + ShortCut = 112 + OnExecute = Win32Help1Execute + OnUpdate = Win32Help1Update + end + object DumpPe1: TAction + Caption = 'Dump PE file' + Hint = 'Dump PE file' + ImageIndex = 9 + ShortCut = 16452 + OnExecute = DumpPe1Execute + OnUpdate = DumpPe1Update + end + object About1: TAction + Caption = 'About...' + Hint = 'About' + OnExecute = About1Execute + end + object SendMail1: TAction + Caption = 'Support' + ImageIndex = 10 + OnExecute = SendMail1Execute + end + object Find1: TAction + Caption = 'Find text' + Hint = 'Find text' + ImageIndex = 11 + ShortCut = 16454 + OnExecute = Find1Execute + OnUpdate = Find1Update + end + end + object ToolbarImagesList: TImageList + ShareImages = True + Left = 72 + Top = 272 + Bitmap = { + 494C01010C000E00040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000004000000001002000000000000040 + 000000000000000000000000000000000000FFFFFF40FFFFFF4000FFFF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000408000004080000040800000408000 + 004080000040800000408000004080000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000408000004080000040800000408000 + 004080000040800000408000004080000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF400000004000FF + FF407F7F7F40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000FFFF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000FFFF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000FFFF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40000000400000004000000040000000400000004000000040000000400000 + 004000000040000000407F7F7F407F7F7F4000000040000000407F7F7F400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF408000004000000040000000407F7F7F400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40800000407F7F7F407F7F7F4000FFFF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFFFF40800000408000 + 0040800000408000004080000040800000408000004080000040FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000408000004080000040800000408000 + 004080000040800000408000004080000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000408000004080000040800000408000 + 004080000040800000408000004080000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000408000004080000040800000408000 + 004080000040800000408000004080000040FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF4000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF400000004000000040000000407F7F7F4000FFFF4000FFFF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40800000407F7F7F4000FFFF4000FFFF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40800000400000FF4000000040000000407F7F + 7F40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000408000004080000040800000408000 + 004080000040800000408000004080000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000408000004080000040800000408000 + 004080000040800000408000004080000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF4000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4000000040FFFFFF400000FF400000FF400000FF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000400000FF400000FF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000400000FF400000FF400000FF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40800000408000004080000040800000408000 + 0040800000408000004080000040FFFFFF4080000040FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408000004080000040800000408000 + 0040800000408000004080000040800000408000004080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF4000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF400000FF400000FF400000FF400000FF400000FF400000FF400000 + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40800000400000FF400000FF400000FF400000 + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF4080000040000000400000FF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000408000004080000040800000408000 + 004080000040800000408000004080000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000408000004080000040800000408000 + 0040800000408000004080000040800000400000008000000000000000800000 + 0000000000800000000000000080000000000000008000000000000000000000 + 0000000000000000000000000080000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000000000000000000000 + 000000000000000000000000000000FFFF0000000080000000000000000000FF + FF00008080000000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008000000000000000800000 + 00000000008000000000000000000000000000000080000000000000000000FF + FF0000FFFF0000FFFF0000000080000000000000000000FFFF0000FFFF000000 + 00007F7F7F3F7F7F7F007F7F7F0000FFFF0000FFFF3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F0000FFFF0000FFFF000000000000000080000000000000000000FF + FF0000808000000000000000008000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBF00000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000000000000000000000000 + 00000000000000000000FFFF00BFFFFF0000FFFF000000000000000000000000 + 00007F7F7F3F7F7F7F007F7F7F0000000000000000000000000000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF00000000000000000000000080000000000000000000FF + FF0000808000000000000000000000000000BFBFBFBFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF0000000080000000000000000000000000000000000000 + 0000000000BFFFFFFF000000000000000000000000BFFFFFFF00000000BFFFFF + FF000000000000000000FFFFFF0000000000000000000000FF000000FF000000 + FF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F0000000000FFFFFF00000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000003F7F7F7F00000000000000000000000080000000000000000000FF + FF00008080000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000080000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF0000000000000000000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000003F7F7F7F0000000000000000000000008000000000000000000080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000080000000000000000000000000000000000000 + 0000000000BFFFFFFF000000000000000000FFFFFF0000000000000000BFFFFF + FF000000000000000000FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000FFFFFF0000000000000000BFFFFFFF000000000000000000000000BFFFFF + FF000000003F7F7F7F0000000000000000000000008000000000000000000000 + 00007F7F7FBFBFBFBF0000000000000000000000000000000000000000000000 + 00007F7F7F000000000000000080000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000003F7F7F7F00000000000000000000000000000000007F7F7FBFBFBF + BF00BFBFBFBFBFBFBF00000000000000000000000000000000007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000000000000000000000000000 + 00000000000000000000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + 0000FFFFFF0000000000FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF000000000000FFFF0000FFFF0000FFFF000000 + 0000FFFFFF00000000000000000000000000000000BFFFFFFF00000000BFFFFF + FF000000000000FFFF0000FFFF0000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF0000000000000000007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000000000000000000000000000 + 0000FFFFFF0000FFFF000000000000000000FFFFFF0000000000FFFFFF000000 + 0000FFFFFFBFFFFFFF00FFFFFF0000000000000000BFFFFFFF007F7F7F3F7F7F + 7F00FFFFFF3F7F7F7F007F7F7FBFFFFFFF007F7F7FBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000FFFF0000FFFF000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000000000FFFF0000FFFF0000FFFF00000000BFBFBFBF00BFBFBFBFBFBF + BF00000000BFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000000000000000000000BFFFFF + FF0000FFFF000000000000FFFFBFFFFFFF00000000BFFFFFFF0000FFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000FFFFFF0000000000000000BFFFFFFF000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FF00BFBFBF000000 + FF00BFBFBFBFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000000000FFFFFF0000FFFF00000000BFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF0000000000000000BFFFFFFF007F7F7F3F7F7F + 7F00FFFFFF3F7F7F7F007F7F7F3F7F7F7F00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000FF000000FF000000FFBFBFBF + BF00BFBFBFBFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F00000000000000008000000000000000000000000000FFFFBFFFFF + FF0000FFFFBFFFFFFF00000000BFFFFFFF0000FFFF0000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBFBFFFFFFF00000000BFFFFFFF000000000000FF + FF0000000000000000000000000000000000000000000000FF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBF00000000007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F00000000800000000000000080000000000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000BFFFFFFF00FFFFFFBFFFFF + FF00000000000000000000000000000000000000000000000000FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000 + 0000FFFFFF000000000000000080000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF0000000000000000000000000000FF + FF0000FFFF00000000000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF00BFBFBF0000000000000000000000 + 000000000080000000000000008000000000FFFF00000000000000FFFFBFFFFF + FF0000FFFFBFFFFFFF0000FFFF00000000000000000000000000FFFFFFBFFFFF + FF00000000BFFFFFFF00FFFFFF000000000000000000000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 000000000000000000000000008000000000000000000000000000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FFFF0000FFFF000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF000000003F7F7F7F00000000800000 + 000000000080000000000000008000000000FFFF00BFFFFF00000000000000FF + FF00FFFFFF0000FFFF000000000000FFFF00FFFFFF0000FFFF00000000BFFFFF + FF00000000BFFFFFFF0000000000000000007F7F7F00000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000800000000000000080000000000000000000FFFF0000FFFF000000 + 000000000000000000000000000000FFFF0000FFFF0000000000000000000000 + 00000000000000FFFF0000FFFF00000000000000000000000000BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF000000003F7F7F7F000000008000000000000000800000 + 000000000080000000000000008000000000FFFF00BFFFFF0000FFFF00000000 + 000000FFFFBFFFFFFF0000FFFFBFFFFFFF000000000000000000FFFFFFBFFFFF + FF00000000000000000000000000000000000000008000000000000000800000 + 0000000000800000000000000080000000000000008000000000000000800000 + 00000000000000000000000000800000000000FFFF0000000000000000000000 + 000000000000000000000000000000FFFF000000000000000000000000000000 + 000000000000000000000000000000FFFF000000008000000000000000000000 + 00000000003F7F7F7F0000000080000000000000008000000000000000800000 + 000000000080000000000000008000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000080000000800000008000000080000000800000008000 + 0000800000008000000080000000800000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F007F7F + 7F0000000000000000007F7F7F00000000000000000000000000000000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000080000000800000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F007F7F7F0000FFFF00000000000000000000000000000000008000 + 0000FFFFFF00FFFFFF0080000000800000008000000080000000800000008000 + 00008000000080000000FFFFFF00800000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F0000FFFF0000FFFF00000000000000000000000000000000008000 + 0000FFFFFF00FFFFFF0080000000800000008000000080000000800000008000 + 0000800000008000000080000000800000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF00000000000000000000000000FFFFFF0000000000000000000000 + 00000000FF0000000000000000007F7F7F000000000000000000000000008000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00800000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF0000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080000000000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF00000000000000000080000000FFFFFF008000 + 000080000000800000008000000080000000800000008000000080000000FFFF + FF00800000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF000000000080000000FFFFFF008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00800000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 00008000000080000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000FFFFFF008000000000000000000000000000000080000000800000008000 + 00008000000080000000FFFFFF00800000008000000080000000800000008000 + 0000FFFFFF0080000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF0000000000000000000000000080000000800000008000 + 00008000000080000000800000008000000080000000FFFFFF00800000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 00008000000080000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + 00007F7F7F007F7F7F0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF007F7F7F000000FF007F7F7F00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000BFBFBF00BFBFBF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF000000FF000000FF000000FF0000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF00BFBFBF00BFBFBF0000000000000000000000000000000000008080000080 + 8000008080000080800000808000008080000080800000808000008080000000 + 000000000000000000000000000000000000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF007F7F7F000000FF007F7F7F00FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00000000000080 + 8000008080000080800000808000008080000080800000808000008080000080 + 8000000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF0000FFFF000000 + 0000008080000080800000808000008080000080800000808000008080000080 + 80000080800000000000000000000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000FF0000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000FFFF00FFFFFF0000FF + FF00000000000080800000808000008080000080800000808000008080000080 + 800000808000008080000000000000000000FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF000000FF007F7F7F0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000FF000000FF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000BFBFBF0000000000FF000000FF000000FF00 + 00000000FF00FF000000FF000000000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 000000000000000000000000000000000000FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000FF000000FF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF00000000000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 00000000000000000000000000000000000000FFFF00FFFFFF0000FFFF00FFFF + FF007F7F7F007F7F7F0000FFFF00FFFFFF007F7F7F000000FF000000FF00FFFF + FF0000FFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF00000000000000000000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF0000FFFF00FFFFFF0000FF + FF000000FF000000FF00FFFFFF0000FFFF007F7F7F000000FF000000FF0000FF + FF00FFFFFF0000FFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF000000000000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF0000FFFF00FFFF + FF000000FF000000FF007F7F7F00FFFFFF007F7F7F000000FF000000FF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF000000FF000000FF000000FF000000FF000000FF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF000000FF000000FF000000FF00FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 7F00FFFF000000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 7F00FFFF0000FFFF00000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000400000000100010000000000000200000000000000000000 + 000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + FFFFFF00FFFFFF00000000000000000000000000000000000000000000000000 + 0000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + FFFFFFBFFFFFFF00FFFFFFBFFFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF00 + FFFFFFBFFFFFFF00FFFFFFBFFFFFFFBFFFE3FF7EC380F000FC419001C300F000 + 8800C003C201F0000000E003C003F0000000E003C003F0000000E003C003F000 + 0000E0030003F000000000010003E000000080000003C0000000E00700038000 + 0000E00F000380000000E00F000700000001E027000F00000001C073003F0001 + 000D9E7980FF0003D5537EFEC3FF0007FC00FC00FFFFFFFFFC00FC0080038003 + FC00FC0080038003FC00FC00800380030000E000800380030000E00080038003 + 0000E000800380030000E0078003800300238007800380030001800780038003 + 00008007800380030023801F800380030063801F8003800300C3801F80038003 + 0107801FFFFFFFFF03FFFFFFFFFFFFFFFFFFFFFFC007FF00FFFFF83FC007FF00 + 001FE00FC007FF00000FC007C007FF0000078003C007000000038003C0070000 + 00010001C007000000000001C0070000001F0001C0070023001F0001C0070001 + 001F0001C00700008FF18003C0070023FFF98003C0070063FF75C007C00700C3 + FF8FE00FC0070107FFFFF83FC00703FF00000000000000000000000000000000 + 000000000000} + end + object OpenFileDialog: TOpenDialog + Filter = + 'PE Exe files (*.exe;*.dll;*.bpl)|*.exe;*.dll;*.bpl|All files (*.' + + '*)|*.*' + Options = [ofHideReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 136 + Top = 272 + end + object ViewImageList: TImageList + ShareImages = True + Left = 104 + Top = 272 + Bitmap = { + 494C01010D000E00040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000004000000001002000000000000040 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000080808000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000008080800080808000FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000808080000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000080808000808080000000000000000000FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000808080008080800000000000000000000000000000000000FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000808080008080800080808000808080008080800080808000808080008080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BFBFBF00BFBFBF007F7F7F007F7F7F007F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BFBFBF00BFBFBF007F7F7F007F7F7F007F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000BFBF + BF00BFBFBF007F7F7F000000000000000000000000007F7F7F007F7F7F007F7F + 7F0000000000000000000000000000000000000000000000000000000000BFBF + BF00BFBFBF007F7F7F000000000000000000000000007F7F7F007F7F7F007F7F + 7F000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF0000000000FFFFFF0000FF0000FFFFFF0000FF0000FFFFFF00000000007F7F + 7F007F7F7F000000000000000000000000000000000000000000BFBFBF00BFBF + BF0000000000FFFFFF000000FF00FFFFFF000000FF00FFFFFF00000000007F7F + 7F007F7F7F0000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 00007F7F7F000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 00007F7F7F0000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF00000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF00000000000000 + 00000000000000000000000000000000000000000000BFBFBF007F7F7F00FFFF + FF00000000000000000000FF0000007F0000007F00000000000000000000FFFF + FF007F7F7F007F7F7F00000000000000000000000000BFBFBF007F7F7F00FFFF + FF0000000000000000000000FF0000007F0000007F000000000000000000FFFF + FF007F7F7F007F7F7F00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF000000FF000000 + FF000000000000000000000000000000000000000000BFBFBF000000000000FF + 00000000000000FF0000007F000000FF0000007F0000007F00000000000000FF + 0000000000007F7F7F00000000000000000000000000BFBFBF00000000000000 + FF00000000000000FF0000007F000000FF0000007F0000007F00000000000000 + FF00000000007F7F7F00000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000FF000000 + FF0000000000000000000000000000000000000000000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF00000000000000000000000000FFFFFF0000000000FFFF + FF000000000000FF000000FF000000FF000000FF0000007F000000000000FFFF + FF00000000007F7F7F00000000000000000000000000FFFFFF0000000000FFFF + FF00000000000000FF000000FF000000FF000000FF0000007F0000000000FFFF + FF00000000007F7F7F00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF000000FF000000 + FF000000000000000000000000000000000000000000FFFFFF000000000000FF + 000000000000FFFFFF0000FF000000FF0000007F000000FF00000000000000FF + 000000000000BFBFBF00000000000000000000000000FFFFFF00000000000000 + FF0000000000FFFFFF000000FF000000FF0000007F000000FF00000000000000 + FF0000000000BFBFBF00000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF00000000000000 + 00000000000000000000000000000000000000000000FFFFFF007F7F7F00FFFF + FF000000000000000000FFFFFF00FFFFFF0000FF00000000000000000000FFFF + FF007F7F7F00BFBFBF00000000000000000000000000FFFFFF007F7F7F00FFFF + FF000000000000000000FFFFFF00FFFFFF000000FF000000000000000000FFFF + FF007F7F7F00BFBFBF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000BFBFBF000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000BFBFBF0000000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00BFBF + BF0000000000FFFFFF0000FF0000FFFFFF0000FF0000FFFFFF0000000000BFBF + BF00BFBFBF000000000000000000000000000000000000000000FFFFFF00BFBF + BF0000000000FFFFFF000000FF00FFFFFF000000FF00FFFFFF0000000000BFBF + BF00BFBFBF0000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00BFBFBF007F7F7F000000000000000000000000007F7F7F00BFBFBF00BFBF + BF0000000000000000000000000000000000000000000000000000000000FFFF + FF00BFBFBF007F7F7F000000000000000000000000007F7F7F00BFBFBF00BFBF + BF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00BFBFBF00BFBFBF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00BFBFBF00BFBFBF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF0000000000000000007F7F7F00000000007F7F7F00000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000FFFF00BFBF + BF0000FFFF00BFBFBF0000FFFF00BFBFBF0000FFFF00BFBFBF0000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + FF000000FF000000FF00000000000000000000000000000000000000FF000000 + FF0000000000000000007F7F7F00000000007F7F7F00000000000000FF000000 + FF000000FF000000000000000000000000000000000000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF000000000000FF + FF00BFBFBF0000FFFF00BFBFBF0000FFFF00BFBFBF0000FFFF00BFBFBF0000FF + FF0000000000FFFFFF00FFFFFF00000000000000000000000000000000000000 + 00000000FF000000FF000000FF007F7F7F00000000007F7F7F000000FF000000 + FF000000FF00000000000000000000000000000000000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF000000000000000000000000000000000000000000FFFF + 0000000000000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF000000 + 00000000000000000000000000000000000000000000FFFFFF0000FFFF000000 + 000000FFFF00BFBFBF0000FFFF00BFBFBF0000FFFF00BFBFBF0000FFFF00BFBF + BF0000FFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF00000000000000FF000000FF000000 + FF0000000000000000000000000000000000000000000000FF00000000000000 + FF000000FF000000FF007F7F7F00000000007F7F7F0000000000000000000000 + 00000000FF000000FF000000000000000000000000000000000000000000FFFF + 00000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00000000000000000000000000000000000000 + 000000000000000000000000FF000000FF00000000000000FF000000FF000000 + 0000000000000000000000000000000000000000FF000000FF00000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000FF000000FF0000000000000000000000000000000000FFFF + 000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF + FF000000000000000000000000000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 000000000000000000000000000000007F000000000000007F00000000000000 + 0000000000000000000000000000000000000000FF000000FF00000000000000 + 0000000000000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000FF000000FF0000000000000000000000000000000000FFFF + 00000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFFFF00000000000000000000000000000000000000 + 000000000000000000000000FF0000007F000000000000007F000000FF000000 + 0000000000000000000000000000000000000000FF000000FF00000000000000 + 000000000000000000007F7F7F00000000007F7F7F0000000000000000000000 + 0000000000000000FF000000FF0000000000000000000000000000000000FFFF + 000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000FF000000FF000000000000000000000000000000FF000000 + FF00000000000000000000000000000000000000FF000000FF00000000000000 + 0000000000000000000000007F000000000000007F000000FF00000000000000 + 0000000000000000FF000000FF0000000000000000000000000000000000FFFF + 00000000000000FFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFFFF00000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000000000000000000000000000FF000000 + FF000000FF000000000000000000000000000000FF000000FF00000000000000 + 000000000000000000000000000000000000000000000000FF000000FF000000 + 0000000000000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000FFFF00FFFFFF0000FFFF0000000000000000000000 + 000000000000000000000000000000000000000000007F7F7F00000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + FF000000FF000000FF000000000000000000000000000000FF000000FF000000 + 000000000000000000000000000000000000000000000000FF000000FF000000 + FF00000000000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF000000000000000000FFFFFF00FFFF + FF000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF0000000000000000007F7F7F00000000007F7F7F00000000000000 + 00000000FF000000FF000000FF0000000000000000000000FF000000FF000000 + FF000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF00000000007F7F7F00000000007F7F7F0000000000000000000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FFFF000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF007F7F7F007F7F7F007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF00000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF007F7F7F007F7F7F007F7F7F007F7F7F0000FFFF0000FFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00000000000000000000000000000000000000000000000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000FFFF000000FF0000FFFF00FFFF + FF0000007F00FF000000FF000000000000000000000000000000000000000000 + 0000808080008080800000000000000000000000000000000000FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF007F7F7F007F7F + 7F007F7F7F00FFFFFF00FFFFFF00FFFFFF0000FFFF000000FF000000FF0000FF + FF00FF00000000007F00FF000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00000000000000000000000000000000000000000000000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000000000FFFF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000FFFF000000FF0000FFFF0000FF + FF00FF00000000007F00FF000000000000000000000000000000000000000000 + 00000000000080808000808080000000000000000000FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000007F7F7F007F7F7F0000FFFF000000FF000000FF000000 + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 00000000000000000000808080000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F00000000007F7F7F007F7F7F0000FFFF000000FF000000FF000000 + FF000000FF0000FFFF0000000000000000000000000000000000000000000000 + 000000000000000000008080800080808000FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF000000000000FFFF000000000000FFFF00000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F007F7F + 7F00000000007F7F7F007F7F7F0000FFFF000000FF000000FF0000FFFF0000FF + FF000000FF0000FFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000080808000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000000000000000FFFFFF00FFFFFF0000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF00000000000000 + 000000000000000000000000000000000000000000007F7F7F00000000007F7F + 7F00000000007F7F7F007F7F7F0000FFFF000000FF0000FFFF007F7F7F000000 + FF0000FFFF000000FF0000FFFF007F7F7F000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + 0000000000007F7F7F007F7F7F007F7F7F0000FFFF0000FFFF007F7F7F0000FF + FF0000FFFF0000FFFF0000FFFF007F7F7F000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 000000000000000000000000000000000000000000007F7F7F00000000000000 + 0000000000007F7F7F007F7F7F007F7F7F0000FFFF0000FFFF007F7F7F007F7F + 7F007F7F7F0000FFFF000000FF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000007F7F7F007F7F7F007F7F7F0000FFFF007F7F7F007F7F + 7F007F7F7F007F7F7F0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F7F7F007F7F7F007F7F + 7F0000000000000000007F7F7F0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000400000000100010000000000000200000000000000000000 + 000000000000000000000000FFFFFF00FFFF000000000000FFFF000000000000 + FFFF000000000000FFFF000000000000FE7F000000000000FC3F000000000000 + FDBF000000000000F99F000000000000FBDF000000000000F3CF000000000000 + F00F000000000000FFFF000000000000FFFF000000000000FFFF000000000000 + FFFF000000000000FFFF000000000000FFDFFFFFFFFFFFFFFFCFFFFFF83FF83F + FFC7FFFFE00FE00F0003FFFFC007C0070001FCFF800380030000FC3F80038003 + 0001FC0F0001000100030003000100010007000000010001000F000300010001 + 001FFC0F00010001007FFC3F8003800300FFFCFF8003800301FFFFFFC007C007 + 03FFFFFFE00FE00FFFFFFFFFF83FF83FFFFFFFFFFFFFFFFFFFFFF83FFFFF801F + C631E00F1FFF0000E223CC47041F0000F0078463000F0000F88FA073000F0000 + FC1F31F900070000FE3F38F900010000FC1F3C7900000000F80F3C3900018000 + F0073C19003F8000E2239C0BFC7FFC00C6318C43FFFFFC01FFFFC467FFFFFC03 + FFFFE00FFFFFFC07FFFFF83FFFFFFFFFFFFFE00F8000FFFFE007E00F0000FFFF + E007E00F0000FFFFE007F00F0000FFFFE007F00F0000F00FE007F80F0000F3CF + E007F0070000FBDFE007F0070000F99FE007F0070000FDBFE007F00FF403FC3F + E007F01FC801FE7FE00FF81FA800FFFFE01FFE1FD800FFFFE03FFF1FB800FFFF + FFFFFF1FFC00FFFFFFFFFFBFFF8CFFFF00000000000000000000000000000000 + 000000000000} + end + object SaveDialog: TSaveDialog + DefaultExt = 'txt' + Filter = 'Text files (*.txt)|*.txt|All files (*.*)|*.*' + Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing] + Left = 168 + Top = 272 + end +end diff --git a/official/1.96/examples/windows/delphitools/dependencyviewer/DependViewMain.pas b/official/1.96/examples/windows/delphitools/dependencyviewer/DependViewMain.pas new file mode 100644 index 0000000..5aba0b9 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/dependencyviewer/DependViewMain.pas @@ -0,0 +1,356 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 DependView.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/11/22 10:23:35 $ } +{ } +{**************************************************************************************************} + +unit DependViewMain; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + Menus, ToolWin, ComCtrls, ImgList, ActnList, StdActns, ClipBrd, Registry, + ShellAPI; + +const + UM_CHECKPARAMSTR = WM_USER + $100; + +type + TMainForm = class(TForm) + MainMenu: TMainMenu; + CoolBar1: TCoolBar; + ToolBar1: TToolBar; + ToolButton1: TToolButton; + ActionList1: TActionList; + ToolbarImagesList: TImageList; + OpenFileDialog: TOpenDialog; + File1: TMenuItem; + Exit1: TAction; + Exit2: TMenuItem; + Open1: TAction; + Open2: TMenuItem; + N1: TMenuItem; + Window1: TMenuItem; + WindowCascade1: TWindowCascade; + WindowTileHorizontal1: TWindowTileHorizontal; + WindowTileVertical1: TWindowTileVertical; + Cascade1: TMenuItem; + TileHorizontally1: TMenuItem; + TileVertically1: TMenuItem; + ToolButton3: TToolButton; + ToolButton4: TToolButton; + ToolButton5: TToolButton; + ViewImageList: TImageList; + ToolButton7: TToolButton; + Copy1: TAction; + Save1: TAction; + Edit1: TMenuItem; + Copy2: TMenuItem; + Save2: TMenuItem; + ToolButton8: TToolButton; + ToolButton9: TToolButton; + ToolButton10: TToolButton; + SelectAll1: TAction; + Selectall2: TMenuItem; + SaveDialog: TSaveDialog; + Win32Help1: TAction; + ToolButton11: TToolButton; + ToolButton12: TToolButton; + Help1: TMenuItem; + Win32helpkeyword1: TMenuItem; + N2: TMenuItem; + About1: TAction; + About2: TMenuItem; + StatusBar: TStatusBar; + DumpPe1: TAction; + ToolButton2: TToolButton; + N3: TMenuItem; + DumpPEfile1: TMenuItem; + SendMail1: TAction; + Sendamessage1: TMenuItem; + Find1: TAction; + ToolButton6: TToolButton; + N4: TMenuItem; + Findtext1: TMenuItem; + procedure Exit1Execute(Sender: TObject); + procedure Open1Execute(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure SelectAll1Update(Sender: TObject); + procedure SelectAll1Execute(Sender: TObject); + procedure Copy1Update(Sender: TObject); + procedure Copy1Execute(Sender: TObject); + procedure Win32Help1Update(Sender: TObject); + procedure Win32Help1Execute(Sender: TObject); + procedure About1Execute(Sender: TObject); + procedure DumpPe1Update(Sender: TObject); + procedure DumpPe1Execute(Sender: TObject); + procedure SendMail1Execute(Sender: TObject); + procedure Find1Update(Sender: TObject); + procedure Find1Execute(Sender: TObject); + procedure CoolBar1Resize(Sender: TObject); + procedure FormShow(Sender: TObject); + private + FPeViewer: Variant; + FPeViewerRegistred: Boolean; + FWin32Help: string; + procedure InvokeWin32Help(const Name: string); + function IsFileViewerChildActive: Boolean; + function IsWin32Help: Boolean; + procedure OnActiveFormChange(Sender: TObject); + procedure UMCheckParamStr(var Message: TMessage); message UM_CHECKPARAMSTR; + procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES; + public + procedure OpenFile(const FileName: TFileName; CheckIfOpen: Boolean); + end; + +var + MainForm: TMainForm; + +implementation + +uses ToolsUtils, FileViewer, JclPeImage, JclRegistry, FindDlg, JclFileUtils; + +{$R *.DFM} + +resourcestring + sNotValidFile = 'This is not a valid PE EXE file'; + +procedure TMainForm.InvokeWin32Help(const Name: string); +var + S: string; +begin + S := PeStripFunctionAW(Name); + WinHelp(Application.Handle, PChar(FWin32Help), HELP_KEY, DWORD(S)); +end; + +procedure TMainForm.OpenFile(const FileName: TFileName; CheckIfOpen: Boolean); +var + I: Integer; +begin + if CheckIfOpen then + begin + for I := 0 to MDIChildCount - 1 do + if MDIChildren[I] is TFileViewerChild and (TFileViewerChild(MDIChildren[I]).FileName = FileName) then + begin + MDIChildren[I].BringToFront; + Exit; + end; + end; + Screen.Cursor := crHourGlass; + try +{ if IsPeExe(FileName) then + begin} + TFileViewerChild.Create(Self).FileName := FileName; + OnActiveFormChange(nil); +{ end else + MessBox(sNotValidFile, MB_ICONINFORMATION);} + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.Exit1Execute(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.Open1Execute(Sender: TObject); +var + I: Integer; +begin + with OpenFileDialog do + begin + FileName := ''; + if Execute then + for I := 0 to Files.Count - 1 do OpenFile(Files[I], True); + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + FWin32Help := Win32HelpFileName; + FPeViewerRegistred := IsPeViewerRegistred; + Screen.OnActiveFormChange := OnActiveFormChange; + DragAcceptFiles(Handle, True); +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + DragAcceptFiles(Handle, False); + Screen.OnActiveFormChange := nil; +end; + +procedure TMainForm.OnActiveFormChange(Sender: TObject); +begin + if IsFileViewerChildActive then + StatusBar.Panels[0].Text := TFileViewerChild(ActiveMDIChild).FileName + else + StatusBar.Panels[0].Text := ''; +end; + +procedure TMainForm.SelectAll1Update(Sender: TObject); +begin + TAction(Sender).Enabled := Screen.ActiveControl is TListView; +end; + +procedure TMainForm.SelectAll1Execute(Sender: TObject); +begin + ListViewSelectAll(Screen.ActiveControl as TListView); +end; + +procedure TMainForm.Copy1Update(Sender: TObject); +begin + TAction(Sender).Enabled := Screen.ActiveControl is TListView; +end; + +procedure TMainForm.Copy1Execute(Sender: TObject); +var + SL: TStringList; +begin + SL := TStringList.Create; + Screen.Cursor := crHourGlass; + try + SL.Capacity := 256; + ListViewToStrings(Screen.ActiveControl as TListView, SL, True); + case TAction(Sender).Tag of + 0: Clipboard.AsText := SL.Text; + 1: with SaveDialog do + begin + FileName := ''; + if Execute then SL.SaveToFile(FileName); + end; + end; + finally + Screen.Cursor := crDefault; + SL.Free; + end; +end; + +procedure TMainForm.Win32Help1Update(Sender: TObject); +begin + Win32Help1.Enabled := IsWin32Help and IsFileViewerChildActive and + (TFileViewerChild(ActiveMDIChild).GetWin32Function <> ''); +end; + +procedure TMainForm.Win32Help1Execute(Sender: TObject); +begin + InvokeWin32Help((ActiveMDIChild as TFileViewerChild).GetWin32Function); +end; + +procedure TMainForm.About1Execute(Sender: TObject); +begin + ShowToolsAboutBox; +end; + +function TMainForm.IsFileViewerChildActive: Boolean; +begin + Result := (ActiveMDIChild is TFileViewerChild); +end; + +function TMainForm.IsWin32Help: Boolean; +begin + Result := Length(FWin32Help) > 0; +end; + +procedure TMainForm.DumpPe1Update(Sender: TObject); +begin + DumpPe1.Enabled := FPeViewerRegistred and IsFileViewerChildActive and + (TFileViewerChild(ActiveMDIChild).SelectedFileName <> ''); +end; + +procedure TMainForm.DumpPe1Execute(Sender: TObject); +begin + FPeViewer := CreateOrGetOleObject(PeViewerClassName); + FPeViewer.OpenFile((ActiveMDIChild as TFileViewerChild).SelectedFileName); + FPeViewer.BringToFront; +end; + +procedure TMainForm.SendMail1Execute(Sender: TObject); +begin + SendEmail; +end; + +procedure TMainForm.Find1Update(Sender: TObject); +begin + TAction(Sender).Enabled := TFindTextForm.CanExecuteFind; +end; + +procedure TMainForm.Find1Execute(Sender: TObject); +begin + ShowFindDialog(Screen.ActiveControl as TListView); +end; + +procedure TMainForm.CoolBar1Resize(Sender: TObject); +begin + D4FixCoolBarResizePaint(Sender); +end; + +procedure TMainForm.FormShow(Sender: TObject); +begin + PostMessage(Handle, UM_CHECKPARAMSTR, 0, 0); +end; + +procedure TMainForm.UMCheckParamStr(var Message: TMessage); +var + I: Integer; + FileName: TFileName; +begin + for I := 1 to ParamCount do + begin + FileName := PathGetLongName(ParamStr(I)); + if (FileName <> '') and not (FileName[1] in ['-', '/']) then + OpenFile(FileName, False); + end; +end; + +procedure TMainForm.WMDropFiles(var Message: TWMDropFiles); +var + FilesCount, I: Integer; + FileName: array[0..MAX_PATH] of Char; +begin + FilesCount := DragQueryFile(Message.Drop, MAXDWORD, nil, 0); + for I := 0 to FilesCount - 1 do + begin + if (DragQueryFile(Message.Drop, I, @FileName, SizeOf(FileName)) > 0) and + IsValidPeFile(FileName) then + OpenFile(FileName, True); + end; + DragFinish(Message.Drop); + Message.Result := 0; + Application.BringToFront; +end; + +// History: + +// $Log: DependViewMain.pas,v $ +// Revision 1.3 2005/11/22 10:23:35 ahuser +// FileDrop support +// +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/dependencyviewer/FileViewer.dfm b/official/1.96/examples/windows/delphitools/dependencyviewer/FileViewer.dfm new file mode 100644 index 0000000..1b9932a --- /dev/null +++ b/official/1.96/examples/windows/delphitools/dependencyviewer/FileViewer.dfm @@ -0,0 +1,239 @@ +object FileViewerChild: TFileViewerChild + Left = 205 + Top = 131 + ActiveControl = DependencyTreeView + AutoScroll = False + Caption = 'FileViewerChild' + ClientHeight = 354 + ClientWidth = 576 + Color = clBtnFace + Constraints.MinHeight = 100 + Constraints.MinWidth = 200 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + PopupMenu = PopupMenu1 + Position = poDefault + ShowHint = True + Visible = True + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 134 + Top = 0 + Width = 3 + Height = 277 + Cursor = crHSplit + ResizeStyle = rsUpdate + end + object Splitter3: TSplitter + Left = 0 + Top = 277 + Width = 576 + Height = 3 + Cursor = crVSplit + Align = alBottom + ResizeStyle = rsUpdate + end + object DependencyTreeView: TTreeView + Left = 0 + Top = 0 + Width = 134 + Height = 277 + Align = alLeft + ChangeDelay = 50 + HideSelection = False + HotTrack = True + Images = MainForm.ViewImageList + Indent = 19 + ReadOnly = True + ShowRoot = False + StateImages = MainForm.ViewImageList + TabOrder = 0 + OnChange = DependencyTreeViewChange + OnDeletion = DependencyTreeViewDeletion + end + object ListViewsPanel: TPanel + Left = 137 + Top = 0 + Width = 439 + Height = 277 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object Splitter2: TSplitter + Left = 0 + Top = 150 + Width = 439 + Height = 3 + Cursor = crVSplit + Align = alTop + ResizeStyle = rsUpdate + end + object ImportListView: TListView + Left = 0 + Top = 153 + Width = 439 + Height = 124 + Align = alClient + Columns = < + item + Caption = 'Name' + Width = 250 + end + item + Alignment = taRightJustify + Caption = 'Ordinal' + Width = 60 + end + item + Alignment = taRightJustify + Caption = 'Hint' + end + item + Caption = 'Module' + end> + HideSelection = False + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.ViewImageList + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = ImportListViewColumnClick + OnData = ImportListViewData + OnDblClick = ExportListViewDblClick + end + object ExportListView: TListView + Left = 0 + Top = 0 + Width = 439 + Height = 150 + Align = alTop + Columns = < + item + Caption = 'Name' + Width = 250 + end + item + Alignment = taRightJustify + Caption = 'Ordinal' + end + item + Alignment = taRightJustify + Caption = 'Hint' + end + item + Caption = 'Address' + Width = 70 + end> + HideSelection = False + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.ViewImageList + TabOrder = 1 + ViewStyle = vsReport + OnColumnClick = ExportListViewColumnClick + OnData = ExportListViewData + OnDblClick = ExportListViewDblClick + end + end + object ModulesListView: TListView + Left = 0 + Top = 280 + Width = 576 + Height = 74 + Align = alBottom + Columns = < + item + Caption = 'Module' + Width = 100 + end + item + Caption = 'Date and time' + Width = 120 + end + item + Alignment = taRightJustify + Caption = 'Size' + Width = 70 + end + item + Caption = 'Subsystem' + Width = 65 + end + item + Caption = 'Base address' + Width = 80 + end + item + Caption = 'File version' + Width = 80 + end + item + Caption = 'Product version' + Width = 90 + end + item + Caption = 'Img ver.' + end + item + Caption = 'Linker' + end + item + Caption = 'OS' + end + item + Caption = 'Subsys ver.' + end + item + Caption = 'Description' + Width = 250 + end> + ColumnClick = False + GridLines = True + HideSelection = False + MultiSelect = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.ViewImageList + TabOrder = 2 + ViewStyle = vsReport + OnDblClick = ModulesListViewDblClick + OnInfoTip = ModulesListViewInfoTip + end + object PopupMenu1: TPopupMenu + Images = MainForm.ToolbarImagesList + Left = 8 + Top = 312 + object Copy1: TMenuItem + Action = MainForm.Copy1 + end + object Save1: TMenuItem + Action = MainForm.Save1 + end + object N1: TMenuItem + Caption = '-' + end + object Selectall1: TMenuItem + Action = MainForm.SelectAll1 + end + object DumpPEfile1: TMenuItem + Action = MainForm.DumpPe1 + end + object Win32helpkeyword1: TMenuItem + Action = MainForm.Win32Help1 + end + end +end diff --git a/official/1.96/examples/windows/delphitools/dependencyviewer/FileViewer.pas b/official/1.96/examples/windows/delphitools/dependencyviewer/FileViewer.pas new file mode 100644 index 0000000..bae8c61 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/dependencyviewer/FileViewer.pas @@ -0,0 +1,673 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 FileViewer.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/12/04 10:10:57 $ } +{ } +{**************************************************************************************************} + +unit FileViewer; + +{$I JCL.INC} + +{.$DEFINE UsePeImagesCache} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, ExtCtrls, Menus, JclPeImage; + +type + TFileViewerChild = class(TForm) + DependencyTreeView: TTreeView; + Splitter1: TSplitter; + ListViewsPanel: TPanel; + Splitter2: TSplitter; + ImportListView: TListView; + ExportListView: TListView; + PopupMenu1: TPopupMenu; + Copy1: TMenuItem; + Save1: TMenuItem; + N1: TMenuItem; + Selectall1: TMenuItem; + Win32helpkeyword1: TMenuItem; + ModulesListView: TListView; + Splitter3: TSplitter; + DumpPEfile1: TMenuItem; + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure ExportListViewData(Sender: TObject; Item: TListItem); + procedure ImportListViewData(Sender: TObject; Item: TListItem); + procedure ExportListViewColumnClick(Sender: TObject; + Column: TListColumn); + procedure ImportListViewColumnClick(Sender: TObject; + Column: TListColumn); + procedure FormDestroy(Sender: TObject); + procedure DependencyTreeViewChange(Sender: TObject; Node: TTreeNode); + procedure DependencyTreeViewDeletion(Sender: TObject; Node: TTreeNode); + procedure ModulesListViewInfoTip(Sender: TObject; Item: TListItem; + var InfoTip: String); + procedure ExportListViewDblClick(Sender: TObject); + procedure ModulesListViewDblClick(Sender: TObject); + private + FAnyRootError: Boolean; + FBasePath: string; + FCurrentImportDirIndex: Integer; + FFileName: TFileName; + FModulesList: TStringList; + FExportViewImage, FParentImportViewImage: TJclPeImage; + FPeImagesCache: TJclPeImagesCache; + function GetModuleName: string; + procedure SetFileName(const Value: TFileName); + procedure ExportListViewSort; + function ModuleToFileName(const ModuleName: string): TFileName; + procedure ImportListViewSort; + procedure InitTree; + function IsListViewActiveAndFocused( ListView: TListView): Boolean; + procedure UpdateExportView(Node: TTreeNode); + procedure UpdateModulesView; + procedure UpdateParentImportView(Node: TTreeNode); + class procedure UpdateSortData(Column: TListColumn); + function GetSelectedFileName: TFileName; + public + function GetWin32Function: string; + property FileName: TFileName read FFileName write SetFileName; + property ModuleName: string read GetModuleName; + property SelectedFileName: TFileName read GetSelectedFileName; + end; + +var + FileViewerChild: TFileViewerChild; + +implementation + +uses DependViewMain, ToolsUtils, JclSysInfo, JclStrings, JclFileUtils; + +{$R *.DFM} + +type + TPeModuleState = ( + modNoErrors, // Normal module with no errors. + modFwdNoErrors, // Forwarded module with no errors. + modDupNoErrors, // Duplicate module with no errors. + modDupFwdNoErrors, // Forwarded duplicate module with no errors. + modExportMissing, // Module with one or more missing export functions + modFwdExportMissing, // Forwarded module with one or more missing export functions + modDupExportMissing, // Duplicate module with one or more missing export functions + modDupFwdExportMissing, // Forwarded duplicate module with one or more missing export functions + modMissing, // Missing module. + modFwdMissing, // Missing forwarded module. + modInvalid, // Invalid module. + modFwdInvalid, // Invalid forwarded module. + modRoot // Root node. + ); + + TPeModuleImageInfo = record + ImageIndex, StateIndex: Integer; + end; + + PPeModuleNodeData = ^TPeModuleNodeData; + TPeModuleNodeData = record + State: TPeModuleState; + ImportDirectoryIndex: Integer; + end; + +const + imgModule = 0; + imgDupModule = 1; + imgModExportMissing = 2; + imgDupExportMissing = 3; + imgMissingModule = 4; + imgInvalidModule = 5; + imgForwardFlag = 6; + imgRoot = 7; + imgExport = 8; + imgFwdExport = 9; + imgImport = 10; + imgUnresolvedImport = 11; + imgSortAsceding = 12; + imgSortDesceding = 3; + + ErrorModules = [modMissing, modFwdMissing, modInvalid, modFwdInvalid]; + MissingExportModules = [modExportMissing, modFwdExportMissing, modDupExportMissing, + modDupFwdExportMissing, modMissing, modFwdMissing, modInvalid, modFwdInvalid]; + ForwardedModules = [modFwdNoErrors, modDupFwdNoErrors, modFwdExportMissing, + modDupFwdExportMissing]; + + ModuleImages: array[TPeModuleState] of TPeModuleImageInfo = ( + (ImageIndex: imgModule; StateIndex: -1), + (ImageIndex: imgModule; StateIndex: imgForwardFlag), + (ImageIndex: imgDupModule; StateIndex: -1), + (ImageIndex: imgDupModule; StateIndex: imgForwardFlag), + (ImageIndex: imgModExportMissing; StateIndex: -1), + (ImageIndex: imgModExportMissing; StateIndex: imgForwardFlag), + (ImageIndex: imgDupExportMissing; StateIndex: -1), + (ImageIndex: imgDupExportMissing; StateIndex: imgForwardFlag), + (ImageIndex: imgMissingModule; StateIndex: -1), + (ImageIndex: imgMissingModule; StateIndex: imgForwardFlag), + (ImageIndex: imgInvalidModule; StateIndex: -1), + (ImageIndex: imgInvalidModule; StateIndex: imgForwardFlag), + (ImageIndex: imgRoot; StateIndex: -1) + ); + +{ TFileViewerChild } + +procedure TFileViewerChild.FormCreate(Sender: TObject); +begin + FModulesList := TStringList.Create; + FModulesList.Sorted := True; + FModulesList.Duplicates := dupIgnore; + FExportViewImage := TJclPeImage.Create; + FPeImagesCache := TJclPeImagesCache.Create; +{$IFNDEF UsePeImagesCache} + FParentImportViewImage := TJclPeImage.Create; +{$ENDIF} + FCurrentImportDirIndex := -1; + ExportListView.Height := ListViewsPanel.ClientHeight div 2; + ImportListView.Tag := $100; + UpdateSortData(ImportListView.Columns[0]); + ExportListView.Tag := $100; + UpdateSortData(ExportListView.Columns[0]); + ModulesListView.Columns[0].Width := ColumnTextWidth; +end; + +procedure TFileViewerChild.FormDestroy(Sender: TObject); +begin + FModulesList.Free; + FExportViewImage.Free; + FPeImagesCache.Free; +{$IFNDEF UsePeImagesCache} + FParentImportViewImage.Free; +{$ENDIF} +end; + +procedure TFileViewerChild.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Fix_ListViewBeforeClose(Self); + Action := caFree; +end; + +function TFileViewerChild.GetModuleName: string; +begin + Result := ExtractFileName(FFileName); +end; + +procedure TFileViewerChild.InitTree; +var + RootNode: TTreeNode; + + procedure SetNodeState(Node: TTreeNode; State: TPeModuleState); +var + I: Integer; +begin + PPeModuleNodeData(Node.Data)^.State := State; + Node.ImageIndex := ModuleImages[State].ImageIndex; + Node.SelectedIndex := ModuleImages[State].ImageIndex; + Node.StateIndex := ModuleImages[State].StateIndex; + if State in (MissingExportModules + ErrorModules) then + begin + if Node.Parent = RootNode then FAnyRootError := True; + I := FModulesList.IndexOf(Node.Text); + Assert(I >= 0); + FModulesList.Objects[I] := Pointer(State); + end; +end; + + function AddNode(Node: TTreeNode; const Text: string; State: TPeModuleState): TTreeNode; +var + Data: PPeModuleNodeData; +begin + Result := DependencyTreeView.Items.AddChild(Node, Text); + New(Data); + Result.Data := Data; + SetNodeState(Result, State); +end; + + procedure ScanModule(const ModuleName: string; Node: TTreeNode; Forwarded, ErrorsOnly: Boolean); +var + ExeImage: TJclPeImage; + I, Found: Integer; + S: string; + TempNode: TTreeNode; + AddedNodes: array of TTreeNode; + AddedNodesCount: Integer; +begin + ExeImage := FPeImagesCache[ModuleToFilename(ModuleName)]; + case ExeImage.Status of + stOk: + if not ErrorsOnly then + begin + with ExeImage.ImportList do + begin + SetLength(AddedNodes, Count); + AddedNodesCount := 0; + CheckImports(FPeImagesCache); + SortList(ilName); + for I := 0 to Count - 1 do + begin + S := Items[I].Name; + Found := FModulesList.IndexOf(S); + if Found = -1 then + begin + Found := FModulesList.Add(S); + FModulesList.Objects[Found] := Pointer(modNoErrors); + if Items[I].TotalResolveCheck = icUnresolved then + TempNode := AddNode(Node, S, modExportMissing) + else + TempNode := AddNode(Node, S, modNoErrors); + AddedNodes[AddedNodesCount] := TempNode; + Inc(AddedNodesCount); + end else + begin + if Items[I].TotalResolveCheck = icUnresolved then + TempNode := AddNode(Node, S, modDupExportMissing) + else + TempNode := AddNode(Node, S, modDupNoErrors); + ScanModule(TempNode.Text, TempNode, False, True); // ! + end; + PPeModuleNodeData(TempNode.Data)^.ImportDirectoryIndex := Items[I].ImportDirectoryIndex; + end; + end; + for I := 0 to AddedNodesCount - 1 do + ScanModule(AddedNodes[I].Text, AddedNodes[I], False, False); + with ExeImage.ExportList do + begin + CheckForwards(FPeImagesCache); + for I := 0 to ForwardedLibsList.Count - 1 do + begin + S := ForwardedLibsList[I]; + Found := FModulesList.IndexOf(S); + if Found = -1 then + begin + Found := FModulesList.Add(S); + FModulesList.Objects[Found] := Pointer(modNoErrors); + if TJclPeResolveCheck(ForwardedLibsList.Objects[I]) = icUnresolved then + AddNode(Node, S, modFwdExportMissing) + else + AddNode(Node, S, modFwdNoErrors); + end else + begin + if TJclPeResolveCheck(ForwardedLibsList.Objects[I]) = icUnresolved then + TempNode := AddNode(Node, S, modDupFwdExportMissing) + else + TempNode := AddNode(Node, S, modDupFwdNoErrors); + ScanModule(TempNode.Text, TempNode, True, True); // ! + end; + end; + end; + end; + stNotFound: + if Forwarded then SetNodeState(Node, modFwdMissing) else SetNodeState(Node, modMissing); + else + if Forwarded then SetNodeState(Node, modFwdInvalid) else SetNodeState(Node, modInvalid); + end; +end; + +begin + with DependencyTreeView do + begin + Items.BeginUpdate; + try + Items.Clear; + Screen.Cursor := crHourGlass; + RootNode := AddNode(nil, ModuleName, modRoot); + FModulesList.AddObject(ModuleName, Pointer(modRoot)); + ScanModule(FFileName, RootNode, False, False); + RootNode.Expand(False); + Selected := RootNode; + finally + Items.EndUpdate; + Screen.Cursor := crDefault; + end; + end; + UpdateModulesView; +{$IFNDEF UsePeImagesCache} + FPeImagesCache.Clear; +{$ENDIF} +end; + +procedure TFileViewerChild.SetFileName(const Value: TFileName); +begin + FAnyRootError := False; + FFileName := Value; + FBasePath := ExtractFilePath(FFileName); + Caption := ModuleName; + InitTree; +end; + +class procedure TFileViewerChild.UpdateSortData(Column: TListColumn); +var + ListView: TListView; + I: Integer; +begin + ListView := TListView(TListColumns(Column.Collection).Owner); + ListView.Columns.BeginUpdate; + with ListView.Columns do + for I := 0 to Count - 1 do + Items[I].ImageIndex := -1; + if ListView.Tag and $FF = Column.Index then + ListView.Tag := ListView.Tag xor $100 + else + ListView.Tag := Column.Index; + if ListView.Tag and $100 = 0 then + Column.ImageIndex := imgSortAsceding + else + Column.ImageIndex := imgSortDesceding; + ListView.Columns.EndUpdate; +end; + +function TFileViewerChild.IsListViewActiveAndFocused( ListView: TListView): Boolean; +begin + Result := (ActiveControl = ListView) and (ListView.ItemFocused <> nil); +end; + +function TFileViewerChild.GetWin32Function: String; +begin + Result := ''; + if IsListViewActiveAndFocused(ImportListView) then + Result := ImportListView.ItemFocused.Caption + else + if IsListViewActiveAndFocused(ExportListView) then + Result := ExportListView.ItemFocused.Caption + else + Result := ''; + if Pos('@', Result) > 0 then + Result := '' + else + Result := StrRemoveChars(Result, ['[', ']']); +end; + +procedure TFileViewerChild.ExportListViewData(Sender: TObject; + Item: TListItem); +begin + with Item, FExportViewImage.ExportList[Item.Index] do + begin + Caption := Name; + SubItems.Add(Format('%d', [Ordinal])); + SubItems.Add(Format('%d', [Hint])); + SubItems.Add(AddressOrForwardStr); + if IsForwarded then ImageIndex := imgFwdExport else ImageIndex := imgExport; + end; +end; + +procedure TFileViewerChild.ImportListViewData(Sender: TObject; Item: TListItem); +var + ViewItem: TJclPeImportFuncItem; +begin + if FCurrentImportDirIndex = -1 then + ViewItem := FParentImportViewImage.ImportList.AllItems[Item.Index] + else + ViewItem := FParentImportViewImage.ImportList[FCurrentImportDirIndex][Item.Index]; + with Item, ViewItem do + begin + if IndirectImportName then + Caption := Format('[%s]', [Name]) + else + Caption := Name; + if Ordinal <> 0 then + begin + SubItems.Add(Format('%d', [Ordinal])); + SubItems.Add(''); + end else + begin + SubItems.Add(''); + SubItems.Add(Format('%d', [Hint])); + end; + if FCurrentImportDirIndex = -1 then SubItems.Add(ImportLib.Name); + case ResolveCheck of + icUnresolved: ImageIndex := imgUnresolvedImport; + icResolved, icNotChecked: ImageIndex := imgImport; + end; + end; +end; + +procedure TFileViewerChild.ExportListViewColumnClick(Sender: TObject; Column: TListColumn); +begin + UpdateSortData(Column); + ExportListViewSort; +end; + +procedure TFileViewerChild.ImportListViewColumnClick(Sender: TObject; Column: TListColumn); +begin + UpdateSortData(Column); + ImportListViewSort; +end; + +procedure TFileViewerChild.UpdateExportView(Node: TTreeNode); +begin + with ExportListView.Items do + begin + BeginUpdate; + if PPeModuleNodeData(Node.Data)^.State in ErrorModules then + FExportViewImage.FileName := '' + else + FExportViewImage.FileName := ModuleToFilename(Node.Text); + Count := FExportViewImage.ExportList.Count; + ExportListViewSort; + EndUpdate; + end; +end; + +procedure TFileViewerChild.UpdateParentImportView(Node: TTreeNode); +var + ParentFileName: TFileName; + NodeState: TPeModuleState; + + procedure ShowModuleColumn(B: Boolean); +begin + with ImportListView do + if (B xor (Columns.Count <> 3)) then + begin + Columns.BeginUpdate; + if B then Columns.Add.Caption := 'Module' else + begin + Columns[3].Free; + if Tag and $FF = 3 then + begin + Tag := $100; + UpdateSortData(Columns[0]); + ImportListViewSort; + end; + end; + Columns.EndUpdate; + end; +end; + +begin + with ImportListView.Items do + begin + BeginUpdate; + if Node.Parent = nil then + ParentFileName := Node.Text + else + ParentFileName := Node.Parent.Text; + ParentFileName := ModuleToFilename(ParentFileName); + NodeState := PPeModuleNodeData(Node.Data)^.State; +{$IFDEF UsePeImagesCache} + FParentImportViewImage := FPeImagesCache[ParentFileName]; + FParentImportViewImage.ImportList.SortList(ilIndex); +{$ELSE} + FParentImportViewImage.FileName := ParentFileName; +{$ENDIF} + if (NodeState in MissingExportModules + ErrorModules) or FAnyRootError then + FParentImportViewImage.ImportList.CheckImports; + FParentImportViewImage.TryGetNamesForOrdinalImports; + if NodeState in ForwardedModules then + begin + ShowModuleColumn(False); + FCurrentImportDirIndex := -1; + FParentImportViewImage.ImportList.FilterModuleName := Node.Text; + Count := FParentImportViewImage.ImportList.AllItemCount; + end else + if Node.Parent = nil then + begin + ShowModuleColumn(True); + FCurrentImportDirIndex := -1; + FParentImportViewImage.ImportList.FilterModuleName := ''; + Count := FParentImportViewImage.ImportList.AllItemCount; + end else + begin + ShowModuleColumn(False); + FCurrentImportDirIndex := PPeModuleNodeData(Node.Data)^.ImportDirectoryIndex; + Count := FParentImportViewImage.ImportList[FCurrentImportDirIndex].Count; + end; + ImportListViewSort; + EndUpdate; + end; +end; + +procedure TFileViewerChild.DependencyTreeViewChange(Sender: TObject; Node: TTreeNode); +begin + UpdateExportView(Node); + UpdateParentImportView(Node); +end; + +procedure TFileViewerChild.DependencyTreeViewDeletion(Sender: TObject; Node: TTreeNode); +begin + Dispose(Node.Data); // PPeModuleNodeData +end; + +procedure TFileViewerChild.ImportListViewSort; +const + MapIndexToSortType: array[0..3] of TJclPeImportSort = (isName, isOrdinal, isHint, isLibImport); +begin + with ImportListView do + begin + if FCurrentImportDirIndex = -1 then + FParentImportViewImage.ImportList.SortAllItemsList(MapIndexToSortType[Tag and $FF], Tag and $100 <> 0) + else + FParentImportViewImage.ImportList[FCurrentImportDirIndex].SortList(MapIndexToSortType[Tag and $FF], Tag and $100 <> 0); + Invalidate; + end; +end; + +procedure TFileViewerChild.ExportListViewSort; +const + MapIndexToSortType: array[0..3] of TJclPeExportSort = + (esName, esOrdinal, esHint, esAddrOrFwd); +begin + with ExportListView do + begin + FExportViewImage.ExportList.SortList(MapIndexToSortType[Tag and $FF], Tag and $100 <> 0); + Invalidate; + end; +end; + +procedure TFileViewerChild.UpdateModulesView; +var + I: Integer; + ExeImage: TJclPeImage; + VI: TJclFileVersionInfo; +begin + with ModulesListView.Items do + begin + BeginUpdate; + try + Clear; + for I := 0 to FModulesList.Count - 1 do + with Add, FModulesList do + begin + ExeImage := FPeImagesCache.Images[ModuleToFilename(Strings[I])]; + Caption := ExtractFileName(ExeImage.FileName); + Data := Objects[I]; + if ExeImage.Status = stOk then + begin + VI := ExeImage.VersionInfo; + with ExeImage.FileProperties, SubItems do + begin + Add(FormatDateTime('ddddd tt', LastWriteTime)); + Add(Format('%.0n', [IntToExtended(Size)])); + end; + with ExeImage, SubItems do + begin + Add(HeaderValues[JclPeHeader_Subsystem]); + Add(HeaderValues[JclPeHeader_ImageBase]); + if Assigned(VI) then Add(VI.FileVersion) else Add(''); + if Assigned(VI) then Add(VI.ProductVersion) else Add(''); + Add(HeaderValues[JclPeHeader_ImageVersion]); + Add(HeaderValues[JclPeHeader_LinkerVersion]); + Add(HeaderValues[JclPeHeader_OperatingSystemVersion]); + Add(HeaderValues[JclPeHeader_SubsystemVersion]); + if Assigned(VI) then Add(VI.FileDescription) else Add(''); + end; + end; + ImageIndex := ModuleImages[TPeModuleState(Objects[I])].ImageIndex; + end; + finally + EndUpdate; + end; + end; +end; + +procedure TFileViewerChild.ModulesListViewInfoTip(Sender: TObject; Item: TListItem; var InfoTip: String); +begin + with Item.SubItems do + if Count > 10 then + InfoTip := Strings[5] + #13#10 + Strings[10] + else + InfoTip := ''; +end; + +function TFileViewerChild.ModuleToFileName(const ModuleName: string): TFileName; +begin + Result := TJclPeImage.ExpandBySearchPath(ModuleName, FBasePath); +end; + +function TFileViewerChild.GetSelectedFileName: TFileName; +var + S: string; +begin + S := ''; + if ActiveControl = DependencyTreeView then + begin + with DependencyTreeView do + if Selected <> nil then + if Selected.Level = 0 then S := FFileName else + S := Selected.Text; + end else + if Activecontrol = ModulesListView then + with ModulesListView do + if Selected <> nil then + S := Selected.Caption; + Result := ModuleToFileName(S); +end; + +procedure TFileViewerChild.ExportListViewDblClick(Sender: TObject); +begin + MainForm.Win32Help1.Execute; +end; + +procedure TFileViewerChild.ModulesListViewDblClick(Sender: TObject); +begin + MainForm.DumpPe1.Execute; +end; + +// History: + +// $Log: FileViewer.pas,v $ +// Revision 1.3 2005/12/04 10:10:57 obones +// Borland Developer Studio 2006 support +// +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeDump.dfm b/official/1.96/examples/windows/delphitools/peviewer/PeDump.dfm new file mode 100644 index 0000000..54f3017 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeDump.dfm @@ -0,0 +1,499 @@ +object PeDumpChild: TPeDumpChild + Left = 195 + Top = 152 + AutoScroll = False + Caption = 'PeDumpChild' + ClientHeight = 347 + ClientWidth = 592 + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 250 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + PopupMenu = PopupMenu1 + Position = poDefault + ShowHint = True + Visible = True + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 121 + Top = 0 + Width = 3 + Height = 347 + Cursor = crHSplit + ResizeStyle = rsUpdate + end + object SectionTreeView: TTreeView + Left = 0 + Top = 0 + Width = 121 + Height = 347 + Align = alLeft + HideSelection = False + HotTrack = True + Images = MainForm.IconImageList + Indent = 19 + ReadOnly = True + TabOrder = 0 + OnChange = SectionTreeViewChange + OnDblClick = SectionTreeViewDblClick + OnExpanding = SectionTreeViewExpanding + end + object PageControl1: TPageControl + Left = 124 + Top = 0 + Width = 468 + Height = 347 + ActivePage = ItemsTab + Align = alClient + TabOrder = 1 + TabStop = False + object ItemsTab: TTabSheet + Caption = 'ItemsTab' + object ItemsListView: TListView + Left = 0 + Top = 0 + Width = 460 + Height = 319 + Align = alClient + Columns = < + item + Caption = 'Item' + Width = 200 + end + item + Caption = 'Value' + Width = 100 + end> + ColumnClick = False + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnData = ItemsListViewData + end + end + object DirectoryTab: TTabSheet + Caption = 'DirectoryTab' + ImageIndex = 1 + object DirectoryListView: TListView + Left = 0 + Top = 0 + Width = 460 + Height = 319 + Align = alClient + Columns = < + item + Caption = 'Directory' + Width = 120 + end + item + Caption = 'RVA' + Width = 80 + end + item + Alignment = taRightJustify + Caption = 'Size' + Width = 80 + end + item + Alignment = taRightJustify + Caption = 'Percent of file' + Width = 80 + end + item + Caption = 'Section' + Width = 70 + end> + ColumnClick = False + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnCustomDrawItem = DirectoryListViewCustomDrawItem + OnData = DirectoryListViewData + end + end + object ImportTab: TTabSheet + Caption = 'ImportTab' + ImageIndex = 2 + object ImportListView: TListView + Left = 0 + Top = 0 + Width = 460 + Height = 300 + Align = alClient + Columns = < + item + Caption = 'Name' + Width = 230 + end + item + Caption = 'Ordinal' + Width = 60 + end + item + Caption = 'Hint' + end + item + Caption = 'Module' + Width = 90 + end> + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = ImportListViewColumnClick + OnData = ImportListViewData + OnDblClick = ImportListViewDblClick + end + object ImportStatusBar: TStatusBar + Left = 0 + Top = 300 + Width = 460 + Height = 19 + Panels = < + item + Width = 90 + end + item + Width = 90 + end + item + Width = 50 + end> + SimplePanel = False + end + end + object ExportTab: TTabSheet + Caption = 'ExportTab' + ImageIndex = 3 + object ExportListView: TListView + Left = 0 + Top = 0 + Width = 460 + Height = 300 + Align = alClient + Columns = < + item + Caption = 'Name' + Width = 250 + end + item + Alignment = taRightJustify + Caption = 'Ordinal' + end + item + Alignment = taRightJustify + Caption = 'Hint' + end + item + Caption = 'Address' + Width = 70 + end + item + Caption = 'Forwarded' + Width = 100 + end + item + Caption = 'Section' + end> + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = ExportListViewColumnClick + OnData = ExportListViewData + OnDblClick = ImportListViewDblClick + end + object ExportStatusBar: TStatusBar + Left = 0 + Top = 300 + Width = 460 + Height = 19 + Panels = < + item + Width = 90 + end + item + Width = 90 + end + item + Width = 100 + end + item + Width = 50 + end> + SimplePanel = False + end + end + object ResourceTab: TTabSheet + Caption = 'ResourceTab' + ImageIndex = 4 + object ResourceListView: TListView + Left = 0 + Top = 0 + Width = 460 + Height = 319 + Align = alClient + Columns = < + item + Caption = 'Names' + Width = 200 + end + item + Caption = 'Offset' + Width = 100 + end + item + Caption = 'Size' + end + item + Caption = 'Languages' + Width = 70 + end> + ColumnClick = False + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnData = ResourceListViewData + end + end + object SectionTab: TTabSheet + Caption = 'SectionTab' + ImageIndex = 5 + object SectionListView: TListView + Left = 0 + Top = 0 + Width = 460 + Height = 319 + Align = alClient + Columns = < + item + Caption = 'Section' + Width = 70 + end + item + Caption = 'VirtSize' + Width = 70 + end + item + Caption = 'RVA' + Width = 70 + end + item + Caption = 'PhysSize' + Width = 70 + end + item + Caption = 'PhysOfs' + Width = 70 + end + item + Caption = 'Flags' + Width = 70 + end + item + Caption = 'Info' + end + item + Alignment = taRightJustify + Caption = 'Percent of file' + Width = 79 + end> + ColumnClick = False + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnData = SectionListViewData + end + end + object ResourceDirTab: TTabSheet + Caption = 'ResourceDirTab' + ImageIndex = 6 + object ResourceDirListView: TListView + Left = 0 + Top = 0 + Width = 460 + Height = 319 + Align = alClient + Columns = < + item + Caption = 'Type' + Width = 200 + end + item + Caption = 'Count' + Width = 100 + end> + ColumnClick = False + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnData = ResourceDirListViewData + end + end + object RelocTab: TTabSheet + Caption = 'RelocTab' + ImageIndex = 7 + object RelocListView: TListView + Left = 0 + Top = 0 + Width = 460 + Height = 300 + Align = alClient + Columns = < + item + Caption = 'Address' + Width = 200 + end + item + Caption = 'Type' + Width = 100 + end> + ColumnClick = False + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnData = RelocListViewData + end + object RelocStatusBar: TStatusBar + Left = 0 + Top = 300 + Width = 460 + Height = 19 + Panels = < + item + Width = 100 + end + item + Width = 50 + end> + SimplePanel = False + end + end + object DebugTab: TTabSheet + Caption = 'DebugTab' + ImageIndex = 8 + object DebugListView: TListView + Left = 0 + Top = 0 + Width = 460 + Height = 319 + Align = alClient + Columns = < + item + Caption = 'Type' + Width = 100 + end + item + Caption = 'Size' + Width = 70 + end + item + Caption = 'RVA' + Width = 70 + end + item + Caption = 'FilePtr' + Width = 70 + end + item + Caption = 'Version' + end> + ColumnClick = False + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnData = DebugListViewData + end + end + end + object PopupMenu1: TPopupMenu + Images = MainForm.ToolbarImagesList + Left = 16 + Top = 312 + object Copytoclipboard1: TMenuItem + Action = MainForm.Copy1 + end + object Selectall1: TMenuItem + Action = MainForm.SelectAll1 + end + object N1: TMenuItem + Caption = '-' + end + object Openlibrary1: TMenuItem + Action = MainForm.OpenLibrary1 + end + object FindinWin32APIhelp1: TMenuItem + Action = MainForm.InvokeHelp1 + Default = True + end + end +end diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeDump.pas b/official/1.96/examples/windows/delphitools/peviewer/PeDump.pas new file mode 100644 index 0000000..9ce578a --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeDump.pas @@ -0,0 +1,934 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 PeDump.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2006/01/15 11:21:32 $ } +{ } +{**************************************************************************************************} + +unit PeDump; + +{$I jcl.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + JclPeImage, ComCtrls, ExtCtrls, Menus; + +type + TPeDumpViewCategory = (vcHeader, vcDirectory, vcSection, vcLoadConfig, + vcImport, vcExport, vcResource, vcRelocation, vcDebug); + + TPeDumpChild = class(TForm) + SectionTreeView: TTreeView; + Splitter1: TSplitter; + PageControl1: TPageControl; + ItemsTab: TTabSheet; + DirectoryTab: TTabSheet; + ItemsListView: TListView; + DirectoryListView: TListView; + ImportTab: TTabSheet; + ImportListView: TListView; + ExportTab: TTabSheet; + ExportListView: TListView; + PopupMenu1: TPopupMenu; + Copytoclipboard1: TMenuItem; + Selectall1: TMenuItem; + N1: TMenuItem; + Openlibrary1: TMenuItem; + FindinWin32APIhelp1: TMenuItem; + ResourceTab: TTabSheet; + ResourceListView: TListView; + SectionTab: TTabSheet; + SectionListView: TListView; + ResourceDirTab: TTabSheet; + ResourceDirListView: TListView; + ExportStatusBar: TStatusBar; + ImportStatusBar: TStatusBar; + RelocTab: TTabSheet; + RelocListView: TListView; + RelocStatusBar: TStatusBar; + DebugTab: TTabSheet; + DebugListView: TListView; + procedure FormCreate(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure ItemsListViewData(Sender: TObject; Item: TListItem); + procedure SectionTreeViewChange(Sender: TObject; Node: TTreeNode); + procedure DirectoryListViewData(Sender: TObject; Item: TListItem); + procedure ImportListViewColumnClick(Sender: TObject; + Column: TListColumn); + procedure ImportListViewData(Sender: TObject; Item: TListItem); + procedure FormDestroy(Sender: TObject); + procedure ExportListViewData(Sender: TObject; Item: TListItem); + procedure ExportListViewColumnClick(Sender: TObject; + Column: TListColumn); + procedure SectionTreeViewDblClick(Sender: TObject); + procedure SectionListViewData(Sender: TObject; Item: TListItem); + procedure ResourceListViewData(Sender: TObject; Item: TListItem); + procedure ResourceDirListViewData(Sender: TObject; Item: TListItem); + procedure ImportListViewDblClick(Sender: TObject); + procedure DirectoryListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure SectionTreeViewExpanding(Sender: TObject; Node: TTreeNode; + var AllowExpansion: Boolean); + procedure RelocListViewData(Sender: TObject; Item: TListItem); + procedure DebugListViewData(Sender: TObject; Item: TListItem); + procedure ItemsListViewInfoTip(Sender: TObject; Item: TListItem; + var InfoTip: String); + private + FCurrentResourceDirectory: TJclPeResourceItem; + FCurrentImportIndex: Integer; + FCurrentRelocationIndex: Integer; + FOriginalPageControlWndProc: TWndMethod; + FPeImage: TJclPeImage; + FGroupImports: Boolean; + FUpdatingView: Boolean; + FUnmangleNames: Boolean; + function GetFileName: TFileName; + function GetHasDirectory(const Directory: DWORD): Boolean; + function GetNodeCategory(Node: TTreeNode): TPeDumpViewCategory; + procedure ExportListViewSort; + procedure ImportListViewSort; + function IsListViewActiveAndFocused(ListView: TListView): Boolean; + procedure PageControlWndProc(var Message: TMessage); + procedure UpdateView; + procedure UpdateImportView(Node: TTreeNode); + procedure UpdateRelocationView(Node: TTreeNode); + procedure UpdateResourceDir; + procedure UpdateResourceView(Directory: TJclPeResourceItem); + class procedure UpdateSortData(Column: TListColumn); + procedure SetGroupImports(const Value: Boolean); + procedure SetUnmangleNames(const Value: Boolean); + function FunctionName(const Name: string): string; + function HeadersRemark(HeaderItem: TJclPeHeader): string; + public + constructor CreateEx(AOwner: TComponent; APeImage: TJclPeImage); + function ActiveLibName: string; + function ActiveWin32Function: string; + property FileName: TFileName read GetFileName; + property HasDirectory[const Directory: DWORD]: Boolean read GetHasDirectory; + property GroupImports: Boolean read FGroupImports write SetGroupImports; + property PeImage: TJclPeImage read FPeImage; + property UnmangleNames: Boolean read FUnmangleNames write SetUnmangleNames; + end; + +var + PeDumpChild: TPeDumpChild; + +implementation + +{$R *.DFM} + +uses + CommCtrl, PeViewerMain, ToolsUtils, PeResource, JclStrings, JclWin32; + +resourcestring + RsHeader = 'Header'; + RsDirectory = 'Directory'; + RsSection = 'Sections'; + RsLoadConfig = 'Load config'; + RsImport = 'Imports'; + RsExport = 'Exports'; + RsRelocation = 'Relocations'; + RsResource = 'Resources'; + RsDebug = 'Debug'; + RsNumberOfNames = 'Names: %d'; + RsNumberOfFunctions = 'Functions: %d'; + RsLinkerProducer = 'Linker: %s'; + RsOrdinalBase = 'Ordinal base: %d'; + RsAddresses = 'Addresses: %d'; + +function GetCategoryName(Category: TPeDumpViewCategory): string; +begin + case Category of + vcHeader: Result := RsHeader; + vcDirectory: Result := RsDirectory; + vcSection: Result := RsSection; + vcLoadConfig: Result := RsLoadConfig; + vcImport: Result := RsImport; + vcExport: Result := RsExport; + vcResource: Result := RsResource; + vcRelocation: Result := RsRelocation; + vcDebug: Result := RsDebug; + end; +end; + +function ImageIndexFromImportKind(Kind: TJclPeImportKind): Integer; +begin + case Kind of + ikImport: + Result := icoImports; + ikDelayImport: + Result := icoDelayImport; + ikBoundImport: + Result := icoBoundImport; + else + Result := 0; + end; +end; + +{ TPeDumpChild } + +function TPeDumpChild.ActiveLibName: string; +begin + with SectionTreeView do + if (Selected <> nil) and (Selected.Level = 1) and + (TPeDumpViewCategory(Selected.Parent.Data) = vcImport) then + Result := FPeImage.ExpandBySearchPath(Selected.Text, ExtractFilePath(FileName)) + else + Result := ''; +end; + +function TPeDumpChild.ActiveWin32Function: string; +begin + Result := ''; + if IsListViewActiveAndFocused(ImportListView) then + Result := ImportListView.ItemFocused.Caption + else + if IsListViewActiveAndFocused(ExportListView) then + Result := ExportListView.ItemFocused.Caption + else + Result := ''; + if Pos('@', Result) > 0 then + Result := '' + else + Result := StrRemoveChars(Result, ['[', ']']); +end; + +constructor TPeDumpChild.CreateEx(AOwner: TComponent; APeImage: TJclPeImage); +begin + inherited Create(AOwner); + FPeImage := APeImage; + Caption := ExtractFileName(FileName); + {$IFDEF COMPILER5_UP} + ItemsListView.OnInfoTip := ItemsListViewInfoTip; + {$ENDIF COMPILER5_UP} +end; + +function TPeDumpChild.GetFileName: TFileName; +begin + if FPeImage = nil then Result := '' else Result := FPeImage.FileName; +end; + +function TPeDumpChild.GetHasDirectory(const Directory: DWORD): Boolean; +begin + if FPeImage = nil then + Result := False + else + Result := FPeImage.DirectoryExists[Directory]; +end; + +procedure TPeDumpChild.PageControlWndProc(var Message: TMessage); +begin +// remove PageControl's border + FOriginalPageControlWndProc(Message); + with Message do + if (Msg = TCM_ADJUSTRECT) and (Message.WParam = 0) then + InflateRect(PRect(LParam)^, 4, 4); +end; + +procedure TPeDumpChild.FormCreate(Sender: TObject); +var + I: Integer; +begin + with PageControl1 do + begin + for I := 0 to PageCount - 1 do Pages[I].TabVisible := False; + FOriginalPageControlWndProc := WindowProc; + WindowProc := PageControlWndProc; + ActivePage := ItemsTab; + Realign; + end; + + ImportListView.Tag := $100; + UpdateSortData(ImportListView.Columns[0]); + ExportListView.Tag := $100; + UpdateSortData(ExportListView.Columns[0]); + + UpdateView; +end; + +procedure TPeDumpChild.FormClose(Sender: TObject; var Action: TCloseAction); +var + F: TForm; +begin + Fix_ListViewBeforeClose(Self); + F := MainForm.FindPeResourceView(FPeImage); + if F <> nil then F.Close; + Action := caFree; +end; + +procedure TPeDumpChild.UpdateView; + + procedure BuildImageTree; +var + Category: TPeDumpViewCategory; + TempNode: TTreeNode; + + function AddCategoryNode(ImageIndex: Integer): TTreeNode; +begin + Result := SectionTreeView.Items.AddChildObject(nil, GetCategoryName(Category), + Pointer(Category)); + Result.ImageIndex := ImageIndex; + Result.SelectedIndex := ImageIndex; +end; + +begin + FPeImage.TryGetNamesForOrdinalImports; + with SectionTreeView do + begin + Items.BeginUpdate; + try + Items.Clear; + for Category := Low(Category) to High(Category) do + case Category of + vcHeader: + AddCategoryNode(icoHeader); + vcDirectory: + AddCategoryNode(icoDirectory); + vcSection: + AddCategoryNode(icoSection); + vcLoadConfig: + if FPeImage.DirectoryExists[IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG] then + AddCategoryNode(icoLoadConfig); + vcImport: + if FPeImage.DirectoryExists[IMAGE_DIRECTORY_ENTRY_IMPORT] then + begin + TempNode := AddCategoryNode(icoImports); + TempNode.HasChildren := True; + end; + vcExport: + if FPeImage.DirectoryExists[IMAGE_DIRECTORY_ENTRY_EXPORT] then + AddCategoryNode(icoExports); + vcRelocation: + if FPeImage.DirectoryExists[IMAGE_DIRECTORY_ENTRY_BASERELOC] then + begin + TempNode := AddCategoryNode(icoRelocation); + TempNode.HasChildren := True; + end; + vcResource: + if FPeImage.DirectoryExists[IMAGE_DIRECTORY_ENTRY_RESOURCE] then + begin + TempNode := AddCategoryNode(icoResources); + TempNode.HasChildren := True; + end; + vcDebug: + if FPeImage.DirectoryExists[IMAGE_DIRECTORY_ENTRY_DEBUG] then + AddCategoryNode(icoDebug); + end; + Selected := Items.GetFirstNode; + finally + Items.EndUpdate; + end; + end; +end; + +begin + BuildImageTree; + + with DirectoryListView do + begin + Items.Count := IMAGE_NUMBEROF_DIRECTORY_ENTRIES; + ItemFocused := Items[0]; + end; + with SectionListView do + begin + Items.Count := FPeImage.ImageSectionCount; + if Items.Count > 0 then ItemFocused := Items[0]; + end; + ExportListView.Items.Count := FPeImage.ExportList.Count; + UpdateResourceDir; + with ExportStatusBar, FPeImage.ExportList do + begin + Panels[0].Text := Format(RsNumberOfNames, [Count]); + Panels[1].Text := Format(RsNumberOfFunctions, [FunctionCount]); + Panels[2].Text := Format(RsOrdinalBase, [Base]); + end; +end; + +procedure TPeDumpChild.ItemsListViewData(Sender: TObject; Item: TListItem); +begin + with Item, FPeImage do + case TListView(Sender).Tag of + 0: begin + Caption := HeaderNames(TJclPeHeader(Index)); + SubItems.Add(HeaderValues[TJclPeHeader(Index)]); + end; + 1: begin + Caption := LoadConfigNames(TJclLoadConfig(Index)); + SubItems.Add(LoadConfigValues[TJclLoadConfig(Index)]); + end; + end; +end; + +procedure TPeDumpChild.SectionTreeViewExpanding(Sender: TObject; + Node: TTreeNode; var AllowExpansion: Boolean); +var + I: Integer; + TempNode: TTreeNode; + ResItem: TJclPeResourceItem; +begin + if Node.GetFirstChild = nil then with SectionTreeView do + begin + Items.BeginUpdate; + case GetNodeCategory(Node) of + vcImport: + if GroupImports then + begin + for I := 0 to FPeImage.ImportList.UniqueLibItemCount - 1 do + with Items.AddChild(Node, FPeImage.ImportList.UniqueLibNames[I]) do + begin + Data := Pointer(-1); + ImageIndex := ImageIndexFromImportKind(FPeImage.ImportList.UniqueLibItems[I].ImportKind); + SelectedIndex := ImageIndex; + end; + end else + begin +// FPeImage.ImportList.SortList(ilName); + for I := 0 to FPeImage.ImportList.Count - 1 do + with Items.AddChild(Node, FPeImage.ImportList[I].Name) do + begin + Data := Pointer(FPeImage.ImportList[I].ImportDirectoryIndex); + ImageIndex := ImageIndexFromImportKind(FPeImage.ImportList[I].ImportKind); + SelectedIndex := ImageIndex; + end; + end; + vcResource: + if Node.Level = 0 then + for I := 0 to FPeImage.ResourceList.Count - 1 do + begin + ResItem := FPeImage.ResourceList[I]; + TempNode := Items.AddChildObject(Node, ResItem.ResourceTypeStr, ResItem); + TempNode.ImageIndex := icoResources; + TempNode.SelectedIndex := TempNode.ImageIndex; + TempNode.HasChildren := True; + end + else + begin + ResItem := TJclPeResourceItem(Node.Data); + for I := 0 to ResItem.List.Count - 1 do + with Items.AddChildObject(Node, ResItem.List[I].Name, ResItem.List[I]) do + begin + ImageIndex := icoResources; + SelectedIndex := ImageIndex; + end; + end; + vcRelocation: + for I := 0 to FPeImage.RelocationList.Count - 1 do + with Items.AddChildObject(Node, + Format('%.8x', [FPeImage.RelocationList[I].VirtualAddress]), Pointer(I)) do + begin + ImageIndex := icoRelocation; + SelectedIndex := ImageIndex; + end; + end; + Items.EndUpdate; + end; +end; + +procedure TPeDumpChild.SectionTreeViewChange(Sender: TObject; Node: TTreeNode); +begin + if FUpdatingView then Exit; + case GetNodeCategory(Node) of + vcHeader: + begin + ItemsListView.Items.Count := Integer(High(TJclPeHeader)) + 1; + ItemsListView.Tag := 0; // Header items + ItemsListView.Invalidate; + PageControl1.ActivePage := ItemsTab; + end; + vcDirectory: PageControl1.ActivePage := DirectoryTab; + vcSection: PageControl1.ActivePage := SectionTab; + vcLoadConfig: + begin + ItemsListView.Items.Count := Integer(High(TJclLoadConfig)) + 1; + ItemsListView.Tag := 1; // Load config items + ItemsListView.Invalidate; + PageControl1.ActivePage := ItemsTab; + end; + vcImport: + begin + if Node.Level = 0 then UpdateImportView(nil) else UpdateImportView(Node); + PageControl1.ActivePage := ImportTab; + end; + vcExport: + PageControl1.ActivePage := ExportTab; + vcRelocation: + begin + UpdateRelocationView(Node); + PageControl1.ActivePage := RelocTab; + end; + vcResource: + if Node.Level = 0 then + begin + UpdateResourceDir; + PageControl1.ActivePage := ResourceDirTab; + end else + begin + UpdateResourceView(TJclPeResourceItem(Node.Data)); + PageControl1.ActivePage := ResourceTab; + end; + vcDebug: + begin + DebugListView.Items.Count := FPeImage.DebugList.Count; + PageControl1.ActivePage := DebugTab; + end; + end; +end; + +procedure TPeDumpChild.DirectoryListViewData(Sender: TObject; Item: TListItem); +const + DirectoryIcons: array[0..15] of Integer = + (icoExports, icoImports, icoResources, -1, -1, icoRelocation, icoDebug, + -1, -1, -1, icoLoadConfig, icoBoundImport, -1, icoDelayImport, -1, -1); +var + Percent: Single; +begin + with Item, FPeImage.OptionalHeader do + begin + Percent := DataDirectory[Index].Size * 100 / SizeOfImage; + Caption := FPeImage.DirectoryNames(Index); + Data := Pointer(DataDirectory[Index].Size); + if Integer(Data) <> 0 then ImageIndex := DirectoryIcons[Index]; + SubItems.Add(Format('%.8x', [DataDirectory[Index].VirtualAddress])); + SubItems.Add(Format('%.8x', [DataDirectory[Index].Size])); + SubItems.Add(Format('%3.1f%%', [Percent])); + SubItems.Add(FPeImage.ImageSectionNameFromRva[DataDirectory[Index].VirtualAddress]); + end; +end; + +class procedure TPeDumpChild.UpdateSortData(Column: TListColumn); +var + ListView: TListView; + I: Integer; +begin + ListView := TListView(TListColumns(Column.Collection).Owner); + ListView.Columns.BeginUpdate; + with ListView.Columns do + for I := 0 to Count - 1 do + Items[I].ImageIndex := -1; + if ListView.Tag and $FF = Column.Index then + ListView.Tag := ListView.Tag xor $100 + else + ListView.Tag := Column.Index; + if ListView.Tag and $100 = 0 then + Column.ImageIndex := icoSortDesc + else + Column.ImageIndex := icoSortAsc; + ListView.Columns.EndUpdate; +end; + +procedure TPeDumpChild.ImportListViewColumnClick(Sender: TObject; Column: TListColumn); +begin + UpdateSortData(Column); + ImportListViewSort; +end; + +procedure TPeDumpChild.UpdateImportView(Node: TTreeNode); +const + LinkerProducers: array[TJclPeLinkerProducer] of string = + ('Borland', 'Microsoft'); +begin + FCurrentImportIndex := -1; + if Node = nil then + begin + FPeImage.ImportList.FilterModuleName := ''; + ImportListView.Items.Count := FPeImage.ImportList.AllItemCount; + end else + if Integer(Node.Data) = -1 then + begin + FPeImage.ImportList.FilterModuleName := Node.Text; + ImportListView.Items.Count := FPeImage.ImportList.AllItemCount; + end else + begin + FCurrentImportIndex := Integer(Node.Data); + ImportListView.Items.Count := FPeImage.ImportList[FCurrentImportIndex].Count; + end; + ImportListViewSort; + ImportListView.Invalidate; + with ImportStatusBar, FPeImage.ImportList do + begin + Panels[0].Text := Format(RsNumberOfFunctions, [ImportListView.Items.Count]); + Panels[1].Text := Format(RsLinkerProducer, [LinkerProducers[LinkerProducer]]); + end; +end; + +procedure TPeDumpChild.ImportListViewData(Sender: TObject; Item: TListItem); +var + ViewItem: TJclPeImportFuncItem; +begin + if FCurrentImportIndex = -1 then + ViewItem := FPeImage.ImportList.AllItems[Item.Index] + else + ViewItem := FPeImage.ImportList[FCurrentImportIndex][Item.Index]; + with Item, ViewItem do + begin + if IndirectImportName then + Caption := Format('[%s]', [Name]) + else + Caption := FunctionName(Name); + if IsByOrdinal then + begin + SubItems.Add(Format('%d', [Ordinal])); + SubItems.Add(''); + end else + begin + SubItems.Add(''); + SubItems.Add(Format('%d', [Hint])); + end; + SubItems.Add(ImportLib.Name); + ImageIndex := ImageIndexFromImportKind(ImportLib.ImportKind); + end; +end; + +procedure TPeDumpChild.FormDestroy(Sender: TObject); +begin + FPeImage.Free; +end; + +procedure TPeDumpChild.ExportListViewData(Sender: TObject; Item: TListItem); +begin + with Item, FPeImage.ExportList[Item.Index] do + begin + Caption := FunctionName(Name); + SubItems.Add(Format('%d', [Ordinal])); + SubItems.Add(Format('%d', [Hint])); + SubItems.Add(Format('%.8x', [Address])); + SubItems.Add(ForwardedName); + SubItems.Add(SectionName); + ImageIndex := 3; + end; +end; + +procedure TPeDumpChild.ExportListViewColumnClick(Sender: TObject; + Column: TListColumn); +begin + UpdateSortData(Column); + ExportListViewSort; +end; + +function TPeDumpChild.IsListViewActiveAndFocused(ListView: TListView): Boolean; +begin + Result := (ActiveControl = ListView) and (ListView.ItemFocused <> nil); +end; + +procedure TPeDumpChild.SectionTreeViewDblClick(Sender: TObject); +begin + MainForm.OpenLibrary1.Execute; +end; + +procedure TPeDumpChild.SectionListViewData(Sender: TObject; Item: TListItem); +var + Percent: Single; +begin + with FPeImage, Item do + begin + Caption := ImageSectionNames[Item.Index]; + with ImageSectionHeaders[Item.Index] do + begin + Percent := SizeOfRawData * 100 / OptionalHeader.SizeOfImage; + SubItems.Add(Format('%.8x', [Misc.VirtualSize])); + SubItems.Add(Format('%.8x', [VirtualAddress])); + SubItems.Add(Format('%.8x', [SizeOfRawData])); + SubItems.Add(Format('%.8x', [PointerToRawData])); + SubItems.Add(Format('%.8x', [Characteristics])); + SubItems.Add(ShortSectionInfo(Characteristics)); + SubItems.Add(Format('%3.1f%%', [Percent])); + end; + end; +end; + +procedure TPeDumpChild.UpdateResourceView(Directory: TJclPeResourceItem); +begin + ResourceListView.Items.Count := 0; + FCurrentResourceDirectory := Directory; + ResourceListView.Items.Count := Directory.List.Count; + ResourceListView.Invalidate; +end; + +procedure TPeDumpChild.ResourceListViewData(Sender: TObject; Item: TListItem); +var + DirSize, I: Integer; +begin + with Item, FCurrentResourceDirectory.List[Item.Index] do + begin + if IsDirectory then + begin + Caption := Name; + if (List.Count = 1) and (StrToIntDef(List[0].Name, 0) = LANG_NEUTRAL) then + begin // only neutral language + DirSize := List[0].DataEntry^.Size; + SubItems.Add(Format('(%x)', [List[0].DataEntry^.OffsetToData])); + end else + begin + DirSize := 0; + for I := 0 to List.Count - 1 do + Inc(DirSize, List[I].DataEntry^.Size); + SubItems.Add(''); + end; + SubItems.Add(Format('%x', [DirSize])); + SubItems.Add(Format('%d', [List.Count])); + end else + begin + Caption := Format('%s (%s)', [ParentItem.Name, Name]); + SubItems.Add(Format('%x', [DataEntry^.OffsetToData])); + SubItems.Add(Format('%x', [DataEntry^.Size])); + SubItems.Add(LangNameFromName(Name)); + end; + end; +end; + +procedure TPeDumpChild.UpdateResourceDir; +begin + ResourceDirListView.Items.Count := FPeImage.ResourceList.Count; + ResourceDirListView.Invalidate; +end; + +procedure TPeDumpChild.ResourceDirListViewData(Sender: TObject; Item: TListItem); +begin + with Item, FPeImage.ResourceList[Item.Index] do + begin + Caption := ResourceTypeStr; + SubItems.Add(Format('%d', [List.Count])); + end; +end; + +procedure TPeDumpChild.UpdateRelocationView(Node: TTreeNode); +begin + if Node.Level = 0 then + begin + FCurrentRelocationIndex := -1; + RelocListView.Items.Count := FPeImage.RelocationList.AllItemCount; + end else + begin + FCurrentRelocationIndex := Integer(Node.Data); + RelocListView.Items.Count := FPeImage.RelocationList[FCurrentRelocationIndex].Count; + end; + RelocStatusBar.Panels[0].Text := Format(RsAddresses, [RelocListView.Items.Count]); + RelocListView.Invalidate; +end; + +procedure TPeDumpChild.RelocListViewData(Sender: TObject; Item: TListItem); +var + ViewItem: TJclPeRelocation; + + function RelocationTypeStr(RelocType: Byte): string; +begin + case RelocType of + IMAGE_REL_BASED_ABSOLUTE: Result := 'ABSOLUTE'; + IMAGE_REL_BASED_HIGHLOW: Result := 'HIGHLOW'; + else + Result := IntToStr(RelocType); + end; +end; + +begin + if FCurrentRelocationIndex = -1 then + ViewItem := FPeImage.RelocationList.AllItems[Item.Index] + else + ViewItem := FPeImage.RelocationList[FCurrentRelocationIndex][Item.Index]; + with Item, ViewItem do + begin + Caption := Format('%.8x', [VirtualAddress]); + SubItems.Add(RelocationTypeStr(RelocType)); + end; +end; + +procedure TPeDumpChild.DebugListViewData(Sender: TObject; Item: TListItem); +begin + with Item, FPeImage.DebugList[Item.Index] do + begin + Caption := FPeImage.DebugTypeNames(_Type); + SubItems.Add(Format('%.8x', [SizeOfData])); + SubItems.Add(Format('%.8x', [AddressOfRawData])); + SubItems.Add(Format('%.8x', [PointerToRawData])); + SubItems.Add(Format('%d.%.2d', [MajorVersion, MinorVersion])); + end; +end; + +procedure TPeDumpChild.ImportListViewDblClick(Sender: TObject); +begin + MainForm.InvokeHelp1.Execute; +end; + +procedure TPeDumpChild.DirectoryListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if Integer(Item.Data) = 0 then Sender.Canvas.Font.Color := clGrayText; +end; + +procedure TPeDumpChild.SetGroupImports(const Value: Boolean); +var + NodeIndex: Integer; + TempNode: TTreeNode; + WasExpanded: Boolean; +begin + if FGroupImports <> Value then + begin + FGroupImports := Value; + with SectionTreeView do + begin + Items.BeginUpdate; + FUpdatingView := True; + try + if Assigned(Selected) then + begin + if Selected.Level > 0 then + begin + NodeIndex := Selected.Parent.Index; + WasExpanded := True; + end else + begin + NodeIndex := Selected.Index; + WasExpanded := Selected.Expanded; + end; + end else + begin + NodeIndex := 0; + WasExpanded := False; + end; + Self.UpdateView; + TempNode := Items.GetFirstNode; + while NodeIndex > 0 do + begin + TempNode := TempNode.GetNextSibling; + Dec(NodeIndex); + end; + FUpdatingView := False; + Selected := TempNode; + if WasExpanded then Selected.Expand(False); + finally + Items.EndUpdate; + end; + end; + end; +end; + +procedure TPeDumpChild.ImportListViewSort; +const + MapIndexToSortType: array[0..3] of TJclPeImportSort = (isName, isOrdinal, isHint, isLibImport); +begin + with ImportListView do + begin + if FCurrentImportIndex = -1 then + FPeImage.ImportList.SortAllItemsList(MapIndexToSortType[Tag and $FF], Tag and $100 <> 0) + else + FPeImage.ImportList[FCurrentImportIndex].SortList(MapIndexToSortType[Tag and $FF], Tag and $100 <> 0); + Invalidate; + end; +end; + +procedure TPeDumpChild.ExportListViewSort; +const + MapIndexToSortType: array[0..5] of TJclPeExportSort = + (esName, esOrdinal, esHint, esAddress, esForwarded, esSection); +begin + with ExportListView do + begin + FPeImage.ExportList.SortList(MapIndexToSortType[Tag and $FF], Tag and $100 <> 0); + Invalidate; + end; +end; + +function TPeDumpChild.GetNodeCategory(Node: TTreeNode): TPeDumpViewCategory; +begin + while Node.Parent <> nil do Node := Node.Parent; + Result := TPeDumpViewCategory(Node.Data); +end; + +procedure TPeDumpChild.SetUnmangleNames(const Value: Boolean); +begin + if FUnmangleNames <> Value then + begin + FUnmangleNames := Value; + ImportListView.Invalidate; + ExportListView.Invalidate; + end; +end; + +function TPeDumpChild.FunctionName(const Name: string): string; +begin + if FUnmangleNames then + PeUnmangleName(Name, Result) + else + Result := Name; +end; + +function TPeDumpChild.HeadersRemark(HeaderItem: TJclPeHeader): string; +const + ImageCharacteristicValues: array [1..14] of packed record + Value: Word; + Name: PChar; + end = ( + (Value: IMAGE_FILE_RELOCS_STRIPPED; Name: 'RELOCS_STRIPPED'), + (Value: IMAGE_FILE_EXECUTABLE_IMAGE; Name: 'EXECUTABLE_IMAGE'), + (Value: IMAGE_FILE_LINE_NUMS_STRIPPED; Name: 'LINE_NUMS_STRIPPED'), + (Value: IMAGE_FILE_LOCAL_SYMS_STRIPPED; Name: 'LOCAL_SYMS_STRIPPED'), + (Value: IMAGE_FILE_AGGRESIVE_WS_TRIM; Name: 'AGGRESIVE_WS_TRIM'), + (Value: IMAGE_FILE_BYTES_REVERSED_LO; Name: 'BYTES_REVERSED_LO'), + (Value: IMAGE_FILE_32BIT_MACHINE; Name: '32BIT_MACHINE'), + (Value: IMAGE_FILE_DEBUG_STRIPPED; Name: 'DEBUG_STRIPPED'), + (Value: IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP; Name: 'REMOVABLE_RUN_FROM_SWAP'), + (Value: IMAGE_FILE_NET_RUN_FROM_SWAP; Name: 'NET_RUN_FROM_SWAP'), + (Value: IMAGE_FILE_SYSTEM; Name: 'SYSTEM'), + (Value: IMAGE_FILE_DLL; Name: 'DLL'), + (Value: IMAGE_FILE_UP_SYSTEM_ONLY; Name: 'UP_SYSTEM_ONLY'), + (Value: IMAGE_FILE_BYTES_REVERSED_HI; Name: 'BYTES_REVERSED_HI') + ); +var + C: Word; + I: Integer; +begin + case HeaderItem of + JclPeHeader_Characteristics: + begin + Result := ''; + C := FPeImage.LoadedImage.FileHeader.FileHeader.Characteristics; + for I := Low(ImageCharacteristicValues) to High(ImageCharacteristicValues) do + if C and ImageCharacteristicValues[I].Value <> 0 then + Result := Result + #13#10 + ImageCharacteristicValues[I].Name; + Delete(Result, 1, 2); + end; + else + Result := ''; + end; +end; + +procedure TPeDumpChild.ItemsListViewInfoTip(Sender: TObject; + Item: TListItem; var InfoTip: String); +begin + case TListView(Sender).Tag of + 0: InfoTip := HeadersRemark(TJclPeHeader(Item.Index)); + end; +end; + +// History: + +// $Log: PeDump.pas,v $ +// Revision 1.3 2006/01/15 11:21:32 outchy +// Removed Log tag +// Changed DELPHI5 to COMPILER5 +// +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeGenDef.dfm b/official/1.96/examples/windows/delphitools/peviewer/PeGenDef.dfm new file mode 100644 index 0000000..1255c2d --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeGenDef.dfm @@ -0,0 +1,144 @@ +object PeGenDefChild: TPeGenDefChild + Left = 278 + Top = 149 + Width = 409 + Height = 338 + Caption = 'Pascal unit generator' + Color = clBtnFace + Constraints.MinHeight = 230 + Constraints.MinWidth = 270 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Position = poDefaultPosOnly + Visible = True + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object PageControl1: TPageControl + Left = 0 + Top = 0 + Width = 401 + Height = 311 + ActivePage = TabSheet1 + Align = alClient + Style = tsFlatButtons + TabOrder = 0 + OnChange = PageControl1Change + object TabSheet1: TTabSheet + Caption = '&Options' + object FunctionsListView: TListView + Left = 0 + Top = 96 + Width = 393 + Height = 184 + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = < + item + Caption = 'Original name' + Width = 140 + end + item + Caption = 'Function name' + Width = 140 + end + item + Caption = 'Address' + Width = 70 + end> + ColumnClick = False + HotTrackStyles = [] + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnCustomDrawItem = FunctionsListViewCustomDrawItem + OnData = FunctionsListViewData + end + object GroupBox1: TGroupBox + Left = 0 + Top = 0 + Width = 392 + Height = 81 + Anchors = [akLeft, akTop, akRight] + Caption = 'Code generation options' + TabOrder = 1 + object Label1: TLabel + Left = 8 + Top = 20 + Width = 107 + Height = 13 + Caption = '&Library constant name:' + FocusControl = LibConstNameEdit + end + object LibConstNameEdit: TEdit + Left = 132 + Top = 16 + Width = 116 + Height = 21 + MaxLength = 32 + TabOrder = 0 + end + object WrapSpinEdit: TSpinEdit + Left = 132 + Top = 47 + Width = 57 + Height = 22 + Enabled = False + MaxLength = 3 + MaxValue = 999 + MinValue = 1 + TabOrder = 1 + Value = 80 + end + object WrapCheckBox: TCheckBox + Left = 8 + Top = 48 + Width = 118 + Height = 17 + Caption = '&Wrap text at column:' + TabOrder = 2 + OnClick = WrapCheckBoxClick + end + end + end + object TabSheet2: TTabSheet + Caption = '&Unit source' + ImageIndex = 1 + object UnitRichEdit: TRichEdit + Left = 0 + Top = 0 + Width = 393 + Height = 280 + Align = alClient + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + HideScrollBars = False + ParentFont = False + PlainText = True + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 0 + WordWrap = False + end + end + end + object SaveDialog: TSaveDialog + DefaultExt = 'pas' + Filter = 'Pascal unit (*.pas)|*.pas|All files (*.*)|*.*' + Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing] + Left = 12 + Top = 195 + end +end diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeGenDef.pas b/official/1.96/examples/windows/delphitools/peviewer/PeGenDef.pas new file mode 100644 index 0000000..d746b22 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeGenDef.pas @@ -0,0 +1,350 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 PeGenDef.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit PeGenDef; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + JclPeImage, ComCtrls, StdCtrls, Spin; + +type + TPeUnitGenFlags = set of (ufDecorated, ufDuplicate, ufVariable); + + TPeUnitGenerator = class(TJclPeImage) + private + FUnitGenFlags: array of TPeUnitGenFlags; + function GetUnitGenFlags(Index: Integer): TPeUnitGenFlags; + public + procedure GenerateUnit(Strings: TStrings; const LibConst: string; WrapPos: Integer); + procedure ScanExports; + property UnitGenFlags[Index: Integer]: TPeUnitGenFlags read GetUnitGenFlags; + end; + + TPeGenDefChild = class(TForm) + PageControl1: TPageControl; + TabSheet1: TTabSheet; + TabSheet2: TTabSheet; + FunctionsListView: TListView; + UnitRichEdit: TRichEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + LibConstNameEdit: TEdit; + WrapSpinEdit: TSpinEdit; + WrapCheckBox: TCheckBox; + SaveDialog: TSaveDialog; + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FunctionsListViewData(Sender: TObject; Item: TListItem); + procedure FunctionsListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure PageControl1Change(Sender: TObject); + procedure WrapCheckBoxClick(Sender: TObject); + private + FPeUnitGenerator: TPeUnitGenerator; + procedure SetFileName(const Value: TFileName); + function GetFileName: TFileName; + procedure GenerateUnit; + public + function CanSave: Boolean; + procedure SaveUnit; + property FileName: TFileName read GetFileName write SetFileName; + end; + +var + PeGenDefChild: TPeGenDefChild; + +implementation + +uses PeViewerMain, JclFileUtils, ToolsUtils, JclSysUtils; + +{$R *.DFM} + +const + nfDecoratedName = $01; + nfAnsiUnicodePair = $02; + +function PascalizeName(const Name: string): string; +const + ValidLeadingChars = ['A'..'Z', 'a'..'z']; + StripLeadingChars = ['_']; + ValidChars = ValidLeadingChars + ['0'..'9']; + InvalidCharReplacement = '_'; + StopChar = '@'; +var + I: Integer; + C: Char; +begin + SetLength(Result, Length(Name)); + Result := ''; + for I := 1 to Length(Name) do + begin + C := Name[I]; + if I = 1 then + begin + if C in ValidLeadingChars then + Result := Result + C + else + if not (C in StripLeadingChars) then + Break; // probably MS C++ or Borland name decoration + end else + begin + if C in ValidChars then + Result := Result + C + else + if C = StopChar then + Break + else + Result := Result + InvalidCharReplacement; + end; + end; + I := Length(Result); + while I > 0 do + if Result[I] = InvalidCharReplacement then + begin + Delete(Result, I, 1); + Dec(I); + end + else + Break; +end; + +function PossiblyAnsiUnicodePair(const Name1, Name2: AnsiString): Boolean; +const + AnsiUnicodeSuffixes = ['A', 'W']; +var + L1, L2: Integer; + Suffix1, Suffix2: Char; +begin + Result := False; + L1 := Length(Name1); + L2 := Length(Name2); + if (L1 = L2) and (L1 > 1) then + begin + Suffix1 := Name1[L1]; + Suffix2 := Name2[L2]; + Result := (Suffix1 in AnsiUnicodeSuffixes) and (Suffix2 in AnsiUnicodeSuffixes) and + (Suffix1 <> Suffix2) and (Copy(Name1, 1, L1 - 1) = Copy(Name2, 1, L2 - 1)); + end; +end; + +function IsDecoratedName(const Name: string): Boolean; +begin + Result := (Length(Name) > 1) and (Name[1] in ['?', '@']); +end; + + +{ TPeUnitGenerator } + +procedure TPeUnitGenerator.GenerateUnit(Strings: TStrings; const LibConst: string; + WrapPos: Integer); +var + I: Integer; + S: string; +begin + Strings.Add('implementation'); + Strings.Add(''); + Strings.Add('const'); + Strings.Add(Format(' %s = ''%s'';', [LibConst, ExtractFileName(FileName)])); + Strings.Add(''); + for I := 0 to ExportList.Count - 1 do + with ExportList[I] do + if FUnitGenFlags[I] = [] then + begin + S := Format('function %s; external %s name ''%s'';', [PascalizeName(Name), LibConst, Name]); + if WrapPos > 0 then + S := WrapText(S, #13#10' ', [' '], WrapPos); + Strings.Add(S); + end; + Strings.Add(''); + Strings.Add('end.'); +end; + +function TPeUnitGenerator.GetUnitGenFlags(Index: Integer): TPeUnitGenFlags; +begin + Result := FUnitGenFlags[Index]; +end; + +procedure TPeUnitGenerator.ScanExports; +var + I: Integer; + PascalName, LastName, FirstSectionName: string; + LastAddress: DWORD; + Flags: TPeUnitGenFlags; +begin + SetLength(FUnitGenFlags, ExportList.Count); + ExportList.SortList(esName); + LastName := ''; + LastAddress := 0; + FirstSectionName := ImageSectionNames[0]; // The first section is code section + for I := 0 to ExportList.Count - 1 do + with ExportList[I] do + begin + Flags := []; + if SectionName <> FirstSectionName then + Include(Flags, ufVariable) + else + if IsDecoratedName(Name) then + Include(Flags, ufDecorated) + else + begin + PascalName := PascalizeName(Name); + if (LastAddress = Address) and (LastName = PascalName) then + Include(Flags, ufDuplicate); + LastName := PascalName; + LastAddress := Address; + end; + FUnitGenFlags[I] := Flags; + end; +end; + +{ TPeGenDefChild } + +procedure TPeGenDefChild.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Fix_ListViewBeforeClose(Self); + Action := caFree; +end; + +procedure TPeGenDefChild.FormCreate(Sender: TObject); +begin + FPeUnitGenerator := TPeUnitGenerator.Create; +end; + +procedure TPeGenDefChild.FormDestroy(Sender: TObject); +begin + FreeAndNil(FPeUnitGenerator); +end; + +function TPeGenDefChild.GetFileName: TFileName; +begin + Result := FPeUnitGenerator.FileName; +end; + +procedure TPeGenDefChild.SetFileName(const Value: TFileName); +begin + Screen.Cursor := crHourGlass; + try + FPeUnitGenerator.FileName := Value; + FPeUnitGenerator.ScanExports; + LibConstNameEdit.Text := PathExtractFileNameNoExt(Value) + 'Lib'; + FunctionsListView.Items.Count := FPeUnitGenerator.ExportList.Count; + FunctionsListView.Invalidate; + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TPeGenDefChild.FunctionsListViewData(Sender: TObject; Item: TListItem); +var + Flags: TPeUnitGenFlags; +begin + Flags := FPeUnitGenerator.UnitGenFlags[Item.Index]; + with Item, FPeUnitGenerator.ExportList[Item.Index] do + begin + Caption := Name; + SubItems.Add(PascalizeName(Name)); + SubItems.Add(AddressOrForwardStr); + if ufDuplicate in Flags then + ImageIndex := icoWarning + else + if Flags * [ufDecorated, ufVariable] = [] then + ImageIndex := icoExports + else + ImageIndex := -1; + end; +end; + +procedure TPeGenDefChild.FunctionsListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); +var + Flags: TPeUnitGenFlags; +begin + Flags := FPeUnitGenerator.UnitGenFlags[Item.Index]; + if Flags * [ufDecorated, ufVariable] <> [] then + Sender.Canvas.Font.Style := [fsStrikeOut]; +end; + +procedure TPeGenDefChild.GenerateUnit; +var + SL: TStringList; + WrapColumn: Integer; +begin + Screen.Cursor := crHourGlass; + SL := TStringList.Create; + try + if WrapCheckBox.Checked then + WrapColumn := WrapSpinEdit.Value + else + WrapColumn := 0; + FPeUnitGenerator.GenerateUnit(SL, LibConstNameEdit.Text, WrapColumn); + UnitRichEdit.Text := SL.Text; + finally + SL.Free; + Screen.Cursor := crDefault; + end; +end; + +procedure TPeGenDefChild.PageControl1Change(Sender: TObject); +begin + if PageControl1.ActivePage = TabSheet1 then + LibConstNameEdit.SetFocus + else + if PageControl1.ActivePage = TabSheet2 then + GenerateUnit; +end; + +procedure TPeGenDefChild.WrapCheckBoxClick(Sender: TObject); +begin + WrapSpinEdit.Enabled := WrapCheckBox.Checked; +end; + +function TPeGenDefChild.CanSave: Boolean; +begin + Result := PageControl1.ActivePage = TabSheet2; +end; + +procedure TPeGenDefChild.SaveUnit; +begin + with SaveDialog do + begin + FileName := PathExtractFileNameNoExt(FPeUnitGenerator.FileName); + if Execute then + UnitRichEdit.Lines.SaveToFile(FileName); + end; +end; + +// History: + +// $Log: PeGenDef.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeResView.dfm b/official/1.96/examples/windows/delphitools/peviewer/PeResView.dfm new file mode 100644 index 0000000..edb8b7c --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeResView.dfm @@ -0,0 +1,420 @@ +object PeResViewChild: TPeResViewChild + Left = 380 + Top = 203 + AutoScroll = False + Caption = 'PeResViewChild' + ClientHeight = 407 + ClientWidth = 597 + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 250 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + PopupMenu = PopupMenu1 + Position = poDefault + Visible = True + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 121 + Top = 0 + Width = 3 + Height = 407 + Cursor = crHSplit + ResizeStyle = rsUpdate + end + object ResourceTreeView: TTreeView + Left = 0 + Top = 0 + Width = 121 + Height = 407 + Align = alLeft + HideSelection = False + Images = MainForm.IconImageList + Indent = 19 + ReadOnly = True + TabOrder = 0 + OnChange = ResourceTreeViewChange + OnExpanding = ResourceTreeViewExpanding + end + object PageControl1: TPageControl + Left = 124 + Top = 0 + Width = 473 + Height = 407 + ActivePage = DirTab + Align = alClient + TabOrder = 1 + TabStop = False + object DirTab: TTabSheet + Caption = 'DirTab' + object DirListView: TListView + Left = 0 + Top = 0 + Width = 465 + Height = 379 + Align = alClient + Columns = < + item + Caption = 'Name' + Width = 150 + end + item + Caption = 'Offset' + Width = 70 + end + item + Caption = 'Size' + Width = 70 + end> + ColumnClick = False + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnData = DirListViewData + end + end + object HexDumpTab: TTabSheet + Caption = 'HexDumpTab' + ImageIndex = 1 + object HexDumpListView: TListView + Left = 0 + Top = 0 + Width = 465 + Height = 379 + Align = alClient + Columns = < + item + Caption = 'Offset' + Width = 70 + end + item + Caption = 'Data' + Width = 250 + end + item + Caption = 'ASCII' + Width = 70 + end> + ColumnClick = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + ParentFont = False + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnData = HexDumpListViewData + end + end + object StringsTab: TTabSheet + Caption = 'StringsTab' + ImageIndex = 2 + object Splitter2: TSplitter + Left = 0 + Top = 341 + Width = 465 + Height = 3 + Cursor = crVSplit + Align = alBottom + ResizeStyle = rsUpdate + end + object StringsListView: TListView + Left = 0 + Top = 0 + Width = 465 + Height = 341 + Align = alClient + Columns = < + item + Caption = 'ID' + Width = 70 + end + item + Caption = 'Text' + Width = 300 + end> + ColumnClick = False + GridLines = True + HideSelection = False + HotTrackStyles = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = MainForm.IconImageList + TabOrder = 0 + ViewStyle = vsReport + OnData = StringsListViewData + OnSelectItem = StringsListViewSelectItem + end + object DetailedStringMemo: TMemo + Left = 0 + Top = 344 + Width = 465 + Height = 35 + Align = alBottom + Color = clBtnFace + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 1 + end + end + object GraphDirTab: TTabSheet + Caption = 'GraphDirTab' + ImageIndex = 3 + object GraphDrawGrid: TDrawGrid + Left = 0 + Top = 0 + Width = 465 + Height = 379 + Align = alClient + ColCount = 2 + DefaultDrawing = False + FixedCols = 0 + Options = [goVertLine, goHorzLine, goColSizing, goRowSelect, goThumbTracking] + TabOrder = 0 + OnDrawCell = GraphDrawGridDrawCell + ColWidths = ( + 147 + 277) + end + end + object TextTab: TTabSheet + Caption = 'TextTab' + ImageIndex = 4 + object TextRichEdit: TRichEdit + Left = 0 + Top = 0 + Width = 465 + Height = 379 + Align = alClient + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + HideScrollBars = False + ParentFont = False + PlainText = True + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 0 + WordWrap = False + end + end + object AviTab: TTabSheet + Caption = 'AviTab' + ImageIndex = 5 + PopupMenu = AviPopupMenu + object Bevel2: TBevel + Left = 0 + Top = 26 + Width = 465 + Height = 334 + Align = alClient + end + object Animate1: TAnimate + Left = 8 + Top = 40 + Width = 100 + Height = 80 + Active = False + Color = clBtnFace + ParentColor = False + OnOpen = Animate1Open + OnClose = Animate1Close + OnStop = Animate1Stop + end + object AviToolBar: TToolBar + Left = 0 + Top = 0 + Width = 465 + Height = 26 + AutoSize = True + ButtonWidth = 51 + Caption = 'AviToolBar' + EdgeBorders = [ebLeft, ebTop, ebRight, ebBottom] + Flat = True + Images = MainForm.ToolbarImagesList + List = True + ShowCaptions = True + TabOrder = 1 + object ToolButton1: TToolButton + Left = 0 + Top = 0 + Action = AviPlay1 + end + object ToolButton2: TToolButton + Left = 51 + Top = 0 + Action = AviStop1 + end + object ToolButton3: TToolButton + Left = 102 + Top = 0 + Action = AviBkColor1 + end + end + object AviStatusBar: TStatusBar + Left = 0 + Top = 360 + Width = 465 + Height = 19 + Panels = < + item + Width = 150 + end> + SimplePanel = False + end + end + object HTMLTab: TTabSheet + Caption = 'HTMLTab' + ImageIndex = 6 + end + object GraphTab: TTabSheet + Caption = 'GraphTab' + ImageIndex = 7 + object GraphImage: TImage + Left = 0 + Top = 0 + Width = 465 + Height = 360 + Align = alClient + AutoSize = True + Center = True + end + object Bevel1: TBevel + Left = 0 + Top = 0 + Width = 465 + Height = 360 + Align = alClient + end + object GraphStatusBar: TStatusBar + Left = 0 + Top = 360 + Width = 465 + Height = 19 + Panels = < + item + Width = 50 + end> + SimplePanel = False + end + end + object DialogTab: TTabSheet + Caption = 'DialogTab' + ImageIndex = 8 + object Bevel3: TBevel + Left = 0 + Top = 0 + Width = 465 + Height = 379 + Align = alClient + end + object DialogTestBtn: TButton + Left = 8 + Top = 8 + Width = 75 + Height = 25 + Caption = '&Show dialog' + TabOrder = 0 + OnClick = DialogTestBtnClick + end + end + end + object ActionList1: TActionList + Images = MainForm.ToolbarImagesList + Left = 136 + Top = 352 + object AviPlay1: TAction + Caption = 'Play' + ImageIndex = 16 + OnExecute = AviPlay1Execute + end + object AviStop1: TAction + Caption = 'Stop' + Enabled = False + ImageIndex = 17 + OnExecute = AviStop1Execute + end + object AviBkColor1: TAction + Caption = 'Color' + ImageIndex = 18 + OnExecute = AviBkColor1Execute + end + end + object ColorDialog1: TColorDialog + Ctl3D = True + Options = [cdPreventFullOpen, cdSolidColor] + Left = 168 + Top = 352 + end + object AviPopupMenu: TPopupMenu + Images = MainForm.ToolbarImagesList + Left = 200 + Top = 352 + object Play1: TMenuItem + Action = AviPlay1 + end + object Stop1: TMenuItem + Action = AviStop1 + end + object Color1: TMenuItem + Action = AviBkColor1 + end + end + object SaveDialog1: TSaveDialog + Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 232 + Top = 352 + end + object PopupMenu1: TPopupMenu + Images = MainForm.ToolbarImagesList + Left = 264 + Top = 352 + object Copytoclipboard1: TMenuItem + Action = MainForm.Copy1 + end + object Savetofile1: TMenuItem + Action = MainForm.Save1 + end + object Selectall1: TMenuItem + Action = MainForm.SelectAll1 + end + object N1: TMenuItem + Caption = '-' + end + object Viewdetails1: TMenuItem + Action = MainForm.ViewResDetails1 + end + object Viewashex1: TMenuItem + Action = MainForm.ViewResHex1 + end + end +end diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeResView.pas b/official/1.96/examples/windows/delphitools/peviewer/PeResView.pas new file mode 100644 index 0000000..30ed46f --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeResView.pas @@ -0,0 +1,717 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 PeResView.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit PeResView; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + JclPeImage, PeResource, JclLogic, JclGraphUtils, ComCtrls, StdCtrls, + ExtCtrls, Grids, ToolWin, ActnList, OleCtrls, Menus, SHDocVw_TLB; + +type + TPeResViewChild = class(TForm) + ResourceTreeView: TTreeView; + PageControl1: TPageControl; + Splitter1: TSplitter; + DirTab: TTabSheet; + HexDumpTab: TTabSheet; + DirListView: TListView; + HexDumpListView: TListView; + StringsTab: TTabSheet; + StringsListView: TListView; + GraphDirTab: TTabSheet; + GraphDrawGrid: TDrawGrid; + TextTab: TTabSheet; + TextRichEdit: TRichEdit; + AviTab: TTabSheet; + Animate1: TAnimate; + AviToolBar: TToolBar; + ToolButton1: TToolButton; + ToolButton2: TToolButton; + ActionList1: TActionList; + AviPlay1: TAction; + AviStop1: TAction; + HTMLTab: TTabSheet; + GraphTab: TTabSheet; + GraphImage: TImage; + Bevel1: TBevel; + GraphStatusBar: TStatusBar; + DetailedStringMemo: TMemo; + Splitter2: TSplitter; + Bevel2: TBevel; + AviStatusBar: TStatusBar; + AviBkColor1: TAction; + ColorDialog1: TColorDialog; + ToolButton3: TToolButton; + AviPopupMenu: TPopupMenu; + Play1: TMenuItem; + Stop1: TMenuItem; + Color1: TMenuItem; + DialogTab: TTabSheet; + SaveDialog1: TSaveDialog; + DialogTestBtn: TButton; + Bevel3: TBevel; + PopupMenu1: TPopupMenu; + Copytoclipboard1: TMenuItem; + Savetofile1: TMenuItem; + N1: TMenuItem; + Viewdetails1: TMenuItem; + Viewashex1: TMenuItem; + Selectall1: TMenuItem; + procedure FormDestroy(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure ResourceTreeViewChange(Sender: TObject; Node: TTreeNode); + procedure DirListViewData(Sender: TObject; Item: TListItem); + procedure HexDumpListViewData(Sender: TObject; Item: TListItem); + procedure StringsListViewData(Sender: TObject; Item: TListItem); + procedure GraphDrawGridDrawCell(Sender: TObject; ACol, ARow: Integer; + Rect: TRect; State: TGridDrawState); + procedure AviPlay1Execute(Sender: TObject); + procedure AviStop1Execute(Sender: TObject); + procedure Animate1Stop(Sender: TObject); + procedure StringsListViewSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure Animate1Open(Sender: TObject); + procedure Animate1Close(Sender: TObject); + procedure AviBkColor1Execute(Sender: TObject); + procedure ResourceTreeViewExpanding(Sender: TObject; Node: TTreeNode; + var AllowExpansion: Boolean); + procedure DialogTestBtnClick(Sender: TObject); + private + FCurrentDir: TPeResItem; + FOriginalPageControlWndProc: TWndMethod; + FResourceImage: TPeResImage; + FSelectedItem: TPeResItem; + FSelectedNode: TTreeNode; + FShowAsHexView: Boolean; + FStringsList: TStringList; + FShowSpecialDirView: Boolean; + FTempGraphic: TPicture; + WebBrowser1: TWebBrowser; + procedure CreateStringsList(Item: TPeResUnkStrings); + procedure CreateGraphicList(Item: TPeResItem); + function GetPeImage: TJclPeImage; + procedure PageControlWndProc(var Message: TMessage); + procedure UpdateSelected; + procedure UpdateView; + procedure SetShowAsHexView(const Value: Boolean); + procedure SetShowSpecialDirView(const Value: Boolean); + public + constructor CreateEx(AOwner: TComponent; APeImage: TJclPeImage); + function CanSaveResource: Boolean; + procedure SaveResource; + property PeImage: TJclPeImage read GetPeImage; + property ShowAsHexView: Boolean read FShowAsHexView write SetShowAsHexView; + property ShowSpecialDirView: Boolean read FShowSpecialDirView write SetShowSpecialDirView; + end; + +var + PeResViewChild: TPeResViewChild; + +implementation + +{$R *.DFM} + +uses + CommCtrl, PeViewerMain, ToolsUtils, JclStrings, JclSysUtils; + +resourcestring + RsAviStatus = 'Width: %u, Height: %u, Frames: %u'; + RsGraphicStatus = 'Width: %u, Height: %u, Bits per pixel: %u'; + RsTitle = 'Resources - %s'; + +const + MinGraphRowHeight = 18; + MaxGraphRowHeight = 150; + +{ TPeResViewChild } + +constructor TPeResViewChild.CreateEx(AOwner: TComponent; APeImage: TJclPeImage); +begin + inherited Create(AOwner); + FShowSpecialDirView := True; + FStringsList := TStringList.Create; + FTempGraphic := TPicture.Create; + FResourceImage := TPeResImage.Create; + FResourceImage.PeImage := APeImage; + Caption := Format(RsTitle, [ExtractFileName(FResourceImage.FileName)]); + WebBrowser1 := TWebBrowser.Create(Self); + TWinControl(WebBrowser1).Parent := HTMLTab; + WebBrowser1.Align := alClient; +end; + +procedure TPeResViewChild.PageControlWndProc(var Message: TMessage); +begin +// remove PageControl's border + FOriginalPageControlWndProc(Message); + with Message do + if (Msg = TCM_ADJUSTRECT) and (Message.WParam = 0) then + InflateRect(PRect(LParam)^, 4, 4); +end; + +procedure TPeResViewChild.FormCreate(Sender: TObject); +var + I: Integer; +begin + with PageControl1 do + begin + for I := 0 to PageCount - 1 do Pages[I].TabVisible := False; + FOriginalPageControlWndProc := WindowProc; + WindowProc := PageControlWndProc; + ActivePage := DirTab; + Realign; + end; + UpdateView; +end; + +procedure TPeResViewChild.FormDestroy(Sender: TObject); +begin + FreeAndNil(FTempGraphic); + FreeAndNil(FStringsList); + FreeAndNil(FResourceImage); +end; + +procedure TPeResViewChild.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Fix_ListViewBeforeClose(Self); + Action := caFree; +end; + +procedure TPeResViewChild.UpdateView; +var + I: Integer; +begin + with ResourceTreeView do + begin + Items.BeginUpdate; + try + Items.Clear; + for I := 0 to FResourceImage.Count - 1 do + with Items.AddObject(nil, FResourceImage[I].ResName, FResourceImage[I]) do + begin + ImageIndex := icoFolderShut; + SelectedIndex := icoFolderOpen; + HasChildren := True; + end; + finally + Items.EndUpdate; + end; + end; +end; + +function TPeResViewChild.GetPeImage: TJclPeImage; +begin + Result := FResourceImage.PeImage; +end; + +procedure TPeResViewChild.ResourceTreeViewChange(Sender: TObject; + Node: TTreeNode); +begin + DirListView.Items.Count := 0; + HexDumpListView.Items.Count := 0; + StringsListView.Items.Count := 0; + GraphDrawGrid.RowCount := 2; + FSelectedNode := Node; + UpdateSelected; +end; + +procedure TPeResViewChild.DirListViewData(Sender: TObject; + Item: TListItem); +begin + with Item, FCurrentDir[Item.Index] do + begin + Caption := ResName; + SubItems.Add(Format('%x', [Offset])); + SubItems.Add(Format('%x', [Size])); + end; +end; + +procedure TPeResViewChild.HexDumpListViewData(Sender: TObject; + Item: TListItem); +var + DumpData: PByte; + Address, EndAddress: Integer; + Hex, Ascii: string; + I: Integer; +begin + with Item do + begin + DumpData := PByte(DWORD(FSelectedItem.RawData) + DWORD(Index * 16)); + Address := FSelectedItem.Offset + Index * 16; + EndAddress := FSelectedItem.Offset + FSelectedItem.Size - 1; + SetLength(Hex, 3 * 16); + SetLength(Ascii, 3 * 16); + Hex := ''; + Ascii := ''; + for I := 0 to 15 do + begin + Hex := Hex + Format('%.2x ', [DumpData^]); + if DumpData^ >= 32 then + Ascii := Ascii + Chr(DumpData^) + else + Ascii := Ascii + '.'; + Inc(DumpData); + if Address + I >= EndAddress then Break; + end; + Item.Caption := Format('%x', [Address]); + Item.SubItems.Add(Hex); + Item.SubItems.Add(Ascii); + end; +end; + +procedure TPeResViewChild.SetShowAsHexView(const Value: Boolean); +begin + if FShowAsHexView <> Value then + begin + FShowAsHexView := Value; + UpdateSelected; + end; +end; + +procedure TPeResViewChild.SetShowSpecialDirView(const Value: Boolean); +begin + if FShowSpecialDirView <> Value then + begin + FShowSpecialDirView := Value; + UpdateSelected; + end; +end; + +procedure TPeResViewChild.CreateStringsList(Item: TPeResUnkStrings); +var + I: Integer; +begin + FStringsList.Clear; + DetailedStringMemo.Lines.Clear; + if not Item.IsList then + TPeResUnkStrings(Item).FillStrings(FStringsList) + else + for I := 0 to Item.ItemCount - 1 do + TPeResUnkStrings(Item[I]).FillStrings(FStringsList); + StringsListView.Items.Count := FStringsList.Count; + StringsListView.Invalidate; +end; + +procedure TPeResViewChild.StringsListViewData(Sender: TObject; Item: TListItem); +begin + with Item do + begin + Caption := Format('%u', [DWORD(FStringsList.Objects[Index])]); + SubItems.Add(StrRemoveChars(FStringsList[Index], [AnsiCarriageReturn, AnsiLineFeed])); + end; +end; + +procedure TPeResViewChild.CreateGraphicList(Item: TPeResItem); +var + I, J, MaxRowHeight, TotalMaxRowHeight: Integer; + + procedure CalculateHeight(Item: TPeResItem); + var + H: Integer; + begin + case Item.Kind of + rkCursor: + H := GetSystemMetrics(SM_CYCURSOR); + rkIcon: + H := GetSystemMetrics(SM_CYICON); + rkBitmap: + H := TPeResUnkGraphic(Item).GraphicProperties.Height; + else + FTempGraphic.Assign(Item); + H := FTempGraphic.Height; + end; + MaxRowHeight := Max(MaxRowHeight, H); + end; + +begin + TotalMaxRowHeight := 0; + with GraphDrawGrid do + begin + SendMessage(Handle, WM_SETREDRAW, 0, 0); + try + RowCount := Item.ItemCount + 1; + RowHeights[0] := MinGraphRowHeight; + for I := 0 to Item.ItemCount - 1 do + begin + MaxRowHeight := 0; + if Item[I].IsList then + for J := 0 to Item[I].ItemCount - 1 do + CalculateHeight(Item[I][J]) + else + CalculateHeight(Item[I]); + RowHeights[I + 1] := Min(Max(MinGraphRowHeight, MaxRowHeight + 4), MaxGraphRowHeight); + TotalMaxRowHeight := Max(TotalMaxRowHeight, MaxRowHeight); + end; + finally + SendMessage(Handle, WM_SETREDRAW, 1, 0); + Invalidate; + end; + end; +end; + +procedure TPeResViewChild.GraphDrawGridDrawCell(Sender: TObject; ACol, + ARow: Integer; Rect: TRect; State: TGridDrawState); +var + Text: string; + Item: TPeResItem; + I, W: Integer; + DrawRect: TRect; +begin + with GraphDrawGrid do + begin + if ARow = 0 then + with Canvas do + begin + case ACol of + 0: Text := 'Name'; + 1: Text := 'Graphic'; + end; + Brush.Color := clBtnFace; + Font.Color := clBtnText; + Dec(Rect.Bottom, 2); + Dec(Rect.Right); + FillRect(Rect); + TextRect(Rect, Rect.Left + 6, Rect.Top + 2, Text); + DrawEdge(Handle, Rect, EDGE_ETCHED, BF_BOTTOMRIGHT or BF_FLAT); + Pen.Color := Color; + Polyline([Point(Rect.Right, Rect.Top), Point(Rect.Right, Rect.Bottom), + Point(Rect.Left, Rect.Bottom)]); + Inc(Rect.Bottom); + MoveTo(Rect.Left, Rect.Bottom); + LineTo(Rect.Right, Rect.Bottom); + Pen.Color := clBtnFace; + Inc(Rect.Bottom); + MoveTo(Rect.Left, Rect.Bottom); + LineTo(Rect.Right, Rect.Bottom); + end else + begin + if (gdSelected in State) and Focused then + begin + Canvas.Brush.Color := clHighlight; + Canvas.Font.Color := clHighlightText; + Canvas.FillRect(Rect); + DrawFocusRect(Canvas.Handle, Rect); + end else + begin + Canvas.Brush.Color := Color; + Canvas.Font.Color := Font.Color; + Canvas.FillRect(Rect); + end; + InflateRect(Rect, -1, -1); + Item := FCurrentDir[ARow - 1]; + case ACol of + 0:Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Item.ResName); + 1:begin + W := 0; + if not Item.IsList then + begin + FTempGraphic.Assign(Item); + with FTempGraphic do + SetRect(DrawRect, Rect.Left, Rect.Top, Rect.Left + Width, Rect.Top + Height); + if not RectIncludesRect(DrawRect, Rect) then + begin + DrawRect.Right := Min(DrawRect.Right, Rect.Right); + DrawRect.Bottom := Min(DrawRect.Bottom, Rect.Bottom); + Canvas.StretchDraw(DrawRect, FTempGraphic.Graphic); + end + else + Canvas.Draw(Rect.Left + 2, Rect.Top + 2, FTempGraphic.Graphic); + end else + for I := 0 to Item.ItemCount - 1 do + begin + FTempGraphic.Assign(Item[I]); + Canvas.Draw(Rect.Left + 2 + W, Rect.Top + 2, FTempGraphic.Graphic); + Inc(W, FTempGraphic.Width + 5); + end; + end; + end; + end; + end; +end; + +procedure TPeResViewChild.AviPlay1Execute(Sender: TObject); +begin + with Animate1 do + Play(1, FrameCount, 1); + AviStop1.Enabled := True; + AviPlay1.Enabled := False; +end; + +procedure TPeResViewChild.AviStop1Execute(Sender: TObject); +begin + Animate1.Stop; + AviStop1.Enabled := False; +end; + +procedure TPeResViewChild.Animate1Stop(Sender: TObject); +begin + AviPlay1.Enabled := True; + AviStop1.Enabled := False; +end; + +procedure TPeResViewChild.StringsListViewSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +begin + if Selected then DetailedStringMemo.Text := Item.SubItems[0]; +end; + +procedure TPeResViewChild.Animate1Open(Sender: TObject); +begin + with Animate1 do + AviStatusBar.Panels[0].Text := Format(RsAviStatus, [FrameWidth, FrameHeight, + FrameCount]); +end; + +procedure TPeResViewChild.Animate1Close(Sender: TObject); +begin + AviStatusBar.Panels[0].Text := ''; +end; + +procedure TPeResViewChild.AviBkColor1Execute(Sender: TObject); +begin + with ColorDialog1 do + begin + CustomColors.Values['ColorA'] := Format('%.6x', [ColorToRGB(clBtnFace)]); + Color := Animate1.Color; + if Execute then Animate1.Color := Color; + end; +end; + +procedure TPeResViewChild.UpdateSelected; + + function SpecialDirectoryView: Boolean; + begin + Result := True; + case FCurrentDir.Kind of + rkBitmap, rkCursor, rkIcon: + begin + CreateGraphicList(FCurrentDir); + PageControl1.ActivePage := GraphDirTab; + end; + rkString: + begin + CreateStringsList(TPeResString(FCurrentDir)); + PageControl1.ActivePage := StringsTab; + end; + else + Result := False; + end; + end; + + procedure DefaultDirectoryView; + begin + DirListView.Items.Count := FCurrentDir.ItemCount; + DirListView.Invalidate; + PageControl1.ActivePage := DirTab; + end; + + function SpecialDetailView: Boolean; + begin + Result := True; + case FSelectedItem.Kind of + rkAccelerator: + begin + TextRichEdit.Lines.Assign(TPeResAccelerator(FSelectedItem)); + PageControl1.ActivePage := TextTab; + end; + rkAvi: + begin + Animate1.Assign(FSelectedItem); + PageControl1.ActivePage := AviTab; + end; + rkBitmap, rkIcon, rkCursor: + begin + GraphImage.Picture.Assign(FSelectedItem); + if GraphImage.Picture.Graphic is TBitmap then + GraphImage.Picture.Bitmap.Transparent := True; + with TPeResUnkGraphic(FSelectedItem).GraphicProperties do + GraphStatusBar.Panels[0].Text := Format(RsGraphicStatus, [Width, Height, BitsPerPixel]); + PageControl1.ActivePage := GraphTab; + end; + rkString: + begin + CreateStringsList(TPeResString(FSelectedItem)); + PageControl1.ActivePage := StringsTab; + end; + rkHTML: + begin + WebBrowser1.Navigate(TPeResHTML(FSelectedItem).ResPath); + PageControl1.ActivePage := HTMLTab; + end; + rkData: + if TPeResRCData(FSelectedItem).DataKind <> dkUnknown then + begin + TextRichEdit.Lines.Assign(TPeResRCData(FSelectedItem)); + PageControl1.ActivePage := TextTab; + end else + Result := False; +{ rkDialog: + begin + DialogTestBtn.Enabled := TPeResDialog(FSelectedItem).CanShowDialog; + PageControl1.ActivePage := DialogTab; + end;} { TODO : Check for dialog templates } + rkMessageTable: + begin + CreateStringsList(TPeResUnkStrings(FSelectedItem)); + PageControl1.ActivePage := StringsTab; + end; + rkVersion: + begin + TextRichEdit.Lines.Assign(TPeResVersion(FSelectedItem)); + PageControl1.ActivePage := TextTab; + end; + else + Result := False; + end; + end; + + procedure DefaultDetailView; + begin + HexDumpListView.Items.Count := (FSelectedItem.Size - 1) div 16 + 1; + HexDumpListView.Invalidate; + PageControl1.ActivePage := HexDumpTab; + end; + +begin + FSelectedItem := TPeResItem(FSelectedNode.Data); + FCurrentDir := FSelectedItem; + if FSelectedNode.Level = 0 then + begin +// FCurrentDir := FSelectedItem; + if (not FShowSpecialDirView) or (not SpecialDirectoryView) then + DefaultDirectoryView; + end else + begin + if FSelectedItem.IsList then + begin +// FCurrentDir := FSelectedItem; + DefaultDirectoryView; + end else + begin + if FShowAsHexView or (not SpecialDetailView) then + DefaultDetailView; + end; + end; +end; + +function TPeResViewChild.CanSaveResource: Boolean; +begin + Result := Assigned(FSelectedItem) and not FSelectedItem.IsList and + ResourceTreeView.Focused; +end; + +procedure TPeResViewChild.ResourceTreeViewExpanding(Sender: TObject; + Node: TTreeNode; var AllowExpansion: Boolean); +var + N, L: Integer; + ListNode, ItemNode: TTreeNode; + Item, RootItem: TPeResItem; +begin + if Node.GetFirstChild = nil then with ResourceTreeView do + begin + Items.BeginUpdate; + try + RootItem := TPeResItem(Node.Data); + for N := 0 to RootItem.ItemCount - 1 do + begin + Item := RootItem[N]; + ListNode := Items.AddChildObject(Node, Item.ResName, Item); + if Item.IsList then + begin + ListNode.ImageIndex := icoFolderShut; + ListNode.SelectedIndex := icoFolderOpen; + for L := 0 to Item.ItemCount - 1 do + begin + ItemNode := Items.AddChildObject(ListNode, Item[L].ResName, Item[L]); + ItemNode.ImageIndex := icoResItem; + ItemNode.SelectedIndex := icoResItem; + end; + end else + begin + ListNode.ImageIndex := icoResItem; + ListNode.SelectedIndex := icoResItem; + end; + end; + finally + Items.EndUpdate; + end; + end; +end; + +procedure TPeResViewChild.SaveResource; +var + FileStream: TFileStream; +begin + with SaveDialog1, (FSelectedItem as TPeResUnknown) do + begin + Filter := Format('*.%s files|*.%s', [FileExt, FileExt]); + FileName := ResName + '.' + FileExt; + if Execute then + begin + FileStream := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(FileStream); + finally + FileStream.Free; + end; + end; + end; +end; + +procedure TPeResViewChild.DialogTestBtnClick(Sender: TObject); +var + Res: Integer; +begin + with ResourceTreeView do + while True do + begin + with TPeResDialog(FSelectedItem) do + if CanShowDialog then + Res := ShowDialog(Application.Handle) + else + Res := 1; + if (Res = 1) and (Selected.GetNextSibling <> nil) then + begin + Selected := Selected.GetNextSibling; + Selected.MakeVisible; + ResourceTreeView.Update; + end else + Break; + end; +end; + +// History: + +// $Log: PeResView.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeResource.pas b/official/1.96/examples/windows/delphitools/peviewer/PeResource.pas new file mode 100644 index 0000000..27a19e7 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeResource.pas @@ -0,0 +1,1545 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 PeResource.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit PeResource; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, Classes, SysUtils, Graphics, ComCtrls, + {$IFDEF DELPHI5_UP} + Contnrs, + {$ENDIF} + JclBase, JclFileUtils, JclPeImage, JclStrings; + +type + PAccelTableEntry = ^TAccelTableEntry; + ACCELTABLEENTRY = packed record + fFlags: Word; + wAnsi: Word; + wId: Word; + padding: Word; + end; + {$EXTERNALSYM ACCELTABLEENTRY} + TAccelTableEntry = ACCELTABLEENTRY; + + PCursorDir = ^TCursorDir; + CURSORDIR = packed record + Width: Word; + Height: Word; + end; + {$EXTERNALSYM CURSORDIR} + TCursorDir = CURSORDIR; + + PCursorShape = ^TCursorShape; + _CURSORSHAPE = packed record + xHotSpot: Integer; + yHotSpot: Integer; + cx: Integer; + cy: Integer; + cbWidth: Integer; + Planes: Byte; + BitsPixel: Byte; + end; + {$EXTERNALSYM _CURSORSHAPE} + TCursorShape = _CURSORSHAPE; + CURSORSHAPE = _CURSORSHAPE; + {$EXTERNALSYM CURSORSHAPE} + + PLocalHeader = ^TLocalHeader; + _LOCALHEADER = packed record + xHotSpot: Word; + yHotSpot: Word; + end; + {$EXTERNALSYM _LOCALHEADER} + TLocalHeader = _LOCALHEADER; + LOCALHEADER = _LOCALHEADER; + {$EXTERNALSYM LOCALHEADER} + + PNewHeader = ^TNewHeader; + _NEWHEADER = packed record + Reserved: Word; + ResType: Word; + ResCount: Word; + end; + {$EXTERNALSYM _NEWHEADER} + TNewHeader = _NEWHEADER; + NEWHEADER = _NEWHEADER; + {$EXTERNALSYM NEWHEADER} + + PIconResdir = ^TIconResdir; + ICONRESDIR = packed record + Width: Byte; + Height: Byte; + ColorCount: Byte; + Reserved: Byte; + end; + {$EXTERNALSYM ICONRESDIR} + TIconResdir = ICONRESDIR; + + TResInfo = packed record + case Integer of + 0: (Icon: TIconResdir); + 1: (Cursor: TCursorDir); + end; + {$NODEFINE TResInfo} + + PResDir = ^TResDir; + _RESDIR = packed record + ResInfo: TResInfo; + Planes: Word; + BitCount: Word; + BytesInRes: DWORD; + IconCursorId: Word; + end; + {$EXTERNALSYM _RESDIR} + TResDir = _RESDIR; + RESDIR = _RESDIR; + {$EXTERNALSYM RESDIR} + + PDlgTemplate = ^TDlgTemplate; + DLGTEMPLATE = packed record + style: DWORD; + dwExtendedStyle: DWORD; + cdit: Word; + x: ShortInt; // short + y: ShortInt; + cx: ShortInt; + cy: ShortInt; + end; + {$EXTERNALSYM DLGTEMPLATE} + TDlgTemplate = DLGTEMPLATE; + + PDlgItemTemplate = ^TDlgItemTemplate; + DLGITEMTEMPLATE = packed record + style: DWORD; + dwExtendedStyle: DWORD; + x: ShortInt; + y: ShortInt; + cx: ShortInt; + cy: ShortInt; + id: Word; + end; + {$EXTERNALSYM DLGITEMTEMPLATE} + TDlgItemTemplate = DLGITEMTEMPLATE; + + PMenuHeader = ^TMenuHeader; + MENUHEADER = packed record + wVersion: Word; + cbHeaderSize: Word; + end; + {$EXTERNALSYM MENUHEADER} + TMenuHeader = MENUHEADER; + + PMenuHelpID = ^TMenuHelpID; + MENUHELPID = packed record + helpID: DWORD; + end; + {$EXTERNALSYM MENUHELPID} + TMenuHelpID = MENUHELPID; + + PNormalMenuItem = ^TNormalMenuItem; + NORMALMENUITEM = packed record + resInfo: WORD; + menuText: Pointer; // szOrOrd + end; + {$EXTERNALSYM NORMALMENUITEM} + TNormalMenuItem = NORMALMENUITEM; + + PPopupMenuItem = ^TPopupMenuItem; + POPUPMENUITEM = packed record + type_: DWORD; + state: DWORD; + id: DWORD; + resInfo: Word; + menuText: Pointer; // szOrOrd + end; + {$EXTERNALSYM POPUPMENUITEM} + TPopupMenuItem = POPUPMENUITEM; + + PMenuExTemplateHeader = ^TMenuExTemplateHeader; + MENUEX_TEMPLATE_HEADER = packed record + wVersion: Word; + wOffset: Word; + dwHelpId: DWORD; + end; + {$EXTERNALSYM MENUEX_TEMPLATE_HEADER} + TMenuExTemplateHeader = MENUEX_TEMPLATE_HEADER; + + PMenuExTemplateItem = ^TMenuExTemplateItem; + MENUEX_TEMPLATE_ITEM = packed record + dwType: DWORD; + dwState: DWORD; + uId: UINT; + bResInfo: Word; + szText: array[0..0] of WideChar; + dwHelpId: DWORD; + end; + {$EXTERNALSYM MENUEX_TEMPLATE_ITEM} + TMenuExTemplateItem = MENUEX_TEMPLATE_ITEM; + + PMessageResourceBlock = ^TMessageResourceBlock; + _MESSAGE_RESOURCE_BLOCK = packed record + LowId: ULONG; + HighId: ULONG; + OffsetToEntries: ULONG; + end; + {$EXTERNALSYM _MESSAGE_RESOURCE_BLOCK} + TMessageResourceBlock = _MESSAGE_RESOURCE_BLOCK; + MESSAGE_RESOURCE_BLOCK = _MESSAGE_RESOURCE_BLOCK; + {$EXTERNALSYM MESSAGE_RESOURCE_BLOCK} + + PMessageResourceData = ^TMessageResourceData; + _MESSAGE_RESOURCE_DATA = packed record + NumberOfBlocks: ULONG; + // Blocks: array[0..0] of TMessageResourceBlock; + end; + {$EXTERNALSYM _MESSAGE_RESOURCE_DATA} + TMessageResourceData = _MESSAGE_RESOURCE_DATA; + MESSAGE_RESOURCE_DATA = _MESSAGE_RESOURCE_DATA; + {$EXTERNALSYM MESSAGE_RESOURCE_DATA} + + PMessageResourceEntry = ^TMessageResourceEntry; + _MESSAGE_RESOURCE_ENTRY = packed record + Length: Word; + Flags: Word; + // Text: array[0..0] of Char; + end; + {$EXTERNALSYM _MESSAGE_RESOURCE_ENTRY} + TMessageResourceEntry = _MESSAGE_RESOURCE_ENTRY; + MESSAGE_RESOURCE_ENTRY = _MESSAGE_RESOURCE_ENTRY; + {$EXTERNALSYM MESSAGE_RESOURCE_ENTRY} + +(* + +Value Meaning +0x0080 Button +0x0081 Edit +0x0082 Static +0x0083 List box +0x0084 Scroll bar +0x0085 Combo box} + + PDlgTemplateEx = ^TDlgTemplateEx; + DLGTEMPLATEEX = packed record + dlgVer: WORD; + signature: WORD; + helpID: DWORD; + exStyle: DWORD; + style: DWORD; + cDlgItems: WORD; + x: short; + y: short; + cx: short; + cy: short; + sz_Or_Ord menu; // name or ordinal of a menu resource + sz_Or_Ord windowClass; // name or ordinal of a window class + WCHAR title[titleLen]; // title string of the dialog box + short pointsize; // if DS_SETFONT or DS_SHELLFONT is set + short weight; // if DS_SETFONT or DS_SHELLFONT is set + short bItalic; // if DS_SETFONT or DS_SHELLFONT is set + WCHAR font[fontLen]; // if DS_SETFONT or DS_SHELLFONT is set +} DLGTEMPLATEEX; + + + typedef struct { + DWORD helpID; + DWORD exStyle; + DWORD style; + short x; + short y; + short cx; + short cy; + WORD id; + sz_Or_Ord windowClass; // name or ordinal of a window class + sz_Or_Ord title; // title string or ordinal of a resource + WORD extraCount; // bytes of following creation data +} DLGITEMTEMPLATEEX; + +struct FONTDIRENTRY { + WORD dfVersion; + DWORD dfSize; + char dfCopyright[60]; + WORD dfType; + WORD dfPoints; + WORD dfVertRes; + WORD dfHorizRes; + WORD dfAscent; + WORD dfInternalLeading; + WORD dfExternalLeading; + BYTE dfItalic; + BYTE dfUnderline; + BYTE dfStrikeOut; + WORD dfWeight; + BYTE dfCharSet; + WORD dfPixWidth; + WORD dfPixHeight; + BYTE dfPitchAndFamily; + WORD dfAvgWidth; + WORD dfMaxWidth; + BYTE dfFirstChar; + BYTE dfLastChar; + BYTE dfDefaultChar; + BYTE dfBreakChar; + WORD dfWidthBytes; + DWORD dfDevice; + DWORD dfFace; + DWORD dfReserved; + char szDeviceName[]; + char szFaceName[]; +}; + +struct FONTGROUPHDR { + WORD NumberOfFonts; + DIRENTRY DE [1]; +}; + +*) + +type + TPeResKind = (rkAccelerator, rkAvi, rkBitmap, rkCursor, rkData, rkDialog, + rkHTML, rkIcon, rkMenu, rkMessageTable, rkString, rkVersion, rkUnknown); + + TPeResImage = class; + + TPeResItem = class; + + TPeResItem = class(TPersistent) + private + FKind: TPeResKind; + FList: TObjectList; + FResImage: TPeResImage; + FResourceItem: TJclPeResourceItem; + FStream: TJclPeResourceRawStream; + function GetItems(Index: Integer): TPeResItem; + function GetItemCount: Integer; + function GetStream: TJclPeResourceRawStream; + protected + procedure CreateList; virtual; + public + constructor Create(AResImage: TPeResImage; AResourceItem: TJclPeResourceItem); virtual; + destructor Destroy; override; + function IsList: Boolean; virtual; + function Offset: Integer; + function RawData: Pointer; + function ResName: string; virtual; + function ResType: TJclPeResourceKind; + procedure SaveToStream(Stream: TStream); virtual; + function Size: Integer; + property ItemCount: Integer read GetItemCount; + property Items[Index: Integer]: TPeResItem read GetItems; default; + property Kind: TPeResKind read FKind; + property ResourceItem: TJclPeResourceItem read FResourceItem; + property Stream: TJclPeResourceRawStream read GetStream; + end; + + TJclReResItemClass = class of TPeResItem; + + TPeResUnknown = class(TPeResItem) + public + function FileExt: string; dynamic; + function IsList: Boolean; override; + function ResName: string; override; + end; + + TPeGraphicProperties = record + Width, Height, BitsPerPixel: Integer; + end; + + TPeResUnkGraphic = class(TPeResUnknown) + public + function GraphicProperties: TPeGraphicProperties; virtual; abstract; + end; + + TPeResUnkStrings = class(TPeResUnknown) + protected + procedure AssignTo(Dest: TPersistent); override; + public + function FileExt: string; override; + procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); virtual; abstract; + end; + + TPeResAccelerator = class(TPeResUnkStrings) + public + procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override; + end; + + TPeResAvi = class(TPeResUnknown) + protected + procedure AssignTo(Dest: TPersistent); override; + public + function FileExt: string; override; + end; + + TPeResBitmap = class(TPeResUnkGraphic) + protected + procedure AssignTo(Dest: TPersistent); override; + public + function GraphicProperties: TPeGraphicProperties; override; + function FileExt: string; override; + procedure SaveToStream(Stream: TStream); override; + end; + + TPeResCursorItem = class(TPeResUnkGraphic) + private + FResInfo: PResDir; + protected + procedure AssignTo(Dest: TPersistent); override; + public + function FileExt: string; override; + function GraphicProperties: TPeGraphicProperties; override; + function ResName: string; override; + procedure SaveToStream(Stream: TStream); override; + end; + + TPeResCursor = class(TPeResUnknown) + private + function GetItems(Index: Integer): TPeResCursorItem; + protected + procedure CreateList; override; + public + function IsList: Boolean; override; + property Items[Index: Integer]: TPeResCursorItem read GetItems; default; + end; + + TPeResDialog = class(TPeResUnknown) + public + function CanShowDialog: Boolean; + function ShowDialog(ParentWnd: HWND): Integer; + end; + + TPeResDataKind = (dkUnknown, dkDFM, dkPackageDescription, dkPackageInfo); + + TPeResRCData = class(TPeResUnknown) + private + FDataKind: TPeResDataKind; + protected + procedure AssignTo(Dest: TPersistent); override; + procedure CheckFormat; + procedure DFMToStrings(Strings: TStrings); + procedure PackageInfoToStrings(Strings: TStrings); + public + constructor Create(AResImage: TPeResImage; AResourceItem: TJclPeResourceItem); override; + function FileExt: string; override; + property DataKind: TPeResDataKind read FDataKind; + end; + + TPeResHTML = class(TPeResUnknown) + public + function FileExt: string; override; + function ResPath: string; + end; + + TPeResIconItem = class(TPeResCursorItem) + public + function FileExt: string; override; + function GraphicProperties: TPeGraphicProperties; override; + end; + + TPeResIcon = class(TPeResCursor) + private + function GetItems(Index: Integer): TPeResIconItem; + public + property Items[Index: Integer]: TPeResIconItem read GetItems; default; + end; + + TPeResMenu = class(TPeResUnknown) + end; + + TPeMessageTable = class(TPeResUnkStrings) + public + procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override; + end; + + TPeResString = class(TPeResUnkStrings) + public + procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override; + end; + + TPeResVersion = class(TPeResUnkStrings) + public + procedure FillStrings(Strings: TStrings; StripCrLf: Boolean = False); override; + end; + + TPeResImage = class(TObjectList) + private + FCursorEntry: TJclPeResourceList; + FIconEntry: TJclPeResourceList; + FImageAttached: Boolean; + FLibHandle: THandle; + FPeImage: TJclPeImage; + function GetFileName: TFileName; + procedure SetFileName(const Value: TFileName); + procedure SetPeImage(const Value: TJclPeImage); + function GetItems(Index: Integer): TPeResItem; + function GetLibHandle: THandle; + protected + procedure CreateList; + procedure UnloadLib; + public + constructor Create; + destructor Destroy; override; + procedure Clear; override; + property ImageAttached: Boolean read FImageAttached; + property Items[Index: Integer]: TPeResItem read GetItems; default; + property LibHandle: THandle read GetLibHandle; + property FileName: TFileName read GetFileName write SetFileName; + property PeImage: TJclPeImage read FPeImage write SetPeImage; + end; + + function LangNameFromName(const Name: string; ShortName: Boolean = False): string; + +implementation + +uses + Consts, JclLocales, JclSysUtils, JclWin32; + +resourcestring + RsPeResAccelerator = 'Accel table'; + RsPeResAVI = 'AVI'; + RsPeResBitmap = 'Bitmap'; + RsPeResCursor = 'Cursor'; + RsPeResData = 'RCData'; + RsPeResDialog = 'Dialog'; + RsPeResHTML = 'HTML'; + RsPeResIcon = 'Icon'; + RsPeResMenu = 'Menu'; + RsPeResMessageTable = 'Message table'; + RsPeResString = 'String'; + RsPeResVersion = 'Version'; + RsNeutralLang = '[Neutral]'; + RsUnknownLang = '[Unknown]'; + + RsTranslations = 'Translations:'; + +var + JclLocalesList: TJclLocalesList; + +function VirtualKeyNameFromCode(KeyCode: Byte): string; +const + KN002F: array[$00..$2F] of PChar = ( + nil, + 'LBUTTON', + 'RBUTTON', + 'CANCEL', + 'MBUTTON', + nil, nil, nil, // 05..07 + 'BACK', + 'TAB', + nil, nil, // 0A..0B + 'CLEAR', + 'RETURN', + nil, nil, // 0E..0F + 'SHIFT ', + 'CONTROL', + 'MENU', + 'PAUSE', + 'CAPITAL', + 'KANA', + 'HANGUL', + 'JUNJA', + 'FINAL', + 'HANJA', + 'KANJI', + 'ESCAPE', + 'CONVERT', + 'NONCONVERT', + 'ACCEPT', + 'MODECHANGE', + 'SPACE', + 'PRIOR', + 'NEXT', + 'END', + 'HOME', + 'LEFT', + 'UP', + 'RIGHT', + 'DOWN', + 'SELECT', + 'PRINT', + 'EXECUTE', + 'SNAPSHOT', + 'INSERT', + 'DELETE', + 'HELP' + ); + KN5B5D: array[$5B..$5D] of PChar = ( + 'LWIN', + 'RWIN', + 'APPS' + ); + KN6A6F: array[$6A..$6F] of PChar = ( + 'MULTIPLY', + 'ADD', + 'SEPARATOR', + 'SUBTRACT', + 'DECIMAL', + 'DIVIDE' + ); + KNA0A5: array[$A0..$A5] of PChar = ( + 'LSHIFT', + 'RSHIFT', + 'LCONTROL', + 'RCONTROL', + 'LMENU', + 'RMENU' + ); + KNF6FE: array[$F6..$FE] of PChar = ( + 'ATTN', + 'CRSEL', + 'EXSEL', + 'EREOF', + 'PLAY', + 'ZOOM', + 'NONAME', + 'PA1', + 'OEM_CLEAR' + ); +begin + case KeyCode of + $00..$2F: + Result := KN002F[KeyCode]; + $30..$39, $41..$5A: + Result := Chr(KeyCode); + $5B..$5D: + Result := KN5B5D[KeyCode]; + $60..$69: + Result := Format('NUMPAD%d', [KeyCode - $60]); + $6A..$6F: + Result := KN6A6F[KeyCode]; + $70..$87: + Result := Format('F%d', [KeyCode - $6F]); + $90: + Result := 'NUMLOCK'; + $91: + Result := 'SCROLL'; + $A0..$A5: + Result := KNA0A5[KeyCode]; + $E5: + Result := 'PROCESSKEY'; + $F6..$FE: + Result := KNF6FE[KeyCode]; + else + Result := ''; + end; + if Result <> '' then Result := 'VK_' + Result; +end; + +function LangNameFromName(const Name: string; ShortName: Boolean): string; +var + LangID: Word; + Locale: TJclLocaleInfo; +begin + LangID := PRIMARYLANGID(StrToIntDef(Name, 0)); + if LangID = LANG_NEUTRAL then + if ShortName then Result := '' else Result := RsNeutralLang + else + begin + Locale := JclLocalesList.ItemFromLangIDPrimary[LangID]; + if Locale <> nil then + with Locale do if ShortName then + Result := AbbreviatedLangName else Result := EnglishLangName + else + Result := RsUnknownLang; + end; +end; + + +function GetResItemKind(Item: TJclPeResourceItem; var Kind: TPeResKind): Boolean; +begin + Result := True; + Kind := rkUnknown; + with Item do + case ResourceType of + rtAccelerators: + Kind := rkAccelerator; + rtCursorEntry, rtIconEntry, rtFont: + Result := False; + rtUserDefined: + begin + if Name = 'AVI' then Kind := rkAvi; + if Name = '2110' then Kind := rkHTML; + end; + rtBitmap: + Kind := rkBitmap; + rtMenu: + Kind := rkMenu; + rtDialog: + Kind := rkDialog; + rtString: + Kind := rkString; + rtRCData: + Kind := rkData; + rtMessageTable: + Kind := rkMessageTable; + rtCursor: + Kind := rkCursor; + rtIcon: + Kind := rkIcon; + rtVersion: + Kind := rkVersion; + rtHmtl: + Kind := rkHTML; + end; +end; + +const + ResItemClasses: array [TPeResKind] of TJclReResItemClass = ( + TPeResAccelerator, + TPeResAvi, + TPeResBitmap, + TPeResCursor, + TPeResRCData, + TPeResDialog, + TPeResHTML, + TPeResIcon, + TPeResMenu, + TPeMessageTable, + TPeResString, + TPeResVersion, + TPeResUnknown + ); + +function WideCharToStr(WStr: PWChar; Len: Integer): string; +begin + if Len = 0 then Len := -1; + Len := WideCharToMultiByte(CP_ACP, 0, WStr, Len, nil, 0, nil, nil); + SetLength(Result, Len); + WideCharToMultiByte(CP_ACP, 0, WStr, Len, PChar(Result), Len, nil, nil); +end; + +{ TPeResItem } + +constructor TPeResItem.Create(AResImage: TPeResImage; AResourceItem: TJclPeResourceItem); +begin + FList := TObjectList.Create(True); + FResImage := AResImage; + FResourceItem := AResourceItem; +end; + +procedure TPeResItem.CreateList; +var + I, J: Integer; + Item: TPeResItem; + ResItem: TJclPeResourceItem; +begin + with FResourceItem.List do + for I := 0 to Count - 1 do + begin + ResItem := Items[I]; + for J := 0 to ResItem.List.Count - 1 do + begin + Item := ResItemClasses[Self.FKind].Create(FResImage, ResItem.List[J]); + Item.FKind := Self.FKind; + FList.Add(Item); + end; + end; +end; + +destructor TPeResItem.Destroy; +begin + FreeAndNil(FList); + FreeAndNil(FStream); + inherited; +end; + +function TPeResItem.GetItemCount: Integer; +begin + if IsList then + begin + if FList.Count = 0 then CreateList; + Result := FList.Count; + end else + Result := -1; +end; + +function TPeResItem.GetItems(Index: Integer): TPeResItem; +begin + Result := TPeResItem(FList[Index]); +end; + +function TPeResItem.GetStream: TJclPeResourceRawStream; +begin + if not Assigned(FStream) then + FStream := TJclPeResourceRawStream.Create(FResourceItem); + Result := FStream; +end; + +function TPeResItem.IsList: Boolean; +begin + Result := FResourceItem.IsDirectory; +end; + +function TPeResItem.Offset: Integer; +begin + if IsList then + Result := FResourceItem.Entry^.OffsetToData and not (IMAGE_RESOURCE_DATA_IS_DIRECTORY) + else + Result := FResourceItem.DataEntry^.OffsetToData +end; + +function TPeResItem.RawData: Pointer; +begin + Result := FResourceItem.RawEntryData; +end; + +function TPeResItem.ResName: string; +const + ResNames: array [TPeResKind] of PResStringRec = ( + @RsPeResAccelerator, + @RsPeResAVI, + @RsPeResBitmap, + @RsPeResCursor, + @RsPeResData, + @RsPeResDialog, + @RsPeResHTML, + @RsPeResIcon, + @RsPeResMenu, + @RsPeResMessageTable, + @RsPeResString, + @RsPeResVersion, + nil + ); +begin + if FKind = rkUnknown then + Result := FResourceItem.ResourceTypeStr + else + Result := LoadResString(ResNames[FKind]); +end; + +function TPeResItem.ResType: TJclPeResourceKind; +begin + Result := FResourceItem.ResourceType; +end; + +procedure TPeResItem.SaveToStream(Stream: TStream); +begin + if not IsList then + Stream.WriteBuffer(RawData^, Size); +end; + +function TPeResItem.Size: Integer; +begin + if IsList then + Result := 0 + else + Result := FResourceItem.DataEntry^.Size; +end; + +{ TPeResUnknown } + +function TPeResUnknown.FileExt: string; +begin + Result := 'bin'; +end; + +function TPeResUnknown.IsList: Boolean; +begin + Result := False; +end; + +function TPeResUnknown.ResName: string; +begin + if StrToIntDef(FResourceItem.Name, 0) = LANG_NEUTRAL then + Result := FResourceItem.ParentItem.Name + else + Result := Format('%s > %s', [FResourceItem.ParentItem.Name, LangNameFromName(FResourceItem.Name)]); +end; + +{ TPeResUnkStrings } + +procedure TPeResUnkStrings.AssignTo(Dest: TPersistent); +begin + if (Dest is TStrings) then + with TStrings(Dest) do + begin + BeginUpdate; + try + Clear; + FillStrings(TStrings(Dest)); + finally + EndUpdate; + end; + end + else + inherited; +end; + +function TPeResUnkStrings.FileExt: string; +begin + Result := 'txt'; +end; + +{ TPeResAccelTable } + +procedure TPeResAccelerator.FillStrings(Strings: TStrings; StripCrLf: Boolean); +var + TableEntry: PAccelTableEntry; + IsLast: Boolean; + S: string; + + function AnsiToChar(A: Word): string; + begin + if A >= 32 then Result := Chr(A) else Result := ''; + end; + +begin + Strings.BeginUpdate; + try + TableEntry := RawData; + repeat + with TableEntry^ do + begin + IsLast := fFlags and $80 <> 0; + if fFlags and FVIRTKEY <> 0 then + begin + S := Format('Virtual Key: %.2u "%s" ', [wAnsi, VirtualKeyNameFromCode(wAnsi)]); + if fFlags and FSHIFT <> 0 then S := S + 'SHIFT '; + if fFlags and FCONTROL <> 0 then S := S + 'CTRL '; + if fFlags and FALT <> 0 then S := S + 'ALT '; + end else + S := Format('ANSI character: %.2u "%s" ', [wAnsi, AnsiToChar(wAnsi)]); + if fFlags and FNOINVERT <> 0 then S := S + 'NOINVERT'; + end; + Strings.Add(TrimRight(S)); + Inc(TableEntry); + until IsLast; + finally + Strings.EndUpdate; + end; +end; + +{ TPeResAvi } + +{$HINTS OFF} +type + TDirtyComponent = class(TPersistent) + private + FOwner: TComponent; + FName: TComponentName; + FTag: Longint; + FComponents: TList; + FFreeNotifies: TList; + FDesignInfo: Longint; + FVCLComObject: Pointer; + FComponentState: TComponentState; + end; +{$HINTS ON} + +procedure TPeResAvi.AssignTo(Dest: TPersistent); +begin + if Dest is TAnimate then + begin + Include(TDirtyComponent(Dest).FComponentState, csLoading); + TAnimate(Dest).ResHandle := FResImage.LibHandle; + TAnimate(Dest).ResName := FResourceItem.ParentItem.ParameterName; + Exclude(TDirtyComponent(Dest).FComponentState, csLoading); + TAnimate(Dest).Reset; + end + else + inherited; +end; + +function TPeResAvi.FileExt: string; +begin + Result := 'avi'; +end; + +{ TPeResBitmap } + +procedure TPeResBitmap.AssignTo(Dest: TPersistent); +var + MemStream: TMemoryStream; + BitMap: TBitMap; +begin + if Dest is TPicture then + begin + BitMap := TPicture(Dest).Bitmap; + MemStream := TMemoryStream.Create; + try + SaveToStream(MemStream); + MemStream.Seek(0, soFromBeginning); + BitMap.LoadFromStream(MemStream); + finally + MemStream.Free; + end + end + else + inherited; +end; + +function TPeResBitmap.FileExt: string; +begin + Result := 'bmp'; +end; + +function TPeResBitmap.GraphicProperties: TPeGraphicProperties; +var + BI: PBitmapInfoHeader; + BC: PBitmapCoreHeader; +begin + BI := PBitmapInfoHeader(RawData); + if BI.biSize = SizeOf(TBitmapInfoHeader) then + begin + Result.Width := BI.biWidth; + Result.Height := BI.biHeight; + Result.BitsPerPixel := BI.biPlanes * BI.biBitCount; + end else + begin + BC := PBitmapCoreHeader(RawData); + Result.Width := BC.bcWidth; + Result.Height := BC.bcHeight; + Result.BitsPerPixel := BC.bcPlanes * BC.bcBitCount; + end; +end; + +procedure TPeResBitmap.SaveToStream(Stream: TStream); + + function GetDInColors(BitCount: Word): Integer; + begin + case BitCount of + 1, 4, 8: Result := 1 shl BitCount; + else + Result := 0; + end; + end; + +var + BH: TBitmapFileHeader; + BI: PBitmapInfoHeader; + BC: PBitmapCoreHeader; + ClrUsed: Integer; +begin + FillChar(BH, sizeof(BH), #0); + BH.bfType := $4D42; + BH.bfSize := Size + SizeOf(BH); + BI := PBitmapInfoHeader(RawData); + if BI.biSize = SizeOf(TBitmapInfoHeader) then + begin + ClrUsed := BI.biClrUsed; + if ClrUsed = 0 then ClrUsed := GetDInColors(BI.biBitCount); + BH.bfOffBits := ClrUsed * SizeOf(TRgbQuad) + SizeOf(TBitmapInfoHeader) + SizeOf(BH); + end + else + begin + BC := PBitmapCoreHeader(RawData); + ClrUsed := GetDInColors(BC.bcBitCount); + BH.bfOffBits := ClrUsed * SizeOf(TRGBTriple) + SizeOf(TBitmapCoreHeader) + SizeOf(BH); + end; + Stream.Write(BH, SizeOf(BH)); + Stream.Write(RawData^, Size); +end; + +{ TPeResCursorItem } + +procedure TPeResCursorItem.AssignTo(Dest: TPersistent); +begin + if Dest is TPicture then + TPicture(Dest).Icon.Handle := CreateIconFromResource(RawData, Size, ResType = rtIconEntry, $30000) + else + inherited; +end; + +function TPeResCursorItem.FileExt: string; +begin + Result := 'cur'; +end; + +function TPeResCursorItem.GraphicProperties: TPeGraphicProperties; +begin + with FResInfo^ do + begin + Result.Width := ResInfo.Cursor.Width; + Result.Height := ResInfo.Cursor.Height; + Result.BitsPerPixel := BitCount * Planes; + end; +end; + +function TPeResCursorItem.ResName: string; +begin + if FResInfo <> nil then + with GraphicProperties do + Result := Format('%d X %d %d bpp', [Width, Height, BitsPerPixel]) + else + Result := ''; +end; + +procedure TPeResCursorItem.SaveToStream(Stream: TStream); +begin + with TIcon.Create do + try + Handle := CreateIconFromResource(RawData, Self.Size, ResType = rtIconEntry, $30000); + SaveToStream(Stream); + finally + Free; + end; +end; +{ TODO : Saving monochrome icons and cursors doesn't work } + +{ TPeResCursor } + +procedure TPeResCursor.CreateList; +var + Item: TPeResItem; + I, J, Cnt: Integer; + ResData: PResDir; + ResOrd: DWORD; + ResList: TJclPeResourceList; + ItemClass: TJclReResItemClass; +begin + if ResType = rtCursor then + begin + ResList := FResImage.FCursorEntry; + ItemClass := TPeResCursorItem; + end else + begin + ResList := FResImage.FIconEntry; + ItemClass := TPeResIconItem; + end; + ResData := RawData; + Cnt := PNewHeader(ResData)^.ResCount; + Inc(PNewHeader(ResData)); + for I := 1 to Cnt do + begin + ResOrd := ResData^.IconCursorId; + for J := 0 to ResList.Count - 1 do + if ResOrd = ResList[J].Entry^.Name then + begin + Item := ItemClass.Create(FResImage, ResList[J].List[0]); + Item.FKind := Self.FKind; + TPeResCursorItem(Item).FResInfo := ResData; + FList.Add(Item); + end; + Inc(ResData); + end; +end; + +function TPeResCursor.GetItems(Index: Integer): TPeResCursorItem; +begin + Result := TPeResCursorItem(FList[Index]); +end; + +function TPeResCursor.IsList: Boolean; +begin + Result := True; +end; + +{ TPeResRCData } + +procedure TPeResRCData.AssignTo(Dest: TPersistent); +begin + if Dest is TStrings then + with TStrings(Dest) do + begin + BeginUpdate; + try + Clear; + case FDataKind of + dkDFM: + DFMToStrings(TStrings(Dest)); + dkPackageDescription: + Add(PWideChar(RawData)); + dkPackageInfo: + PackageInfoToStrings(TStrings(Dest)); + end; + finally + EndUpdate; + end; + end else + inherited; +end; + +procedure TPeResRCData.CheckFormat; +{$IFNDEF DELPHI5_UP} +const + FilerSignature: array[1..4] of Char = 'TPF0'; +var + Signature: Integer; +{$ENDIF DELPHI5_UP} +begin + FDataKind := dkUnknown; + if ResName = 'DESCRIPTION' then + FDataKind := dkPackageDescription + else + if ResName = 'PACKAGEINFO' then + FDataKind := dkPackageInfo + else + begin + Stream.Seek(0, soFromBeginning); + {$IFDEF DELPHI5_UP} + if TestStreamFormat(Stream) = sofBinary then + FDataKind := dkDFM; + {$ELSE DELPHI5_UP} + Signature := 0; + Stream.Read(Signature, SizeOf(Signature)); + if (Byte(Signature) = $FF) or (Signature = Integer(FilerSignature)) then + FDataKind := dkDFM; + {$ENDIF DELPHI5_UP} + end; +end; + +constructor TPeResRCData.Create(AResImage: TPeResImage; + AResourceItem: TJclPeResourceItem); +begin + inherited; + CheckFormat; +end; + +procedure TPeResRCData.DFMToStrings(Strings: TStrings); +var + MemStream: TMemoryStream; +begin + MemStream := TMemoryStream.Create; + try + Stream.Seek(0, soFromBeginning); + ObjectBinaryToText(Stream, MemStream); + MemStream.Seek(0, soFromBeginning); + Strings.LoadFromStream(MemStream); + finally + MemStream.Free; + end; +end; + +function TPeResRCData.FileExt: string; +begin + if DataKind = dkDFM then + Result := 'dfm' + else + Result := inherited FileExt; +end; + +procedure TPeResRCData.PackageInfoToStrings(Strings: TStrings); +var + I: Integer; +begin + with TJclPePackageInfo.Create(FResImage.LibHandle) do + try + Strings.Add('Contains'); + Strings.Add(StringOfChar('-', 80)); + for I := 0 to ContainsCount - 1 do + Strings.Add(Format(' %s [%s]', [ContainsNames[I], UnitInfoFlagsToString(ContainsFlags[I])])); + if RequiresCount > 0 then + begin + Strings.Add(''); + Strings.Add('Requires'); + Strings.Add(StringOfChar('-', 80)); + for I := 0 to RequiresCount - 1 do + Strings.Add(Format(' %s', [RequiresNames[I]])); + end; + Strings.Add(''); + Strings.Add('Package Info flags'); + Strings.Add(StringOfChar('-', 80)); + Strings.Add(Format('Options : %s', [PackageOptionsToString(Flags)])); + Strings.Add(Format('Module type: %s', [PackageModuleTypeToString(Flags)])); + Strings.Add(Format('Producer : %s', [ProducerToString(Flags)])); + finally + Free; + end; +end; + +{ TPeResDialog } + +function TPeResDialog.CanShowDialog: Boolean; +begin + Result := Windows.PDlgTemplate(RawData)^.style and DS_CONTROL = 0; +end; + +function TPeResDialog.ShowDialog(ParentWnd: HWND): Integer; +var + LastFocus: HWND; + MemHandle: THandle; + P: Windows.PDlgTemplate; + + function DialogProc(hwndDlg: HWND; uMsg: UINT; W: WPARAM; L: LPARAM): BOOL; stdcall; + begin + Result := False; + case uMsg of + WM_INITDIALOG: + Result := True; + WM_LBUTTONDBLCLK: + EndDialog(hwndDlg, 0); + WM_RBUTTONUP: + EndDialog(hwndDlg, 1); + WM_SYSCOMMAND: + if W and $FFF0 = SC_CLOSE then + EndDialog(hwndDlg, 0); + end; + end; + +begin + LastFocus := GetFocus; + MemHandle := GlobalAlloc(GMEM_ZEROINIT, Size); + P := GlobalLock(MemHandle); + Move(RawData^, P^, Size); + GlobalUnlock(MemHandle); + Result := DialogBoxIndirect(hinstance, Windows.PDlgTemplate(MemHandle)^, + ParentWnd, @DialogProc); + GlobalFree(MemHandle); + SetFocus(LastFocus); +end; + +{ TPeResHTML } + +function TPeResHTML.FileExt: string; +begin + Result := Copy(ExtractFileExt(FResourceItem.ParentItem.ParameterName), 2, 20); +end; + +function TPeResHTML.ResPath: string; +begin + Result := Format('res://%s/%s', [FResImage.FileName, FResourceItem.ParentItem.ParameterName]); +end; + +{ TPeResIconItem } + +function TPeResIconItem.FileExt: string; +begin + Result := 'ico'; +end; + +function TPeResIconItem.GraphicProperties: TPeGraphicProperties; +begin + with FResInfo^ do + begin + Result.Width := ResInfo.Icon.Width; + Result.Height := ResInfo.Icon.Height; + Result.BitsPerPixel := BitCount * Planes; + end; +end; + +{ TPeResIcon } + +function TPeResIcon.GetItems(Index: Integer): TPeResIconItem; +begin + Result := TPeResIconItem(FList[Index]); +end; + +{ TPeMessageTable } + +procedure TPeMessageTable.FillStrings(Strings: TStrings; StripCrLf: Boolean); +var + Count, I: Integer; + E: DWORD; + Block: PMessageResourceBlock; + Entry: PMessageResourceEntry; + S: string; + Text: PChar; + Data: Pointer; +begin + Data := RawData; + Count := PMessageResourceData(Data)^.NumberOfBlocks; + Block := Data; + Inc(PMessageResourceData(Block)); + for I := 1 to Count do + begin + Entry := PMessageResourceEntry(DWORD(Data) + Block^.OffsetToEntries); + for E := Block^.LowId to Block^.HighId do + begin + with Entry^ do + begin + Text := PChar(Entry) + Sizeof(TMessageResourceEntry); + if Flags = 1 then + S := WideCharToStr(PWideChar(Text), lstrlenW(PWideChar(Text))) + else + SetString(S, PAnsiChar(Text), StrLen(Text)); + if StripCrLf then S := StrRemoveChars(S, [AnsiCarriageReturn, AnsiLineFeed]); + Strings.AddObject(S, Pointer(E)); + end; + Entry := Pointer(PChar(Entry) + Entry^.Length); + end; + Inc(Block); + end; +end; + +{ TPeResString } + +procedure TPeResString.FillStrings(Strings: TStrings; StripCrLf: Boolean); +var + P: PWChar; + ID: Integer; + Cnt: Cardinal; + Len: Word; + S: string; +begin + P := RawData; + Cnt := 0; + while Cnt < 16 do + begin + Len := Word(P^); + if Len > 0 then + begin + Inc(P); + ID := ((FResourceItem.ParentItem.Entry^.Name - 1) shl 4) + Cnt; + S := WideCharToStr(P, Len); + if StripCrLf then S := StrRemoveChars(S, [AnsiCarriageReturn, AnsiLineFeed]); + Strings.AddObject(S, Pointer(ID)); + Inc(P, Len); + end else + Inc(P); + Inc(Cnt); + end; +end; + +{ TPeResVersion } + +procedure TPeResVersion.FillStrings(Strings: TStrings; StripCrLf: Boolean); +var + I: Integer; +begin + Strings.Clear; + with TJclFileVersionInfo.Attach(RawData, Size) do + try + for I := 0 to LanguageCount - 1 do + begin + LanguageIndex := I; + Strings.Add(Format('[%s] %s', [LanguageIds[I], LanguageNames[I]])); + Strings.Add(StringOfChar('-', 80)); + Strings.AddStrings(Items); + Strings.Add(BinFileVersion); + Strings.Add(OSIdentToString(FileOS)); + Strings.Add(OSFileTypeToString(FileType, FileSubType)); + Strings.Add(''); + end; + Strings.Add(RsTranslations); + for I := 0 to TranslationCount - 1 do + Strings.Add(VersionLanguageId(Translations[I])); + finally + Free; + end; +end; + +{ TPeResImage } + +procedure TPeResImage.Clear; +begin + inherited; + if Assigned(FPeImage) then + begin + if not FImageAttached then FreeAndNil(FPeImage) else FPeImage := nil; + end; +end; + +constructor TPeResImage.Create; +begin + inherited Create(True); +end; + +procedure TPeResImage.CreateList; +var + I: Integer; + Kind: TPeResKind; + Item: TJclPeResourceItem; + ResItem: TPeResItem; +begin + with FPeImage.ResourceList do + for I := 0 to Count - 1 do + begin + Item := Items[I]; + if GetResItemKind(Item, Kind) then + begin + ResItem := TPeResItem.Create(Self, Item); + ResItem.FKind := Kind; + Self.Add(ResItem); + end else + case Item.ResourceType of + rtCursorEntry: + FCursorEntry := Item.List; + rtIconEntry: + FIconEntry := Item.List; + end; + end; +end; + +destructor TPeResImage.Destroy; +begin + UnloadLib; + inherited; +end; + +function TPeResImage.GetFileName: TFileName; +begin + if Assigned(FPeImage) then Result := FPeImage.FileName else Result := ''; +end; + +function TPeResImage.GetItems(Index: Integer): TPeResItem; +begin + Result := TPeResItem(inherited Items[Index]); +end; + +function TPeResImage.GetLibHandle: THandle; +begin + if FLibHandle = 0 then + begin + FLibHandle := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE); + if FLibHandle = 0 then RaiseLastOSError; + end; + Result := FLibHandle; +end; + +procedure TPeResImage.SetFileName(const Value: TFileName); +begin + if FileName <> Value then + begin + Clear; + FImageAttached := False; + FPeImage := TJclPeImage.Create; + FPeImage.FileName := Value; + CreateList; + end; +end; + +procedure TPeResImage.SetPeImage(const Value: TJclPeImage); +begin + Clear; + FPeImage := Value; + FImageAttached := True; + CreateList; +end; + +procedure TPeResImage.UnloadLib; +begin + if FLibHandle <> 0 then + begin + FreeLibrary(FLibHandle); + FLibHandle := 0; + end; +end; + +initialization + JclLocalesList := TJclLocalesList.Create; + +finalization + FreeAndNil(JclLocalesList); + +// History: + +// $Log: PeResource.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeSearch.dfm b/official/1.96/examples/windows/delphitools/peviewer/PeSearch.dfm new file mode 100644 index 0000000..272339e --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeSearch.dfm @@ -0,0 +1,162 @@ +object PeSearchChild: TPeSearchChild + Left = 259 + Top = 176 + AutoScroll = False + Caption = 'Search function' + ClientHeight = 265 + ClientWidth = 397 + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 300 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + FormStyle = fsMDIChild + OldCreateOrder = False + Position = poDefaultPosOnly + Visible = True + OnClose = FormClose + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object ProcessLabel: TLabel + Left = 8 + Top = 80 + Width = 64 + Height = 13 + Caption = 'ProcessLabel' + end + object Bevel1: TBevel + Left = 0 + Top = 56 + Width = 398 + Height = 18 + Anchors = [akLeft, akTop, akRight] + Shape = bsBottomLine + end + object CountLabel: TLabel + Left = 334 + Top = 81 + Width = 54 + Height = 13 + Alignment = taRightJustify + Anchors = [akTop, akRight] + Caption = 'CountLabel' + end + object Label1: TLabel + Left = 6 + Top = 12 + Width = 31 + Height = 13 + Caption = '&Name:' + FocusControl = FuncNameEdit + end + object Label2: TLabel + Left = 6 + Top = 44 + Width = 25 + Height = 13 + Caption = '&Path:' + FocusControl = PathEdit + end + object FuncNameEdit: TEdit + Left = 40 + Top = 8 + Width = 155 + Height = 21 + Anchors = [akLeft, akTop, akRight] + AutoSize = False + CharCase = ecUpperCase + TabOrder = 0 + OnChange = FuncNameEditChange + end + object ResultListView: TListView + Left = 0 + Top = 104 + Width = 397 + Height = 161 + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = < + item + Caption = 'Name' + Width = 90 + end + item + Caption = 'Filename' + Width = 300 + end> + ColumnClick = False + MultiSelect = True + ReadOnly = True + RowSelect = True + TabOrder = 1 + ViewStyle = vsReport + OnDblClick = ResultListViewDblClick + end + object StartBtn: TButton + Left = 318 + Top = 8 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = 'Start' + Default = True + TabOrder = 2 + OnClick = StartBtnClick + end + object StopBtn: TButton + Left = 318 + Top = 40 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Cancel = True + Caption = 'Stop' + Enabled = False + TabOrder = 3 + OnClick = StopBtnClick + end + object PathEdit: TEdit + Left = 40 + Top = 40 + Width = 251 + Height = 21 + Anchors = [akLeft, akTop, akRight] + AutoSize = False + CharCase = ecUpperCase + TabOrder = 4 + OnChange = FuncNameEditChange + end + object SelectDirBtn: TButton + Left = 295 + Top = 40 + Width = 13 + Height = 21 + Anchors = [akTop, akRight] + Caption = '...' + TabOrder = 5 + OnClick = SelectDirBtnClick + end + object ExportCheckBox: TCheckBox + Left = 203 + Top = 8 + Width = 49 + Height = 17 + Anchors = [akTop, akRight] + Caption = '&Export' + TabOrder = 6 + OnClick = FuncNameEditChange + end + object ImportCheckBox: TCheckBox + Left = 260 + Top = 8 + Width = 49 + Height = 17 + Anchors = [akTop, akRight] + Caption = '&Import' + TabOrder = 7 + OnClick = FuncNameEditChange + end +end diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeSearch.pas b/official/1.96/examples/windows/delphitools/peviewer/PeSearch.pas new file mode 100644 index 0000000..a745989 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeSearch.pas @@ -0,0 +1,233 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 PeSearch.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit PeSearch; + +{$I JCL.INC} + +{$IFDEF COMPILER6_UP} + {$WARN UNIT_PLATFORM OFF} +{$ENDIF COMPILER6_UP} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls, JclPeImage, ExtCtrls; + +type + TPeSearchChild = class(TForm) + FuncNameEdit: TEdit; + ResultListView: TListView; + StartBtn: TButton; + ProcessLabel: TLabel; + StopBtn: TButton; + Bevel1: TBevel; + PathEdit: TEdit; + CountLabel: TLabel; + SelectDirBtn: TButton; + Label1: TLabel; + Label2: TLabel; + ExportCheckBox: TCheckBox; + ImportCheckBox: TCheckBox; + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure StartBtnClick(Sender: TObject); + procedure StopBtnClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure SelectDirBtnClick(Sender: TObject); + procedure FuncNameEditChange(Sender: TObject); + procedure ResultListViewDblClick(Sender: TObject); + private + FSearchThread: TJclPeNameSearch; + procedure SearchDone(Sender: TObject); + procedure SearchFound(Sender: TObject; const FileName: TFileName; + const FunctionName: string; Option: TJclPeNameSearchOption); + procedure SearchProcessFile(Sender: TObject; PeImage: TJclPeImage; var Process: Boolean); + procedure UpdateCounter; + procedure UpdateButtons; + public + function ActiveLibName: string; + procedure ClearResults; + procedure StartSearch; + procedure StopSearch; + end; + +var + PeSearchChild: TPeSearchChild; + +implementation + +{$R *.DFM} + +uses + FileCtrl, JclSysInfo, PeViewerMain; + +procedure TPeSearchChild.FormClose(Sender: TObject; var Action: TCloseAction); +begin + if Assigned(FSearchThread) then + begin + FSearchThread.OnFound := nil; + FSearchThread.OnProcessFile := nil; + FSearchThread.OnTerminate := nil; + FSearchThread.Terminate; + end; + Action := caFree; +end; + +procedure TPeSearchChild.SearchDone(Sender: TObject); +begin + FSearchThread := nil; + UpdateButtons; + ProcessLabel.Caption := ''; +end; + +procedure TPeSearchChild.SearchFound(Sender: TObject; const FileName: TFileName; + const FunctionName: string; Option: TJclPeNameSearchOption); +begin + with ResultListView.Items.Add do + begin + Caption := FunctionName; + SubItems.Add(FileName); + case Option of + seImports: ImageIndex := icoImports; + seDelayImports: ImageIndex := icoDelayImport; + seBoundImports: ImageIndex := icoBoundImport; + seExports: ImageIndex := icoExports; + end; + end; + UpdateCounter; +end; + +procedure TPeSearchChild.SearchProcessFile(Sender: TObject; PeImage: TJclPeImage; var Process: Boolean); +begin + ProcessLabel.Caption := PeImage.FileName; +end; + +procedure TPeSearchChild.StartSearch; +var + Options: TJclPeNameSearchOptions; +begin + Options := []; + if ExportCheckBox.Checked then Include(Options, seExports); + if ImportCheckBox.Checked then Options := Options + [seImports, seDelayImports, seBoundImports]; + FSearchThread := TJclPeNameSearch.Create(Trim(FuncNameEdit.Text), + PathEdit.Text, Options); + FSearchThread.OnTerminate := SearchDone; + FSearchThread.OnFound := SearchFound; + FSearchThread.OnProcessFile := SearchProcessFile; + UpdateButtons; + ClearResults; + FSearchThread.Resume; +end; + +procedure TPeSearchChild.StopSearch; +begin + FSearchThread.Terminate; +end; + +procedure TPeSearchChild.StartBtnClick(Sender: TObject); +begin + StartSearch; +end; + +procedure TPeSearchChild.StopBtnClick(Sender: TObject); +begin + StopSearch; +end; + +procedure TPeSearchChild.FormCreate(Sender: TObject); +begin + ProcessLabel.Caption := ''; + PathEdit.Text := GetWindowsSystemFolder; + UpdateButtons; + UpdateCounter; +end; + +procedure TPeSearchChild.SelectDirBtnClick(Sender: TObject); +var + S: string; +begin + if SelectDirectory('', '', S) then PathEdit.Text := S; +end; + +procedure TPeSearchChild.ClearResults; +begin + with ResultListView.Items do + begin + BeginUpdate; + Clear; + EndUpdate; + end; + UpdateCounter; +end; + +procedure TPeSearchChild.UpdateCounter; +begin + with ResultListView.Items do + if Count = 0 then + CountLabel.Caption := '' + else + CountLabel.Caption := Format('%d', [Count]); +end; + +procedure TPeSearchChild.UpdateButtons; +begin + StartBtn.Enabled := (FuncNameEdit.Text <> '') and (PathEdit.Text <> '') and + (ImportCheckBox.Checked or ExportCheckBox.Checked) and + not Assigned(FSearchThread); + StopBtn.Enabled := Assigned(FSearchThread); + FuncNameEdit.Enabled := not Assigned(FSearchThread); + PathEdit.Enabled := not Assigned(FSearchThread); + SelectDirBtn.Enabled := not Assigned(FSearchThread); + ExportCheckBox.Enabled := not Assigned(FSearchThread); + ImportCheckBox.Enabled := not Assigned(FSearchThread); +end; + +procedure TPeSearchChild.FuncNameEditChange(Sender: TObject); +begin + UpdateButtons; +end; + +function TPeSearchChild.ActiveLibName: string; +begin + if ResultListView.Selected <> nil then + Result := ResultListView.Selected.SubItems[0] + else + Result := ''; +end; + +procedure TPeSearchChild.ResultListViewDblClick(Sender: TObject); +begin + MainForm.OpenLibrary1.Execute; +end; + +// History: + +// $Log: PeSearch.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeViewer.dof b/official/1.96/examples/windows/delphitools/peviewer/PeViewer.dof new file mode 100644 index 0000000..bc483da --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeViewer.dof @@ -0,0 +1,134 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir=..\..\..\..\bin +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=..\..\..\..\source;..\..\..\..\source\common;..\..\..\..\source\windows;..\..\..\..\source\vcl +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=0 +MinorVer=5 +Release=4 +Build=129 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1033 +CodePage=1252 +[Version Info Keys] +CompanyName=Petr Vones +FileDescription=PE Viewer +FileVersion=0.5.4.129 +InternalName=PEVIEWER +LegalCopyright=(c) 2002 Petr Vones +LegalTrademarks= +OriginalFilename=PEVIEWER.EXE +ProductName=PE Viewer +ProductVersion=0.5.4 diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeViewer.dpr b/official/1.96/examples/windows/delphitools/peviewer/PeViewer.dpr new file mode 100644 index 0000000..96bed79 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeViewer.dpr @@ -0,0 +1,30 @@ +program PeViewer; + +uses + Forms, + SysUtils, + D6MdiMsgFix in '..\Common\D6MdiMsgFix.pas', + PeViewerMain in 'PeViewerMain.pas' {MainForm}, + PeDump in 'PeDump.pas' {PeDumpChild}, + PeSearch in 'PeSearch.pas' {PeSearchChild}, + PeViewer_TLB in 'PeViewer_TLB.pas', + PeViewerControl in 'PeViewerControl.pas' {PeViewerControl: CoClass}, + PeResource in 'PeResource.pas', + PeResView in 'PeResView.pas' {PeResViewChild}, + ToolsUtils in '..\Common\ToolsUtils.pas', + About in '..\Common\About.pas' {AboutBox}, + PeGenDef in 'PeGenDef.pas' {PeGenDefChild}, + FindDlg in '..\Common\FindDlg.pas' {FindTextForm}, + ExceptDlg in '..\..\..\..\experts\debug\dialog\ExceptDlg.pas' {ExceptionDialog}, + SHDocVw_TLB in '..\Common\SHDocVw_TLB.pas'; + +{$R *.TLB} + +{$R *.RES} + +begin + Application.Initialize; + Application.Title := 'PE Viewer'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeViewer.res b/official/1.96/examples/windows/delphitools/peviewer/PeViewer.res new file mode 100644 index 0000000..26d12ee Binary files /dev/null and b/official/1.96/examples/windows/delphitools/peviewer/PeViewer.res differ diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeViewer.tlb b/official/1.96/examples/windows/delphitools/peviewer/PeViewer.tlb new file mode 100644 index 0000000..bd17d10 Binary files /dev/null and b/official/1.96/examples/windows/delphitools/peviewer/PeViewer.tlb differ diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeViewerControl.pas b/official/1.96/examples/windows/delphitools/peviewer/PeViewerControl.pas new file mode 100644 index 0000000..603cb49 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeViewerControl.pas @@ -0,0 +1,94 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 PeViewerControl.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2006/01/15 11:21:32 $ } +{ } +{**************************************************************************************************} + +unit PeViewerControl; + +{$I JCL.INC} + +interface + +uses + ComObj, ActiveX, PeViewer_TLB, Forms, Windows, StdVcl; + +type + TPeViewerControl = class(TAutoObject, IPeViewerControl) + private + FROTHandle: Integer; + protected + procedure OpenFile(const FileName: WideString); safecall; + procedure BringToFront; safecall; + { Protected declarations } + public + destructor Destroy; override; + procedure Initialize; override; + end; + +implementation + +uses ComServ, PeViewerMain; + +procedure TPeViewerControl.OpenFile(const FileName: WideString); +begin + if Length(FileName) > 0 then MainForm.OpenFile(FileName, True); +end; + +procedure TPeViewerControl.BringToFront; +begin + Application.Restore; + SetForegroundWindow(Application.Handle); +end; + +procedure TPeViewerControl.Initialize; +begin + inherited; + OleCheck(RegisterActiveObject(Self as IUnknown, Class_PeViewerControl, + ACTIVEOBJECT_WEAK, FROTHandle)); + {$IFDEF COMPILER5_UP} + ComServer.UIInteractive := False; + {$ENDIF} +end; + +destructor TPeViewerControl.Destroy; +begin + OleCheck(RevokeActiveObject(FROTHandle, nil)); + inherited; +end; + +initialization + TAutoObjectFactory.Create(ComServer, TPeViewerControl, Class_PeViewerControl, + ciMultiInstance, tmApartment); + +// History: + +// $Log: PeViewerControl.pas,v $ +// Revision 1.3 2006/01/15 11:21:32 outchy +// Removed Log tag +// Changed DELPHI5 to COMPILER5 +// +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeViewerMain.dfm b/official/1.96/examples/windows/delphitools/peviewer/PeViewerMain.dfm new file mode 100644 index 0000000..e5aa53f --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeViewerMain.dfm @@ -0,0 +1,2179 @@ +object MainForm: TMainForm + Left = 193 + Top = 108 + Width = 576 + Height = 403 + Caption = 'PE Viewer' + Color = clAppWorkSpace + Constraints.MinHeight = 150 + Constraints.MinWidth = 370 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + FormStyle = fsMDIForm + Menu = MainMenu1 + OldCreateOrder = False + Position = poDefault + ShowHint = True + Visible = True + WindowMenu = Window1 + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object StatusBar1: TStatusBar + Left = 0 + Top = 330 + Width = 568 + Height = 19 + Panels = < + item + Width = 50 + end> + end + object CoolBar1: TCoolBar + Left = 0 + Top = 0 + Width = 568 + Height = 26 + AutoSize = True + Bands = < + item + Break = False + Control = ToolBar1 + ImageIndex = -1 + MinHeight = 22 + Width = 564 + end> + Color = clBtnFace + ParentColor = False + OnResize = CoolBar1Resize + object ToolBar1: TToolBar + Left = 9 + Top = 0 + Width = 551 + Height = 22 + AutoSize = True + Caption = 'ToolBar1' + Color = clBtnFace + EdgeBorders = [] + Flat = True + Images = ToolbarImagesList + ParentColor = False + TabOrder = 0 + object ToolButton1: TToolButton + Left = 0 + Top = 0 + Action = FileOpen1 + end + object ToolButton3: TToolButton + Left = 23 + Top = 0 + Action = Copy1 + end + object ToolButton4: TToolButton + Left = 46 + Top = 0 + Action = Save1 + end + object ToolButton20: TToolButton + Left = 69 + Top = 0 + Action = Find1 + end + object ToolButton5: TToolButton + Left = 92 + Top = 0 + Width = 8 + Caption = 'ToolButton5' + ImageIndex = 3 + Style = tbsSeparator + end + object ToolButton7: TToolButton + Left = 100 + Top = 0 + Action = GroupImports1 + Style = tbsCheck + end + object ToolButton19: TToolButton + Left = 123 + Top = 0 + Action = UnmangleNames1 + Style = tbsCheck + end + object ToolButton2: TToolButton + Left = 146 + Top = 0 + Action = OpenLibrary1 + end + object ToolButton18: TToolButton + Left = 169 + Top = 0 + Action = ShowUnitGen1 + end + object ToolButton11: TToolButton + Left = 192 + Top = 0 + Action = InvokeHelp1 + end + object ToolButton15: TToolButton + Left = 215 + Top = 0 + Width = 8 + Caption = 'ToolButton15' + ImageIndex = 10 + Style = tbsSeparator + end + object ToolButton14: TToolButton + Left = 223 + Top = 0 + Action = ViewResources1 + end + object ToolButton16: TToolButton + Left = 246 + Top = 0 + Action = ViewResDetails1 + Style = tbsCheck + end + object ToolButton17: TToolButton + Left = 269 + Top = 0 + Action = ViewResHex1 + Style = tbsCheck + end + object ToolButton8: TToolButton + Left = 292 + Top = 0 + Width = 8 + Caption = 'ToolButton8' + ImageIndex = 4 + Style = tbsSeparator + end + object ToolButton6: TToolButton + Left = 300 + Top = 0 + Action = Search1 + end + object ToolButton10: TToolButton + Left = 323 + Top = 0 + Width = 8 + Caption = 'ToolButton10' + ImageIndex = 14 + Style = tbsSeparator + end + object ToolButton9: TToolButton + Left = 331 + Top = 0 + Action = WindowCascade1 + end + object ToolButton12: TToolButton + Left = 354 + Top = 0 + Action = WindowTileHorizontal1 + end + object ToolButton13: TToolButton + Left = 377 + Top = 0 + Action = WindowTileVertical1 + end + end + end + object MainMenu1: TMainMenu + Images = ToolbarImagesList + Left = 8 + Top = 304 + object File1: TMenuItem + Caption = 'File' + object Open1: TMenuItem + Action = FileOpen1 + end + object Savetofile1: TMenuItem + Action = Save1 + end + object N3: TMenuItem + Caption = '-' + end + object Exit2: TMenuItem + Action = Exit1 + end + end + object Edit1: TMenuItem + Caption = 'Edit' + object Copytoclipboard1: TMenuItem + Action = Copy1 + end + object Selectall2: TMenuItem + Action = SelectAll1 + end + object N4: TMenuItem + Caption = '-' + end + object Findtext1: TMenuItem + Action = Find1 + end + end + object View1: TMenuItem + Caption = 'View' + object Search2: TMenuItem + Action = Search1 + end + object Openlibrary2: TMenuItem + Action = OpenLibrary1 + end + object Groupimports2: TMenuItem + Action = GroupImports1 + end + object Pascalunitgenerator1: TMenuItem + Action = ShowUnitGen1 + end + object N2: TMenuItem + Caption = '-' + end + object Unmanglenames2: TMenuItem + Action = UnmangleNames1 + end + object Viewresources2: TMenuItem + Action = ViewResources1 + end + object Viewdetails1: TMenuItem + Action = ViewResDetails1 + end + object Viewashex1: TMenuItem + Action = ViewResHex1 + end + end + object Window1: TMenuItem + Caption = 'Window' + object Cascade1: TMenuItem + Action = WindowCascade1 + end + object TileHorizontally1: TMenuItem + Action = WindowTileHorizontal1 + end + object TileVertically1: TMenuItem + Action = WindowTileVertical1 + end + end + object Help1: TMenuItem + Caption = 'Help' + object FindinWin32APIhelp1: TMenuItem + Action = InvokeHelp1 + end + object N1: TMenuItem + Caption = '-' + end + object Support1: TMenuItem + Action = SendMail1 + end + object About2: TMenuItem + Action = About1 + end + end + end + object ActionList: TActionList + Images = ToolbarImagesList + Left = 40 + Top = 304 + object Exit1: TAction + Caption = 'Exit' + Hint = 'Exit' + ImageIndex = 0 + OnExecute = Exit1Execute + end + object FileOpen1: TAction + Caption = 'Open...' + Hint = 'Open' + ImageIndex = 6 + ShortCut = 16463 + OnExecute = FileOpen1Execute + end + object InvokeHelp1: TAction + Caption = 'Find in Win32 API help' + Hint = 'Win32API help' + ImageIndex = 5 + ShortCut = 112 + OnExecute = InvokeHelp1Execute + OnUpdate = InvokeHelp1Update + end + object Copy1: TAction + Caption = 'Copy to clipboard' + Hint = 'Copy to clipboard' + ImageIndex = 2 + ShortCut = 16451 + OnExecute = Copy1Execute + OnUpdate = Copy1Update + end + object Save1: TAction + Caption = 'Save to file...' + Hint = 'Save to file' + ImageIndex = 2 + ShortCut = 16468 + OnExecute = Save1Execute + OnUpdate = Save1Update + end + object WindowCascade1: TWindowCascade + Category = 'Window' + Caption = 'Cascade' + Hint = 'Cascade' + ImageIndex = 7 + end + object WindowTileHorizontal1: TWindowTileHorizontal + Category = 'Window' + Caption = 'Tile Horizontally' + Hint = 'Tile Horizontally' + ImageIndex = 8 + end + object WindowTileVertical1: TWindowTileVertical + Category = 'Window' + Caption = 'Tile Vertically' + Hint = 'Tile Vertically' + ImageIndex = 9 + end + object About1: TAction + Caption = 'About...' + Hint = 'About' + OnExecute = About1Execute + end + object OpenLibrary1: TAction + Caption = 'Open library' + Hint = 'Open library' + ImageIndex = 4 + ShortCut = 16460 + OnExecute = OpenLibrary1Execute + OnUpdate = OpenLibrary1Update + end + object SelectAll1: TAction + Caption = 'Select all' + Hint = 'Select all' + ImageIndex = 14 + ShortCut = 16449 + OnExecute = SelectAll1Execute + OnUpdate = SelectAll1Update + end + object GroupImports1: TAction + Caption = 'Group imports' + Hint = 'Group imports' + ImageIndex = 13 + ShortCut = 16455 + OnExecute = GroupImports1Execute + OnUpdate = GroupImports1Update + end + object Search1: TAction + Caption = 'Search' + Hint = 'Search' + ImageIndex = 12 + OnExecute = Search1Execute + end + object ViewResources1: TAction + Caption = 'View resources' + Hint = 'View resources' + ImageIndex = 15 + ShortCut = 16466 + OnExecute = ViewResources1Execute + OnUpdate = ViewResources1Update + end + object ViewResDetails1: TAction + Caption = 'View details' + ImageIndex = 19 + ShortCut = 16452 + OnExecute = ViewResDetails1Execute + OnUpdate = ViewResDetails1Update + end + object ViewResHex1: TAction + Caption = 'View as hex' + Hint = 'View as hex' + ImageIndex = 20 + ShortCut = 16456 + OnExecute = ViewResHex1Execute + OnUpdate = ViewResHex1Update + end + object SendMail1: TAction + Caption = 'Support' + Hint = 'Support' + ImageIndex = 21 + OnExecute = SendMail1Execute + end + object ShowUnitGen1: TAction + Caption = 'Pascal unit generator' + Hint = 'Pascal unit generator' + ImageIndex = 22 + OnExecute = ShowUnitGen1Execute + OnUpdate = ShowUnitGen1Update + end + object UnmangleNames1: TAction + Caption = 'Unmangle names' + Hint = 'Unmangle names' + ImageIndex = 23 + ShortCut = 16469 + OnExecute = UnmangleNames1Execute + OnUpdate = UnmangleNames1Update + end + object Find1: TAction + Caption = 'Find text' + Hint = 'Find text' + ImageIndex = 24 + ShortCut = 16454 + OnExecute = Find1Execute + OnUpdate = Find1Update + end + end + object OpenFileDialog: TOpenDialog + Filter = + 'PE Exe files (*.exe;*.dll;*.bpl)|*.exe;*.dll;*.bpl|All files (*.' + + '*)|*.*' + Options = [ofHideReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 104 + Top = 304 + end + object ToolbarImagesList: TImageList + ShareImages = True + Left = 72 + Top = 304 + Bitmap = { + 494C010119001D00040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000008000000001002000000000000080 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF0000FFFF0000FFFF0000000000000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFF0000FFFF0000FFFF000000000000000000000000 + 00007F7F7F007F7F7F007F7F7F00000000000000003F7F7F7F0000FFFF3F7F7F + 7F000000000000000000000000BFFFFFFF000000000000000000FFFFFF000000 + 0000000000BFFFFFFF000000000000000000FFFF0000000000000000000000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF00000000000000FF000000FF000000 + FF00000000007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F + 7F007F7F7F0000000000FFFFFF00000000000000000000FFFF0000FFFF0000FF + FF000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF000000000000000000FFFF00000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF00000000000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000FFFFFF00000000000000003F7F7F7F0000FFFF3F7F7F + 7F000000000000000000000000BFFFFFFF000000000000000000000000000000 + 0000FFFFFFBFFFFFFF000000000000000000FFFF000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF000000000000000000FFFF00000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF000000000000000000FFFFFF000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF0000000000000000000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFFBFFFFFFF000000000000000000FFFF00000000000000FFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF0000000000FFFF0000FFFF0000FFFF + 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF000000 + 00000000000000000000FFFFFF00FFFFFF0000000000FFFFFF007F7F7F007F7F + 7F00FFFFFF007F7F7F007F7F7F00FFFFFF007F7F7F00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00000000BFBFBFBF00FFFFFF000000 + 0000FFFFFF0000000000000000000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF0000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000000000FF000000FF000000 + FF000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF007F7F7F007F7F + 7F00FFFFFF007F7F7F007F7F7F007F7F7F00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + 0000FFFF0000FFFF000000000000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF0000000000000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFF000000FF0000BFFF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF0000FFFF0000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF007F7F7F00000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FF0000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00000000000000000000000000000000000000 + 0000000000BFFFFFFF000000000000000000000000BFFFFFFF00000000BFFFFF + FF000000000000000000FFFFFF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000BFFFFFFF000000000000000000FFFFFF0000000000000000BFFFFF + FF000000000000000000FFFFFF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF0000FFFF0000FFFF00000000000000 + 00000000000000000000000000000000000000000000FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000808080008080800080808000000000000000 + 00000000000000000000000000000000000000000000BFBFBF00FFFFFF00BFBF + BF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBF + BF00FFFFFF000000FF00FFFFFF00000000000000000000000000000000000000 + 00000000000000000000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + 0000FFFFFF0000000000FFFFFF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00000000000000000000000000000000000000 + 0000FFFFFF0000FFFF000000000000000000FFFFFF0000000000FFFFFF000000 + 0000FFFFFFBFFFFFFF00FFFFFF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000BFFFFF + FF0000FFFF000000000000FFFFBFFFFFFF00000000BFFFFFFF0000FFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000000000FFFFFF0000FFFF00000000BFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00800000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000000000000000000000000000FFFFFF0000000000FFFF + FF0000000000000000000000000000000000000000000000000000FFFFBFFFFF + FF0000FFFFBFFFFFFF00000000BFFFFFFF0000FFFF0000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000BFFFFFFF00FFFFFFBFFFFF + FF00000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000000000000000FFFFFF000000000000000000000000000000 + 000000000000000000000000000000000000FFFF00000000000000FFFFBFFFFF + FF0000FFFFBFFFFFFF0000FFFF00000000000000000000000000FFFFFFBFFFFF + FF00000000BFFFFFFF00FFFFFF00000000000000000080000000800000008000 + 00008000000080000000FFFFFF00800000008000000080000000800000008000 + 0000FFFFFF008000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF000000000000000000000000000000000000000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF000000 + 000000000000000000000000000000000000FFFF00BFFFFF00000000000000FF + FF00FFFFFF0000FFFF000000000000FFFF00FFFFFF0000FFFF00000000BFFFFF + FF00000000BFFFFFFF0000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF00FFFFFF0000000000FFFFFF00000000000000 + 000000000000000000000000000000000000FFFF00BFFFFF0000FFFF00000000 + 000000FFFFBFFFFFFF0000FFFFBFFFFFFF000000000000000000FFFFFFBFFFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 000000000000000000000000000000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000080000000000000000000FF + FF00008080000000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000800000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000000000000000000000000080000000000000000000FF + FF0000808000000000000000008000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBF0000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF00BFBFBFBFBFBF + BF00BFBFBF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFFBFFFFF + FF00000000BFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000000000000000000000000080000000000000000000FF + FF0000808000000000000000000000000000BFBFBFBFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF000000008000000000000000BFBFBFBF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000BFBFBFBFBFBFBF0000000080000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000003F7F7F + 7F007F7F7F000000000000000000000000000000000000000000FFFFFFBFFFFF + FF00000000BFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000000000000000000000000080000000000000000000FF + FF00008080000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000080000000000000000000000000BFBFBF000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000800000 + 0000000000BFBFBFBF00BFBFBF000000000000000000FF000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F3F7F7F + 7F00000000000000000000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000BFFFFF + FF00FFFFFF000000000000000000000000000000008000000000000000000080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF000000 + 0000FFFFFF0000000000BFBFBF0000000000FF00000000000000FF0000BFFF00 + 0000000000000000000000000000000000000000003F7F7F7F007F7F7F000000 + 0000000000000000000000000000000000000000000000000000FFFFFFBFFFFF + FF00FFFFFF0000000000FFFFFFBFFFFFFF00FFFFFF0000000000FFFFFFBFFFFF + FF00FFFFFF000000000000000000000000000000008000000000000000000000 + 00007F7F7FBFBFBFBF0000000000000000000000000000000000000000000000 + 00007F7F7F00000000000000008000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFF + FF000000000000000000BFBFBF0000000000FF00000000000000000000000000 + 0000FF0000000000000000000000000000007F7F7F3F7F7F7F00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000000000000FFFFFFBFFFFF + FF00FFFFFF0000000000FFFFFFBFFFFFFF00FFFFFF0000000000FFFFFFBFFFFF + FF00FFFFFF0000000000000000000000000000000000000000007F7F7FBFBFBF + BF00BFBFBFBFBFBFBF00000000000000000000000000000000007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000000000000000FFFFFF000000 + 0000000000BFFFFFFF000000000000000000FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000BFBFBF0000000000FF0000BFFF000000000000000000 + 00000000000000000000000000BFFFFFFF007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F3F7F7F7F007F7F7F00000000000000000000000000FFFFFFBFFFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00000000000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF0000000000000000007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000BFBFBF000000000000000000FF000000FF0000BFFF00 + 0000FF0000BFFF00000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFF + FF00FFFFFF00000000000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00000000BFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000000000000000000000BFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFF + FF00FFFFFF00000000000000000000000000000000000000FF00BFBFBF000000 + FF00BFBFBFBFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F00000000000000008000000000000000000000FF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 000000000000000000000000FF0000000000000000000000000000000000FF00 + 0000000000BFFF0000000000000000000000000000BFFFFFFF00000000000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FFBFBFBF + BF00BFBFBFBFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F00000000000000008000000000000000000000FF00000000BFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF0000000000000000000000FF00000000000000000000000000FF0000000000 + 000000000000FF0000000000000000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + 000000000000000000000000000000000000000000000000FF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBF00000000007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F00000000800000000000000080000000000000000000000000000000BFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00000000BFFFFFFF0000000000000000000000000000000000FF0000000000 + 000000000000FF0000000000000000000000000000BFFFFFFF00000000BFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF00000000000000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFF + FF00FFFFFF00000000000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF00BFBFBF0000000000000000000000 + 0000000000800000000000000080000000000000000000000000000000BFFFFF + FF000000000000000000000000BFFFFFFF000000000000000000FFFFFFBFFFFF + FF00000000BFFFFFFF0000000080000000000000000000000000FF0000000000 + 000000000000000000000000000000000000000000BFFFFFFF00FFFFFFBFFFFF + FF000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000BFFFFF + FF0000000000000000000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF000000003F7F7F7F00000000800000 + 0000000000800000000000000080000000000000000000000000000000BFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF0000000000000000000000008000000000000000000000000000000000FF00 + 0000FF0000BFFF0000000000000000000000000000BFFFFFFF00000000BFFFFF + FF00000000BFFFFFFF00FFFFFF00000000000000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF000000003F7F7F7F000000008000000000000000800000 + 0000000000800000000000000080000000000000000000000000000000BFFFFF + FF00FFFFFFBFFFFFFF0000000000000000000000000000000000000000000000 + 0000000000800000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00000000BFFFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008000000000000000000000 + 00000000003F7F7F7F0000000080000000000000008000000000000000800000 + 0000000000800000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF000000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF0000000000000000000000000000000000000000 + 00000000003F7F7F7F0000000000000000000000003F7F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFF000000000000FFFF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFF0000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000000000FFFF0000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF3F7F7F + 7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF3F7F7F + 7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000000000FFFF0000FFFF0000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000000000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000003F7F7F7F000000FF000000 + FF000000FF000000FF000000FF000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF3F7F7F7F0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF00000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF00000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF00000000000000000000000000000000FF000000 + FF000000FF000000FF000000000000FF0000000000BFFF000000FF0000BFFF00 + 0000FF0000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000003F7F7F7F000000FF000000 + FF000000FF000000000000FF000000FF000000FF000000000000FF0000BFFF00 + 0000FF00003F7F7F7F0000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + FF000000000000FF000000FF000000FF000000FF000000FF0000000000BFFF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + 000000FF000000FF000000FF000000FF000000FF000000FF000000FF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + 00000000000000FF000000FF000000FF000000FF000000FF0000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000FFFF000000000000FFFF000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000FFFF0000000000000000000000000000000000000000 + 00000000003F7F7F7F0000000000000000000000003F7F7F7F00000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFF000000000000FFFF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFF0000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF000000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF0000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF0000FFFF0000FFFF0000000000000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFF0000FFFF0000FFFF000000000000000000000000 + 00007F7F7F007F7F7F007F7F7F00000000000000003F7F7F7F0000FFFF3F7F7F + 7F000000000000000000000000BFFFFFFF000000000000000000FFFFFF000000 + 0000000000BFFFFFFF000000000000000000FFFF0000000000000000000000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF00000000000000FF000000FF000000 + FF00000000007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F + 7F007F7F7F0000000000FFFFFF00000000000000000000FFFF0000FFFF0000FF + FF000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF000000000000000000FFFF00000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF00000000000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000FFFFFF00000000000000003F7F7F7F0000FFFF3F7F7F + 7F000000000000000000000000BFFFFFFF000000000000000000000000000000 + 0000FFFFFFBFFFFFFF000000000000000000FFFF000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF000000000000000000FFFF00000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF000000000000000000FFFFFF000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF0000000000000000000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFFBFFFFFFF000000000000000000FFFF00000000000000FFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF0000000000FFFF0000FFFF0000FFFF + 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF000000 + 00000000000000000000FFFFFF00FFFFFF0000000000FFFFFF007F7F7F007F7F + 7F00FFFFFF007F7F7F007F7F7F00FFFFFF007F7F7F00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00000000BFBFBFBF00FFFFFF000000 + 0000FFFFFF0000000000000000000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF0000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000000000FF000000FF000000 + FF000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF007F7F7F007F7F + 7F00FFFFFF007F7F7F007F7F7F007F7F7F00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + 0000FFFF0000FFFF000000000000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF0000000000000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFF000000FF0000BFFF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF0000FFFF0000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF007F7F7F00000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FF0000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF0000FFFF0000FFFF00000000000000 + 00000000000000000000000000000000000000000000FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000808080008080800080808000000000000000 + 00000000000000000000000000000000000000000000BFBFBF00FFFFFF00BFBF + BF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBF + BF00FFFFFF000000FF00FFFFFF00000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00800000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000000000000000000000000000FFFFFF0000000000FFFF + FF00000000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000FFFFFF008000000000000000000000000000000080000000800000008000 + 00008000000080000000FFFFFF00800000008000000080000000800000008000 + 0000FFFFFF008000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF000000000000000000000000000000000000000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF00FFFFFF0000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000080000000800000008000000080000000800000008000 + 0000800000008000000080000000800000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF007F7F7F000000FF007F7F7F00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000000000000000 + 000000000000FF000000FF000000FF000000FF000000FF000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF000000FF000000FF000000FF0000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FF000000FF000000FF000000FF00 + 0000FF000000FF000000BFBFBF0000000000BFBFBF00FF000000FF000000FF00 + 0000FF000000FF000000FF00000000000000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF007F7F7F000000FF007F7F7F00FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000008080000080 + 8000008080000080800000808000008080000080800000808000008080000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000BFBFBF00BFBF + BF00BFBFBF00BFBFBF00000000007F7F7F0000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000000000000000000000FFFF00000000000080 + 8000008080000080800000808000008080000080800000808000008080000080 + 8000000000000000000000000000000000000000000000000000000000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 00008000000080000000800000008000000000000000FFFFFF00000000007F7F + 7F007F7F7F0000000000FFFFFF007F7F7F00FFFFFF00000000007F7F7F007F7F + 7F0000000000FFFFFF00000000000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000FF0000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF00000000000000000000000000FFFFFF0000FFFF000000 + 0000008080000080800000808000008080000080800000808000008080000080 + 8000008080000000000000000000000000000000000000000000000000008000 + 0000FFFFFF00FFFFFF0080000000800000008000000080000000800000008000 + 00008000000080000000FFFFFF00800000007F7F7F0000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000007F7F7F0000000000FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF000000FF007F7F7F0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF00000000000000000000FFFF00FFFFFF0000FF + FF00000000000080800000808000008080000080800000808000008080000080 + 8000008080000080800000000000000000000000000000000000000000008000 + 0000FFFFFF00FFFFFF0080000000800000008000000080000000800000008000 + 0000800000008000000080000000800000007F7F7F0000000000FFFFFF000000 + 00000000000000000000FFFFFF007F7F7F00FFFFFF0000000000000000000000 + 0000FFFFFF00000000007F7F7F000000000000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000FF000000FF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00800000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000000000000000000000FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000FF000000FF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF00000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 000080000000000000000000000000000000000000007F7F7F0000000000FFFF + FF000000000000000000FFFFFF007F7F7F00FFFFFF000000000000000000FFFF + FF00000000007F7F7F00000000000000000000FFFF00FFFFFF0000FFFF00FFFF + FF007F7F7F007F7F7F0000FFFF00FFFFFF007F7F7F000000FF000000FF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000080000000FFFFFF008000 + 000080000000800000008000000080000000800000008000000080000000FFFF + FF0080000000000000000000000000000000000000007F7F7F0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000007F7F7F000000000000000000FFFFFF0000FFFF00FFFFFF0000FF + FF000000FF000000FF00FFFFFF0000FFFF007F7F7F000000FF000000FF0000FF + FF00FFFFFF0000FFFF00FFFFFF00000000000000000000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000FFFFFF008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 000080000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF000000000000000000000000000000000000000000FFFFFF0000FFFF00FFFF + FF000000FF000000FF007F7F7F00FFFFFF007F7F7F000000FF000000FF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00800000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF000000FF000000FF000000FF000000FF000000FF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF000000FF000000FF000000FF00FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 00008000000080000000800000008000000080000000FFFFFF00800000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + 00007F7F7F007F7F7F0000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000BFBFBF00BFBFBF0000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF00BFBFBF00BFBFBF0000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F007F7F + 7F0000000000000000007F7F7F00000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00BFBFBF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F007F7F7F0000FFFF00000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F0000FFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000BFBFBF0000000000FF000000FF000000FF00 + 00000000FF00FF000000FF0000000000000000000000FFFFFF00000000000000 + 0000FFFFFF00000000000000000000000000FFFFFF0000000000000000000000 + 00000000FF0000000000000000007F7F7F000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF00000000000000000000000000FF000000FF000000FF00 + 0000FF000000FF00000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF00000000000000000000000000FF000000FF00 + 0000FF0000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF000000000000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF00000000000000000000000000FF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF00000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 000000000000000000007F7F7F0000FFFF007F7F7F0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF000000000000000000000000000000FF000000FF000000 + FF00000000000000000000FFFF0000FFFF0000FFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F00FFFF000000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF00000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF000000000000000000000000000000FF000000FF000000 + FF0000000000000000007F7F7F0000FFFF007F7F7F0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F00FFFF0000FFFF00000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF0000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF00000000000000000000000000000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000800000000100010000000000000400000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000F000000000000000F000000000000000 + F000000000000000F000000000000000F000000000000000F000000000000000 + F000000000000000E000000000000000C0000000000000008000000000000000 + 8000000000000000000000000000000000000000000000000001000000000000 + 000300000000000000070000000000008003C3808007FFFF8003C3000003FFE7 + 8003C2010001FFC78003C00380108F8F8003C003000007008003C00300003200 + 80030003800000008003000380008000800300030000F900800300030000E100 + 800300030000C900800300070000C9008003000FC001C3008007003FC001E300 + 800F80FFC007FF01801FC3FFE3FFFF03FFFFFFFFFFFFBFFF00010001F83FBFFF + 000100011010B04900010001E00F807F1FF11FF1C007B07F1DF11FF18003B9FF + 1CF118318003BFFF1C7118318003B0491C3118318003807F1C7118318003B07F + 1CF11831C007B9FF1DF11FF1E00FBFFF1FF11FF13018048F00010001F83F07FF + 00010001FFFF07FF00010001FFFF9FFFFFFF8000FFE3FC01FFF88000FC418C01 + 20F8C00088000401007FE00000000401007CF00000000401003CF80000008C01 + 000FFC000000FC01000406000000FC01000C07000000040301FF018000000407 + E3FC01800000040FFFFC0060000007FFFFFFC06000010603FFF8C0600001FF07 + FFF8F044000DFF8FFFFFF07ED553FFDFFFFFFFFFFFFF800180038003C0070000 + 80038003BFEB00008003800300050000800380037E310000800380037E350000 + 8003800300060000800380037FEA0000800380038014E00780038003C00AE007 + 80038003E001E00780038003E007E00780038003F007E00F80038003F003E01F + FFFFFFFFF803E03FFFFFFFFFFFFFE07FFFFFFFFFFFFFFC00FFFFF83FFFFFFC00 + F83FE00F001FFC000001C007000FFC00000180030007E000000180030003E000 + 000100010001E000000100010000E00780030001001F800780030001001F8007 + 80030001001F8007C10780038FF1801FE38F8003FFF9801FFFFFC007FF75801F + FFFFE00FFF8F801FFFFFF83FFFFFFFFFC007FF00FC00FE7FC007FF00FC00FE1F + C007FF00FC00FC07C007FF00FC00FC01C00700000000F800C00700000000F800 + C007000000000000C007000000000000C007002300230001C007000100010032 + C00700000000003EC00700230023003EC00700630063003EC00700C300C3001D + C007010701070023C00703FF03FF003F00000000000000000000000000000000 + 000000000000} + end + object SaveDialog: TSaveDialog + DefaultExt = 'txt' + Filter = 'Text files (*.txt)|*.txt|All files (*.*)|*.*' + Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing] + Left = 136 + Top = 304 + end + object IconImageList: TImageList + ShareImages = True + Left = 168 + Top = 304 + Bitmap = { + 494C010111001300040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000005000000001002000000000000050 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF00000000000000003F7F7F7F000000003F7F7F7F00000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF3F7F7F7F000000003F7F7F7F000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF00000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF00000000000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000080000000000000008000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000800000000000000080000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000000000000000000000000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000000000000000000000000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF00000000000000003F7F7F7F000000003F7F7F7F00000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008000000000000000800000 + 00000000000000000000FFFFFFBFFFFFFF000000008000000000000000000000 + FF00000080000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000003F7F7F7F00000000000000 + 0000000000BFFFFFFF00FFFFFF00000000000000008000000000000000000000 + FF00000080000000FF0000000000008080000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008080808000C0C0C080C0C0 + C000C0C0C080C0C0C000C0C0C080C0C0C000C0C0C080C0C0C000C0C0C080C0C0 + C000C0C0C0000000000000000000000000007F7F7F0000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF0000000080000000000000008000000000000000000000 + FF00000080000000FF0000808000008080000000008080808000808080808080 + 8000808080808080800080808080808080008080808080808000808080808080 + 8000808080808080800080808000000000000000000000000000808080808080 + 8000808080808080800080808080808080008080808080808000808080808080 + 8000808080808080800000000000000000000000008080808000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00C0C0C000000000000000000000000000000000BFFFFFFF00000000000000 + 0000FFFFFFBFFFFFFF0000000080000000000000008000000000000000000000 + FF00000080000000FF0000808000008080000000008080808000FFFFFF0000FF + FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF + FF00C0C0C00000FFFF0080808000000000000000000000000000808080BFFFFF + FF0000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0 + C00000FFFF808080800000000000000000000000008080808000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00C0C0C0000000000000000000000000000000000000000000000000800000 + 0000000000BFFFFFFF0000000080000000000000008000000000000000000000 + FF00000080000000FF0000808080000000000000008080808000FFFFFF80C0C0 + C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0 + C00000FFFF80C0C0C00080808000000000000000008080808000FFFFFF0000FF + FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF + FF00C0C0C0000000000080808000000000000000008080808000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00C0C0C0000000000000000000000000000000003F7F7F7F00000000800000 + 0000000000BFFFFFFF00000000800000000000000080000000000000FF000000 + FF000000FF000000FF000000FF80000000000000008080808000FFFFFF0000FF + FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF + FF00C0C0C00000FFFF0080808000000000000000008080808000FFFFFF80C0C0 + C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0 + C000808080000000000080808000000000000000008080808000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF0000000080C0C0C000C0C0C00000000000FFFFFFBFFFFF + FF00C0C0C00000000000000000000000000000000080000000007F7F7F000000 + 0000FFFFFF00000000007F7F7F80000000000000000000000000000080000000 + 8000000080000000800000008080000000000000008080808000FFFFFF80C0C0 + C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0 + C00000FFFF80C0C0C0008080800000000000808080BFFFFFFF00C0C0C00000FF + FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF + FF00000000808080800080808000000000000000008080808000FFFFFFBFFFFF + FF00FFFFFF8080808000FFFFFF00000000008080808080808000000000BFFFFF + FF00C0C0C0000000000000000000000000000000008000000000000000000000 + 00000000003F7F7F7F0000000080000000000000000000808000008080000080 + 8000000000800000000000000080000000000000008080808000FFFFFF0000FF + FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF + FF00C0C0C00000FFFF008080800000000000808080BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF808080 + 800000000080C0C0C00080808000000000000000008080808000FFFFFFBFFFFF + FF0000000080C0C0C000000000BFFFFFFF008080800000000000FFFFFFBFFFFF + FF00C0C0C0000000000000000000000000000000008000000000000000800000 + 0000000000800000000000000000000000000080800000808000008080800000 + 0000000000800000000000000080000000000000008080808000FFFFFF80C0C0 + C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0 + C00000FFFF80C0C0C00080808000000000008080808080808000808080808080 + 8000808080808080800080808080808080008080808080808000808080808080 + 80008080800000FFFF0080808000000000000000008080808000FFFFFF000000 + 000000FFFF00000000008080808080808000000000BFFFFFFF00FFFFFFBFFFFF + FF00C0C0C0000000000000000000000000000000008000000000000000000000 + 0000000000800000000000000000008080000080800000808000000000800000 + 0000000000800000000000000080000000000000008080808000FFFFFF0000FF + FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C00000FF + FF00C0C0C00000FFFF0080808000000000000000008080808000FFFFFF80C0C0 + C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0C00000FFFF80C0C0 + C00000FFFF80C0C0C00080808000000000000000008080808000FFFFFFBFFFFF + FF000000000000FFFF000000000000000000FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00C0C0C0000000000000000000000000000000000000000000000000000000 + 0000000000000000000000808000008080000080808000000000000000800000 + 0000000000800000000000000080000000000000008080808000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF0080808000000000000000008080808000FFFFFF0000FF + FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C0BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF0080808000000000000000008080808000FFFFFFBFFFFF + FF000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00C0C0C0000000000000000000000000000000008000000000000000000000 + 0000000000000080800000808000008080000000008000000000000000800000 + 0000000000800000000000000080000000000000008080808000C0C0C00000FF + FF00C0C0C00000FFFF00C0C0C00000FFFF00C0C0C08080808000808080808080 + 8000808080808080800080808000000000000000008080808000FFFFFF80C0C0 + C00000FFFF80C0C0C00000FFFF80C0C0C000FFFFFF8080808000808080808080 + 8000808080808080800080808000000000000000008080808000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000008080800000000000000080000000000000003F7F7F + 7F000000003F7F7F7F000000008000000000000000000000000080808080C0C0 + C00000FFFF80C0C0C00000FFFF80C0C0C0008080800000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080BFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF008080800000000000000000000000 + 0000000000000000000000000000000000000000008080808000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00C0C0C0BFFFFF + FF00808080000000000000000000000000000000008000000000000000000000 + 00000000000000000000000000800000000000000080000000000000003F7F7F + 7F000000003F7F7F7F0000000080000000000000000000000000000000808080 + 8000808080808080800080808080808080000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000808080 + 8000808080808080800080808080808080000000000000000000000000000000 + 0000000000000000000000000000000000000000008080808000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00C0C0C0808080 + 8000000000000000000000000000000000000000008000000000008080000000 + 000000000000000000000000003F7F7F7F0000000080000000000000003F7F7F + 7F000000003F7F7F7F0000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008080808000808080808080 + 8000808080808080800080808080808080008080808080808000808080000000 + 0000000000000000000000000000000000000000008000000000008080000080 + 8000000000000000000000000000000000000000000000000000000000800000 + 0000000000800000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF007F0000007F0000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + 00000000000000000000000000BFFFFFFF007F7F7F007F0000007F0000007F00 + 00007F7F7F000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BFBFBF00BFBFBF007F7F7F007F7F7F007F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + FF000000FF000000FF00000000BFFFFFFF00000000007F0000007F0000007F00 + 00007F0000007F0000007F7F7F00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000BFBF + BF00BFBFBF007F7F7F000000000000000000000000007F7F7F007F7F7F007F7F + 7F00000000000000000000000000000000000000000000000000000000BFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + FF000000FF000000FF00000000BFFFFFFF0000000000000000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F7F7F0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF0000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000007F7F + 7F007F7F7F000000000000000000000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + FF000000FF000000FF00000000BFFFFFFF0000000000000000007F7F7F007F00 + 00007F0000007F0000007F0000007F0000007F0000007F0000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 00007F7F7F000000000000000000000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + 00000000000000000000000000BFFFFFFF000000000000000000000000007F00 + 00007F0000007F0000007F0000007F0000007F0000007F0000007F0000007F00 + 00007F7F7F000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF00000000000000 + 00000000000000000000000000000000000000000000BFBFBF007F7F7F00FFFF + FF00000000000000000000FFFF00007F7F00007F7F000000000000000000FFFF + FF007F7F7F007F7F7F0000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF000000000000000000000000000000 + 00007F0000007F0000007F0000007F0000007F0000007F0000007F0000007F00 + 00007F0000007F0000007F7F7F00000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF000000FF000000 + FF000000000000000000000000000000000000000000BFBFBF000000000000FF + FF000000000000FFFF00007F7F0000FFFF00007F7F00007F7F000000000000FF + FF00000000007F7F7F0000000000000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00000000BFFFFFFF00FFFFFFBFFFFFFF000000FF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF00000000000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF00000000000000000000000000FFFFFF0000000000FFFF + FF000000000000FFFF0000FFFF0000FFFF0000FFFF00007F7F0000000000FFFF + FF00000000007F7F7F0000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFFBFFFFFFF00FFFFFF000000 + 00000000000000000000FFFFFFBFFFFFFF000000000000000000000000000000 + 0000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF00 + 0000FF000000FF00000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF000000FF000000 + FF000000000000000000000000000000000000000000FFFFFF000000000000FF + FF0000000000FFFFFF0000FFFF0000FFFF00007F7F0000FFFF000000000000FF + FF0000000000BFBFBF0000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF00000000000000 + 00000000000000000000000000BFFFFFFF00000000000000000000000000FF00 + 0000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF00000000000000 + 00000000000000000000000000000000000000000000FFFFFF007F7F7F00FFFF + FF000000000000000000FFFFFF00FFFFFF0000FFFF000000000000000000FFFF + FF007F7F7F00BFBFBF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FF00 + 0000FF000000FF000000FF000000FF000000FF000000FF000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000BFBFBF000000000000000000000000000000000000000000FFFF00BFFFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFFBFFFFFFF000000000000000000FF000000FF00 + 0000FF000000FF000000FF000000FF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00BFBF + BF0000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000000000BFBF + BF00BFBFBF000000000000000000000000000000000000000000FFFF00BFFFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFFBFFFFFFF0000000000FF000000FF000000FF00 + 0000FF000000FF00000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00BFBFBF007F7F7F000000000000000000000000007F7F7F00BFBFBF00BFBF + BF00000000000000000000000000000000000000000000000000FFFF00BFFFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFFBFFFFFFF0000000000FF000000FF000000FF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00BFBFBF00BFBFBF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFFBFFFFFFF00FF000000FF000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FF000000FF000000FF000000FF000000FF000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FF000000FF000000FF000000FF00 + 0000FF000000FF000000BFBFBF0000000000BFBFBF00FF000000FF000000FF00 + 0000FF000000FF000000FF000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + 0000000000000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF00BFBFBF00BFBFBF00000000007F7F7F0000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000080808000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000000000000000000000000000000000000000000000000000FFFF + 00000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000007F7F + 7F007F7F7F0000000000FFFFFF007F7F7F00FFFFFF00000000007F7F7F007F7F + 7F0000000000FFFFFF0000000000000000000000000000000000000000000000 + 000000000000000000008080800080808000FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000808080008080800000000000000000000000000000000000FFFFFF00FFFF + FF0000000000000000000000000000000000000000000000000000000000FFFF + 000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF + FF00000000000000000000000000000000007F7F7F0000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000007F7F7F00000000000000000000000000000000000000 + 00000000000000000000808080000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000FFFFFF000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + 00000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000007F7F7F0000000000FFFFFF000000 + 00000000000000000000FFFFFF007F7F7F00FFFFFF0000000000000000000000 + 0000FFFFFF00000000007F7F7F00000000000000000000000000000000000000 + 00000000000080808000808080000000000000000000FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000080808000808080000000000000000000FFFFFF00FFFFFF000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + 000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000808080000000000000000000FFFFFF00000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + 00000000000000FFFF00FFFFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F7F7F0000000000FFFF + FF000000000000000000FFFFFF007F7F7F00FFFFFF000000000000000000FFFF + FF00000000007F7F7F0000000000000000000000000000000000000000000000 + 0000808080008080800000000000000000000000000000000000FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000008080800080808000FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF00FFFFFF0000FFFF0000000000000000000000 + 000000000000000000000000000000000000000000007F7F7F0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000007F7F7F0000000000000000000000000000000000000000000000 + 0000808080008080800080808000808080008080800080808000808080008080 + 8000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000080808000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000FFFF000000 + 00007F7F7F007F7F7F000000000000000000000000000000000000000000007F + 7F00007F7F00007F7F00007F7F00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + 000000000000000000000000000000000000000000000000000000FFFF000000 + 00007F7F7F0000000000BFBFBF00BFBFBF00BFBFBF00BFBFBF0000000000007F + 7F0000FFFF00007F7F0000FFFF00000000000000000000000000000000000000 + 000000000000FFFFFF0000000000FFFFFF000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF0000000000000000000000000000000000000000000000000000FFFF000000 + 00007F7F7F007F7F7F00000000000000000000000000000000000000000000FF + FF00007F7F0000FFFF00007F7F0000000000000000000000000000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF00000000000000000000000000000000000000000000FFFF000000 + 00007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F000000000000FF + FF0000FFFF00007F7F0000FFFF000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF000000000000000000FFFFFF000000 + 00000000000000000000FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF000000000000000000000000000000000000FFFF000000 + 00007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F000000000000FF + FF0000FFFF0000FFFF00007F7F000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF000000FF0000000000000000000000000000FFFF000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF0000FFFF0000FFFF0000FFFF000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFFFF00000000000000000000000000000000000000 + FF00000000000000000000000000FFFFFF0000000000BFBFBF00000000000000 + 0000FFFFFF0000000000FFFFFF000000000000000000FFFFFF00000000000000 + 0000FFFFFF00000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF000000000000000000000000000000000000FFFF000000 + 000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000000000FF + FF0000FFFF0000FFFF0000FFFF000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + FF000000FF000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF00000000000000000000000000000000000000000000FFFF000000 + 000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000000000FF + FF0000FFFF0000FFFF0000FFFF000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000FF000000FF000000 + FF000000FF000000FF0000000000FFFFFF000000000000000000FFFFFF000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000FF000000 + FF0000000000000000000000000000000000000000000000000000FFFF000000 + 000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000000000FF + FF0000FFFF0000FFFF0000FFFF000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000000000000000000000000000000000000000FF000000FF000000 + FF000000FF000000FF000000FF0000000000FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF00FFFFFF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000FF000000 + 000000000000000000000000000000000000000000000000000000FFFF000000 + 00007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F000000000000FF + FF0000FFFF0000FFFF0000FFFF000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF000000000000000000FFFFFF00FFFF + FF0000000000FFFFFF000000000000000000000000000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF0000000000BFBFBF00FFFFFF000000 + 0000FFFFFF0000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000FFFF000000 + 000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000000000FF + FF0000FFFF0000FFFF0000FFFF000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000000000000000000000000000000000000000FF000000FF000000 + FF000000FF000000FF000000FF0000000000FFFFFF00FFFFFF00FFFFFF000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000007F + 7F0000FFFF0000FFFF0000FFFF000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FF000000FF000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF00007F7F0000FFFF0000FFFF000000000000000000FFFFFF0000000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000007F + 7F0000FFFF00007F7F0000FFFF000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000500000000100010000000000800200000000000000000000 + 000000000000000000000000FFFFFF00FFFF000000000000FFFF000000000000 + C631000000000000E223000000000000F007000000000000F88F000000000000 + FC1F000000000000FE3F000000000000FC1F000000000000F80F000000000000 + F007000000000000E223000000000000C631000000000000FFFF000000000000 + FFFF000000000000FFFF000000000000F862FFFFFFFF800380E0C000E0008003 + 01E08000C000800301E08000C000800331E180008000800331C1800080008003 + C181800000008003C307800000008003FE17800000009003CC37800080008203 + A877800080008C0340F780018001800301E3C07FC07F8007C1E3E0FFE0FF800F + C0E3FFFFFFFF801FC83FFFFFFFFFFFFFFFFFFFFFFFFF80001FFFFFFFF83F8000 + 07FFFFFFE00FC00081FFFFFFC007E000C07FFCFF8003F000C01FFC3F8003F800 + E007FC0F0001FC00F00100030001FE00000000000001FF00F00300030001FF80 + E00FFC0F00018380E03FFC3F800383E0C0FFFCFF800383E083FFFFFFC00783E0 + 8FFFFFFFE00F83843FFFFFFFF83FFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + 1FFFF83FFFFFFFFF041F0001FFFFFFFF000F0001FE7FF00F000F0001FC3FF3CF + 00070001FDBFFBDF00010001F99FF99F00008003FBDFFDBF00018003F3CFFC3F + 003F8003F00FFE7FFC7FC107FFFFFFFFFFFFE38FFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8FC0FC00FFFFFFDF8000F000FC00FFCF + 8000C000FC00FFC700000000FC00000380000000FC00000180000000EC000000 + 80000000E40000018A800000E00000038A800000000000078A8000000001000F + 800000010003001F8A8000030007007F8FC00007000F00FFFFC0001FE3FF01FF + FFC0007FE7FF03FFFFC001FFEFFFFFFF00000000000000000000000000000000 + 000000000000} + end +end diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeViewerMain.pas b/official/1.96/examples/windows/delphitools/peviewer/PeViewerMain.pas new file mode 100644 index 0000000..bfb44ce --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeViewerMain.pas @@ -0,0 +1,641 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 PeViewerMain.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/11/22 10:24:00 $ } +{ } +{**************************************************************************************************} + +unit PeViewerMain; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + Menus, ActnList, ToolWin, ComCtrls, StdActns, ImgList, ShellAPI, JclPeImage; + +const + UM_CHECKPARAMSTR = WM_USER + $100; + +type + TMainForm = class(TForm) + MainMenu1: TMainMenu; + ActionList: TActionList; + File1: TMenuItem; + StatusBar1: TStatusBar; + FileOpen1: TAction; + Edit1: TMenuItem; + Window1: TMenuItem; + Exit1: TAction; + Exit2: TMenuItem; + InvokeHelp1: TAction; + Copy1: TAction; + Save1: TAction; + Copytoclipboard1: TMenuItem; + OpenFileDialog: TOpenDialog; + WindowCascade1: TWindowCascade; + WindowTileHorizontal1: TWindowTileHorizontal; + WindowTileVertical1: TWindowTileVertical; + Cascade1: TMenuItem; + TileHorizontally1: TMenuItem; + TileVertically1: TMenuItem; + ToolbarImagesList: TImageList; + Savetofile1: TMenuItem; + Open1: TMenuItem; + Help1: TMenuItem; + About1: TAction; + About2: TMenuItem; + CoolBar1: TCoolBar; + ToolBar1: TToolBar; + ToolButton1: TToolButton; + ToolButton3: TToolButton; + ToolButton4: TToolButton; + ToolButton5: TToolButton; + ToolButton11: TToolButton; + N3: TMenuItem; + SaveDialog: TSaveDialog; + OpenLibrary1: TAction; + ToolButton2: TToolButton; + SelectAll1: TAction; + Selectall2: TMenuItem; + IconImageList: TImageList; + GroupImports1: TAction; + View1: TMenuItem; + Openlibrary2: TMenuItem; + FindinWin32APIhelp1: TMenuItem; + N1: TMenuItem; + Search1: TAction; + ToolButton6: TToolButton; + N2: TMenuItem; + Search2: TMenuItem; + ToolButton7: TToolButton; + ToolButton8: TToolButton; + Groupimports2: TMenuItem; + ToolButton9: TToolButton; + ToolButton10: TToolButton; + ToolButton12: TToolButton; + ToolButton13: TToolButton; + ViewResources1: TAction; + Viewresources2: TMenuItem; + ToolButton14: TToolButton; + ToolButton15: TToolButton; + ViewResDetails1: TAction; + ViewResHex1: TAction; + ToolButton16: TToolButton; + ToolButton17: TToolButton; + Viewdetails1: TMenuItem; + Viewashex1: TMenuItem; + SendMail1: TAction; + Support1: TMenuItem; + ShowUnitGen1: TAction; + ToolButton18: TToolButton; + Pascalunitgenerator1: TMenuItem; + UnmangleNames1: TAction; + ToolButton19: TToolButton; + Unmanglenames2: TMenuItem; + Find1: TAction; + ToolButton20: TToolButton; + N4: TMenuItem; + Findtext1: TMenuItem; + procedure Exit1Execute(Sender: TObject); + procedure InvokeHelp1Update(Sender: TObject); + procedure FileOpen1Execute(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure InvokeHelp1Execute(Sender: TObject); + procedure Save1Execute(Sender: TObject); + procedure OpenLibrary1Execute(Sender: TObject); + procedure Copy1Update(Sender: TObject); + procedure OpenLibrary1Update(Sender: TObject); + procedure Copy1Execute(Sender: TObject); + procedure SelectAll1Execute(Sender: TObject); + procedure GroupImports1Update(Sender: TObject); + procedure GroupImports1Execute(Sender: TObject); + procedure Search1Execute(Sender: TObject); + procedure ViewResources1Update(Sender: TObject); + procedure ViewResources1Execute(Sender: TObject); + procedure ViewResDetails1Update(Sender: TObject); + procedure ViewResDetails1Execute(Sender: TObject); + procedure ViewResHex1Update(Sender: TObject); + procedure ViewResHex1Execute(Sender: TObject); + procedure Save1Update(Sender: TObject); + procedure About1Execute(Sender: TObject); + procedure SendMail1Execute(Sender: TObject); + procedure ShowUnitGen1Update(Sender: TObject); + procedure ShowUnitGen1Execute(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure UnmangleNames1Update(Sender: TObject); + procedure UnmangleNames1Execute(Sender: TObject); + procedure SelectAll1Update(Sender: TObject); + procedure Find1Update(Sender: TObject); + procedure Find1Execute(Sender: TObject); + procedure CoolBar1Resize(Sender: TObject); + private + FWin32Help: string; + function ActiveListViewToStrings: TStrings; + function IsWin32Help: Boolean; + function IsPeDumpChildActive: Boolean; + function IsPeResChildActive: Boolean; + function IsSearchChildActive: Boolean; + function IsGenDefChildActive: Boolean; + procedure OnActiveFormChange(Sender: TObject); + procedure UMCheckParamStr(var Message: TMessage); message UM_CHECKPARAMSTR; + procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES; + public + function FindPeResourceView(APeImage: TJclPeImage): TForm; + procedure InvokeWin32Help(const Name: string); + procedure OpenFile(const FileName: TFileName; CheckIfOpen: Boolean); + end; + +var + MainForm: TMainForm; + +const + icoHeader = 0; + icoDirectory = 1; + icoImports = 2; + icoExports = 3; + icoResources = 4; + icoSection = 5; + icoSortAsc = 6; + icoSortDesc = 7; + icoDelayImport = 8; + icoBoundImport = 9; + icoLoadConfig = 10; + icoRelocation = 11; + icoDebug = 12; + icoFolderShut = 13; + icoFolderOpen = 14; + icoResItem = 15; + icoWarning = 16; + +implementation + +uses ActiveX, ClipBrd, ToolsUtils, JclFileUtils, JclSysUtils, + About, PeDump, PeSearch, PeResView, PeGenDef, FindDlg; + +{$R *.DFM} + +{ TMainForm } + +procedure TMainForm.Exit1Execute(Sender: TObject); +begin + Close; +end; + +function TMainForm.IsPeDumpChildActive: Boolean; +begin + Result := ActiveMDIChild is TPeDumpChild; +end; + +procedure TMainForm.InvokeHelp1Update(Sender: TObject); +begin + TAction(Sender).Enabled := IsWin32Help and IsPeDumpChildActive and + (TPeDumpChild(ActiveMDIChild).ActiveWin32Function <> ''); +end; + +procedure TMainForm.FileOpen1Execute(Sender: TObject); +var + I: Integer; +begin + with OpenFileDialog do + begin + FileName := ''; + if Execute then + for I := 0 to Files.Count - 1 do OpenFile(Files[I], False); + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + FWin32Help := Win32HelpFileName; + Screen.OnActiveFormChange := OnActiveFormChange; + DragAcceptFiles(Handle, True); +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + Screen.OnActiveFormChange := nil; + WinHelp(Application.Handle, PChar(FWin32Help), HELP_QUIT, 0); + DragAcceptFiles(Handle, False); +end; + +procedure TMainForm.OnActiveFormChange(Sender: TObject); +begin + if IsPeDumpChildActive then + begin +// GroupImports1.Checked := TPeDumpChild(ActiveMDIChild).GroupImports; + StatusBar1.Panels[0].Text := TPeDumpChild(ActiveMDIChild).FileName; + end else + if IsPeResChildActive then + begin + StatusBar1.Panels[0].Text := TPeResViewChild(ActiveMDIChild).PeImage.FileName; + end else + if IsGenDefChildActive then + begin + StatusBar1.Panels[0].Text := TPeGenDefChild(ActiveMDIChild).FileName; + end else + StatusBar1.Panels[0].Text := ''; +end; + +procedure TMainForm.OpenFile(const FileName: TFileName; CheckIfOpen: Boolean); +var + EI: TJclPeImage; + I: Integer; +begin + if CheckIfOpen then + begin + for I := 0 to MDIChildCount - 1 do + if MDIChildren[I] is TPeDumpChild and (TPeDumpChild(MDIChildren[I]).FileName = FileName) then + begin + MDIChildren[I].BringToFront; + Exit; + end; + end; + Screen.Cursor := crHourGlass; + EI := TJclPeImage.Create; + try + try + EI.FileName := FileName; + TPeDumpChild.CreateEx(Self, EI); + except + EI.Free; + raise; + end; + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.InvokeHelp1Execute(Sender: TObject); +begin + InvokeWin32Help(TPeDumpChild(ActiveMDIChild).ActiveWin32Function); +end; + +procedure TMainForm.Save1Execute(Sender: TObject); +var + SL: TStrings; +begin + if IsPeResChildActive and TPeResViewChild(ActiveMDIChild).CanSaveResource then + TPeResViewChild(ActiveMDIChild).SaveResource + else + if IsGenDefChildActive then + TPeGenDefChild(ActiveMDIChild).SaveUnit + else + with SaveDialog do + begin + if IsPeDumpChildActive then + FileName := ChangeFileExt(TPeDumpChild(ActiveMDIChild).FileName, '.txt') + else + FileName := ''; + if Execute then + begin + SL := ActiveListViewToStrings; + try + SL.SaveToFile(FileName); + finally + SL.Free; + end; + end; + end; +end; + +function TMainForm.IsWin32Help: Boolean; +begin + Result := FWin32Help <> ''; +end; + +procedure TMainForm.InvokeWin32Help(const Name: string); +var + S: string; +begin + S := PeStripFunctionAW(Name); + WinHelp(Application.Handle, PChar(FWin32Help), HELP_KEY, DWORD(S)); +end; + +procedure TMainForm.OpenLibrary1Execute(Sender: TObject); +begin + if IsPeDumpChildActive then + OpenFile(TPeDumpChild(ActiveMDIChild).ActiveLibName, False) + else + OpenFile(TPeSearchChild(ActiveMDIChild).ActiveLibName, False); +end; + +procedure TMainForm.Copy1Update(Sender: TObject); +begin + TAction(Sender).Enabled := (Screen.ActiveControl is TListView) or + ((Screen.ActiveControl is TRichEdit) and ((Screen.ActiveControl as TRichEdit).SelLength > 0)); +end; + +procedure TMainForm.OpenLibrary1Update(Sender: TObject); +begin + OpenLibrary1.Enabled := + (IsPeDumpChildActive and (TPeDumpChild(ActiveMDIChild).ActiveLibName <> '')) or + (IsSearchChildActive and (TPeSearchChild(ActiveMDIChild).ActiveLibName <> '')); +end; + +function TMainForm.ActiveListViewToStrings: TStrings; +begin + Screen.Cursor := crHourGlass; + try + Result := TStringList.Create; + try + Result.Capacity := 256; + ListViewToStrings(Screen.ActiveControl as TListView, Result, True); + except + FreeAndNil(Result); + raise; + end; + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.Copy1Execute(Sender: TObject); +var + SL: TStrings; +begin + if Screen.ActiveControl is TRichEdit then + (Screen.ActiveControl as TRichEdit).CopyToClipboard + else + if Screen.ActiveControl is TListView then + begin + SL := ActiveListViewToStrings; + try + Clipboard.AsText := SL.Text; + finally + SL.Free; + end; + end; +end; + +procedure TMainForm.SelectAll1Execute(Sender: TObject); +begin + if Screen.ActiveControl is TRichEdit then + TRichEdit(Screen.ActiveControl).SelectAll + else + if Screen.ActiveControl is TListView then + ListViewSelectAll(TListView(Screen.ActiveControl)); +end; + +procedure TMainForm.GroupImports1Update(Sender: TObject); +begin + with TAction(Sender) do + begin + Enabled := IsPeDumpChildActive; + if Enabled then + Checked := TPeDumpChild(ActiveMDIChild).GroupImports + else + Checked := False; + end; +end; + +procedure TMainForm.GroupImports1Execute(Sender: TObject); +begin + with TPeDumpChild(ActiveMDIChild) do + begin + GroupImports := not GroupImports; + GroupImports1.Checked := GroupImports; + end; +end; + +procedure TMainForm.Search1Execute(Sender: TObject); +begin + TPeSearchChild.Create(Self); +end; + +function TMainForm.IsSearchChildActive: Boolean; +begin + Result := ActiveMDIChild is TPeSearchChild; +end; + +procedure TMainForm.ViewResources1Update(Sender: TObject); +begin + TAction(Sender).Enabled := IsPeDumpChildActive and + TPeDumpChild(ActiveMDIChild).HasDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE]; +end; + +procedure TMainForm.ViewResources1Execute(Sender: TObject); +var + F: TForm; +begin + with ActiveMDIChild as TPeDumpChild do + begin + F := FindPeResourceView(PeImage); + if F = nil then + TPeResViewChild.CreateEx(Self, PeImage) + else + F.BringToFront; + end; +end; + +function TMainForm.FindPeResourceView(APeImage: TJclPeImage): TForm; +var + I: Integer; +begin + Result := nil; + for I := 0 to MDIChildCount - 1 do + if (MDIChildren[I] is TPeResViewChild) and (TPeResViewChild(MDIChildren[I]).PeImage = APeImage) then + begin + Result := MDIChildren[I]; + Break; + end; +end; + +function TMainForm.IsPeResChildActive: Boolean; +begin + Result := ActiveMDIChild is TPeResViewChild; +end; + +procedure TMainForm.ViewResDetails1Update(Sender: TObject); +begin + with TAction(Sender) do + begin + Enabled := IsPeResChildActive; + if Enabled then + Checked := TPeResViewChild(ActiveMDIChild).ShowSpecialDirView + else + Checked := False; + end; +end; + +procedure TMainForm.ViewResDetails1Execute(Sender: TObject); +begin + with ViewResDetails1 do + begin + Checked := not Checked; + TPeResViewChild(ActiveMDIChild).ShowSpecialDirView := Checked; + end; +end; + +procedure TMainForm.ViewResHex1Update(Sender: TObject); +begin + with TAction(Sender) do + begin + Enabled := IsPeResChildActive; + if Enabled then + Checked := TPeResViewChild(ActiveMDIChild).ShowAsHexView + else + Checked := False; + end; +end; + +procedure TMainForm.ViewResHex1Execute(Sender: TObject); +begin + with ViewResHex1 do + begin + Checked := not Checked; + TPeResViewChild(ActiveMDIChild).ShowAsHexView := Checked; + end; +end; + +procedure TMainForm.Save1Update(Sender: TObject); +begin + TAction(Sender).Enabled := (Screen.ActiveControl is TListView) or + (IsPeResChildActive and TPeResViewChild(ActiveMDIChild).CanSaveResource) or + (IsGenDefChildActive and TPeGenDefChild(ActiveMDIChild).CanSave); +end; + +procedure TMainForm.About1Execute(Sender: TObject); +begin + ShowToolsAboutBox; +end; + +procedure TMainForm.SendMail1Execute(Sender: TObject); +begin + SendEmail; +end; + +procedure TMainForm.ShowUnitGen1Update(Sender: TObject); +begin + TAction(Sender).Enabled := IsPeDumpChildActive and + TPeDumpChild(ActiveMDIChild).HasDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT]; +end; + +procedure TMainForm.ShowUnitGen1Execute(Sender: TObject); +var + CurrFileName: TFileName; +begin + CurrFileName := (ActiveMDIChild as TPeDumpChild).FileName; + with TPeGenDefChild.Create(Self) do + FileName := CurrFileName; +end; + +function TMainForm.IsGenDefChildActive: Boolean; +begin + Result := ActiveMDIChild is TPeGenDefChild; +end; + +procedure TMainForm.FormShow(Sender: TObject); +begin + PostMessage(Handle, UM_CHECKPARAMSTR, 0, 0); +end; + +procedure TMainForm.UMCheckParamStr(var Message: TMessage); +var + I: Integer; + FileName: TFileName; +begin + for I := 1 to ParamCount do + begin + FileName := PathGetLongName(ParamStr(I)); + if (FileName <> '') and not (FileName[1] in ['-', '/']) then + OpenFile(FileName, False); + end; +end; + +procedure TMainForm.WMDropFiles(var Message: TWMDropFiles); +var + FilesCount, I: Integer; + FileName: array[0..MAX_PATH] of Char; +begin + FilesCount := DragQueryFile(Message.Drop, MAXDWORD, nil, 0); + for I := 0 to FilesCount - 1 do + begin + if (DragQueryFile(Message.Drop, I, @FileName, SizeOf(FileName)) > 0) and + IsValidPeFile(FileName) then + OpenFile(FileName, True); + end; + DragFinish(Message.Drop); + Message.Result := 0; + Application.BringToFront; +end; + +procedure TMainForm.UnmangleNames1Update(Sender: TObject); +begin + with TAction(Sender) do + begin + Enabled := IsPeDumpChildActive; + if Enabled then + Checked := TPeDumpChild(ActiveMDIChild).UnmangleNames + else + Checked := False; + end; +end; + +procedure TMainForm.UnmangleNames1Execute(Sender: TObject); +begin + with TPeDumpChild(ActiveMDIChild) do + begin + UnmangleNames := not UnmangleNames; + UnmangleNames1.Checked := UnmangleNames; + end; +end; + +procedure TMainForm.SelectAll1Update(Sender: TObject); +begin + TAction(Sender).Enabled := (Screen.ActiveControl is TListView) or + (Screen.ActiveControl is TRichEdit); +end; + +procedure TMainForm.Find1Update(Sender: TObject); +begin + TAction(Sender).Enabled := TFindTextForm.CanExecuteFind; +end; + +procedure TMainForm.Find1Execute(Sender: TObject); +begin + ShowFindDialog(Screen.ActiveControl as TListView); +end; + +procedure TMainForm.CoolBar1Resize(Sender: TObject); +begin + D4FixCoolBarResizePaint(Sender); +end; + +initialization + OleInitialize(nil); + +finalization + OleUninitialize; + +// History: + +// $Log: PeViewerMain.pas,v $ +// Revision 1.3 2005/11/22 10:24:00 ahuser +// FileDrop support +// +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/peviewer/PeViewer_TLB.pas b/official/1.96/examples/windows/delphitools/peviewer/PeViewer_TLB.pas new file mode 100644 index 0000000..8b012e0 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/peviewer/PeViewer_TLB.pas @@ -0,0 +1,117 @@ +unit PeViewer_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: 1.1 $ +// File generated on 4.6.2000 18:23:08 from Type Library described below. + +// ************************************************************************ // +// Type Lib: C:\Program Files\Borland\Delphi5\Projects\Tools\PeViewer\PeViewer.tlb (1) +// IID\LCID: {7DD35085-3A37-11D4-B06E-C61ABD372324}\0 +// Helpfile: +// DepndLst: +// (1) v2.0 stdole, (C:\WINDOWS\SYSTEM\StdOle2.Tlb) +// ************************************************************************ // + +{$I jcl.inc} + +{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. + +interface + +uses + Windows, ActiveX, Classes, Graphics, + {$IFDEF DELPHI5_UP} + OleServer, + {$ENDIF DELPHI5_UP} + OleCtrls, StdVCL; + +// *********************************************************************// +// 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 + PeViewerMajorVersion = 1; + PeViewerMinorVersion = 0; + + LIBID_PeViewer: TGUID = '{7DD35085-3A37-11D4-B06E-C61ABD372324}'; + + IID_IPeViewerControl: TGUID = '{7DD35086-3A37-11D4-B06E-C61ABD372324}'; + CLASS_PeViewerControl: TGUID = '{7DD35088-3A37-11D4-B06E-C61ABD372324}'; +type + +// *********************************************************************// +// Forward declaration of types defined in TypeLibrary +// *********************************************************************// + IPeViewerControl = interface; + IPeViewerControlDisp = dispinterface; + +// *********************************************************************// +// Declaration of CoClasses defined in Type Library +// (NOTE: Here we map each CoClass to its Default Interface) +// *********************************************************************// + PeViewerControl = IPeViewerControl; + + +// *********************************************************************// +// Interface: IPeViewerControl +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7DD35086-3A37-11D4-B06E-C61ABD372324} +// *********************************************************************// + IPeViewerControl = interface(IDispatch) + ['{7DD35086-3A37-11D4-B06E-C61ABD372324}'] + procedure OpenFile(const FileName: WideString); safecall; + procedure BringToFront; safecall; + end; + +// *********************************************************************// +// DispIntf: IPeViewerControlDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {7DD35086-3A37-11D4-B06E-C61ABD372324} +// *********************************************************************// + IPeViewerControlDisp = dispinterface + ['{7DD35086-3A37-11D4-B06E-C61ABD372324}'] + procedure OpenFile(const FileName: WideString); dispid 1; + procedure BringToFront; dispid 2; + end; + +// *********************************************************************// +// The Class CoPeViewerControl provides a Create and CreateRemote method to +// create instances of the default interface IPeViewerControl exposed by +// the CoClass PeViewerControl. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoPeViewerControl = class + class function Create: IPeViewerControl; + class function CreateRemote(const MachineName: string): IPeViewerControl; + end; + +implementation + +uses ComObj; + +class function CoPeViewerControl.Create: IPeViewerControl; +begin + Result := CreateComObject(CLASS_PeViewerControl) as IPeViewerControl; +end; + +class function CoPeViewerControl.CreateRemote(const MachineName: string): IPeViewerControl; +begin + Result := CreateRemoteComObject(MachineName, CLASS_PeViewerControl) as IPeViewerControl; +end; + +end. diff --git a/official/1.96/examples/windows/delphitools/resfix/ResFix.dof b/official/1.96/examples/windows/delphitools/resfix/ResFix.dof new file mode 100644 index 0000000..48fc6fe --- /dev/null +++ b/official/1.96/examples/windows/delphitools/resfix/ResFix.dof @@ -0,0 +1,145 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=1 +UnsafeCode=1 +UnsafeCast=1 +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir=..\..\..\..\bin +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=..\..\..\..\source;..\..\..\..\source\common;..\..\..\..\source\windows;..\..\..\..\source\vcl +Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP;EasyNSED7;Jcl +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=0 +MinorVer=5 +Release=4 +Build=15 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1033 +CodePage=1252 +[Version Info Keys] +CompanyName=Petr Vones +FileDescription=ResFix utility +FileVersion=0.5.4.15 +InternalName=RESFIX +LegalCopyright=(c) 2002 Petr Vones +LegalTrademarks= +OriginalFilename=RESFIX.EXE +ProductName=ResFix utility for Win95 +ProductVersion=0.5.4 +Comments= +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=1 +Item0=..\..\..\..\source;..\..\..\..\source\common;..\..\..\..\source\windows;..\..\..\..\source\vcl +[HistoryLists\hlOutputDirectorry] +Count=1 +Item0=..\..\..\..\bin diff --git a/official/1.96/examples/windows/delphitools/resfix/ResFix.dpr b/official/1.96/examples/windows/delphitools/resfix/ResFix.dpr new file mode 100644 index 0000000..88f58f8 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/resfix/ResFix.dpr @@ -0,0 +1,17 @@ +program ResFix; + +uses + Forms, + ResFixMain in 'ResFixMain.pas' {MainForm}, + About in '..\Common\About.pas' {AboutBox}, + ToolsUtils in '..\Common\ToolsUtils.pas', + ExceptDlg in '..\..\..\..\experts\debug\dialog\ExceptDlg.pas' {ExceptionDialog}; + +{$R *.RES} + +begin + Application.Initialize; + Application.Title := 'ResFix'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/delphitools/resfix/ResFix.res b/official/1.96/examples/windows/delphitools/resfix/ResFix.res new file mode 100644 index 0000000..ef1acfc Binary files /dev/null and b/official/1.96/examples/windows/delphitools/resfix/ResFix.res differ diff --git a/official/1.96/examples/windows/delphitools/resfix/ResFixMain.dfm b/official/1.96/examples/windows/delphitools/resfix/ResFixMain.dfm new file mode 100644 index 0000000..19a14e9 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/resfix/ResFixMain.dfm @@ -0,0 +1,1052 @@ +object MainForm: TMainForm + Left = 227 + Top = 112 + AutoScroll = False + Caption = 'Resource fix utility for Windows 95' + ClientHeight = 357 + ClientWidth = 425 + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 250 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Menu = MainMenu1 + OldCreateOrder = False + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Bevel1: TBevel + Left = 0 + Top = 281 + Width = 425 + Height = 57 + Align = alBottom + end + object Label1: TLabel + Left = 8 + Top = 287 + Width = 86 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Smallest resource:' + end + object Label2: TLabel + Left = 8 + Top = 303 + Width = 82 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Largest resource:' + end + object Label3: TLabel + Left = 8 + Top = 319 + Width = 68 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Scaling factor:' + end + object MinResLabel: TLabel + Left = 100 + Top = 287 + Width = 66 + Height = 13 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + AutoSize = False + Caption = '0' + end + object MaxResLabel: TLabel + Left = 100 + Top = 303 + Width = 66 + Height = 13 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + AutoSize = False + Caption = '0' + end + object FactorLabel: TLabel + Left = 100 + Top = 319 + Width = 66 + Height = 13 + Alignment = taRightJustify + Anchors = [akLeft, akBottom] + AutoSize = False + Caption = '0' + end + object CoolBar1: TCoolBar + Left = 0 + Top = 0 + Width = 425 + Height = 26 + AutoSize = True + Bands = < + item + Control = ToolBar1 + ImageIndex = -1 + MinHeight = 22 + Width = 421 + end> + OnResize = CoolBar1Resize + object ToolBar1: TToolBar + Left = 9 + Top = 0 + Width = 408 + Height = 22 + AutoSize = True + Caption = 'ToolBar1' + EdgeBorders = [] + Flat = True + Images = ImageList1 + TabOrder = 0 + object ToolButton1: TToolButton + Left = 0 + Top = 0 + Action = Open1 + end + object ToolButton2: TToolButton + Left = 23 + Top = 0 + Width = 8 + Caption = 'ToolButton2' + ImageIndex = 2 + Style = tbsSeparator + end + object ToolButton3: TToolButton + Left = 31 + Top = 0 + Action = Description1 + end + end + end + object StatusBar: TStatusBar + Left = 0 + Top = 338 + Width = 425 + Height = 19 + Panels = < + item + Width = 90 + end + item + Width = 50 + end> + SimplePanel = False + end + object ResListView: TListView + Left = 0 + Top = 26 + Width = 425 + Height = 255 + Align = alClient + Columns = < + item + Caption = 'Resource type' + Width = 100 + end + item + Caption = 'Resource name' + Width = 100 + end + item + Alignment = taRightJustify + Caption = 'Size' + Width = 60 + end + item + Alignment = taRightJustify + Caption = 'Fixed size' + Width = 70 + end> + ColumnClick = False + HotTrackStyles = [] + ReadOnly = True + RowSelect = True + TabOrder = 2 + ViewStyle = vsReport + OnCustomDrawItem = ResListViewCustomDrawItem + end + object MainMenu1: TMainMenu + Images = ImageList1 + Left = 8 + Top = 248 + object File1: TMenuItem + Caption = 'File' + object Open2: TMenuItem + Action = Open1 + end + object N1: TMenuItem + Caption = '-' + end + object Exit2: TMenuItem + Action = Exit1 + end + end + object Help1: TMenuItem + Caption = 'Help' + object Descriptionofbug1: TMenuItem + Action = Description1 + end + object N2: TMenuItem + Caption = '-' + end + object Support1: TMenuItem + Action = SendMail1 + end + object About11: TMenuItem + Action = About1 + end + end + end + object ActionList1: TActionList + Images = ImageList1 + Left = 40 + Top = 248 + object Open1: TAction + Caption = 'Open ...' + Hint = 'Open a PE file' + ImageIndex = 1 + ShortCut = 16463 + OnExecute = Open1Execute + end + object Exit1: TAction + Caption = 'Exit' + ImageIndex = 0 + OnExecute = Exit1Execute + end + object About1: TAction + Caption = 'About ...' + Hint = 'About' + OnExecute = About1Execute + end + object Description1: TAction + Caption = 'More about the bug' + Hint = 'Learn more about the bug in MSDN article' + ImageIndex = 2 + OnExecute = Description1Execute + end + object SendMail1: TAction + Caption = 'Support' + ImageIndex = 21 + OnExecute = SendMail1Execute + end + end + object ImageList1: TImageList + Left = 72 + Top = 248 + Bitmap = { + 494C010116001800040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000006000000001002000000000000060 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000080000000000000000000FF + FF00008080000000000000000080000000000000000000000000000000000000 + 000000000000000000000000000000000000BFBFBF40FFFFFF40BFBFBF40FFFF + FF40BFBFBF40FFFFFF40BFBFBF40FFFFFF40BFBFBF40FFFFFF40BFBFBF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40BFBFBF40FFFFFF40BFBFBF40FFFF + FF40BFBFBF40FFFFFF40BFBFBF40FFFFFF40BFBFBF40FFFFFF40BFBFBF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF400000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000000000000000000000000080000000000000000000FF + FF0000808000000000000000008000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBF0000000000FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF400000000000000000FFFFFFBFFFFF + FF00000000BFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000000000000000000000000080000000000000000000FF + FF0000808000000000000000000000000000BFBFBFBFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF000000008000000000FFFFFF40FFFFFF40FFFFFF40FFFF + FF4000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408080 + 80408080804080808040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF4000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF408080 + 80408080804080808040FFFFFF40FFFFFF400000000000000000FFFFFFBFFFFF + FF00000000BFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000000000000000000000000080000000000000000000FF + FF00008080000000000000000000000000000000000000000000000000000000 + 000000000000000000000000008000000000BFBFBF40FFFFFF40BFBFBF40FFFF + FF40BFBFBF40FFFFFF40BFBFBF40FFFFFF40BFBFBF40FFFFFF40BFBFBF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF40BFBFBF40FFFFFF40BFBFBF40FFFF + FF40BFBFBF40FFFFFF40BFBFBF40FFFFFF40BFBFBF40FFFFFF40BFBFBF400000 + 0040FFFFFF40FFFFFF40FFFFFF40FFFFFF400000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000BFFFFF + FF00FFFFFF000000000000000000000000000000008000000000000000000080 + 8000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000008000000000FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF400000000000000000FFFFFFBFFFFF + FF00FFFFFF0000000000FFFFFFBFFFFFFF00FFFFFF0000000000FFFFFFBFFFFF + FF00FFFFFF000000000000000000000000000000008000000000000000000000 + 00007F7F7FBFBFBFBF0000000000000000000000000000000000000000000000 + 00007F7F7F00000000000000008000000000FFFFFF40FFFFFF40FFFFFF40FFFF + FF4000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF4000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40000000400000000000000000FFFFFFBFFFFF + FF00FFFFFF0000000000FFFFFFBFFFFFFF00FFFFFF0000000000FFFFFFBFFFFF + FF00FFFFFF0000000000000000000000000000000000000000007F7F7FBFBFBF + BF00BFBFBFBFBFBFBF00000000000000000000000000000000007F7F7F3F7F7F + 7F007F7F7F00000000000000008000000000FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF400000000000000000FFFFFFBFFFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00000000000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF0000000000000000007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F00000000000000008000000000FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF400000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFF + FF00FFFFFF00000000000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00000000BFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F00000000000000008000000000FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40000000400000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFF + FF00FFFFFF00000000000000000000000000000000000000FF00BFBFBF000000 + FF00BFBFBFBFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F00000000000000008000000000FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF400000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FFBFBFBF + BF00BFBFBFBFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F00000000000000008000000000FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF40FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF4080000040FFFFFF40FFFFFF400000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + 000000000000000000000000000000000000000000000000FF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBF00000000007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F0000000080000000000000008000000000FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF400000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFF + FF00FFFFFF00000000000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF00BFBFBF0000000000000000000000 + 000000000080000000000000008000000000FFFFFF40FFFFFF40FFFFFF40FFFF + FF4000000040FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF4000000040FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000BFFFFF + FF0000000000000000000000000000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF000000003F7F7F7F00000000800000 + 000000000080000000000000008000000000FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40800000408000004080000040FFFFFF4080000040FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF408000004080000040800000400000000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF000000003F7F7F7F000000008000000000000000800000 + 000000000080000000000000008000000000FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF400000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008000000000000000000000 + 00000000003F7F7F7F0000000080000000000000008000000000000000800000 + 00000000008000000000000000800000000000000040FFFFFF40FFFFFF40FFFF + FF400000004000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF400000004000000040FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFFFF40FFFF + FF40FFFFFF40FFFFFF40FFFFFF40FFFFFF400000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF000000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF0000000000000000000000000000000000000000 + 00000000003F7F7F7F0000000000000000000000003F7F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFF000000000000FFFF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFF0000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000000000FFFF0000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF3F7F7F + 7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF3F7F7F + 7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000000000FFFF0000FFFF0000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000000000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000003F7F7F7F000000FF000000 + FF000000FF000000FF000000FF000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF3F7F7F7F0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF00000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000000000FFFF0000FFFF0000FFFF0000FF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF00000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF00000000000000000000000000000000FF000000 + FF000000FF000000FF000000000000FF0000000000BFFF000000FF0000BFFF00 + 0000FF0000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000003F7F7F7F000000FF000000 + FF000000FF000000000000FF000000FF000000FF000000000000FF0000BFFF00 + 0000FF00003F7F7F7F0000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + FF000000000000FF000000FF000000FF000000FF000000FF0000000000BFFF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + 000000FF000000FF000000FF000000FF000000FF000000FF000000FF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF000000000000FFFF000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F0000000000FFFF0000000000000000000000000000000000000000 + 00000000000000FF000000FF000000FF000000FF000000FF0000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000FFFF000000000000FFFF000000000000FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFF0000000000FFFF0000000000000000000000000000000000000000 + 00000000003F7F7F7F0000000000000000000000003F7F7F7F00000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFF000000000000FFFF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFF0000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF000000000000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF0000FFFF00BFFFFF + 0000FFFF00BFFFFF0000FFFF0000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF0000FFFF0000FFFF0000000000000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFF0000FFFF0000FFFF000000000000000000000000 + 00007F7F7F007F7F7F007F7F7F00000000000000003F7F7F7F0000FFFF3F7F7F + 7F000000000000000000000000BFFFFFFF000000000000000000FFFFFF000000 + 0000000000BFFFFFFF000000000000000000FFFF0000000000000000000000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF00000000000000FF000000FF000000 + FF00000000007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F + 7F007F7F7F0000000000FFFFFF00000000000000000000FFFF0000FFFF0000FF + FF000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF000000000000000000FFFF00000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF00000000000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000FFFFFF00000000000000003F7F7F7F0000FFFF3F7F7F + 7F000000000000000000000000BFFFFFFF000000000000000000000000000000 + 0000FFFFFFBFFFFFFF000000000000000000FFFF000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF000000000000000000FFFF00000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF000000000000000000FFFFFF000000 + 000000000000000000000000000000000000FFFF000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF0000000000000000000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFFBFFFFFFF000000000000000000FFFF00000000000000FFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF0000000000FFFF0000FFFF0000FFFF + 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF000000 + 00000000000000000000FFFFFF00FFFFFF0000000000FFFFFF007F7F7F007F7F + 7F00FFFFFF007F7F7F007F7F7F00FFFFFF007F7F7F00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000000000BFFFFFFF00000000BFBFBFBF00FFFFFF000000 + 0000FFFFFF0000000000000000000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF0000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000000000FF000000FF000000 + FF000000000000000000000000BFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF007F7F7F007F7F + 7F00FFFFFF007F7F7F007F7F7F007F7F7F00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + 0000FFFF0000FFFF000000000000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF0000000000000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFF000000FF0000BFFF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF0000FFFF0000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF007F7F7F00000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FF0000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF0000FFFF0000FFFF00000000000000 + 00000000000000000000000000000000000000000000FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000808080008080800080808000000000000000 + 00000000000000000000000000000000000000000000BFBFBF00FFFFFF00BFBF + BF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBF + BF00FFFFFF000000FF00FFFFFF00000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00800000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000000000000000000000000000FFFFFF0000000000FFFF + FF00000000000000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000FFFFFF008000000000000000000000000000000080000000800000008000 + 00008000000080000000FFFFFF00800000008000000080000000800000008000 + 0000FFFFFF008000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF000000000000000000000000000000000000000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF00FFFFFF0000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000080000000800000008000000080000000800000008000 + 0000800000008000000080000000800000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF007F7F7F000000FF007F7F7F00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF000000FF000000FF000000FF0000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000000000000000000000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF007F7F7F000000FF007F7F7F00FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F007F7F + 7F0000000000000000007F7F7F00000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00BFBFBF00000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000000000000000000000000000000000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 00008000000080000000800000008000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F007F7F7F0000FFFF00000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000FF0000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000008000 + 0000FFFFFF00FFFFFF0080000000800000008000000080000000800000008000 + 00008000000080000000FFFFFF008000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F0000FFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF0000000000FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF000000FF007F7F7F0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF00000000000000000000000000000000008000 + 0000FFFFFF00FFFFFF0080000000800000008000000080000000800000008000 + 00008000000080000000800000008000000000000000FFFFFF00000000000000 + 0000FFFFFF00000000000000000000000000FFFFFF0000000000000000000000 + 00000000FF0000000000000000007F7F7F000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000FF000000FF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00000000000000000000000000000000008000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF008000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF00000000000000000000000000FF000000FF000000FF00 + 0000FF000000FF00000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF000000000000000000FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000FF000000FF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF00000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 00008000000000000000000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF00000000000000000000000000FF000000FF00 + 0000FF0000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF00FFFFFF0000FFFF00FFFF + FF007F7F7F007F7F7F0000FFFF00FFFFFF007F7F7F000000FF000000FF00FFFF + FF0000FFFF00FFFFFF0000FFFF00000000000000000080000000FFFFFF008000 + 000080000000800000008000000080000000800000008000000080000000FFFF + FF008000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF00000000000000000000000000FF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF0000FFFF00FFFFFF0000FF + FF000000FF000000FF00FFFFFF0000FFFF007F7F7F000000FF000000FF0000FF + FF00FFFFFF0000FFFF00FFFFFF00000000000000000080000000FFFFFF008000 + 0000800000008000000080000000800000008000000080000000800000008000 + 00008000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 000000000000000000007F7F7F0000FFFF007F7F7F0000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF0000FFFF00FFFF + FF000000FF000000FF007F7F7F00FFFFFF007F7F7F000000FF000000FF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000080000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00800000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF000000000000000000000000000000FF000000FF000000 + FF00000000000000000000FFFF0000FFFF0000FFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF000000FF000000FF000000FF000000FF000000FF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000000000 + 00000000000000000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF000000000000000000000000000000FF000000FF000000 + FF0000000000000000007F7F7F0000FFFF007F7F7F0000000000000000000000 + 000000000000000000000000000000000000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF000000FF000000FF000000FF00FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000080000000800000008000 + 00008000000080000000800000008000000080000000FFFFFF00800000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF00000000000000000000000000000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000080000000800000008000 + 0000800000008000000080000000800000008000000080000000800000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + 00007F7F7F007F7F7F0000000000000000000000000000000000000000000000 + 7F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000BFBFBF00BFBFBF0000000000000000000000000000000000000000000000 + 7F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FF000000FF000000FF000000FF000000FF000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF00BFBFBF00BFBFBF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000008080000080 + 8000008080000080800000808000008080000080800000808000008080000000 + 000000000000000000000000000000000000FF000000FF000000FF000000FF00 + 0000FF000000FF000000BFBFBF0000000000BFBFBF00FF000000FF000000FF00 + 0000FF000000FF000000FF000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000FFFF00000000000080 + 8000008080000080800000808000008080000080800000808000008080000080 + 8000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF00BFBFBF00BFBFBF00000000007F7F7F0000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF0000FFFF000000 + 0000008080000080800000808000008080000080800000808000008080000080 + 80000080800000000000000000000000000000000000FFFFFF00000000007F7F + 7F007F7F7F0000000000FFFFFF007F7F7F00FFFFFF00000000007F7F7F007F7F + 7F0000000000FFFFFF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00000000000080800000808000008080000080800000808000008080000080 + 8000008080000080800000000000000000007F7F7F0000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000007F7F7F000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000007F7F7F0000000000FFFFFF000000 + 00000000000000000000FFFFFF007F7F7F00FFFFFF0000000000000000000000 + 0000FFFFFF00000000007F7F7F000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000BFBFBF0000000000FF000000FF000000FF00 + 00000000FF00FF000000FF000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 000000000000000000000000000000000000000000007F7F7F0000000000FFFF + FF000000000000000000FFFFFF007F7F7F00FFFFFF000000000000000000FFFF + FF00000000007F7F7F00000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF000000000000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F7F7F0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000007F7F7F00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 7F00FFFF000000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 7F00FFFF0000FFFF00000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000600000000100010000000000000300000000000000000000 + 000000000000000000000000FFFFFF008003C3807F7F7F008003C3007F7F7F00 + 8003C2010000003F8003C0030000003F8003C003BFBFBF008003C003BFBFBF00 + 80030003BFBFBFBF80030003BFBFBFBF800300030000FF00800300030000FF00 + 80030003BFBFBF0080030007BFBFBF008003000F0000FF008007003F00000000 + 800F80FF00000000801FC3FF00000000FFFFFFFFFFFFBFFF00010001F83FBFFF + 000100011010B04900010001E00F807F1FF11FF1C007B07F1DF11FF18003B9FF + 1CF118318003BFFF1C7118318003B0491C3118318003807F1C7118318003B07F + 1CF11831C007B9FF1DF11FF1E00FBFFF1FF11FF13018048F00010001F83F07FF + 00010001FFFF07FF00010001FFFF9FFFFFFF8000FFE3FC01FFF88000FC418C01 + 20F8C00088000401007FE00000000401007CF00000000401003CF80000008C01 + 000FFC000000FC01000406000000FC01000C07000000040301FF018000000407 + E3FC01800000040FFFFC0060000007FFFFFFC06000010603FFF8C0600001FF07 + FFF8F044000DFF8FFFFFF07ED553FFDFFFFFFFFFFFFF800180038003C0070000 + 80038003BFEB00008003800300050000800380037E310000800380037E350000 + 8003800300060000800380037FEA0000800380038014E00780038003C00AE007 + 80038003E001E00780038003E007E00780038003F007E00F80038003F003E01F + FFFFFFFFF803E03FFFFFFFFFFFFFE07FFC00FE7FFFFFFC00FC00FE1FF83FFC00 + FC00FC07E00FFC00FC00FC01C007FC000000F8008003E0000000F8008003E000 + 000000000001E000000000000001E00700230001000180070001003200018007 + 0000003E000180070023003E8003801F0063003E8003801F00C3001DC007801F + 01070023E00F801F03FF003FF83FFFFFC007FFFFFFFFFF00C007FFFFFFFFFF00 + C007001FF83FFF00C007000F0001FF00C007000700010000C007000300010000 + C007000100010000C007000000010000C007001F80030023C007001F80030001 + C007001F80030000C0078FF1C1070023C007FFF9E38F0063C007FF75FFFF00C3 + C007FF8FFFFF0107C007FFFFFFFF03FF00000000000000000000000000000000 + 000000000000} + end + object OpenFileDialog: TOpenDialog + Filter = + 'PE Exe files (*.exe;*.dll;*.bpl)|*.exe;*.dll;*.bpl|All files (*.' + + '*)|*.*' + Options = [ofHideReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 104 + Top = 248 + end +end diff --git a/official/1.96/examples/windows/delphitools/resfix/ResFixMain.pas b/official/1.96/examples/windows/delphitools/resfix/ResFixMain.pas new file mode 100644 index 0000000..8021d8b --- /dev/null +++ b/official/1.96/examples/windows/delphitools/resfix/ResFixMain.pas @@ -0,0 +1,270 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 ResFixMain.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit ResFixMain; + +{$I jcl.inc} +{$IFDEF SUPPORTS_PLATFORM_WARNINGS} + {$WARN SYMBOL_PLATFORM OFF} +{$ENDIF SUPPORTS_PLATFORM_WARNINGS} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, ToolWin, ImgList, ActnList, Menus, JclPeImage, StdCtrls, + ExtCtrls; + +type + TMainForm = class(TForm) + CoolBar1: TCoolBar; + ToolBar1: TToolBar; + ToolButton1: TToolButton; + MainMenu1: TMainMenu; + ActionList1: TActionList; + ImageList1: TImageList; + StatusBar: TStatusBar; + Open1: TAction; + Exit1: TAction; + About1: TAction; + File1: TMenuItem; + Open2: TMenuItem; + N1: TMenuItem; + Exit2: TMenuItem; + Help1: TMenuItem; + About11: TMenuItem; + Description1: TAction; + ToolButton2: TToolButton; + ToolButton3: TToolButton; + Descriptionofbug1: TMenuItem; + N2: TMenuItem; + OpenFileDialog: TOpenDialog; + ResListView: TListView; + Bevel1: TBevel; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + MinResLabel: TLabel; + MaxResLabel: TLabel; + FactorLabel: TLabel; + SendMail1: TAction; + Support1: TMenuItem; + procedure Exit1Execute(Sender: TObject); + procedure Description1Execute(Sender: TObject); + procedure About1Execute(Sender: TObject); + procedure Open1Execute(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure ResListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure SendMail1Execute(Sender: TObject); + procedure CoolBar1Resize(Sender: TObject); + private + FPeImage: TJclPeImage; + procedure OpenFile(const FileName: TFileName); + procedure ProcessFile; + public + { Public declarations } + end; + +var + MainForm: TMainForm; + +implementation + +uses About, ToolsUtils, JclLogic, JclShell, JclSysUtils; + +{$R *.DFM} + +resourcestring + RsCheckApp = 'It is recommended to check the application. Would you like to start it ?'; + RsDescriptionURL = 'http://support.microsoft.com/support/kb/articles/Q182/8/19.asp'; + RsFixed = 'File was fixed'; + RsNoFixes = 'Not fixes needed'; + +type + TJclPeImageHack = class(TJclPeImage); + +{ TMainForm } + +procedure TMainForm.FormCreate(Sender: TObject); +begin + FPeImage := TJclPeImage.Create; + TJclPeImageHack(FPeImage).ReadOnlyAccess := False; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FPeImage); +end; + +procedure TMainForm.Exit1Execute(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.Description1Execute(Sender: TObject); +begin + Win32Check(ShellExecEx(RsDescriptionURL)); +end; + +procedure TMainForm.About1Execute(Sender: TObject); +begin + ShowToolsAboutBox; +end; + +procedure TMainForm.Open1Execute(Sender: TObject); +begin + with OpenFileDialog do + begin + FileName := ''; + if Execute then OpenFile(FileName); + end; +end; + +procedure TMainForm.OpenFile(const FileName: TFileName); +begin + FPeImage.FileName := FileName; + StatusBar.Panels[0].Text := ''; + StatusBar.Panels[1].Text := FileName; + ProcessFile; +end; + +procedure TMainForm.ProcessFile; +var + MinResSize, MaxResSize: Integer; + ScalingFactor: Integer; + NeedFix, AnyFixes: Boolean; + FileName: TFileName; + + procedure ScanResources(List: TJclPeResourceList); + var + I, Size: Integer; + Item: TJclPeResourceItem; + begin + for I := 0 to List.Count - 1 do + begin + Item := List[I]; + if Item.IsDirectory then + ScanResources(Item.List) + else + begin + Size := Item.DataEntry^.Size; + MinResSize := Min(MinResSize, Size); + MaxResSize := Max(MaxResSize, Size); + with ResListView.Items.Add do + begin + Caption := Item.ResourceTypeStr; + Data := Item; + SubItems.Add(Item.ParentItem.Name); + SubItems.Add(Format('%u', [Size])); + SubItems.Add(''); + end; + end; + end; + end; + + procedure FixResources(List: TJclPeResourceList); + var + I, Size: Integer; + Item: TJclPeResourceItem; + begin + for I := 0 to List.Count - 1 do + begin + Item := List[I]; + if Item.IsDirectory then + FixResources(Item.List) + else + if Item.ResourceType in [rtCursor, rtIcon, rtCursorEntry, rtIconEntry] then + begin + Size := Item.DataEntry^.Size; + if (Size mod ScalingFactor <> 0) or (Size < ScalingFactor * 2) then + begin + Size := Max((Size div ScalingFactor + 1) * ScalingFactor, ScalingFactor * 2); + Item.DataEntry^.Size := Size; + AnyFixes := True; + ResListView.FindData(0, Item, True, False).SubItems[2] := Format('%u', [Size]); + end; + end; + end; + end; + +begin + MinResSize := MaxInt; + MaxResSize := 0; + FileName := FPeImage.FileName; + ResListView.Items.BeginUpdate; + try + ResListView.Items.Clear; + ScanResources(FPeImage.ResourceList); + + ScalingFactor := ((MaxResSize div 65536) div 2 + 1) * 2; + MinResLabel.Caption := Format('%d', [MinResSize]); + MaxResLabel.Caption := Format('%d', [MaxResSize]); + FactorLabel.Caption := Format('%d', [ScalingFactor]); + + NeedFix := (MaxResSize >= 65536) and (MinResSize mod ScalingFactor <> 0); + AnyFixes := False; + if NeedFix then FixResources(FPeImage.ResourceList); + FPeImage.FileName := ''; + ListViewFocusFirstItem(ResListView); + finally + ResListView.Items.EndUpdate; + end; + with StatusBar.Panels[0] do + if AnyFixes then + begin + Text := RsFixed; + if MessBox(RsCheckApp, MB_YESNO or MB_ICONQUESTION) = ID_YES then + ShellExecEx(FileName); + end else + Text := RsNoFixes; +end; + +procedure TMainForm.ResListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if Item.SubItems[2] <> '' then + Sender.Canvas.Font.Color := clRed; +end; + +procedure TMainForm.SendMail1Execute(Sender: TObject); +begin + SendEmail; +end; + +procedure TMainForm.CoolBar1Resize(Sender: TObject); +begin + D4FixCoolBarResizePaint(Sender); +end; + +// History: + +// $Log: ResFixMain.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/screenjpg/Main.dfm b/official/1.96/examples/windows/delphitools/screenjpg/Main.dfm new file mode 100644 index 0000000..071988c --- /dev/null +++ b/official/1.96/examples/windows/delphitools/screenjpg/Main.dfm @@ -0,0 +1,901 @@ +object MainForm: TMainForm + Left = 192 + Top = 107 + Width = 561 + Height = 447 + Caption = 'ScreenJPG' + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 300 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Menu = MainMenu1 + OldCreateOrder = False + Position = poDefaultPosOnly + ShowHint = True + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object CoolBar1: TCoolBar + Left = 0 + Top = 0 + Width = 553 + Height = 26 + AutoSize = True + Bands = < + item + Control = ToolBar1 + ImageIndex = -1 + MinHeight = 22 + Width = 549 + end> + OnResize = CoolBar1Resize + object ToolBar1: TToolBar + Left = 9 + Top = 0 + Width = 536 + Height = 22 + AutoSize = True + Caption = 'ToolBar1' + EdgeBorders = [] + Flat = True + Images = ImageList1 + TabOrder = 0 + object ToolButton1: TToolButton + Left = 0 + Top = 0 + Action = OpenFile1 + end + object ToolButton3: TToolButton + Left = 23 + Top = 0 + Action = SaveFile1 + end + object ToolButton4: TToolButton + Left = 46 + Top = 0 + Width = 8 + Caption = 'ToolButton4' + ImageIndex = 1 + Style = tbsSeparator + end + object ToolButton5: TToolButton + Left = 54 + Top = 0 + Action = Paste1 + end + object ToolButton6: TToolButton + Left = 77 + Top = 0 + Width = 8 + Caption = 'ToolButton6' + ImageIndex = 2 + Style = tbsSeparator + end + object RatioComboBox: TComboBox + Left = 85 + Top = 0 + Width = 58 + Height = 21 + Hint = 'Quality' + TabStop = False + Style = csDropDownList + Color = clBtnFace + Ctl3D = True + DropDownCount = 10 + Enabled = False + ItemHeight = 13 + ParentCtl3D = False + TabOrder = 0 + OnChange = RatioComboBoxChange + end + object ColorComboBox: TComboBox + Left = 143 + Top = 0 + Width = 58 + Height = 21 + Hint = 'Color' + TabStop = False + Style = csDropDownList + Color = clBtnFace + Ctl3D = True + Enabled = False + ItemHeight = 13 + Items.Strings = ( + 'B/W' + 'Color') + ParentCtl3D = False + TabOrder = 1 + OnChange = RatioComboBoxChange + end + end + end + object StatusBar1: TStatusBar + Left = 0 + Top = 382 + Width = 553 + Height = 19 + Panels = < + item + Width = 120 + end + item + Width = 50 + end> + SimplePanel = False + end + object ScrollBox: TScrollBox + Left = 0 + Top = 26 + Width = 553 + Height = 356 + HorzScrollBar.Tracking = True + VertScrollBar.Tracking = True + Align = alClient + TabOrder = 2 + object Image1: TImage + Left = 0 + Top = 0 + Width = 549 + Height = 352 + Align = alClient + AutoSize = True + end + end + object MainMenu1: TMainMenu + Images = ImageList1 + Left = 8 + Top = 344 + object File1: TMenuItem + Caption = 'File' + object Open1: TMenuItem + Action = OpenFile1 + end + object SaveAs1: TMenuItem + Action = SaveFile1 + end + object N1: TMenuItem + Caption = '-' + end + object Exit2: TMenuItem + Action = Exit1 + end + end + object Edit1: TMenuItem + Caption = 'Edit' + object Paste11: TMenuItem + Action = Paste1 + end + end + object Help1: TMenuItem + Caption = 'Help' + object About2: TMenuItem + Action = About1 + end + end + end + object ImageList1: TImageList + Left = 40 + Top = 344 + Bitmap = { + 494C010111001300040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000005000000001002000000000000050 + 00000000000000000000000000000000000000000000000000007F7F7F007F7F + 7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F + 7F007F7F7F00FFFFFF00000000000000000010C0000040AF60004FEF6000408F + 70001F8060000FC0100040EF6F00904F7F009F6F600090EF6F00608F6F00102F + 600090CF2F00A04F70000F6F60005F2F6F0070EF60004FC01000B0AF6000908F + 70009F6F600090EF6F00608F6F00102F600090CF2F00A04F70000F6F60005F2F + 6F0070EF60004FA000000F8F6F004FEF600070EF000040206000606F4000602F + 6F002FCF6F00A00F0F00A02F600010EF4F00804F5000000F0000000F00000010 + 00000F0010008000000030204F000010000000000000000000007F7F7F007F7F + 7F0000000000FFFFFF0000000000000000000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000009F8F70000F8F7000AF6F7000102F + 6000902F300020804F002FCF6000A04F000000600000A0EF6F00806F0000F02F + 00002FE050004F8F6000A00F6F001F202F0010C0000040AF60004FEF6000408F + 700010601000300050000FCF6F002F8F6F009FCF0F000FA00000BF2F6F00208F + 7000404F0000900000000FA00000BF2F6F00208F7000404F0000900000000060 + 0F009F2F6F006F0F700060AF6000802F600070AF6000600F0F00000000005080 + 50009F6F600090EF6F00608F6F0010EF6F0000000000000000007F7F7F00FFFF + FF007F7F7F0000000000FFFFFF00000000000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000002FAF00001F8F7000606F3000202F + 0F003FA04000702F6000108F6F002F8F600040400F004F8F70002FAF6F0040AF + 60004FEF6000408F700010A00F005F0050000F4F70002FCF6F00A06F4000A08F + 6F009F80400040000F00A02F600010EF4F00908F60002F4F70001020000040E0 + 4F00706F4000402F600070EF60002FEF00009F4050000F8F70004FEF6F001FEF + 6F006F4F60007F4F40007F0F7F001F0F6F000FCF6F003FAF60006F204F00A0AF + 60006F6F700070605000A04F70004FCF6F0000000000000000007F7F7F00FFFF + FF00000000007F7F7F0000000000FFFFFF000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000007F0F7F001F0F6F000FCF6F003FAF + 6000000000004F8050001FEF6F006F4F60007F4F40007F0F7F006F6040007F8F + 6F007F4F70001FEF6F006F4F60007F4F40007F0F7F0020804F002FCF6000A06F + 0000BF1000001F8050007F0F7000100000002FE050004F8F6000A00F6F001040 + 3F0030004F002F2F6F003F0F6F00A04F0000AFE00000A02F6000106F5000A0EF + 6F00800F0F002F605000A02F7F0060AF600000000000000000007F7F7F00FFFF + FF0000000000000000007F7F7F00FFFFFF000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF0000000000000000007F7F7F00FFFFFF000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF0000000000000000007F7F7F00FFFFFF000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF0000000000000000007F7F7F00FFFFFF000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF0000000000000000007F7F7F00FFFFFF000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF0000000000000000007F7F7F00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF0000000000000000007F7F7F007F7F7F000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF0000000000000000007F7F7F00FFFFFF000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF0000000000FFFFFF007F7F7F00FFFFFF000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF007F7F7F00FFFFFF007F7F7F00FFFFFF000000000000000000000000000000 + 00007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F00FFFF + FF007F7F7F007F7F7F007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF007F7F7F00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F007F7F + 7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F + 7F007F7F7F000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008000000080000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000800000000000000000000000800000000000000000000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000800000000000000000000000800000000000000080000000000000000000 + 0000800000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000800000000000000000000000800000000000000080000000000000000000 + 0000800000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008000000080000000800000000000000080000000000000000000 + 0000800000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000800000000000000080000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000800000000000000080000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000800000008000000080000000800000008000 + 0000800000008000000080000000800000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000080000000FFFFFF0000000000000000000000 + 00000000000000000000FFFFFF00800000000000000000000000000000000000 + 000000000000000000000000000000FFFF0000FFFF0000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000000000000000 + 0000000000000000000000000000808080008080800080808000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000080000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF0000000000000000000000 + 00000000000000000000FFFFFF00800000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 0000800000008000000080000000000000000000000000000000000000000000 + 000080000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000FFFFFF000000 + 000000000000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 0000800000008000000000000000000000000000000000000000000000000000 + 000000000000800000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF000000000000000000FFFF + FF00800000008000000080000000800000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 0000800000000000000000000000000000000000000000000000000000000000 + 000000000000800000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000FFFFFF000000 + 000000000000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0080000000FFFFFF008000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 0000000000008000000000000000000000000000000000000000000000000000 + 000000000000800000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0080000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00800000008000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000800000000000 + 0000000000000000000080000000800000000000000000000000000000000000 + 000080000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000FFFFFF000000 + 000000000000FFFFFF0000000000800000008000000080000000800000008000 + 0000800000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008000000080000000800000008000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF000000000000000000000000000000000000000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000080000000800000008000000080000000800000008000 + 0000800000008000000080000000800000000000000000000000000000000000 + 7F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000008080000080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800000000000000000000000000000000000000000000000 + 0000000000000000000080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000000000000000 + 7F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000008080000080 + 8000008080000080800000808000008080000080800000808000008080000000 + 0000000000000000000000000000000000000000000000000000008080000080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800000000000000000000000000080808000008080008080 + 8000008080008080800080000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFFFF00800000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000FFFF00000000000080 + 8000008080000080800000808000008080000080800000808000008080000080 + 8000000000000000000000000000000000000000000000000000008080000080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800000000000000000000000000000808000808080000080 + 8000808080000080800080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00800000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF0000FFFF000000 + 0000008080000080800000808000008080000080800000808000008080000080 + 8000008080000000000000000000000000000000000000000000008080000080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800000000000000000000000000080808000008080008080 + 8000008080008080800080000000FFFFFF00000000000000000000000000FFFF + FF00800000008000000080000000800000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00000000000080800000808000008080000080800000808000008080000080 + 8000008080000080800000000000000000000000000000000000008080000080 + 8000008080000080800000808000008080000080800000808000008080000080 + 8000008080000080800000000000000000000000000000808000808080000080 + 8000808080000080800080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0080000000FFFFFF0080000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000008080000080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000008080000080800000000000000000000000000080808000008080008080 + 8000008080008080800080000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00800000008000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000008080000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800000000000000000000000000000808000808080000080 + 8000808080000080800080000000800000008000000080000000800000008000 + 0000800000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000008080000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800000000000000000000000000080808000008080008080 + 8000008080008080800000808000808080000080800080808000008080008080 + 8000008080000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000008080000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800000000000000000000000000000808000808080000000 + 0000000000000000000000000000000000000000000000000000000000008080 + 8000808080000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF000000000000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000008080000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000080800000000000000000000000000080808000808080000000 + 0000000000000000000000000000000000000000000000000000000000008080 + 8000008080000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000008080000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000808000808080000080 + 80000000000000FFFF00000000000000000000FFFF0000000000808080000080 + 8000808080000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000008080000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F00FFFF000000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F00FFFF0000FFFF00000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000500000000100010000000000800200000000000000000000 + 000000000000000000000000FFFFFF00C00300780000E0FFCBF3000000000078 + C5F3000000000000CAF3000000001084CCF3000000000000CCF3108410840000 + CCF3008400000000CCF3000000000000CCF3000000000000CC73000000840000 + CCF3000000000000CCF3000000000000C8F3000000000000C0F3000000000000 + C003000000000000C007E0FFE0FFE0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF8FFFC007C007C0078C03FFFFFFFFFFFF8FFFC03FF83FF807FFFF + FFFFFFFFFFFFFFFFC007C007C0078FFFFFFFFFFFFFFF8C03C03FF01FF8078FFF + FFFFFFFFFFFFFFFFC007C007C007FFFFFFFFFFFFFFFF8FFFC03FF83FF8078C03 + FFFFFFFFFFFF8FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF9FFFFFFFFFFFFFF + F6CFFFFFFFFFE00FF6B7FFFFFFFFFFFFF6B7F00F81FFF83FF8B7F8C7E3FFF39F + FE8FF8C7F1FFF39FFE3FF8C7F8FFF39FFF7FF80FFC7FF39FFE3FF8C7FE3FF39F + FEBFF8C7FF1FF39FFC9FF8C7FF8FF39FFDDFF00FFF03E10FFDDFFFFFFFFFFFFF + FDDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC007FFFFFFFF + FE00BFEBFFFFC007FE000005FFFFC007FE007E31FFFFC00780007E35FFF7C007 + 80000006C1F7C00780007FEAC3FBC00780008014C7FBC0078001C00ACBFBC007 + 8003E001DCF7C0078007E007FF0FC007807FF007FFFFC00F80FFF003FFFFC01F + 81FFF803FFFFC03FFFFFFFFFFFFFFFFFFFFFFFFFFFFFC007FFFFC001FC00C007 + 001F80318000C007000F80310000C007000780310000C007000380010000C007 + 000180010001C007000080010003C007001F8FF10003C007001F8FF10003C007 + 001F8FF10003C0078FF18FF10FC3C007FFF98FF10003C007FF758FF58007C007 + FF8F8001F87FC007FFFFFFFFFFFFC00700000000000000000000000000000000 + 000000000000} + end + object ActionList1: TActionList + Images = ImageList1 + Left = 72 + Top = 344 + object OpenFile1: TAction + Caption = 'Open ...' + Hint = 'Open a file' + ImageIndex = 0 + ShortCut = 16463 + OnExecute = OpenFile1Execute + end + object Exit1: TAction + Caption = 'Exit' + ImageIndex = 3 + OnExecute = Exit1Execute + end + object SaveFile1: TAction + Caption = 'Save As ...' + ImageIndex = 1 + ShortCut = 16467 + OnExecute = SaveFile1Execute + OnUpdate = SaveFile1Update + end + object Paste1: TAction + Caption = 'Paste picture' + Hint = 'Paste picture' + ImageIndex = 2 + ShortCut = 16470 + OnExecute = Paste1Execute + OnUpdate = Paste1Update + end + object About1: TAction + Caption = 'About...' + OnExecute = About1Execute + end + end + object SaveDialog1: TSaveDialog + DefaultExt = 'jpeg' + Filter = 'JPEG images|*.jpg;*.jpeg' + Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing] + Left = 138 + Top = 348 + end + object OpenDialog1: TOpenPictureDialog + Filter = 'Bitmaps (*.bmp)|*.bmp||*.emf' + Left = 106 + Top = 348 + end +end diff --git a/official/1.96/examples/windows/delphitools/screenjpg/Main.pas b/official/1.96/examples/windows/delphitools/screenjpg/Main.pas new file mode 100644 index 0000000..b4bc57a --- /dev/null +++ b/official/1.96/examples/windows/delphitools/screenjpg/Main.pas @@ -0,0 +1,292 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 Main.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit Main; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, ToolWin, ActnList, ImgList, Menus, ExtCtrls, StdCtrls, Jpeg, + ClipBrd, ExtDlgs; + +type + TMainForm = class(TForm) + CoolBar1: TCoolBar; + ToolBar1: TToolBar; + StatusBar1: TStatusBar; + MainMenu1: TMainMenu; + ImageList1: TImageList; + ActionList1: TActionList; + OpenFile1: TAction; + Exit1: TAction; + File1: TMenuItem; + Open1: TMenuItem; + N1: TMenuItem; + Exit2: TMenuItem; + ToolButton1: TToolButton; + ScrollBox: TScrollBox; + Image1: TImage; + RatioComboBox: TComboBox; + SaveFile1: TAction; + SaveAs1: TMenuItem; + ToolButton3: TToolButton; + SaveDialog1: TSaveDialog; + ColorComboBox: TComboBox; + Paste1: TAction; + ToolButton4: TToolButton; + ToolButton5: TToolButton; + ToolButton6: TToolButton; + Edit1: TMenuItem; + Paste11: TMenuItem; + Help1: TMenuItem; + OpenDialog1: TOpenPictureDialog; + About1: TAction; + About2: TMenuItem; + procedure Exit1Execute(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure OpenFile1Execute(Sender: TObject); + procedure RatioComboBoxChange(Sender: TObject); + procedure SaveFile1Execute(Sender: TObject); + procedure Paste1Execute(Sender: TObject); + procedure Paste1Update(Sender: TObject); + procedure SaveFile1Update(Sender: TObject); + procedure About1Execute(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure CoolBar1Resize(Sender: TObject); + private + FJpegImage: TJPEGImage; + FFileName: TFileName; + FModified: Boolean; + FOriginalPicture: TPicture; + procedure CompressPicture; + procedure FillCombos; + procedure EnableCombos; + public + function CheckSaved: Boolean; + procedure OpenFile; + function SaveFile: Boolean; + procedure UpdatePicture; + property Modified: Boolean read FModified; + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.DFM} + +uses + ToolsUtils, JclSysUtils; + +resourcestring + RsSaveImage = 'Save current image ?'; + RsJpegSize = 'JPEG Size: %.0n'; + +function TMainForm.CheckSaved: Boolean; +begin + Result := not Modified; + if not Result then + case MessBox(RsSaveImage, MB_ICONEXCLAMATION or MB_YESNOCANCEL) of + ID_YES: Result := SaveFile; + ID_NO: Result := True; + else + Result := False; + end; +end; + +procedure TMainForm.CompressPicture; +var + Ratio: Integer; +begin + with RatioComboBox do Ratio := Integer(Items.Objects[ItemIndex]); + FJpegImage.Grayscale := (ColorComboBox.ItemIndex = 0); + FJpegImage.CompressionQuality := Ratio; + FJpegImage.Assign(FOriginalPicture.Graphic); +end; + +procedure TMainForm.EnableCombos; +begin + RatioComboBox.Enabled := True; + RatioComboBox.Color := clWindow; + ColorComboBox.Enabled := True; + ColorComboBox.Color := clWindow; +end; + +procedure TMainForm.Exit1Execute(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.OpenFile; +begin + if CheckSaved then + begin + with OpenDialog1 do + begin + FileName := ''; + if Execute then + begin + FFileName := FileName; + FOriginalPicture.LoadFromFile(FileName); + UpdatePicture; + end; + end; + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + FJpegImage := TJPEGImage.Create; + FOriginalPicture := TPicture.Create; + Image1.Align := alNone; + FillCombos; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FOriginalPicture); + FreeAndNil(FJpegImage); +end; + +procedure TMainForm.UpdatePicture; +var + MemStream : TMemoryStream; +begin + Screen.Cursor := crHourGlass; + try + EnableCombos; + CompressPicture; + MemStream := TMemoryStream.Create; + try + FJpegImage.SaveToStream(MemStream); + StatusBar1.Panels[0].Text := Format(RsJpegSize, [IntToExtended(MemStream.Size)]); + MemStream.Position := 0; + FJpegImage.LoadFromStream(MemStream); + Image1.Picture.Assign(FJpegImage); + Image1.Update; + finally + MemStream.Free; + end; + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.OpenFile1Execute(Sender: TObject); +begin + OpenFile; +end; + +procedure TMainForm.FillCombos; +const + QualityTable: array [0..10] of TJPEGQualityRange = + (10, 20, 30, 40, 50, 60, 70, 80, 90, 95, 100); +var + I: Integer; +begin + with RatioComboBox do + begin + for I := Low(QualityTable) to High(QualityTable) do + Items.AddObject(Format('%d%%', [QualityTable[I]]), Pointer(QualityTable[I])); + ItemIndex := 8; + end; + ColorComboBox.ItemIndex := 1; +end; + +procedure TMainForm.RatioComboBoxChange(Sender: TObject); +begin + UpdatePicture; + FModified := True; +end; + +procedure TMainForm.SaveFile1Execute(Sender: TObject); +begin + SaveFile; +end; + +procedure TMainForm.Paste1Execute(Sender: TObject); +begin + if CheckSaved then + begin + FOriginalPicture.Assign(Clipboard); + FFileName := ''; + UpdatePicture; + FModified := True; + end; +end; + +procedure TMainForm.Paste1Update(Sender: TObject); +begin + Paste1.Enabled := Clipboard.HasFormat(CF_BITMAP); +end; + +procedure TMainForm.SaveFile1Update(Sender: TObject); +begin + SaveFile1.Enabled := Assigned(Image1.Picture.Graphic); +end; + +function TMainForm.SaveFile: Boolean; +begin + Result := False; + with SaveDialog1 do + begin + FileName := ChangeFileExt(FFileName, '.jpeg'); + if Execute then + begin + FJpegImage.SaveToFile(FileName); + Result := True; + FModified := False; + end; + end; +end; + +procedure TMainForm.About1Execute(Sender: TObject); +begin + ShowToolsAboutBox; +end; + +procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + CanClose := CheckSaved; +end; + +procedure TMainForm.CoolBar1Resize(Sender: TObject); +begin + D4FixCoolBarResizePaint(Sender); +end; + +// History: + +// $Log: Main.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/screenjpg/ScreenJPG.dof b/official/1.96/examples/windows/delphitools/screenjpg/ScreenJPG.dof new file mode 100644 index 0000000..02b884c --- /dev/null +++ b/official/1.96/examples/windows/delphitools/screenjpg/ScreenJPG.dof @@ -0,0 +1,134 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir=..\..\..\..\bin +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=..\..\..\..\source;..\..\..\..\source\common;..\..\..\..\source\windows;..\..\..\..\source\vcl +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=0 +MinorVer=5 +Release=4 +Build=3 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1033 +CodePage=1252 +[Version Info Keys] +CompanyName=Petr Vones +FileDescription=Screen to JPEG convertor +FileVersion=0.5.4.3 +InternalName=PEVIEWER +LegalCopyright=(c) 2002 Petr Vones +LegalTrademarks= +OriginalFilename=SCREENJPG.EXE +ProductName=Screen to JPEG convertor +ProductVersion=0.5.4 diff --git a/official/1.96/examples/windows/delphitools/screenjpg/ScreenJPG.dpr b/official/1.96/examples/windows/delphitools/screenjpg/ScreenJPG.dpr new file mode 100644 index 0000000..a36df1c --- /dev/null +++ b/official/1.96/examples/windows/delphitools/screenjpg/ScreenJPG.dpr @@ -0,0 +1,17 @@ +program ScreenJPG; + +uses + Forms, + Main in 'Main.pas' {MainForm}, + About in '..\Common\About.pas' {AboutBox}, + ToolsUtils in '..\Common\ToolsUtils.pas', + ExceptDlg in '..\..\..\..\experts\debug\dialog\ExceptDlg.pas' {ExceptionDialog}; + +{$R *.RES} + +begin + Application.Initialize; + Application.Title := 'ScreenJPG'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/delphitools/screenjpg/ScreenJPG.res b/official/1.96/examples/windows/delphitools/screenjpg/ScreenJPG.res new file mode 100644 index 0000000..0a04ff1 Binary files /dev/null and b/official/1.96/examples/windows/delphitools/screenjpg/ScreenJPG.res differ diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/ChangePriority.dfm b/official/1.96/examples/windows/delphitools/toolhelpview/ChangePriority.dfm new file mode 100644 index 0000000..dc72ece --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/ChangePriority.dfm @@ -0,0 +1,44 @@ +object ChangePriorityDlg: TChangePriorityDlg + Left = 235 + Top = 178 + ActiveControl = PriorityRadioGroup + BorderStyle = bsDialog + Caption = 'Change process priority' + ClientHeight = 111 + ClientWidth = 229 + Color = clBtnFace + ParentFont = True + OldCreateOrder = True + Position = poScreenCenter + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object OKBtn: TButton + Left = 148 + Top = 8 + Width = 75 + Height = 25 + Caption = 'OK' + Default = True + TabOrder = 0 + OnClick = OKBtnClick + end + object CancelBtn: TButton + Left = 148 + Top = 38 + Width = 75 + Height = 25 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object PriorityRadioGroup: TRadioGroup + Left = 8 + Top = 3 + Width = 129 + Height = 102 + Caption = 'Priority' + TabOrder = 2 + end +end diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/ChangePriority.pas b/official/1.96/examples/windows/delphitools/toolhelpview/ChangePriority.pas new file mode 100644 index 0000000..02fe3a5 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/ChangePriority.pas @@ -0,0 +1,121 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 ChangePriority.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit ChangePriority; + +{$I JCL.INC} + +interface + +uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, + Buttons, ExtCtrls; + +type + TChangePriorityDlg = class(TForm) + OKBtn: TButton; + CancelBtn: TButton; + PriorityRadioGroup: TRadioGroup; + procedure FormCreate(Sender: TObject); + procedure OKBtnClick(Sender: TObject); + private + FProcessID: DWORD; + procedure SetProcessID(const Value: DWORD); + public + property ProcessID: DWORD write SetProcessID; + end; + +var + ChangePriorityDlg: TChangePriorityDlg; + +implementation + +{$R *.DFM} + +uses + ToolsUtils; + +resourcestring + sCantChange = 'Couldn''t change process priority'; + +{ TChangePriorityDlg } + +procedure TChangePriorityDlg.SetProcessID(const Value: DWORD); +var + Handle: THandle; + Priority: DWORD; + I: Integer; +begin + FProcessID := Value; + Handle := OpenProcess(PROCESS_ALL_ACCESS{PROCESS_QUERY_INFORMATION}, False, FProcessID); + if Handle <> 0 then + begin + Priority := GetPriorityClass(Handle); + CloseHandle(Handle); + end else Priority := 0; + I := PriorityRadioGroup.Items.IndexOfObject(Pointer(Priority)); + if I = -1 then I := 1; + PriorityRadioGroup.ItemIndex := I; +end; + +procedure TChangePriorityDlg.FormCreate(Sender: TObject); +begin + with PriorityRadioGroup.Items do + begin + BeginUpdate; + AddObject('&Idle', Pointer(IDLE_PRIORITY_CLASS)); + AddObject('&Normal', Pointer(NORMAL_PRIORITY_CLASS)); + AddObject('&High', Pointer(HIGH_PRIORITY_CLASS)); + AddObject('&Realtime', Pointer(REALTIME_PRIORITY_CLASS)); + EndUpdate; + end; +end; + +procedure TChangePriorityDlg.OKBtnClick(Sender: TObject); +var + Handle: THandle; + Priority: DWORD; + Res: Boolean; +begin + with PriorityRadioGroup do Priority := DWORD(Items.Objects[ItemIndex]); + Handle := OpenProcess(PROCESS_ALL_ACCESS{PROCESS_SET_INFORMATION}, False, FProcessID); + if Handle <> 0 then + begin + Res := SetPriorityClass(Handle, Priority); + CloseHandle(Handle); + end else Res := False; + if Res then + ModalResult := mrOk + else + MessBox(sCantChange, MB_ICONERROR); +end; + +// History: + +// $Log: ChangePriority.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/Global.dfm b/official/1.96/examples/windows/delphitools/toolhelpview/Global.dfm new file mode 100644 index 0000000..7933378 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/Global.dfm @@ -0,0 +1,1081 @@ +object GlobalModule: TGlobalModule + OldCreateOrder = False + OnCreate = DataModuleCreate + Left = 240 + Top = 203 + Height = 324 + Width = 481 + object ToolbarImagesList: TImageList + ShareImages = True + Left = 112 + Top = 8 + Bitmap = { + 494C01011A001D00040010001000FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000008000000001002000000000000080 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFFFF00000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000FF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000003F7F7F7F0000000000000000000000000000000000000000000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + FF00FFFFFFFFFFFFFFFFFFFFFFF7F8EBC9CD72A0A7099DA4009DA4009DA4009D + A4009DA4009DA4009DA4009DA4009DA4009DA4009DA4009DA4009DA4009DA400 + 9DA4009DA4009DA400A3A90FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF000000FF00000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF000000 + 0000FFFFFF00000000000000000000000000000000BFFFFFFF00000000BFFFFF + FF000000000000FFFF0000FFFF00000000000000000000000000000000000000 + FF00000000000000FF007F7F7F00000000000000003F7F7F7F000000FF000000 + 00000000FF00000000000000000000000000000000BFBFBFBF007F7F7FBFFFFF + FF00000000000000000000FF0000008000000080000000000000000000BFFFFF + FF007F7F7F3F7F7F7F00000000000000000000000000000000000000003F7F7F + 7F00000000000000FF0000000000000000000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000000000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF000000FF00000000000000 + 000000000000000000000000000000000000000000BFBFBFBF000000000000FF + 00000000000000FF00000080000000FF000000800000008000000000000000FF + 00000000003F7F7F7F0000000000000000000000000000000000000000000000 + 00007F7F7F00000000000000FF000000FF000000FF000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000000000BFFFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF00000000BFFFFF + FF000000000000FF000000FF000000FF000000FF000000800000000000BFFFFF + FF000000003F7F7F7F0000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF000000000000FF + 0000000000BFFFFFFF0000FF000000FF00000080000000FF00000000000000FF + 0000000000BFBFBFBF0000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBFBFFFFFFF00000000BFFFFFFF000000000000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000BFBFBFBF00BFBFBF3F7F7F7F007F7F7F3F7F7F7F00000000000000 + 000000000000000000000000000000000000000000BFFFFFFF007F7F7FBFFFFF + FF000000000000000000FFFFFFBFFFFFFF0000FF000000000000000000BFFFFF + FF007F7F7FBFBFBFBF00000000000000000000000000000000000000003F7F7F + 7F0000000000000000000000FF000000FF0000000000000000000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF0000000000000000000000000000FF + FF0000FFFF000000000000000000000000000000000000000000000000BFBFBF + BF00BFBFBF3F7F7F7F0000000000000000000000003F7F7F7F007F7F7F3F7F7F + 7F00000000000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000BFBFBF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF00000000000000000000000000000000000000000000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FFFF0000FFFF0000000000000000000000000000000000BFBFBFBFBFBF + BF00000000BFFFFFFF000000FFBFFFFFFF000000FFBFFFFFFF000000003F7F7F + 7F007F7F7F000000000000000000000000000000000000000000FFFFFFBFBFBF + BF00000000BFFFFFFF0000FF00BFFFFFFF0000FF00BFFFFFFF00000000BFBFBF + BF00BFBFBF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF000000 + 000000000000000000000000000000FFFF0000FFFF0000000000000000000000 + 00000000000000FFFF0000FFFF00000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 00007F7F7F000000000000000000000000000000000000000000000000BFFFFF + FF00BFBFBF3F7F7F7F0000000000000000000000003F7F7F7F00BFBFBFBFBFBF + BF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000000000000000000000 + 000000000000000000000000000000FFFF000000000000000000000000000000 + 000000000000000000000000000000FFFF00000000BFBFBFBF007F7F7FBFFFFF + FF0000000000000000000000FF00000080000000800000000000000000BFFFFF + FF007F7F7F3F7F7F7F0000000000000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00BFBFBFBFBFBFBF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000080000000000000000000FF + FF00008080000000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008000000000000000800000 + 0000000000800000000000000080000000000000008000000000000000800000 + 0000000000800000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000080000000000000000000FF + FF0000808000000000000000008000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBF00000000000000008000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000800000 + 0000000000800000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008000000000000000800000 + 00000000008000000000000000800000000000000080000000000000000000FF + FF0000808000000000000000000000000000BFBFBFBFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF0000000080000000000000008000000000000000000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000000000 + 0000000000800000000000000080000000007F7F7F3F7F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000008000000000000000800000 + 00000000008000000000000000000000000000000080000000000000000000FF + FF00008080000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000800000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000000000 + 8000000000800000000000000080000000000000003F7F7F7F007F7F7F3F7F7F + 7F00000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF0000000000FFFFFF000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 00000000000000000000FFFF00BFFFFF00000000008000000000000000000080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000080000000000000000000000000000080000000 + 8000000080000000800000008000000080000000800000008000000000000000 + 8000000080000000000000000080000000000000FFBFFFFFFF000000003F7F7F + 7F007F7F7F00000000000000000000000000000000000000000000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000FF000000FF000000 + FF000000003F7F7F7F007F7F7F3F7F7F7F000000008000000000000000000000 + 00007F7F7FBFBFBFBF0000000000000000000000000000000000000000000000 + 00007F7F7F000000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000080000000800000000080000000000000000000000000FFFFFF000000 + 00007F7F7F0000000000000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFFFF0000000000000000000000FF000000FF000000 + FF000000FF0000000000000000000000000000000000000000007F7F7FBFBFBF + BF00BFBFBFBFBFBFBF00000000000000000000000000000000007F7F7F3F7F7F + 7F007F7F7F0000000000000000800000000000000000000000007F7F7F000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFF + FF00000000000000800000008000000000000000003F7F7F7F00BFBFBFBFBFBF + BF007F7F7F3F7F7F7F00000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF0000000000000000007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000008000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFF + FF00FFFFFF00000000000000800000000000BFBFBFBFBFBFBF00000000000000 + 00000000000000000000000000000000000000000000FFFFFF0000000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + 00007F7F7F00000000007F7F7F0000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00000000BFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000008000000000000000000000 + 0000FFFFFFBFFFFFFF007F7F7F00000000000000000000000000000000BFBFBF + BF00BFBFBFBFFFFFFF0000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000007F7F7F00000000007F7F7F000000 + 00007F7F7F00000000007F7F7F0000000000000000000000FF00BFBFBF000000 + FF00BFBFBFBFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000008000000000000000800000 + 00000000000000000000000000BFBFBFBF00BFBFBFBFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFFFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008000000000000000800000 + 0000000000800000000000000080000000000000FF000000FF000000FFBFBFBF + BF00BFBFBFBFBFBFBF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F000000000000000080000000000000008000000000000000800000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000BFFFFFFF000000008000000000000000000000000000000000007F + 7F00007F7F00007F7F00007F7F00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBF00000000007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F00000000800000000000000080000000000000008000000000000000800000 + 00000000000000000000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00000000BFFFFFFF000000008000000000BFBFBF00BFBFBF0000000000007F + 7F0000FFFF00007F7F0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF0000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF00BFBFBF0000000000000000000000 + 0000000000800000000000000080000000000000008000000000000000800000 + 00000000000000000000FFFFFF00000000000000000000000000FFFFFFBFFFFF + FF000000000000000000000000800000000000000000000000000000000000FF + FF00007F7F0000FFFF00007F7F00000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF0000000000000000BFBFBFBF00BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF00BFBFBFBFBFBFBF000000003F7F7F7F00000000800000 + 0000000000800000000000000080000000000000008000000000000000800000 + 00000000000000000000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF00000000800000000000000080000000007F7F7F007F7F7F000000000000FF + FF0000FFFF00007F7F0000FFFF000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000000000 + 7F00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF00000000000000000000000000BFBFBFBFBFBF + BF00BFBFBFBFBFBFBF000000003F7F7F7F000000008000000000000000800000 + 0000000000800000000000000080000000000000008000000000000000800000 + 00000000000000000000FFFFFFBFFFFFFF007F7F7F0000000000000000000000 + 0000000000800000000000000080000000007F7F7F007F7F7F000000000000FF + FF0000FFFF0000FFFF00007F7F0000000000000000000000000000007F000000 + 7F0000007F0000007F0000007F0000007F0000007F0000007F00000000000000 + 7F0000007F000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00000000000000008000000000000000000000 + 00000000003F7F7F7F0000000080000000000000008000000000000000800000 + 0000000000800000000000000080000000000000008000000000000000800000 + 0000000000800000000000000000000000000000008000000000000000800000 + 00000000008000000000000000800000000000000000000000000000000000FF + FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000007F0000007F0000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000000000000000000000 + 000000000000000000000000000000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF000000 + 00007F7F7F3F7F7F7F007F7F7F0000FFFF0000FFFF3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F0000FFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000BFBFBFBF00BFBFBF3F7F7F7F007F7F7F3F7F7F7F00000000000000 + 0000000000000000000000000000000000000000003F7F7F7F000000003F7F7F + 7F00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000BFBFBF + BF00BFBFBF3F7F7F7F0000000000000000000000003F7F7F7F007F7F7F3F7F7F + 7F000000000000000000000000000000000000000000000000000000FF000000 + 00007F7F7F000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000003F7F7F7F0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBFBFBFBF + BF00000000BFFFFFFF0000FF00BFFFFFFF0000FF00BFFFFFFF000000003F7F7F + 7F007F7F7F000000000000000000000000000000003F7F7F7F00000000000000 + FF000000003F7F7F7F0000000000000000000000003F7F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000003F7F7F7F0000000000000000007F7F7F0000000000000000000000 + 00000000003F7F7F7F0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 00007F7F7F0000000000000000000000000000000000000000007F7F7F000000 + 00000000FF00000000007F7F7F00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000000000BFFFFFFF000000000000000000000000BFFFFF + FF000000003F7F7F7F0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFBFBFBF007F7F7FBFFFFF + FF00000000000000000000FF0000008000000080000000000000000000BFFFFF + FF007F7F7F3F7F7F7F00000000000000000000000000000000000000003F7F7F + 7F00000000000000FF0000000000000000000000FF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000003F7F7F7F0000000000000000000000000000000000000000000000 + 00007F7F7F000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFBFBFBF000000000000FF + 00000000000000FF00000080000000FF000000800000008000000000000000FF + 00000000003F7F7F7F0000000000000000000000000000000000000000000000 + 00007F7F7F00000000000000FF000000FF000000FF000000FF00000000000000 + 00000000000000000000000000000000000000FFFF0000FFFF0000FFFF000000 + 0000FFFFFF00000000000000000000000000000000BFFFFFFF00000000BFFFFF + FF000000000000FFFF0000FFFF00000000000000003F7F7F7F00000000000000 + 00007F7F7F000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF00000000BFFFFF + FF000000000000FF000000FF000000FF000000FF000000800000000000BFFFFF + FF000000003F7F7F7F0000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFF + FF000000000000FFFF0000FFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF000000000000FF + 0000000000BFFFFFFF0000FF000000FF00000080000000FF00000000000000FF + 0000000000BFBFBFBF0000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF000000FF000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000000000BFFFFFFF000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000003F7F7F + 7F00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000BFFFFFFF007F7F7FBFFFFF + FF000000000000000000FFFFFFBFFFFFFF0000FF000000000000000000BFFFFF + FF007F7F7FBFBFBFBF00000000000000000000000000000000000000003F7F7F + 7F0000000000000000000000FF000000FF000000FF000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00000000BFFFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000BFBFBF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000FF000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBFBFFFFFFF00000000BFFFFFFF000000000000FF + FF00000000000000000000000000000000000000000000000000000000000000 + FF007F7F7F0000000000000000000000000000000000000000000000003F7F7F + 7F000000FF000000000000000000000000000000000000000000FFFFFFBFBFBF + BF00000000BFFFFFFF0000FF00BFFFFFFF0000FF00BFFFFFFF00000000BFBFBF + BF00BFBFBF000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFFBFFFFFFF00FFFFFFBFFFFFFF0000000000000000000000000000FF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF00000000000000000000000000000000000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000BFFFFF + FF00BFBFBF3F7F7F7F0000000000000000000000003F7F7F7F00BFBFBFBFBFBF + BF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF00000000000000000000000000000000000000000000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FFFF0000FFFF0000000000000000000000000000000000000000000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00BFBFBFBFBFBFBF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF000000 + 000000000000000000000000000000FFFF0000FFFF0000000000000000000000 + 00000000000000FFFF0000FFFF00000000000000000000000000000000000000 + FF00000000000000FF007F7F7F00000000000000003F7F7F7F000000FF000000 + 00000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000000000000000000000 + 000000000000000000000000000000FFFF000000000000000000000000000000 + 000000000000000000000000000000FFFF000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008000000000000000800000 + 0000000000800000000000000080000000000000008000000000000000000000 + 0000000000000000000000000080000000000000008000000000000000800000 + 0000000000800000000000000080000000000000008000000000000000800000 + 0000000000800000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000008000000000000000800000 + 00000000008000000000000000000000000000000080000000000000000000FF + FF0000FFFF0000FFFF0000000080000000000000008000000000000000800000 + 0000000000000000000000000000000000000000000000000000000000800000 + 0000000000800000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF0000000000FFFFFF000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 00000000000000000000FFFF00BFFFFF0000FFFF000000000000000000000000 + 00007F7F7F3F7F7F7F007F7F7F00000000000000008000000000000000000000 + 0000000000BFBFBFBF00BFBFBF3F7F7F7F007F7F7F3F7F7F7F00000000000000 + 0000000000800000000000000080000000000000000000000000000000000000 + 0000000000BFBFBFBF00BFBFBF3F7F7F7F007F7F7F3F7F7F7F00000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000FF000000FF000000 + FF000000003F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F7F007F7F7F3F7F7F + 7F007F7F7F0000000000FFFFFF00000000000000008000000000000000BFBFBF + BF00BFBFBF3F7F7F7F0000000000000000000000003F7F7F7F007F7F7F3F7F7F + 7F00000000800000000000000080000000000000000000000000000000BFBFBF + BF00BFBFBF3F7F7F7F0000000000000000000000003F7F7F7F007F7F7F3F7F7F + 7F000000000000000000000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFFFF0000000000000000000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000BFBFBFBFBFBF + BF00000000BFFFFFFF0000FFFFBFFFFFFF0000FFFFBFFFFFFF000000003F7F7F + 7F007F7F7F000000000000000080000000000000000000000000BFBFBFBFBFBF + BF00000000BFFFFFFF000000FFBFFFFFFF000000FFBFFFFFFF000000003F7F7F + 7F007F7F7F0000000000000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 00007F7F7F000000000000000080000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 00007F7F7F0000000000000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF000000000000000000000000000000 + 00000000000000000000FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000BFBFBFBF007F7F7FBFFFFF + FF00000000000000000000FFFF00008080000080800000000000000000BFFFFF + FF007F7F7F3F7F7F7F000000008000000000000000BFBFBFBF007F7F7FBFFFFF + FF0000000000000000000000FF00000080000000800000000000000000BFFFFF + FF007F7F7F3F7F7F7F00000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000BFBFBFBF000000000000FF + FF000000000000FFFF000080800000FFFF0000808000008080000000000000FF + FF000000003F7F7F7F000000008000000000000000BFBFBFBF00000000000000 + FF00000000000000FF00000080000000FF000000800000008000000000000000 + FF000000003F7F7F7F00000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000000000BFFFFFFF007F7F7F3F7F7F + 7F00FFFFFF3F7F7F7F007F7F7FBFFFFFFF007F7F7FBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000BFFFFFFF00000000BFFFFF + FF000000000000FFFF0000FFFF0000FFFF0000FFFF0000808000000000BFFFFF + FF000000003F7F7F7F000000008000000000000000BFFFFFFF00000000BFFFFF + FF00000000000000FF000000FF000000FF000000FF0000008000000000BFFFFF + FF000000003F7F7F7F00000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000000000000000000000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000BFFFFFFF000000000000FF + FF00000000BFFFFFFF0000FFFF0000FFFF000080800000FFFF000000000000FF + FF00000000BFBFBFBF000000008000000000000000BFFFFFFF00000000000000 + FF00000000BFFFFFFF000000FF000000FF00000080000000FF00000000000000 + FF00000000BFBFBFBF00000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF000000000000000000FFFFFF00FFFF + FF0000000000FFFFFF000000000000000000000000BFFFFFFF007F7F7F3F7F7F + 7F00FFFFFF3F7F7F7F007F7F7F3F7F7F7F00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000000000BFFFFFFF007F7F7FBFFFFF + FF000000000000000000FFFFFFBFFFFFFF0000FFFF0000000000000000BFFFFF + FF007F7F7FBFBFBFBF000000008000000000000000BFFFFFFF007F7F7FBFFFFF + FF000000000000000000FFFFFFBFFFFFFF000000FF0000000000000000BFFFFF + FF007F7F7FBFBFBFBF00000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000000000000000000000000000000000BFFFFFFF00FFFFFFBFFFFF + FF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFFBFFFFFFF00FFFFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000BFBFBF000000000000000080000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 0000BFBFBF0000000000000000000000000000000000FFFFFF0000000000FFFF + FF0000000000FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000 + 0000FFFFFF000000000000000080000000000000000000000000FFFFFFBFBFBF + BF00000000BFFFFFFF0000FFFFBFFFFFFF0000FFFFBFFFFFFF00000000BFBFBF + BF00BFBFBF000000000000000080000000000000000000000000FFFFFFBFBFBF + BF00000000BFFFFFFF000000FFBFFFFFFF000000FFBFFFFFFF00000000BFBFBF + BF00BFBFBF0000000000000000000000000000000000FFFFFF0000000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000080000000000000008000000000000000BFFFFF + FF00BFBFBF3F7F7F7F0000000000000000000000003F7F7F7F00BFBFBFBFBFBF + BF00000000800000000000000080000000000000000000000000000000BFFFFF + FF00BFBFBF3F7F7F7F0000000000000000000000003F7F7F7F00BFBFBFBFBFBF + BF000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000007F7F7F00000000007F7F7F000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000800000000000000080000000000000008000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00BFBFBFBFBFBFBF00000000000000 + 0000000000800000000000000080000000000000000000000000000000000000 + 0000000000BFFFFFFF00FFFFFFBFFFFFFF00BFBFBFBFBFBFBF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000008000000000000000800000 + 0000000000800000000000000080000000000000008000000000000000800000 + 0000000000000000000000000080000000000000008000000000000000800000 + 0000000000000000000000000000000000000000000000000000000000800000 + 0000000000800000000000000080000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000000000000000000000000000000000FFFF000000 + 00007F7F7F007F7F7F000000000000000000000000000000000000000000007F + 7F00007F7F00007F7F00007F7F00000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000BFBFBF0000000000000000000000 + 00000000FF00000000000000000000000000000000000000000000FFFF000000 + 00007F7F7F0000000000BFBFBF00BFBFBF00BFBFBF00BFBFBF0000000000007F + 7F0000FFFF00007F7F0000FFFF000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000000000 + 7F00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000007F7F7F00000000007F7F7F00BFBFBF007F7F7F00000000000000 + 00000000000000000000000000000000FF00000000000000000000FFFF000000 + 00007F7F7F007F7F7F00000000000000000000000000000000000000000000FF + FF00007F7F0000FFFF00007F7F0000000000000000000000000000007F000000 + 7F0000007F0000007F0000007F0000007F0000007F0000007F00000000000000 + 7F0000007F000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F007F7F7F0000000000BFBFBF00BFBFBF00BFBFBF00000000000000 + 000000000000000000000000FF0000000000000000000000000000FFFF000000 + 00007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F000000000000FF + FF0000FFFF00007F7F0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000007F0000007F0000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF000000000000FFFF000000000000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F007F7F7F0000000000BFBFBF00BFBFBF00BFBFBF00000000000000 + 0000000000000000FF000000000000000000000000000000000000FFFF000000 + 00007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F000000000000FF + FF0000FFFF0000FFFF00007F7F000000000000000000000000007F7F7F000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFF + FF000000000000007F0000007F00000000000000000000000000000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000007F7F + 7F007F7F7F007F7F7F000000000000000000BFBFBF00BFBFBF00000000000000 + 00000000FF00000000000000000000000000000000000000000000FFFF000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFF + FF00000000000000000000007F00000000000000000000000000000000000000 + 000000FFFF000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF000000 + 000000000000000000000000000000000000000000007F7F7F0000000000BFBF + BF00BFBFBF00BFBFBF0000000000BFBFBF0000000000BFBFBF007F7F7F000000 + 000000000000000000000000000000000000000000000000000000FFFF000000 + 000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000000000FF + FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF007F7F7F0000000000000000000000000000000000FFFF + FF0000000000FFFFFF0000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF000000 + 000000000000000000000000000000000000000000007F7F7F00000000007F7F + 7F007F7F7F007F7F7F0000000000BFBFBF0000000000BFBFBF007F7F7F000000 + 00000000FF000000FF000000FF000000FF00000000000000000000FFFF000000 + 000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000000000FF + FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF0000000000000000000000000000000000000000000000 + 000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF000000 + 00000000000000000000000000000000000000000000BFBFBF0000000000BFBF + BF00BFBFBF00BFBFBF0000000000BFBFBF0000000000BFBFBF007F7F7F000000 + 000000000000000000000000000000000000000000000000000000FFFF000000 + 000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000000000FF + FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF007F7F7F0000000000000000000000 + 000000000000FFFFFF0000000000000000000000000000000000000000000000 + 00000000000000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 000000000000000000000000000000000000000000000000000000000000BFBF + BF00BFBFBF00BFBFBF000000000000000000BFBFBF00BFBFBF00000000000000 + 00000000FF00000000000000000000000000000000000000000000FFFF000000 + 00007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F000000000000FF + FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000BFBFBF00BFBFBF00000000007F7F7F00BFBFBF00BFBFBF00000000000000 + 0000000000000000FF000000000000000000000000000000000000FFFF000000 + 000000000000FFFFFF0000000000FFFFFF0000000000FFFFFF000000000000FF + FF0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF00FFFFFF007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000BFBFBF00BFBFBF00000000007F7F7F007F7F7F00BFBFBF00000000000000 + 000000000000000000000000FF00000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000007F + 7F0000FFFF0000FFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BFBFBF007F7F7F007F7F7F007F7F7F007F7F7F00000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF00007F7F0000FFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000BFBFBF00000000007F7F7F0000000000000000000000 + 00000000FF000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000007F + 7F0000FFFF00007F7F0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F0000007F0000007F0000007F00 + 00007F0000007F00000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F000000FF000000FF00 + 0000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF00 + 0000FF0000007F00000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F0000007F0000007F00 + 0000BFBFBF00BFBFBF0000007F0000FFFF0000007F00BFBFBF00BFBFBF007F00 + 00007F0000007F00000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF0000000000FFFF0000000000000000000000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000BFBFBF00BFBFBF00BFBFBF0000007F00FFFFFF00FFFFFF007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F007F7F + 7F0000000000000000007F7F7F0000000000FFFF00000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000BFBFBF00BFBFBF00BFBFBF0000FFFF00FFFFFF007F7F7F007F7F7F000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F007F7F7F0000FFFF0000000000FFFF000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FF000000FF000000FF00000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BFBFBF00BFBFBF0000007F00FFFFFF007F7F7F00000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F0000FFFF0000FFFF0000000000FFFF00000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000BFBFBF0000FFFF007F7F7F0000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF00000000000000000000000000FFFFFF0000000000000000000000 + 00000000FF0000000000000000007F7F7F00FFFF000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF0000000000000000000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000BFBFBF000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF000000000000000000FFFF00000000000000FFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF000000000000000000000000000000 + 000000000000000000000000000000000000000000007F7F7F0000FFFF007F7F + 7F00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000007F00FFFFFF0000007F0000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF000000000000000000000000000000000000FF + FF00FFFFFF0000FFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000007F0000FFFF0000007F00FFFFFF0000007F00000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF000000000000000000000000007F7F7F0000FFFF007F7F + 7F00000000000000000000000000000000000000000000000000000000000000 + 0000BFBFBF00BFBFBF0000007F0000FFFF00FFFFFF0000FFFF007F7F7F000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000BFBFBF00BFBFBF00BFBFBF00BFBFBF0000007F00FFFFFF007F7F7F000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F0000007F0000007F00 + 0000BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F00 + 00007F0000007F000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F000000FF000000FF00 + 0000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF00 + 0000FF0000007F000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F0000007F0000007F0000007F00 + 00007F0000007F00000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FF000000FF000000FF000000FF000000FF000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00000000000000000000000000FFFFFF0000000000FFFF + FF000000000000000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 000000000000000000000000000000000000FF000000FF000000FF000000FF00 + 0000FF000000FF000000BFBFBF0000000000BFBFBF00FF000000FF000000FF00 + 0000FF000000FF000000FF000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00BFBFBF00000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF00BFBFBF00BFBFBF00000000007F7F7F0000000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF000000000000000000FFFFFF000000000000000000FFFF + FF000000000000000000FFFFFF00000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F00000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000007F7F + 7F007F7F7F0000000000FFFFFF007F7F7F00FFFFFF00000000007F7F7F007F7F + 7F0000000000FFFFFF0000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF00000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000007F7F7F0000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000007F7F7F00000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000007F7F7F0000000000FFFFFF000000 + 00000000000000000000FFFFFF007F7F7F00FFFFFF0000000000000000000000 + 0000FFFFFF00000000007F7F7F00000000000000000000000000000000000000 + 0000FFFFFF0000FFFF000000000000000000FFFFFF0000000000FFFFFF000000 + 0000FFFFFF00FFFFFF00FFFFFF000000000000000000FF000000FF000000FF00 + 0000FF000000FF00000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00000000000000000000000000000000000000000000000000FFFF + FF0000FFFF000000000000FFFF00FFFFFF0000000000FFFFFF0000FFFF000000 + 0000FFFFFF0000000000FFFFFF00000000000000000000000000FF000000FF00 + 0000FF0000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000007F7F7F000000000000000000000000007F7F7F0000000000FFFF + FF000000000000000000FFFFFF007F7F7F00FFFFFF000000000000000000FFFF + FF00000000007F7F7F0000000000000000000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000000000FFFFFF0000FFFF0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000000000000000FF00 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000007F7F7F0000000000000000007F7F7F0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00000000007F7F7F000000000000000000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000FFFFFF0000FFFF0000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 000000000000000000007F7F7F0000FFFF007F7F7F0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF0000000000FFFFFF00FFFFFF00FFFF + FF0000000000000000000000000000000000000000000000FF000000FF000000 + FF00000000000000000000FFFF0000FFFF0000FFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF00000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00000000000000000000000000FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF0000000000000000000000FF000000FF000000 + FF0000000000000000007F7F7F0000FFFF007F7F7F0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000007F7F7F000000000000000000000000007F7F7F000000 + 000000000000000000007F7F7F00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF0000FFFF00000000000000FF + FF00FFFFFF0000FFFF000000000000FFFF00FFFFFF0000FFFF0000000000FFFF + FF0000000000FFFFFF000000000000000000000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000007F7F7F0000000000000000000000000000000000000000000000 + 0000000000007F7F7F0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF0000FFFF0000FFFF00000000 + 000000FFFF00FFFFFF0000FFFF00FFFFFF000000000000000000FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + 00007F7F7F007F7F7F0000000000000000000000000000000000000000000000 + 7F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000BFBFBF00BFBFBF0000000000000000000000000000000000000000000000 + 7F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF0000000000BFBFBF00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF00BFBFBF00BFBFBF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF0000000000BFBFBF00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF0000000000BFBFBF00000000007F7F7F000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF00000000007F7F7F00000000007F7F7F000000 + 000000000000000000000000000000000000000000007F7F7F000000FF000000 + FF0000000000000000000000FF000000FF000000FF0000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000BFBFBF0000000000FF000000FF000000FF00 + 00000000FF00FF000000FF000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF0000000000BFBFBF00000000007F7F7F000000 + 0000000000000000000000000000000000007F7F7F000000FF00000000000000 + 00000000000000000000000000000000FF000000FF0000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF0000000000BFBFBF00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF00000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 7F0000007F0000007F0000FFFF000000000000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00007F7F7F00000000007F7F7F00000000007F7F7F00000000007F7F7F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000FF000000FF00000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FF000000FF000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 7F0000007F0000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000000000000000000000000000000000000000000000000000000000FFFF + FF00BFBFBF00BFBFBF00BFBFBF007F7F7F007F7F7F007F7F7F007F7F7F007F7F + 7F00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 7F00FFFF000000007F000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000007F7F + 7F000000FF0000000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 7F00FFFF0000FFFF00000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000007F7F7F007F7F7F007F7F7F0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000004000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000800000000100010000000000000400000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF00 + 0000000000FFFF0000007F0000007F000000000000007F000000000000000000 + FFFFFF40FFFFFF40FFFFFF40FFFFFF4000000040FFFFFF400000FF400000FF40 + FFFFFF400000FF40FFFFFF40FFFFFF40C380FFFFFFFFFF40C300E01FFFFFFF40 + C201C00F00000000C003800700000000C003000300000000C00300010000FF00 + 00038000000000000003C000000000000003E000000000000003F00000000000 + 0003F801000000000007F80100000000000FF80100000000003FF80700000000 + 80FFF80700000000C3FFFC7F00000000FFFFFFFFFF7EFFFFF83FFFFF9001FFFF + E00F8FFFC0032020C00787FFE0037271800383BFE00303038003C13FE003A723 + 0001E03FE003A7A70001F01F000187870001F81F8000CF8F0001F00FE007CFCF + 0001E00FE00FFFFF8003FC07E00FE7E78003FF07E027E3C7C007FFC3C073E7E7 + E00FFFF39E79E997F83FFFFF7EFEFC3FFC00FFE3FFFFFFFFF000FC41F83FF83F + C0008800E00FE00F00000000C007C00700000000800380030000000080038003 + 0000000000010001000000000001000100000000000100010000000000010001 + 000100000001000100030000800380030007000180038003001F0001C007C007 + 007F000DE00FE00F01FFD553F83FF83FFFFFFDFFFFFF8FC0E01FF8FFFC7B8000 + C00FF8FFF83780008007F87FF03E00000003F81FE01D80000001F80FE01B8000 + 8000F00F80178000C000E00F001F8A80E000E00F00108A80F000E00F001F8A80 + F801F01F80178000FC01F00FE01B8A80FE01F00FE01D8FC0FF1FF007F03EFFC0 + FFFFF007F837FFC0FFFFF007FC7BFFC0FFFFFC00FFFFFFFF8003FC00FFF8F83F + 8003FC0020F8E7CF8003FC00007FDFF7E00F0000007CB01BE00F0000003CB83B + F01F0000000F7C7DF83F000000047E8DFC7F0023000C4105F83F000101FF4105 + F01F0000E3FC4105E00F0023FFFC818BE00F0063FFFF81FB800300C3FFF8DFF7 + 80030107FFF8E7CF800303FFFFFFF83FFE7FFC7FFFFFF000FE1FF83FFFFFF000 + FC07F01FF83FF000FC01F01F0001F000F800F01F0001F000F800F01F0001F000 + 0000F01F0001F0000000F01F0001E0000001F83F8003C0000032FEC380038000 + 003EFEB980038000003EFF7DC1070000003EFF3DE38F0000001DFC99FFFF0001 + 0023F9C3FFFF0003003FF3FFFFFF0007C007E00FFFFFFF00C007E00FFFFFFF00 + C007E00FF9FFFF00C007E00FF0FFFF00C007E00FF0FF0000C007E00FE07F0000 + C007E00FC07F0000C007A00B843F0000C007C0071E3F0023C007E00FFE1F0001 + C007E00FFF1F0000C007C007FF8F0023C007C007FFC70063C007C007FFE300C3 + C007F83FFFF80107C007F83FFFFF03FF} + end + object SaveDialog: TSaveDialog + DefaultExt = 'txt' + Filter = 'Text file (*.txt)|*.txt' + Left = 24 + Top = 8 + end +end diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/Global.pas b/official/1.96/examples/windows/delphitools/toolhelpview/Global.pas new file mode 100644 index 0000000..9fc133d --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/Global.pas @@ -0,0 +1,139 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 Global.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit Global; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, ImgList; + +type + TGlobalModule = class(TDataModule) + ToolbarImagesList: TImageList; + SaveDialog: TSaveDialog; + procedure DataModuleCreate(Sender: TObject); + private + FPeViewer: Variant; + FPeViewerRegistred: Boolean; + public + function ExecuteSaveDialog(var FileName: TFileName): Boolean; + procedure ListViewToClipboard(ListView: TListView); + procedure ListViewToFile(ListView: TListView; const FileName: TFileName); + procedure ViewPE(const FileName: TFileName); + property PeViewerRegistred: Boolean read FPeViewerRegistred; + end; + +var + GlobalModule: TGlobalModule; + +implementation + +{$R *.DFM} + +uses + ClipBrd, ToolsUtils, JclSysInfo; + +resourcestring + sWrongWindowsVersion = 'This application is intended for Windows 95/98/2000 only'; + +procedure CheckWindowsVersion; +begin + if IsWinNT4 then + begin + MessageBox(0, PChar(sWrongWindowsVersion), nil, MB_OK or MB_ICONERROR); + Halt(0); + end; +end; + +{ TGlobalModule } + +procedure TGlobalModule.ListViewToClipboard(ListView: TListView); +var + S: TStringList; +begin + S := TStringList.Create; + Screen.Cursor := crHourGlass; + try + ListViewToStrings(ListView, S, ListView.MultiSelect); + Clipboard.AsText := S.Text; + finally + S.Free; + Screen.Cursor := crDefault; + end; +end; + +procedure TGlobalModule.ListViewToFile(ListView: TListView; const FileName: TFileName); +var + S: TStringList; +begin + SaveDialog.FileName := ChangeFileExt(FileName, ''); + if SaveDialog.Execute then + begin + S := TStringList.Create; + Screen.Cursor := crHourGlass; + try + ListViewToStrings(ListView, S, ListView.MultiSelect); + S.SaveToFile(SaveDialog.FileName); + finally + S.Free; + Screen.Cursor := crDefault; + end; + end; +end; + +function TGlobalModule.ExecuteSaveDialog(var FileName: TFileName): Boolean; +begin + SaveDialog.FileName := ChangeFileExt(FileName, ''); + Result := SaveDialog.Execute; + if Result then FileName := SaveDialog.FileName; +end; + +procedure TGlobalModule.DataModuleCreate(Sender: TObject); +begin + FPeViewerRegistred := IsPeViewerRegistred; +end; + +procedure TGlobalModule.ViewPE(const FileName: TFileName); +begin + FPeViewer := CreateOrGetOleObject(PeViewerClassName); + FPeViewer.OpenFile(FileName); + FPeViewer.BringToFront; +end; + +initialization + CheckWindowsVersion; + +// History: + +// $Log: Global.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/HeapDump.dfm b/official/1.96/examples/windows/delphitools/toolhelpview/HeapDump.dfm new file mode 100644 index 0000000..8707fd7 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/HeapDump.dfm @@ -0,0 +1,235 @@ +inherited HeapDumpForm: THeapDumpForm + Left = 239 + Top = 152 + Width = 482 + Height = 380 + Caption = 'HeapDumpForm' + OldCreateOrder = True + PixelsPerInch = 96 + TextHeight = 13 + object Splitter2: TSplitter [0] + Left = 0 + Top = 281 + Width = 474 + Height = 3 + Cursor = crVSplit + Align = alBottom + AutoSnap = False + ResizeStyle = rsUpdate + end + object StatusBar: TStatusBar [1] + Left = 0 + Top = 334 + Width = 474 + Height = 19 + Panels = < + item + Width = 90 + end + item + Width = 90 + end + item + Width = 90 + end + item + Width = 90 + end> + SimplePanel = False + OnResize = StatusBarResize + end + object Panel1: TPanel [2] + Left = 0 + Top = 26 + Width = 474 + Height = 255 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object Splitter1: TSplitter + Left = 137 + Top = 0 + Width = 3 + Height = 255 + Cursor = crHSplit + AutoSnap = False + ResizeStyle = rsUpdate + end + object HeapListView: TListView + Tag = 1 + Left = 0 + Top = 0 + Width = 137 + Height = 255 + Align = alLeft + AllocBy = 16 + Columns = < + item + Caption = 'HID' + Width = 70 + end + item + Caption = 'Flags' + Width = 60 + end> + HideSelection = False + ReadOnly = True + RowSelect = True + PopupMenu = PopupMenu + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = HeapListViewColumnClick + OnCompare = HeapListViewCompare + OnSelectItem = HeapListViewSelectItem + end + object HeapEntryListView: TListView + Left = 140 + Top = 0 + Width = 334 + Height = 255 + Align = alClient + AllocBy = 128 + Columns = < + item + Caption = 'Handle' + Width = 70 + end + item + Caption = 'Start Adress' + Width = 70 + end + item + Alignment = taRightJustify + Caption = 'BlockSize' + Width = 70 + end + item + Caption = 'End Adress' + Width = 70 + end + item + Caption = 'Flags' + Width = 65 + end + item + Alignment = taRightJustify + Caption = 'Lock Count' + Width = 70 + end> + ColumnClick = False + HideSelection = False + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + PopupMenu = PopupMenu + TabOrder = 1 + ViewStyle = vsReport + OnData = HeapEntryListViewData + OnSelectItem = HeapEntryListViewSelectItem + end + end + object HeapEntryMemo: TMemo [3] + Left = 0 + Top = 284 + Width = 474 + Height = 50 + Align = alBottom + PopupMenu = PopupMenu + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 2 + end + inherited CoolBar: TCoolBar + Width = 474 + Bands = < + item + Control = ToolBar + ImageIndex = -1 + MinHeight = 22 + Width = 470 + end> + inherited ToolBar: TToolBar + Width = 457 + object ToolButton5: TToolButton + Left = 0 + Top = 0 + Action = Refresh1 + end + object ToolButton6: TToolButton + Left = 23 + Top = 0 + Width = 8 + Caption = 'ToolButton6' + ImageIndex = 1 + Style = tbsSeparator + end + object ToolButton7: TToolButton + Left = 31 + Top = 0 + Action = Copy1 + end + object ToolButton8: TToolButton + Left = 54 + Top = 0 + Action = SaveToFile1 + end + object ToolButton3: TToolButton + Left = 77 + Top = 0 + Action = Find1 + end + object ToolButton1: TToolButton + Left = 100 + Top = 0 + Width = 8 + Caption = 'ToolButton1' + ImageIndex = 4 + Style = tbsSeparator + end + object ToolButton2: TToolButton + Left = 108 + Top = 0 + Action = SelectAll1 + end + end + end + inherited ActionList: TActionList + Top = 296 + inherited Refresh1: TAction + OnExecute = Refresh1Execute + end + end + inherited PopupMenu: TPopupMenu + Top = 296 + object Refresh2: TMenuItem + Caption = 'Refresh' + Hint = 'Refresh HeapList' + ImageIndex = 2 + ShortCut = 116 + OnClick = Refresh1Execute + end + object N1: TMenuItem + Caption = '-' + end + object Copy2: TMenuItem + Caption = 'Copy' + Hint = 'Copy to clipboard' + ImageIndex = 9 + ShortCut = 16451 + end + object Save1: TMenuItem + Caption = 'Save' + Hint = 'Save to text file' + ImageIndex = 3 + ShortCut = 16467 + end + object N2: TMenuItem + Caption = '-' + end + object Selectall2: TMenuItem + Action = SelectAll1 + end + end +end diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/HeapDump.pas b/official/1.96/examples/windows/delphitools/toolhelpview/HeapDump.pas new file mode 100644 index 0000000..6017f8a --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/HeapDump.pas @@ -0,0 +1,341 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 HeadDump.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit HeapDump; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, ExtCtrls, StdCtrls, ToolWin, ActnList, ClipBrd, Menus, + TLHelp32, ViewTemplate; + +type + THeapDumpForm = class(TViewForm) + StatusBar: TStatusBar; + Panel1: TPanel; + HeapListView: TListView; + Splitter1: TSplitter; + HeapEntryListView: TListView; + Splitter2: TSplitter; + HeapEntryMemo: TMemo; + ToolButton5: TToolButton; + ToolButton6: TToolButton; + ToolButton7: TToolButton; + ToolButton8: TToolButton; + Refresh2: TMenuItem; + N1: TMenuItem; + Copy2: TMenuItem; + Save1: TMenuItem; + ToolButton1: TToolButton; + ToolButton2: TToolButton; + N2: TMenuItem; + Selectall2: TMenuItem; + ToolButton3: TToolButton; + procedure HeapListViewColumnClick(Sender: TObject; + Column: TListColumn); + procedure HeapListViewCompare(Sender: TObject; Item1, Item2: TListItem; + Data: Integer; var Compare: Integer); + procedure StatusBarResize(Sender: TObject); + procedure Refresh1Execute(Sender: TObject); + procedure HeapEntryListViewData(Sender: TObject; Item: TListItem); + procedure HeapEntryListViewSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure HeapListViewSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + private + FProcessID: DWORD; + FFileName: TFileName; + FreeSum, FixedSum, MoveableSum: Integer; + FHeapEntries: array of THeapEntry32; + procedure BuildHeapList; + procedure BuildHeapEntriesList(HeapID: DWORD); + procedure UpdateStatusLine; + procedure ReadHeapEntry(Item: TListItem); + public + procedure BuildContent; override; + procedure SetParams(ProcessID: DWORD; const FileName: TFileName); + end; + +var + HeapDumpForm: THeapDumpForm; + +implementation + +{$R *.DFM} + +uses + Global, Main, ToolsUtils; + +resourcestring + sCaption = 'HeapList - %s'; + sCountStatus = 'Heap Entries: %d'; + sFixedStatus = 'Fixed: %0.n'; + sFreeStatus = 'Free: %0.n'; + sMoveableStatus = 'Moveable: %0.n'; + sPressEscape = 'Press to cancel enumerating heap items ...'; + +{ THeapDumpForm } + +procedure THeapDumpForm.BuildHeapEntriesList(HeapID: DWORD); +var + Next: Boolean; + HeapEntry: THeapEntry32; + EntriesCount: Integer; +begin + with HeapEntryListView do + begin + Items.BeginUpdate; + Screen.Cursor := crHourGlass; + try + HeapEntryMemo.Font.Style := [fsBold]; + HeapEntryMemo.Text := sPressEscape; + Items.Count := 0; + EntriesCount := 0; + SetLength(FHeapEntries, 0); + FreeSum := 0; + FixedSum := 0; + MoveableSum := 0; + HeapEntry.dwSize := Sizeof(HeapEntry); + Next := Heap32First(HeapEntry, FProcessID, HeapID); + while Next do + begin + SetLength(FHeapEntries, EntriesCount + 1); + FHeapEntries[EntriesCount] := HeapEntry; + with HeapEntry do + case dwFlags of + LF32_FIXED: + Inc(FixedSum, dwBlockSize); + LF32_FREE: + Inc(FreeSum, dwBlockSize); + LF32_MOVEABLE: + Inc(MoveableSum, dwBlockSize); + end; + Inc(EntriesCount); + if EntriesCount mod 200 = 0 then + begin + UpdateStatusLine; + if GetAsyncKeyState(VK_ESCAPE) and $8000 <> 0 then Break; + end; + Next := Heap32Next(HeapEntry); + end; + Items.Count := EntriesCount; + if Items.Count > 0 then + begin + AlphaSort; + ItemFocused := Items[0]; + ItemFocused.Selected := True; + end; + UpdateStatusLine; + HeapEntryMemo.ParentFont := True; + finally + Items.EndUpdate; + Screen.Cursor := crDefault; + end; + end; +end; + +procedure THeapDumpForm.BuildHeapList; +var + SnapProcHandle: THandle; + HeapList: THeapList32; + Next: Boolean; +begin + with HeapListView do + begin + Items.BeginUpdate; + try + Items.Clear; + SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPHEAPLIST, FProcessID); + if SnapProcHandle <> THandle(-1) then + begin + HeapList.dwSize := Sizeof(HeapList); + Next := Heap32ListFirst(SnapProcHandle, HeapList); + while Next do + begin + with Items.Add do + begin + Caption := Format('%.8x', [HeapList.th32HeapID]); + Data := Pointer(HeapList.th32HeapID); + case HeapList.dwFlags of + HF32_DEFAULT: + SubItems.Add('Default'); + HF32_SHARED: + SubItems.Add('Shared'); + else + SubItems.Add('Normal'); + end; + end; + Next := Heap32ListNext(SnapProcHandle, HeapList); + end; + CloseHandle(SnapProcHandle); + end; + if Items.Count > 0 then + begin + AlphaSort; + ItemFocused := Items[0]; + ItemFocused.Selected := True; + end else + begin + BuildHeapEntriesList(0); + HeapEntryMemo.Lines.Clear; + end; + finally + Items.EndUpdate; + end; + end; +end; + +procedure THeapDumpForm.SetParams(ProcessID: DWORD; const FileName: TFileName); +begin + FProcessID := ProcessID; + FFileName := FileName; + Caption := Format(sCaption, [FFileName]); + PostBuildContentMessage; +end; + +procedure THeapDumpForm.HeapListViewColumnClick(Sender: TObject; + Column: TListColumn); +begin + LVColumnClick(Column); +end; + +procedure THeapDumpForm.HeapListViewCompare(Sender: TObject; Item1, + Item2: TListItem; Data: Integer; var Compare: Integer); +begin + LVCompare(TListView(Sender), Item1, Item2, Compare); +end; + +procedure THeapDumpForm.UpdateStatusLine; +begin + with StatusBar.Panels do + begin + BeginUpdate; + Items[0].Text := Format(sCountStatus, [High(FHeapEntries) + 1]); + Items[1].Text := Format(sFixedStatus, [IntToExtended(FixedSum)]); + Items[2].Text := Format(sMoveableStatus, [IntToExtended(MoveableSum)]); + Items[3].Text := Format(sFreeStatus, [IntToExtended(FreeSum)]); + EndUpdate; + Update; + end; +end; + +procedure THeapDumpForm.StatusBarResize(Sender: TObject); +var + I: Integer; +begin + with StatusBar do + for I := 0 to Panels.Count - 1 do Panels[I].Width := Width div 4; +end; + +procedure THeapDumpForm.ReadHeapEntry(Item: TListItem); +var + BlockSize, BytesRead: DWORD; + Buffer, BufferEnd, P: PChar; +begin + with HeapEntryMemo do {if DWORD(Item.SubItems.Objects[2]) <> LF32_FREE then} + begin + BlockSize := DWORD(Item.SubItems.Objects[1]); + if BlockSize > 32768 then BlockSize := 32768; + GetMem(Buffer, BlockSize); + Lines.BeginUpdate; + try + Lines.Clear; + if Toolhelp32ReadProcessMemory(FProcessID, Item.SubItems.Objects[0], + Buffer^, BlockSize - 1, BytesRead) then + begin + P := Buffer; + BufferEnd := Buffer + BytesRead - 1; + while P < BufferEnd do + begin + case P^ of + #0: P^ := '|'; + #1..#31: P^ := '.'; + end; + Inc(P); + end; + Buffer[BytesRead] := #0; + SetTextBuf(Buffer); + end; + finally + FreeMem(Buffer); + Lines.EndUpdate; + end; + end; +end; + +procedure THeapDumpForm.Refresh1Execute(Sender: TObject); +begin + BuildHeapList; +end; + +procedure THeapDumpForm.HeapEntryListViewData(Sender: TObject; + Item: TListItem); +begin + with Item, FHeapEntries[Item.Index] do + begin + Caption := Format('%.8x', [hHandle]); + SubItems.AddObject(Format('%.8x', [dwAddress]), Pointer(dwAddress)); + SubItems.AddObject(Format('%.0n', [IntToExtended(dwBlockSize)]), Pointer(dwBlockSize)); + SubItems.AddObject(Format('%.8x', [dwAddress + dwBlockSize]), Pointer(dwAddress + dwBlockSize)); + case dwFlags of + LF32_FIXED: + SubItems.AddObject('Fixed', Pointer(dwFlags)); + LF32_FREE: + SubItems.AddObject('Free', Pointer(dwFlags)); + LF32_MOVEABLE: + SubItems.AddObject('Moveable', Pointer(dwFlags)); + end; + SubItems.AddObject(Format('%d', [dwLockCount]), Pointer(dwLockCount)); + end; +end; + +procedure THeapDumpForm.HeapEntryListViewSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +begin + if Selected then ReadHeapEntry(Item); +end; + +procedure THeapDumpForm.HeapListViewSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +begin + if Selected then BuildHeapEntriesList(DWORD(Item.Data)); +end; + +procedure THeapDumpForm.BuildContent; +begin + BuildHeapList; +end; + +// History: + +// $Log: HeapDump.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/Main.dfm b/official/1.96/examples/windows/delphitools/toolhelpview/Main.dfm new file mode 100644 index 0000000..02526b3 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/Main.dfm @@ -0,0 +1,876 @@ +object MainForm: TMainForm + Left = 191 + Top = 107 + ActiveControl = ProcessListView + AutoScroll = False + Caption = 'ToolHelp Viewer' + ClientHeight = 404 + ClientWidth = 587 + Color = clBtnFace + Constraints.MinHeight = 300 + Constraints.MinWidth = 400 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Menu = MainMenu + OldCreateOrder = False + Position = poDefault + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 0 + Top = 234 + Width = 587 + Height = 3 + Cursor = crVSplit + Align = alBottom + MinSize = 70 + ResizeStyle = rsUpdate + end + object ProcessListView: TListView + Left = 0 + Top = 26 + Width = 587 + Height = 208 + Align = alClient + AllocBy = 32 + Columns = < + item + Caption = 'Process' + Width = 110 + end + item + Caption = 'PID' + MaxWidth = 65 + Width = 65 + end + item + Alignment = taRightJustify + Caption = 'Priority' + MaxWidth = 50 + end + item + Alignment = taRightJustify + Caption = 'Threads' + MaxWidth = 51 + Width = 51 + end + item + Caption = 'ExeType' + MaxWidth = 55 + Width = 55 + end + item + Caption = 'FileName' + Width = 250 + end + item + Caption = 'Parent Process' + Width = 90 + end> + GridLines = True + HideSelection = False + HotTrackStyles = [] + ReadOnly = True + RowSelect = True + PopupMenu = PopupMenu + StateImages = PriorityImagesList + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = ProcessListViewColumnClick + OnCompare = ProcessListViewCompare + OnDblClick = ProcessListViewDblClick + OnEnter = ProcessListViewEnter + OnSelectItem = ProcessListViewSelectItem + end + object StatusBar: TStatusBar + Left = 0 + Top = 385 + Width = 587 + Height = 19 + Panels = < + item + Width = 85 + end + item + Width = 400 + end + item + Width = 165 + end> + SimplePanel = False + OnResize = StatusBarResize + end + object BottomPanel: TPanel + Left = 0 + Top = 237 + Width = 587 + Height = 148 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 2 + object Splitter2: TSplitter + Left = 470 + Top = 0 + Width = 3 + Height = 148 + Cursor = crHSplit + Align = alRight + MinSize = 70 + ResizeStyle = rsUpdate + end + object ModulesListView: TListView + Left = 0 + Top = 0 + Width = 470 + Height = 148 + Align = alClient + AllocBy = 32 + Columns = < + item + Caption = 'Module' + Width = 70 + end + item + Caption = 'MID' + MaxWidth = 65 + Width = 65 + end + item + Caption = 'ImageBase' + Width = 70 + end + item + Caption = 'Base' + Width = 70 + end + item + Alignment = taRightJustify + Caption = 'Size' + MaxWidth = 80 + Width = 70 + end + item + Alignment = taRightJustify + Caption = 'Global #' + MaxWidth = 55 + Width = 55 + end + item + Alignment = taRightJustify + Caption = 'Process #' + MaxWidth = 60 + Width = 60 + end + item + Caption = 'Handle' + MaxWidth = 70 + Width = 70 + end + item + Caption = 'FileName' + Width = 200 + end> + HotTrackStyles = [] + ReadOnly = True + RowSelect = True + PopupMenu = PopupMenu + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = ProcessListViewColumnClick + OnCompare = ProcessListViewCompare + OnCustomDrawItem = ModulesListViewCustomDrawItem + OnDblClick = ProcessListViewDblClick + OnEnter = ProcessListViewEnter + OnSelectItem = ModulesListViewSelectItem + end + object ThreadsListView: TListView + Left = 473 + Top = 0 + Width = 114 + Height = 148 + Align = alRight + AllocBy = 4 + Columns = < + item + Caption = 'TID' + Width = 65 + end + item + Caption = 'Priority' + Width = 45 + end> + HotTrackStyles = [] + ReadOnly = True + RowSelect = True + TabOrder = 1 + ViewStyle = vsReport + OnColumnClick = ProcessListViewColumnClick + OnCompare = ProcessListViewCompare + OnEnter = ProcessListViewEnter + end + end + object CoolBar1: TCoolBar + Left = 0 + Top = 0 + Width = 587 + Height = 26 + AutoSize = True + BandMaximize = bmNone + Bands = < + item + Control = ToolBar1 + ImageIndex = -1 + MinHeight = 22 + Width = 583 + end> + FixedSize = True + OnResize = CoolBar1Resize + object ToolBar1: TToolBar + Left = 9 + Top = 0 + Width = 570 + Height = 22 + AutoSize = True + Caption = 'ToolBar1' + EdgeBorders = [] + Flat = True + Images = GlobalModule.ToolbarImagesList + TabOrder = 0 + Wrapable = False + object RefreshButton: TToolButton + Left = 0 + Top = 0 + Action = Refresh1 + end + object ToolButton7: TToolButton + Left = 23 + Top = 0 + Width = 8 + Caption = 'ToolButton7' + ImageIndex = 6 + Style = tbsSeparator + end + object CopyButton: TToolButton + Left = 31 + Top = 0 + Action = Copy1 + end + object SaveButton: TToolButton + Left = 54 + Top = 0 + Action = SaveToFile1 + end + object ToolButton3: TToolButton + Left = 77 + Top = 0 + Width = 8 + Caption = 'ToolButton3' + ImageIndex = 5 + Style = tbsSeparator + end + object ToolButton1: TToolButton + Left = 85 + Top = 0 + Action = DumpHeap1 + end + object ToolButton2: TToolButton + Left = 108 + Top = 0 + Action = DumpMemory1 + end + object ToolButton6: TToolButton + Left = 131 + Top = 0 + Action = DumpModules1 + end + object ToolButton10: TToolButton + Left = 154 + Top = 0 + Action = DumpPE1 + end + object ToolButton4: TToolButton + Left = 177 + Top = 0 + Width = 8 + Caption = 'ToolButton4' + ImageIndex = 5 + Style = tbsSeparator + end + object ChangePriButton: TToolButton + Left = 185 + Top = 0 + Action = ChangePriority1 + end + object KillButton: TToolButton + Left = 208 + Top = 0 + Action = Terminate1 + end + object PropertyButton: TToolButton + Left = 231 + Top = 0 + Action = FileProperties1 + end + object ToolButton5: TToolButton + Left = 254 + Top = 0 + Width = 8 + Caption = 'ToolButton5' + ImageIndex = 5 + Style = tbsSeparator + end + object HottrackButton: TToolButton + Left = 262 + Top = 0 + Action = HotTrack1 + Style = tbsCheck + end + object ToolButton8: TToolButton + Left = 285 + Top = 0 + Action = InfoTip1 + Style = tbsCheck + end + object ToolButton9: TToolButton + Left = 308 + Top = 0 + Action = BeepOnChange1 + Style = tbsCheck + end + object ToolButton11: TToolButton + Left = 331 + Top = 0 + Action = CheckImageBase1 + Style = tbsCheck + end + end + end + object PriorityImagesList: TImageList + Left = 104 + Top = 312 + Bitmap = { + 494C010103000500040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000002000000001002000000000000020 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F00 + 00007F0000007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F0000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F0000007F00 + 0000BFBFBF00BFBFBF007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF0000007F0000007F0000007F00BFBFBF007F000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F000000BFBFBF00BFBFBF00BFBF + BF0000007F0000007F0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF0000007F0000007F0000007F00BFBFBF000000000000000000000000000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF0000007F0000007F0000007F00BFBFBF00BFBFBF00BFBFBF007F0000007F00 + 0000BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000 + 7F0000007F0000007F0000007F0000007F007F000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F000000BFBFBF00BFBFBF000000 + 7F0000007F0000007F0000007F0000007F00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000 + 7F0000007F0000007F0000007F0000007F0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000BFBFBF00BFBFBF00BFBFBF000000 + 7F0000007F0000007F0000007F0000007F00BFBFBF00BFBFBF007F0000007F00 + 00007F0000007F0000007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F0000007F00 + 0000BFBFBF00BFBFBF007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F0000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F00000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000007F0000007F0000007F000000BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F00 + 00007F0000007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000FFFFFF00BFBFBF00FFFF + FF00BFBFBF00FFFFFF00BFBFBF00BFBFBF007F00000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000FFFF00FFFFFF007F000000BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000BFBFBF00FFFFFF000000 + 7F00FFFFFF0000007F0000007F00BFBFBF007F00000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF0000FFFF007F000000BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000FFFFFF00BFBFBF000000 + 7F00BFBFBF0000007F00BFBFBF00FFFFFF007F00000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF0000000000FFFFFF00FFFFFF00FFFF + FF000000000000000000000000000000000000FFFF00FFFFFF007F000000BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F00 + 00007F0000007F0000007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F0000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000BFBFBF0000007F000000 + 7F00FFFFFF00BFBFBF0000007F00BFBFBF007F00000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF0000000000FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF000000000000FFFF00FFFFFF0000FFFF007F000000BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F0000007F00 + 0000BFBFBF00BFBFBF007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000FFFFFF00BFBFBF000000 + 7F00BFBFBF0000007F0000007F00FFFFFF007F00000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF0000000000FFFFFF00FFFFFF00FFFF + FF00000000000000000000FFFF00FFFFFF0000FFFF00FFFFFF007F000000BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F0000007F00 + 0000BFBFBF00BFBFBF007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF007F0000007F0000007F0000007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F000000BFBFBF00FFFFFF00BFBF + BF00FFFFFF00BFBFBF00FFFFFF00BFBFBF007F00000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF000000000000000000000000000000 + 00000000000000FFFF00FFFFFF007F0000007F0000007F0000007F000000BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F00 + 00007F0000007F0000007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF007F000000FFFFFF00FFFFFF007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F0000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F00000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F00 + 000000FFFF00FFFFFF0000FFFF007F00000000FFFF007F000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF007F000000FFFFFF00FFFFFF007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F0000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F00000000000000BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F00 + 0000FFFFFF0000FFFF00FFFFFF007F0000007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F00 + 00007F0000007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF007F0000007F0000007F0000007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF007F0000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F000000BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF007F00 + 00007F0000007F0000007F0000007F000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF0000007F00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF0000FFFF0000FFFF0000000000000000000000 + 0000000000000000000000000000000000007F000000BFBFBF00BFBFBF000000 + 0000000000000000000000000000BFBFBF00000000000000000000000000BFBF + BF00000000000000000000000000BFBFBF000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF0000FFFF0000FFFF0000000000000000000000 + 0000000000000000000000000000000000007F000000BFBFBF00BFBFBF000000 + 0000000000000000000000000000BFBFBF00000000000000000000000000BFBF + BF00000000000000000000000000BFBFBF000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF00000000000000 + 0000000000000000000000000000000000007F000000BFBFBF00BFBFBF000000 + 0000000000000000000000000000BFBFBF00000000000000000000000000BFBF + BF00000000000000000000000000BFBFBF000000000000000000000000000000 + 0000000000000000FF000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FFFF0000FFFF00FFFFFF00FFFFFF00FFFFFF0000FFFF0000FFFF000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000000000000000000000000000 + 0000000000000000FF000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000FFFF000000 + 0000000000000000000000000000000000007F000000BFBFBF00BFBFBF000000 + 0000000000000000000000000000BFBFBF00000000000000000000000000BFBF + BF00000000000000000000000000BFBFBF000000000000000000000000000000 + 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FFFF00FFFFFF00FFFFFF00000000007F7F7F007F7F7F0000FFFF000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FFFF00FFFFFF00FFFFFF007F7F7F00FFFFFF00FFFFFF0000FFFF000000 + 0000000000000000000000000000000000007F000000BFBFBF00BFBFBF000000 + 0000000000000000000000000000BFBFBF00000000000000000000000000BFBF + BF00000000000000000000000000BFBFBF000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000FFFF0000FFFF00FFFFFF007F7F7F00FFFFFF0000FFFF0000FFFF000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF000000FF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FFFF0000FFFF007F7F7F0000FFFF0000FFFF00000000000000 + 0000000000000000000000000000000000007F0000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000007F0000007F0000007F0000007F00 + 00007F0000007F0000007F0000007F0000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF0000FFFF0000FFFF0000000000000000000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF000000 + 0000000000000000000000000000BFBFBF00000000000000000000000000BFBF + BF00000000000000000000000000BFBFBF000000000000000000000000000000 + 00000000000000000000000000000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFF0000FFFF0000FFFF0000000000000000000000 + 000000000000000000000000000000000000BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00BFBF + BF00BFBFBF00BFBFBF00BFBFBF00BFBFBF00424D3E000000000000003E000000 + 2800000040000000200000000100010000000000000100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FF000000000000FF0000FF0000FF + 000000000000FF0000FFBFBFBF00000000FF0000FFFFFF00FF0000FF0000FF00 + 000000000000000000000000FF0000FFFEFFFC7FF83F0000FEFFFC7FF83FBFBF + FC7FFC7FF83FFFFFFC7FFC7FF83F0000F83FFC7FF01F0000F83FFC7FE00F0000 + F01FE00FE00FBFBFF01FE00FC007FFFFE00FF01FC00B0000E00FF01FC00700FF + FC7FF83FE00FFF00FC7FF83FE00F0000FC7FFC7FF01FFF00FC7FFC7FF83FFF00 + FC7FFEFFF83F0000FC7FFEFFF83F00FF00000000000000000000000000000000 + 000000000000} + end + object MainMenu: TMainMenu + Images = GlobalModule.ToolbarImagesList + Left = 8 + Top = 312 + object File1: TMenuItem + Caption = '&File' + object CopyItem: TMenuItem + Action = Copy1 + end + object SaveItem: TMenuItem + Action = SaveToFile1 + end + object N2: TMenuItem + Caption = '-' + end + object ExitItem: TMenuItem + Action = Exit1 + end + end + object Tools1: TMenuItem + Caption = '&Tools' + object RefreshItem: TMenuItem + Action = Refresh1 + end + object N1: TMenuItem + Caption = '-' + end + object ChangePriorityItem: TMenuItem + Action = ChangePriority1 + end + object DumpHeapItem: TMenuItem + Action = DumpHeap1 + end + object DumpMemory11: TMenuItem + Action = DumpMemory1 + end + object Moduleslist1: TMenuItem + Action = DumpModules1 + end + object DumpPEfile1: TMenuItem + Action = DumpPE1 + end + object N4: TMenuItem + Caption = '-' + end + object FilePropItem: TMenuItem + Action = FileProperties1 + end + object TerminateItem: TMenuItem + Action = Terminate1 + end + end + object Options1: TMenuItem + Caption = '&Options' + object Beeponchange2: TMenuItem + Action = BeepOnChange1 + end + object CheckImageBase2: TMenuItem + Action = CheckImageBase1 + end + object HotTrackItem: TMenuItem + Action = HotTrack1 + end + object InfoTip2: TMenuItem + Action = InfoTip1 + end + end + object Views1: TMenuItem + Caption = '&Views' + Visible = False + end + object Help1: TMenuItem + Caption = '&Help' + object Support1: TMenuItem + Action = SendMail1 + end + object AboutItem: TMenuItem + Action = About1 + end + end + end + object ActionList1: TActionList + Images = GlobalModule.ToolbarImagesList + Left = 40 + Top = 312 + object Exit1: TAction + Caption = 'Exit' + Hint = 'Exit application' + ImageIndex = 0 + OnExecute = Exit1Execute + end + object Terminate1: TAction + Caption = 'Terminate Process' + Hint = 'Terminate process' + ImageIndex = 1 + ShortCut = 16468 + OnExecute = Terminate1Execute + OnUpdate = Terminate1Update + end + object Refresh1: TAction + Caption = 'Refresh' + Hint = 'Refresh' + ImageIndex = 2 + ShortCut = 116 + OnExecute = Refresh1Execute + end + object About1: TAction + Caption = 'About...' + Hint = 'About' + OnExecute = About1Execute + end + object HotTrack1: TAction + Caption = 'HotTrack' + Hint = 'ListView hottrack' + ImageIndex = 5 + OnExecute = HotTrack1Execute + end + object SaveToFile1: TAction + Caption = 'Save as ...' + Hint = 'Save to text file' + ImageIndex = 3 + ShortCut = 16467 + OnExecute = SaveToFile1Execute + OnUpdate = SaveToFile1Update + end + object FileProperties1: TAction + Caption = 'File Properties' + Hint = 'File properties' + ImageIndex = 4 + ShortCut = 32781 + OnExecute = FileProperties1Execute + OnUpdate = FileProperties1Update + end + object ChangePriority1: TAction + Caption = 'Change Process Priority' + Hint = 'Change process priority' + ImageIndex = 8 + ShortCut = 16464 + OnExecute = ChangePriority1Execute + OnUpdate = Terminate1Update + end + object Copy1: TAction + Caption = 'Copy' + Hint = 'Copy to clipboard' + ImageIndex = 9 + ShortCut = 16451 + OnExecute = Copy1Execute + OnUpdate = SaveToFile1Update + end + object DumpHeap1: TAction + Caption = 'Heap List' + Hint = 'Heap list ' + ImageIndex = 11 + ShortCut = 16456 + OnExecute = DumpHeap1Execute + OnUpdate = Terminate1Update + end + object DumpMemory1: TAction + Caption = 'Memory List' + Hint = 'Virtual Memory list' + ImageIndex = 12 + ShortCut = 16461 + OnExecute = DumpMemory1Execute + OnUpdate = Terminate1Update + end + object DumpModules1: TAction + Caption = 'Modules list' + Hint = 'Lists all mapped modules' + ImageIndex = 7 + ShortCut = 16460 + OnExecute = DumpModules1Execute + end + object InfoTip1: TAction + Caption = 'InfoTip' + Hint = 'Listview infotips' + ImageIndex = 13 + OnExecute = InfoTip1Execute + end + object BeepOnChange1: TAction + Caption = 'Beep on change' + Hint = 'Beep on change in process list' + ImageIndex = 14 + OnExecute = BeepOnChange1Execute + end + object CheckImageBase1: TAction + Caption = 'Check ImageBase' + Hint = 'Check ImageBase' + ImageIndex = 16 + OnExecute = CheckImageBase1Execute + end + object DumpPE1: TAction + Caption = 'Dump PE file' + Hint = 'Dump PE file' + ImageIndex = 22 + ShortCut = 16452 + OnExecute = DumpPE1Execute + OnUpdate = DumpPE1Update + end + object SendMail1: TAction + Caption = 'Support' + ImageIndex = 24 + OnExecute = SendMail1Execute + end + end + object PopupMenu: TPopupMenu + Images = GlobalModule.ToolbarImagesList + Left = 72 + Top = 312 + object RefreshItemP: TMenuItem + Action = Refresh1 + end + object N5: TMenuItem + Caption = '-' + end + object CopyItemP: TMenuItem + Action = Copy1 + end + object SaveItemP: TMenuItem + Action = SaveToFile1 + end + object ChangePriorityItemP: TMenuItem + Action = ChangePriority1 + end + object DumpHeapItemP: TMenuItem + Action = DumpHeap1 + end + object MemoryList1: TMenuItem + Action = DumpMemory1 + end + object Moduleslist2: TMenuItem + Action = DumpModules1 + end + object DumpPEfile2: TMenuItem + Action = DumpPE1 + Default = True + end + object TerminateItemP: TMenuItem + Action = Terminate1 + end + object N3: TMenuItem + Caption = '-' + end + object PropertyItemP: TMenuItem + Action = FileProperties1 + end + end +end diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/Main.pas b/official/1.96/examples/windows/delphitools/toolhelpview/Main.pas new file mode 100644 index 0000000..487d583 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/Main.pas @@ -0,0 +1,947 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 Main.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2006/01/15 11:21:32 $ } +{ } +{**************************************************************************************************} + +unit Main; + +{$I jcl.inc} +{$IFDEF SUPPORTS_PLATFORM_WARNINGS} + {$WARN SYMBOL_PLATFORM OFF} +{$ENDIF SUPPORTS_PLATFORM_WARNINGS} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, ImgList, StdCtrls, ToolWin, Menus, ActnList, ExtCtrls, IniFiles; + +const + UM_ACTIVATEMAINFORM = WM_USER + $100; + +type + TMainForm = class(TForm) + ProcessListView: TListView; + PriorityImagesList: TImageList; + MainMenu: TMainMenu; + ActionList1: TActionList; + Exit1: TAction; + ExitItem: TMenuItem; + File1: TMenuItem; + StatusBar: TStatusBar; + Tools1: TMenuItem; + Terminate1: TAction; + TerminateItem: TMenuItem; + Refresh1: TAction; + RefreshItem: TMenuItem; + About1: TAction; + Help1: TMenuItem; + AboutItem: TMenuItem; + HotTrack1: TAction; + HotTrackItem: TMenuItem; + SaveToFile1: TAction; + SaveItem: TMenuItem; + N2: TMenuItem; + FileProperties1: TAction; + FilePropItem: TMenuItem; + PopupMenu: TPopupMenu; + RefreshItemP: TMenuItem; + SaveItemP: TMenuItem; + TerminateItemP: TMenuItem; + PropertyItemP: TMenuItem; + N3: TMenuItem; + ChangePriority1: TAction; + ChangePriorityItem: TMenuItem; + N5: TMenuItem; + ChangePriorityItemP: TMenuItem; + BottomPanel: TPanel; + ModulesListView: TListView; + ThreadsListView: TListView; + Splitter2: TSplitter; + Splitter1: TSplitter; + Views1: TMenuItem; + N1: TMenuItem; + Copy1: TAction; + CopyItem: TMenuItem; + CopyItemP: TMenuItem; + DumpHeap1: TAction; + DumpHeapItem: TMenuItem; + DumpHeapItemP: TMenuItem; + DumpMemory1: TAction; + DumpMemory11: TMenuItem; + MemoryList1: TMenuItem; + Options1: TMenuItem; + CoolBar1: TCoolBar; + ToolBar1: TToolBar; + RefreshButton: TToolButton; + HottrackButton: TToolButton; + ToolButton7: TToolButton; + CopyButton: TToolButton; + SaveButton: TToolButton; + ToolButton3: TToolButton; + ToolButton1: TToolButton; + ToolButton2: TToolButton; + ToolButton4: TToolButton; + ChangePriButton: TToolButton; + KillButton: TToolButton; + PropertyButton: TToolButton; + ToolButton5: TToolButton; + InfoTip1: TAction; + ToolButton8: TToolButton; + InfoTip2: TMenuItem; + BeepOnChange1: TAction; + ToolButton9: TToolButton; + Beeponchange2: TMenuItem; + CheckImageBase1: TAction; + ToolButton11: TToolButton; + CheckImageBase2: TMenuItem; + DumpModules1: TAction; + ToolButton6: TToolButton; + Moduleslist1: TMenuItem; + N4: TMenuItem; + Moduleslist2: TMenuItem; + DumpPE1: TAction; + DumpPEfile1: TMenuItem; + ToolButton10: TToolButton; + DumpPEfile2: TMenuItem; + SendMail1: TAction; + Support1: TMenuItem; + procedure FormCreate(Sender: TObject); + procedure ProcessListViewCompare(Sender: TObject; Item1, + Item2: TListItem; Data: Integer; var Compare: Integer); + procedure ProcessListViewColumnClick(Sender: TObject; + Column: TListColumn); + procedure Exit1Execute(Sender: TObject); + procedure Terminate1Execute(Sender: TObject); + procedure Refresh1Execute(Sender: TObject); + procedure About1Execute(Sender: TObject); + procedure Terminate1Update(Sender: TObject); + procedure HotTrack1Execute(Sender: TObject); + procedure SaveToFile1Update(Sender: TObject); + procedure SaveToFile1Execute(Sender: TObject); + procedure FileProperties1Update(Sender: TObject); + procedure FileProperties1Execute(Sender: TObject); + procedure ProcessListViewEnter(Sender: TObject); + procedure ChangePriority1Execute(Sender: TObject); + procedure Copy1Execute(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure StatusBarResize(Sender: TObject); + procedure DumpHeap1Execute(Sender: TObject); + procedure DumpMemory1Execute(Sender: TObject); + procedure ProcessListViewSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure ModulesListViewSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure ProcessListViewInfoTip(Sender: TObject; Item: TListItem; + var InfoTip: string); + procedure ModulesListViewInfoTip(Sender: TObject; Item: TListItem; + var InfoTip: string); + procedure InfoTip1Execute(Sender: TObject); + procedure BeepOnChange1Execute(Sender: TObject); + procedure CheckImageBase1Execute(Sender: TObject); + procedure ModulesListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure DumpModules1Execute(Sender: TObject); + procedure DumpPE1Update(Sender: TObject); + procedure ProcessListViewDblClick(Sender: TObject); + procedure DumpPE1Execute(Sender: TObject); + procedure SendMail1Execute(Sender: TObject); + procedure CoolBar1Resize(Sender: TObject); + private + FDisableUpdate: Boolean; + FProcess_Cnt, FThreads_Cnt, FModules_Cnt, FModules_Size: LongWord; + FIniFile: TIniFile; + procedure BuildModulesList(ProcessID: DWORD); + procedure BuildProcessList(Rebuild: Boolean = False); + procedure BuildThreadsList(ProcessID: DWORD); + function CheckProcessesChange: Boolean; + function FocusedFileName: TFileName; + procedure KillProcess(ProcessID: DWORD); + procedure LoadSettings; + procedure RebuildViewsMenuHotKeys; + procedure SaveSettings; + function SummaryInfo: string; + procedure TimerRefresh; + procedure UpdateListViewsOptions; + procedure UpdateStatusLine(SummaryOnly: Boolean = False); + procedure ViewsMenuClick(Sender: TObject); + procedure WMTimer(var Msg: TWMTimer); message WM_TIMER; + procedure WMMenuChar(var Msg: TWMMenuChar); message WM_MENUCHAR; + procedure UMActivateMainForm(var Msg: TMessage); message UM_ACTIVATEMAINFORM; + public + procedure AddToViewsMenu(AForm: TForm; const ACaption: string); + procedure DeleteFromViewsMenu(AForm: TForm); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.DFM} + +uses + TLHelp32, About, ShellAPI, ChangePriority, HeapDump, MemoryDump, Global, + CommCtrl, JclShell, JclSysInfo, JclFileUtils, JclAppInst, ModulesDump, + ToolsUtils, FindDlg, PsApi; + +resourcestring + sCantOpenForTerminate = 'Can''t open this process for terminate.'; + sKill = 'Do you really want to kill process "%s" ?'; + sNotFound = 'Not found'; + sSaveProcessesList = 'ToolHelp process list'; + sSaveModulesList = 'Modules used by process %s'; + sSaveThreadsList = 'Threads created by process %s'; + sWaitTimeout = 'Timeout.'; + sProcessesSummary = 'Processes: %d, Threads: %d'; + sModulesSummary = 'Cnt: %d, Tot.Size: %.0n'; + sNotRelocated = '[base]'; + +const + PROCESS_CLASS_IDLE = 4; + PROCESS_CLASS_NORMAL = 8; + PROCESS_CLASS_HIGH = 13; + PROCESS_CLASS_TIMECRITICAL = 24; + +function GetPriorityIconIndex(Priority: DWORD): Integer; +begin + case Priority of + PROCESS_CLASS_IDLE: Result := 0; + PROCESS_CLASS_HIGH: Result := 1; + PROCESS_CLASS_TIMECRITICAL: Result := 2; + else + Result := -1; + end; +end; + +function GetProcessVersion(Version: DWORD): string; +var + C: array[0..2] of Char; +begin + C[0] := Chr(Lo(LOWORD(Version))); + C[1] := Chr(Hi(LOWORD(Version))); + if C[0] < #32 then C[0] := '_'; + if C[1] < #32 then C[1] := '_'; + C[2] := #0; + Result := Format('%s %d.%d', [C, Hi(HIWORD(Version)), Lo(HIWORD(Version))]); +end; + +{ TMainForm } + +procedure TMainForm.FormCreate(Sender: TObject); +var + FileInfo: TSHFileInfo; + ImageListHandle: THandle; +begin + {$IFDEF COMPILER5_UP} + ProcessListView.OnInfoTip := ProcessListViewInfoTip; + ModulesListView.OnInfoTip := ModulesListViewInfoTip; + {$ELSE COMPILER5_UP} + InfoTip1.Visible := False; + {$ENDIF COMPILER5_UP} + FIniFile := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini')); + LoadSettings; + ImageListHandle := SHGetFileInfo('', 0, FileInfo, SizeOf(FileInfo), + SHGFI_SYSICONINDEX or SHGFI_SMALLICON); + SendMessage(ProcessListView.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, ImageListHandle); + SetTimer(Handle, 1, 500, nil); + BuildProcessList; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + SaveSettings; + FIniFile.UpdateFile; + FIniFile.Free; + Win32Check(KillTimer(Handle, 1)); +end; + +procedure TMainForm.BuildProcessList(Rebuild: Boolean = False); +var + SnapProcHandle, ProcessHandle: THandle; + ProcessEntry: TProcessEntry32; + Next: Boolean; + FileInfo: TSHFileInfo; + ProcessVersion: DWORD; + FindItem: TListItem; + I: Integer; + ProcList: TList; + Added, Changed: Boolean; + + procedure CheckChanged; +begin + if ProcessListView.ItemFocused = FindItem then Changed := True; +end; + +begin + if FDisableUpdate then Exit; + ProcList := TList.Create; + Added := False; + Changed := False; + with ProcessListView do + try + FDisableUpdate := True; + try + if Rebuild then + begin + Screen.Cursor := crHourGlass; + Items.BeginUpdate; + Items.Clear; + FProcess_Cnt := 0; + FThreads_Cnt := 0; + end else + SendMessage(Handle, WM_SETREDRAW, 0, 0); + SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + if SnapProcHandle <> THandle(-1) then + begin + ProcessEntry.dwSize := Sizeof(ProcessEntry); + Next := Process32First(SnapProcHandle, ProcessEntry); + while Next do + begin + ProcList.Add(Pointer(ProcessEntry.th32ProcessID)); + FindItem := FindData(0, Pointer(ProcessEntry.th32ProcessID), True, False); + with ProcessEntry do if FindItem = nil then + begin // New Process + Added := True; + if IsWin2k then + begin + ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, th32ProcessID); + if Handle <> 0 then + begin + if GetModuleFileNameEx(ProcessHandle, 0, szExeFile, SizeOf(szExeFile)) = 0 then + StrPCopy(szExeFile, '[Idle]'); + CloseHandle(ProcessHandle); + end; + end; + ProcessVersion := SHGetFileInfo(szExeFile, 0, FileInfo, Sizeof(FileInfo), SHGFI_EXETYPE); + SHGetFileInfo(szExeFile, 0, FileInfo, Sizeof(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON); + with Items.Add, ProcessEntry do + begin + Caption := AnsiLowerCase(ExtractFileName(szExeFile)); + Data := Pointer(th32ProcessID); + ImageIndex := FileInfo.iIcon; + StateIndex := GetPriorityIconIndex(pcPriClassBase); + SubItems.AddObject(Format('%.8x', [th32ProcessID]), Pointer(th32ProcessID)); + SubItems.AddObject(Format('%d', [pcPriClassBase]), Pointer(pcPriClassBase)); + SubItems.AddObject(Format('%d', [cntThreads]), Pointer(cntThreads)); + SubItems.AddObject(GetProcessVersion(ProcessVersion), Pointer(ProcessVersion)); + SubItems.Add(szExeFile); + SubItems.AddObject(Format('(%.8x)', [th32ParentProcessID]), Pointer(th32ParentProcessID)); + Inc(FProcess_Cnt); + Inc(FThreads_Cnt, cntThreads); + end; + end else + with FindItem do + begin // Any changes in existing process ? + if SubItems.Objects[1] <> Pointer(pcPriClassBase) then + begin + SubItems.Objects[1] := Pointer(pcPriClassBase); + SubItems.Strings[1] := Format('%d', [pcPriClassBase]); + StateIndex := GetPriorityIconIndex(pcPriClassBase); + end; + if SubItems.Objects[2] <> Pointer(cntThreads) then + begin + Inc(FThreads_Cnt, cntThreads - DWORD(SubItems.Objects[2])); + SubItems.Objects[2] := Pointer(cntThreads); + SubItems.Strings[2] := Format('%d', [cntThreads]); + CheckChanged; + end; + end; + Next := Process32Next(SnapProcHandle, ProcessEntry); + end; + CloseHandle(SnapProcHandle); + end; + if Added then // find the names of parent processes + begin + for I := 0 to Items.Count - 1 do + begin + FindItem := FindData(0, Items[I].SubItems.Objects[5], True, False); + if FindItem <> nil then Items[I].SubItems[5] := FindItem.Caption; + end; + AlphaSort; + end; + for I := Items.Count - 1 downto 0 do // delete non-existing processes + if ProcList.IndexOf(Items[I].Data) = -1 then + begin + Dec(FProcess_Cnt); + Dec(FThreads_Cnt, DWORD(Items[I].SubItems.Objects[2])); + Items.Delete(I); + end; + if GetNextItem(nil, sdAll, [isSelected]) = nil then + begin + if ItemFocused = nil then ItemFocused := Items[0]; + ItemFocused.Selected := True; + end else + if Changed then BuildThreadsList(DWORD(ItemFocused.Data)); + UpdateStatusLine(True); + finally + if Rebuild then + Items.EndUpdate + else + SendMessage(Handle, WM_SETREDRAW, 1, 0); + end; + finally + FDisableUpdate := False; + ProcList.Free; + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.BuildThreadsList(ProcessID: DWORD); +var + SnapProcHandle: THandle; + ThreadEntry: TThreadEntry32; + Next: Boolean; +begin + with ThreadsListView do + try + Items.BeginUpdate; + Items.Clear; + SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0); + if SnapProcHandle <> THandle(-1) then + begin + ThreadEntry.dwSize := Sizeof(ThreadEntry); + Next := Thread32First(SnapProcHandle, ThreadEntry); + while Next do + begin + if ThreadEntry.th32OwnerProcessID = ProcessID then + with Items.Add, ThreadEntry do + begin + Caption := Format('%.8x', [th32ThreadID]); + Data := Pointer(th32ThreadID); + SubItems.AddObject(Format('%d', [tpDeltaPri]), Pointer(tpDeltaPri)); + end; + Next := Thread32Next(SnapProcHandle, ThreadEntry); + end; + CloseHandle(SnapProcHandle); + end; + AlphaSort; + ListViewFocusFirstItem(ThreadsListView); + finally + Items.EndUpdate; + end; +end; + +procedure TMainForm.BuildModulesList(ProcessID: DWORD); +var + SnapProcHandle: THandle; + ModuleEntry: TModuleEntry32; + Next: Boolean; + ImageBase: DWORD; +begin + with ModulesListView do + try + Items.BeginUpdate; + Items.Clear; + FModules_Cnt := 0; + FModules_Size := 0; + SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcessID); + if SnapProcHandle <> THandle(-1) then + begin + ModuleEntry.dwSize := Sizeof(ModuleEntry); + Next := Module32First(SnapProcHandle, ModuleEntry); + while Next do + begin + with Items.Add, ModuleEntry do + begin + Caption := AnsiLowerCase(szModule); + SubItems.AddObject(Format('%.8x', [th32ModuleID]), Pointer(th32ModuleID)); + if CheckImageBase1.Checked then + begin + ImageBase := GetImageBase(szExePath); + if ImageBase = DWORD(modBaseAddr) then + SubItems.AddObject(sNotRelocated, Pointer(0)) + else + SubItems.AddObject(Format('%.8x', [ImageBase]), Pointer(ImageBase)); + end else + SubItems.Add(''); + SubItems.AddObject(Format('%p', [modBaseAddr]), Pointer(modBaseAddr)); + SubItems.AddObject(Format('%.0n', [IntToExtended(modBaseSize)]), Pointer(modBaseSize)); + SubItems.AddObject(Format('%d', [GlblcntUsage]), Pointer(GlblcntUsage)); + SubItems.AddObject(Format('%d', [ProccntUsage]), Pointer(ProccntUsage)); + SubItems.AddObject(Format('%.8x', [hModule]), Pointer(hModule)); + SubItems.Add(szExePath); + Inc(FModules_Cnt); + Inc(FModules_Size, modBaseSize); + end; + Next := Module32Next(SnapProcHandle, ModuleEntry); + end; + CloseHandle(SnapProcHandle); + end; + AlphaSort; + ListViewFocusFirstItem(ModulesListView); + finally + Items.EndUpdate; + end; +end; + +function TMainForm.CheckProcessesChange: Boolean; +var + SnapProcHandle: THandle; + ProcessEntry: TProcessEntry32; + Next: Boolean; + ProcessCount: Integer; + FindItem: TListItem; +begin + Result := False; + ProcessCount := 0; + SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + if SnapProcHandle <> THandle(-1) then + begin + ProcessEntry.dwSize := Sizeof(ProcessEntry); + Next := Process32First(SnapProcHandle, ProcessEntry); + while Next and (not Result) do + begin + Inc(ProcessCount); + FindItem := ProcessListView.FindData(0, Pointer(ProcessEntry.th32ProcessID), True, False); + if FindItem = nil then + Result := True + else + with FindItem do + Result := (SubItems.Objects[1] <> Pointer(ProcessEntry.pcPriClassBase)) or + (SubItems.Objects[2] <> Pointer(ProcessEntry.cntThreads)); + Next := Process32Next(SnapProcHandle, ProcessEntry); + end; + CloseHandle(SnapProcHandle); + end; + Result := Result or (ProcessCount <> ProcessListView.Items.Count); +end; + +function TMainForm.FocusedFileName: TFileName; +begin + if (ActiveControl = ProcessListView) and (ProcessListView.ItemFocused <> nil) then + Result := ProcessListView.ItemFocused.SubItems[4] else + if (ActiveControl = ModulesListView) and (ModulesListView.ItemFocused <> nil) then + Result := ModulesListView.ItemFocused.SubItems[7] else + Result := ''; +end; + +procedure TMainForm.KillProcess(ProcessID: DWORD); +var + ProcessHandle: THandle; +begin + ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS{PROCESS_TERMINATE}, False, ProcessID); + if ProcessHandle <> 0 then + begin + TerminateProcess(ProcessHandle, 0); + if WaitForSingleObject(ProcessHandle, 10000) = WAIT_TIMEOUT then + MessBox(sWaitTimeout, MB_ICONWARNING); + CloseHandle(ProcessHandle); + BuildProcessList; + end else + MessBox(sCantOpenForTerminate, MB_ICONERROR); +end; + +function TMainForm.SummaryInfo: string; +begin + if (ActiveControl = ProcessListView) then + Result := Format(sProcessesSummary , [FProcess_Cnt, FThreads_Cnt]) else + if (ActiveControl = ModulesListView) then + Result := Format(sModulesSummary , [FModules_Cnt, IntToExtended(FModules_Size)]) else + Result := ''; +end; + +procedure TMainForm.TimerRefresh; +begin + if not Application.Terminated and IsWindowEnabled(Handle) and CheckProcessesChange then + begin + BuildProcessList; + if BeepOnChange1.Checked then MessageBeep(MB_OK); + end; +end; + +procedure TMainForm.UpdateStatusLine(SummaryOnly: Boolean = False); +var + FileName: TFileName; +begin + FileName := FocusedFileName; + with StatusBar.Panels do + begin + BeginUpdate; + if not SummaryOnly then + begin + Items[0].Text := ''; + Items[1].Text := ''; + if VersionResourceAvailable(FileName) then + try + with TJclFileVersionInfo.Create(FileName) do + try + StatusBar.Panels.Items[0].Text := FileVersion; + StatusBar.Panels.Items[1].Text := FileDescription; + finally + Free; + end; + except + end else + Items[0].Text := sNotFound; + end; + Items[2].Text := SummaryInfo; + EndUpdate; + end; +end; + +procedure TMainForm.ProcessListViewCompare(Sender: TObject; Item1, + Item2: TListItem; Data: Integer; var Compare: Integer); +begin + LVCompare(TListView(Sender), Item1, Item2, Compare); +end; + +procedure TMainForm.ProcessListViewColumnClick(Sender: TObject; + Column: TListColumn); +begin + LVColumnClick(Column); +end; + +procedure TMainForm.ProcessListViewEnter(Sender: TObject); +begin + UpdateStatusLine; +end; + +procedure TMainForm.Exit1Execute(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.BeepOnChange1Execute(Sender: TObject); +begin + with BeepOnChange1 do + Checked := not Checked; +end; + +procedure TMainForm.HotTrack1Execute(Sender: TObject); +begin + with HotTrack1 do + begin + Checked := not Checked; + UpdateListViewsOptions; + end; +end; + +procedure TMainForm.InfoTip1Execute(Sender: TObject); +begin + with InfoTip1 do + begin + Checked := not Checked; + UpdateListViewsOptions; + end; +end; + +procedure TMainForm.CheckImageBase1Execute(Sender: TObject); +begin + with CheckImageBase1 do + begin + Checked := not Checked; + ProcessListViewSelectItem(nil, ProcessListView.Selected, Assigned(ProcessListView.Selected)); + end; +end; + +procedure TMainForm.Terminate1Execute(Sender: TObject); +begin + with ProcessListView do if (ItemFocused <> nil) and + (MessBoxFmt(sKill, [ItemFocused.Caption], MB_ICONEXCLAMATION or MB_YESNO or MB_DEFBUTTON2) = ID_YES) then + KillProcess(DWORD(ItemFocused.Data)); +end; + +procedure TMainForm.Refresh1Execute(Sender: TObject); +begin + BuildProcessList(True); +end; + +procedure TMainForm.About1Execute(Sender: TObject); +begin + ShowToolsAboutBox; +end; + +procedure TMainForm.ChangePriority1Execute(Sender: TObject); +begin + with TChangePriorityDlg.Create(Application) do + try + ProcessID := DWORD(ProcessListView.ItemFocused.Data); + ShowModal; + finally + Free; + end; +end; + +procedure TMainForm.Terminate1Update(Sender: TObject); +begin + TAction(Sender).Enabled := (ActiveControl = ProcessListView) and + (ProcessListView.ItemFocused <> nil); +end; + +procedure TMainForm.SaveToFile1Update(Sender: TObject); +begin + TAction(Sender).Enabled := ActiveControl is TListView; +end; + +procedure TMainForm.SaveToFile1Execute(Sender: TObject); +var + FileName: string; +begin + if ActiveControl = ProcessListView then + FileName := sSaveProcessesList else + if ActiveControl = ThreadsListView then + FileName := Format(sSaveThreadsList, [ProcessListView.ItemFocused.Caption]) else + if ActiveControl = ModulesListView then + FileName := Format(sSaveModulesList, [ProcessListView.ItemFocused.Caption]); + GlobalModule.ListViewToFile(ActiveControl as TListView, FileName); +end; + +procedure TMainForm.FileProperties1Update(Sender: TObject); +begin + FileProperties1.Enabled := + (ActiveControl = ProcessListView) or (ActiveControl = ModulesListView); +end; + +procedure TMainForm.FileProperties1Execute(Sender: TObject); +begin + DisplayPropDialog(Application.Handle, FocusedFileName); +end; + +procedure TMainForm.AddToViewsMenu(AForm: TForm; const ACaption: string); +var + Item: TMenuItem; +begin + Item := TMenuItem.Create(Views1); + Item.Caption := ACaption; + Item.Tag := Integer(AForm); + Item.OnClick := ViewsMenuClick; + Views1.Add(Item); + RebuildViewsMenuHotKeys; +end; + +procedure TMainForm.DeleteFromViewsMenu(AForm: TForm); +var + I: Integer; +begin + with Views1 do + for I := 0 to Count - 1 do + if Pointer(Items[I].Tag) = AForm then + begin + Items[I].Free; + System.Break; + end; + RebuildViewsMenuHotKeys; +end; + +procedure TMainForm.ViewsMenuClick(Sender: TObject); +begin + TForm(TMenuItem(Sender).Tag).BringToFront; +end; + +procedure TMainForm.RebuildViewsMenuHotKeys; +var + I: Integer; +begin + for I := 0 to Views1.Count - 1 do + if I < 9 then + Views1.Items[I].ShortCut := ShortCut(I + 49, [ssAlt]) + else + Views1.Items[I].ShortCut := 0; + Views1.Visible := Views1.Count > 0; +end; + +procedure TMainForm.Copy1Execute(Sender: TObject); +begin + GlobalModule.ListViewToClipboard(ActiveControl as TListView); +end; + +procedure TMainForm.WMTimer(var Msg: TWMTimer); +begin + if Msg.TimerID = 1 then + begin + TimerRefresh; + Msg.Result := 0; + end else inherited; +end; + +procedure TMainForm.WMMenuChar(var Msg: TWMMenuChar); +begin + inherited; + if Msg.Result = MNC_IGNORE then + PostMessage(Handle, UM_ACTIVATEMAINFORM, 0, 0); +end; + +procedure TMainForm.UMActivateMainForm(var Msg: TMessage); +begin + BringToFront; +end; + +procedure TMainForm.StatusBarResize(Sender: TObject); +begin + with StatusBar do + Panels[1].Width := Width - Panels[0].Width - Panels[2].Width; +end; + +procedure TMainForm.DumpHeap1Execute(Sender: TObject); +begin + FDisableUpdate := True; + try + with THeapDumpForm.Create(Application) do + begin + with ProcessListView.ItemFocused do SetParams(DWORD(Data), Caption); + Show; + end; + finally + FDisableUpdate := False; + end; +end; + +procedure TMainForm.DumpMemory1Execute(Sender: TObject); +begin + FDisableUpdate := True; + try + with TMemoryDumpForm.Create(Application) do + try + with ProcessListView.ItemFocused do SetParams(DWORD(Data), Caption); + Show; + except + Free; + raise + end; + finally + FDisableUpdate := False; + end; +end; + +procedure TMainForm.ProcessListViewSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +begin + if Selected then + begin + BuildThreadsList(DWORD(Item.Data)); + BuildModulesList(DWORD(Item.Data)); + UpdateStatusLine; + end; +end; + +procedure TMainForm.ModulesListViewSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +begin + if Selected and TWinControl(Sender).Focused then UpdateStatusLine; +end; + +procedure TMainForm.ProcessListViewInfoTip(Sender: TObject; + Item: TListItem; var InfoTip: string); +begin + InfoTip := InfoTipVersionString(Item.SubItems[4]); +end; + +procedure TMainForm.ModulesListViewInfoTip(Sender: TObject; + Item: TListItem; var InfoTip: string); +begin + InfoTip := InfoTipVersionString(Item.SubItems[7]); +end; + +procedure TMainForm.LoadSettings; +begin + with FIniFile do + begin + Left := ReadInteger(Name, 'Left', Left); + Top := ReadInteger(Name, 'Top', Top); + Width := ReadInteger(Name, 'Width', Width); + Height := ReadInteger(Name, 'Height', Height); + HotTrack1.Checked := ReadBool('Options', HotTrack1.Name, HotTrack1.Checked); + InfoTip1.Checked := ReadBool('Options', InfoTip1.Name, InfoTip1.Checked); + BeepOnChange1.Checked := ReadBool('Options', BeepOnChange1.Name, BeepOnChange1.Checked); + CheckImageBase1.Checked := ReadBool('Options', CheckImageBase1.Name, CheckImageBase1.Checked); + end; + UpdateListViewsOptions; +end; + +procedure TMainForm.SaveSettings; +begin + with FIniFile do + begin + WriteInteger(Name, 'Left', Left); + WriteInteger(Name, 'Top', Top); + WriteInteger(Name, 'Width', Width); + WriteInteger(Name, 'Height', Height); + WriteBool('Options', HotTrack1.Name, HotTrack1.Checked); + WriteBool('Options', InfoTip1.Name, InfoTip1.Checked); + WriteBool('Options', BeepOnChange1.Name, BeepOnChange1.Checked); + WriteBool('Options', CheckImageBase1.Name, CheckImageBase1.Checked); + end; +end; + +procedure TMainForm.UpdateListViewsOptions; +begin + ProcessListView.HotTrack := HotTrack1.Checked; + ThreadsListView.HotTrack := HotTrack1.Checked; + ModulesListView.HotTrack := HotTrack1.Checked; + ProcessListView.ShowHint := InfoTip1.Checked; + ThreadsListView.ShowHint := InfoTip1.Checked; + ModulesListView.ShowHint := InfoTip1.Checked; +end; + +procedure TMainForm.ModulesListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if Item.SubItems.Objects[1] <> nil then + Sender.Canvas.Font.Style := [fsunderline]; +end; + +procedure TMainForm.DumpModules1Execute(Sender: TObject); +begin + if not Assigned(ModulesDumpForm) then + ModulesDumpForm := TModulesDumpForm.Create(Application); + ModulesDumpForm.Show; +end; + +procedure TMainForm.DumpPE1Update(Sender: TObject); +begin + DumpPE1.Enabled := GlobalModule.PeViewerRegistred and (Length(FocusedFileName) > 0); +end; + +procedure TMainForm.ProcessListViewDblClick(Sender: TObject); +begin + DumpPE1.Execute; +end; + +procedure TMainForm.DumpPE1Execute(Sender: TObject); +begin + GlobalModule.ViewPE(FocusedFileName); +end; + +procedure TMainForm.SendMail1Execute(Sender: TObject); +begin + SendEmail; +end; + +procedure TMainForm.CoolBar1Resize(Sender: TObject); +begin + D4FixCoolBarResizePaint(Sender); +end; + +// History: + +// $Log: Main.pas,v $ +// Revision 1.3 2006/01/15 11:21:32 outchy +// Removed Log tag +// Changed DELPHI5 to COMPILER5 +// +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/MemoryDump.dfm b/official/1.96/examples/windows/delphitools/toolhelpview/MemoryDump.dfm new file mode 100644 index 0000000..5b14849 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/MemoryDump.dfm @@ -0,0 +1,282 @@ +inherited MemoryDumpForm: TMemoryDumpForm + Left = 206 + Top = 116 + Width = 654 + Height = 423 + Caption = 'MemoryDumpForm' + OldCreateOrder = True + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter [0] + Left = 0 + Top = 191 + Width = 646 + Height = 3 + Cursor = crVSplit + Align = alBottom + AutoSnap = False + ResizeStyle = rsUpdate + end + object Splitter2: TSplitter [1] + Left = 105 + Top = 26 + Width = 3 + Height = 165 + Cursor = crHSplit + AutoSnap = False + ResizeStyle = rsUpdate + end + inherited CoolBar: TCoolBar + Width = 646 + Bands = < + item + Control = ToolBar + ImageIndex = -1 + MinHeight = 22 + Width = 642 + end> + inherited ToolBar: TToolBar + Width = 629 + object ToolButton5: TToolButton + Left = 0 + Top = 0 + Action = Refresh1 + end + object ToolButton6: TToolButton + Left = 23 + Top = 0 + Width = 8 + Caption = 'ToolButton6' + ImageIndex = 1 + Style = tbsSeparator + end + object ToolButton1: TToolButton + Left = 31 + Top = 0 + Action = Copy1 + end + object ToolButton2: TToolButton + Left = 54 + Top = 0 + Action = SaveToFile1 + end + object ToolButton10: TToolButton + Left = 77 + Top = 0 + Action = Find1 + end + object ToolButton9: TToolButton + Left = 100 + Top = 0 + Action = SaveData1 + end + object ToolButton3: TToolButton + Left = 123 + Top = 0 + Width = 8 + Caption = 'ToolButton3' + ImageIndex = 4 + Style = tbsSeparator + end + object ToolButton4: TToolButton + Left = 131 + Top = 0 + Action = SelectAll1 + end + object ToolButton7: TToolButton + Left = 154 + Top = 0 + Width = 8 + Caption = 'ToolButton7' + ImageIndex = 18 + Style = tbsSeparator + end + object ToolButton8: TToolButton + Left = 162 + Top = 0 + Action = ViewAsText1 + Style = tbsCheck + end + end + end + object StatusBar: TStatusBar [3] + Left = 0 + Top = 377 + Width = 646 + Height = 19 + Panels = < + item + Width = 65 + end + item + Width = 130 + end + item + Width = 130 + end + item + Width = 50 + end> + SimplePanel = False + end + object PagesListView: TListView [4] + Left = 108 + Top = 26 + Width = 538 + Height = 165 + Align = alClient + AllocBy = 64 + Columns = < + item + Caption = 'Base' + Width = 80 + end + item + Caption = 'Protect' + Width = 75 + end + item + Caption = 'Allocation' + Width = 65 + end + item + Caption = 'Alloc.protect' + Width = 75 + end + item + Alignment = taRightJustify + Caption = 'Region size' + Width = 90 + end + item + Caption = 'State' + Width = 60 + end + item + Caption = 'ModuleName' + Width = 100 + end + item + Caption = 'Type' + end> + ColumnClick = False + HideSelection = False + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + PopupMenu = PopupMenu + SmallImages = GlobalModule.ToolbarImagesList + TabOrder = 1 + ViewStyle = vsReport + OnCustomDrawItem = PagesListViewCustomDrawItem + OnData = PagesListViewData + OnSelectItem = PagesListViewSelectItem + end + object DumpListView: TListView [5] + Left = 0 + Top = 194 + Width = 646 + Height = 183 + Align = alBottom + Columns = < + item + Caption = 'Address' + Width = 80 + end + item + Caption = 'Data' + Width = 350 + end + item + Caption = 'ASCII' + Width = 130 + end> + ColumnClick = False + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + MultiSelect = True + OwnerData = True + ReadOnly = True + RowSelect = True + ParentFont = False + PopupMenu = PopupMenu + TabOrder = 2 + ViewStyle = vsReport + OnData = DumpListViewData + end + object MemoryTreeView: TTreeView [6] + Left = 0 + Top = 26 + Width = 105 + Height = 165 + Align = alLeft + Images = GlobalModule.ToolbarImagesList + Indent = 19 + ReadOnly = True + TabOrder = 4 + OnChange = MemoryTreeViewChange + OnGetSelectedIndex = MemoryTreeViewGetSelectedIndex + end + inherited ActionList: TActionList + inherited Refresh1: TAction + OnExecute = Refresh1Execute + end + object ViewAsText1: TAction + Caption = 'View as text' + Hint = 'View as text' + ImageIndex = 23 + ShortCut = 16468 + OnExecute = ViewAsText1Execute + end + object SaveData1: TAction + Caption = 'Save data' + Hint = 'Save region data' + ImageIndex = 25 + ShortCut = 16452 + OnExecute = SaveData1Execute + OnUpdate = SaveData1Update + end + end + inherited PopupMenu: TPopupMenu + object Refresh2: TMenuItem + Action = Refresh1 + end + object N1: TMenuItem + Caption = '-' + end + object Copy2: TMenuItem + Action = Copy1 + end + object Save1: TMenuItem + Action = SaveToFile1 + end + object Savedata2: TMenuItem + Action = SaveData1 + end + object N2: TMenuItem + Caption = '-' + end + object Selectall2: TMenuItem + Action = SelectAll1 + end + object N3: TMenuItem + Caption = '-' + end + object Viewastext2: TMenuItem + Action = ViewAsText1 + end + end + object SaveDataDialog: TSaveDialog + DefaultExt = 'bin' + Filter = 'Binary files (*.bin)|*.bin|All files (*.*)|*.*' + Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing] + Left = 104 + Top = 224 + end +end diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/MemoryDump.pas b/official/1.96/examples/windows/delphitools/toolhelpview/MemoryDump.pas new file mode 100644 index 0000000..2b7efa2 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/MemoryDump.pas @@ -0,0 +1,521 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 MemoryDump.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit MemoryDump; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, ToolWin, ActnList, ExtCtrls, ViewTemplate, Menus; + +type + TMemoryInfo = packed record + MemInfo: TMemoryBasicInformation; + RepeatedItem, MappedFile: Boolean; + end; + + TMemoryDumpForm = class(TViewForm) + StatusBar: TStatusBar; + PagesListView: TListView; + Splitter1: TSplitter; + DumpListView: TListView; + ToolButton5: TToolButton; + ToolButton6: TToolButton; + MemoryTreeView: TTreeView; + Splitter2: TSplitter; + ToolButton1: TToolButton; + ToolButton2: TToolButton; + ToolButton3: TToolButton; + ToolButton4: TToolButton; + Refresh2: TMenuItem; + N1: TMenuItem; + Copy2: TMenuItem; + Save1: TMenuItem; + N2: TMenuItem; + Selectall2: TMenuItem; + ViewAsText1: TAction; + ToolButton7: TToolButton; + ToolButton8: TToolButton; + N3: TMenuItem; + Viewastext2: TMenuItem; + SaveData1: TAction; + ToolButton9: TToolButton; + Savedata2: TMenuItem; + SaveDataDialog: TSaveDialog; + ToolButton10: TToolButton; + procedure Refresh1Execute(Sender: TObject); + procedure DumpListViewData(Sender: TObject; Item: TListItem); + procedure PagesListViewSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure FormDestroy(Sender: TObject); + procedure PagesListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure FormCreate(Sender: TObject); + procedure PagesListViewData(Sender: TObject; Item: TListItem); + procedure MemoryTreeViewChange(Sender: TObject; Node: TTreeNode); + procedure MemoryTreeViewGetSelectedIndex(Sender: TObject; + Node: TTreeNode); + procedure ViewAsText1Execute(Sender: TObject); + procedure SaveData1Update(Sender: TObject); + procedure SaveData1Execute(Sender: TObject); + private + FDumpBytesPerLine: Integer; + FProcessID: DWORD; + FProcess: THandle; + FFileName: TFileName; + FMemoryInfo: array of TMemoryInfo; + FModulesList: TStringList; + procedure BuildPagesList; + procedure BuildModulesList; + procedure UpdateDumpList; + public + procedure SetParams(ProcessID: DWORD; const FileName: TFileName); + end; + +var + MemoryDumpForm: TMemoryDumpForm; + +implementation + +uses Global, TLHelp32, ToolsUtils, FindDlg, JclBase; + +{$R *.DFM} + +resourcestring + sAllocations = 'Allocations'; + sCaption = 'Virtual Memory list - %s'; + sCommited = 'Comitted: %.0n'; + sCount = 'Count: %d'; + sModules = 'Modules'; + sReserved = 'Reserved: %.0n'; + +function AllocationProtectStr(P: DWORD): string; +begin + case P of + PAGE_NOACCESS: + Result := 'NoAccess'; + PAGE_READONLY: + Result := 'ReadOnly'; + PAGE_READWRITE: + Result := 'ReadWrite'; + PAGE_WRITECOPY: + Result := 'WriteCopy'; + PAGE_EXECUTE: + Result := 'Exec'; + PAGE_EXECUTE_READ: + Result := 'ExecRead'; + PAGE_EXECUTE_READWRITE: + Result := 'ExecReadWrite'; + PAGE_EXECUTE_WRITECOPY: + Result := 'ExecWriteCopy'; + PAGE_GUARD: + Result := 'Guard'; + PAGE_NOCACHE: + Result := 'NoCache'; + else + Result := ''; + end; +end; + +function StateStr(P: DWORD): string; +begin + case P of + MEM_COMMIT: + Result := 'Commit'; + MEM_FREE: + Result := 'Free'; + MEM_RESERVE: + Result := 'Reserve'; + else + Result := Format('%x', [P]); + end; +end; + +function TypeStr(P: DWORD): string; +begin + case P of + MEM_IMAGE: + Result := 'Image'; + MEM_MAPPED: + Result := 'Mapped'; + MEM_PRIVATE: + Result := 'Private'; + else + Result := Format('%x', [P]); + end; +end; + +function ImageIndexFromInfo(MemInfo: TMemoryInfo): Integer; +begin + with MemInfo do + if MappedFile then Result := 6 else + if RepeatedItem then Result := 21 else + Result := 19; +end; + +{ TMemoryDumpForm } + +procedure TMemoryDumpForm.FormCreate(Sender: TObject); +begin + inherited; + FModulesList := TStringList.Create; +end; + +procedure TMemoryDumpForm.FormDestroy(Sender: TObject); +begin + FModulesList.Free; + if FProcess <> 0 then CloseHandle(FProcess); +end; + +procedure TMemoryDumpForm.BuildPagesList; +var + AllocationsNode, ModulesNode, TempNode: TTreeNode; + LastAllocationBase: Pointer; + LastMappedFile: Boolean; + I, N, TotalCommit, TotalReserve: Integer; + + procedure EnumAllocations; +var + P: PChar; + MI: TMemoryBasicInformation; + Res: DWORD; + Count: Integer; +begin + FMemoryInfo := nil; + Count := 0; + P := Pointer(0); + Res := VirtualQueryEx(FProcess, P, MI, SizeOf(MI)); + if Res <> SizeOf(MI) then RaiseLastOSError; + while Res = SizeOf(MI) do + begin + if MI.AllocationBase <> nil then + begin + SetLength(FMemoryInfo, Count + 1); + FMemoryInfo[Count].MemInfo := MI; + Inc(Count); + end; + Inc(P, MI.RegionSize); + Res := VirtualQueryEx(FProcess, P, MI, SizeOf(MI)); + end; +end; + +begin + Screen.Cursor := crHourGlass; + try + PagesListView.Items.BeginUpdate; + PagesListView.Items.Count := 0; + MemoryTreeView.Items.BeginUpdate; + StatusBar.Panels.BeginUpdate; + try + EnumAllocations; + PagesListView.Items.Count := Length(FMemoryInfo); + + with MemoryTreeView.Items do + begin + Clear; + AllocationsNode := AddFirst(nil, sAllocations); + AllocationsNode.ImageIndex := 19; + ModulesNode := Add(nil, sModules); + ModulesNode.ImageIndex := 6; + LastAllocationBase := nil; + LastMappedFile := False; + for I := 0 to Length(FMemoryInfo) - 1 do + with FMemoryInfo[I] do + if LastAllocationBase <> MemInfo.AllocationBase then + begin + TempNode := AddChildObject(AllocationsNode, Format('%p', [MemInfo.AllocationBase]), Pointer(I)); + with TempNode do ImageIndex := Parent.ImageIndex; + LastAllocationBase := MemInfo.AllocationBase; + RepeatedItem := False; + N := FModulesList.IndexOfObject(LastAllocationBase); + if N <> -1 then + begin + TempNode := AddChildObject(ModulesNode, FModulesList[N], Pointer(I)); + with TempNode do ImageIndex := Parent.ImageIndex; + MappedFile := True; + end else + MappedFile := False; + LastMappedFile := MappedFile; + end else + begin + RepeatedItem := True; + MappedFile := LastMappedFile; + end; + end; + AllocationsNode.AlphaSort; + ModulesNode.AlphaSort; + + TotalCommit := 0; + TotalReserve := 0; + for I := 0 to Length(FMemoryInfo) - 1 do with FMemoryInfo[I].MemInfo do + case State of + MEM_COMMIT: Inc(TotalCommit, RegionSize); + MEM_RESERVE: Inc(TotalReserve, RegionSize); + end; + with StatusBar do + begin + Panels[0].Text := Format(sCount, [Length(FMemoryInfo)]); + Panels[1].Text := Format(sCommited, [IntToExtended(TotalCommit)]); + Panels[2].Text := Format(sReserved, [IntToExtended(TotalReserve)]); + end; + + ListViewFocusFirstItem(PagesListView); + finally + PagesListView.Items.EndUpdate; + MemoryTreeView.Items.EndUpdate; + StatusBar.Panels.EndUpdate; + end; + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMemoryDumpForm.BuildModulesList; +var + SnapProcHandle: THandle; + ModuleEntry: TModuleEntry32; + Next: Boolean; +begin + FModulesList.Clear; + SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, FProcessID); + if SnapProcHandle <> THandle(-1) then + begin + ModuleEntry.dwSize := SizeOf(ModuleEntry); + Next := Module32First(SnapProcHandle, ModuleEntry); + while Next do + begin + FModulesList.AddObject(ModuleEntry.szModule, Pointer(ModuleEntry.modBaseAddr)); + Next := Module32Next(SnapProcHandle, ModuleEntry); + end; + CloseHandle(SnapProcHandle); + end; +end; + +procedure TMemoryDumpForm.SetParams(ProcessID: DWORD; const FileName: TFileName); +begin + FProcessID := ProcessID; + FFileName := FileName; + Caption := Format(sCaption, [FFileName]); + Refresh1.Execute; +end; + +procedure TMemoryDumpForm.UpdateDumpList; +begin + with DumpListView do + begin + if ViewAsText1.Checked then + begin + FDumpBytesPerLine := 64; + Columns[1].Caption := 'Ansi text'; + Columns[2].Caption := 'Unicode text'; + end else + begin + FDumpBytesPerLine := 16; + Columns[1].Caption := 'Data'; + Columns[2].Caption := 'ASCII'; + end; + Items.Count := Integer(PagesListView.Selected.SubItems.Objects[3]) div FDumpBytesPerLine; + Invalidate; + end; +end; + +procedure TMemoryDumpForm.Refresh1Execute(Sender: TObject); +begin + if FProcess <> 0 then CloseHandle(FProcess); + FProcess := OpenProcess(PROCESS_ALL_ACCESS, False, FProcessID); + if FProcess = 0 then + begin + Close; + RaiseLastOSError; + end; + BuildModulesList; + BuildPagesList; +end; + +procedure TMemoryDumpForm.DumpListViewData(Sender: TObject; Item: TListItem); +var + Address: Pointer; + LineData: packed array[0..63] of Byte; + NR: DWORD; + Hex, Ascii, S: string; + I: Integer; + W: PWideChar; +begin + with TListView(Sender) do + if PagesListView.Selected <> nil then + begin + Address := Pointer(DWORD(FMemoryInfo[PagesListView.Selected.Index].MemInfo.BaseAddress) + DWORD(Item.Index * FDumpBytesPerLine)); + SetLength(Hex, 3 * SizeOf(LineData)); + SetLength(Ascii, 3 * SizeOf(LineData)); + Hex := ''; + Ascii := ''; + if ReadProcessMemory(FProcess, Address, @LineData, SizeOf(LineData), NR) and (NR = SizeOf(LineData)) then + begin + if ViewAsText1.Checked then + begin + for I := 0 to FDumpBytesPerLine - 1 do + begin + if LineData[I] >= 32 then + Hex := Hex + Chr(LineData[I]) + else + Hex := Hex + '.'; + end; + W := PWideChar(@LineData); + for I := 0 to FDumpBytesPerLine div 2 - 1 do + begin + SetLength(S, 1); + WideCharToMultiByte(CP_ACP, 0, W, 1, PChar(S), 1, nil, nil); + S := PChar(S); + if Length(S) = 0 then S := '.'; + Ascii := Ascii + S; + Inc(W); + end; + end else + begin + for I := 0 to FDumpBytesPerLine - 1 do + begin + Hex := Hex + Format('%.2x ', [LineData[I]]); + if LineData[I] >= 32 then + Ascii := Ascii + Chr(LineData[I]) + else + Ascii := Ascii + '.'; + end; + end; + end; + Item.Caption := Format('%p', [Address]); + Item.SubItems.Add(Hex); + Item.SubItems.Add(Ascii); + end; +end; + +procedure TMemoryDumpForm.PagesListViewSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +begin + if Selected then + begin + if (DWORD(Item.SubItems.Objects[0]) = PAGE_NOACCESS) or + (DWORD(Item.SubItems.Objects[2]) = 0) then + begin + DumpListView.Items.Count := 0; + DumpListView.Invalidate; + end else + UpdateDumpList; + end; +end; + +procedure TMemoryDumpForm.PagesListViewData(Sender: TObject; Item: TListItem); +var + I: Integer; +begin + with Item, FMemoryInfo[Item.Index].MemInfo do + begin + Caption := Format('%p', [BaseAddress]); + SubItems.AddObject(AllocationProtectStr(Protect), Pointer(Protect)); + SubItems.AddObject(Format('%p', [AllocationBase]), AllocationBase); + SubItems.AddObject(AllocationProtectStr(AllocationProtect), Pointer(AllocationProtect)); + SubItems.AddObject(Format('%.0n', [IntToExtended(RegionSize)]), Pointer(RegionSize)); + SubItems.AddObject(StateStr(State), Pointer(State)); + I := FModulesList.IndexOfObject(AllocationBase); + if I <> - 1 then SubItems.Add(FModulesList[I]) else SubItems.Add(''); + SubItems.AddObject(TypeStr(Type_9), Pointer(Type_9)); + end; + Item.ImageIndex := ImageIndexFromInfo(FMemoryInfo[Item.Index]); +end; + +procedure TMemoryDumpForm.PagesListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if DWORD(Item.SubItems.Objects[0]) = PAGE_NOACCESS then + Sender.Canvas.Font.Color := clBtnFace; +end; + +procedure TMemoryDumpForm.MemoryTreeViewChange(Sender: TObject; Node: TTreeNode); +begin + if Node.Level = 1 then + with PagesListView do + begin + while Assigned(Selected) do Selected.Selected := False; + ItemFocused := PagesListView.Items[Integer(Node.Data)]; + ItemFocused.Selected := True; + ItemFocused.MakeVisible(False); + end; +end; + +procedure TMemoryDumpForm.MemoryTreeViewGetSelectedIndex(Sender: TObject; + Node: TTreeNode); +begin + Node.SelectedIndex := Node.ImageIndex; +end; + +procedure TMemoryDumpForm.ViewAsText1Execute(Sender: TObject); +begin + with ViewAsText1 do + Checked := not Checked; + UpdateDumpList; +end; + +procedure TMemoryDumpForm.SaveData1Update(Sender: TObject); +begin + TAction(Sender).Enabled := (ActiveControl = PagesListView) and + (PagesListView.Selected <> nil) and + (DWORD(PagesListView.Selected.SubItems.Objects[0]) <> PAGE_NOACCESS); +end; + +procedure TMemoryDumpForm.SaveData1Execute(Sender: TObject); +var + MS: TMemoryStream; + NR: DWORD; +begin + with SaveDataDialog, FMemoryInfo[PagesListView.Selected.Index].MemInfo do + begin + FileName := ''; + if Execute then + begin + MS := TMemoryStream.Create; + try + MS.Size := RegionSize; + if ReadProcessMemory(FProcess, BaseAddress, MS.Memory, RegionSize, NR) and + (NR = RegionSize) then + MS.SaveToFile(FileName) + else + RaiseLastOSError; + finally + MS.Free; + end; + end; + end; +end; + +// History: + +// $Log: MemoryDump.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS $Log$ tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/ModulesDump.dfm b/official/1.96/examples/windows/delphitools/toolhelpview/ModulesDump.dfm new file mode 100644 index 0000000..71750ff --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/ModulesDump.dfm @@ -0,0 +1,180 @@ +inherited ModulesDumpForm: TModulesDumpForm + Left = 235 + Top = 159 + Width = 469 + Height = 336 + ActiveControl = ModulesListView + Caption = 'Modules list' + OldCreateOrder = True + PixelsPerInch = 96 + TextHeight = 13 + inherited CoolBar: TCoolBar + Width = 461 + Bands = < + item + Control = ToolBar + ImageIndex = -1 + MinHeight = 22 + Width = 457 + end> + inherited ToolBar: TToolBar + Width = 444 + object ToolButton1: TToolButton + Left = 0 + Top = 0 + Action = Refresh1 + end + object ToolButton2: TToolButton + Left = 23 + Top = 0 + Width = 8 + Caption = 'ToolButton2' + ImageIndex = 3 + Style = tbsSeparator + end + object ToolButton3: TToolButton + Left = 31 + Top = 0 + Action = Copy1 + end + object ToolButton4: TToolButton + Left = 54 + Top = 0 + Action = SaveToFile1 + end + object ToolButton10: TToolButton + Left = 77 + Top = 0 + Action = Find1 + end + object ToolButton5: TToolButton + Left = 100 + Top = 0 + Width = 8 + Caption = 'ToolButton5' + ImageIndex = 4 + Style = tbsSeparator + end + object ToolButton6: TToolButton + Left = 108 + Top = 0 + Action = SelectAll1 + end + object ToolButton7: TToolButton + Left = 131 + Top = 0 + Width = 8 + Caption = 'ToolButton7' + ImageIndex = 18 + Style = tbsSeparator + end + object ToolButton8: TToolButton + Left = 139 + Top = 0 + Action = FileProp1 + end + object ToolButton9: TToolButton + Left = 162 + Top = 0 + Action = DumpPe1 + end + end + end + object StatusBar: TStatusBar [1] + Left = 0 + Top = 290 + Width = 461 + Height = 19 + Panels = < + item + Width = 90 + end + item + Width = 50 + end> + SimplePanel = False + end + object ModulesListView: TListView [2] + Left = 0 + Top = 26 + Width = 461 + Height = 264 + Align = alClient + Columns = < + item + Caption = 'Module' + Width = 80 + end + item + Alignment = taRightJustify + Caption = 'Usage' + end + item + Alignment = taRightJustify + Caption = 'Relocated' + Width = 70 + end + item + Caption = 'Filename' + Width = 300 + end> + HideSelection = False + MultiSelect = True + ReadOnly = True + RowSelect = True + PopupMenu = PopupMenu + SmallImages = GlobalModule.ToolbarImagesList + TabOrder = 2 + ViewStyle = vsReport + OnColumnClick = ModulesListViewColumnClick + OnCompare = ModulesListViewCompare + OnInfoTip = ModulesListViewInfoTip + end + inherited ActionList: TActionList + inherited Refresh1: TAction + OnExecute = Refresh1Execute + end + object FileProp1: TAction + Caption = 'Properties' + Hint = 'File properties' + ImageIndex = 4 + ShortCut = 32781 + OnExecute = FileProp1Execute + OnUpdate = FileProp1Update + end + object DumpPe1: TAction + Caption = 'Dump PE' + Hint = 'Dump PE' + ImageIndex = 22 + ShortCut = 16452 + OnExecute = DumpPe1Execute + OnUpdate = DumpPe1Update + end + end + inherited PopupMenu: TPopupMenu + object Refresh2: TMenuItem + Action = Refresh1 + end + object N1: TMenuItem + Caption = '-' + end + object Copy2: TMenuItem + Action = Copy1 + end + object Selectall2: TMenuItem + Action = SaveToFile1 + end + object N2: TMenuItem + Caption = '-' + end + object Selectall3: TMenuItem + Action = SelectAll1 + end + object DumpPE2: TMenuItem + Action = DumpPe1 + end + object Properties1: TMenuItem + Action = FileProp1 + end + end +end diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/ModulesDump.pas b/official/1.96/examples/windows/delphitools/toolhelpview/ModulesDump.pas new file mode 100644 index 0000000..0a27ffa --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/ModulesDump.pas @@ -0,0 +1,252 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 ModulesDump.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit ModulesDump; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ViewTemplate, Menus, ActnList, ComCtrls, ToolWin; + +type + TModulesDumpForm = class(TViewForm) + StatusBar: TStatusBar; + ModulesListView: TListView; + ToolButton1: TToolButton; + ToolButton2: TToolButton; + ToolButton3: TToolButton; + ToolButton4: TToolButton; + ToolButton5: TToolButton; + ToolButton6: TToolButton; + Refresh2: TMenuItem; + N1: TMenuItem; + Copy2: TMenuItem; + Selectall2: TMenuItem; + N2: TMenuItem; + Selectall3: TMenuItem; + FileProp1: TAction; + ToolButton7: TToolButton; + ToolButton8: TToolButton; + Properties1: TMenuItem; + DumpPe1: TAction; + ToolButton9: TToolButton; + DumpPE2: TMenuItem; + ToolButton10: TToolButton; + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormShow(Sender: TObject); + procedure Refresh1Execute(Sender: TObject); + procedure ModulesListViewColumnClick(Sender: TObject; + Column: TListColumn); + procedure ModulesListViewCompare(Sender: TObject; Item1, + Item2: TListItem; Data: Integer; var Compare: Integer); + procedure FileProp1Update(Sender: TObject); + procedure FileProp1Execute(Sender: TObject); + procedure ModulesListViewInfoTip(Sender: TObject; Item: TListItem; + var InfoTip: String); + procedure DumpPe1Execute(Sender: TObject); + procedure DumpPe1Update(Sender: TObject); + private + function SelectedFileName: TFileName; + public + procedure BuildContent; override; + procedure BuildModulesList; + end; + +var + ModulesDumpForm: TModulesDumpForm; + +implementation + +{$R *.DFM} + +uses + ToolsUtils, TLHelp32, JclShell, Global; + +resourcestring + sModulesCount = 'Modules: %d'; + +procedure TModulesDumpForm.BuildContent; +begin + BuildModulesList; +end; + +procedure TModulesDumpForm.BuildModulesList; +type + TProcessData = packed record + UsageCnt: Word; + RelocateCnt: Word; + end; +var + ML: TStringList; + SnapProcHandle, SnapModuleHandle: THandle; + ProcessEntry: TProcessEntry32; + ModuleEntry: TModuleEntry32; + ProcessNext, ModuleNext: Boolean; + I: Integer; + PD: TProcessData; +begin + ML := TStringList.Create; + Screen.Cursor := crHourGlass; + try + ML.Sorted := True; + ML.Duplicates := dupIgnore; + + SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + if SnapProcHandle <> THandle(-1) then + begin + ProcessEntry.dwSize := Sizeof(ProcessEntry); + ProcessNext := Process32First(SnapProcHandle, ProcessEntry); + while ProcessNext do + begin + SnapModuleHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcessEntry.th32ProcessID); + if SnapModuleHandle <> THandle(-1) then + begin + ModuleEntry.dwSize := Sizeof(ModuleEntry); + ModuleNext := Module32First(SnapModuleHandle, ModuleEntry); + while ModuleNext do + begin + I := ML.Add(ModuleEntry.szExePath); + PD := TProcessData(ML.Objects[I]); + Inc(PD.UsageCnt); + if GetImageBase(ModuleEntry.szExePath) <> DWORD(ModuleEntry.modBaseAddr) then + Inc(PD.RelocateCnt); + ML.Objects[I] := Pointer(PD); + ModuleNext := Module32Next(SnapModuleHandle, ModuleEntry); + end; + CloseHandle(SnapModuleHandle); + end; + ProcessNext := Process32Next(SnapProcHandle, ProcessEntry); + end; + CloseHandle(SnapProcHandle); + end; + + with ModulesListView do + begin + Items.BeginUpdate; + Items.Clear; + for I := 0 to ML.Count - 1 do + with Items.Add do + begin + Caption := AnsiLowerCase(ExtractFileName(ML[I])); + PD := TProcessData(ML.Objects[I]); + if PD.RelocateCnt = 0 then + ImageIndex := 20 + else + ImageIndex := 19; + with SubItems do + begin + Add(IntToStr(PD.UsageCnt)); + if PD.RelocateCnt = 0 then Add('-') else Add(IntToStr(PD.RelocateCnt)); + Add(ML[I]); + end; + end; + AlphaSort; + Items.EndUpdate; + end; + + with StatusBar do + begin + Panels.BeginUpdate; + Panels[0].Text := Format(sModulesCount, [ML.Count]); + Panels.EndUpdate; + end; + + finally + ML.Free; + Screen.Cursor := crDefault; + end; +end; + +procedure TModulesDumpForm.FormClose(Sender: TObject; var Action: TCloseAction); +begin + inherited; + ModulesDumpForm := nil; +end; + +procedure TModulesDumpForm.FormShow(Sender: TObject); +begin + inherited; + PostBuildContentMessage; +end; + +function TModulesDumpForm.SelectedFileName: TFileName; +begin + Result := ModulesListView.Selected.SubItems[2]; +end; + +procedure TModulesDumpForm.Refresh1Execute(Sender: TObject); +begin + BuildModulesList; +end; + +procedure TModulesDumpForm.ModulesListViewColumnClick(Sender: TObject; + Column: TListColumn); +begin + LVColumnClick(Column); +end; + +procedure TModulesDumpForm.ModulesListViewCompare(Sender: TObject; Item1, + Item2: TListItem; Data: Integer; var Compare: Integer); +begin + LVCompare(ModulesListView, Item1, Item2, Compare); +end; + +procedure TModulesDumpForm.FileProp1Update(Sender: TObject); +begin + FileProp1.Enabled := Assigned(ModulesListView.Selected); +end; + +procedure TModulesDumpForm.FileProp1Execute(Sender: TObject); +begin + DisplayPropDialog(Application.Handle, SelectedFileName); +end; + +procedure TModulesDumpForm.ModulesListViewInfoTip(Sender: TObject; + Item: TListItem; var InfoTip: String); +begin + InfoTip := InfoTipVersionString(Item.SubItems[2]); +end; + +procedure TModulesDumpForm.DumpPe1Execute(Sender: TObject); +begin + GlobalModule.ViewPE(ModulesListView.Selected.SubItems[2]); +end; + +procedure TModulesDumpForm.DumpPe1Update(Sender: TObject); +begin + DumpPe1.Enabled := GlobalModule.PeViewerRegistred and Assigned(ModulesListView.Selected) +end; + +// History: + +// $Log: ModulesDump.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dof b/official/1.96/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dof new file mode 100644 index 0000000..229fd00 --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dof @@ -0,0 +1,134 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir=..\..\..\..\bin +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=..\..\..\..\source;..\..\..\..\source\common;..\..\..\..\source\windows;..\..\..\..\source\vcl +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=0 +MinorVer=5 +Release=4 +Build=65 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1033 +CodePage=1252 +[Version Info Keys] +CompanyName=Petr Vones +FileDescription=ToolHelp Viewer for Win95/98/2000 +FileVersion=0.5.4.65 +InternalName=TOOLHELPVIEWER +LegalCopyright=(c) 2002 Petr Vones +LegalTrademarks= +OriginalFilename=TOOLHELPVIEWER.EXE +ProductName=ToolHelp Viewer +ProductVersion=0.5.4 diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dpr b/official/1.96/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dpr new file mode 100644 index 0000000..4820cca --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dpr @@ -0,0 +1,32 @@ +program ToolHelpViewer; + +uses + Forms, + SysUtils, + JclAppInst, + Main in 'Main.pas' {MainForm}, + ChangePriority in 'ChangePriority.pas' {ChangePriorityDlg}, + HeapDump in 'HeapDump.pas' {HeapDumpForm}, + MemoryDump in 'MemoryDump.pas' {MemoryDumpForm}, + Global in 'Global.pas' {GlobalModule: TDataModule}, + ViewTemplate in 'ViewTemplate.pas' {ViewForm}, + ModulesDump in 'ModulesDump.pas' {ModulesDumpForm}, + ToolsUtils in '..\Common\ToolsUtils.pas', + About in '..\Common\About.pas' {AboutBox}, + FindDlg in '..\Common\FindDlg.pas' {FindForm}, + ExceptDlg in '..\..\..\..\experts\debug\dialog\ExceptDlg.pas' {ExceptionDialog}; + +{$R *.RES} + +begin + try + JclAppInstances.CheckSingleInstance; + Application.Initialize; + Application.Title := 'ToolHelp Viewer'; + Application.CreateForm(TGlobalModule, GlobalModule); + Application.CreateForm(TMainForm, MainForm); + Application.Run; + except // fix for Delphi 5's RTL bug + SysUtils.ShowException(ExceptObject, ExceptAddr); + end; +end. diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/ToolHelpViewer.res b/official/1.96/examples/windows/delphitools/toolhelpview/ToolHelpViewer.res new file mode 100644 index 0000000..12a2ffd Binary files /dev/null and b/official/1.96/examples/windows/delphitools/toolhelpview/ToolHelpViewer.res differ diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/ViewTemplate.dfm b/official/1.96/examples/windows/delphitools/toolhelpview/ViewTemplate.dfm new file mode 100644 index 0000000..4ef2a5c --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/ViewTemplate.dfm @@ -0,0 +1,109 @@ +object ViewForm: TViewForm + Left = 288 + Top = 168 + Width = 348 + Height = 301 + BorderStyle = bsSizeToolWin + Caption = 'ViewForm' + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 300 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poDefaultPosOnly + ShowHint = True + OnClose = FormClose + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object CoolBar: TCoolBar + Left = 0 + Top = 0 + Width = 340 + Height = 26 + AutoSize = True + Bands = < + item + Control = ToolBar + ImageIndex = -1 + MinHeight = 22 + Width = 336 + end> + PopupMenu = ToolBarPopupMenu + object ToolBar: TToolBar + Left = 9 + Top = 0 + Width = 323 + Height = 22 + AutoSize = True + Caption = 'ToolBar' + EdgeBorders = [] + Flat = True + Images = GlobalModule.ToolbarImagesList + TabOrder = 0 + end + end + object ActionList: TActionList + Images = GlobalModule.ToolbarImagesList + Left = 8 + Top = 224 + object TextLabels1: TAction + Caption = 'Text labels' + OnExecute = TextLabels1Execute + end + object Copy1: TAction + Caption = 'Copy' + Hint = 'Copy to clipboard' + ImageIndex = 9 + ShortCut = 16451 + OnExecute = Copy1Execute + OnUpdate = Copy1Update + end + object SaveToFile1: TAction + Caption = 'Save' + Hint = 'Save to text file' + ImageIndex = 3 + ShortCut = 16467 + OnExecute = SaveToFile1Execute + OnUpdate = Copy1Update + end + object Refresh1: TAction + Caption = 'Refresh' + Hint = 'Refresh the list' + ImageIndex = 2 + ShortCut = 116 + end + object SelectAll1: TAction + Caption = 'Select all' + Hint = 'Select all listview items' + ImageIndex = 17 + ShortCut = 16449 + OnExecute = SelectAll1Execute + OnUpdate = SelectAll1Update + end + object Find1: TAction + Caption = 'Find text' + Hint = 'Find text' + ImageIndex = 7 + ShortCut = 16454 + OnExecute = Find1Execute + OnUpdate = Find1Update + end + end + object PopupMenu: TPopupMenu + Images = GlobalModule.ToolbarImagesList + Left = 40 + Top = 224 + end + object ToolBarPopupMenu: TPopupMenu + Left = 72 + Top = 224 + object Textlabels2: TMenuItem + Action = TextLabels1 + end + end +end diff --git a/official/1.96/examples/windows/delphitools/toolhelpview/ViewTemplate.pas b/official/1.96/examples/windows/delphitools/toolhelpview/ViewTemplate.pas new file mode 100644 index 0000000..964207c --- /dev/null +++ b/official/1.96/examples/windows/delphitools/toolhelpview/ViewTemplate.pas @@ -0,0 +1,162 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) - Delphi Tools } +{ } +{ 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 ViewTemplate.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): } +{ } +{**************************************************************************************************} +{ } +{ Last modified: $Date: 2005/10/27 01:44:51 $ } +{ } +{**************************************************************************************************} + +unit ViewTemplate; + +{$I JCL.INC} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ToolWin, ComCtrls, ActnList, Menus; + +const + UM_BUILD = WM_USER + $100; + +type + TViewForm = class(TForm) + CoolBar: TCoolBar; + ToolBar: TToolBar; + ActionList: TActionList; + PopupMenu: TPopupMenu; + TextLabels1: TAction; + ToolBarPopupMenu: TPopupMenu; + Textlabels2: TMenuItem; + Copy1: TAction; + SaveToFile1: TAction; + Refresh1: TAction; + SelectAll1: TAction; + Find1: TAction; + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure FormShow(Sender: TObject); + procedure TextLabels1Execute(Sender: TObject); + procedure SelectAll1Update(Sender: TObject); + procedure SelectAll1Execute(Sender: TObject); + procedure Copy1Update(Sender: TObject); + procedure Copy1Execute(Sender: TObject); + procedure SaveToFile1Execute(Sender: TObject); + procedure Find1Update(Sender: TObject); + procedure Find1Execute(Sender: TObject); + private + procedure UpdateTextLabels; + procedure UMBuild(var Msg: TMessage); message UM_BUILD; + public + procedure BuildContent; dynamic; abstract; + procedure PostBuildContentMessage; + end; + +var + ViewForm: TViewForm; + +implementation + +uses Main, Global, ToolsUtils, About, FindDlg; + +{$R *.DFM} + +procedure TViewForm.FormClose(Sender: TObject; var Action: TCloseAction); +begin + MainForm.DeleteFromViewsMenu(Self); + Action := caFree; +end; + +procedure TViewForm.FormShow(Sender: TObject); +begin + MainForm.AddToViewsMenu(Self, Caption); +end; + +procedure TViewForm.TextLabels1Execute(Sender: TObject); +begin + with TextLabels1 do Checked := not Checked; + UpdateTextLabels; +end; + +procedure TViewForm.UpdateTextLabels; +begin + ToolBar.ShowCaptions := TextLabels1.Checked; + if not ToolBar.ShowCaptions then + begin + ToolBar.ButtonHeight := 0; + ToolBar.ButtonWidth := 0; + end; +end; + +procedure TViewForm.Copy1Update(Sender: TObject); +begin + TAction(Sender).Enabled := ActiveControl is TListView; +end; + +procedure TViewForm.SelectAll1Update(Sender: TObject); +begin + TAction(Sender).Enabled := + (ActiveControl is TListView) and TListView(ActiveControl).MultiSelect; +end; + +procedure TViewForm.SelectAll1Execute(Sender: TObject); +begin + ListViewSelectAll(ActiveControl as TListView); +end; + +procedure TViewForm.Copy1Execute(Sender: TObject); +begin + GlobalModule.ListViewToClipboard(ActiveControl as TListView); +end; + +procedure TViewForm.SaveToFile1Execute(Sender: TObject); +begin + GlobalModule.ListViewToFile(ActiveControl as TListView, Caption); +end; + +procedure TViewForm.UMBuild(var Msg: TMessage); +begin + Update; + BuildContent; +end; + +procedure TViewForm.PostBuildContentMessage; +begin + PostMessage(Handle, UM_BUILD, 0, 0); +end; + +procedure TViewForm.Find1Update(Sender: TObject); +begin + TAction(Sender).Enabled := + (ActiveControl is TListView) and not TListView(ActiveControl).HideSelection; +end; + +procedure TViewForm.Find1Execute(Sender: TObject); +begin + ShowFindDialog(ActiveControl as TListView); +end; + +// History: + +// $Log: ViewTemplate.pas,v $ +// Revision 1.2 2005/10/27 01:44:51 rrossmair +// - added MPL headers and CVS Log tags +// + +end. diff --git a/official/1.96/examples/windows/edisdk/Clean.bat b/official/1.96/examples/windows/edisdk/Clean.bat new file mode 100644 index 0000000..2bca898 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/Clean.bat @@ -0,0 +1,18 @@ +@echo off +if exist *.~* del *.~* +if exist *.dcu del *.dcu +if exist *.dpl del *.dpl +if exist *.bpl del *.bpl +if exist *.bpi del *.bpi +if exist *.lsp del *.lsp +if exist *.dcp del *.dcp +if exist *.dpc del *.dpc +if exist *.bak del *.bak +if exist *.obj del *.obj +if exist *.hpp del *.hpp +if exist *.lib del *.lib +if exist *.exe del *.exe +if exist *.dsk del *.dsk + + + diff --git a/official/1.96/examples/windows/edisdk/EDICOMExample.dof b/official/1.96/examples/windows/edisdk/EDICOMExample.dof new file mode 100644 index 0000000..abe45c2 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/EDICOMExample.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=..\..\..\bin diff --git a/official/1.96/examples/windows/edisdk/EDICOMExample.dpr b/official/1.96/examples/windows/edisdk/EDICOMExample.dpr new file mode 100644 index 0000000..9c6d63c --- /dev/null +++ b/official/1.96/examples/windows/edisdk/EDICOMExample.dpr @@ -0,0 +1,13 @@ +program EDICOMExample; + +uses + Forms, + EDICOMExampleMain in 'EDICOMExampleMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/edisdk/EDICOMExample.res b/official/1.96/examples/windows/edisdk/EDICOMExample.res new file mode 100644 index 0000000..55f8742 Binary files /dev/null and b/official/1.96/examples/windows/edisdk/EDICOMExample.res differ diff --git a/official/1.96/examples/windows/edisdk/EDICOMExampleMain.dfm b/official/1.96/examples/windows/edisdk/EDICOMExampleMain.dfm new file mode 100644 index 0000000..a9e6b25 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/EDICOMExampleMain.dfm @@ -0,0 +1,50 @@ +object Form1: TForm1 + Left = 192 + Top = 107 + Width = 696 + Height = 480 + Caption = 'Form1' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object Button1: TButton + Left = 32 + Top = 4 + Width = 75 + Height = 25 + Caption = 'Button1' + TabOrder = 0 + OnClick = Button1Click + end + object Memo1: TMemo + Left = 0 + Top = 36 + Width = 688 + Height = 417 + Anchors = [akLeft, akTop, akRight, akBottom] + Lines.Strings = ( + 'Memo1') + TabOrder = 1 + end + object Button2: TButton + Left = 120 + Top = 4 + Width = 75 + Height = 25 + Caption = 'Button2' + TabOrder = 2 + OnClick = Button2Click + end + object F: TEDICOMFile + AutoConnect = False + ConnectKind = ckRunningOrNew + Left = 64 + Top = 32 + end +end diff --git a/official/1.96/examples/windows/edisdk/EDICOMExampleMain.pas b/official/1.96/examples/windows/edisdk/EDICOMExampleMain.pas new file mode 100644 index 0000000..48cfdec --- /dev/null +++ b/official/1.96/examples/windows/edisdk/EDICOMExampleMain.pas @@ -0,0 +1,157 @@ +unit EDICOMExampleMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, OleServer, EDISDK_TLB; + +type + TForm1 = class(TForm) + F: TEDICOMFile; + Button1: TButton; + Memo1: TMemo; + Button2: TButton; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +procedure TForm1.Button1Click(Sender: TObject); +var + I: Integer; +begin + F.Options := 0; + F.Options := F.Options or foVariableDelimiterDetection; + F.Options := F.Options or foUseAltDelimiterDetection; + F.Options := F.Options or foRemoveCrLf; + F.Options := F.Options or foRemoveCr; + F.Options := F.Options or foRemoveLf; + F.Options := F.Options or foIgnoreGarbageAtEndOfFile; + F.LoadFromFile(ExtractFileDir(Application.ExeName) + '\sample.edi'); + Memo1.Lines.Add( F.Data ); + F.Disassemble; + Memo1.Lines.Add(F.Interchange[0].SegmentISA.SegmentId); + Memo1.Lines.Add(F.Interchange[0].FunctionalGroup[0].SegmentGS.SegmentId); + Memo1.Lines.Add(F.Interchange[0].FunctionalGroup[0].TransactionSet[0].SegmentST.SegmentId); + for I := 0 to F.Interchange[0].FunctionalGroup[0].TransactionSet[0].SegmentCount - 1 do + begin + F.Interchange[0].FunctionalGroup[0].TransactionSet[0].Segment[I].Assemble; + Memo1.Lines.Add( F.Interchange[0].FunctionalGroup[0].TransactionSet[0].Segment[I].Data ); + end; + Memo1.Lines.Add(F.Interchange[0].FunctionalGroup[0].TransactionSet[0].Segment[0].Data); + Memo1.Lines.Add(F.Interchange[0].FunctionalGroup[0].TransactionSet[0].SegmentSE.SegmentId); + Memo1.Lines.Add(F.Interchange[0].FunctionalGroup[0].SegmentGE.SegmentId); + Memo1.Lines.Add(F.Interchange[0].SegmentIEA.SegmentId); +end; + +procedure TForm1.Button2Click(Sender: TObject); +var + C: IEDICOMFile; + I, F, T, S: Integer; +begin + Memo1.Lines.Clear; + + C := CoEDICOMFile.Create; + I := C.AddInterchange; + C.Interchange[I].SetDelimiters('~' + #13#10, '*', '>'); + with C.Interchange[I].SegmentISA do + begin + SegmentId := 'ISA'; + DeleteElements; + AddElements(17); + Element[0].Data := 'data'; + Element[1].Data := 'data'; + Element[2].Data := 'data'; + Element[3].Data := 'data'; + Element[4].Data := 'data'; + Element[5].Data := 'data'; + Element[6].Data := 'data'; + Element[7].Data := 'data'; + Element[8].Data := 'data'; + Element[9].Data := 'data'; + Element[10].Data := 'data'; + Element[11].Data := 'data'; + Element[12].Data := 'data'; + Element[13].Data := 'data'; + Element[14].Data := 'data'; + Element[15].Data := 'data'; + Element[16].Data := C.Interchange[I].Delimiters.SS; + end; + + F := C.Interchange[I].AddFunctionalGroup; + with C.Interchange[I].FunctionalGroup[F].SegmentGS do + begin + SegmentId := 'GS'; + DeleteElements; + AddElements(8); + Element[0].Data := 'data'; + Element[1].Data := 'data'; + Element[2].Data := 'data'; + Element[3].Data := 'data'; + Element[4].Data := 'data'; + Element[5].Data := 'data'; + Element[6].Data := 'data'; + Element[7].Data := 'data'; + end; + + T := C.Interchange[I].FunctionalGroup[F].AddTransactionSet; + with C.Interchange[I].FunctionalGroup[F].TransactionSet[T].SegmentST do + begin + SegmentId := 'ST'; + DeleteElements; + AddElements(2); + Element[0].Data := 'data'; + Element[1].Data := 'data'; + end; + + S := C.Interchange[I].FunctionalGroup[F].TransactionSet[T].AddSegment; + with C.Interchange[I].FunctionalGroup[F].TransactionSet[T].Segment[S] do + begin + SegmentId := 'TST'; + AddElements(2); + Element[0].Data := 'data 1'; + Element[1].Data := 'data 2'; + end; + + with C.Interchange[I].FunctionalGroup[F].TransactionSet[T].SegmentSE do + begin + SegmentId := 'SE'; + DeleteElements; + AddElements(2); + Element[0].Data := 'data'; + Element[1].Data := 'data'; + end; + + with C.Interchange[I].FunctionalGroup[F].SegmentGE do + begin + SegmentId := 'GE'; + DeleteElements; + AddElements(2); + Element[0].Data := 'data'; + Element[1].Data := 'data'; + end; + + with C.Interchange[I].SegmentIEA do + begin + SegmentId := 'IEA'; + DeleteElements; + AddElements(2); + Element[0].Data := 'data'; + Element[1].Data := 'data'; + end; + + Memo1.Lines.Add( C.Assemble ); +end; + +end. diff --git a/official/1.96/examples/windows/edisdk/EDISDK_TLB.dcr b/official/1.96/examples/windows/edisdk/EDISDK_TLB.dcr new file mode 100644 index 0000000..4961f7d Binary files /dev/null and b/official/1.96/examples/windows/edisdk/EDISDK_TLB.dcr differ diff --git a/official/1.96/examples/windows/edisdk/EDISDK_TLB.pas b/official/1.96/examples/windows/edisdk/EDISDK_TLB.pas new file mode 100644 index 0000000..8027ed4 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/EDISDK_TLB.pas @@ -0,0 +1,1021 @@ +unit EDISDK_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: 1.1 $ +// File generated on 17.7.2004 03:10:43 from Type Library described below. + +// *************************************************************************// +// 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. +// ************************************************************************ // +// Type Lib: I:\Quellen\jedi\jcl\examples\vcl\edisdk\comserver\EDISDK.dll (1) +// IID\LCID: {AF3BB992-62DF-41B7-92C7-FA41BDBB427E}\0 +// Helpfile: +// DepndLst: +// (1) v2.0 stdole, (F:\WINNT\system32\STDOLE2.TLB) +// (2) v4.0 StdVCL, (F:\WINNT\system32\STDVCL40.DLL) +// ************************************************************************ // +{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. +interface + +uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL; + +// *********************************************************************// +// 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 + EDISDKMajorVersion = 1; + EDISDKMinorVersion = 0; + + LIBID_EDISDK: TGUID = '{AF3BB992-62DF-41B7-92C7-FA41BDBB427E}'; + + IID_IEDICOMDelimiters: TGUID = '{A0181BBD-2F88-4FDC-9752-8303519D2D62}'; + CLASS_EDICOMDelimiters: TGUID = '{30B8A020-5D35-4ED8-B889-C13F309AE308}'; + IID_IEDICOMDataObject: TGUID = '{C7037767-05C8-4C6F-8201-655A6B5A4CF4}'; + IID_IEDICOMDataObjectGroup: TGUID = '{AEADBE04-6D1C-493E-BE6B-51E96BAD3680}'; + IID_IEDICOMElement: TGUID = '{E4ED3376-38AA-423C-9160-AAD190ACCB35}'; + CLASS_EDICOMElement: TGUID = '{4EFCADAA-60D0-4D61-875C-A27D6BCE932B}'; + IID_IEDICOMSegment: TGUID = '{467C692E-C22F-44B5-ACDB-C7A337B68675}'; + CLASS_EDICOMSegment: TGUID = '{63946EB6-DBDF-44FB-AAA4-123E7C2275B6}'; + IID_IEDICOMTransactionSet: TGUID = '{B2300104-4FF0-40A3-ABED-29E2A36C1844}'; + CLASS_EDICOMTransactionSet: TGUID = '{B540FDFC-B0D0-4E74-A7F4-B09DC260E656}'; + IID_IEDICOMFunctionalGroup: TGUID = '{C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31}'; + CLASS_EDICOMFunctionalGroup: TGUID = '{C69EA833-88BF-4D55-AFC0-264F1B7ED54C}'; + IID_IEDICOMInterchangeControl: TGUID = '{B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A}'; + CLASS_EDICOMInterchangeControl: TGUID = '{EF07065C-6E35-41B6-9564-D2D5714600A8}'; + IID_IEDICOMFile: TGUID = '{DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F}'; + CLASS_EDICOMFile: TGUID = '{E8400822-5701-4226-8F78-A784B3777CB9}'; + +// *********************************************************************// +// Declaration of Enumerations defined in Type Library +// *********************************************************************// +// Constants for enum EDICOMDataObjectDataState +type + EDICOMDataObjectDataState = TOleEnum; +const + ediCreated = $00000000; + ediAssembled = $00000001; + ediDisassembled = $00000002; + +// Constants for enum EDIFileOptions +type + EDIFileOptions = TOleEnum; +const + foNone = $00000000; + foVariableDelimiterDetection = $00000001; + foUseAltDelimiterDetection = $00000002; + foRemoveCrLf = $00000004; + foRemoveCr = $00000008; + foRemoveLf = $00000010; + foIgnoreGarbageAtEndOfFile = $00000020; + +type + +// *********************************************************************// +// Forward declaration of types defined in TypeLibrary +// *********************************************************************// + IEDICOMDelimiters = interface; + IEDICOMDelimitersDisp = dispinterface; + IEDICOMDataObject = interface; + IEDICOMDataObjectDisp = dispinterface; + IEDICOMDataObjectGroup = interface; + IEDICOMDataObjectGroupDisp = dispinterface; + IEDICOMElement = interface; + IEDICOMElementDisp = dispinterface; + IEDICOMSegment = interface; + IEDICOMSegmentDisp = dispinterface; + IEDICOMTransactionSet = interface; + IEDICOMTransactionSetDisp = dispinterface; + IEDICOMFunctionalGroup = interface; + IEDICOMFunctionalGroupDisp = dispinterface; + IEDICOMInterchangeControl = interface; + IEDICOMInterchangeControlDisp = dispinterface; + IEDICOMFile = interface; + IEDICOMFileDisp = dispinterface; + +// *********************************************************************// +// Declaration of CoClasses defined in Type Library +// (NOTE: Here we map each CoClass to its Default Interface) +// *********************************************************************// + EDICOMDelimiters = IEDICOMDelimiters; + EDICOMElement = IEDICOMElement; + EDICOMSegment = IEDICOMSegment; + EDICOMTransactionSet = IEDICOMTransactionSet; + EDICOMFunctionalGroup = IEDICOMFunctionalGroup; + EDICOMInterchangeControl = IEDICOMInterchangeControl; + EDICOMFile = IEDICOMFile; + + +// *********************************************************************// +// Interface: IEDICOMDelimiters +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A0181BBD-2F88-4FDC-9752-8303519D2D62} +// *********************************************************************// + IEDICOMDelimiters = interface(IDispatch) + ['{A0181BBD-2F88-4FDC-9752-8303519D2D62}'] + function Get_SD: WideString; safecall; + procedure Set_SD(const Value: WideString); safecall; + function Get_ED: WideString; safecall; + procedure Set_ED(const Value: WideString); safecall; + function Get_SS: WideString; safecall; + procedure Set_SS(const Value: WideString); safecall; + function Get_SDLen: Integer; safecall; + function Get_EDLen: Integer; safecall; + function Get_SSLen: Integer; safecall; + property SD: WideString read Get_SD write Set_SD; + property ED: WideString read Get_ED write Set_ED; + property SS: WideString read Get_SS write Set_SS; + property SDLen: Integer read Get_SDLen; + property EDLen: Integer read Get_EDLen; + property SSLen: Integer read Get_SSLen; + end; + +// *********************************************************************// +// DispIntf: IEDICOMDelimitersDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A0181BBD-2F88-4FDC-9752-8303519D2D62} +// *********************************************************************// + IEDICOMDelimitersDisp = dispinterface + ['{A0181BBD-2F88-4FDC-9752-8303519D2D62}'] + property SD: WideString dispid 201; + property ED: WideString dispid 202; + property SS: WideString dispid 203; + property SDLen: Integer readonly dispid 204; + property EDLen: Integer readonly dispid 205; + property SSLen: Integer readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMDataObject +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C7037767-05C8-4C6F-8201-655A6B5A4CF4} +// *********************************************************************// + IEDICOMDataObject = interface(IDispatch) + ['{C7037767-05C8-4C6F-8201-655A6B5A4CF4}'] + function Assemble: WideString; safecall; + procedure Disassemble; safecall; + function Get_State: Integer; safecall; + function Get_Data: WideString; safecall; + procedure Set_Data(const Value: WideString); safecall; + function Get_DataLength: Integer; safecall; + function Get_Delimiters: IEDICOMDelimiters; safecall; + property State: Integer read Get_State; + property Data: WideString read Get_Data write Set_Data; + property DataLength: Integer read Get_DataLength; + property Delimiters: IEDICOMDelimiters read Get_Delimiters; + end; + +// *********************************************************************// +// DispIntf: IEDICOMDataObjectDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C7037767-05C8-4C6F-8201-655A6B5A4CF4} +// *********************************************************************// + IEDICOMDataObjectDisp = dispinterface + ['{C7037767-05C8-4C6F-8201-655A6B5A4CF4}'] + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMDataObjectGroup +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AEADBE04-6D1C-493E-BE6B-51E96BAD3680} +// *********************************************************************// + IEDICOMDataObjectGroup = interface(IEDICOMDataObject) + ['{AEADBE04-6D1C-493E-BE6B-51E96BAD3680}'] + end; + +// *********************************************************************// +// DispIntf: IEDICOMDataObjectGroupDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AEADBE04-6D1C-493E-BE6B-51E96BAD3680} +// *********************************************************************// + IEDICOMDataObjectGroupDisp = dispinterface + ['{AEADBE04-6D1C-493E-BE6B-51E96BAD3680}'] + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMElement +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E4ED3376-38AA-423C-9160-AAD190ACCB35} +// *********************************************************************// + IEDICOMElement = interface(IEDICOMDataObject) + ['{E4ED3376-38AA-423C-9160-AAD190ACCB35}'] + end; + +// *********************************************************************// +// DispIntf: IEDICOMElementDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E4ED3376-38AA-423C-9160-AAD190ACCB35} +// *********************************************************************// + IEDICOMElementDisp = dispinterface + ['{E4ED3376-38AA-423C-9160-AAD190ACCB35}'] + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMSegment +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {467C692E-C22F-44B5-ACDB-C7A337B68675} +// *********************************************************************// + IEDICOMSegment = interface(IEDICOMDataObjectGroup) + ['{467C692E-C22F-44B5-ACDB-C7A337B68675}'] + function Get_Element(Index: Integer): IEDICOMElement; safecall; + function Get_SegmentId: WideString; safecall; + procedure Set_SegmentId(const Value: WideString); safecall; + function AddElement: Integer; safecall; + function InsertElement(InsertIndex: Integer): Integer; safecall; + procedure DeleteElement(Index: Integer); safecall; + function AddElements(Count: Integer): Integer; safecall; + function InsertElements(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteElements; safecall; + function Get_ElementCount: Integer; safecall; + property Element[Index: Integer]: IEDICOMElement read Get_Element; + property SegmentId: WideString read Get_SegmentId write Set_SegmentId; + property ElementCount: Integer read Get_ElementCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMSegmentDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {467C692E-C22F-44B5-ACDB-C7A337B68675} +// *********************************************************************// + IEDICOMSegmentDisp = dispinterface + ['{467C692E-C22F-44B5-ACDB-C7A337B68675}'] + property Element[Index: Integer]: IEDICOMElement readonly dispid 401; + property SegmentId: WideString dispid 402; + function AddElement: Integer; dispid 403; + function InsertElement(InsertIndex: Integer): Integer; dispid 404; + procedure DeleteElement(Index: Integer); dispid 405; + function AddElements(Count: Integer): Integer; dispid 406; + function InsertElements(InsertIndex: Integer; Count: Integer): Integer; dispid 407; + procedure DeleteElements; dispid 408; + property ElementCount: Integer readonly dispid 409; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMTransactionSet +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B2300104-4FF0-40A3-ABED-29E2A36C1844} +// *********************************************************************// + IEDICOMTransactionSet = interface(IEDICOMDataObjectGroup) + ['{B2300104-4FF0-40A3-ABED-29E2A36C1844}'] + function Get_SegmentST: IEDICOMSegment; safecall; + function Get_SegmentSE: IEDICOMSegment; safecall; + function Get_Segment(Index: Integer): IEDICOMSegment; safecall; + function AddSegment: Integer; safecall; + function InsertSegment(InsertIndex: Integer): Integer; safecall; + procedure DeleteSegment(Index: Integer); safecall; + function AddSegments(Count: Integer): Integer; safecall; + function InsertSegments(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteSegments; safecall; + function Get_SegmentCount: Integer; safecall; + property SegmentST: IEDICOMSegment read Get_SegmentST; + property SegmentSE: IEDICOMSegment read Get_SegmentSE; + property Segment[Index: Integer]: IEDICOMSegment read Get_Segment; + property SegmentCount: Integer read Get_SegmentCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMTransactionSetDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B2300104-4FF0-40A3-ABED-29E2A36C1844} +// *********************************************************************// + IEDICOMTransactionSetDisp = dispinterface + ['{B2300104-4FF0-40A3-ABED-29E2A36C1844}'] + property SegmentST: IEDICOMSegment readonly dispid 401; + property SegmentSE: IEDICOMSegment readonly dispid 402; + property Segment[Index: Integer]: IEDICOMSegment readonly dispid 403; + function AddSegment: Integer; dispid 404; + function InsertSegment(InsertIndex: Integer): Integer; dispid 405; + procedure DeleteSegment(Index: Integer); dispid 406; + function AddSegments(Count: Integer): Integer; dispid 407; + function InsertSegments(InsertIndex: Integer; Count: Integer): Integer; dispid 408; + procedure DeleteSegments; dispid 409; + property SegmentCount: Integer readonly dispid 410; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMFunctionalGroup +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31} +// *********************************************************************// + IEDICOMFunctionalGroup = interface(IEDICOMDataObjectGroup) + ['{C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31}'] + function Get_SegmentGS: IEDICOMSegment; safecall; + function Get_SegmentGE: IEDICOMSegment; safecall; + function Get_TransactionSet(Index: Integer): IEDICOMTransactionSet; safecall; + function AddTransactionSet: Integer; safecall; + function InsertTransactionSet(InsertIndex: Integer): Integer; safecall; + procedure DeleteTransactionSet(Index: Integer); safecall; + function AddTransactionSets(Count: Integer): Integer; safecall; + function InsertTransactionSets(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteTransactionSets; safecall; + function Get_TransactionSetCount: Integer; safecall; + property SegmentGS: IEDICOMSegment read Get_SegmentGS; + property SegmentGE: IEDICOMSegment read Get_SegmentGE; + property TransactionSet[Index: Integer]: IEDICOMTransactionSet read Get_TransactionSet; + property TransactionSetCount: Integer read Get_TransactionSetCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMFunctionalGroupDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31} +// *********************************************************************// + IEDICOMFunctionalGroupDisp = dispinterface + ['{C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31}'] + property SegmentGS: IEDICOMSegment readonly dispid 401; + property SegmentGE: IEDICOMSegment readonly dispid 402; + property TransactionSet[Index: Integer]: IEDICOMTransactionSet readonly dispid 403; + function AddTransactionSet: Integer; dispid 404; + function InsertTransactionSet(InsertIndex: Integer): Integer; dispid 405; + procedure DeleteTransactionSet(Index: Integer); dispid 406; + function AddTransactionSets(Count: Integer): Integer; dispid 407; + function InsertTransactionSets(InsertIndex: Integer; Count: Integer): Integer; dispid 408; + procedure DeleteTransactionSets; dispid 409; + property TransactionSetCount: Integer readonly dispid 410; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMInterchangeControl +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A} +// *********************************************************************// + IEDICOMInterchangeControl = interface(IEDICOMDataObjectGroup) + ['{B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A}'] + function Get_SegmentISA: IEDICOMSegment; safecall; + function Get_SegmentIEA: IEDICOMSegment; safecall; + function Get_FunctionalGroup(Index: Integer): IEDICOMFunctionalGroup; safecall; + function AddFunctionalGroup: Integer; safecall; + function InsertFunctionalGroup(InsertIndex: Integer): Integer; safecall; + procedure DeleteFunctionalGroup(Index: Integer); safecall; + function AddFunctionalGroups(InsertIndex: Integer): Integer; safecall; + function InsertFunctionalGroups(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteFunctionalGroups; safecall; + procedure SetDelimiters(const SD: WideString; const ED: WideString; const SS: WideString); safecall; + function Get_FunctionalGroupCount: Integer; safecall; + property SegmentISA: IEDICOMSegment read Get_SegmentISA; + property SegmentIEA: IEDICOMSegment read Get_SegmentIEA; + property FunctionalGroup[Index: Integer]: IEDICOMFunctionalGroup read Get_FunctionalGroup; + property FunctionalGroupCount: Integer read Get_FunctionalGroupCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMInterchangeControlDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A} +// *********************************************************************// + IEDICOMInterchangeControlDisp = dispinterface + ['{B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A}'] + property SegmentISA: IEDICOMSegment readonly dispid 401; + property SegmentIEA: IEDICOMSegment readonly dispid 402; + property FunctionalGroup[Index: Integer]: IEDICOMFunctionalGroup readonly dispid 403; + function AddFunctionalGroup: Integer; dispid 404; + function InsertFunctionalGroup(InsertIndex: Integer): Integer; dispid 405; + procedure DeleteFunctionalGroup(Index: Integer); dispid 406; + function AddFunctionalGroups(InsertIndex: Integer): Integer; dispid 407; + function InsertFunctionalGroups(InsertIndex: Integer; Count: Integer): Integer; dispid 408; + procedure DeleteFunctionalGroups; dispid 409; + procedure SetDelimiters(const SD: WideString; const ED: WideString; const SS: WideString); dispid 410; + property FunctionalGroupCount: Integer readonly dispid 411; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMFile +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F} +// *********************************************************************// + IEDICOMFile = interface(IEDICOMDataObjectGroup) + ['{DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F}'] + procedure LoadFromFile(const FileName: WideString); safecall; + procedure ReLoadFromFile; safecall; + procedure SaveToFile; safecall; + procedure SaveAsToFile(const FileName: WideString); safecall; + function Get_FileName: WideString; safecall; + procedure Set_FileName(const Value: WideString); safecall; + function Get_Interchange(Index: Integer): IEDICOMInterchangeControl; safecall; + function Get_Options: Byte; safecall; + procedure Set_Options(Value: Byte); safecall; + function AddInterchange: Integer; safecall; + function InsertInterchange(InsertIndex: Integer): Integer; safecall; + procedure DeleteInterchange(Index: Integer); safecall; + function AddInterchanges(Count: Integer): Integer; safecall; + function InsertInterchanges(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteInterchanges; safecall; + function Get_InterchangeCount: Integer; safecall; + property FileName: WideString read Get_FileName write Set_FileName; + property Interchange[Index: Integer]: IEDICOMInterchangeControl read Get_Interchange; + property Options: Byte read Get_Options write Set_Options; + property InterchangeCount: Integer read Get_InterchangeCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMFileDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F} +// *********************************************************************// + IEDICOMFileDisp = dispinterface + ['{DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F}'] + procedure LoadFromFile(const FileName: WideString); dispid 401; + procedure ReLoadFromFile; dispid 402; + procedure SaveToFile; dispid 403; + procedure SaveAsToFile(const FileName: WideString); dispid 404; + property FileName: WideString dispid 405; + property Interchange[Index: Integer]: IEDICOMInterchangeControl readonly dispid 406; + property Options: Byte dispid 407; + function AddInterchange: Integer; dispid 408; + function InsertInterchange(InsertIndex: Integer): Integer; dispid 409; + procedure DeleteInterchange(Index: Integer); dispid 410; + function AddInterchanges(Count: Integer): Integer; dispid 411; + function InsertInterchanges(InsertIndex: Integer; Count: Integer): Integer; dispid 412; + procedure DeleteInterchanges; dispid 413; + property InterchangeCount: Integer readonly dispid 414; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// The Class CoEDICOMDelimiters provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMDelimiters exposed by +// the CoClass EDICOMDelimiters. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMDelimiters = class + class function Create: IEDICOMDelimiters; + class function CreateRemote(const MachineName: string): IEDICOMDelimiters; + end; + +// *********************************************************************// +// The Class CoEDICOMElement provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMElement exposed by +// the CoClass EDICOMElement. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMElement = class + class function Create: IEDICOMElement; + class function CreateRemote(const MachineName: string): IEDICOMElement; + end; + +// *********************************************************************// +// The Class CoEDICOMSegment provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMSegment exposed by +// the CoClass EDICOMSegment. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMSegment = class + class function Create: IEDICOMSegment; + class function CreateRemote(const MachineName: string): IEDICOMSegment; + end; + +// *********************************************************************// +// The Class CoEDICOMTransactionSet provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMTransactionSet exposed by +// the CoClass EDICOMTransactionSet. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMTransactionSet = class + class function Create: IEDICOMTransactionSet; + class function CreateRemote(const MachineName: string): IEDICOMTransactionSet; + end; + +// *********************************************************************// +// The Class CoEDICOMFunctionalGroup provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMFunctionalGroup exposed by +// the CoClass EDICOMFunctionalGroup. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMFunctionalGroup = class + class function Create: IEDICOMFunctionalGroup; + class function CreateRemote(const MachineName: string): IEDICOMFunctionalGroup; + end; + +// *********************************************************************// +// The Class CoEDICOMInterchangeControl provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMInterchangeControl exposed by +// the CoClass EDICOMInterchangeControl. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMInterchangeControl = class + class function Create: IEDICOMInterchangeControl; + class function CreateRemote(const MachineName: string): IEDICOMInterchangeControl; + end; + +// *********************************************************************// +// The Class CoEDICOMFile provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMFile exposed by +// the CoClass EDICOMFile. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMFile = class + class function Create: IEDICOMFile; + class function CreateRemote(const MachineName: string): IEDICOMFile; + end; + + +// *********************************************************************// +// OLE Server Proxy class declaration +// Server Object : TEDICOMFile +// Help String : +// Default Interface: IEDICOMFile +// Def. Intf. DISP? : No +// Event Interface: +// TypeFlags : (2) CanCreate +// *********************************************************************// +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + TEDICOMFileProperties= class; +{$ENDIF} + TEDICOMFile = class(TOleServer) + private + FIntf: IEDICOMFile; +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps: TEDICOMFileProperties; + function GetServerProperties: TEDICOMFileProperties; +{$ENDIF} + function GetDefaultInterface: IEDICOMFile; + protected + procedure InitServerData; override; + function Get_State: Integer; + function Get_Data: WideString; + procedure Set_Data(const Value: WideString); + function Get_DataLength: Integer; + function Get_Delimiters: IEDICOMDelimiters; + function Get_FileName: WideString; + procedure Set_FileName(const Value: WideString); + function Get_Interchange(Index: Integer): IEDICOMInterchangeControl; + function Get_Options: Byte; + procedure Set_Options(Value: Byte); + function Get_InterchangeCount: Integer; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Connect; override; + procedure ConnectTo(svrIntf: IEDICOMFile); + procedure Disconnect; override; + function Assemble: WideString; + procedure Disassemble; + procedure LoadFromFile(const FileName: WideString); + procedure ReLoadFromFile; + procedure SaveToFile; + procedure SaveAsToFile(const FileName: WideString); + function AddInterchange: Integer; + function InsertInterchange(InsertIndex: Integer): Integer; + procedure DeleteInterchange(Index: Integer); + function AddInterchanges(Count: Integer): Integer; + function InsertInterchanges(InsertIndex: Integer; Count: Integer): Integer; + procedure DeleteInterchanges; + property DefaultInterface: IEDICOMFile read GetDefaultInterface; + property State: Integer read Get_State; + property DataLength: Integer read Get_DataLength; + property Delimiters: IEDICOMDelimiters read Get_Delimiters; + property Interchange[Index: Integer]: IEDICOMInterchangeControl read Get_Interchange; + property InterchangeCount: Integer read Get_InterchangeCount; + property Data: WideString read Get_Data write Set_Data; + property FileName: WideString read Get_FileName write Set_FileName; + property Options: Byte read Get_Options write Set_Options; + published +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + property Server: TEDICOMFileProperties read GetServerProperties; +{$ENDIF} + end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +// *********************************************************************// +// OLE Server Properties Proxy Class +// Server Object : TEDICOMFile +// (This object is used by the IDE's Property Inspector to allow editing +// of the properties of this server) +// *********************************************************************// + TEDICOMFileProperties = class(TPersistent) + private + FServer: TEDICOMFile; + function GetDefaultInterface: IEDICOMFile; + constructor Create(AServer: TEDICOMFile); + protected + function Get_State: Integer; + function Get_Data: WideString; + procedure Set_Data(const Value: WideString); + function Get_DataLength: Integer; + function Get_Delimiters: IEDICOMDelimiters; + function Get_FileName: WideString; + procedure Set_FileName(const Value: WideString); + function Get_Interchange(Index: Integer): IEDICOMInterchangeControl; + function Get_Options: Byte; + procedure Set_Options(Value: Byte); + function Get_InterchangeCount: Integer; + public + property DefaultInterface: IEDICOMFile read GetDefaultInterface; + published + property Data: WideString read Get_Data write Set_Data; + property FileName: WideString read Get_FileName write Set_FileName; + property Options: Byte read Get_Options write Set_Options; + end; +{$ENDIF} + + +procedure Register; + +implementation + +uses ComObj; + +class function CoEDICOMDelimiters.Create: IEDICOMDelimiters; +begin + Result := CreateComObject(CLASS_EDICOMDelimiters) as IEDICOMDelimiters; +end; + +class function CoEDICOMDelimiters.CreateRemote(const MachineName: string): IEDICOMDelimiters; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMDelimiters) as IEDICOMDelimiters; +end; + +class function CoEDICOMElement.Create: IEDICOMElement; +begin + Result := CreateComObject(CLASS_EDICOMElement) as IEDICOMElement; +end; + +class function CoEDICOMElement.CreateRemote(const MachineName: string): IEDICOMElement; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMElement) as IEDICOMElement; +end; + +class function CoEDICOMSegment.Create: IEDICOMSegment; +begin + Result := CreateComObject(CLASS_EDICOMSegment) as IEDICOMSegment; +end; + +class function CoEDICOMSegment.CreateRemote(const MachineName: string): IEDICOMSegment; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMSegment) as IEDICOMSegment; +end; + +class function CoEDICOMTransactionSet.Create: IEDICOMTransactionSet; +begin + Result := CreateComObject(CLASS_EDICOMTransactionSet) as IEDICOMTransactionSet; +end; + +class function CoEDICOMTransactionSet.CreateRemote(const MachineName: string): IEDICOMTransactionSet; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMTransactionSet) as IEDICOMTransactionSet; +end; + +class function CoEDICOMFunctionalGroup.Create: IEDICOMFunctionalGroup; +begin + Result := CreateComObject(CLASS_EDICOMFunctionalGroup) as IEDICOMFunctionalGroup; +end; + +class function CoEDICOMFunctionalGroup.CreateRemote(const MachineName: string): IEDICOMFunctionalGroup; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMFunctionalGroup) as IEDICOMFunctionalGroup; +end; + +class function CoEDICOMInterchangeControl.Create: IEDICOMInterchangeControl; +begin + Result := CreateComObject(CLASS_EDICOMInterchangeControl) as IEDICOMInterchangeControl; +end; + +class function CoEDICOMInterchangeControl.CreateRemote(const MachineName: string): IEDICOMInterchangeControl; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMInterchangeControl) as IEDICOMInterchangeControl; +end; + +class function CoEDICOMFile.Create: IEDICOMFile; +begin + Result := CreateComObject(CLASS_EDICOMFile) as IEDICOMFile; +end; + +class function CoEDICOMFile.CreateRemote(const MachineName: string): IEDICOMFile; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMFile) as IEDICOMFile; +end; + +procedure TEDICOMFile.InitServerData; +const + CServerData: TServerData = ( + ClassID: '{E8400822-5701-4226-8F78-A784B3777CB9}'; + IntfIID: '{DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F}'; + EventIID: ''; + LicenseKey: nil; + Version: 500); +begin + ServerData := @CServerData; +end; + +procedure TEDICOMFile.Connect; +var + punk: IUnknown; +begin + if FIntf = nil then + begin + punk := GetServer; + Fintf:= punk as IEDICOMFile; + end; +end; + +procedure TEDICOMFile.ConnectTo(svrIntf: IEDICOMFile); +begin + Disconnect; + FIntf := svrIntf; +end; + +procedure TEDICOMFile.DisConnect; +begin + if Fintf <> nil then + begin + FIntf := nil; + end; +end; + +function TEDICOMFile.GetDefaultInterface: IEDICOMFile; +begin + if FIntf = nil then + Connect; + Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation'); + Result := FIntf; +end; + +constructor TEDICOMFile.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps := TEDICOMFileProperties.Create(Self); +{$ENDIF} +end; + +destructor TEDICOMFile.Destroy; +begin +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} + FProps.Free; +{$ENDIF} + inherited Destroy; +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +function TEDICOMFile.GetServerProperties: TEDICOMFileProperties; +begin + Result := FProps; +end; +{$ENDIF} + +function TEDICOMFile.Get_State: Integer; +begin + Result := DefaultInterface.Get_State; +end; + +function TEDICOMFile.Get_Data: WideString; +begin + Result := DefaultInterface.Get_Data; +end; + +procedure TEDICOMFile.Set_Data(const Value: WideString); +begin + DefaultInterface.Set_Data(Value); +end; + +function TEDICOMFile.Get_DataLength: Integer; +begin + Result := DefaultInterface.Get_DataLength; +end; + +function TEDICOMFile.Get_Delimiters: IEDICOMDelimiters; +begin + Result := DefaultInterface.Get_Delimiters; +end; + +function TEDICOMFile.Get_FileName: WideString; +begin + Result := DefaultInterface.Get_FileName; +end; + +procedure TEDICOMFile.Set_FileName(const Value: WideString); +begin + DefaultInterface.Set_FileName(Value); +end; + +function TEDICOMFile.Get_Interchange(Index: Integer): IEDICOMInterchangeControl; +begin + Result := DefaultInterface.Get_Interchange(Index); +end; + +function TEDICOMFile.Get_Options: Byte; +begin + Result := DefaultInterface.Get_Options; +end; + +procedure TEDICOMFile.Set_Options(Value: Byte); +begin + DefaultInterface.Set_Options(Value); +end; + +function TEDICOMFile.Get_InterchangeCount: Integer; +begin + Result := DefaultInterface.Get_InterchangeCount; +end; + +function TEDICOMFile.Assemble: WideString; +begin + Result := DefaultInterface.Assemble; +end; + +procedure TEDICOMFile.Disassemble; +begin + DefaultInterface.Disassemble; +end; + +procedure TEDICOMFile.LoadFromFile(const FileName: WideString); +begin + DefaultInterface.LoadFromFile(FileName); +end; + +procedure TEDICOMFile.ReLoadFromFile; +begin + DefaultInterface.ReLoadFromFile; +end; + +procedure TEDICOMFile.SaveToFile; +begin + DefaultInterface.SaveToFile; +end; + +procedure TEDICOMFile.SaveAsToFile(const FileName: WideString); +begin + DefaultInterface.SaveAsToFile(FileName); +end; + +function TEDICOMFile.AddInterchange: Integer; +begin + Result := DefaultInterface.AddInterchange; +end; + +function TEDICOMFile.InsertInterchange(InsertIndex: Integer): Integer; +begin + Result := DefaultInterface.InsertInterchange(InsertIndex); +end; + +procedure TEDICOMFile.DeleteInterchange(Index: Integer); +begin + DefaultInterface.DeleteInterchange(Index); +end; + +function TEDICOMFile.AddInterchanges(Count: Integer): Integer; +begin + Result := DefaultInterface.AddInterchanges(Count); +end; + +function TEDICOMFile.InsertInterchanges(InsertIndex: Integer; Count: Integer): Integer; +begin + Result := DefaultInterface.InsertInterchanges(InsertIndex, Count); +end; + +procedure TEDICOMFile.DeleteInterchanges; +begin + DefaultInterface.DeleteInterchanges; +end; + +{$IFDEF LIVE_SERVER_AT_DESIGN_TIME} +constructor TEDICOMFileProperties.Create(AServer: TEDICOMFile); +begin + inherited Create; + FServer := AServer; +end; + +function TEDICOMFileProperties.GetDefaultInterface: IEDICOMFile; +begin + Result := FServer.DefaultInterface; +end; + +function TEDICOMFileProperties.Get_State: Integer; +begin + Result := DefaultInterface.Get_State; +end; + +function TEDICOMFileProperties.Get_Data: WideString; +begin + Result := DefaultInterface.Get_Data; +end; + +procedure TEDICOMFileProperties.Set_Data(const Value: WideString); +begin + DefaultInterface.Set_Data(Value); +end; + +function TEDICOMFileProperties.Get_DataLength: Integer; +begin + Result := DefaultInterface.Get_DataLength; +end; + +function TEDICOMFileProperties.Get_Delimiters: IEDICOMDelimiters; +begin + Result := DefaultInterface.Get_Delimiters; +end; + +function TEDICOMFileProperties.Get_FileName: WideString; +begin + Result := DefaultInterface.Get_FileName; +end; + +procedure TEDICOMFileProperties.Set_FileName(const Value: WideString); +begin + DefaultInterface.Set_FileName(Value); +end; + +function TEDICOMFileProperties.Get_Interchange(Index: Integer): IEDICOMInterchangeControl; +begin + Result := DefaultInterface.Get_Interchange(Index); +end; + +function TEDICOMFileProperties.Get_Options: Byte; +begin + Result := DefaultInterface.Get_Options; +end; + +procedure TEDICOMFileProperties.Set_Options(Value: Byte); +begin + DefaultInterface.Set_Options(Value); +end; + +function TEDICOMFileProperties.Get_InterchangeCount: Integer; +begin + Result := DefaultInterface.Get_InterchangeCount; +end; + +{$ENDIF} + +procedure Register; +begin + RegisterComponents('ActiveX',[TEDICOMFile]); +end; + +end. diff --git a/official/1.96/examples/windows/edisdk/comserver/Clean.bat b/official/1.96/examples/windows/edisdk/comserver/Clean.bat new file mode 100644 index 0000000..2bca898 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/comserver/Clean.bat @@ -0,0 +1,18 @@ +@echo off +if exist *.~* del *.~* +if exist *.dcu del *.dcu +if exist *.dpl del *.dpl +if exist *.bpl del *.bpl +if exist *.bpi del *.bpi +if exist *.lsp del *.lsp +if exist *.dcp del *.dcp +if exist *.dpc del *.dpc +if exist *.bak del *.bak +if exist *.obj del *.obj +if exist *.hpp del *.hpp +if exist *.lib del *.lib +if exist *.exe del *.exe +if exist *.dsk del *.dsk + + + diff --git a/official/1.96/examples/windows/edisdk/comserver/EDISDK.dll b/official/1.96/examples/windows/edisdk/comserver/EDISDK.dll new file mode 100644 index 0000000..edb233a Binary files /dev/null and b/official/1.96/examples/windows/edisdk/comserver/EDISDK.dll differ diff --git a/official/1.96/examples/windows/edisdk/comserver/EDISDK.dof b/official/1.96/examples/windows/edisdk/comserver/EDISDK.dof new file mode 100644 index 0000000..133155e --- /dev/null +++ b/official/1.96/examples/windows/edisdk/comserver/EDISDK.dof @@ -0,0 +1,13 @@ +[Directories] +OutputDir=..\..\..\bin +[Version Info Keys] +CompanyName=Ray's Jedi Projects +FileDescription=EDI SDK COM Object Library +FileVersion=1.0.0.24 +InternalName= +LegalCopyright=Raymond Alexander +LegalTrademarks= +OriginalFilename=EDISDK.dll +ProductName=EDI SDK COM Object Library +ProductVersion=1.0.0.0 +Comments=Beta version for testing only! diff --git a/official/1.96/examples/windows/edisdk/comserver/EDISDK.dpr b/official/1.96/examples/windows/edisdk/comserver/EDISDK.dpr new file mode 100644 index 0000000..f30b6f7 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/comserver/EDISDK.dpr @@ -0,0 +1,21 @@ +library EDISDK; + +uses + ComServ, + EDISDK_TLB in 'EDISDK_TLB.pas', + JclEDICOM_ANSIX12 in 'JclEDICOM_ANSIX12.pas'; + +{$R *.TLB} + +{$E dll} + +exports + DllGetClassObject, + DllCanUnloadNow, + DllRegisterServer, + DllUnregisterServer; + +{$R *.RES} + +begin +end. diff --git a/official/1.96/examples/windows/edisdk/comserver/EDISDK.res b/official/1.96/examples/windows/edisdk/comserver/EDISDK.res new file mode 100644 index 0000000..2aff2bd Binary files /dev/null and b/official/1.96/examples/windows/edisdk/comserver/EDISDK.res differ diff --git a/official/1.96/examples/windows/edisdk/comserver/EDISDK.tlb b/official/1.96/examples/windows/edisdk/comserver/EDISDK.tlb new file mode 100644 index 0000000..e3e6659 Binary files /dev/null and b/official/1.96/examples/windows/edisdk/comserver/EDISDK.tlb differ diff --git a/official/1.96/examples/windows/edisdk/comserver/EDISDK_TLB.pas b/official/1.96/examples/windows/edisdk/comserver/EDISDK_TLB.pas new file mode 100644 index 0000000..e8f53d8 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/comserver/EDISDK_TLB.pas @@ -0,0 +1,651 @@ +unit EDISDK_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: 1.1 $ +// File generated on 17.7.2004 03:06:57 from Type Library described below. + +// ************************************************************************ // +// Type Lib: I:\Quellen\jedi\jcl\examples\vcl\edisdk\comserver\EDISDK.tlb (1) +// IID\LCID: {AF3BB992-62DF-41B7-92C7-FA41BDBB427E}\0 +// Helpfile: +// DepndLst: +// (1) v2.0 stdole, (F:\WINNT\system32\STDOLE2.TLB) +// (2) v4.0 StdVCL, (F:\WINNT\system32\STDVCL40.DLL) +// ************************************************************************ // +{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. +interface + +uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL; + +// *********************************************************************// +// 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 + EDISDKMajorVersion = 1; + EDISDKMinorVersion = 0; + + LIBID_EDISDK: TGUID = '{AF3BB992-62DF-41B7-92C7-FA41BDBB427E}'; + + IID_IEDICOMDelimiters: TGUID = '{A0181BBD-2F88-4FDC-9752-8303519D2D62}'; + CLASS_EDICOMDelimiters: TGUID = '{30B8A020-5D35-4ED8-B889-C13F309AE308}'; + IID_IEDICOMDataObject: TGUID = '{C7037767-05C8-4C6F-8201-655A6B5A4CF4}'; + IID_IEDICOMDataObjectGroup: TGUID = '{AEADBE04-6D1C-493E-BE6B-51E96BAD3680}'; + IID_IEDICOMElement: TGUID = '{E4ED3376-38AA-423C-9160-AAD190ACCB35}'; + CLASS_EDICOMElement: TGUID = '{4EFCADAA-60D0-4D61-875C-A27D6BCE932B}'; + IID_IEDICOMSegment: TGUID = '{467C692E-C22F-44B5-ACDB-C7A337B68675}'; + CLASS_EDICOMSegment: TGUID = '{63946EB6-DBDF-44FB-AAA4-123E7C2275B6}'; + IID_IEDICOMTransactionSet: TGUID = '{B2300104-4FF0-40A3-ABED-29E2A36C1844}'; + CLASS_EDICOMTransactionSet: TGUID = '{B540FDFC-B0D0-4E74-A7F4-B09DC260E656}'; + IID_IEDICOMFunctionalGroup: TGUID = '{C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31}'; + CLASS_EDICOMFunctionalGroup: TGUID = '{C69EA833-88BF-4D55-AFC0-264F1B7ED54C}'; + IID_IEDICOMInterchangeControl: TGUID = '{B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A}'; + CLASS_EDICOMInterchangeControl: TGUID = '{EF07065C-6E35-41B6-9564-D2D5714600A8}'; + IID_IEDICOMFile: TGUID = '{DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F}'; + CLASS_EDICOMFile: TGUID = '{E8400822-5701-4226-8F78-A784B3777CB9}'; + +// *********************************************************************// +// Declaration of Enumerations defined in Type Library +// *********************************************************************// +// Constants for enum EDICOMDataObjectDataState +type + EDICOMDataObjectDataState = TOleEnum; +const + ediCreated = $00000000; + ediAssembled = $00000001; + ediDisassembled = $00000002; + +// Constants for enum EDIFileOptions +type + EDIFileOptions = TOleEnum; +const + foNone = $00000000; + foVariableDelimiterDetection = $00000001; + foUseAltDelimiterDetection = $00000002; + foRemoveCrLf = $00000004; + foRemoveCr = $00000008; + foRemoveLf = $00000010; + foIgnoreGarbageAtEndOfFile = $00000020; + +type + +// *********************************************************************// +// Forward declaration of types defined in TypeLibrary +// *********************************************************************// + IEDICOMDelimiters = interface; + IEDICOMDelimitersDisp = dispinterface; + IEDICOMDataObject = interface; + IEDICOMDataObjectDisp = dispinterface; + IEDICOMDataObjectGroup = interface; + IEDICOMDataObjectGroupDisp = dispinterface; + IEDICOMElement = interface; + IEDICOMElementDisp = dispinterface; + IEDICOMSegment = interface; + IEDICOMSegmentDisp = dispinterface; + IEDICOMTransactionSet = interface; + IEDICOMTransactionSetDisp = dispinterface; + IEDICOMFunctionalGroup = interface; + IEDICOMFunctionalGroupDisp = dispinterface; + IEDICOMInterchangeControl = interface; + IEDICOMInterchangeControlDisp = dispinterface; + IEDICOMFile = interface; + IEDICOMFileDisp = dispinterface; + +// *********************************************************************// +// Declaration of CoClasses defined in Type Library +// (NOTE: Here we map each CoClass to its Default Interface) +// *********************************************************************// + EDICOMDelimiters = IEDICOMDelimiters; + EDICOMElement = IEDICOMElement; + EDICOMSegment = IEDICOMSegment; + EDICOMTransactionSet = IEDICOMTransactionSet; + EDICOMFunctionalGroup = IEDICOMFunctionalGroup; + EDICOMInterchangeControl = IEDICOMInterchangeControl; + EDICOMFile = IEDICOMFile; + + +// *********************************************************************// +// Interface: IEDICOMDelimiters +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A0181BBD-2F88-4FDC-9752-8303519D2D62} +// *********************************************************************// + IEDICOMDelimiters = interface(IDispatch) + ['{A0181BBD-2F88-4FDC-9752-8303519D2D62}'] + function Get_SD: WideString; safecall; + procedure Set_SD(const Value: WideString); safecall; + function Get_ED: WideString; safecall; + procedure Set_ED(const Value: WideString); safecall; + function Get_SS: WideString; safecall; + procedure Set_SS(const Value: WideString); safecall; + function Get_SDLen: Integer; safecall; + function Get_EDLen: Integer; safecall; + function Get_SSLen: Integer; safecall; + property SD: WideString read Get_SD write Set_SD; + property ED: WideString read Get_ED write Set_ED; + property SS: WideString read Get_SS write Set_SS; + property SDLen: Integer read Get_SDLen; + property EDLen: Integer read Get_EDLen; + property SSLen: Integer read Get_SSLen; + end; + +// *********************************************************************// +// DispIntf: IEDICOMDelimitersDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {A0181BBD-2F88-4FDC-9752-8303519D2D62} +// *********************************************************************// + IEDICOMDelimitersDisp = dispinterface + ['{A0181BBD-2F88-4FDC-9752-8303519D2D62}'] + property SD: WideString dispid 201; + property ED: WideString dispid 202; + property SS: WideString dispid 203; + property SDLen: Integer readonly dispid 204; + property EDLen: Integer readonly dispid 205; + property SSLen: Integer readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMDataObject +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C7037767-05C8-4C6F-8201-655A6B5A4CF4} +// *********************************************************************// + IEDICOMDataObject = interface(IDispatch) + ['{C7037767-05C8-4C6F-8201-655A6B5A4CF4}'] + function Assemble: WideString; safecall; + procedure Disassemble; safecall; + function Get_State: Integer; safecall; + function Get_Data: WideString; safecall; + procedure Set_Data(const Value: WideString); safecall; + function Get_DataLength: Integer; safecall; + function Get_Delimiters: IEDICOMDelimiters; safecall; + property State: Integer read Get_State; + property Data: WideString read Get_Data write Set_Data; + property DataLength: Integer read Get_DataLength; + property Delimiters: IEDICOMDelimiters read Get_Delimiters; + end; + +// *********************************************************************// +// DispIntf: IEDICOMDataObjectDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C7037767-05C8-4C6F-8201-655A6B5A4CF4} +// *********************************************************************// + IEDICOMDataObjectDisp = dispinterface + ['{C7037767-05C8-4C6F-8201-655A6B5A4CF4}'] + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMDataObjectGroup +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AEADBE04-6D1C-493E-BE6B-51E96BAD3680} +// *********************************************************************// + IEDICOMDataObjectGroup = interface(IEDICOMDataObject) + ['{AEADBE04-6D1C-493E-BE6B-51E96BAD3680}'] + end; + +// *********************************************************************// +// DispIntf: IEDICOMDataObjectGroupDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {AEADBE04-6D1C-493E-BE6B-51E96BAD3680} +// *********************************************************************// + IEDICOMDataObjectGroupDisp = dispinterface + ['{AEADBE04-6D1C-493E-BE6B-51E96BAD3680}'] + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMElement +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E4ED3376-38AA-423C-9160-AAD190ACCB35} +// *********************************************************************// + IEDICOMElement = interface(IEDICOMDataObject) + ['{E4ED3376-38AA-423C-9160-AAD190ACCB35}'] + end; + +// *********************************************************************// +// DispIntf: IEDICOMElementDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {E4ED3376-38AA-423C-9160-AAD190ACCB35} +// *********************************************************************// + IEDICOMElementDisp = dispinterface + ['{E4ED3376-38AA-423C-9160-AAD190ACCB35}'] + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMSegment +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {467C692E-C22F-44B5-ACDB-C7A337B68675} +// *********************************************************************// + IEDICOMSegment = interface(IEDICOMDataObjectGroup) + ['{467C692E-C22F-44B5-ACDB-C7A337B68675}'] + function Get_Element(Index: Integer): IEDICOMElement; safecall; + function Get_SegmentId: WideString; safecall; + procedure Set_SegmentId(const Value: WideString); safecall; + function AddElement: Integer; safecall; + function InsertElement(InsertIndex: Integer): Integer; safecall; + procedure DeleteElement(Index: Integer); safecall; + function AddElements(Count: Integer): Integer; safecall; + function InsertElements(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteElements; safecall; + function Get_ElementCount: Integer; safecall; + property Element[Index: Integer]: IEDICOMElement read Get_Element; + property SegmentId: WideString read Get_SegmentId write Set_SegmentId; + property ElementCount: Integer read Get_ElementCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMSegmentDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {467C692E-C22F-44B5-ACDB-C7A337B68675} +// *********************************************************************// + IEDICOMSegmentDisp = dispinterface + ['{467C692E-C22F-44B5-ACDB-C7A337B68675}'] + property Element[Index: Integer]: IEDICOMElement readonly dispid 401; + property SegmentId: WideString dispid 402; + function AddElement: Integer; dispid 403; + function InsertElement(InsertIndex: Integer): Integer; dispid 404; + procedure DeleteElement(Index: Integer); dispid 405; + function AddElements(Count: Integer): Integer; dispid 406; + function InsertElements(InsertIndex: Integer; Count: Integer): Integer; dispid 407; + procedure DeleteElements; dispid 408; + property ElementCount: Integer readonly dispid 409; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMTransactionSet +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B2300104-4FF0-40A3-ABED-29E2A36C1844} +// *********************************************************************// + IEDICOMTransactionSet = interface(IEDICOMDataObjectGroup) + ['{B2300104-4FF0-40A3-ABED-29E2A36C1844}'] + function Get_SegmentST: IEDICOMSegment; safecall; + function Get_SegmentSE: IEDICOMSegment; safecall; + function Get_Segment(Index: Integer): IEDICOMSegment; safecall; + function AddSegment: Integer; safecall; + function InsertSegment(InsertIndex: Integer): Integer; safecall; + procedure DeleteSegment(Index: Integer); safecall; + function AddSegments(Count: Integer): Integer; safecall; + function InsertSegments(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteSegments; safecall; + function Get_SegmentCount: Integer; safecall; + property SegmentST: IEDICOMSegment read Get_SegmentST; + property SegmentSE: IEDICOMSegment read Get_SegmentSE; + property Segment[Index: Integer]: IEDICOMSegment read Get_Segment; + property SegmentCount: Integer read Get_SegmentCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMTransactionSetDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B2300104-4FF0-40A3-ABED-29E2A36C1844} +// *********************************************************************// + IEDICOMTransactionSetDisp = dispinterface + ['{B2300104-4FF0-40A3-ABED-29E2A36C1844}'] + property SegmentST: IEDICOMSegment readonly dispid 401; + property SegmentSE: IEDICOMSegment readonly dispid 402; + property Segment[Index: Integer]: IEDICOMSegment readonly dispid 403; + function AddSegment: Integer; dispid 404; + function InsertSegment(InsertIndex: Integer): Integer; dispid 405; + procedure DeleteSegment(Index: Integer); dispid 406; + function AddSegments(Count: Integer): Integer; dispid 407; + function InsertSegments(InsertIndex: Integer; Count: Integer): Integer; dispid 408; + procedure DeleteSegments; dispid 409; + property SegmentCount: Integer readonly dispid 410; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMFunctionalGroup +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31} +// *********************************************************************// + IEDICOMFunctionalGroup = interface(IEDICOMDataObjectGroup) + ['{C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31}'] + function Get_SegmentGS: IEDICOMSegment; safecall; + function Get_SegmentGE: IEDICOMSegment; safecall; + function Get_TransactionSet(Index: Integer): IEDICOMTransactionSet; safecall; + function AddTransactionSet: Integer; safecall; + function InsertTransactionSet(InsertIndex: Integer): Integer; safecall; + procedure DeleteTransactionSet(Index: Integer); safecall; + function AddTransactionSets(Count: Integer): Integer; safecall; + function InsertTransactionSets(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteTransactionSets; safecall; + function Get_TransactionSetCount: Integer; safecall; + property SegmentGS: IEDICOMSegment read Get_SegmentGS; + property SegmentGE: IEDICOMSegment read Get_SegmentGE; + property TransactionSet[Index: Integer]: IEDICOMTransactionSet read Get_TransactionSet; + property TransactionSetCount: Integer read Get_TransactionSetCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMFunctionalGroupDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31} +// *********************************************************************// + IEDICOMFunctionalGroupDisp = dispinterface + ['{C2FDB4EF-6252-4E67-BAD4-E7200B9CEA31}'] + property SegmentGS: IEDICOMSegment readonly dispid 401; + property SegmentGE: IEDICOMSegment readonly dispid 402; + property TransactionSet[Index: Integer]: IEDICOMTransactionSet readonly dispid 403; + function AddTransactionSet: Integer; dispid 404; + function InsertTransactionSet(InsertIndex: Integer): Integer; dispid 405; + procedure DeleteTransactionSet(Index: Integer); dispid 406; + function AddTransactionSets(Count: Integer): Integer; dispid 407; + function InsertTransactionSets(InsertIndex: Integer; Count: Integer): Integer; dispid 408; + procedure DeleteTransactionSets; dispid 409; + property TransactionSetCount: Integer readonly dispid 410; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMInterchangeControl +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A} +// *********************************************************************// + IEDICOMInterchangeControl = interface(IEDICOMDataObjectGroup) + ['{B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A}'] + function Get_SegmentISA: IEDICOMSegment; safecall; + function Get_SegmentIEA: IEDICOMSegment; safecall; + function Get_FunctionalGroup(Index: Integer): IEDICOMFunctionalGroup; safecall; + function AddFunctionalGroup: Integer; safecall; + function InsertFunctionalGroup(InsertIndex: Integer): Integer; safecall; + procedure DeleteFunctionalGroup(Index: Integer); safecall; + function AddFunctionalGroups(InsertIndex: Integer): Integer; safecall; + function InsertFunctionalGroups(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteFunctionalGroups; safecall; + procedure SetDelimiters(const SD: WideString; const ED: WideString; const SS: WideString); safecall; + function Get_FunctionalGroupCount: Integer; safecall; + property SegmentISA: IEDICOMSegment read Get_SegmentISA; + property SegmentIEA: IEDICOMSegment read Get_SegmentIEA; + property FunctionalGroup[Index: Integer]: IEDICOMFunctionalGroup read Get_FunctionalGroup; + property FunctionalGroupCount: Integer read Get_FunctionalGroupCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMInterchangeControlDisp +// Flags: (4432) Hidden Dual OleAutomation Dispatchable +// GUID: {B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A} +// *********************************************************************// + IEDICOMInterchangeControlDisp = dispinterface + ['{B7FF3E84-8D1E-44F5-BC6A-578881CF7B5A}'] + property SegmentISA: IEDICOMSegment readonly dispid 401; + property SegmentIEA: IEDICOMSegment readonly dispid 402; + property FunctionalGroup[Index: Integer]: IEDICOMFunctionalGroup readonly dispid 403; + function AddFunctionalGroup: Integer; dispid 404; + function InsertFunctionalGroup(InsertIndex: Integer): Integer; dispid 405; + procedure DeleteFunctionalGroup(Index: Integer); dispid 406; + function AddFunctionalGroups(InsertIndex: Integer): Integer; dispid 407; + function InsertFunctionalGroups(InsertIndex: Integer; Count: Integer): Integer; dispid 408; + procedure DeleteFunctionalGroups; dispid 409; + procedure SetDelimiters(const SD: WideString; const ED: WideString; const SS: WideString); dispid 410; + property FunctionalGroupCount: Integer readonly dispid 411; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// Interface: IEDICOMFile +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F} +// *********************************************************************// + IEDICOMFile = interface(IEDICOMDataObjectGroup) + ['{DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F}'] + procedure LoadFromFile(const FileName: WideString); safecall; + procedure ReLoadFromFile; safecall; + procedure SaveToFile; safecall; + procedure SaveAsToFile(const FileName: WideString); safecall; + function Get_FileName: WideString; safecall; + procedure Set_FileName(const Value: WideString); safecall; + function Get_Interchange(Index: Integer): IEDICOMInterchangeControl; safecall; + function Get_Options: Byte; safecall; + procedure Set_Options(Value: Byte); safecall; + function AddInterchange: Integer; safecall; + function InsertInterchange(InsertIndex: Integer): Integer; safecall; + procedure DeleteInterchange(Index: Integer); safecall; + function AddInterchanges(Count: Integer): Integer; safecall; + function InsertInterchanges(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteInterchanges; safecall; + function Get_InterchangeCount: Integer; safecall; + property FileName: WideString read Get_FileName write Set_FileName; + property Interchange[Index: Integer]: IEDICOMInterchangeControl read Get_Interchange; + property Options: Byte read Get_Options write Set_Options; + property InterchangeCount: Integer read Get_InterchangeCount; + end; + +// *********************************************************************// +// DispIntf: IEDICOMFileDisp +// Flags: (4416) Dual OleAutomation Dispatchable +// GUID: {DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F} +// *********************************************************************// + IEDICOMFileDisp = dispinterface + ['{DEA6D2C3-98EE-4276-AA08-0AB4F1AEAC0F}'] + procedure LoadFromFile(const FileName: WideString); dispid 401; + procedure ReLoadFromFile; dispid 402; + procedure SaveToFile; dispid 403; + procedure SaveAsToFile(const FileName: WideString); dispid 404; + property FileName: WideString dispid 405; + property Interchange[Index: Integer]: IEDICOMInterchangeControl readonly dispid 406; + property Options: Byte dispid 407; + function AddInterchange: Integer; dispid 408; + function InsertInterchange(InsertIndex: Integer): Integer; dispid 409; + procedure DeleteInterchange(Index: Integer); dispid 410; + function AddInterchanges(Count: Integer): Integer; dispid 411; + function InsertInterchanges(InsertIndex: Integer; Count: Integer): Integer; dispid 412; + procedure DeleteInterchanges; dispid 413; + property InterchangeCount: Integer readonly dispid 414; + function Assemble: WideString; dispid 201; + procedure Disassemble; dispid 202; + property State: Integer readonly dispid 203; + property Data: WideString dispid 205; + property DataLength: Integer readonly dispid 204; + property Delimiters: IEDICOMDelimiters readonly dispid 206; + end; + +// *********************************************************************// +// The Class CoEDICOMDelimiters provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMDelimiters exposed by +// the CoClass EDICOMDelimiters. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMDelimiters = class + class function Create: IEDICOMDelimiters; + class function CreateRemote(const MachineName: string): IEDICOMDelimiters; + end; + +// *********************************************************************// +// The Class CoEDICOMElement provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMElement exposed by +// the CoClass EDICOMElement. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMElement = class + class function Create: IEDICOMElement; + class function CreateRemote(const MachineName: string): IEDICOMElement; + end; + +// *********************************************************************// +// The Class CoEDICOMSegment provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMSegment exposed by +// the CoClass EDICOMSegment. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMSegment = class + class function Create: IEDICOMSegment; + class function CreateRemote(const MachineName: string): IEDICOMSegment; + end; + +// *********************************************************************// +// The Class CoEDICOMTransactionSet provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMTransactionSet exposed by +// the CoClass EDICOMTransactionSet. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMTransactionSet = class + class function Create: IEDICOMTransactionSet; + class function CreateRemote(const MachineName: string): IEDICOMTransactionSet; + end; + +// *********************************************************************// +// The Class CoEDICOMFunctionalGroup provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMFunctionalGroup exposed by +// the CoClass EDICOMFunctionalGroup. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMFunctionalGroup = class + class function Create: IEDICOMFunctionalGroup; + class function CreateRemote(const MachineName: string): IEDICOMFunctionalGroup; + end; + +// *********************************************************************// +// The Class CoEDICOMInterchangeControl provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMInterchangeControl exposed by +// the CoClass EDICOMInterchangeControl. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMInterchangeControl = class + class function Create: IEDICOMInterchangeControl; + class function CreateRemote(const MachineName: string): IEDICOMInterchangeControl; + end; + +// *********************************************************************// +// The Class CoEDICOMFile provides a Create and CreateRemote method to +// create instances of the default interface IEDICOMFile exposed by +// the CoClass EDICOMFile. The functions are intended to be used by +// clients wishing to automate the CoClass objects exposed by the +// server of this typelibrary. +// *********************************************************************// + CoEDICOMFile = class + class function Create: IEDICOMFile; + class function CreateRemote(const MachineName: string): IEDICOMFile; + end; + +implementation + +uses ComObj; + +class function CoEDICOMDelimiters.Create: IEDICOMDelimiters; +begin + Result := CreateComObject(CLASS_EDICOMDelimiters) as IEDICOMDelimiters; +end; + +class function CoEDICOMDelimiters.CreateRemote(const MachineName: string): IEDICOMDelimiters; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMDelimiters) as IEDICOMDelimiters; +end; + +class function CoEDICOMElement.Create: IEDICOMElement; +begin + Result := CreateComObject(CLASS_EDICOMElement) as IEDICOMElement; +end; + +class function CoEDICOMElement.CreateRemote(const MachineName: string): IEDICOMElement; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMElement) as IEDICOMElement; +end; + +class function CoEDICOMSegment.Create: IEDICOMSegment; +begin + Result := CreateComObject(CLASS_EDICOMSegment) as IEDICOMSegment; +end; + +class function CoEDICOMSegment.CreateRemote(const MachineName: string): IEDICOMSegment; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMSegment) as IEDICOMSegment; +end; + +class function CoEDICOMTransactionSet.Create: IEDICOMTransactionSet; +begin + Result := CreateComObject(CLASS_EDICOMTransactionSet) as IEDICOMTransactionSet; +end; + +class function CoEDICOMTransactionSet.CreateRemote(const MachineName: string): IEDICOMTransactionSet; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMTransactionSet) as IEDICOMTransactionSet; +end; + +class function CoEDICOMFunctionalGroup.Create: IEDICOMFunctionalGroup; +begin + Result := CreateComObject(CLASS_EDICOMFunctionalGroup) as IEDICOMFunctionalGroup; +end; + +class function CoEDICOMFunctionalGroup.CreateRemote(const MachineName: string): IEDICOMFunctionalGroup; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMFunctionalGroup) as IEDICOMFunctionalGroup; +end; + +class function CoEDICOMInterchangeControl.Create: IEDICOMInterchangeControl; +begin + Result := CreateComObject(CLASS_EDICOMInterchangeControl) as IEDICOMInterchangeControl; +end; + +class function CoEDICOMInterchangeControl.CreateRemote(const MachineName: string): IEDICOMInterchangeControl; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMInterchangeControl) as IEDICOMInterchangeControl; +end; + +class function CoEDICOMFile.Create: IEDICOMFile; +begin + Result := CreateComObject(CLASS_EDICOMFile) as IEDICOMFile; +end; + +class function CoEDICOMFile.CreateRemote(const MachineName: string): IEDICOMFile; +begin + Result := CreateRemoteComObject(MachineName, CLASS_EDICOMFile) as IEDICOMFile; +end; + +end. diff --git a/official/1.96/examples/windows/edisdk/comserver/JclEDICOM_ANSIX12.pas b/official/1.96/examples/windows/edisdk/comserver/JclEDICOM_ANSIX12.pas new file mode 100644 index 0000000..b405474 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/comserver/JclEDICOM_ANSIX12.pas @@ -0,0 +1,1064 @@ +{**************************************************************************************************} +{ } +{ Ray's Jedi Projects } +{ } +{ 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 EDICOM_ANSIX12.pas. } +{ } +{ The Initial Developer of the Original Code is Raymond Alexander. } +{ Portions created by Raymond Alexander are Copyright Raymond Alexander. All rights reserved. } +{ } +{ Contributor(s): } +{ } +{**************************************************************************************************} +{ } +{ This is an experimental unit for COM interop with other languages. } +{ } +{ Unit owner: Raymond Alexander } +{ Date created: May 29, 2004 } +{ Last modified: May 30, 2004 } +{ Additional Info: } +{ E-Mail at RaysDelphiBox3@hotmail.com } +{ For latest EDI specific updates see http://sourceforge.net/projects/edisdk } +{ See home page for latest news & events and online help. } +{ } +{**************************************************************************************************} +unit JclEDICOM_ANSIX12; + +interface + +uses + Windows, ActiveX, Classes, ComObj, StdVcl, EDISDK_TLB, + JclEDI, JclEDI_ANSIX12; + +type + + IEDICOMInternalInterface = interface + ['{72227476-D4D4-448C-9C28-08552373C737}'] + procedure SetInternalEDIObjectRef(EDIObject: TEDIObject); + end; + + TEDICOMDelimiters = class(TAutoObject, IEDICOMInternalInterface, IEDICOMDelimiters) + private + FDelimiters: TEDIDelimiters; + protected + function Get_SD: WideString; safecall; + procedure Set_SD(const Value: WideString); safecall; + function Get_ED: WideString; safecall; + procedure Set_ED(const Value: WideString); safecall; + function Get_SS: WideString; safecall; + procedure Set_SS(const Value: WideString); safecall; + function Get_SDLen: Integer; safecall; + function Get_EDLen: Integer; safecall; + function Get_SSLen: Integer; safecall; + public + procedure Initialize; override; + destructor Destroy; override; + procedure SetInternalEDIObjectRef(EDIObject: TEDIObject); + end; + + TEDICOMElement = class(TAutoObject, IEDICOMInternalInterface, IEDICOMElement) + private + FDelimitersIntf: TEDICOMDelimiters; + FElement: TEDIElement; + protected + function Assemble: WideString; safecall; + procedure Disassemble; safecall; + function Get_State: Integer; safecall; + function Get_Data: WideString; safecall; + procedure Set_Data(const Value: WideString); safecall; + function Get_DataLength: Integer; safecall; + function Get_Delimiters: IEDICOMDelimiters; safecall; + property Delimiters: IEDICOMDelimiters read Get_Delimiters; + property State: Integer read Get_State; + property Data: WideString read Get_Data write Set_Data; + property DataLength: Integer read Get_DataLength; + public + procedure Initialize; override; + destructor Destroy; override; + procedure SetInternalEDIObjectRef(EDIObject: TEDIObject); + end; + + TEDICOMSegment = class(TAutoObject, IEDICOMInternalInterface, IEDICOMSegment) + private + FDelimitersIntf: TEDICOMDelimiters; + FElementIntf: TEDICOMElement; + FSegment: TEDISegment; + protected + function Assemble: WideString; safecall; + procedure Disassemble; safecall; + function Get_State: Integer; safecall; + function Get_Data: WideString; safecall; + procedure Set_Data(const Value: WideString); safecall; + function Get_DataLength: Integer; safecall; + property State: Integer read Get_State; + property Data: WideString read Get_Data write Set_Data; + property DataLength: Integer read Get_DataLength; + // + function AddElement: Integer; safecall; + function InsertElement(InsertIndex: Integer): Integer; safecall; + procedure DeleteElement(Index: Integer); safecall; + function AddElements(Count: Integer): Integer; safecall; + function InsertElements(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteElements; safecall; + + function Get_Element(Index: Integer): IEDICOMElement; safecall; + property Element[Index: Integer]: IEDICOMElement read Get_Element; + function Get_SegmentId: WideString; safecall; + procedure Set_SegmentId(const Value: WideString); safecall; + + function Get_ElementCount: Integer; safecall; + property ElementCount: Integer read Get_ElementCount; + + function Get_Delimiters: IEDICOMDelimiters; safecall; + property Delimiters: IEDICOMDelimiters read Get_Delimiters; + property SegmentId: WideString read Get_SegmentId write Set_SegmentId; + public + procedure Initialize; override; + destructor Destroy; override; + procedure SetInternalEDIObjectRef(EDIObject: TEDIObject); + end; + + TEDICOMTransactionSet = class(TAutoObject, IEDICOMInternalInterface, IEDICOMTransactionSet) + private + FDelimitersIntf: TEDICOMDelimiters; + FSegmentIntf: TEDICOMSegment; + FTransactionSet: TEDITransactionSet; + protected + function Assemble: WideString; safecall; + procedure Disassemble; safecall; + function Get_State: Integer; safecall; + function Get_Data: WideString; safecall; + procedure Set_Data(const Value: WideString); safecall; + function Get_DataLength: Integer; safecall; + property State: Integer read Get_State; + property Data: WideString read Get_Data write Set_Data; + property DataLength: Integer read Get_DataLength; + // + function AddSegment: Integer; safecall; + function InsertSegment(InsertIndex: Integer): Integer; safecall; + procedure DeleteSegment(Index: Integer); safecall; + function AddSegments(Count: Integer): Integer; safecall; + function InsertSegments(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteSegments; safecall; + + function Get_SegmentST: IEDICOMSegment; safecall; + function Get_SegmentSE: IEDICOMSegment; safecall; + function Get_Segment(Index: Integer): IEDICOMSegment; safecall; + + function Get_SegmentCount: Integer; safecall; + property SegmentCount: Integer read Get_SegmentCount; + + function Get_Delimiters: IEDICOMDelimiters; safecall; + property Delimiters: IEDICOMDelimiters read Get_Delimiters; + property SegmentST: IEDICOMSegment read Get_SegmentST; + property SegmentSE: IEDICOMSegment read Get_SegmentSE; + property Segment[Index: Integer]: IEDICOMSegment read Get_Segment; + public + procedure Initialize; override; + destructor Destroy; override; + procedure SetInternalEDIObjectRef(EDIObject: TEDIObject); + end; + + TEDICOMFunctionalGroup = class(TAutoObject, IEDICOMInternalInterface, IEDICOMFunctionalGroup) + private + FDelimitersIntf: TEDICOMDelimiters; + FSegmentIntf: TEDICOMSegment; + FTransactionSetIntf: TEDICOMTransactionSet; + FFunctionalGroup: TEDIFunctionalGroup; + protected + function Assemble: WideString; safecall; + procedure Disassemble; safecall; + function Get_State: Integer; safecall; + function Get_Data: WideString; safecall; + procedure Set_Data(const Value: WideString); safecall; + function Get_DataLength: Integer; safecall; + property State: Integer read Get_State; + property Data: WideString read Get_Data write Set_Data; + property DataLength: Integer read Get_DataLength; + // + function AddTransactionSet: Integer; safecall; + function InsertTransactionSet(InsertIndex: Integer): Integer; safecall; + procedure DeleteTransactionSet(Index: Integer); safecall; + function AddTransactionSets(Count: Integer): Integer; safecall; + function InsertTransactionSets(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteTransactionSets; safecall; + + function Get_SegmentGS: IEDICOMSegment; safecall; + function Get_SegmentGE: IEDICOMSegment; safecall; + function Get_TransactionSet(Index: Integer): IEDICOMTransactionSet; safecall; + + function Get_TransactionSetCount: Integer; safecall; + property TransactionSetCount: Integer read Get_TransactionSetCount; + + function Get_Delimiters: IEDICOMDelimiters; safecall; + property Delimiters: IEDICOMDelimiters read Get_Delimiters; + property SegmentGS: IEDICOMSegment read Get_SegmentGS; + property SegmentGE: IEDICOMSegment read Get_SegmentGE; + property TransactionSet[Index: Integer]: IEDICOMTransactionSet read Get_TransactionSet; + public + procedure Initialize; override; + destructor Destroy; override; + procedure SetInternalEDIObjectRef(EDIObject: TEDIObject); + end; + + TEDICOMInterchangeControl = class(TAutoObject, IEDICOMInternalInterface, IEDICOMInterchangeControl) + private + FDelimitersIntf: TEDICOMDelimiters; + FSegmentIntf: TEDICOMSegment; + FFunctionalGroupIntf: TEDICOMFunctionalGroup; + FInterchangeControl: TEDIInterchangeControl; + protected + function Assemble: WideString; safecall; + procedure Disassemble; safecall; + function Get_State: Integer; safecall; + function Get_Data: WideString; safecall; + procedure Set_Data(const Value: WideString); safecall; + function Get_DataLength: Integer; safecall; + property State: Integer read Get_State; + property Data: WideString read Get_Data write Set_Data; + property DataLength: Integer read Get_DataLength; + // + procedure SetDelimiters(const SD: WideString; const ED: WideString; const SS: WideString); safecall; + + function AddFunctionalGroup: Integer; safecall; + function InsertFunctionalGroup(InsertIndex: Integer): Integer; safecall; + procedure DeleteFunctionalGroup(Index: Integer); safecall; + function AddFunctionalGroups(InsertIndex: Integer): Integer; safecall; + function InsertFunctionalGroups(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteFunctionalGroups; safecall; + + function Get_SegmentISA: IEDICOMSegment; safecall; + function Get_SegmentIEA: IEDICOMSegment; safecall; + function Get_FunctionalGroup(Index: Integer): IEDICOMFunctionalGroup; safecall; + + function Get_FunctionalGroupCount: Integer; safecall; + property FunctionalGroupCount: Integer read Get_FunctionalGroupCount; + + function Get_Delimiters: IEDICOMDelimiters; safecall; + property Delimiters: IEDICOMDelimiters read Get_Delimiters; + property SegmentISA: IEDICOMSegment read Get_SegmentISA; + property SegmentIEA: IEDICOMSegment read Get_SegmentIEA; + property FunctionalGroup[Index: Integer]: IEDICOMFunctionalGroup read Get_FunctionalGroup; + public + procedure Initialize; override; + destructor Destroy; override; + procedure SetInternalEDIObjectRef(EDIObject: TEDIObject); + end; + + TEDICOMFile = class(TAutoObject, IEDICOMFile) + private + FDelimitersIntf: TEDICOMDelimiters; + FInterchangeControlIntf: TEDICOMInterchangeControl; + FEDIFile: TEDIFile; + protected + function Assemble: WideString; safecall; + procedure Disassemble; safecall; + function Get_State: Integer; safecall; + function Get_Data: WideString; safecall; + procedure Set_Data(const Value: WideString); safecall; + function Get_DataLength: Integer; safecall; + property State: Integer read Get_State; + property Data: WideString read Get_Data write Set_Data; + property DataLength: Integer read Get_DataLength; + // + procedure LoadFromFile(const FileName: WideString); safecall; + procedure ReLoadFromFile; safecall; + procedure SaveToFile; safecall; + procedure SaveAsToFile(const FileName: WideString); safecall; + function Get_FileName: WideString; safecall; + procedure Set_FileName(const Value: WideString); safecall; + function Get_Interchange(Index: Integer): IEDICOMInterchangeControl; safecall; + function Get_Options: Byte; safecall; + procedure Set_Options(Value: Byte); safecall; + + function AddInterchange: Integer; safecall; + function InsertInterchange(InsertIndex: Integer): Integer; safecall; + procedure DeleteInterchange(Index: Integer); safecall; + function AddInterchanges(Count: Integer): Integer; safecall; + function InsertInterchanges(InsertIndex: Integer; Count: Integer): Integer; safecall; + procedure DeleteInterchanges; safecall; + + function Get_InterchangeCount: Integer; safecall; + property InterchangeCount: Integer read Get_InterchangeCount; + + function Get_Delimiters: IEDICOMDelimiters; safecall; + property Delimiters: IEDICOMDelimiters read Get_Delimiters; + property FileName: WideString read Get_FileName write Set_FileName; + property Interchange[Index: Integer]: IEDICOMInterchangeControl read Get_Interchange; + property Options: Byte read Get_Options write Set_Options; + public + procedure Initialize; override; + destructor Destroy; override; + end; + +implementation + +uses ComServ, SysUtils; + +{ TEDICOMElement } + +function TEDICOMElement.Assemble: WideString; +begin + Result := FElement.Assemble; +end; + +destructor TEDICOMElement.Destroy; +begin + FDelimitersIntf.ObjRelease; + FDelimitersIntf := nil; + FElement := nil; + inherited; +end; + +procedure TEDICOMElement.Disassemble; +begin + FElement.Disassemble; +end; + +function TEDICOMElement.Get_Data: WideString; +begin + Result := FElement.Data; +end; + +function TEDICOMElement.Get_DataLength: Integer; +begin + Result := FElement.DataLength; +end; + +function TEDICOMElement.Get_Delimiters: IEDICOMDelimiters; +begin + FDelimitersIntf.SetInternalEDIObjectRef(FElement.Delimiters); + Result := FDelimitersIntf; +end; + +function TEDICOMElement.Get_State: Integer; +begin + Result := Integer(FElement.State); +end; + +procedure TEDICOMElement.Initialize; +begin + inherited; + FDelimitersIntf := TEDICOMDelimiters.Create; + FDelimitersIntf.ObjAddRef; +end; + +procedure TEDICOMElement.SetInternalEDIObjectRef(EDIObject: TEDIObject); +begin + FElement := TEDIElement(EDIObject); +end; + +procedure TEDICOMElement.Set_Data(const Value: WideString); +begin + FElement.Data := Value; +end; + +{ TEDICOMSegment } + +function TEDICOMSegment.AddElement: Integer; +begin + Result := FSegment.AddElement; +end; + +function TEDICOMSegment.AddElements(Count: Integer): Integer; +begin + Result := FSegment.AddElements(Count); +end; + +function TEDICOMSegment.Assemble: WideString; +begin + Result := FSegment.Assemble; +end; + +procedure TEDICOMSegment.DeleteElement(Index: Integer); +begin + FSegment.DeleteElement(Index); +end; + +procedure TEDICOMSegment.DeleteElements; +begin + FSegment.DeleteElements; +end; + +destructor TEDICOMSegment.Destroy; +begin + FElementIntf.ObjRelease; + FElementIntf := nil; + FDelimitersIntf.ObjRelease; + FDelimitersIntf := nil; + FSegment := nil; + inherited; +end; + +procedure TEDICOMSegment.Disassemble; +begin + FSegment.Disassemble; +end; + +function TEDICOMSegment.Get_Data: WideString; +begin + Result := FSegment.Data; +end; + +function TEDICOMSegment.Get_DataLength: Integer; +begin + Result := FSegment.DataLength; +end; + +function TEDICOMSegment.Get_Delimiters: IEDICOMDelimiters; +begin + FDelimitersIntf.SetInternalEDIObjectRef(FSegment.Delimiters); + Result := FDelimitersIntf; +end; + +function TEDICOMSegment.Get_Element(Index: Integer): IEDICOMElement; +begin + FElementIntf.SetInternalEDIObjectRef(FSegment[Index]); + Result := FElementIntf; +end; + +function TEDICOMSegment.Get_ElementCount: Integer; +begin + Result := FSegment.ElementCount; +end; + +function TEDICOMSegment.Get_SegmentId: WideString; +begin + Result := FSegment.SegmentId; +end; + +function TEDICOMSegment.Get_State: Integer; +begin + Result := Integer(FSegment.State); +end; + +procedure TEDICOMSegment.Initialize; +begin + inherited; + FDelimitersIntf := TEDICOMDelimiters.Create; + FDelimitersIntf.ObjAddRef; + FElementIntf := TEDICOMElement.Create; + FElementIntf.ObjAddRef; + FSegment := nil; +end; + +function TEDICOMSegment.InsertElement(InsertIndex: Integer): Integer; +begin + Result := FSegment.InsertElement(InsertIndex); +end; + +function TEDICOMSegment.InsertElements(InsertIndex, Count: Integer): Integer; +begin + Result := FSegment.InsertElements(InsertIndex, Count); +end; + +procedure TEDICOMSegment.SetInternalEDIObjectRef(EDIObject: TEDIObject); +begin + FSegment := TEDISegment(EDIObject); +end; + +procedure TEDICOMSegment.Set_Data(const Value: WideString); +begin + FSegment.Data := Value; +end; + +procedure TEDICOMSegment.Set_SegmentId(const Value: WideString); +begin + FSegment.SegmentId := Value; +end; + +{ TEDICOMTransactionSet } + +function TEDICOMTransactionSet.AddSegment: Integer; +begin + Result := FTransactionSet.AddSegment; +end; + +function TEDICOMTransactionSet.AddSegments(Count: Integer): Integer; +begin + Result := FTransactionSet.AddSegments(Count); +end; + +function TEDICOMTransactionSet.Assemble: WideString; +begin + Result := FTransactionSet.Assemble; +end; + +procedure TEDICOMTransactionSet.DeleteSegment(Index: Integer); +begin + FTransactionSet.DeleteSegment(Index); +end; + +procedure TEDICOMTransactionSet.DeleteSegments; +begin + FTransactionSet.DeleteSegments; +end; + +destructor TEDICOMTransactionSet.Destroy; +begin + FSegmentIntf.ObjRelease; + FSegmentIntf := nil; + FDelimitersIntf.ObjRelease; + FDelimitersIntf := nil; + FTransactionSet := nil; + inherited; +end; + +procedure TEDICOMTransactionSet.Disassemble; +begin + FTransactionSet.Disassemble; +end; + +function TEDICOMTransactionSet.Get_Data: WideString; +begin + Result := FTransactionSet.Data; +end; + +function TEDICOMTransactionSet.Get_DataLength: Integer; +begin + Result := FTransactionSet.DataLength; +end; + +function TEDICOMTransactionSet.Get_Delimiters: IEDICOMDelimiters; +begin + FDelimitersIntf.SetInternalEDIObjectRef(FTransactionSet.Delimiters); + Result := FDelimitersIntf; +end; + +function TEDICOMTransactionSet.Get_Segment(Index: Integer): IEDICOMSegment; +begin + FSegmentIntf.SetInternalEDIObjectRef(FTransactionSet[Index]); + Result := FSegmentIntf; +end; + +function TEDICOMTransactionSet.Get_SegmentCount: Integer; +begin + Result := FTransactionSet.SegmentCount; +end; + +function TEDICOMTransactionSet.Get_SegmentSE: IEDICOMSegment; +begin + FSegmentIntf.SetInternalEDIObjectRef(FTransactionSet.SegmentSE); + Result := FSegmentIntf; +end; + +function TEDICOMTransactionSet.Get_SegmentST: IEDICOMSegment; +begin + FSegmentIntf.SetInternalEDIObjectRef(FTransactionSet.SegmentST); + Result := FSegmentIntf; +end; + +function TEDICOMTransactionSet.Get_State: Integer; +begin + Result := Integer(FTransactionSet.State); +end; + +procedure TEDICOMTransactionSet.Initialize; +begin + inherited; + FDelimitersIntf := TEDICOMDelimiters.Create; + FDelimitersIntf.ObjAddRef; + FSegmentIntf := TEDICOMSegment.Create; + FSegmentIntf.ObjAddRef; + FTransactionSet := nil; +end; + +function TEDICOMTransactionSet.InsertSegment(InsertIndex: Integer): Integer; +begin + Result := FTransactionSet.InsertSegment(InsertIndex); +end; + +function TEDICOMTransactionSet.InsertSegments(InsertIndex, Count: Integer): Integer; +begin + Result := FTransactionSet.InsertSegments(InsertIndex, Count); +end; + +procedure TEDICOMTransactionSet.SetInternalEDIObjectRef(EDIObject: TEDIObject); +begin + FTransactionSet := TEDITransactionSet(EDIObject); +end; + +procedure TEDICOMTransactionSet.Set_Data(const Value: WideString); +begin + FTransactionSet.Data := Value; +end; + +{ TEDICOMFunctionalGroup } + +function TEDICOMFunctionalGroup.AddTransactionSet: Integer; +begin + Result := FFunctionalGroup.AddTransactionSet; +end; + +function TEDICOMFunctionalGroup.AddTransactionSets(Count: Integer): Integer; +begin + Result := FFunctionalGroup.AddTransactionSets(Count); +end; + +function TEDICOMFunctionalGroup.Assemble: WideString; +begin + Result := FFunctionalGroup.Assemble; +end; + +procedure TEDICOMFunctionalGroup.DeleteTransactionSet(Index: Integer); +begin + FFunctionalGroup.DeleteTransactionSet(Index); +end; + +procedure TEDICOMFunctionalGroup.DeleteTransactionSets; +begin + FFunctionalGroup.DeleteTransactionSets; +end; + +destructor TEDICOMFunctionalGroup.Destroy; +begin + FTransactionSetIntf.ObjRelease; + FTransactionSetIntf := nil; + FSegmentIntf.ObjRelease; + FSegmentIntf := nil; + FDelimitersIntf.ObjRelease; + FDelimitersIntf := nil; + FFunctionalGroup := nil; + inherited; +end; + +procedure TEDICOMFunctionalGroup.Disassemble; +begin + FFunctionalGroup.Disassemble; +end; + +function TEDICOMFunctionalGroup.Get_Data: WideString; +begin + Result := FFunctionalGroup.Data; +end; + +function TEDICOMFunctionalGroup.Get_DataLength: Integer; +begin + Result := FFunctionalGroup.DataLength; +end; + +function TEDICOMFunctionalGroup.Get_Delimiters: IEDICOMDelimiters; +begin + FDelimitersIntf.SetInternalEDIObjectRef(FFunctionalGroup.Delimiters); + Result := FDelimitersIntf; +end; + +function TEDICOMFunctionalGroup.Get_SegmentGE: IEDICOMSegment; +begin + FSegmentIntf.SetInternalEDIObjectRef(FFunctionalGroup.SegmentGE); + Result := FSegmentIntf; +end; + +function TEDICOMFunctionalGroup.Get_SegmentGS: IEDICOMSegment; +begin + FSegmentIntf.SetInternalEDIObjectRef(FFunctionalGroup.SegmentGS); + Result := FSegmentIntf; +end; + +function TEDICOMFunctionalGroup.Get_State: Integer; +begin + Result := Integer(FFunctionalGroup.State); +end; + +function TEDICOMFunctionalGroup.Get_TransactionSet(Index: Integer): IEDICOMTransactionSet; +begin + FTransactionSetIntf.SetInternalEDIObjectRef(FFunctionalGroup[Index]); + Result := FTransactionSetIntf; +end; + +function TEDICOMFunctionalGroup.Get_TransactionSetCount: Integer; +begin + Result := FFunctionalGroup.TransactionSetCount; +end; + +procedure TEDICOMFunctionalGroup.Initialize; +begin + inherited; + FDelimitersIntf := TEDICOMDelimiters.Create; + FDelimitersIntf.ObjAddRef; + FSegmentIntf := TEDICOMSegment.Create; + FSegmentIntf.ObjAddRef; + FTransactionSetIntf := TEDICOMTransactionSet.Create; + FTransactionSetIntf.ObjAddRef; + FFunctionalGroup := nil; +end; + +function TEDICOMFunctionalGroup.InsertTransactionSet(InsertIndex: Integer): Integer; +begin + Result := FFunctionalGroup.InsertTransactionSet(InsertIndex); +end; + +function TEDICOMFunctionalGroup.InsertTransactionSets(InsertIndex, Count: Integer): Integer; +begin + Result := FFunctionalGroup.InsertTransactionSets(InsertIndex, Count); +end; + +procedure TEDICOMFunctionalGroup.SetInternalEDIObjectRef(EDIObject: TEDIObject); +begin + FFunctionalGroup := TEDIFunctionalGroup(EDIObject); +end; + +procedure TEDICOMFunctionalGroup.Set_Data(const Value: WideString); +begin + FFunctionalGroup.Data := Value; +end; + +{ TEDICOMInterchangeControl } + +function TEDICOMInterchangeControl.Assemble: WideString; +begin + Result := FInterchangeControl.Assemble; +end; + +destructor TEDICOMInterchangeControl.Destroy; +begin + FFunctionalGroupIntf.ObjRelease; + FFunctionalGroupIntf := nil; + FSegmentIntf.ObjRelease; + FSegmentIntf := nil; + FDelimitersIntf.ObjRelease; + FDelimitersIntf := nil; + FInterchangeControl := nil; + inherited; +end; + +procedure TEDICOMInterchangeControl.Disassemble; +begin + FInterchangeControl.Disassemble; +end; + +function TEDICOMInterchangeControl.Get_Data: WideString; +begin + Result := FInterchangeControl.Data; +end; + +function TEDICOMInterchangeControl.Get_DataLength: Integer; +begin + Result := FInterchangeControl.DataLength; +end; + +function TEDICOMInterchangeControl.Get_FunctionalGroup(Index: Integer): IEDICOMFunctionalGroup; +begin + FFunctionalGroupIntf.SetInternalEDIObjectRef(FInterchangeControl[Index]); + Result := FFunctionalGroupIntf; +end; + +function TEDICOMInterchangeControl.Get_SegmentIEA: IEDICOMSegment; +begin + FSegmentIntf.SetInternalEDIObjectRef(FInterchangeControl.SegmentIEA); + Result := FSegmentIntf; +end; + +function TEDICOMInterchangeControl.Get_SegmentISA: IEDICOMSegment; +begin + FSegmentIntf.SetInternalEDIObjectRef(FInterchangeControl.SegmentISA); + Result := FSegmentIntf; +end; + +function TEDICOMInterchangeControl.Get_State: Integer; +begin + Result := Integer(FInterchangeControl.State); +end; + +procedure TEDICOMInterchangeControl.Initialize; +begin + inherited; + FDelimitersIntf := TEDICOMDelimiters.Create; + FDelimitersIntf.ObjAddRef; + FSegmentIntf := TEDICOMSegment.Create; + FSegmentIntf.ObjAddRef; + FFunctionalGroupIntf := TEDICOMFunctionalGroup.Create; + FFunctionalGroupIntf.ObjAddRef; + FInterchangeControl := nil; +end; + +procedure TEDICOMInterchangeControl.Set_Data(const Value: WideString); +begin + FInterchangeControl.Data := Value; +end; + +procedure TEDICOMInterchangeControl.SetInternalEDIObjectRef(EDIObject: TEDIObject); +begin + FInterchangeControl := TEDIInterchangeControl(EDIObject); +end; + +function TEDICOMInterchangeControl.AddFunctionalGroup: Integer; +begin + Result := FInterchangeControl.AddFunctionalGroup; +end; + +function TEDICOMInterchangeControl.AddFunctionalGroups(InsertIndex: Integer): Integer; +begin + Result := FInterchangeControl.InsertFunctionalGroup(InsertIndex); +end; + +procedure TEDICOMInterchangeControl.DeleteFunctionalGroup(Index: Integer); +begin + FInterchangeControl.DeleteFunctionalGroup(Index); +end; + +procedure TEDICOMInterchangeControl.DeleteFunctionalGroups; +begin + FInterchangeControl.DeleteFunctionalGroups; +end; + +function TEDICOMInterchangeControl.InsertFunctionalGroup(InsertIndex: Integer): Integer; +begin + Result := FInterchangeControl.InsertFunctionalGroup(InsertIndex); +end; + +function TEDICOMInterchangeControl.InsertFunctionalGroups(InsertIndex, Count: Integer): Integer; +begin + Result := FInterchangeControl.InsertFunctionalGroups(InsertIndex, Count); +end; + +function TEDICOMInterchangeControl.Get_Delimiters: IEDICOMDelimiters; +begin + FDelimitersIntf.SetInternalEDIObjectRef(FInterchangeControl.Delimiters); + Result := FDelimitersIntf; +end; + +procedure TEDICOMInterchangeControl.SetDelimiters(const SD, ED, SS: WideString); +begin + FInterchangeControl.Delimiters := TEDIDelimiters.Create(SD, ED, SS); +end; + +function TEDICOMInterchangeControl.Get_FunctionalGroupCount: Integer; +begin + Result := FInterchangeControl.FunctionalGroupCount; +end; + +{ TEDICOMFile } + +function TEDICOMFile.AddInterchange: Integer; +begin + Result := FEDIFile.AddInterchange; +end; + +function TEDICOMFile.AddInterchanges(Count: Integer): Integer; +begin + Result := FEDIFile.AddInterchanges(Count); +end; + +function TEDICOMFile.Assemble: WideString; +begin + Result := FEDIFile.Assemble; +end; + +procedure TEDICOMFile.DeleteInterchange(Index: Integer); +begin + FEDIFile.DeleteInterchange(Index); +end; + +procedure TEDICOMFile.DeleteInterchanges; +begin + FEDIFile.DeleteInterchanges; +end; + +destructor TEDICOMFile.Destroy; +begin + FInterchangeControlIntf.ObjRelease; + FInterchangeControlIntf := nil; + FDelimitersIntf.ObjRelease; + FDelimitersIntf := nil; + FEDIFile.Free; + FEDIFile := nil; + inherited; +end; + +procedure TEDICOMFile.Disassemble; +begin + FEDIFile.Disassemble; +end; + +function TEDICOMFile.Get_Data: WideString; +begin + Result := FEDIFile.Data; +end; + +function TEDICOMFile.Get_DataLength: Integer; +begin + Result := FEDIFile.DataLength; +end; + +function TEDICOMFile.Get_Delimiters: IEDICOMDelimiters; +begin + FDelimitersIntf.SetInternalEDIObjectRef(FEDIFile.Delimiters); + Result := FDelimitersIntf; +end; + +function TEDICOMFile.Get_FileName: WideString; +begin + Result := FEDIFile.FileName; +end; + +function TEDICOMFile.Get_Interchange(Index: Integer): IEDICOMInterchangeControl; +begin + FInterchangeControlIntf.SetInternalEDIObjectRef(FEDIFile[Index]); + Result := FInterchangeControlIntf; +end; + +function TEDICOMFile.Get_InterchangeCount: Integer; +begin + Result := FEDIFile.InterchangeControlCount; +end; + +function TEDICOMFile.Get_Options: Byte; +begin + Result := Byte(FEDIFIle.Options); +end; + +function TEDICOMFile.Get_State: Integer; +begin + Result := Integer(FEDIFile.State); +end; + +procedure TEDICOMFile.Initialize; +begin + inherited; + FDelimitersIntf := TEDICOMDelimiters.Create; + FDelimitersIntf.ObjAddRef; + FInterchangeControlIntf := TEDICOMInterchangeControl.Create; + FInterchangeControlIntf.ObjAddRef; + FEDIFile := TEDIFile.Create(nil); +end; + +function TEDICOMFile.InsertInterchange(InsertIndex: Integer): Integer; +begin + Result := FEDIFile.InsertInterchange(InsertIndex); +end; + +function TEDICOMFile.InsertInterchanges(InsertIndex, Count: Integer): Integer; +begin + Result := FEDIFile.InsertInterchanges(InsertIndex, Count); +end; + +procedure TEDICOMFile.LoadFromFile(const FileName: WideString); +begin + FEDIFile.LoadFromFile(FileName); +end; + +procedure TEDICOMFile.ReLoadFromFile; +begin + FEDIFile.ReLoadFromFile; +end; + +procedure TEDICOMFile.SaveAsToFile(const FileName: WideString); +begin + FEDIFile.SaveAsToFile(FileName); +end; + +procedure TEDICOMFile.SaveToFile; +begin + FEDIFile.SaveToFile; +end; + +procedure TEDICOMFile.Set_Data(const Value: WideString); +begin + FEDIFile.Data := Value; +end; + +procedure TEDICOMFile.Set_FileName(const Value: WideString); +begin + FEDIFile.FileName := Value; +end; + +procedure TEDICOMFile.Set_Options(Value: Byte); +begin + FEDIFile.Options := TEDIFileOptions(Value); +end; + +{ TEDICOMDelimiters } + +destructor TEDICOMDelimiters.Destroy; +begin + FDelimiters := nil; + inherited; +end; + +function TEDICOMDelimiters.Get_ED: WideString; +begin + Result := FDelimiters.ED; +end; + +function TEDICOMDelimiters.Get_EDLen: Integer; +begin + Result := FDelimiters.EDLen; +end; + +function TEDICOMDelimiters.Get_SD: WideString; +begin + Result := FDelimiters.SD; +end; + +function TEDICOMDelimiters.Get_SDLen: Integer; +begin + Result := FDelimiters.SDLen; +end; + +function TEDICOMDelimiters.Get_SS: WideString; +begin + Result := FDelimiters.SS; +end; + +function TEDICOMDelimiters.Get_SSLen: Integer; +begin + Result := FDelimiters.SSLen; +end; + +procedure TEDICOMDelimiters.Initialize; +begin + inherited; + FDelimiters := nil; +end; + +procedure TEDICOMDelimiters.Set_ED(const Value: WideString); +begin + FDelimiters.ED := Value; +end; + +procedure TEDICOMDelimiters.Set_SD(const Value: WideString); +begin + FDelimiters.SD := Value; +end; + +procedure TEDICOMDelimiters.Set_SS(const Value: WideString); +begin + FDelimiters.SS := Value; +end; + +procedure TEDICOMDelimiters.SetInternalEDIObjectRef(EDIObject: TEDIObject); +begin + FDelimiters := TEDIDelimiters(EDIObject); +end; + +initialization + TAutoObjectFactory.Create(ComServer, TEDICOMDelimiters, CLASS_EDICOMDelimiters, + ciMultiInstance, tmApartment); + TAutoObjectFactory.Create(ComServer, TEDICOMElement, Class_EDICOMElement, + ciMultiInstance, tmApartment); + TAutoObjectFactory.Create(ComServer, TEDICOMSegment, Class_EDICOMSegment, + ciMultiInstance, tmApartment); + TAutoObjectFactory.Create(ComServer, TEDICOMTransactionSet, Class_EDICOMTransactionSet, + ciMultiInstance, tmApartment); + TAutoObjectFactory.Create(ComServer, TEDICOMFunctionalGroup, Class_EDICOMFunctionalGroup, + ciMultiInstance, tmApartment); + TAutoObjectFactory.Create(ComServer, TEDICOMInterchangeControl, Class_EDICOMInterchangeControl, + ciMultiInstance, tmApartment); + TAutoObjectFactory.Create(ComServer, TEDICOMFile, Class_EDICOMFile, + ciMultiInstance, tmApartment); + +// History + +// rrossmair 2004-07-17: +// - removed unit Dialogs usage + +end. diff --git a/official/1.96/examples/windows/edisdk/comserver/sample.edi b/official/1.96/examples/windows/edisdk/comserver/sample.edi new file mode 100644 index 0000000..bb0a617 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/comserver/sample.edi @@ -0,0 +1 @@ +ISA*00* *00* *ZZ*592015694 *ZZ*F92450103 *030619*1421*U*00401*806333537*0*T*>~GS*FA*MEDBCLM00590*V0014*20030619*1421*806333538*X*004010X098A1~ST*997*360001~AK1*HC*1~AK2*837*031711~AK5*A~AK9*A*1*1*1~SE*6*360001~GE*1*806333538~IEA*1*806333537~ \ No newline at end of file diff --git a/official/1.96/examples/windows/edisdk/sample.edi b/official/1.96/examples/windows/edisdk/sample.edi new file mode 100644 index 0000000..bb0a617 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/sample.edi @@ -0,0 +1 @@ +ISA*00* *00* *ZZ*592015694 *ZZ*F92450103 *030619*1421*U*00401*806333537*0*T*>~GS*FA*MEDBCLM00590*V0014*20030619*1421*806333538*X*004010X098A1~ST*997*360001~AK1*HC*1~AK2*837*031711~AK5*A~AK9*A*1*1*1~SE*6*360001~GE*1*806333538~IEA*1*806333537~ \ No newline at end of file diff --git a/official/1.96/examples/windows/edisdk/vb5/Form1.frm b/official/1.96/examples/windows/edisdk/vb5/Form1.frm new file mode 100644 index 0000000..90fbdcc --- /dev/null +++ b/official/1.96/examples/windows/edisdk/vb5/Form1.frm @@ -0,0 +1,164 @@ +VERSION 5.00 +Begin VB.Form Form1 + Caption = "Form1" + ClientHeight = 5670 + ClientLeft = 60 + ClientTop = 345 + ClientWidth = 6885 + LinkTopic = "Form1" + ScaleHeight = 5670 + ScaleWidth = 6885 + StartUpPosition = 3 'Windows Default + Begin VB.CommandButton Command2 + Caption = "Create File" + Height = 495 + Left = 3120 + TabIndex = 2 + Top = 240 + Width = 3375 + End + Begin VB.TextBox Text1 + Height = 4695 + Left = 240 + MultiLine = -1 'True + ScrollBars = 3 'Both + TabIndex = 1 + Top = 840 + Width = 6375 + End + Begin VB.CommandButton Command1 + Caption = "LoadFile" + Height = 495 + Left = 240 + TabIndex = 0 + Top = 240 + Width = 2535 + End +End +Attribute VB_Name = "Form1" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Private Sub Command1_Click() + Dim F As EDICOMFile + Dim I As Integer + Set F = New EDICOMFile + F.Options = 0 + F.Options = F.Options Or foVariableDelimiterDetection + F.Options = F.Options Or foUseAltDelimiterDetection + F.Options = F.Options Or foRemoveCrLf + F.Options = F.Options Or foRemoveCr + F.Options = F.Options Or foRemoveLf + F.Options = F.Options Or foIgnoreGarbageAtEndOfFile + F.LoadFromFile (App.Path & "\sample.edi") + Text1.Text = F.Data + F.Disassemble + Text1.Text = Text1.Text & vbCrLf + Text1.Text = Text1.Text & F.Interchange(0).SegmentISA.SegmentId + Text1.Text = Text1.Text & vbCrLf + Text1.Text = Text1.Text & F.Interchange(0).FunctionalGroup(0).SegmentGS.SegmentId + Text1.Text = Text1.Text & vbCrLf + Text1.Text = Text1.Text & F.Interchange(0).FunctionalGroup(0).TransactionSet(0).SegmentST.SegmentId + For I = 0 To F.Interchange(0).FunctionalGroup(0).TransactionSet(0).SegmentCount - 1 Step 1 + F.Interchange(0).FunctionalGroup(0).TransactionSet(0).Segment(I).Assemble + Text1.Text = Text1.Text & vbCrLf + Text1.Text = Text1.Text & F.Interchange(0).FunctionalGroup(0).TransactionSet(0).Segment(I).Data + Next + Text1.Text = Text1.Text & vbCrLf + Text1.Text = Text1.Text & F.Interchange(0).FunctionalGroup(0).TransactionSet(0).SegmentSE.SegmentId + Text1.Text = Text1.Text & vbCrLf + Text1.Text = Text1.Text & F.Interchange(0).FunctionalGroup(0).SegmentGE.SegmentId + Text1.Text = Text1.Text & vbCrLf + Text1.Text = Text1.Text & F.Interchange(0).SegmentIEA.SegmentId +End Sub + +Private Sub Command2_Click() + Dim C As EDICOMFile + Dim I, F, T, S, E As Integer + Set C = New EDICOMFile + + I = C.AddInterchange + C.Interchange(I).SetDelimiters "~" & vbCrLf, "*", ">" + With C.Interchange(I).SegmentISA + .SegmentId = "ISA" + .DeleteElements + .AddElements (17) + .Element(0).Data = "data" + .Element(1).Data = "data" + .Element(2).Data = "data" + .Element(3).Data = "data" + .Element(4).Data = "data" + .Element(5).Data = "data" + .Element(6).Data = "data" + .Element(7).Data = "data" + .Element(8).Data = "data" + .Element(9).Data = "data" + .Element(10).Data = "data" + .Element(11).Data = "data" + .Element(12).Data = "data" + .Element(13).Data = "data" + .Element(14).Data = "data" + .Element(15).Data = "data" + .Element(16).Data = C.Interchange(I).Delimiters.SS + End With + + F = C.Interchange(I).AddFunctionalGroup + With C.Interchange(I).FunctionalGroup(F).SegmentGS + .SegmentId = "GS" + .DeleteElements + .AddElements (8) + .Element(0).Data = "data" + .Element(1).Data = "data" + .Element(2).Data = "data" + .Element(3).Data = "data" + .Element(4).Data = "data" + .Element(5).Data = "data" + .Element(6).Data = "data" + .Element(7).Data = "data" + End With + + T = C.Interchange(I).FunctionalGroup(F).AddTransactionSet + With C.Interchange(I).FunctionalGroup(F).TransactionSet(T).SegmentST + .SegmentId = "ST" + .DeleteElements + .AddElements (2) + .Element(0).Data = "data" + .Element(1).Data = "data" + End With + + S = C.Interchange(I).FunctionalGroup(F).TransactionSet(T).AddSegment + With C.Interchange(I).FunctionalGroup(F).TransactionSet(T).Segment(S) + .SegmentId = "TST" + .AddElements (2) + .Element(0).Data = "data 1" + .Element(1).Data = "data 2" + End With + + With C.Interchange(I).FunctionalGroup(F).TransactionSet(T).SegmentSE + .SegmentId = "SE" + .DeleteElements + .AddElements (2) + .Element(0).Data = "data" + .Element(1).Data = "data" + End With + + With C.Interchange(I).FunctionalGroup(F).SegmentGE + .SegmentId = "GE" + .DeleteElements + .AddElements (2) + .Element(0).Data = "data" + .Element(1).Data = "data" + End With + + With C.Interchange(I).SegmentIEA + .SegmentId = "IEA" + .DeleteElements + .AddElements (2) + .Element(0).Data = "data" + .Element(1).Data = "data" + End With + + Text1.Text = C.Assemble + +End Sub diff --git a/official/1.96/examples/windows/edisdk/vb5/Form1.frx b/official/1.96/examples/windows/edisdk/vb5/Form1.frx new file mode 100644 index 0000000..da8c0d9 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/vb5/Form1.frx @@ -0,0 +1 @@ +Text1 \ No newline at end of file diff --git a/official/1.96/examples/windows/edisdk/vb5/Project1.exe b/official/1.96/examples/windows/edisdk/vb5/Project1.exe new file mode 100644 index 0000000..360f39a Binary files /dev/null and b/official/1.96/examples/windows/edisdk/vb5/Project1.exe differ diff --git a/official/1.96/examples/windows/edisdk/vb5/Project1.vbp b/official/1.96/examples/windows/edisdk/vb5/Project1.vbp new file mode 100644 index 0000000..a94b847 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/vb5/Project1.vbp @@ -0,0 +1,39 @@ +Type=Exe +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\WINNT\System32\stdole2.tlb#OLE Automation +Reference=*\G{AF3BB992-62DF-41B7-92C7-FA41BDBB427E}#1.0#0#..\EDISDK.dll#EDI SDK COM Object Library +Form=Form1.frm +Object={00028C01-0000-0000-0000-000000000046}#1.0#0; DBGRID32.OCX +Object={FE0065C0-1B7B-11CF-9D53-00AA003C9CB6}#1.0#0; comct232.ocx +Object={FAEEE763-117E-101B-8933-08002B2F4F5A}#1.1#0; dblist32.ocx +Object={0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0; FM20.DLL +Object={5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0; msflxgrd.ocx +Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0; comdlg32.ocx +IconForm="Form1" +Startup="Form1" +HelpFile="" +Title="Project1" +ExeName32="Project1.exe" +Command32="" +Name="Project1" +HelpContextID="0" +CompatibleMode="0" +MajorVer=1 +MinorVer=0 +RevisionVer=3 +AutoIncrementVer=1 +ServerSupportFiles=0 +VersionCompanyName="None" +CompilationType=0 +OptimizationType=0 +FavorPentiumPro(tm)=-1 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=-1 +UnroundedFP=0 +StartMode=0 +Unattended=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 diff --git a/official/1.96/examples/windows/edisdk/vb5/Project1.vbw b/official/1.96/examples/windows/edisdk/vb5/Project1.vbw new file mode 100644 index 0000000..a4c36f7 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/vb5/Project1.vbw @@ -0,0 +1 @@ +Form1 = 44, 44, 419, 390, Z, 22, 22, 273, 284, diff --git a/official/1.96/examples/windows/edisdk/vb5/sample.edi b/official/1.96/examples/windows/edisdk/vb5/sample.edi new file mode 100644 index 0000000..bb0a617 --- /dev/null +++ b/official/1.96/examples/windows/edisdk/vb5/sample.edi @@ -0,0 +1 @@ +ISA*00* *00* *ZZ*592015694 *ZZ*F92450103 *030619*1421*U*00401*806333537*0*T*>~GS*FA*MEDBCLM00590*V0014*20030619*1421*806333538*X*004010X098A1~ST*997*360001~AK1*HC*1~AK2*837*031711~AK5*A~AK9*A*1*1*1~SE*6*360001~GE*1*806333538~IEA*1*806333537~ \ No newline at end of file diff --git a/official/1.96/examples/windows/fileversion/VerInfoDemoMain.dfm b/official/1.96/examples/windows/fileversion/VerInfoDemoMain.dfm new file mode 100644 index 0000000..96ff36c --- /dev/null +++ b/official/1.96/examples/windows/fileversion/VerInfoDemoMain.dfm @@ -0,0 +1,55 @@ +object Form1: TForm1 + Left = 203 + Top = 116 + Width = 537 + Height = 420 + Caption = 'TJclFileVersionInfo example' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object Memo1: TMemo + Left = 152 + Top = 0 + Width = 377 + Height = 392 + Anchors = [akLeft, akTop, akRight, akBottom] + Lines.Strings = ( + 'Memo1') + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 0 + end + object DriveComboBox1: TDriveComboBox + Left = 0 + Top = 0 + Width = 145 + Height = 19 + DirList = DirectoryListBox1 + TabOrder = 1 + end + object DirectoryListBox1: TDirectoryListBox + Left = 0 + Top = 24 + Width = 145 + Height = 97 + FileList = FileListBox1 + ItemHeight = 16 + TabOrder = 2 + end + object FileListBox1: TFileListBox + Left = 0 + Top = 128 + Width = 145 + Height = 262 + Anchors = [akLeft, akTop, akBottom] + ItemHeight = 13 + TabOrder = 3 + OnChange = FileListBox1Change + end +end diff --git a/official/1.96/examples/windows/fileversion/VerInfoDemoMain.pas b/official/1.96/examples/windows/fileversion/VerInfoDemoMain.pas new file mode 100644 index 0000000..9b736a0 --- /dev/null +++ b/official/1.96/examples/windows/fileversion/VerInfoDemoMain.pas @@ -0,0 +1,77 @@ +unit VerInfoDemoMain; + +interface + +{$I jcl.inc} + +{$IFDEF COMPILER6_UP} + {$WARN UNIT_PLATFORM OFF} +{$ENDIF COMPILER6_UP} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, FileCtrl; + +type + TForm1 = class(TForm) + Memo1: TMemo; + DriveComboBox1: TDriveComboBox; + DirectoryListBox1: TDirectoryListBox; + FileListBox1: TFileListBox; + procedure FileListBox1Change(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +uses + JclFileUtils, JclStrings; + +{ TForm1 } + +procedure TForm1.FileListBox1Change(Sender: TObject); +var + FileName: TFileName; + I: Integer; +begin + FileName := FileListBox1.FileName; + Memo1.Lines.BeginUpdate; + try + Memo1.Lines.Clear; + + if VersionResourceAvailable(FileName) then + with TJclFileVersionInfo.Create(FileName) do + try + for I := 0 to LanguageCount - 1 do + begin + LanguageIndex := I; + Memo1.Lines.Add(Format('[%s] %s', [LanguageIds[I], LanguageNames[I]])); + Memo1.Lines.Add(StringOfChar('-', 80)); + Memo1.Lines.AddStrings(Items); + Memo1.Lines.Add(BinFileVersion); + Memo1.Lines.Add(OSIdentToString(FileOS)); + Memo1.Lines.Add(OSFileTypeToString(FileType, FileSubType)); + Memo1.Lines.Add(''); + end; + Memo1.Lines.Add('Translations:'); + for I := 0 to TranslationCount - 1 do + Memo1.Lines.Add(VersionLanguageId(Translations[I])); + Memo1.Lines.Add(BooleanToStr(TranslationMatchesLanguages)); + finally + Free; + end; + + finally + Memo1.Lines.EndUpdate; + end; +end; + +end. diff --git a/official/1.96/examples/windows/fileversion/VerInfoExample.dof b/official/1.96/examples/windows/fileversion/VerInfoExample.dof new file mode 100644 index 0000000..4c107f6 --- /dev/null +++ b/official/1.96/examples/windows/fileversion/VerInfoExample.dof @@ -0,0 +1,82 @@ +[Compiler] +A=1 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=0 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir=..\..\..\bin +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=$(DELPHI)\Lib\Debug;I:\Quellen\jedi\jcl\lib\d5\debug;I:\Quellen\jedi\jcl.cvs\jcl\lib\D5\debug;I:\Quellen\jedi\jcl\lib\D5\debug +Packages=Vcl50;TeeQR50;dclocx50;Vclx50;dclqsprint50;dcliex50;ex2fs;Vcldb50;Vclbde50;ibevnt50;Indy50;A406_R50;rrMixers50;rrCmpInf50;VclSmp50;TeeUI50;TeeDB50;Tee50;vcldbx50;VCLIB50;vclie50;Inetdb50;Inet50;dclaxserver50;EPCOTAUtils50;DJcl50;ADSD50;rrSigDpl50;JvAppFrmD5R;JvCoreD5R;JvBandsD5R;JvBDED5R;JvDBD5R;JvCmpD5R;JvCryptD5R;JvCtrlsD5R;JvCustomD5R;JvDlgsD5R;JvDockingD5R;JvDotNetCtrlsD5R;JvEDID5R;Qrpt50;JvGlobusD5R;JvHMID5R;JvInspectorD5R;JvInterpreterD5R;JvJansD5R;JvManagedThreadsD5R;JvMMD5R;JvNetD5R;JvStdCtrlsD5R;JvPageCompsD5R;JvPluginD5R;JvPrintPreviewD5R;JvSystemD5R;JvTimeFrameworkD5R;JvUIBD5R;JvValidatorsD5R;JvWizardD5R;JvXPCtrlsD5R +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +[Language] +ActiveLang= +ProjectLang=$00000407 +RootDir= +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1031 +CodePage=1252 +[Excluded Packages] +$(DELPHI)\Bin\dclie50.bpl=Internet Explorer Components +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=1 +Item0=$(DELPHI)\Lib\Debug;I:\Quellen\jedi\jcl\lib\d5\debug;I:\Quellen\jedi\jcl.cvs\jcl\lib\D5\debug;I:\Quellen\jedi\jcl\lib\D5\debug +[HistoryLists\hlOutputDirectorry] +Count=1 +Item0=..\..\..\bin diff --git a/official/1.96/examples/windows/fileversion/VerInfoExample.dpr b/official/1.96/examples/windows/fileversion/VerInfoExample.dpr new file mode 100644 index 0000000..2797b48 --- /dev/null +++ b/official/1.96/examples/windows/fileversion/VerInfoExample.dpr @@ -0,0 +1,13 @@ +program VerInfoExample; + +uses + Forms, + VerInfoDemoMain in 'VerInfoDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/fileversion/VerInfoExample.res b/official/1.96/examples/windows/fileversion/VerInfoExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/fileversion/VerInfoExample.res differ diff --git a/official/1.96/examples/windows/lanman/LanManDemoMain.dfm b/official/1.96/examples/windows/lanman/LanManDemoMain.dfm new file mode 100644 index 0000000..b1c41d5 --- /dev/null +++ b/official/1.96/examples/windows/lanman/LanManDemoMain.dfm @@ -0,0 +1,271 @@ +object Form1: TForm1 + Left = 339 + Top = 230 + Width = 724 + Height = 416 + Caption = 'Form1' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object GroupBox1: TGroupBox + Left = 8 + Top = 8 + Width = 345 + Height = 205 + Caption = 'User' + TabOrder = 0 + object Label1: TLabel + Left = 16 + Top = 24 + Width = 54 + Height = 13 + Caption = 'User name:' + end + object Label2: TLabel + Left = 16 + Top = 72 + Width = 49 + Height = 13 + Caption = 'Password:' + end + object Label3: TLabel + Left = 16 + Top = 96 + Width = 44 + Height = 13 + Caption = 'Comment' + end + object Label4: TLabel + Left = 16 + Top = 144 + Width = 30 + Height = 13 + Caption = 'Script:' + end + object Label5: TLabel + Left = 16 + Top = 168 + Width = 34 + Height = 13 + Caption = 'Server:' + end + object Label6: TLabel + Left = 16 + Top = 120 + Width = 44 + Height = 13 + Caption = 'HomeDir:' + end + object Label11: TLabel + Left = 16 + Top = 48 + Width = 50 + Height = 13 + Caption = 'Full Name:' + end + object edtUserName: TEdit + Left = 80 + Top = 20 + Width = 165 + Height = 21 + TabOrder = 0 + end + object edtPassword: TEdit + Left = 80 + Top = 68 + Width = 165 + Height = 21 + TabOrder = 1 + end + object edtComment: TEdit + Left = 80 + Top = 92 + Width = 165 + Height = 21 + TabOrder = 2 + end + object edtScript: TEdit + Left = 80 + Top = 140 + Width = 165 + Height = 21 + TabOrder = 3 + end + object edtServer: TEdit + Left = 80 + Top = 164 + Width = 165 + Height = 21 + TabOrder = 4 + end + object edtHomedir: TEdit + Left = 80 + Top = 116 + Width = 165 + Height = 21 + TabOrder = 5 + end + object btnAddUser: TButton + Left = 262 + Top = 20 + Width = 75 + Height = 25 + Caption = '&Add' + TabOrder = 6 + OnClick = btnAddUserClick + end + object btnDeleteUser: TButton + Left = 262 + Top = 52 + Width = 75 + Height = 25 + Caption = 'Delete' + TabOrder = 7 + OnClick = btnDeleteUserClick + end + object edtFullName: TEdit + Left = 80 + Top = 44 + Width = 165 + Height = 21 + TabOrder = 8 + end + end + object GroupBox2: TGroupBox + Left = 8 + Top = 220 + Width = 257 + Height = 161 + Caption = 'Group Information' + TabOrder = 1 + object Label7: TLabel + Left = 16 + Top = 24 + Width = 21 + Height = 13 + Caption = 'SID:' + end + object Label8: TLabel + Left = 16 + Top = 48 + Width = 31 + Height = 13 + Caption = 'Name:' + end + object edtSIDName: TEdit + Left = 80 + Top = 44 + Width = 165 + Height = 21 + TabOrder = 0 + end + object cboSID: TComboBox + Left = 80 + Top = 20 + Width = 165 + Height = 21 + ItemHeight = 13 + TabOrder = 1 + OnChange = cboSIDChange + Items.Strings = ( + 'DOMAIN_ALIAS_RID_ADMINS' + 'DOMAIN_ALIAS_RID_USERS' + 'DOMAIN_ALIAS_RID_GUESTS' + 'DOMAIN_ALIAS_RID_POWER_USERS' + 'DOMAIN_ALIAS_RID_BACKUP_OPS' + 'DOMAIN_ALIAS_RID_REPLICATOR' + 'SECURITY_WORLD_RID') + end + object GroupBox3: TGroupBox + Left = 16 + Top = 72 + Width = 229 + Height = 73 + Caption = 'System' + TabOrder = 2 + object rbLocal: TRadioButton + Left = 12 + Top = 20 + Width = 113 + Height = 17 + Caption = 'Local' + TabOrder = 0 + end + object rbRemote: TRadioButton + Left = 12 + Top = 42 + Width = 17 + Height = 17 + TabOrder = 1 + end + object edtSystemName: TEdit + Left = 32 + Top = 40 + Width = 181 + Height = 21 + TabOrder = 2 + end + end + end + object GroupBox4: TGroupBox + Left = 360 + Top = 8 + Width = 349 + Height = 89 + Caption = 'Group' + TabOrder = 2 + object Label9: TLabel + Left = 16 + Top = 24 + Width = 61 + Height = 13 + Caption = 'Group name:' + end + object Label10: TLabel + Left = 16 + Top = 52 + Width = 44 + Height = 13 + Caption = 'Comment' + end + object edtGroupName: TEdit + Left = 84 + Top = 20 + Width = 165 + Height = 21 + TabOrder = 0 + end + object btnAddGroup: TButton + Left = 262 + Top = 20 + Width = 75 + Height = 25 + Caption = '&Add' + TabOrder = 1 + OnClick = btnAddGroupClick + end + object btnDeleteGroup: TButton + Left = 262 + Top = 52 + Width = 75 + Height = 25 + Caption = 'Delete' + TabOrder = 2 + OnClick = btnDeleteGroupClick + end + object edtGroupComment: TEdit + Left = 84 + Top = 48 + Width = 165 + Height = 21 + TabOrder = 3 + end + end +end diff --git a/official/1.96/examples/windows/lanman/LanManDemoMain.pas b/official/1.96/examples/windows/lanman/LanManDemoMain.pas new file mode 100644 index 0000000..a7bb8e5 --- /dev/null +++ b/official/1.96/examples/windows/lanman/LanManDemoMain.pas @@ -0,0 +1,124 @@ +unit LanManDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls; + +type + TForm1 = class(TForm) + GroupBox1: TGroupBox; + Label1: TLabel; + edtUserName: TEdit; + Label2: TLabel; + edtPassword: TEdit; + Label3: TLabel; + edtComment: TEdit; + Label4: TLabel; + edtScript: TEdit; + Label5: TLabel; + edtServer: TEdit; + Label6: TLabel; + edtHomedir: TEdit; + GroupBox2: TGroupBox; + Label7: TLabel; + Label8: TLabel; + edtSIDName: TEdit; + cboSID: TComboBox; + GroupBox3: TGroupBox; + rbLocal: TRadioButton; + rbRemote: TRadioButton; + edtSystemName: TEdit; + GroupBox4: TGroupBox; + btnAddUser: TButton; + btnDeleteUser: TButton; + Label9: TLabel; + edtGroupName: TEdit; + btnAddGroup: TButton; + btnDeleteGroup: TButton; + Label10: TLabel; + edtGroupComment: TEdit; + Label11: TLabel; + edtFullName: TEdit; + procedure btnAddUserClick(Sender: TObject); + procedure cboSIDChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure btnDeleteUserClick(Sender: TObject); + procedure btnAddGroupClick(Sender: TObject); + procedure btnDeleteGroupClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +uses JclLANMan, JclSysInfo; + +{$R *.DFM} + +procedure TForm1.btnAddUserClick(Sender: TObject); +begin + if CreateLocalAccount(edtUsername.Text, + edtFullName.Text, + edtPassword.Text, + edtComment.Text, + edtHomeDir.Text, + edtScript.Text) then + begin + ShowMessage('Success') + end + else + ShowMessage('Failure'); + +end; + +procedure TForm1.cboSIDChange(Sender: TObject); +var + SystemName: string; +begin + if rbLocal.Checked then + SystemName := '' + else + SystemName := edtSystemName.Text; + + case cboSID.ItemIndex of + 0: edtSIDName.Text := LookupGroupname(SystemName, wkrAdmins); + 1: edtSIDName.Text := LookupGroupname(SystemName, wkrUsers); + 2: edtSIDName.Text := LookupGroupname(SystemName, wkrGuests); + 3: edtSIDName.Text := LookupGroupname(SystemName, wkrPowerUsers); + 4: edtSIDName.Text := LookupGroupname(SystemName, wkrBackupOPs); + 5: edtSIDName.Text := LookupGroupname(SystemName, wkrReplicator); + 6: edtSIDName.Text := LookupGroupname(SystemName, wkrEveryone); + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + edtSystemName.Text := GetLocalComputerName; +end; + +procedure TForm1.btnDeleteUserClick(Sender: TObject); +begin + DeleteLocalAccount(edtUserName.Text); +end; + +procedure TForm1.btnAddGroupClick(Sender: TObject); +begin + if CreateLocalGroup('', edtGroupName.Text, edtGroupComment.Text) then + ShowMessage('success') + else + SHowMessage('failure'); +end; + +procedure TForm1.btnDeleteGroupClick(Sender: TObject); +begin + DeleteLocalGroup('', edtGroupName.Text); +end; + +end. diff --git a/official/1.96/examples/windows/lanman/LanManExample.dof b/official/1.96/examples/windows/lanman/LanManExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/lanman/LanManExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/lanman/LanManExample.dpr b/official/1.96/examples/windows/lanman/LanManExample.dpr new file mode 100644 index 0000000..2e91df3 --- /dev/null +++ b/official/1.96/examples/windows/lanman/LanManExample.dpr @@ -0,0 +1,13 @@ +program LanManExample; + +uses + Forms, + LanManDemoMain in 'LanManDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/lanman/LanManExample.res b/official/1.96/examples/windows/lanman/LanManExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/lanman/LanManExample.res differ diff --git a/official/1.96/examples/windows/locales/LocalesDemoMain.dfm b/official/1.96/examples/windows/locales/LocalesDemoMain.dfm new file mode 100644 index 0000000..af23463 --- /dev/null +++ b/official/1.96/examples/windows/locales/LocalesDemoMain.dfm @@ -0,0 +1,306 @@ +object MainForm: TMainForm + Left = 199 + Top = 112 + Width = 640 + Height = 597 + Caption = 'JclLocales demo' + Color = clBtnFace + Constraints.MinHeight = 570 + Constraints.MinWidth = 640 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 9 + Top = 246 + Width = 53 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Day names' + end + object Label2: TLabel + Left = 8 + Top = 374 + Width = 64 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Month names' + end + object Label3: TLabel + Left = 141 + Top = 246 + Width = 103 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Date and time formats' + end + object Bevel1: TBevel + Left = 312 + Top = 200 + Width = 17 + Height = 363 + Anchors = [akLeft, akBottom] + Shape = bsLeftLine + end + object Label4: TLabel + Left = 320 + Top = 206 + Width = 81 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Keyboard layouts' + end + object Label5: TLabel + Left = 320 + Top = 363 + Width = 126 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Available keyboard layouts' + end + object Label6: TLabel + Left = 141 + Top = 504 + Width = 47 + Height = 13 + Caption = 'Calendars' + end + object LocalesListView: TListView + Left = 0 + Top = 0 + Width = 632 + Height = 195 + Align = alTop + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = < + item + Caption = 'Country' + Width = 120 + end + item + Caption = 'LCID' + end + item + Caption = 'LangName' + Width = 130 + end + item + Caption = 'Lng' + Width = 40 + end + item + Caption = 'CP' + end + item + Caption = '$ Local' + end + item + Caption = '$ Intl.' + end + item + Caption = 'Code' + end> + ColumnClick = False + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Arial' + Font.Style = [] + GridLines = True + HideSelection = False + ReadOnly = True + RowSelect = True + ParentFont = False + TabOrder = 0 + ViewStyle = vsReport + OnCustomDrawSubItem = LocalesListViewCustomDrawSubItem + OnSelectItem = LocalesListViewSelectItem + end + object LocalesRadioGroup: TRadioGroup + Left = 9 + Top = 206 + Width = 296 + Height = 37 + Anchors = [akLeft, akBottom] + Caption = '&Locales' + Columns = 2 + ItemIndex = 0 + Items.Strings = ( + '&Supported' + '&Installed') + TabOrder = 1 + OnClick = LocalesRadioGroupClick + end + object DayNamesListBox: TListBox + Left = 8 + Top = 262 + Width = 121 + Height = 105 + Style = lbOwnerDrawFixed + Anchors = [akLeft, akBottom] + Color = clBtnFace + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Arial' + Font.Style = [] + ItemHeight = 14 + ParentFont = False + TabOrder = 2 + end + object MonthNamesListBox: TListBox + Left = 8 + Top = 389 + Width = 121 + Height = 174 + Style = lbOwnerDrawFixed + Anchors = [akLeft, akBottom] + Color = clBtnFace + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Arial' + Font.Style = [] + ItemHeight = 14 + ParentFont = False + TabOrder = 3 + end + object FormatsListBox: TListBox + Left = 141 + Top = 262 + Width = 163 + Height = 235 + Style = lbOwnerDrawFixed + Anchors = [akLeft, akBottom] + Color = clBtnFace + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Arial' + Font.Style = [] + ItemHeight = 14 + ParentFont = False + TabOrder = 4 + end + object KeyblayoutsListBox: TListBox + Left = 320 + Top = 222 + Width = 305 + Height = 121 + Anchors = [akLeft, akRight, akBottom] + ItemHeight = 13 + TabOrder = 5 + OnClick = KeyblayoutsListBoxClick + OnDblClick = ActivateBtnClick + end + object ActivateBtn: TButton + Left = 512 + Top = 202 + Width = 57 + Height = 19 + Anchors = [akRight, akBottom] + Caption = 'Activate' + Enabled = False + TabOrder = 7 + OnClick = ActivateBtnClick + end + object AvailableLayoutsListView: TListView + Left = 320 + Top = 379 + Width = 305 + Height = 185 + Anchors = [akLeft, akRight, akBottom] + Columns = < + item + Caption = 'Name' + Width = 140 + end + item + Caption = 'Identifier' + Width = 70 + end + item + Caption = 'ID' + Width = 40 + end + item + Caption = 'File' + Width = 90 + end> + ColumnClick = False + GridLines = True + HideSelection = False + ReadOnly = True + RowSelect = True + TabOrder = 9 + ViewStyle = vsReport + OnChange = AvailableLayoutsListViewChange + OnCustomDrawItem = AvailableLayoutsListViewCustomDrawItem + end + object LoadBtn: TButton + Left = 576 + Top = 355 + Width = 49 + Height = 19 + Anchors = [akRight, akBottom] + Caption = 'Load' + Enabled = False + TabOrder = 10 + OnClick = LoadBtnClick + end + object UnloadBtn: TButton + Left = 576 + Top = 202 + Width = 49 + Height = 19 + Anchors = [akRight, akBottom] + Caption = 'Unload' + Enabled = False + TabOrder = 11 + OnClick = UnloadBtnClick + end + object PrevBtn: TButton + Left = 407 + Top = 202 + Width = 42 + Height = 19 + Anchors = [akRight, akBottom] + Caption = 'Prev' + TabOrder = 6 + OnClick = PrevBtnClick + end + object NextBtn: TButton + Left = 455 + Top = 202 + Width = 42 + Height = 19 + Anchors = [akRight, akBottom] + Caption = 'Next' + TabOrder = 8 + OnClick = NextBtnClick + end + object CalendarsListBox: TListBox + Left = 141 + Top = 520 + Width = 163 + Height = 41 + Style = lbOwnerDrawFixed + Anchors = [akLeft, akBottom] + Color = clBtnFace + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Arial' + Font.Style = [] + ItemHeight = 14 + ParentFont = False + TabOrder = 12 + end +end diff --git a/official/1.96/examples/windows/locales/LocalesDemoMain.pas b/official/1.96/examples/windows/locales/LocalesDemoMain.pas new file mode 100644 index 0000000..e7cf9d5 --- /dev/null +++ b/official/1.96/examples/windows/locales/LocalesDemoMain.pas @@ -0,0 +1,290 @@ +unit LocalesDemoMain; + +interface + +{$I jcl.inc} +{$IFDEF SUPPORTS_PLATFORM_WARNINGS} + {$WARN SYMBOL_PLATFORM OFF} +{$ENDIF SUPPORTS_PLATFORM_WARNINGS} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + JclBase, JclLocales, ComCtrls, StdCtrls, ExtCtrls; + +type + TMainForm = class(TForm) + LocalesListView: TListView; + LocalesRadioGroup: TRadioGroup; + DayNamesListBox: TListBox; + MonthNamesListBox: TListBox; + FormatsListBox: TListBox; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Bevel1: TBevel; + KeyblayoutsListBox: TListBox; + Label4: TLabel; + ActivateBtn: TButton; + AvailableLayoutsListView: TListView; + Label5: TLabel; + LoadBtn: TButton; + UnloadBtn: TButton; + PrevBtn: TButton; + NextBtn: TButton; + CalendarsListBox: TListBox; + Label6: TLabel; + procedure FormDestroy(Sender: TObject); + procedure LocalesRadioGroupClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure LocalesListViewSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure ActivateBtnClick(Sender: TObject); + procedure KeyblayoutsListBoxClick(Sender: TObject); + procedure LocalesListViewCustomDrawSubItem(Sender: TCustomListView; + Item: TListItem; SubItem: Integer; State: TCustomDrawState; + var DefaultDraw: Boolean); + procedure AvailableLayoutsListViewChange(Sender: TObject; + Item: TListItem; Change: TItemChange); + procedure LoadBtnClick(Sender: TObject); + procedure UnloadBtnClick(Sender: TObject); + procedure PrevBtnClick(Sender: TObject); + procedure NextBtnClick(Sender: TObject); + procedure AvailableLayoutsListViewCustomDrawItem( + Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; + var DefaultDraw: Boolean); + private + LocalesList: TJclLocalesList; + KeyboardLayoutList: TJclKeyboardLayoutList; + public + procedure CreateAvailableKeyLayoutsList; + procedure CreateLocalesList; + procedure UpdateView(ListItem: TListItem); + procedure UpdateKeybLayouts(Sender: TObject); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.DFM} + +uses + JclSysInfo, JclSysUtils; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + CreateLocalesList; + KeyboardLayoutList := TJclKeyboardLayoutList.Create; + KeyboardLayoutList.OnRefresh := UpdateKeybLayouts; + KeyboardLayoutList.Refresh; + CreateAvailableKeyLayoutsList; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(LocalesList); + FreeAndNil(KeyboardLayoutList); +end; + +procedure TMainForm.CreateLocalesList; +var + I: Integer; +begin + FreeAndNil(LocalesList); + case LocalesRadioGroup.ItemIndex of + 0: LocalesList := TJclLocalesList.Create(lkSupported); + 1: LocalesList := TJclLocalesList.Create(lkInstalled); + end; + with LocalesListView do + begin + Items.BeginUpdate; + try + Items.Clear; + for I := 0 to LocalesList.Count - 1 do + with Items.Add, LocalesList[I] do + begin + Caption := EnglishCountryName; + Data := LocalesList[I]; + SubItems.Add(Format('%.4x', [LocaleID])); + SubItems.Add(EnglishLangName); + SubItems.Add(AbbreviatedLangName); + SubItems.Add(Format('%d', [CodePageANSI])); + UseSystemACP := False; + SubItems.Add(MonetarySymbolLocal); + UseSystemACP := True; + SubItems.Add(MonetarySymbolIntl); + SubItems.Add(Format('%d', [CountryCode])); + end; + AlphaSort; + Selected := Items[0]; + Selected.MakeVisible(False); + finally + Items.EndUpdate; + end; + end; +end; + +procedure TMainForm.LocalesRadioGroupClick(Sender: TObject); +begin + CreateLocalesList; +end; + +procedure TMainForm.UpdateView(ListItem: TListItem); +var + I: Integer; +begin + if ListItem = nil then Exit; + with TJclLocaleInfo(ListItem.Data) do + begin + UseSystemACP := False; + with DayNamesListBox do + begin + Items.Clear; + Font.Charset := FontCharset; + for I := Low(TJclLocalesDays) to High(TJclLocalesDays) do + Items.Add(Format('[%d.] %s', [I, LongDayNames[I]])); + end; + with MonthNamesListBox do + begin + Items.Clear; + Font.Charset := FontCharset; + for I := Low(TJclLocalesMonths) to High(TJclLocalesMonths) - 1 do + Items.Add(Format('[%.2d.] %s', [I, LongMonthNames[I]])); + end; + with FormatsListBox do + begin + Font.Charset := FontCharset; + Items.Clear; + Items.Add('Long date formats:'); + Items.AddStrings(DateFormats[ldLong]); + Items.Add(''); + Items.Add('Short date formats:'); + Items.AddStrings(DateFormats[ldShort]); + if IsWin2k then + begin + Items.Add(''); + Items.Add('Year month formats:'); + Items.AddStrings(DateFormats[ldYearMonth]); + end; + Items.Add(''); + Items.Add('Time formats:'); + Items.AddStrings(TimeFormats); + end; + with CalendarsListBox do + begin + Font.Charset := FontCharset; + Items.Assign(Calendars); + end; + UseSystemACP := True; + end; +end; + +procedure TMainForm.LocalesListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); +begin + if Selected then UpdateView(Item); +end; + +procedure TMainForm.UpdateKeybLayouts(Sender: TObject); +var + I: Integer; +begin + with KeyblayoutsListBox do + begin + Items.BeginUpdate; + try + Items.Clear; + for I := 0 to KeyboardLayoutList.Count - 1 do + Items.AddObject(Format('[%.8x] %s', [ KeyboardLayoutList[I].Layout, + KeyboardLayoutList[I].DisplayName]), KeyboardLayoutList[I]); + finally + Items.EndUpdate; + end; + end; +end; + +procedure TMainForm.ActivateBtnClick(Sender: TObject); +begin + with KeyblayoutsListBox do + TJclKeyboardLayout(Items.Objects[ItemIndex]).Activate([klActivate]); +end; + +procedure TMainForm.KeyblayoutsListBoxClick(Sender: TObject); +begin + ActivateBtn.Enabled := KeyblayoutsListBox.ItemIndex >= 0; + UnloadBtn.Enabled := ActivateBtn.Enabled; +end; + +procedure TMainForm.LocalesListViewCustomDrawSubItem( + Sender: TCustomListView; Item: TListItem; SubItem: Integer; + State: TCustomDrawState; var DefaultDraw: Boolean); +begin + with Sender.Canvas.Font do + if SubItem = 5 then + Charset := TJclLocaleInfo(Item.Data).FontCharset + else + Charset := DEFAULT_CHARSET; +end; + +procedure TMainForm.CreateAvailableKeyLayoutsList; +var + I: Integer; +begin + with AvailableLayoutsListView do + begin + Items.BeginUpdate; + try + Items.Clear; + for I := 0 to KeyboardLayoutList.AvailableLayoutCount - 1 do + with Items.Add, KeyboardLayoutList.AvailableLayouts[I] do + begin + Caption := Name; + Data := KeyboardLayoutList.AvailableLayouts[I]; + SubItems.Add(IdentifierName); + SubItems.Add(Format('%.4x', [LayoutID])); + SubItems.Add(LayoutFile); + end; + AlphaSort; + finally + Items.EndUpdate; + end; + end; +end; + +procedure TMainForm.AvailableLayoutsListViewChange(Sender: TObject; + Item: TListItem; Change: TItemChange); +begin + LoadBtn.Enabled := AvailableLayoutsListView.Selected <> nil; +end; + +procedure TMainForm.LoadBtnClick(Sender: TObject); +begin + Win32Check(TJclAvailableKeybLayout(AvailableLayoutsListView.Selected.Data).Load([])); +end; + +procedure TMainForm.UnloadBtnClick(Sender: TObject); +begin + with KeyblayoutsListBox do + Win32Check(TJclKeyboardLayout(Items.Objects[ItemIndex]).Unload); +end; + +procedure TMainForm.PrevBtnClick(Sender: TObject); +begin + KeyboardLayoutList.ActivatePrevLayout; +end; + +procedure TMainForm.NextBtnClick(Sender: TObject); +begin + KeyboardLayoutList.ActivateNextLayout; +end; + +procedure TMainForm.AvailableLayoutsListViewCustomDrawItem( + Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; + var DefaultDraw: Boolean); +begin + with Sender do + if not TJclAvailableKeybLayout(Item.Data).LayoutFileExists then + Canvas.Font.Color := clInactiveCaption; +end; + +end. diff --git a/official/1.96/examples/windows/locales/LocalesExample.dof b/official/1.96/examples/windows/locales/LocalesExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/locales/LocalesExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/locales/LocalesExample.dpr b/official/1.96/examples/windows/locales/LocalesExample.dpr new file mode 100644 index 0000000..8894744 --- /dev/null +++ b/official/1.96/examples/windows/locales/LocalesExample.dpr @@ -0,0 +1,13 @@ +program LocalesExample; + +uses + Forms, + LocalesDemoMain in 'LocalesDemoMain.pas' {MainForm}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/locales/LocalesExample.res b/official/1.96/examples/windows/locales/LocalesExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/locales/LocalesExample.res differ diff --git a/official/1.96/examples/windows/mapi/MapiDemoMain.dfm b/official/1.96/examples/windows/mapi/MapiDemoMain.dfm new file mode 100644 index 0000000..436918e --- /dev/null +++ b/official/1.96/examples/windows/mapi/MapiDemoMain.dfm @@ -0,0 +1,257 @@ +object MainForm: TMainForm + Left = 285 + Top = 165 + Width = 700 + Height = 520 + Caption = 'JclMapi (TJclEmail class) example' + Color = clBtnFace + Constraints.MinHeight = 350 + Constraints.MinWidth = 400 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Bevel1: TBevel + Left = 8 + Top = 458 + Width = 89 + Height = 33 + Anchors = [akLeft, akBottom] + end + object Label1: TLabel + Left = 8 + Top = 12 + Width = 16 + Height = 13 + Caption = '&To:' + FocusControl = ToNameEdit + end + object Label2: TLabel + Left = 8 + Top = 36 + Width = 39 + Height = 13 + Caption = '&Subject:' + FocusControl = SubjectEdit + end + object Label3: TLabel + Left = 8 + Top = 80 + Width = 24 + Height = 13 + Caption = '&Body' + FocusControl = BodyEdit + end + object ClientLabel: TLabel + Left = 12 + Top = 459 + Width = 83 + Height = 30 + Alignment = taCenter + Anchors = [akLeft, akBottom] + AutoSize = False + Caption = 'ClientLabel' + Transparent = True + Layout = tlCenter + WordWrap = True + end + object Label4: TLabel + Left = 8 + Top = 60 + Width = 57 + Height = 13 + Caption = 'Attachment:' + end + object Label5: TLabel + Left = 48 + Top = 12 + Width = 28 + Height = 13 + Caption = 'Name' + end + object Label6: TLabel + Left = 203 + Top = 12 + Width = 38 + Height = 13 + Caption = 'Address' + end + object AttachmentPaintBox: TPaintBox + Left = 68 + Top = 60 + Width = 513 + Height = 17 + Anchors = [akLeft, akTop, akRight] + OnPaint = AttachmentPaintBoxPaint + end + object ClientTypeGroupBox: TGroupBox + Left = 8 + Top = 371 + Width = 89 + Height = 84 + Anchors = [akLeft, akBottom] + Caption = '&Client connect' + TabOrder = 4 + object AutomaticRadioBtn: TRadioButton + Left = 8 + Top = 16 + Width = 70 + Height = 17 + Caption = '&Automatic' + Checked = True + TabOrder = 0 + TabStop = True + OnClick = AutomaticRadioBtnClick + end + object MapiRadioBtn: TRadioButton + Left = 8 + Top = 40 + Width = 70 + Height = 17 + Caption = '&MAPI' + TabOrder = 1 + OnClick = AutomaticRadioBtnClick + end + object DirectRadioBtn: TRadioButton + Left = 8 + Top = 64 + Width = 70 + Height = 17 + Caption = '&Direct' + TabOrder = 2 + OnClick = AutomaticRadioBtnClick + end + end + object ClientsListView: TListView + Left = 104 + Top = 374 + Width = 446 + Height = 114 + Anchors = [akLeft, akRight, akBottom] + Columns = < + item + Caption = 'KeyValue' + Width = 80 + end + item + Caption = 'Client' + Width = 80 + end + item + Caption = 'Path' + Width = 240 + end> + ColumnClick = False + HideSelection = False + ReadOnly = True + RowSelect = True + TabOrder = 5 + ViewStyle = vsReport + OnCustomDrawItem = ClientsListViewCustomDrawItem + OnSelectItem = ClientsListViewSelectItem + end + object ToNameEdit: TEdit + Left = 80 + Top = 8 + Width = 113 + Height = 21 + TabOrder = 0 + end + object SubjectEdit: TEdit + Left = 48 + Top = 32 + Width = 533 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 2 + end + object BodyEdit: TRichEdit + Left = 8 + Top = 96 + Width = 680 + Height = 271 + Anchors = [akLeft, akTop, akRight, akBottom] + HideScrollBars = False + PlainText = True + ScrollBars = ssBoth + TabOrder = 3 + end + object SendBtn: TButton + Left = 605 + Top = 8 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = '&Send' + TabOrder = 6 + OnClick = SendBtnClick + end + object AttachmentBtn: TButton + Left = 605 + Top = 40 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = '&Attachment' + TabOrder = 7 + OnClick = AttachmentBtnClick + end + object ToAddressEdit: TEdit + Left = 248 + Top = 8 + Width = 333 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 1 + end + object DialogCheckBox: TCheckBox + Left = 604 + Top = 72 + Width = 81 + Height = 17 + Anchors = [akTop, akRight] + Caption = 'Show &dialog' + Checked = True + State = cbChecked + TabOrder = 8 + end + object ProfilesListView: TListView + Left = 556 + Top = 374 + Width = 132 + Height = 114 + Anchors = [akRight, akBottom] + Columns = < + item + Caption = 'Profile name' + Width = 125 + end> + ColumnClick = False + HideSelection = False + ReadOnly = True + RowSelect = True + TabOrder = 9 + ViewStyle = vsReport + OnCustomDrawItem = ProfilesListViewCustomDrawItem + OnSelectItem = ClientsListViewSelectItem + end + object HtmlCheckBox: TCheckBox + Left = 48 + Top = 79 + Width = 97 + Height = 17 + Caption = 'HTML message' + TabOrder = 10 + end + object OpenDialog1: TOpenDialog + Title = 'Select attachment' + Left = 472 + Top = 104 + end +end diff --git a/official/1.96/examples/windows/mapi/MapiDemoMain.pas b/official/1.96/examples/windows/mapi/MapiDemoMain.pas new file mode 100644 index 0000000..75e4db7 --- /dev/null +++ b/official/1.96/examples/windows/mapi/MapiDemoMain.pas @@ -0,0 +1,207 @@ +unit MapiDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, ComCtrls, StdCtrls, JclMapi; + +type + TMainForm = class(TForm) + ClientTypeGroupBox: TGroupBox; + AutomaticRadioBtn: TRadioButton; + MapiRadioBtn: TRadioButton; + DirectRadioBtn: TRadioButton; + ClientsListView: TListView; + ToNameEdit: TEdit; + Label1: TLabel; + SubjectEdit: TEdit; + Label2: TLabel; + BodyEdit: TRichEdit; + SendBtn: TButton; + Label3: TLabel; + ClientLabel: TLabel; + Bevel1: TBevel; + AttachmentBtn: TButton; + Label4: TLabel; + ToAddressEdit: TEdit; + Label5: TLabel; + Label6: TLabel; + OpenDialog1: TOpenDialog; + DialogCheckBox: TCheckBox; + AttachmentPaintBox: TPaintBox; + ProfilesListView: TListView; + HtmlCheckBox: TCheckBox; + procedure FormCreate(Sender: TObject); + procedure ClientsListViewSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure AutomaticRadioBtnClick(Sender: TObject); + procedure ClientsListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure SendBtnClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure AttachmentBtnClick(Sender: TObject); + procedure AttachmentPaintBoxPaint(Sender: TObject); + procedure ProfilesListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); + private + procedure BuildClientList; + procedure BuildProfilesList; + procedure UpdateClientName; + public + SimpleMapiMail: TJclEmail; + end; + +var + MainForm: TMainForm; + +implementation + +uses + JclFileUtils, JclSysUtils; + +{$R *.DFM} + +procedure TMainForm.BuildClientList; +var + I: Integer; +begin + // Create list of registered mail clients + ClientsListView.Items.BeginUpdate; + try + ClientsListView.Items.Clear; + with SimpleMapiMail do + begin + for I := 0 to ClientCount - 1 do + with ClientsListView.Items.Add do + begin + Caption := Clients[I].RegKeyName; + Data := Pointer(Clients[I].Valid); + SubItems.Add(Clients[I].ClientName); + SubItems.Add(Clients[I].ClientPath); + end; + ClientsListView.Items[SelectedClientIndex].Selected := True; + AutomaticRadioBtn.Enabled := AnyClientInstalled; + MapiRadioBtn.Enabled := SimpleMapiInstalled; + DirectRadioBtn.Enabled := ClientCount > 0; + end; + finally + ClientsListView.Items.EndUpdate; + end; +end; + +procedure TMainForm.BuildProfilesList; +var + I: Integer; +begin + ProfilesListView.Items.BeginUpdate; + try + ProfilesListView.Items.Clear; + with SimpleMapiMail do + for I := 0 to ProfileCount - 1 do + with ProfilesListView.Items.Add do + begin + Caption := Profiles[I]; + Data := Pointer(Caption = DefaultProfileName); + end; + finally + ProfilesListView.Items.EndUpdate; + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + SimpleMapiMail := TJclEmail.Create; + BuildClientList; + BuildProfilesList; + UpdateClientName; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(SimpleMapiMail); +end; + +procedure TMainForm.ClientsListViewSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +begin + if Selected then + begin + SimpleMapiMail.SelectedClientIndex := Item.Index; + UpdateClientName; + end; +end; + +procedure TMainForm.UpdateClientName; +begin + ClientLabel.Caption := SimpleMapiMail.CurrentClientName; +end; + +procedure TMainForm.AutomaticRadioBtnClick(Sender: TObject); +begin + with SimpleMapiMail do + begin + if AutomaticRadioBtn.Checked then + ClientConnectKind := ctAutomatic; + if MapiRadioBtn.Checked then + ClientConnectKind := ctMapi; + if DirectRadioBtn.Checked then + ClientConnectKind := ctDirect; + end; + UpdateClientName; +end; + +procedure TMainForm.ClientsListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if not Boolean(Item.Data) then + Sender.Canvas.Font.Color := clInactiveCaption; +end; + +procedure TMainForm.ProfilesListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if Boolean(Item.Data) then + Sender.Canvas.Font.Style := [fsBold]; +end; + +procedure TMainForm.SendBtnClick(Sender: TObject); +begin + if not DialogCheckBox.Checked then + Application.MessageBox('The message will be inserted to Outgoing folder.', + PChar(Caption), MB_OK or MB_ICONWARNING); + +{ // Simple message creating, using TJclEmail.SimpleSendMail class method + JclSimpleSendMail(ToAddressEdit.Text, ToNameEdit.Text, SubjectEdit.Text, + BodyEdit.Text, OpenDialog1.FileName, DialogCheckBox.Checked);} + + // Creating message using TJclEmail object, it is more flexible, but you have + // to create an instance (SimpleMapiMail variable in this example) of the class + SimpleMapiMail.Clear; + SimpleMapiMail.Recipients.Add(ToAddressEdit.Text, ToNameEdit.Text); + SimpleMapiMail.Subject := SubjectEdit.Text; + SimpleMapiMail.Body := BodyEdit.Text; + SimpleMapiMail.HtmlBody := HtmlCheckBox.Checked; + if OpenDialog1.FileName <> '' then + SimpleMapiMail.Attachments.Add(OpenDialog1.FileName); + SimpleMapiMail.Send(DialogCheckBox.Checked); +end; + +procedure TMainForm.AttachmentBtnClick(Sender: TObject); +begin + with OpenDialog1 do + begin + FileName := ''; + Execute; + AttachmentPaintBox.Invalidate; + end; +end; + +procedure TMainForm.AttachmentPaintBoxPaint(Sender: TObject); +begin + with TPaintBox(Sender) do + Canvas.TextRect(ClientRect, 0, 0, + PathCompactPath(Canvas.Handle, OpenDialog1.FileName, Width, cpCenter)); +end; + +end. diff --git a/official/1.96/examples/windows/mapi/MapiExample.dof b/official/1.96/examples/windows/mapi/MapiExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/mapi/MapiExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/mapi/MapiExample.dpr b/official/1.96/examples/windows/mapi/MapiExample.dpr new file mode 100644 index 0000000..54597ee --- /dev/null +++ b/official/1.96/examples/windows/mapi/MapiExample.dpr @@ -0,0 +1,13 @@ +program MapiExample; + +uses + Forms, + MapiDemoMain in 'MapiDemoMain.pas' {MainForm}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/mapi/MapiExample.res b/official/1.96/examples/windows/mapi/MapiExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/mapi/MapiExample.res differ diff --git a/official/1.96/examples/windows/mapi/ReadMailDemoMain.dfm b/official/1.96/examples/windows/mapi/ReadMailDemoMain.dfm new file mode 100644 index 0000000..c56ee2a --- /dev/null +++ b/official/1.96/examples/windows/mapi/ReadMailDemoMain.dfm @@ -0,0 +1,91 @@ +object Form1: TForm1 + Left = 192 + Top = 107 + Width = 783 + Height = 540 + Caption = 'JclMapi messages reading example' + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 300 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 0 + Top = 177 + Width = 775 + Height = 3 + Cursor = crVSplit + Align = alTop + ResizeStyle = rsUpdate + end + object HeadersListView: TListView + Left = 0 + Top = 0 + Width = 775 + Height = 177 + Align = alTop + Columns = < + item + Caption = 'From' + Width = 180 + end + item + Caption = 'Subject' + Width = 300 + end + item + Caption = 'Received' + Width = 130 + end + item + Caption = 'MsgID' + Width = 60 + end> + ColumnClick = False + ReadOnly = True + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + OnCustomDrawItem = HeadersListViewCustomDrawItem + OnSelectItem = HeadersListViewSelectItem + end + object PreviewRichEdit: TRichEdit + Left = 0 + Top = 180 + Width = 775 + Height = 292 + Align = alClient + Font.Charset = EASTEUROPE_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Courier New' + Font.Style = [] + Lines.Strings = ( + 'PreviewRichEdit') + ParentFont = False + PlainText = True + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 1 + WordWrap = False + end + object AttachmentsListBox: TListBox + Left = 0 + Top = 472 + Width = 775 + Height = 41 + Align = alBottom + Color = clBtnFace + ItemHeight = 13 + TabOrder = 2 + Visible = False + end +end diff --git a/official/1.96/examples/windows/mapi/ReadMailDemoMain.pas b/official/1.96/examples/windows/mapi/ReadMailDemoMain.pas new file mode 100644 index 0000000..b511838 --- /dev/null +++ b/official/1.96/examples/windows/mapi/ReadMailDemoMain.pas @@ -0,0 +1,124 @@ +unit ReadMailDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, StdCtrls, ComCtrls, JclMapi; + +type + TForm1 = class(TForm) + HeadersListView: TListView; + PreviewRichEdit: TRichEdit; + Splitter1: TSplitter; + AttachmentsListBox: TListBox; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure HeadersListViewSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure HeadersListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); + private + Email: TJclEmail; + public + procedure PrevievMessage(const SeedMessageID: string); + procedure ReadHeaders; + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +uses + Mapi, // MAPI_UNREAD constant + JclSysUtils; + +procedure TForm1.FormCreate(Sender: TObject); +begin + Email := TJclEmail.Create; + ReadHeaders; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + FreeAndNil(Email); +end; + +procedure TForm1.PrevievMessage(const SeedMessageID: string); +var + HeaderLinesCount: Integer; +begin + with PreviewRichEdit do + begin + Lines.BeginUpdate; + try + Lines.Clear; + // Set SeedMessageID before reading + Email.SeedMessageID := SeedMessageID; + Email.Read; + HeaderLinesCount := Email.MessageReport(Lines); + // Message header part highlighting + SelStart := 0; + SelLength := SendMessage(Handle, EM_LINEINDEX, HeaderLinesCount, 0); + SelAttributes.Style := [fsBold]; + SelLength := 0; + SelStart := 0; + finally + Lines.EndUpdate; + end; + end; + AttachmentsListBox.Items.Assign(Email.Attachments); + AttachmentsListBox.Visible := AttachmentsListBox.Items.Count > 0; +end; + +procedure TForm1.ReadHeaders; +var + NextMessage: Boolean; +begin + // You have to be logged on before reading messages. LogOff is automatically + // called in TJclEmail destructor. + Email.LogOn; + + // SimpleMAPI is limited to read messages from InBox root folder only + HeadersListView.Items.BeginUpdate; + Screen.Cursor := crHourGlass; + try + HeadersListView.Items.Clear; + NextMessage := Email.FindFirstMessage; + while NextMessage do + begin + Email.Read([roHeaderOnly]); + with HeadersListView.Items.Add do + begin + Caption := Email.Recipients.Originator.Name; + SubItems.Add(Email.Subject); + SubItems.Add(DateTimeToStr(Email.ReadMsg.DateReceived)); + SubItems.Add(Email.SeedMessageID); + Data := Pointer(Email.ReadMsg.Flags); // store Flags for custom draw + end; + NextMessage := Email.FindNextMessage; + end; + finally + HeadersListView.Items.EndUpdate; + Screen.Cursor := crDefault; + end; +end; + +procedure TForm1.HeadersListViewSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +begin + if Selected then + PrevievMessage(Item.SubItems[2]); +end; + +procedure TForm1.HeadersListViewCustomDrawItem(Sender: TCustomListView; + Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); +begin + if DWORD(Item.Data) and MAPI_UNREAD <> 0 then + Sender.Canvas.Font.Style := [fsBold]; +end; + +end. diff --git a/official/1.96/examples/windows/mapi/ReadMailExample.dof b/official/1.96/examples/windows/mapi/ReadMailExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/mapi/ReadMailExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/mapi/ReadMailExample.dpr b/official/1.96/examples/windows/mapi/ReadMailExample.dpr new file mode 100644 index 0000000..a8676c3 --- /dev/null +++ b/official/1.96/examples/windows/mapi/ReadMailExample.dpr @@ -0,0 +1,13 @@ +program ReadMailExample; + +uses + Forms, + ReadMailDemoMain in 'ReadMailDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/mapi/ReadMailExample.res b/official/1.96/examples/windows/mapi/ReadMailExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/mapi/ReadMailExample.res differ diff --git a/official/1.96/examples/windows/multimedia/MultiMediaExample.dof b/official/1.96/examples/windows/multimedia/MultiMediaExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/multimedia/MultiMediaExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/multimedia/MultiMediaExample.dpr b/official/1.96/examples/windows/multimedia/MultiMediaExample.dpr new file mode 100644 index 0000000..e836910 --- /dev/null +++ b/official/1.96/examples/windows/multimedia/MultiMediaExample.dpr @@ -0,0 +1,13 @@ +program MultiMediaExample; + +uses + Forms, + MultimediaDemoMain in 'MultimediaDemoMain.pas' {MainForm}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/multimedia/MultiMediaExample.res b/official/1.96/examples/windows/multimedia/MultiMediaExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/multimedia/MultiMediaExample.res differ diff --git a/official/1.96/examples/windows/multimedia/MultimediaDemoMain.dfm b/official/1.96/examples/windows/multimedia/MultimediaDemoMain.dfm new file mode 100644 index 0000000..052f5f7 --- /dev/null +++ b/official/1.96/examples/windows/multimedia/MultimediaDemoMain.dfm @@ -0,0 +1,215 @@ +object MainForm: TMainForm + Left = 313 + Top = 238 + Width = 677 + Height = 567 + Caption = 'Multimedia example' + Color = clBtnFace + Constraints.MinHeight = 515 + Constraints.MinWidth = 562 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poDefaultPosOnly + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object PageControl: TPageControl + Left = 0 + Top = 0 + Width = 669 + Height = 540 + ActivePage = TabSheet1 + Align = alClient + TabOrder = 0 + object TabSheet1: TTabSheet + Caption = 'CD audio' + object Label2: TLabel + Left = 8 + Top = 80 + Width = 48 + Height = 13 + Caption = '&Track info' + FocusControl = AudioInfoMemo + end + object OpenDriveBtn: TButton + Left = 208 + Top = 48 + Width = 75 + Height = 25 + Caption = '&Open drive' + TabOrder = 0 + OnClick = OpenDriveBtnClick + end + object CloseDriveBtn: TButton + Left = 288 + Top = 48 + Width = 75 + Height = 25 + Caption = '&Close drive' + TabOrder = 1 + OnClick = CloseDriveBtnClick + end + object MediaPresentBtn: TButton + Left = 384 + Top = 48 + Width = 75 + Height = 25 + Caption = '&Media ?' + TabOrder = 2 + OnClick = MediaPresentBtnClick + end + object AudioInfoBtn: TButton + Left = 464 + Top = 48 + Width = 75 + Height = 25 + Caption = 'CD &Audio info' + TabOrder = 3 + OnClick = AudioInfoBtnClick + end + object AudioInfoMemo: TMemo + Left = 8 + Top = 96 + Width = 647 + Height = 407 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 4 + end + object GroupBox1: TGroupBox + Left = 8 + Top = 8 + Width = 185 + Height = 65 + Caption = 'Drive Select' + TabOrder = 5 + object Label1: TLabel + Left = 8 + Top = 16 + Width = 28 + Height = 13 + Caption = 'Drive:' + FocusControl = DriveComboBox + end + object DriveComboBox: TComboBox + Left = 8 + Top = 32 + Width = 81 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + TabOrder = 0 + end + object DefaultDriveCheckBox: TCheckBox + Left = 96 + Top = 32 + Width = 81 + Height = 17 + Caption = '&Default drive' + TabOrder = 1 + OnClick = DefaultDriveCheckBoxClick + end + end + end + object TabSheet2: TTabSheet + Caption = 'Audio mixer' + ImageIndex = 1 + object Label3: TLabel + Left = 8 + Top = 8 + Width = 46 + Height = 13 + Caption = '&Mixer tree' + FocusControl = MixerTreeView + end + object Label4: TLabel + Left = 272 + Top = 8 + Width = 32 + Height = 13 + Caption = '&Details' + FocusControl = MixerDetailListView + end + object MixerTreeView: TTreeView + Left = 8 + Top = 24 + Width = 257 + Height = 481 + Anchors = [akLeft, akTop, akBottom] + HideSelection = False + Indent = 19 + ReadOnly = True + TabOrder = 0 + OnChange = MixerTreeViewChange + OnCustomDrawItem = MixerTreeViewCustomDrawItem + end + object MixerDetailListView: TListView + Left = 272 + Top = 24 + Width = 377 + Height = 409 + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = < + item + Caption = 'Item' + Width = 100 + end + item + Caption = 'Value' + Width = 270 + end> + ColumnClick = False + GridLines = True + ReadOnly = True + RowSelect = True + TabOrder = 1 + ViewStyle = vsReport + end + object GroupBox2: TGroupBox + Left = 272 + Top = 440 + Width = 378 + Height = 65 + Anchors = [akLeft, akRight, akBottom] + TabOrder = 2 + object SpeakersMuteCheckBox: TCheckBox + Left = 8 + Top = 24 + Width = 97 + Height = 17 + Caption = 'Speakers Mute' + TabOrder = 0 + OnClick = SpeakersMuteCheckBoxClick + end + object SaveMixerBtn: TButton + Left = 120 + Top = 20 + Width = 75 + Height = 25 + Caption = 'Save to File...' + TabOrder = 1 + OnClick = SaveMixerBtnClick + end + end + end + end + object SaveDialog: TSaveDialog + DefaultExt = 'txt' + Filter = 'Text files (*.txt)|*.txt' + Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing] + Left = 20 + Top = 488 + end +end diff --git a/official/1.96/examples/windows/multimedia/MultimediaDemoMain.pas b/official/1.96/examples/windows/multimedia/MultimediaDemoMain.pas new file mode 100644 index 0000000..c6a01f7 --- /dev/null +++ b/official/1.96/examples/windows/multimedia/MultimediaDemoMain.pas @@ -0,0 +1,555 @@ +unit MultimediaDemoMain; + +interface + +{$I jcl.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls, MMSystem, JclMultimedia; + +type + TMainForm = class(TForm) + PageControl: TPageControl; + TabSheet1: TTabSheet; + Label2: TLabel; + OpenDriveBtn: TButton; + CloseDriveBtn: TButton; + MediaPresentBtn: TButton; + AudioInfoBtn: TButton; + AudioInfoMemo: TMemo; + GroupBox1: TGroupBox; + Label1: TLabel; + DriveComboBox: TComboBox; + DefaultDriveCheckBox: TCheckBox; + TabSheet2: TTabSheet; + MixerTreeView: TTreeView; + Label3: TLabel; + MixerDetailListView: TListView; + Label4: TLabel; + GroupBox2: TGroupBox; + SpeakersMuteCheckBox: TCheckBox; + SaveMixerBtn: TButton; + SaveDialog: TSaveDialog; + procedure FormCreate(Sender: TObject); + procedure OpenDriveBtnClick(Sender: TObject); + procedure CloseDriveBtnClick(Sender: TObject); + procedure MediaPresentBtnClick(Sender: TObject); + procedure AudioInfoBtnClick(Sender: TObject); + procedure DefaultDriveCheckBoxClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure MixerTreeViewCustomDrawItem(Sender: TCustomTreeView; + Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); + procedure MixerTreeViewChange(Sender: TObject; Node: TTreeNode); + procedure SpeakersMuteCheckBoxClick(Sender: TObject); + procedure SaveMixerBtnClick(Sender: TObject); + private + FComponentTypes: TStringList; + FControlTypes: TStringList; + FMixer: TJclMixer; + procedure BuildDrives; + procedure BuildMixerTree; + procedure BuildTypesList; + function GetSelectedDrive: Char; + procedure SaveMixerToFile(const FileName: string); + procedure UpdateMixerDetails(MixerObject: TObject); + procedure UpdateMixerControl(MixerHandle: HMIXER; ControlID: DWORD); + procedure UpdateMixerLine(MixerHandle: HMIXER; LineID: DWORD); + procedure UpdateSelectedMixerInfo; + procedure UpdateMixerSpeakerControls; + procedure WMMmMixmControlChange(var Message: TMessage); message MM_MIXM_CONTROL_CHANGE; + procedure WMMmMixmLineChange(var Message: TMessage); message MM_MIXM_LINE_CHANGE; + function GetSelectedMixerTreeObject: TObject; + public + function ComponentTypeConstToString(ComponentType: DWORD): string; + function ControlTypeConstToString(ControlType: DWORD): string; + property SelectedDrive: Char read GetSelectedDrive; + property SelectedMixerTreeObject: TObject read GetSelectedMixerTreeObject; + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.DFM} + +uses + JclFileUtils, JclStrings, JclSysUtils; + +{ TMainForm } + +procedure TMainForm.FormCreate(Sender: TObject); +begin + FComponentTypes := TStringList.Create; + FControlTypes := TStringList.Create; + BuildTypesList; + FMixer := TJclMixer.Create(Handle); + BuildDrives; + BuildMixerTree; + UpdateMixerSpeakerControls; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FComponentTypes); + FreeAndNil(FControlTypes); + FreeAndNil(FMixer); +end; + +procedure TMainForm.BuildTypesList; +begin + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_DST_UNDEFINED', Pointer(MIXERLINE_COMPONENTTYPE_DST_UNDEFINED)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_DST_DIGITAL', Pointer(MIXERLINE_COMPONENTTYPE_DST_DIGITAL)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_DST_LINE', Pointer(MIXERLINE_COMPONENTTYPE_DST_LINE)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_DST_MONITOR', Pointer(MIXERLINE_COMPONENTTYPE_DST_MONITOR)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_DST_SPEAKERS', Pointer(MIXERLINE_COMPONENTTYPE_DST_SPEAKERS)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_DST_HEADPHONES', Pointer(MIXERLINE_COMPONENTTYPE_DST_HEADPHONES)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_DST_TELEPHONE', Pointer(MIXERLINE_COMPONENTTYPE_DST_TELEPHONE)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_DST_WAVEIN', Pointer(MIXERLINE_COMPONENTTYPE_DST_WAVEIN)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_DST_VOICEIN', Pointer(MIXERLINE_COMPONENTTYPE_DST_VOICEIN)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_UNDEFINED', Pointer(MIXERLINE_COMPONENTTYPE_SRC_UNDEFINED)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_DIGITAL', Pointer(MIXERLINE_COMPONENTTYPE_SRC_DIGITAL)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_LINE', Pointer(MIXERLINE_COMPONENTTYPE_SRC_LINE)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE', Pointer(MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER', Pointer(MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC', Pointer(MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE', Pointer(MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_PCSPEAKER', Pointer(MIXERLINE_COMPONENTTYPE_SRC_PCSPEAKER)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT', Pointer(MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY', Pointer(MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY)); + FComponentTypes.AddObject('MIXERLINE_COMPONENTTYPE_SRC_ANALOG', Pointer(MIXERLINE_COMPONENTTYPE_SRC_ANALOG)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_CUSTOM', Pointer(MIXERCONTROL_CONTROLTYPE_CUSTOM)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_BOOLEANMETER', Pointer(MIXERCONTROL_CONTROLTYPE_BOOLEANMETER)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_SIGNEDMETER', Pointer(MIXERCONTROL_CONTROLTYPE_SIGNEDMETER)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_PEAKMETER', Pointer(MIXERCONTROL_CONTROLTYPE_PEAKMETER)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_UNSIGNEDMETER', Pointer(MIXERCONTROL_CONTROLTYPE_UNSIGNEDMETER)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_BOOLEAN', Pointer(MIXERCONTROL_CONTROLTYPE_BOOLEAN)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_ONOFF', Pointer(MIXERCONTROL_CONTROLTYPE_ONOFF)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_MUTE', Pointer(MIXERCONTROL_CONTROLTYPE_MUTE)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_MONO', Pointer(MIXERCONTROL_CONTROLTYPE_MONO)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_LOUDNESS', Pointer(MIXERCONTROL_CONTROLTYPE_LOUDNESS)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_STEREOENH', Pointer(MIXERCONTROL_CONTROLTYPE_STEREOENH)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_BUTTON', Pointer(MIXERCONTROL_CONTROLTYPE_BUTTON)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_DECIBELS', Pointer(MIXERCONTROL_CONTROLTYPE_DECIBELS)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_SIGNED', Pointer(MIXERCONTROL_CONTROLTYPE_SIGNED)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_UNSIGNED', Pointer(MIXERCONTROL_CONTROLTYPE_UNSIGNED)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_PERCENT', Pointer(MIXERCONTROL_CONTROLTYPE_PERCENT)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_SLIDER', Pointer(MIXERCONTROL_CONTROLTYPE_SLIDER)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_PAN', Pointer(MIXERCONTROL_CONTROLTYPE_PAN)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_QSOUNDPAN', Pointer(MIXERCONTROL_CONTROLTYPE_QSOUNDPAN)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_FADER', Pointer(MIXERCONTROL_CONTROLTYPE_FADER)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_VOLUME', Pointer(MIXERCONTROL_CONTROLTYPE_VOLUME)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_BASS', Pointer(MIXERCONTROL_CONTROLTYPE_BASS)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_TREBLE', Pointer(MIXERCONTROL_CONTROLTYPE_TREBLE)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_EQUALIZER', Pointer(MIXERCONTROL_CONTROLTYPE_EQUALIZER)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_SINGLESELECT', Pointer(MIXERCONTROL_CONTROLTYPE_SINGLESELECT)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_MUX', Pointer(MIXERCONTROL_CONTROLTYPE_MUX)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_MULTIPLESELECT', Pointer(MIXERCONTROL_CONTROLTYPE_MULTIPLESELECT)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_MIXER', Pointer(MIXERCONTROL_CONTROLTYPE_MIXER)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_MICROTIME', Pointer(MIXERCONTROL_CONTROLTYPE_MICROTIME)); + FControlTypes.AddObject('MIXERCONTROL_CONTROLTYPE_MILLITIME', Pointer(MIXERCONTROL_CONTROLTYPE_MILLITIME)); +end; + +function TMainForm.ComponentTypeConstToString(ComponentType: DWORD): string; +var + I: Integer; +begin + Result := ''; + for I := 0 to FComponentTypes.Count - 1 do + if DWORD(FComponentTypes.Objects[I]) = ComponentType then + begin + Result := FComponentTypes[I]; + Break; + end; +end; + +function TMainForm.ControlTypeConstToString(ControlType: DWORD): string; +var + I: Integer; +begin + Result := ''; + for I := 0 to FControlTypes.Count - 1 do + if DWORD(FControlTypes.Objects[I]) = ControlType then + begin + Result := FControlTypes[I]; + Break; + end; +end; + +//================================================================================================== +// CD audio +//================================================================================================== + +procedure TMainForm.BuildDrives; +var + D: Char; + DriveStr: string; +begin + for D := 'A' to 'Z' do + begin + DriveStr := D + ':\'; + if GetDriveType(PChar(DriveStr)) = DRIVE_CDROM then + DriveComboBox.Items.Add(D); + end; + if DriveComboBox.Items.Count > 0 then + DriveComboBox.ItemIndex := 0; +end; + +procedure TMainForm.DefaultDriveCheckBoxClick(Sender: TObject); +begin + DriveComboBox.Enabled := not DefaultDriveCheckBox.Checked; +end; + +function TMainForm.GetSelectedDrive: Char; +begin + if DefaultDriveCheckBox.Checked then + Result := #0 + else + Result := DriveComboBox.Text[1]; +end; + +procedure TMainForm.OpenDriveBtnClick(Sender: TObject); +begin + Screen.Cursor := crHourGlass; + try + OpenCloseCdDrive(True, SelectedDrive); + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.CloseDriveBtnClick(Sender: TObject); +begin + Screen.Cursor := crHourGlass; + try + OpenCloseCdDrive(False, SelectedDrive); + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.MediaPresentBtnClick(Sender: TObject); +begin + Screen.Cursor := crHourGlass; + try + ShowMessage(BooleanToStr(IsMediaPresentInDrive(SelectedDrive))); + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.AudioInfoBtnClick(Sender: TObject); +var + TotalTimeStr: string; +begin + Screen.Cursor := crHourGlass; + AudioInfoMemo.Lines.BeginUpdate; + try + AudioInfoMemo.Lines.Add('Product : ' + GetCdInfo(miProduct, SelectedDrive)); + AudioInfoMemo.Lines.Add('Identity : ' + GetCdInfo(miIdentity, SelectedDrive)); + AudioInfoMemo.Lines.Add('Universal Product Code : ' + GetCdInfo(miUPC, SelectedDrive)); + TotalTimeStr := GetCDAudioTrackList(AudioInfoMemo.Lines, True, SelectedDrive); + AudioInfoMemo.Lines.Add('Total time: ' + TotalTimeStr); + finally + AudioInfoMemo.Lines.EndUpdate; + Screen.Cursor := crDefault; + end; + AudioInfoMemo.Lines.Add(''); +end; + +//================================================================================================== +// Audio mixer +//================================================================================================== + +procedure TMainForm.BuildMixerTree; +var + DeviceIndex, DestionationIndex, SourceIndex, LineControlIndex: Integer; + DeviceNode, DestionationNode, SourceNode: TTreeNode; + Device: TJclMixerDevice; + Destination: TJclMixerDestination; + SourceLine: TJclMixerSource; + LineControl: TJclMixerLineControl; +begin + with MixerTreeView do + begin + Items.BeginUpdate; + Screen.Cursor := crHourGlass; + try + Items.Clear; + for DeviceIndex := 0 to FMixer.DeviceCount - 1 do + begin + Device := FMixer.Devices[DeviceIndex]; + DeviceNode := Items.AddChildObjectFirst(nil, Device.ProductName, Device); + + for DestionationIndex := 0 to Device.DestinationCount - 1 do + begin + Destination := Device.Destinations[DestionationIndex]; + DestionationNode := Items.AddChildObjectFirst(DeviceNode, Destination.Name, Destination); + + for LineControlIndex := 0 to Destination.LineControlCount - 1 do + begin + LineControl := Destination.LineControls[LineControlIndex]; + Items.AddChildObjectFirst(DestionationNode, LineControl.Name, LineControl); + end; + + for SourceIndex := 0 to Destination.SourceCount - 1 do + begin + SourceLine := Destination.Sources[SourceIndex]; + SourceNode := Items.AddChildObjectFirst(DestionationNode, SourceLine.Name, SourceLine); + + for LineControlIndex := 0 to SourceLine.LineControlCount - 1 do + begin + LineControl := SourceLine.LineControls[LineControlIndex]; + Items.AddChildObjectFirst(SourceNode, LineControl.Name, LineControl); + end; + + end; + end; + end; + FullExpand; + if Items.Count > 0 then + begin + Selected := Items.GetFirstNode; + Selected.MakeVisible; + end; + finally + Items.EndUpdate; + Screen.Cursor := crDefault; + end; + end; +end; + +function TMainForm.GetSelectedMixerTreeObject: TObject; +begin + if MixerTreeView.Selected <> nil then + Result := TObject(MixerTreeView.Selected.Data) + else + Result := nil; +end; + +procedure TMainForm.SaveMixerToFile(const FileName: string); +var + List: TStringList; + I, D: Integer; + Node: TTreeNode; + C: Char; +begin + List := TStringList.Create; + MixerDetailListView.Items.BeginUpdate; + try + for I := 0 to MixerTreeView.Items.Count - 1 do + begin + Node := MixerTreeView.Items[I]; + UpdateMixerDetails(TObject(Node.Data)); + case Node.Level of + 0: C := ' '; + 1: C := '='; + 2: C := '+'; + 3: C := '-'; + else + C := '!'; + end; + List.Add(Format('%*s%s %s', [Node.Level * 2, '', Node.Text, StringOfChar(C, 119 - Node.Level * 2 - Length(Node.Text))])); + with MixerDetailListView.Items do + for D := 0 to Count - 1 do + begin + List.Add(Format('%*s%s=%s', [Node.Level * 2, '', Item[D].Caption, Item[D].SubItems[0]])); + end; + List.Add(''); + end; + List.SaveToFile(FileName); + Node := MixerTreeView.Selected; + if Assigned(Node) then + UpdateMixerDetails(TObject(Node.Data)) + else + UpdateMixerDetails(nil); + finally + MixerDetailListView.Items.EndUpdate; + List.Free; + end; +end; + +procedure TMainForm.UpdateMixerDetails(MixerObject: TObject); + + procedure AddLine(const ItemName, Value: string); + begin + with MixerDetailListView.Items.Add do + begin + Caption := ItemName; + SubItems.Add(Value); + end; + end; + + procedure BuildMixerDeviceDetails(Device: TJclMixerDevice); + begin + with Device do + begin + AddLine('Handle', IntToHex(Handle, 8)); + AddLine('Mid', IntToHex(Capabilities.wMid, 4)); + AddLine('Pid', IntToHex(Capabilities.wPid, 4)); + with WordRec(LongRec(Capabilities.vDriverVersion).Lo) do + AddLine('Driver version', FormatVersionString(Hi, Lo)); + AddLine('Support', IntToHex(Capabilities.fdwSupport, 8)); + end; + end; + + procedure BuildMixerLineDetails(Line: TJclMixerLine); + var + DisplayName: string; + begin + with Line do + begin + DisplayName := ComponentString; + if DisplayName = '' then + DisplayName := Format('(%.8x)', [LineInfo.dwComponentType]); + AddLine('Component type', Format('%s [%s]', [DisplayName, ComponentTypeConstToString(LineInfo.dwComponentType)])); + AddLine('ID', IntToHex(ID, 8)); + AddLine('Channels', IntToStr(LineInfo.cChannels)); + AddLine('Connections', IntToStr(LineInfo.cConnections)); + AddLine('Target name', LineInfo.Target.szPname); + end; + end; + + procedure BuildMixerDestinationDetails(Destination: TJclMixerDestination); + begin + BuildMixerLineDetails(Destination); + end; + + procedure BuildMixerSourceDetails(Source: TJclMixerSource); + begin + BuildMixerLineDetails(Source); + end; + + procedure BuildMixerLineControlDetails(LineControl: TJclMixerLineControl); + begin + with LineControl do + begin + AddLine('ID', IntToHex(ControlInfo.dwControlID, 8)); + AddLine('Control type', Format('%.8x [%s]', [ControlInfo.dwControlType, ControlTypeConstToString(ControlInfo.dwControlType)])); + AddLine('Disabled', BooleanToStr(IsDisabled)); + AddLine('List', BooleanToStr(IsList)); + AddLine('Multiple', BooleanToStr(IsMultiple)); + AddLine('Uniform', BooleanToStr(IsUniform)); + AddLine('Multiple items', IntToHex(ControlInfo.cMultipleItems, 8)); + if not IsMultiple then + AddLine('Uniform value', IntToHex(UniformValue, 8)); + AddLine('Minimum', IntToHex(ControlInfo.Bounds.lMinimum, 8)); + AddLine('Maximum', IntToHex(ControlInfo.Bounds.lMaximum, 8)); + AddLine('Steps', IntToHex(ControlInfo.Metrics.cSteps, 8)); + AddLine('Value', ValueString); + AddLine('List text', ListText.CommaText); + end; + end; + +begin + with MixerDetailListView do + begin + Items.BeginUpdate; + try + Items.Clear; + if MixerObject is TJclMixerDevice then + BuildMixerDeviceDetails(TJclMixerDevice(MixerObject)) + else + if MixerObject is TJclMixerDestination then + BuildMixerDestinationDetails(TJclMixerDestination(MixerObject)) + else + if MixerObject is TJclMixerSource then + BuildMixerSourceDetails(TJclMixerSource(MixerObject)) + else + if MixerObject is TJclMixerLineControl then + BuildMixerLineControlDetails(TJclMixerLineControl(MixerObject)); + finally + Items.EndUpdate; + end; + end; +end; + +procedure TMainForm.UpdateMixerControl(MixerHandle: HMIXER; ControlID: DWORD); +var + Control: TJclMixerLineControl; +begin + Control := FMixer.LineControlByID[MixerHandle, ControlID]; + if Control <> nil then + begin + if Control = SelectedMixerTreeObject then + UpdateSelectedMixerInfo; + end; +end; + +procedure TMainForm.UpdateMixerLine(MixerHandle: HMIXER; LineID: DWORD); +var + Line: TJclMixerLine; +begin + Line := FMixer.LineByID[MixerHandle, LineID]; + if Line <> nil then + begin + if Line = SelectedMixerTreeObject then + UpdateSelectedMixerInfo; + if Line.LineInfo.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS then + UpdateMixerSpeakerControls; + end; +end; + +procedure TMainForm.UpdateSelectedMixerInfo; +begin + UpdateMixerDetails(SelectedMixerTreeObject); +end; + +procedure TMainForm.UpdateMixerSpeakerControls; +begin + SpeakersMuteCheckBox.Checked := FMixer.SpeakersMute; +end; + +procedure TMainForm.MixerTreeViewCustomDrawItem(Sender: TCustomTreeView; + Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); +var + NodeObject: TObject; +begin + NodeObject := TObject(Node.Data); + if NodeObject is TJclMixerDevice then + Sender.Canvas.Font.Style := [fsBold] + else + if NodeObject is TJclMixerDestination then + begin + Sender.Canvas.Font.Style := [fsBold]; + if not (cdsFocused in State) then + Sender.Canvas.Font.Color := clRed; + end + else + if NodeObject is TJclMixerSource then + begin + Sender.Canvas.Font.Style := [fsBold]; + if not (cdsFocused in State) then + Sender.Canvas.Font.Color := clBlue; + end; +end; + +procedure TMainForm.MixerTreeViewChange(Sender: TObject; Node: TTreeNode); +begin + UpdateMixerDetails(TObject(Node.Data)); +end; + +procedure TMainForm.SpeakersMuteCheckBoxClick(Sender: TObject); +begin + FMixer.SpeakersMute := SpeakersMuteCheckBox.Checked; +end; + +procedure TMainForm.SaveMixerBtnClick(Sender: TObject); +begin + SaveDialog.FileName := 'Mixer.txt'; + if SaveDialog.Execute then + SaveMixerToFile(SaveDialog.FileName); +end; + +procedure TMainForm.WMMmMixmControlChange(var Message: TMessage); +begin + UpdateMixerControl(Message.WParam, Message.LParam); +end; + +procedure TMainForm.WMMmMixmLineChange(var Message: TMessage); +begin + UpdateMixerLine(Message.WParam, Message.LParam); +end; + +end. diff --git a/official/1.96/examples/windows/ntfs/JEDISoftLinks.dof b/official/1.96/examples/windows/ntfs/JEDISoftLinks.dof new file mode 100644 index 0000000..a357c00 --- /dev/null +++ b/official/1.96/examples/windows/ntfs/JEDISoftLinks.dof @@ -0,0 +1,4 @@ +[Directories] +OutputDir=..\..\..\bin +[Parameters] +RunParams=/UNREGSERVER diff --git a/official/1.96/examples/windows/ntfs/JEDISoftLinks.dpr b/official/1.96/examples/windows/ntfs/JEDISoftLinks.dpr new file mode 100644 index 0000000..b7b53c3 --- /dev/null +++ b/official/1.96/examples/windows/ntfs/JEDISoftLinks.dpr @@ -0,0 +1,16 @@ +{$R JEDISoftLinks.TLB} + +library JEDISoftLinks; + +uses + ComServ, + SoftLinkDragDropHandler in 'SoftLinkDragDropHandler.pas'; + +exports + DllGetClassObject, + DllCanUnloadNow, + DllRegisterServer, + DllUnregisterServer; + +begin +end. diff --git a/official/1.96/examples/windows/ntfs/JEDISoftLinks.tlb b/official/1.96/examples/windows/ntfs/JEDISoftLinks.tlb new file mode 100644 index 0000000..f5ea296 Binary files /dev/null and b/official/1.96/examples/windows/ntfs/JEDISoftLinks.tlb differ diff --git a/official/1.96/examples/windows/ntfs/JEDISoftLinks_TLB.pas b/official/1.96/examples/windows/ntfs/JEDISoftLinks_TLB.pas new file mode 100644 index 0000000..619f171 --- /dev/null +++ b/official/1.96/examples/windows/ntfs/JEDISoftLinks_TLB.pas @@ -0,0 +1,49 @@ +unit JEDISoftLinks_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: 1.1 $ +// File generated on 07.12.2004 00:56:32 from Type Library described below. + +// ************************************************************************ // +// Type Lib: I:\Quellen\jedi\jcl\examples\windows\ntfs\JEDISoftLinks.tlb (1) +// IID\LCID: {7E0F7014-DB2F-47E1-881D-8A3FBFECB518}\0 +// Helpfile: +// DepndLst: +// (1) v2.0 stdole, (F:\WINNT\system32\stdole2.tlb) +// (2) v4.0 StdVCL, (F:\WINNT\system32\STDVCL40.DLL) +// ************************************************************************ // +{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. +interface + +uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL; + +// *********************************************************************// +// 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 + JEDISoftLinksMajorVersion = 1; + JEDISoftLinksMinorVersion = 0; + + LIBID_JEDISoftLinks: TGUID = '{7E0F7014-DB2F-47E1-881D-8A3FBFECB518}'; + + +implementation + +uses ComObj; + +end. diff --git a/official/1.96/examples/windows/ntfs/SoftLinkDragDropHandler.pas b/official/1.96/examples/windows/ntfs/SoftLinkDragDropHandler.pas new file mode 100644 index 0000000..7064a6f --- /dev/null +++ b/official/1.96/examples/windows/ntfs/SoftLinkDragDropHandler.pas @@ -0,0 +1,228 @@ +// +// Robert Rossmair, 2001, 2004 +// +// Adds "create junction here" entry to explorer context menu, when a directory +// is dragged & dropped onto a NTFS volume. When selected, it creates a NTFS +// junction to the source directory, instead of copying it to the new location. +// +// The name of the junction is prefixed with a "~" to mark it as different from +// a normal directory, since dumb ol' Explorer doesn't know nothing about NTFS +// junctions. +// +// This unit is based on $(DELPHI)\Demos\ActiveX\ShellExt\ContextM +// +unit SoftLinkDragDropHandler; + +interface + +uses + Windows, ActiveX, ComObj, ShlObj, + JclBase, JclStrings, JclFileUtils, JclShell, JclNTFS; + +type + TDirDropContextMenu = class(TComObject, IShellExtInit, IContextMenu) + private + FLinkTarget: string; + FLinkPath: string; + FIsRootDirectory: Boolean; + protected + { IShellExtInit } + function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning + function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; + hKeyProgID: HKEY): HResult; stdcall; + { IContextMenu } + function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, + uFlags: UINT): HResult; stdcall; + function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall; + function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; + pszName: LPSTR; cchMax: UINT): HResult; stdcall; + end; + +const + Class_ContextMenu: TGUID = '{DDE0E099-9901-4507-9A47-3DC66B13AB6B}'; + +implementation + +uses ComServ, SysUtils, ShellApi, Registry; + +resourcestring + SDescription = 'JEDI SoftLinks Shell Extension'; + SRegKeyDir = 'Directory\shellex\DragDropHandlers\JEDISoftLinks'; + SRegKeyDrive = 'Drive\shellex\DragDropHandlers\JEDISoftLinks'; + SMenuItem = 'Create junction here'; + SMenuHelp = 'Create an NTFS junction point'; + +const + Prefix = '~'; + +function OnNtfsVolume(const FileName: string): Boolean; +begin + Result := NtfsReparsePointsSupported(ExtractFileDrive(FileName)); +end; + +function TDirDropContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; + hKeyProgID: HKEY): HResult; +var + FileName: string; + LinkDir: string; + Volume: string; + StgMedium: TStgMedium; + FormatEtc: TFormatEtc; + Count, N: Integer; +begin + FLinkPath := ''; + + if (lpdobj = nil) then + begin + Result := E_INVALIDARG; + Exit; + end; + + with FormatEtc do + begin + cfFormat := CF_HDROP; + ptd := nil; + dwAspect := DVASPECT_CONTENT; + lindex := -1; + tymed := TYMED_HGLOBAL; + end; + + // Render the data referenced by the IDataObject pointer to an HGLOBAL + // storage medium in CF_HDROP format. + Result := lpdobj.GetData(FormatEtc, StgMedium); + if Failed(Result) then + Exit; + + // If only one file is selected, retrieve the file name and store it in + // FLinkTarget. Otherwise fail the call. + Count := DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0); + Result := E_FAIL; + if Count = 1 then + begin + SetLength(FLinkTarget, DragQueryFile(StgMedium.hGlobal, 0, nil, 0) + 1); + DragQueryFile(StgMedium.hGlobal, 0, PChar(FLinkTarget), Length(FLinkTarget)); + if DirectoryExists(FLinkTarget) then + begin + LinkDir := PidlToPath(pidlFolder); + if OnNtfsVolume(LinkDir) then + begin + FileName := ExtractFileName(FLinkTarget); + StrResetLength(FileName); + FIsRootDirectory := FileName = ''; + if FIsRootDirectory then + begin + Volume := ExtractFileDrive(FLinkTarget); + N := Pos(':', Volume); + if N > 0 then + SetLength(Volume, N - 1); + FileName := Volume; + end; + FLinkPath := Format('%s' + Prefix + '%.175s', [PathAddSeparator(LinkDir), FileName]); + Result := NOERROR; + end; + end; + end; + ReleaseStgMedium(StgMedium); +end; + +function TDirDropContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, + idCmdLast, uFlags: UINT): HResult; +begin + Result := 0; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0); + + if FLinkPath = '' then + Exit; + + if ((uFlags and $0000000F) = CMF_NORMAL) or + ((uFlags and CMF_EXPLORE) <> 0) then + begin + // Add one menu item to context menu + InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, PChar(SMenuItem)); + + // Return number of menu items added + Result := 1; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 1) + end; +end; + +function TDirDropContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; +var + Success: Boolean; +begin + Result := E_FAIL; + if (HiWord(Integer(lpici.lpVerb)) <> 0) then + begin + // We are called by an application + Exit; + end; + + if (LoWord(lpici.lpVerb) <> 0) then + begin + // invalid argument number + Result := E_INVALIDARG; + Exit; + end; + + if (not DirectoryExists(FLinkPath) and CreateDir(FLinkPath)) {or DirectoryIsEmpty(FLinkPath)} then + begin + Success := NtfsCreateJunctionPoint(FLinkPath, FLinkTarget); + if Success then + SHChangeNotify(SHCNE_MKDIR, SHCNF_PATH, PChar(FLinkPath), nil); + end; +end; + +function TDirDropContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; + pszName: LPSTR; cchMax: UINT): HRESULT; +begin + if (idCmd = 0) then + begin + if (uType = GCS_HELPTEXT) then + // return help string for menu item + StrCopy(pszName, PChar(SMenuHelp)); + Result := NOERROR; + end + else + Result := E_INVALIDARG; +end; + +type + TDirDropContextMenuFactory = class(TComObjectFactory) + public + procedure UpdateRegistry(Register: Boolean); override; + end; + +procedure TDirDropContextMenuFactory.UpdateRegistry(Register: Boolean); +var + ClassID: string; +begin + if Register then + begin + inherited UpdateRegistry(Register); + + ClassID := GUIDToString(Class_ContextMenu); + CreateRegKey(SRegKeyDir, '', ClassID); + CreateRegKey(SRegKeyDrive, '', ClassID); + + if (Win32Platform = VER_PLATFORM_WIN32_NT) then + with TRegistry.Create do + try + RootKey := HKEY_LOCAL_MACHINE; + OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True); + OpenKey('Approved', True); + WriteString(ClassID, SDescription); + finally + Free; + end; + end + else + begin + DeleteRegKey(SRegKeyDir); + DeleteRegKey(SRegKeyDrive); + inherited UpdateRegistry(Register); + end; +end; + +initialization + TDirDropContextMenuFactory.Create(ComServer, TDirDropContextMenu, Class_ContextMenu, + '', SDescription, ciMultiInstance, + tmApartment); +end. diff --git a/official/1.96/examples/windows/ntservice/NtSvcDemoDependent.dfm b/official/1.96/examples/windows/ntservice/NtSvcDemoDependent.dfm new file mode 100644 index 0000000..f08daac --- /dev/null +++ b/official/1.96/examples/windows/ntservice/NtSvcDemoDependent.dfm @@ -0,0 +1,63 @@ +object frmDependent: TfrmDependent + Left = 356 + Top = 295 + BorderStyle = bsDialog + Caption = 'Dependent Services' + ClientHeight = 239 + ClientWidth = 410 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object boxDependOn: TGroupBox + Left = 0 + Top = 0 + Width = 201 + Height = 201 + Caption = 'Depend On' + TabOrder = 0 + object treeDependOn: TTreeView + Left = 8 + Top = 16 + Width = 185 + Height = 177 + Indent = 19 + ReadOnly = True + TabOrder = 0 + OnDblClick = treeDependDblClick + end + end + object boxDependBy: TGroupBox + Left = 208 + Top = 1 + Width = 201 + Height = 200 + Caption = 'Depend By' + TabOrder = 1 + object treeDependBy: TTreeView + Left = 8 + Top = 16 + Width = 185 + Height = 177 + Indent = 19 + ReadOnly = True + ShowLines = False + ShowRoot = False + TabOrder = 0 + OnDblClick = treeDependDblClick + end + end + object btnOK: TBitBtn + Left = 168 + Top = 211 + Width = 75 + Height = 25 + TabOrder = 2 + Kind = bkOK + end +end diff --git a/official/1.96/examples/windows/ntservice/NtSvcDemoDependent.pas b/official/1.96/examples/windows/ntservice/NtSvcDemoDependent.pas new file mode 100644 index 0000000..adcb3af --- /dev/null +++ b/official/1.96/examples/windows/ntservice/NtSvcDemoDependent.pas @@ -0,0 +1,88 @@ +unit NtSvcDemoDependent; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Buttons, WinSvc, JclSvcCtrl, ComCtrls; + +type + TfrmDependent = class(TForm) + boxDependOn: TGroupBox; + boxDependBy: TGroupBox; + btnOK: TBitBtn; + treeDependOn: TTreeView; + treeDependBy: TTreeView; + procedure treeDependDblClick(Sender: TObject); + private + m_SelectedSvc: TJclNtService; + + procedure ShowDependent(const NtSvc: TJclNtService); + public + class function Execute(const NtSvc: TJclNtService): TJclNtService; + end; + +implementation + +uses NtSvcDemoGroups; + +{$R *.DFM} + +{ TfrmDependent } + +class function TfrmDependent.Execute(const NtSvc: TJclNtService): TJclNtService; +begin + with TfrmDependent.Create(nil) do + try + ShowDependent(NtSvc); + + m_SelectedSvc := nil; + ShowModal; + Result := m_SelectedSvc; + finally + Free; + end; +end; + +procedure TfrmDependent.ShowDependent(const NtSvc: TJclNtService); +var + I, J: Integer; + Node: TTreeNode; + SvcGrp: TJclServiceGroup; +begin + treeDependOn.ShowLines := NtSvc.DependentGroupCount <> 0; + treeDependOn.ShowRoot := NtSvc.DependentGroupCount <> 0; + + for I:=0 to NtSvc.DependentGroupCount-1 do + begin + SvcGrp := NtSvc.DependentGroups[I]; + Node := treeDependOn.Items.AddObject(nil, SvcGrp.Name, SvcGrp); + for J:=0 to SvcGrp.ServiceCount-1 do + treeDependOn.Items.AddChildObject(Node, + SvcGrp.Services[J].ServiceName, SvcGrp.Services[J]); + end; + + for I:=0 to NtSvc.DependentServiceCount-1 do + treeDependOn.Items.AddObject(nil, NtSvc.DependentServices[I].ServiceName, + NtSvc.DependentServices[I]); + + for I:=0 to NtSvc.DependentByServiceCount-1 do + treeDependBy.Items.AddObject(nil, NtSvc.DependentByServices[I].ServiceName, + NtSvc.DependentByServices[I]); + + treeDependOn.FullExpand; + treeDependBy.FullExpand; +end; + +procedure TfrmDependent.treeDependDblClick(Sender: TObject); +begin + with TTreeView(Sender) do + if Assigned(Selected) then + if TObject(Selected.Data).ClassType = TJclNtService then + begin + m_SelectedSvc := TJclNtService(Selected.Data); + Close; + end; +end; + +end. diff --git a/official/1.96/examples/windows/ntservice/NtSvcDemoGroups.dfm b/official/1.96/examples/windows/ntservice/NtSvcDemoGroups.dfm new file mode 100644 index 0000000..924eeb0 --- /dev/null +++ b/official/1.96/examples/windows/ntservice/NtSvcDemoGroups.dfm @@ -0,0 +1,35 @@ +object frmServiceGroups: TfrmServiceGroups + Left = 410 + Top = 278 + BorderStyle = bsDialog + Caption = 'Service Groups' + ClientHeight = 344 + ClientWidth = 216 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object treeServices: TTreeView + Left = 8 + Top = 8 + Width = 201 + Height = 297 + Indent = 19 + ReadOnly = True + TabOrder = 0 + OnDblClick = treeServicesDblClick + end + object btnOK: TBitBtn + Left = 72 + Top = 312 + Width = 75 + Height = 25 + TabOrder = 1 + Kind = bkOK + end +end diff --git a/official/1.96/examples/windows/ntservice/NtSvcDemoGroups.pas b/official/1.96/examples/windows/ntservice/NtSvcDemoGroups.pas new file mode 100644 index 0000000..ead36e0 --- /dev/null +++ b/official/1.96/examples/windows/ntservice/NtSvcDemoGroups.pas @@ -0,0 +1,76 @@ +unit NtSvcDemoGroups; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, StdCtrls, Buttons, JclSvcCtrl; + +type + TfrmServiceGroups = class(TForm) + treeServices: TTreeView; + btnOK: TBitBtn; + procedure treeServicesDblClick(Sender: TObject); + private + m_SelectedSvc: TJclNtService; + + procedure ShowGroups(const NtSvc: TJclNtService); + public + class function Execute(const NtSvc: TJclNtService): TJclNtService; + end; + +implementation + +{$R *.DFM} + +{ TfrmServiceGroups } + +class function TfrmServiceGroups.Execute(const NtSvc: TJclNtService): TJclNtService; +begin + with TfrmServiceGroups.Create(nil) do + try + ShowGroups(NtSvc); + + m_SelectedSvc := nil; + ShowModal; + Result := m_SelectedSvc; + finally + Free; + end; +end; + +procedure TfrmServiceGroups.ShowGroups(const NtSvc: TJclNtService); +var + GrpIdx, SvcIdx: Integer; + GrpNode, SvcNode: TTreeNode; + CurGrp: TJclServiceGroup; + CurNtSvc: TJclNtService; +begin + with NtSvc.SCManager do + for GrpIdx:=0 to GroupCount-1 do + begin + CurGrp := Groups[GrpIdx]; + + if CurGrp.Name = '' then Continue; + + GrpNode := treeServices.Items.AddChildObject(nil, CurGrp.Name, CurGrp); + for SvcIdx:=0 to CurGrp.ServiceCount-1 do + begin + CurNtSvc := CurGrp.Services[SvcIdx]; + SvcNode := treeServices.Items.AddChildObject(GrpNode, CurNtSvc.ServiceName, CurNtSvc); + if NtSvc = CurNtSvc then + treeServices.Selected := SvcNode; + end; + end; +end; + +procedure TfrmServiceGroups.treeServicesDblClick(Sender: TObject); +begin + if Assigned(treeServices.Selected) and (treeServices.Selected.Level = 1) then + begin + m_SelectedSvc := TJclNtService(treeServices.Selected.Data); + Close; + end; +end; + +end. diff --git a/official/1.96/examples/windows/ntservice/NtSvcDemoMain.dfm b/official/1.96/examples/windows/ntservice/NtSvcDemoMain.dfm new file mode 100644 index 0000000..03439f4 --- /dev/null +++ b/official/1.96/examples/windows/ntservice/NtSvcDemoMain.dfm @@ -0,0 +1,275 @@ +object frmMain: TfrmMain + Left = 271 + Top = 251 + Width = 640 + Height = 480 + Caption = 'NT Service Control Demo' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Menu = mnuMain + OldCreateOrder = False + Position = poDesktopCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object lstSvc: TListView + Left = 0 + Top = 0 + Width = 632 + Height = 415 + Align = alClient + Columns = < + item + Caption = 'Service Name' + Width = 80 + end + item + Caption = 'Display Name' + Width = 300 + end + item + Caption = 'State' + Width = 64 + end + item + Caption = 'Start Type' + Width = 80 + end + item + Caption = 'Err Ctrl Type' + Width = 80 + end + item + Caption = 'Exit Code' + Width = 60 + end + item + AutoSize = True + Caption = 'Description' + WidthType = ( + -12) + end + item + AutoSize = True + Caption = 'File Name' + WidthType = ( + -12) + end + item + AutoSize = True + Caption = 'Group' + WidthType = ( + -12) + end> + GridLines = True + HideSelection = False + HotTrack = True + HotTrackStyles = [htHandPoint, htUnderlineHot] + OwnerData = True + ReadOnly = True + RowSelect = True + ParentShowHint = False + PopupMenu = mnuPopup + ShowHint = True + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = lstSvcColumnClick + OnData = lstSvcData + end + object barStatus: TStatusBar + Left = 0 + Top = 415 + Width = 632 + Height = 19 + Panels = <> + SimplePanel = True + end + object lstActions: TActionList + Left = 24 + Top = 40 + object actViewRefresh: TAction + Category = 'View' + Caption = '&Refresh' + Hint = 'Refresh all' + ShortCut = 116 + OnExecute = actViewRefreshExecute + end + object actFileConnect: TAction + Category = 'File' + Caption = '&Connect...' + Hint = 'Connect to computer' + ShortCut = 16462 + OnExecute = actFileConnectExecute + end + object actFileExit: TAction + Category = 'File' + Caption = 'E&xit' + Hint = 'Exit the program' + ShortCut = 32883 + OnExecute = actFileExitExecute + end + object actHelpAbout: TAction + Category = 'Help' + Caption = 'About' + Hint = 'About the program' + ShortCut = 112 + OnExecute = actHelpAboutExecute + end + object actControlStart: TAction + Category = 'Control' + Caption = '&Start' + Hint = 'Start Service' + ShortCut = 16466 + OnExecute = actControlStartExecute + OnUpdate = actControlStartUpdate + end + object actControlStop: TAction + Category = 'Control' + Caption = 'St&op' + Hint = 'Stop Service' + ShortCut = 16467 + OnExecute = actControlStopExecute + OnUpdate = actControlStopUpdate + end + object actControlPause: TAction + Category = 'Control' + Caption = '&Pause' + Hint = 'Pause Service' + ShortCut = 16464 + OnExecute = actControlPauseExecute + OnUpdate = actControlPauseUpdate + end + object actControlContinue: TAction + Category = 'Control' + Caption = '&Continue' + Hint = 'Continue Service' + ShortCut = 16468 + OnExecute = actControlContinueExecute + OnUpdate = actControlContinueUpdate + end + object actViewDependent: TAction + Category = 'View' + Caption = '&Dependent' + Hint = 'View the service dependent' + ShortCut = 16452 + OnExecute = actViewDependentExecute + OnUpdate = actViewDependentUpdate + end + object actViewGroups: TAction + Category = 'View' + Caption = 'Groups' + Hint = 'View the service groups' + ShortCut = 16455 + OnExecute = actViewGroupsExecute + OnUpdate = actViewGroupsUpdate + end + object actControlDelete: TAction + Category = 'Control' + Caption = '&Delete' + Hint = 'Delete Service' + ShortCut = 16430 + OnExecute = actControlDeleteExecute + OnUpdate = ActionItemSelected + end + end + object mnuPopup: TPopupMenu + Left = 136 + Top = 40 + object popControlStart: TMenuItem + Action = actControlStart + end + object popControlStop: TMenuItem + Action = actControlStop + end + object popControlPause: TMenuItem + Action = actControlPause + end + object popControlContinue: TMenuItem + Action = actControlContinue + end + object popLine0: TMenuItem + Caption = '-' + end + object popControlDelete: TMenuItem + Action = actControlDelete + end + object popLine1: TMenuItem + Caption = '-' + end + object popViewDependent: TMenuItem + Action = actViewDependent + end + object popViewGroups: TMenuItem + Action = actViewGroups + end + object popLine2: TMenuItem + Caption = '-' + end + object popViewRefresh: TMenuItem + Action = actViewRefresh + end + end + object mnuMain: TMainMenu + Left = 80 + Top = 40 + object mnuFile: TMenuItem + Caption = '&File' + object mnuFileConnect: TMenuItem + Action = actFileConnect + end + object mnuFileLine1: TMenuItem + Caption = '-' + end + object mnuFileExit: TMenuItem + Action = actFileExit + end + end + object mnuView: TMenuItem + Caption = '&View' + object mnuViewDependent: TMenuItem + Action = actViewDependent + end + object mnuViewGroups: TMenuItem + Action = actViewGroups + end + object mnuViewLine1: TMenuItem + Caption = '-' + end + object mnuViewRefreshStatus: TMenuItem + Action = actViewRefresh + end + end + object mnuControl: TMenuItem + Caption = '&Control' + object mnuControlStart: TMenuItem + Action = actControlStart + end + object mnuControlStop: TMenuItem + Action = actControlStop + end + object mnuControlPause: TMenuItem + Action = actControlPause + end + object mnuControlContinue: TMenuItem + Action = actControlContinue + end + object mnuControlLine1: TMenuItem + Caption = '-' + end + object mnuControlDelete: TMenuItem + Action = actControlDelete + end + end + object mnuHelp: TMenuItem + Caption = '&Help' + object mnuHelpAbout: TMenuItem + Action = actHelpAbout + end + end + end +end diff --git a/official/1.96/examples/windows/ntservice/NtSvcDemoMain.pas b/official/1.96/examples/windows/ntservice/NtSvcDemoMain.pas new file mode 100644 index 0000000..b929499 --- /dev/null +++ b/official/1.96/examples/windows/ntservice/NtSvcDemoMain.pas @@ -0,0 +1,416 @@ +unit NtSvcDemoMain; + +interface + +{$I jcl.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, ComCtrls, ActnList, Menus, JclSvcCtrl; + +type + TfrmMain = class(TForm) + lstSvc: TListView; + lstActions: TActionList; + actViewRefresh: TAction; + mnuPopup: TPopupMenu; + popViewRefresh: TMenuItem; + actFileConnect: TAction; + actFileExit: TAction; + mnuMain: TMainMenu; + mnuFile: TMenuItem; + mnuFileConnect: TMenuItem; + mnuFileLine1: TMenuItem; + mnuFileExit: TMenuItem; + mnuView: TMenuItem; + mnuViewRefreshStatus: TMenuItem; + actHelpAbout: TAction; + mnuHelp: TMenuItem; + mnuHelpAbout: TMenuItem; + barStatus: TStatusBar; + actControlStart: TAction; + actControlStop: TAction; + actControlPause: TAction; + actControlContinue: TAction; + mnuControl: TMenuItem; + mnuControlStart: TMenuItem; + mnuControlStop: TMenuItem; + mnuControlPause: TMenuItem; + mnuControlContinue: TMenuItem; + popLine1: TMenuItem; + popControlStart: TMenuItem; + popControlStop: TMenuItem; + popControlPause: TMenuItem; + popControlContinue: TMenuItem; + actViewDependent: TAction; + mnuViewDependent: TMenuItem; + mnuViewLine1: TMenuItem; + popLine2: TMenuItem; + popViewDependent: TMenuItem; + actViewGroups: TAction; + mnuViewGroups: TMenuItem; + popViewGroups: TMenuItem; + actControlDelete: TAction; + mnuControlLine1: TMenuItem; + mnuControlDelete: TMenuItem; + popLine0: TMenuItem; + popControlDelete: TMenuItem; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure lstSvcData(Sender: TObject; Item: TListItem); + procedure actViewRefreshExecute(Sender: TObject); + procedure lstSvcColumnClick(Sender: TObject; Column: TListColumn); + procedure actFileExitExecute(Sender: TObject); + procedure actFileConnectExecute(Sender: TObject); + procedure actHelpAboutExecute(Sender: TObject); + procedure actControlStartExecute(Sender: TObject); + procedure actControlStopExecute(Sender: TObject); + procedure actControlPauseExecute(Sender: TObject); + procedure actControlContinueExecute(Sender: TObject); + procedure actControlStartUpdate(Sender: TObject); + procedure actControlStopUpdate(Sender: TObject); + procedure actControlPauseUpdate(Sender: TObject); + procedure actControlContinueUpdate(Sender: TObject); + procedure actControlDeleteExecute(Sender: TObject); + procedure ActionItemSelected(Sender: TObject); + procedure actViewDependentExecute(Sender: TObject); + procedure actViewGroupsExecute(Sender: TObject); + procedure lstSvcInfoTip(Sender: TObject; Item: TListItem; + var InfoTip: String); + procedure ApplicationHint(Sender: TObject); + procedure actViewDependentUpdate(Sender: TObject); + procedure actViewGroupsUpdate(Sender: TObject); + private + FSCManager: TJclSCManager; + {$IFDEF DELPHI5_UP} + m_fOrderAsc: Boolean; + {$ENDIF DELPHI5_UP} + function GetStatusHint: string; + procedure SetStatusHint(const Value: string); + function GetSelected: TJclNtService; + procedure SelectService(const Svc: TJclNtService); + public + procedure Refresh(const Svc: TJclNtService = nil); + + property SCManager: TJclSCManager read FSCManager; + property Selected: TJclNtService read GetSelected; + + property StatusHint: string read GetStatusHint write SetStatusHint; + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.DFM} + +uses + ShellApi, TypInfo, NtSvcDemoDependent, NtSvcDemoGroups, + JclSysUtils; + +const + CRLF = #13#10; + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + FSCManager := TJclSCManager.Create; + FSCManager.Refresh(True); + + Application.OnHint := ApplicationHint; + {$IFDEF DELPHI5_UP} + lstSvc.OnInfoTip := lstSvcInfoTip; + {$ELSE DELPHI5_UP} + lstSvc.ColumnClick := False; + {$ENDIF DELPHI5_UP} + + Refresh; +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + Application.OnHint := nil; + + FreeAndNil(FSCManager); +end; + +function TfrmMain.GetStatusHint: string; +begin + Result := barStatus.SimpleText; +end; + +procedure TfrmMain.SetStatusHint(const Value: string); +begin + barStatus.SimpleText := Value; + Application.ProcessMessages; +end; + +function TfrmMain.GetSelected: TJclNtService; +begin + Result := SCManager.Services[lstSvc.Selected.Index]; +end; + +procedure TfrmMain.SelectService(const Svc: TJclNtService); +var + Item: TListItem; +begin + if Assigned(Svc) then + begin + Item := lstSvc.FindData(0, Svc, True, True); + if Assigned(Item) then + begin + lstSvc.Selected := Item; + Item.MakeVisible(False); + end; + end; +end; + +procedure TfrmMain.Refresh(const Svc: TJclNtService = nil); +begin + if Assigned(Svc) then + Svc.Refresh + else + SCManager.Refresh; + + lstSvc.Items.Count := SCManager.ServiceCount; + lstSvc.Invalidate; +end; + +procedure TfrmMain.lstSvcData(Sender: TObject; Item: TListItem); +begin + with Item, SCManager.Services[Item.Index] do + begin + Caption := ServiceName; + Data := SCManager.Services[Item.Index]; + SubItems.Add(DisplayName); + SubItems.Add(GetEnumName(TypeInfo(TJclServiceState), Integer(ServiceState))); + SubItems.Add(GetEnumName(TypeInfo(TJclServiceStartType), Integer(StartType))); + SubItems.Add(GetEnumName(TypeInfo(TJclServiceErrorControlType), Integer(ErrorControlType))); + SubItems.Add(IntToStr(Win32ExitCode)); + SubItems.Add(Description); + SubItems.Add(FileName); + SubItems.Add(Group.Name); + end; +end; + +procedure TfrmMain.actViewRefreshExecute(Sender: TObject); +begin + Refresh; +end; + +procedure TfrmMain.lstSvcColumnClick(Sender: TObject; Column: TListColumn); +const + SortOrderMapping: array[0..8] of TJclServiceSortOrderType = + (sotServiceName, sotDisplayName, sotServiceState, + sotStartType, sotErrorControlType, sotWin32ExitCode, + sotDescription, sotFileName, sotLoadOrderGroup); +var + {$IFDEF DELPHI5_UP} + I: Integer; + {$ENDIF DELPHI5_UP} + NtSvcName: string; + NtSvc: TJclNtService; +begin + if Assigned(lstSvc.Selected) then + NtSvcName := Selected.ServiceName + else + NtSvcName := ''; + + {$IFDEF DELPHI5_UP} + if Column.Tag = Ord(True) then + m_fOrderAsc := not m_fOrderAsc + else + m_fOrderAsc := True; + + for I:=0 to lstSvc.Columns.Count-1 do + lstSvc.Columns[I].Tag := Ord(lstSvc.Columns[I] = Column); + + SCManager.Sort(SortOrderMapping[Column.Index], m_fOrderAsc); + {$ENDIF DELPHI5_UP} + + Refresh; + + if (NtSvcName <> '') and SCManager.FindService(NtSvcName, NtSvc) then + SelectService(NtSvc); +end; + +procedure TfrmMain.actFileExitExecute(Sender: TObject); +begin + Close; +end; + +procedure TfrmMain.actFileConnectExecute(Sender: TObject); +var + ComputerName: string; +begin + if InputQuery('Browse a computer', 'Computer name:', ComputerName) and + (CompareText(ComputerName, SCManager.MachineName) <> 0) then + begin + FreeAndNil(FSCManager); + + StatusHint := 'Connecting to ' + ComputerName + '...'; + FSCManager := TJclSCManager.Create(ComputerName); + FSCManager.Refresh(True); + StatusHint := 'Connected to ' + ComputerName; + + Refresh; + end; +end; + +procedure TfrmMain.actHelpAboutExecute(Sender: TObject); +begin + ShellAbout(Handle, PChar(Caption), + PChar('JEDI Code Library (JCL)' + CRLF + 'http://delphi-jedi.org/'), + Application.Icon.Handle); +end; + +procedure TfrmMain.actControlStartExecute(Sender: TObject); +begin + Selected.Start; + Refresh(Selected); +end; + +procedure TfrmMain.actControlStopExecute(Sender: TObject); +begin + Selected.Stop; + Refresh(Selected); +end; + +procedure TfrmMain.actControlPauseExecute(Sender: TObject); +begin + Selected.Pause; + Refresh(Selected); +end; + +procedure TfrmMain.actControlContinueExecute(Sender: TObject); +begin + Selected.Continue; + Refresh(Selected); +end; + +procedure TfrmMain.actControlStartUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(lstSvc.Selected) and + (Selected.ServiceState in [ssStopped]); +end; + +procedure TfrmMain.actControlStopUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(lstSvc.Selected) and + (Selected.ServiceState in [ssRunning]) and + (caStop in Selected.ControlsAccepted); +end; + +procedure TfrmMain.actControlPauseUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(lstSvc.Selected) and + (Selected.ServiceState in [ssRunning]) and + (caPauseContinue in Selected.ControlsAccepted); +end; + +procedure TfrmMain.actControlContinueUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(lstSvc.Selected) and + (Selected.ServiceState in [ssPaused]); +end; + +procedure TfrmMain.actControlDeleteExecute(Sender: TObject); +begin + if MessageDlg(Format('Are you sure to delete the [%s] service?', [Selected.ServiceName]), + mtConfirmation, [mbYes, mbNo], 0) = mrYes then + begin + Selected.Delete; + SCManager.Refresh(True); + Refresh; + end; +end; + +procedure TfrmMain.ActionItemSelected(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(lstSvc.Selected); +end; + +procedure TfrmMain.actViewDependentExecute(Sender: TObject); +begin + SelectService(TfrmDependent.Execute(Selected)); +end; + +procedure TfrmMain.actViewDependentUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(lstSvc.Selected) and + ((Selected.DependentServiceCount <> 0) or + (Selected.DependentGroupCount <> 0) or + (Selected.DependentByServiceCount <> 0)); +end; + +procedure TfrmMain.actViewGroupsExecute(Sender: TObject); +begin + SelectService(TfrmServiceGroups.Execute(Selected)); +end; + +procedure TfrmMain.actViewGroupsUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(lstSvc.Selected) and + (Selected.Group.Name <> '') +end; + +procedure TfrmMain.lstSvcInfoTip(Sender: TObject; Item: TListItem; + var InfoTip: String); + function FormatServiceTypes(const SvcTypes: TJclServiceTypes): string; + var + AType: TJclServiceType; + begin + Result := ''; + for AType:=Low(TJclServiceType) to High(TJclServiceType) do + if AType in SvcTypes then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + GetEnumName(TypeInfo(TJclServiceType), Integer(AType)); + end; + end; + function FormatControlsAccepted(const CtrlAccepted: TJclServiceControlAccepteds): string; + var + ACtrl: TJclServiceControlAccepted; + begin + Result := ''; + for ACtrl:=Low(TJclServiceControlAccepted) to High(TJclServiceControlAccepted) do + if ACtrl in CtrlAccepted then + begin + if Result <> '' then + Result := Result + ', '; + Result := Result + GetEnumName(TypeInfo(TJclServiceControlAccepted), Integer(ACtrl)); + end; + end; +begin + with TJclNtService(Item.Data) do + InfoTip := Format('Service Name: %s' + CRLF + + 'Display Name: %s' + CRLF + + 'Description: %s' + CRLF + + 'File Name: %s' + CRLF + + 'Service Type: %s' + CRLF + + 'Service State: %s' + CRLF + + 'Start Type: %s' + CRLF + + 'Error Control: %s' + CRLF + + 'Win32 Exit Code: [%d] %s' + CRLF + + 'Service Group: %s' + CRLF + + 'Controls Accepted: %s', + [ServiceName, + DisplayName, + Description, + FileName, + FormatServiceTypes(ServiceTypes), + GetEnumName(TypeInfo(TJclServiceState), Integer(ServiceState)), + GetEnumName(TypeInfo(TJclServiceStartType), Integer(StartType)), + GetEnumName(TypeInfo(TJclServiceErrorControlType), Integer(ErrorControlType)), + Win32ExitCode, SysErrorMessage(Win32ExitCode), + Group.Name, + FormatControlsAccepted(ControlsAccepted)]); +end; + +procedure TfrmMain.ApplicationHint(Sender: TObject); +begin + StatusHint := GetLongHint(Application.Hint); +end; + +end. diff --git a/official/1.96/examples/windows/ntservice/NtSvcExample.dof b/official/1.96/examples/windows/ntservice/NtSvcExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/ntservice/NtSvcExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/ntservice/NtSvcExample.dpr b/official/1.96/examples/windows/ntservice/NtSvcExample.dpr new file mode 100644 index 0000000..ba5d896 --- /dev/null +++ b/official/1.96/examples/windows/ntservice/NtSvcExample.dpr @@ -0,0 +1,15 @@ +program NtSvcExample; + +uses + Forms, + NtSvcDemoMain in 'NtSvcDemoMain.pas' {frmMain}, + NtSvcDemoDependent in 'NtSvcDemoDependent.pas' {frmDependent}, + NtSvcDemoGroups in 'NtSvcDemoGroups.pas' {frmServiceGroups}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/official/1.96/examples/windows/ntservice/NtSvcExample.res b/official/1.96/examples/windows/ntservice/NtSvcExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/ntservice/NtSvcExample.res differ diff --git a/official/1.96/examples/windows/peimage/ApiHookDemoMain.dfm b/official/1.96/examples/windows/peimage/ApiHookDemoMain.dfm new file mode 100644 index 0000000..37d2c34 --- /dev/null +++ b/official/1.96/examples/windows/peimage/ApiHookDemoMain.dfm @@ -0,0 +1,53 @@ +object Form1: TForm1 + Left = 193 + Top = 103 + Width = 458 + Height = 356 + Caption = 'TJclPeMapImgHooks demo' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object HookBtn: TButton + Left = 8 + Top = 16 + Width = 89 + Height = 25 + Caption = 'Hook' + TabOrder = 0 + OnClick = HookBtnClick + end + object UnhookBtn: TButton + Left = 8 + Top = 48 + Width = 89 + Height = 25 + Caption = 'Unhook' + TabOrder = 1 + OnClick = UnhookBtnClick + end + object BeepBtn: TButton + Left = 8 + Top = 104 + Width = 89 + Height = 25 + Caption = 'MessageBeep' + TabOrder = 2 + OnClick = BeepBtnClick + end + object Memo1: TMemo + Left = 132 + Top = 0 + Width = 318 + Height = 329 + Anchors = [akLeft, akTop, akRight, akBottom] + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 3 + end +end diff --git a/official/1.96/examples/windows/peimage/ApiHookDemoMain.pas b/official/1.96/examples/windows/peimage/ApiHookDemoMain.pas new file mode 100644 index 0000000..47c6c65 --- /dev/null +++ b/official/1.96/examples/windows/peimage/ApiHookDemoMain.pas @@ -0,0 +1,82 @@ +unit ApiHookDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls; + +type + TForm1 = class(TForm) + HookBtn: TButton; + UnhookBtn: TButton; + BeepBtn: TButton; + Memo1: TMemo; + procedure HookBtnClick(Sender: TObject); + procedure UnhookBtnClick(Sender: TObject); + procedure BeepBtnClick(Sender: TObject); + private + { Private declarations } + public + procedure AddMsg(const S: string); + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +uses + JclPeImage, JclSysUtils; + +var + PeImportHooks: TJclPeMapImgHooks; + + OldMessageBeep: function(uType: UINT): BOOL; stdcall = nil; + +function NewMessageBeep(uType: UINT): BOOL; stdcall; +begin + Form1.AddMsg(Format('MessageBeep called, uType = %d', [uType])); + Result := OldMessageBeep(uType); +end; + +{ TForm1 } + +procedure TForm1.AddMsg(const S: string); +begin + Memo1.Lines.Add(S); +end; + +procedure TForm1.HookBtnClick(Sender: TObject); +begin + if PeImportHooks.HookImport(Pointer(HInstance), user32, 'MessageBeep', + @NewMessageBeep, @OldMessageBeep) then + AddMsg('MessageBeep hooked ...') + else + AddMsg(Format('MessageBeep hooking error - %s', [SysErrorMessage(GetLastError)])); +end; + +procedure TForm1.UnhookBtnClick(Sender: TObject); +begin + if PeImportHooks.UnhookByNewAddress(@NewMessageBeep) then + begin + @OldMessageBeep := nil; + AddMsg('MessageBeep unhooked ...'); + end else + AddMsg('MessageBeep wasn''t hooked') +end; + +procedure TForm1.BeepBtnClick(Sender: TObject); +begin + MessageBeep(MB_OK); +end; + +initialization + PeImportHooks := TJclPeMapImgHooks.Create; + +finalization + FreeAndNil(PeImportHooks); + +end. diff --git a/official/1.96/examples/windows/peimage/ApiHookExample.dof b/official/1.96/examples/windows/peimage/ApiHookExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/peimage/ApiHookExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/peimage/ApiHookExample.dpr b/official/1.96/examples/windows/peimage/ApiHookExample.dpr new file mode 100644 index 0000000..3922a8e --- /dev/null +++ b/official/1.96/examples/windows/peimage/ApiHookExample.dpr @@ -0,0 +1,13 @@ +program ApiHookExample; + +uses + Forms, + ApiHookDemoMain in 'ApiHookDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/peimage/ApiHookExample.res b/official/1.96/examples/windows/peimage/ApiHookExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/peimage/ApiHookExample.res differ diff --git a/official/1.96/examples/windows/peimage/PeFuncDemoMain.dfm b/official/1.96/examples/windows/peimage/PeFuncDemoMain.dfm new file mode 100644 index 0000000..7661f6d --- /dev/null +++ b/official/1.96/examples/windows/peimage/PeFuncDemoMain.dfm @@ -0,0 +1,165 @@ +object Form1: TForm1 + Left = 209 + Top = 107 + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsSingle + Caption = 'JclPeImage PeXXX functions example' + ClientHeight = 506 + ClientWidth = 561 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object FileNameLabel: TLabel + Left = 96 + Top = 8 + Width = 70 + Height = 13 + Caption = 'FileNameLabel' + end + object Label1: TLabel + Left = 8 + Top = 40 + Width = 91 + Height = 13 + Caption = '&Exported functions:' + FocusControl = ExportsListBox + end + object Label2: TLabel + Left = 8 + Top = 184 + Width = 87 + Height = 13 + Caption = 'I&mported functions' + FocusControl = ImportsListBox + end + object Label3: TLabel + Left = 368 + Top = 184 + Width = 79 + Height = 13 + Caption = 'Imported &libraries' + FocusControl = ImportedLibsListBox + end + object Label4: TLabel + Left = 8 + Top = 352 + Width = 28 + Height = 13 + Caption = '&Forms' + FocusControl = FormsListBox + end + object Label5: TLabel + Left = 216 + Top = 352 + Width = 37 + Height = 13 + Caption = '&Bitmaps' + FocusControl = BitmapResListBox + end + object Label6: TLabel + Left = 352 + Top = 352 + Width = 26 + Height = 13 + Caption = '&Icons' + FocusControl = IconsListBox + end + object Label7: TLabel + Left = 456 + Top = 352 + Width = 35 + Height = 13 + Caption = '&Cursors' + FocusControl = CursorsListBox + end + object ExportsListBox: TListBox + Left = 8 + Top = 56 + Width = 545 + Height = 121 + ItemHeight = 13 + Sorted = True + TabOrder = 1 + end + object ImportsListBox: TListBox + Left = 8 + Top = 200 + Width = 345 + Height = 145 + ItemHeight = 13 + Sorted = True + TabOrder = 2 + end + object ImportedLibsListBox: TListBox + Left = 368 + Top = 200 + Width = 185 + Height = 145 + ItemHeight = 13 + Sorted = True + TabOrder = 3 + end + object BitmapResListBox: TListBox + Tag = 200 + Left = 216 + Top = 368 + Width = 129 + Height = 129 + ItemHeight = 13 + Sorted = True + TabOrder = 5 + end + object OpenBtn: TButton + Left = 8 + Top = 8 + Width = 75 + Height = 25 + Caption = 'Open' + TabOrder = 0 + OnClick = OpenBtnClick + end + object IconsListBox: TListBox + Tag = 200 + Left = 352 + Top = 368 + Width = 97 + Height = 129 + ItemHeight = 13 + Sorted = True + TabOrder = 6 + end + object FormsListBox: TListBox + Tag = 350 + Left = 8 + Top = 368 + Width = 201 + Height = 129 + ItemHeight = 13 + Sorted = True + TabOrder = 4 + end + object CursorsListBox: TListBox + Tag = 200 + Left = 456 + Top = 368 + Width = 97 + Height = 129 + ItemHeight = 13 + Sorted = True + TabOrder = 7 + end + object OpenDialog1: TOpenDialog + Filter = + 'Executable files (*.exe;*.dll;*.bpl;*.ocx)|*.exe;*.dll;*.bpl;*.o' + + 'cx' + Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 176 + Top = 8 + end +end diff --git a/official/1.96/examples/windows/peimage/PeFuncDemoMain.pas b/official/1.96/examples/windows/peimage/PeFuncDemoMain.pas new file mode 100644 index 0000000..4f85968 --- /dev/null +++ b/official/1.96/examples/windows/peimage/PeFuncDemoMain.pas @@ -0,0 +1,124 @@ +unit PeFuncDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls; + +type + TForm1 = class(TForm) + OpenDialog1: TOpenDialog; + ExportsListBox: TListBox; + ImportsListBox: TListBox; + ImportedLibsListBox: TListBox; + BitmapResListBox: TListBox; + OpenBtn: TButton; + IconsListBox: TListBox; + FormsListBox: TListBox; + FileNameLabel: TLabel; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + CursorsListBox: TListBox; + Label7: TLabel; + procedure OpenBtnClick(Sender: TObject); + private + { Private declarations } + public + procedure BeginUpdateListBoxes; + procedure EndUpdateListBoxes; + procedure UpdateViews(const FileName: TFileName); + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +uses + JclPeImage; + +procedure TForm1.BeginUpdateListBoxes; +var + I: Integer; + C: TComponent; +begin + for I := 0 to ComponentCount - 1 do + begin + C := Components[I]; + if C is TListBox then + with TListBox(C) do + begin + Items.BeginUpdate; + Items.Clear; + end; + end; +end; + +procedure TForm1.EndUpdateListBoxes; +var + I, Extent: Integer; + C: TComponent; +begin + for I := 0 to ComponentCount - 1 do + begin + C := Components[I]; + if C is TListBox then + with TListBox(C) do + begin + ItemIndex := -1; + if Items.Count > 0 then + Extent := Tag + else + Extent := 0; + SendMessage(Handle, LB_SETHORIZONTALEXTENT, Extent, 0); + Items.EndUpdate; + end; + end; +end; + +procedure TForm1.OpenBtnClick(Sender: TObject); +begin + with OpenDialog1 do + begin + FileName := ''; + if Execute then + if IsValidPeFile(FileName) then + UpdateViews(FileName) + else + ShowMessageFmt('The file "%s" is not valid PE file.', [FileName]); + end; +end; + +procedure TForm1.UpdateViews(const FileName: TFileName); +begin + BeginUpdateListBoxes; + Screen.Cursor := crHourGlass; + try + FileNameLabel.Caption := FileName; + + // Exported functions + PeExportedFunctions(FileName, ExportsListBox.Items); + // Imported functions + PeImportedFunctions(FileName, ImportsListBox.Items, '', True); + // Imported libraries (not recursive) + PeImportedLibraries(FileName, ImportedLibsListBox.Items, False, False); + // VCL form names + PeBorFormNames(FileName, FormsListBox.Items); + // Bitmap, Icon and Cursor names + PeResourceKindNames(FileName, rtBitmap, BitmapResListBox.Items); + PeResourceKindNames(FileName, rtIcon, IconsListBox.Items); + PeResourceKindNames(FileName, rtCursor, CursorsListBox.Items); + finally + Screen.Cursor := crDefault; + EndUpdateListBoxes; + end; +end; + +end. diff --git a/official/1.96/examples/windows/peimage/PeFuncExample.dof b/official/1.96/examples/windows/peimage/PeFuncExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/peimage/PeFuncExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/peimage/PeFuncExample.dpr b/official/1.96/examples/windows/peimage/PeFuncExample.dpr new file mode 100644 index 0000000..352a76f --- /dev/null +++ b/official/1.96/examples/windows/peimage/PeFuncExample.dpr @@ -0,0 +1,13 @@ +program PeFuncExample; + +uses + Forms, + PeFuncDemoMain in 'PeFuncDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/peimage/PeFuncExample.res b/official/1.96/examples/windows/peimage/PeFuncExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/peimage/PeFuncExample.res differ diff --git a/official/1.96/examples/windows/peimage/UnmangleNameDemoMain.dfm b/official/1.96/examples/windows/peimage/UnmangleNameDemoMain.dfm new file mode 100644 index 0000000..4b36021 --- /dev/null +++ b/official/1.96/examples/windows/peimage/UnmangleNameDemoMain.dfm @@ -0,0 +1,111 @@ +object Form1: TForm1 + Left = 203 + Top = 123 + AutoScroll = False + Caption = 'PeUnmangleName example' + ClientHeight = 483 + ClientWidth = 719 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object PeFileLabel: TLabel + Left = 104 + Top = 435 + Width = 72 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Borland PE file:' + end + object PackageLabel: TLabel + Left = 224 + Top = 435 + Width = 46 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Package:' + end + object FilenameLabel: TLabel + Left = 104 + Top = 452 + Width = 47 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'FileName:' + end + object PackageDescrLabel: TLabel + Left = 104 + Top = 469 + Width = 103 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Package description: ' + end + object PackageVerLabel: TLabel + Left = 312 + Top = 435 + Width = 125 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Package compiler version:' + end + object ListView1: TListView + Left = 0 + Top = 0 + Width = 719 + Height = 433 + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = < + item + Caption = 'Export name' + Width = 250 + end + item + Caption = 'Description' + Width = 90 + end + item + Caption = 'RTTI TypeKind' + Width = 85 + end + item + Caption = 'RTTI Name' + Width = 120 + end + item + Caption = 'Info' + Width = 200 + end> + ColumnClick = False + GridLines = True + OwnerData = True + ReadOnly = True + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + OnData = ListView1Data + end + object OpenBtn: TButton + Left = 6 + Top = 442 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = '&Open' + TabOrder = 1 + OnClick = OpenBtnClick + end + object OpenDialog1: TOpenDialog + Filter = 'BPL|*.bpl|BPL, DLL|*.bpl;*.dll' + Left = 8 + Top = 400 + end +end diff --git a/official/1.96/examples/windows/peimage/UnmangleNameDemoMain.pas b/official/1.96/examples/windows/peimage/UnmangleNameDemoMain.pas new file mode 100644 index 0000000..358df09 --- /dev/null +++ b/official/1.96/examples/windows/peimage/UnmangleNameDemoMain.pas @@ -0,0 +1,228 @@ +unit UnmangleNameDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ExtCtrls, ComCtrls, StdCtrls, JclPeImage; + +type + TForm1 = class(TForm) + ListView1: TListView; + OpenBtn: TButton; + OpenDialog1: TOpenDialog; + PeFileLabel: TLabel; + PackageLabel: TLabel; + FilenameLabel: TLabel; + PackageDescrLabel: TLabel; + PackageVerLabel: TLabel; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure OpenBtnClick(Sender: TObject); + procedure ListView1Data(Sender: TObject; Item: TListItem); + private + BorImage: TJclPeBorImage; + public + procedure UpdateInfo; + class procedure LabelCaptionParam(Lbl: TLabel; const StringParam: string); + end; + +var + Form1: TForm1; + +implementation + +{$R *.DFM} + +uses + ComObj, TypInfo, + JclSysInfo, JclSysUtils, JclWin32; + +// Demonstrates creating custom resource item classes + +type + TJclPeResourceStringItem = class (TJclPeResourceItem) + public + function GetItemIDString(const ItemID: Word): string; + end; + + TJclDemoPeBorImage = class (TJclPeBorImage) + protected + function ResourceItemCreate(AEntry: PImageResourceDirectoryEntry; + AParentItem: TJclPeResourceItem): TJclPeResourceItem; override; + public + function ResourceStringValue(const ID: Word): string; + end; + +{ TJclPeResourceStringItem } + +function TJclPeResourceStringItem.GetItemIDString(const ItemID: Word): string; +var + P: PWChar; + Cnt: Cardinal; + Len: Word; +begin + Result := ''; + Assert(IsDirectory); + P := List[0].RawEntryData; + Cnt := 0; + while Cnt < 16 do + begin + Len := Word(P^); + if Len > 0 then + begin + Inc(P); + if Cnt = ItemID then + begin + Result := PChar(WideCharLenToString(P, Len)); + Exit; + end; + Inc(P, Len); + end else + Inc(P); + Inc(Cnt); + end; +end; + +{ TJclDemoPeBorImage } + +function TJclDemoPeBorImage.ResourceItemCreate(AEntry: PImageResourceDirectoryEntry; + AParentItem: TJclPeResourceItem): TJclPeResourceItem; +begin + if (AParentItem <> nil) and (AParentItem.Level = 1) and (AParentItem.ResourceType = rtString) then + Result := TJclPeResourceStringItem.Create(Self, AParentItem, AEntry) + else + Result := inherited ResourceItemCreate(AEntry, AParentItem); +end; + +function TJclDemoPeBorImage.ResourceStringValue(const ID: Word): string; +var + Item: TJclPeResourceItem; + BlockID, ItemID: Word; +begin + Result := ''; + BlockID := (ID div 16) + 1; + ItemID := ID mod 16; + Item := ResourceList.FindResource(rtString, IntToStr(BlockID)); + if Item <> nil then + Result := (Item as TJclPeResourceStringItem).GetItemIDString(ItemID); +end; + +{ TForm1 } + +procedure TForm1.FormCreate(Sender: TObject); +begin + BorImage := TJclDemoPeBorImage.Create; + OpenDialog1.InitialDir := GetWindowsSystemFolder; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + FreeAndNil(BorImage); +end; + +procedure TForm1.OpenBtnClick(Sender: TObject); +begin + with OpenDialog1 do + begin + FileName := ''; + if Execute then + begin + BorImage.FileName := FileName; +// BorImage.ExportList.SortList(esOrdinal); + UpdateInfo; + end; + end; +end; + +procedure TForm1.UpdateInfo; +const + YesNoText: array [Boolean] of string = ('[NO]', '[YES]'); +begin + ListView1.Items.Count := BorImage.ExportList.Count; + ListView1.Invalidate; + LabelCaptionParam(PeFileLabel, YesNoText[BorImage.IsBorlandImage]); + LabelCaptionParam(PackageLabel, YesNoText[BorImage.IsPackage]); + LabelCaptionParam(FilenameLabel, BorImage.FileName); + if BorImage.IsPackage then + begin + LabelCaptionParam(PackageDescrLabel, BorImage.PackageInfo.Description); + LabelCaptionParam(PackageVerLabel, IntToStr(BorImage.PackageCompilerVersion)); + end + else + begin + LabelCaptionParam(PackageDescrLabel, ''); + LabelCaptionParam(PackageVerLabel, ''); + end; +end; + +procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem); +var + Unmangled, OriginalName, S, SectionName: string; + Descr: TJclBorUmDescription; + Res: TJclBorUmResult; + TI: PTypeInfo; + TD: PTypeData; + ResString: PResStringRec; +begin + with Item do + begin + OriginalName := BorImage.ExportList[Index].Name; + Res := PeBorUnmangleName(OriginalName, Unmangled, Descr); + if Res = urOk then + begin + Caption := Unmangled; + S := Copy(GetEnumName(TypeInfo(TJclBorUmSymbolKind), Integer(Descr.Kind)), 3, 255); + if smQualified in Descr.Modifiers then S := S + ' [Q]'; + if smLinkProc in Descr.Modifiers then S := S + ' [L]'; + SubItems.Add(S); + case Descr.Kind of + skRTTI: + begin + TI := BorImage.ExportList[Index].MappedAddress; + SubItems.Add(Copy(GetEnumName(TypeInfo(TTypeKind), Integer(TI^.Kind)), 3, 255)); + SubItems.Add(TI^.Name); + TD := GetTypeData(TI); + case TI^.Kind of + tkInterface: + SubItems.Add(GUIDToString(TD^.Guid)); + tkMethod: + SubItems.Add(GetEnumName(TypeInfo(TMethodKind), Integer(TD^.MethodKind))); + end; + end; + skData: + begin + SectionName := BorImage.ExportList[Index].SectionName; + SubItems.Add(SectionName); + if (smQualified in Descr.Modifiers) and (SectionName = 'CODE') then + begin // Exported data in CODE section are resourcestrings + ResString := BorImage.ExportList[Index].MappedAddress; + SubItems.Add(Format('ResString ID: %d', [ResString^.Identifier])); + SubItems.Add(TJclDemoPeBorImage(BorImage).ResourceStringValue(ResString^.Identifier)); + end; + end; + end; + end else + begin // Not mangled or Microsoft compiler + PeUnmangleName(OriginalName, Unmangled); + Caption := Unmangled; + SubItems.Add(GetEnumName(TypeInfo(TJclBorUmResult), Integer(Res))); + end; + end; +end; + +class procedure TForm1.LabelCaptionParam(Lbl: TLabel; const StringParam: string); +var + I: Integer; +begin + with Lbl do + begin + I := Pos(':', Caption); + if I = 0 then + Caption := Caption + ': ' + StringParam + else + Caption := Copy(Caption, 1, I) + ' ' + StringParam; + end; +end; + +end. diff --git a/official/1.96/examples/windows/peimage/UnmangleNameExample.dof b/official/1.96/examples/windows/peimage/UnmangleNameExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/peimage/UnmangleNameExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/peimage/UnmangleNameExample.dpr b/official/1.96/examples/windows/peimage/UnmangleNameExample.dpr new file mode 100644 index 0000000..0c9ba97 --- /dev/null +++ b/official/1.96/examples/windows/peimage/UnmangleNameExample.dpr @@ -0,0 +1,13 @@ +program UnmangleNameExample; + +uses + Forms, + UnmangleNameDemoMain in 'UnmangleNameDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/peimage/UnmangleNameExample.res b/official/1.96/examples/windows/peimage/UnmangleNameExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/peimage/UnmangleNameExample.res differ diff --git a/official/1.96/examples/windows/registry/RegistryDemoMain.dfm b/official/1.96/examples/windows/registry/RegistryDemoMain.dfm new file mode 100644 index 0000000..4fd7d38 --- /dev/null +++ b/official/1.96/examples/windows/registry/RegistryDemoMain.dfm @@ -0,0 +1,53 @@ +object Form1: TForm1 + Left = 211 + Top = 136 + Width = 649 + Height = 474 + Caption = 'Form1' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 225 + Top = 0 + Width = 3 + Height = 447 + Cursor = crHSplit + end + object tvKeys: TTreeView + Left = 0 + Top = 0 + Width = 225 + Height = 447 + Align = alLeft + Indent = 19 + TabOrder = 0 + OnChange = tvKeysChange + OnExpanding = tvKeysExpanding + end + object lvValues: TListView + Left = 228 + Top = 0 + Width = 413 + Height = 447 + Align = alClient + Columns = < + item + Caption = 'Name' + Width = 200 + end + item + Caption = 'Value' + Width = 200 + end> + TabOrder = 1 + ViewStyle = vsReport + end +end diff --git a/official/1.96/examples/windows/registry/RegistryDemoMain.pas b/official/1.96/examples/windows/registry/RegistryDemoMain.pas new file mode 100644 index 0000000..8f252cf --- /dev/null +++ b/official/1.96/examples/windows/registry/RegistryDemoMain.pas @@ -0,0 +1,174 @@ +unit RegistryDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, ComCtrls, + JclRegistry, JclStrings; + +type + TForm1 = class(TForm) + tvKeys: TTreeView; + Splitter1: TSplitter; + lvValues: TListView; + procedure tvKeysExpanding(Sender: TObject; Node: TTreeNode; + var AllowExpansion: Boolean); + procedure FormCreate(Sender: TObject); + procedure tvKeysChange(Sender: TObject; Node: TTreeNode); + private + function BuildPath(const Node: TTreeNode): string; + procedure InitTree; + function ExtractRootKey(const FullPath: string): string; + function ExtractKey(const FullPath: string): string; + function AddChildNode(const Node: TTreeNode; const Text: string): TTreeNode; + procedure GetKeyInfos(const Node: TTreeNode; var RootKey: HKEY; + var Key: string); + public + end; + +var + Form1: TForm1; + +implementation + +uses + JclSysUtils; + +{$R *.DFM} + +procedure TForm1.InitTree; +begin + tvKeys.Items.Clear; + with tvKeys.Items.AddChild(nil, 'HKEY_CLASSES_ROOT') do + HasChildren := true; + + with tvKeys.Items.AddChild(nil, 'HKEY_CURRENT_USER') do + HasChildren := true; + + with tvKeys.Items.AddChild(nil, 'HKEY_LOCAL_MACHINE') do + HasChildren := true; + + with tvKeys.Items.AddChild(nil, 'HKEY_USERS') do + HasChildren := true; + +end; + +function TForm1.BuildPath(const Node: TTreeNode): string; +begin + if Node <> nil then + Result := BuildPath(Node.Parent) + Node.Text + '\' + else + Result := ''; +end; + +function TForm1.ExtractRootKey(const FullPath: string): string; +var + strTmp: string; +begin + strTmp := FullPath; + Result := StrToken(strTmp, '\'); +end; + +function TForm1.ExtractKey(const FullPath: string): string; +var + strTmp: string; +begin + strTmp := FullPath; + StrToken(strTmp, '\'); + Result := strTmp; +end; + +procedure TForm1.GetKeyInfos(const Node: TTreeNode; var RootKey: HKEY; var Key: string); +var + strTmp, + strRootKey: string; +begin + strTmp := BuildPath(Node); + strRootKey := ExtractRootKey(strTmp); + + if strRootKey = 'HKEY_CLASSES_ROOT' then + RootKey := HKEY_CLASSES_ROOT; + if strRootKey = 'HKEY_CURRENT_USER' then + RootKey := HKEY_CURRENT_USER; + if strRootKey = 'HKEY_LOCAL_MACHINE' then + RootKey := HKEY_LOCAL_MACHINE; + if strRootKey = 'HKEY_USERS' then + RootKey := HKEY_USERS; + + Key:= ExtractKey(strTmp); +end; + +procedure TForm1.tvKeysExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); +var + strTmp, + Key: string; + RootKey: HKEY; + stlSubKeys: TStrings; + i: Integer; + NewNode: TTreeNode; +begin + GetKeyInfos(Node, RootKey, Key); + + stlSubKeys := TStringList.Create; + RegGetKeyNames(RootKey, Key, stlSubKeys); + + for i := 0 to stlSubKeys.Count - 1 do begin + strTmp := stlSubKeys[i]; + NewNode := AddChildNode(Node, strTmp); + if NewNode <> nil then + NewNode.HasChildren := RegHasSubKeys(RootKey, Key + strTmp); + end; + + stlSubKeys.Free; + +end; + +function TForm1.AddChildNode(const Node: TTreeNode; const Text: string): TTreeNode; +var + i: integer; + DoesExist: boolean; +begin + DoesExist := false; + Result := nil; + + for i := 0 to Node.Count - 1 do + if Node.Item[i].Text = Text then begin + DoesExist := true; + break; + end; + + if not DoesExist then + Result := tvKeys.Items.AddChild(Node, Text); +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + InitTree; +end; + +procedure TForm1.tvKeysChange(Sender: TObject; Node: TTreeNode); +var + strTmp, + Key: string; + RootKey: HKEY; + stlValueNames: TStrings; + i: integer; +begin + lvValues.Items.Clear; + GetKeyInfos(Node, RootKey, Key); + + stlValueNames := TStringList.Create; + if RegGetValueNames(RootKey, Key, stlValueNames) then begin + for i := 0 to stlValueNames.Count - 1 do begin + strTmp := stlValueNames[i]; + with lvValues.Items.Add do begin + Caption := strTmp; + SubItems.Add(RegReadString(RootKey, Key, strTmp)); + end; + end; + end; + +end; + +end. diff --git a/official/1.96/examples/windows/registry/RegistryExample.dof b/official/1.96/examples/windows/registry/RegistryExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/registry/RegistryExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/registry/RegistryExample.dpr b/official/1.96/examples/windows/registry/RegistryExample.dpr new file mode 100644 index 0000000..88510c0 --- /dev/null +++ b/official/1.96/examples/windows/registry/RegistryExample.dpr @@ -0,0 +1,13 @@ +program RegistryExample; + +uses + Forms, + RegistryDemoMain in 'RegistryDemoMain.pas' {Form1}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/official/1.96/examples/windows/registry/RegistryExample.res b/official/1.96/examples/windows/registry/RegistryExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/registry/RegistryExample.res differ diff --git a/official/1.96/examples/windows/structstorage/HexDump.pas b/official/1.96/examples/windows/structstorage/HexDump.pas new file mode 100644 index 0000000..0332e01 --- /dev/null +++ b/official/1.96/examples/windows/structstorage/HexDump.pas @@ -0,0 +1,535 @@ +unit HexDump; + +interface + +uses + SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls; + +const + MAXDIGITS = 16; + +{ THexDump } + +type + + THexStr = array[0..2] of Char; + THexStrArray = array[0..MAXDIGITS-1] of THexStr; + + THexDump = class(TCustomControl) + private + FActive: Boolean; + FAddress: Pointer; + FDataSize: Integer; + FTopLine: Integer; + FCurrentLine: Integer; + FVisibleLines: Integer; + FLineCount: Integer; + FBytesPerLine: Integer; + FItemHeight: Integer; + FItemWidth: Integer; + FFileColors: array[0..2] of TColor; + FShowCharacters: Boolean; + FShowAddress: Boolean; + FBorder: TBorderStyle; + FHexData: THexStrArray; + FLineAddr: array[0..15] of char; + FStream:TMemoryStream; + + procedure CalcPaintParams; + procedure SetTopLine(Value: Integer); + procedure SetCurrentLine(Value: Integer); + procedure SetFileColor(Index: Integer; Value: TColor); + function GetFileColor(Index: Integer): TColor; + procedure SetShowCharacters(Value: Boolean); + procedure SetShowAddress(Value: Boolean); + procedure SetBorder(Value: TBorderStyle); + procedure SetAddress(Value: Pointer); + procedure SetDataSize(Value: Integer); + procedure AdjustScrollBars; + function LineAddr(Index: Integer): PChar; + function LineData(Index: Integer): PChar; + function LineChars(Index: Integer): PChar; + function ScrollIntoView: Boolean; + procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; + procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER; + procedure CMExit(var Message: TCMLostFocus); message CM_EXIT; + procedure WMSize(var Message: TWMSize); message WM_SIZE; + procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; + procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; + protected + procedure CreateParams(var Params: TCreateParams); override; + procedure Paint; override; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property CurrentLine: Integer read FCurrentLine write SetCurrentLine; + procedure LoadFromStream(Stream:TStream); + procedure Clear; + property Address: Pointer read FAddress write SetAddress; + property DataSize: Integer read FDataSize write SetDataSize; + published + property Align; + + property Border: TBorderStyle read FBorder write SetBorder; + property Color default clWhite; + property Ctl3D; + property Font; + property TabOrder; + property TabStop; + property ShowAddress: Boolean read FShowAddress write SetShowAddress default True; + property ShowCharacters: Boolean read FShowCharacters write SetShowCharacters default True; + property AddressColor: TColor index 0 read GetFileColor write SetFileColor default clBlack; + property HexDataColor: TColor index 1 read GetFileColor write SetFileColor default clBlack; + property AnsiCharColor: TColor index 2 read GetFileColor write SetFileColor default clBlack; + end; + +function CreateHexDump(AOwner: TWinControl): THexDump; + +implementation + +{ Form Methods } + +function CreateHexDump(AOwner: TWinControl): THexDump; +begin + Result := THexDump.Create(AOwner); + with Result do + begin + Parent := AOwner; + Font.Name := 'FixedSys'; + ShowCharacters := True; + Align := alClient; + end; +end; + +{ THexDump } + +constructor THexDump.Create(AOwner: TComponent); +begin + inherited Create(AOwner); +// ControlStyle := [csFramed]; + Ctl3D := true; + FBorder := bsSingle; + Color := clWhite; + FShowAddress := True; + FShowCharacters := True; + Width := 300; + Height := 200; + FillChar(FHexData, SizeOf(FHexData), #9); +end; + +destructor THexDump.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure THexDump.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + with Params do + begin + ExStyle := ExStyle and not WS_EX_CONTROLPARENT; + if (FBorder = bsSingle) then + begin + Style := Style and not WS_BORDER; + ExStyle := ExStyle or WS_EX_CLIENTEDGE; + end; + Style := Style or WS_VSCROLL; + end; +end; + +{ VCL Command Messages } + +procedure THexDump.CMFontChanged(var Message: TMessage); +begin + inherited; + Canvas.Font := Self.Font; + FItemHeight := Canvas.TextHeight('A') + 2; + FItemWidth := Canvas.TextWidth('D') + 1; + CalcPaintParams; + AdjustScrollBars; +end; + +procedure THexDump.CMEnter; +begin + inherited; +{ InvalidateLineMarker; } +end; + +procedure THexDump.CMExit; +begin + inherited; +{ InvalidateLineMarker; } +end; + +{ Windows Messages } + +procedure THexDump.WMSize(var Message: TWMSize); +begin + inherited; + CalcPaintParams; + AdjustScrollBars; +end; + +procedure THexDump.WMGetDlgCode(var Message: TWMGetDlgCode); +begin + Message.Result := DLGC_WANTARROWS; +end; + +procedure THexDump.WMVScroll(var Message: TWMVScroll); +var + NewTopLine: Integer; + LinesMoved: Integer; + R: TRect; +begin + inherited; + NewTopLine := FTopLine; + case Message.ScrollCode of + SB_LINEDOWN: Inc(NewTopLine); + SB_LINEUP: Dec(NewTopLine); + SB_PAGEDOWN: Inc(NewTopLine, FVisibleLines - 1); + SB_PAGEUP: Dec(NewTopLine, FVisibleLines - 1); + SB_THUMBPOSITION, SB_THUMBTRACK: NewTopLine := Message.Pos; + end; + + if NewTopLine < 0 then NewTopLine := 0; + if NewTopLine >= FLineCount then + NewTopLine := FLineCount - 1; + + if NewTopLine <> FTopLine then + begin + LinesMoved := FTopLine - NewTopLine; + FTopLine := NewTopLine; + SetScrollPos(Handle, SB_VERT, FTopLine, True); + + if Abs(LinesMoved) = 1 then + begin + R := Bounds(0, 0, ClientWidth, ClientHeight - FItemHeight); + if LinesMoved = 1 then OffsetRect(R, 0, FItemHeight); + + ScrollWindow(Handle, 0, FItemHeight * LinesMoved, @R, nil); + + if LinesMoved = -1 then + begin + R.Top := ClientHeight - FItemHeight; + R.Bottom := ClientHeight; + end + else + begin + R.Top := 0; + R.Bottom := FItemHeight; + end; + + Windows.InvalidateRect(Handle, @R, False); + + end + else Invalidate; + end; +end; + +{ Painting Related } + +procedure THexDump.CalcPaintParams; +const + Divisor: array[boolean] of Integer = (3,4); +var + CharsPerLine: Integer; + +begin + if FItemHeight < 1 then Exit; + FVisibleLines := (ClientHeight div FItemHeight) + 1; + CharsPerLine := ClientWidth div FItemWidth; + if FShowAddress then Dec(CharsPerLine, 10); + FBytesPerLine := CharsPerLine div Divisor[FShowCharacters]; + if FBytesPerLine < 1 then + FBytesPerLine := 1 + else if FBytesPerLine > MAXDIGITS then + FBytesPerLine := MAXDIGITS; + FLineCount := (DataSize div FBytesPerLine); + if Boolean(DataSize mod FBytesPerLine) then Inc(FLineCount); +end; + +procedure THexDump.AdjustScrollBars; +begin + SetScrollRange(Handle, SB_VERT, 0, FLineCount - 1, True); +end; + +function THexDump.ScrollIntoView: Boolean; +begin + Result := False; + if FCurrentLine < FTopLine then + begin + Result := True; + SetTopLine(FCurrentLine); + end + else if FCurrentLine >= (FTopLine + FVisibleLines) - 1 then + begin + SetTopLine(FCurrentLine - (FVisibleLines - 2)); + Result := True; + end; +end; + +procedure THexDump.SetTopLine(Value: Integer); +var + LinesMoved: Integer; + R: TRect; +begin + if Value <> FTopLine then + begin + if Value < 0 then Value := 0; + if Value >= FLineCount then Value := FLineCount - 1; + + LinesMoved := FTopLine - Value; + FTopLine := Value; + SetScrollPos(Handle, SB_VERT, FTopLine, True); + + if Abs(LinesMoved) = 1 then + begin + R := Bounds(1, 0, ClientWidth, ClientHeight - FItemHeight); + if LinesMoved = 1 then OffsetRect(R, 0, FItemHeight); + + ScrollWindow(Handle, 0, FItemHeight * LinesMoved, @R, nil); + + if LinesMoved = -1 then + begin + R.Top := ClientHeight - FItemHeight; + R.Bottom := ClientHeight; + end + else + begin + R.Top := 0; + R.Bottom := FItemHeight; + end; + + InvalidateRect(Handle, @R, False); + + end + else Invalidate; + end; +end; + +procedure THexDump.SetCurrentLine(Value: Integer); +var + R: TRect; +begin + if Value <> FCurrentLine then + begin + if Value < 0 then Value := 0; + if Value >= FLineCount then Value := FLineCount - 1; + + if (FCurrentLine >= FTopLine) and (FCurrentLine < FTopLine + FVisibleLines - 1) then + begin + R := Bounds(0, 0, 1, FItemHeight); + OffsetRect(R, 0, (FCurrentLine - FTopLine) * FItemHeight); + Windows.InvalidateRect(Handle, @R, True); + end; + FCurrentLine := Value; + + R := Bounds(0, 0, 1, FItemHeight); + OffsetRect(R, 0, (FCurrentLine - FTopLine) * FItemHeight); + Windows.InvalidateRect(Handle, @R, True); + ScrollIntoView; + end; +end; + +procedure THexDump.Paint; +var + R: TRect; + I: Integer; + AddressWidth: Integer; + TabStop: Integer; + ByteCnt: Integer; +begin +// inherited Paint; + Canvas.Brush.Color := Self.Color; + Canvas.FillRect(ClientRect); + if FShowAddress then + AddressWidth := FItemWidth*10 + else + AddressWidth := 0; + R := Bounds(1, 0, ClientWidth, FItemHeight); + TabStop := FItemWidth*3; + Canvas.Font.Color := FFileColors[1]; + ByteCnt := FBytesPerLine; + for I := 0 to FVisibleLines - 1 do + begin + R.Left := 1; + if I + FTopLine < FLineCount then + begin + if FShowAddress then + begin + Canvas.Font.Color := FFileColors[0]; + R.Right := R.Left + AddressWidth; + ExtTextOut(Canvas.Handle, R.Left, R.Top, ETO_OPAQUE or ETO_CLIPPED, @R, LineAddr(I+FTopLine), 9, nil); + R.Left := R.Right; + R.Right := ClientWidth; + Canvas.Font.Color := FFileColors[1]; + end; + if (I+FTopLine = FLineCount-1) and ((DataSize mod FBytesPerLine) > 0) then + ByteCnt := DataSize mod FBytesPerLine; + TabbedTextOut(Canvas.Handle, R.Left, R.Top, LineData(I+FTopLine), + (ByteCnt*3)-1, 1, TabStop, R.Left); + if FShowCharacters then + begin + R.Left := AddressWidth+(FItemWidth*(FBytesPerLine*3)); + Canvas.Font.Color := FFileColors[2]; + ExtTextOut(Canvas.Handle, R.Left, R.Top, ETO_OPAQUE or ETO_CLIPPED, @R, LineChars(I+FTopLine), ByteCnt, nil); + end; + end + else ExtTextOut(Canvas.Handle, R.Left, R.Top, ETO_OPAQUE or ETO_CLIPPED, + @R, nil, 0, nil); + OffsetRect(R, 0, FItemHeight); + end; +end; + +{ Event Overrides } + +procedure THexDump.KeyDown(var Key: Word; Shift: TShiftState); +begin + inherited KeyDown(Key, Shift); + if not FActive then Exit; + + case Key of + VK_DOWN: CurrentLine := CurrentLine + 1; + VK_UP: CurrentLine := CurrentLine - 1; + VK_NEXT: CurrentLine := CurrentLine + FVisibleLines; + VK_PRIOR: CurrentLine := CurrentLine - FVisibleLines; + VK_HOME: CurrentLine := 0; + VK_END: CurrentLine := FLineCount - 1; + end; +end; + +procedure THexDump.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited MouseDown(Button, Shift, X, Y); + if not Focused then SetFocus; + if (Button = mbLeft) and FActive then + CurrentLine := FTopLine + (Y div FItemHeight); +end; + +{ Property Set/Get Routines } + +procedure THexDump.SetBorder(Value: TBorderStyle); +begin + if Value <> FBorder then + begin + FBorder := Value; + RecreateWnd; + end; +end; + +procedure THexDump.SetShowAddress(Value: Boolean); +begin + if FShowAddress <> Value then + begin + FShowAddress := Value; + Invalidate; + end; +end; + +procedure THexDump.SetShowCharacters(Value: Boolean); +begin + if Value <> FShowCharacters then + begin + FShowCharacters := Value; + Invalidate; + end; +end; + +procedure THexDump.SetFileColor(Index: Integer; Value: TColor); +begin + if FFileColors[Index] <> Value then + begin + FFileColors[Index] := Value; + Invalidate; + end; +end; + +function THexDump.GetFileColor(Index: Integer): TColor; +begin + Result := FFileColors[Index]; +end; + +procedure THexDump.SetAddress(Value: Pointer); +begin + FActive := Value <> nil; + FAddress := Value; + Invalidate; +end; + +procedure THexDump.SetDataSize(Value: Integer); +begin + FDataSize := Value; + CalcPaintParams; + Invalidate; + AdjustScrollBars; +end; + +function THexDump.LineAddr(Index: Integer): PChar; +begin + Result := StrFmt(FLineAddr, '%p:', [Pointer(PChar(Address)+Index*FBytesPerLine)]); +end; + +function THexDump.LineData(Index: Integer): PChar; + + procedure SetData(P: PChar); + const + HexDigits : array[0..15] of Char = '0123456789ABCDEF'; + var + I: Integer; + B: Byte; + begin + for I := 0 to FBytesPerLine-1 do + begin + try + B := Byte(P[I]); + FHexData[I][0] := HexDigits[B SHR $04]; + FHexData[I][1] := HexDigits[B AND $0F]; + except + FHexData[I][0] := '?'; + FHexData[I][1] := '?'; + end; + + end; + end; + +begin + SetData(PChar(FAddress) + Index*FBytesPerLine); + Result := FHexData[0]; +end; + +function THexDump.LineChars(Index: Integer): PChar; +begin + Result := PChar(FAddress) + Index*FBytesPerLine; +end; + +procedure THexDump.LoadFromStream(Stream: TStream); +begin + Clear; + if Stream <> nil then + begin + FStream := TMemoryStream.Create; + FStream.CopyFrom(Stream,0); + Address := FStream.Memory; + DataSize := FStream.Size; + end; +end; + +procedure THexDump.Clear; +begin + if Parent <> nil then + begin + FVisibleLines := 0; + SetTopLine(0); + SetCurrentLine(0); + Address := nil; + DataSize := 0; + end; + FreeAndNil(FStream); +end; + +end. diff --git a/official/1.96/examples/windows/structstorage/PropsFrm.dfm b/official/1.96/examples/windows/structstorage/PropsFrm.dfm new file mode 100644 index 0000000..a8ab5a3 --- /dev/null +++ b/official/1.96/examples/windows/structstorage/PropsFrm.dfm @@ -0,0 +1,221 @@ +object frmProps: TfrmProps + Left = 798 + Top = 376 + Width = 339 + Height = 385 + BorderIcons = [biSystemMenu] + Caption = 'Properties' + Color = clBtnFace + Constraints.MaxHeight = 385 + Constraints.MaxWidth = 600 + Constraints.MinHeight = 385 + Constraints.MinWidth = 290 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poMainFormCenter + ShowHint = True + PixelsPerInch = 96 + TextHeight = 13 + object TabControl1: TTabControl + Left = 5 + Top = 4 + Width = 321 + Height = 309 + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 0 + Tabs.Strings = ( + 'General') + TabIndex = 0 + object Label1: TLabel + Left = 12 + Top = 32 + Width = 35 + Height = 13 + Caption = 'Name:' + FocusControl = edName + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [fsBold] + ParentFont = False + end + object Label2: TLabel + Left = 12 + Top = 103 + Width = 26 + Height = 13 + Caption = 'Size:' + FocusControl = edSize + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [fsBold] + ParentFont = False + end + object Label3: TLabel + Left = 12 + Top = 139 + Width = 48 + Height = 13 + Caption = 'Created:' + FocusControl = edCreated + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [fsBold] + ParentFont = False + end + object Label4: TLabel + Left = 12 + Top = 175 + Width = 51 + Height = 13 + Caption = 'Modified:' + FocusControl = edModified + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [fsBold] + ParentFont = False + end + object Label5: TLabel + Left = 12 + Top = 211 + Width = 69 + Height = 13 + Caption = 'Last Access:' + FocusControl = edAccessed + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [fsBold] + ParentFont = False + end + object Label6: TLabel + Left = 12 + Top = 67 + Width = 31 + Height = 13 + Caption = 'Type:' + FocusControl = edType + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [fsBold] + ParentFont = False + end + object Label7: TLabel + Left = 12 + Top = 247 + Width = 36 + Height = 13 + Caption = 'CLSID:' + FocusControl = edCLSID + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [fsBold] + ParentFont = False + end + object edName: TEdit + Left = 26 + Top = 47 + Width = 279 + Height = 21 + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + ParentColor = True + ReadOnly = True + TabOrder = 0 + end + object edSize: TEdit + Left = 26 + Top = 118 + Width = 279 + Height = 21 + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + ParentColor = True + ReadOnly = True + TabOrder = 2 + end + object edCreated: TEdit + Left = 26 + Top = 154 + Width = 279 + Height = 21 + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + ParentColor = True + ReadOnly = True + TabOrder = 3 + end + object edModified: TEdit + Left = 26 + Top = 190 + Width = 279 + Height = 21 + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + ParentColor = True + ReadOnly = True + TabOrder = 4 + end + object edAccessed: TEdit + Left = 26 + Top = 226 + Width = 279 + Height = 21 + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + ParentColor = True + ReadOnly = True + TabOrder = 5 + end + object edType: TEdit + Left = 26 + Top = 82 + Width = 279 + Height = 21 + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + ParentColor = True + ReadOnly = True + TabOrder = 1 + end + object edCLSID: TEdit + Left = 26 + Top = 262 + Width = 279 + Height = 21 + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + ParentColor = True + ReadOnly = True + TabOrder = 6 + end + end + object btnClose: TButton + Left = 239 + Top = 323 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Cancel = True + Caption = '&Close' + Default = True + ModalResult = 7 + TabOrder = 1 + end +end diff --git a/official/1.96/examples/windows/structstorage/PropsFrm.pas b/official/1.96/examples/windows/structstorage/PropsFrm.pas new file mode 100644 index 0000000..ef7029c --- /dev/null +++ b/official/1.96/examples/windows/structstorage/PropsFrm.pas @@ -0,0 +1,186 @@ +{----------------------------------------------------------------------------- +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/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: PropsFrm.PAS, released on 2002-12-29. + +The Initial Developer of the Original Code is Peter Thörnqvist [peter3@peter3.com] +Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist. +All Rights Reserved. + +Contributor(s): + +Last Modified: $Date: 2005/10/17 13:35:15 $ + +You may retrieve the latest version of this file at the Project JEDI's Code Library home page, +located at http://jcl.sourceforge.net + +Description: +Displays statistics for a TStatStg record + +-----------------------------------------------------------------------------} + +unit PropsFrm; + +{$I jcl.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, ActiveX, StdCtrls, ComCtrls; + +type + TfrmProps = class(TForm) + TabControl1: TTabControl; + btnClose: TButton; + Label1: TLabel; + edName: TEdit; + Label2: TLabel; + edSize: TEdit; + Label3: TLabel; + edCreated: TEdit; + Label4: TLabel; + edModified: TEdit; + Label5: TLabel; + edAccessed: TEdit; + Label6: TLabel; + edType: TEdit; + Label7: TLabel; + edCLSID: TEdit; + private + { Private declarations } + public + { Public declarations } + class procedure ShowProperties(Stat: TStatStg); + end; + +resourcestring + SError = 'Error'; + SConfirm = 'Confirm'; + SRoot = 'Document Root'; + SConfirmConversion = 'Confirm Conversion'; + SConvertFilePrompt = 'This file doesn''t appear to be a compound file. Would you like to convert it?'; + SConvertSuccess = 'File was converted succesfully.'; + SConvertFailFmt = 'Unable to convert file:'#13#10'%s'; + SBytesFloatFmt = '%0.n bytes'; + SConfirmSaveChanges = 'Do you want to save your changes?'; + + SAddFolder = 'Add Folder'; + SFolderNameLabel = '&Name:'; + SErrNameEmpty = 'Name cannot be empty'; + SErrNameDuplicate = 'There is already an item with that name. Use another name.'; + SAddFile = 'Add File'; + SFileNameLabel = '&Name:'; + SDeletePrompt = 'Delete selected item?'; + SErrNodeEdit = 'Cannot edit this node!'; + SErrNodeRename = 'Cannot rename node!'; + + SAboutMsg = 'Demo for JCL Structured Storage Class Wrapper.'#13#10#13#10 + + 'Note that all changes made to files with this program will be committed'#13#10 + + 'directly (unless running in Transacted mode) and cannot be undone'#13#10 + + ' - use backup data for testing!'#13#10#13#10 + + 'The latest version of JCL is always available at http://jcl.sourceforge.net'; + SAboutCaption = 'About Compound Document Editor...'; + SStorage = 'Storage'; + SStream = 'Stream'; + SLockBytes = 'Lock bytes'; + SProperty = 'Property'; + SUnknown = 'unknown'; + SNotSet = '(not set)'; + +implementation +uses + JclDateTime +{$IFNDEF COMPILER6_UP} + , ComObj +{$ENDIF} + ; + +{$R *.dfm} + +{ TfrmProps } + +function StgTypeToStr(dwType: integer): string; +begin + case dwType of + STGTY_STORAGE: + Result := SStorage; + STGTY_STREAM: + Result := SStream; + STGTY_LOCKBYTES: + Result := SLockBytes; + STGTY_PROPERTY: + Result := SProperty; + else + Result := SUnknown; + end; +end; + +function LimitedDateTimeToStr(ADateTime: TDateTime): string; +begin + if ADateTime > EncodeDate(1900, 01, 01) then + Result := DateTimeToStr(ADateTime) + else + Result := SNotSet; +end; + +function MyGUIDToString(GUID: TGUID): string; +var EmptyGUID: TGUID; +begin + FillChar(EmptyGUID, sizeof(EmptyGUID), 0); + if CompareMem(@GUID, @EmptyGUID, sizeof(GUID)) then + Result := SNotSet + else + Result := GUIDToString(GUID); +end; + +class procedure TfrmProps.ShowProperties(Stat: TStatStg); +var + frmProps: TfrmProps; + i: integer; + nSize: double; +begin + frmProps := self.Create(Application); + with frmProps, Stat do + try + edName.Text := WideCharToString(pwcsName); + + edType.Text := StgTypeToStr(dwType); + nSize := cbSize; + edSize.Text := Format(SBytesFloatFmt, [nSize]); + edCreated.Text := LimitedDateTimeToStr(FileTimeToLocalDateTime(ctime)); + edModified.Text := LimitedDateTimeToStr(FileTimeToLocalDateTime(mtime)); + edAccessed.Text := LimitedDateTimeToStr(FileTimeToLocalDateTime(atime)); + edCLSID.Text := MyGUIDToString(clsid); + for i := 0 to ComponentCount - 1 do + if Components[i] is TEdit then + TEdit(Components[i]).Hint := TEdit(Components[i]).Text; + ShowModal; + finally + Free; + end; +end; + +// History: + +// $Log: PropsFrm.pas,v $ +// Revision 1.1 2005/10/17 13:35:15 rrossmair +// - moved over from examples\vcl\* +// +// Revision 1.2 2004/10/02 05:47:27 marquardt +// added check for incompatible jedi.inc +// replaced jedi.inc with jvcl.inc +// +// Revision 1.1 2004/06/12 03:44:00 rrossmair +// structured storage demo initial check-in; adapted for JCL +// + +end. + diff --git a/official/1.96/examples/windows/structstorage/StructStorageExample.dof b/official/1.96/examples/windows/structstorage/StructStorageExample.dof new file mode 100644 index 0000000..abe45c2 --- /dev/null +++ b/official/1.96/examples/windows/structstorage/StructStorageExample.dof @@ -0,0 +1,2 @@ +[Directories] +OutputDir=..\..\..\bin diff --git a/official/1.96/examples/windows/structstorage/StructStorageExample.dpr b/official/1.96/examples/windows/structstorage/StructStorageExample.dpr new file mode 100644 index 0000000..aa81f4c --- /dev/null +++ b/official/1.96/examples/windows/structstorage/StructStorageExample.dpr @@ -0,0 +1,15 @@ +program StructStorageExample; + +uses + Forms, + StructStorageExampleMain in 'StructStorageExampleMain.pas' {frmMain}, + PropsFrm in 'PropsFrm.pas' {frmProps}; + +{$R *.RES} + +begin + Application.Initialize; + Application.Title := 'Compound Document Editor'; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/official/1.96/examples/windows/structstorage/StructStorageExample.res b/official/1.96/examples/windows/structstorage/StructStorageExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/structstorage/StructStorageExample.res differ diff --git a/official/1.96/examples/windows/structstorage/StructStorageExampleMain.dfm b/official/1.96/examples/windows/structstorage/StructStorageExampleMain.dfm new file mode 100644 index 0000000..b607ce6 --- /dev/null +++ b/official/1.96/examples/windows/structstorage/StructStorageExampleMain.dfm @@ -0,0 +1,548 @@ +object frmMain: TfrmMain + Left = 388 + Top = 230 + Width = 463 + Height = 295 + Caption = 'Compound Document Editor' + Color = clBtnFace + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Menu = mmMain + OldCreateOrder = True + Position = poScreenCenter + OnCreate = FormCreate + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 162 + Top = 0 + Width = 5 + Height = 230 + Cursor = crHSplit + AutoSnap = False + MinSize = 100 + ResizeStyle = rsUpdate + end + object tvDocInfo: TTreeView + Left = 0 + Top = 0 + Width = 162 + Height = 230 + Align = alLeft + ChangeDelay = 60 + HideSelection = False + Images = il16 + Indent = 19 + PopupMenu = popTreeView + TabOrder = 0 + ToolTips = False + OnChange = tvDocInfoChange + OnCollapsed = tvDocInfoCollapsed + OnDblClick = tvDocInfoDblClick + OnDeletion = tvDocInfoDeletion + OnEdited = tvDocInfoEdited + OnEditing = tvDocInfoEditing + OnExpanded = tvDocInfoExpanded + end + object StatusBar1: TStatusBar + Left = 0 + Top = 230 + Width = 455 + Height = 19 + Panels = < + item + Width = 400 + end + item + Width = 90 + end> + SimplePanel = False + end + object reDetails: TRichEdit + Left = 167 + Top = 0 + Width = 288 + Height = 230 + Align = alClient + PlainText = True + ScrollBars = ssBoth + TabOrder = 2 + WantTabs = True + WordWrap = False + end + object mmMain: TMainMenu + Left = 24 + Top = 72 + object File1: TMenuItem + Caption = 'File' + object New1: TMenuItem + Action = acNew + end + object Open1: TMenuItem + Action = acOpen + end + object Save1: TMenuItem + Action = acSave + end + object SaveAs1: TMenuItem + Action = acSaveAs + end + object N8: TMenuItem + Caption = '-' + end + object ransacted1: TMenuItem + Action = acTransacted + end + object N1: TMenuItem + Caption = '-' + end + object Properties1: TMenuItem + Action = acProperties + end + object N9: TMenuItem + Caption = '-' + end + object Exit1: TMenuItem + Action = acExit + end + end + object Edit1: TMenuItem + Caption = 'Edit' + object Undo1: TMenuItem + Action = acUndo + end + object N4: TMenuItem + Caption = '-' + end + object Cut1: TMenuItem + Action = acCut + end + object Copy1: TMenuItem + Action = acCopy + end + object Paste1: TMenuItem + Action = acPaste + end + object N5: TMenuItem + Caption = '-' + end + object Editstream1: TMenuItem + Action = acEditData + end + object Savechanges1: TMenuItem + Action = acSaveData + end + end + object Actions1: TMenuItem + Caption = 'Actions' + object Addfolder1: TMenuItem + Action = acAddFolder + end + object Addfile1: TMenuItem + Action = acAddFile + end + object N2: TMenuItem + Caption = '-' + end + object Rename1: TMenuItem + Action = acRename + end + object Delete1: TMenuItem + Action = acDelete + end + object N10: TMenuItem + Caption = '-' + end + object Refresh1: TMenuItem + Action = acRefresh + end + end + object Help1: TMenuItem + Caption = 'Help' + object About1: TMenuItem + Action = acAbout + end + end + end + object OpenDialog: TOpenDialog + Filter = + 'Compound files|*.doc;*.xls;*.ppt;*.mpp;*.mdb;*.dot|All Files (*.' + + '*)|*.*' + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing] + Title = 'Open Compound File' + Left = 24 + Top = 16 + end + object il16: TImageList + Left = 24 + Top = 136 + Bitmap = { + 494C010104000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000003000000001001000000000000018 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000104200000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000104218631863186318631863 + 1042007C007CFF7F007C007C0000000000000000104210421042104210421042 + 1042104210421042104210421042104200000000000010421042104210421042 + 1042104210421042104210421042104200000000000000000000000000000000 + 00000000000000000000000000000000000000001042FF7FFF7FFF7FFF7F1042 + 007C007CFF7FFF7FFF7F007C007C0000000000001042FF7FE07F1863E07F1863 + E07F1863E07F1863E07F1863E07F10420000000000001042FF7F1863E07F1863 + E07F1863E07F1863E07FE07F1042000000000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7FFF7FFF7FFF7F00000000000000001042FF7FFF7FFF7F1042007C + 007C007C007CFF7F007C007C007C007C000000001042FF7F1863E07F1863E07F + 1863E07F1863E07F1863E07F18631042000000001042FF7F1863E07F1863E07F + 1863E07F1863E07F1863E07F0000104200000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7FFF7FFF7FFF7F00000000000000001042FF7FFF7FFF7F1042007C + 007C007C007C007C007C007C007C007C000000001042FF7FE07F1863E07F1863 + E07F1863E07F1863E07F1863E07F1042000000001042FF7FE07F1863E07F1863 + E07F1863E07F1863E07F18630000104200000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7FFF7FFF7FFF7F00000000000000001042FF7FFF7FFF7F1042007C + 007C007C007CFF7F007C007C007C007C000000001042FF7F1863E07F1863E07F + 1863E07F1863E07F1863E07F1863104200001042FF7FE07F1863E07F1863E07F + 1863E07F1863E07FE07F00001042104200000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7FFF7FFF7FFF7F00000000000000001042FF7FFF7FFF7F1042007C + 007C007CFF7FFF7FFF7F007C007C007C000000001042FF7FE07F1863E07F1863 + E07F1863E07F1863E07F1863E07F104200001042FF7FFF7FFF7FFF7FFF7FFF7F + FF7FFF7FFF7FFF7F104210421863104200000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7FFF7FFF7FFF7F00000000000000001042FF7FFF7FFF7F1042007C + 007C007CFF7FFF7FFF7F007C007C007C000000001042FF7F1863E07F1863E07F + 1863E07F1863E07F1863E07F1863104200001042104210421042104210421042 + 104210421042104210421042E07F104200000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7FFF7FFF7FFF7F00000000000000001042FF7FFF7FFF7FFF7F1042 + 007C007CFF7FFF7FFF7F007C007C0000000000001042FF7FE07F1863E07F1863 + E07F1863E07F1863E07F1863E07F1042000000001042FF7FE07F1863E07F1863 + E07F1863E07F1863E07F1863E07F104200000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7FFF7FFF7FFF7F00000000000000001042FF7FFF7FFF7FFF7FFF7F + 1042007C007C007C007C007C00000000000000001042FF7FFF7FFF7FFF7FFF7F + FF7FFF7FFF7FFF7FFF7FFF7FFF7F1042000000001042FF7F1863E07F1863E07F + 1863FF7FFF7FFF7FFF7FFF7FFF7F104200000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7FFF7FFF7FFF7F00000000000000001042FF7FFF7FFF7FFF7FFF7F + FF7F1042104210421042104200000000000000001042E07F1863E07F1863E07F + 1863E07F104210421042104210421042000000001042FF7FE07F1863E07F1863 + E07FFF7F10421042104210421042104200000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7F00000000000000000000000000001042FF7FFF7FFF7FFF7FFF7F + FF7FFF7F10421863FF7F1863000000000000000000001042E07F1863E07F1863 + E07F10420000000000000000000000000000000000001042FF7FFF7FFF7FFF7F + FF7F104200000000000000000000000000000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7F0000FF7F000000000000000000001042FF7FFF7FFF7FFF7FFF7F + FF7FFF7F1042FF7F186300000000000000000000000000001042104210421042 + 1042000000000000000000000000000000000000000000001042104210421042 + 1042000000000000000000000000000000000000000000000000FF7FFF7FFF7F + FF7FFF7FFF7F00000000000000000000000000001042FF7FFF7FFF7FFF7FFF7F + FF7FFF7F10421863000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000001042FF7FFF7FFF7FFF7FFF7F + FF7FFF7F10420000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000104210421042104210421042 + 104210421042000000000000000000000000424D3E000000000000003E000000 + 2800000040000000300000000100010000000000800100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFFFFFFFFFF8001C000E000FFFF8001 + 8000C000E00380018000C000E003800080008000E003800080008000E0038000 + 80000000E003800080000000E003800080000000E003800180008000E0038001 + 80008000E003800180018001E0038003C07FC07FE0078007E0FFE0FFE00F800F + FFFFFFFFE01F801FFFFFFFFFFFFF803F00000000000000000000000000000000 + 000000000000} + end + object alMain: TActionList + OnUpdate = alMainUpdate + Left = 96 + Top = 136 + object acOpen: TAction + Category = 'File' + Caption = 'Open...' + ShortCut = 16463 + OnExecute = acOpenExecute + end + object acExit: TAction + Category = 'File' + Caption = 'Exit' + ShortCut = 32883 + OnExecute = acExitExecute + end + object acAddFolder: TAction + Category = 'Actions' + Caption = 'Add Folder...' + ShortCut = 45 + OnExecute = acAddFolderExecute + end + object acAddFile: TAction + Category = 'Actions' + Caption = 'Add File...' + ShortCut = 16429 + OnExecute = acAddFileExecute + end + object acDelete: TAction + Category = 'Actions' + Caption = 'Delete...' + ShortCut = 16430 + OnExecute = acDeleteExecute + end + object acAbout: TAction + Category = 'Help' + Caption = 'About...' + OnExecute = acAboutExecute + end + object acEditData: TAction + Category = 'Edit' + Caption = 'Edit Data' + ShortCut = 16453 + OnExecute = acEditDataExecute + end + object acSaveData: TAction + Category = 'Edit' + Caption = 'Save Edits' + ShortCut = 24659 + OnExecute = acSaveDataExecute + end + object acCut: TEditCut + Category = 'Edit' + Caption = 'Cut' + ImageIndex = 0 + ShortCut = 16472 + end + object acCopy: TEditCopy + Category = 'Edit' + Caption = 'Copy' + ImageIndex = 1 + ShortCut = 16451 + end + object acPaste: TEditPaste + Category = 'Edit' + Caption = 'Paste' + ImageIndex = 2 + ShortCut = 16470 + end + object acUndo: TEditUndo + Category = 'Edit' + Caption = 'Undo' + ImageIndex = 3 + ShortCut = 16474 + end + object acRename: TAction + Category = 'Actions' + Caption = 'Rename' + ShortCut = 113 + OnExecute = acRenameExecute + end + object acRefresh: TAction + Category = 'Actions' + Caption = 'Refresh' + ShortCut = 116 + OnExecute = acRefreshExecute + end + object acProperties: TAction + Category = 'File' + Caption = 'Properties...' + ShortCut = 32781 + OnExecute = acPropertiesExecute + end + object acTransacted: TAction + Category = 'File' + Caption = 'Transacted' + Checked = True + ShortCut = 16468 + OnExecute = acTransactedExecute + end + object acNew: TAction + Category = 'File' + Caption = 'New...' + ShortCut = 16462 + OnExecute = acNewExecute + end + object acSave: TAction + Category = 'File' + Caption = 'Save' + ShortCut = 16467 + OnExecute = acSaveExecute + end + object acSaveAs: TAction + Category = 'File' + Caption = 'Save As...' + OnExecute = acSaveAsExecute + end + end + object popTreeView: TPopupMenu + Left = 96 + Top = 72 + object AddFolder2: TMenuItem + Action = acAddFolder + end + object AddFile2: TMenuItem + Action = acAddFile + end + object N7: TMenuItem + Caption = '-' + end + object Rename2: TMenuItem + Action = acRename + end + object Delete2: TMenuItem + Action = acDelete + end + object N6: TMenuItem + Caption = '-' + end + object acProper1: TMenuItem + Action = acProperties + Default = True + end + end + object SaveDialog: TSaveDialog + Filter = + 'Compound files|*.doc;*.xls;*.ppt;*.mpp;*.mdb;*.dot|All Files (*.' + + '*)|*.*' + Options = [ofOverwritePrompt, ofHideReadOnly, ofCreatePrompt, ofEnableSizing] + Title = 'Save New File As' + Left = 96 + Top = 16 + end +end diff --git a/official/1.96/examples/windows/structstorage/StructStorageExampleMain.pas b/official/1.96/examples/windows/structstorage/StructStorageExampleMain.pas new file mode 100644 index 0000000..a0da9c5 --- /dev/null +++ b/official/1.96/examples/windows/structstorage/StructStorageExampleMain.pas @@ -0,0 +1,955 @@ +{----------------------------------------------------------------------------- +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/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: ViewMain.PAS, released on 2002-12-29. + +The Initial Developer of the Original Code is Peter Thörnqvist [peter3@peter3.com] +Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist. +All Rights Reserved. + +Contributor(s): + +Last Modified: $Date: 2005/10/17 13:35:15 $ + +You may retrieve the latest version of this file at the Project JEDI's Code Library home page, +located at http://jcl.sourceforge.net + +Description: + + Fairly complete demo program for the JclStructStorage unit. + Note that the HexDump unit was taken from Borland's ResXplorer demo and has been + slightly modified by me. It is still copyrighted by Borland, of course. + +-----------------------------------------------------------------------------} + +unit StructStorageExampleMain; + +{$I jcl.inc} + +interface + +uses + Windows, SysUtils, Classes, Messages, Forms, Menus, StdActns, StdCtrls, ComCtrls, + ActnList, ImgList, Controls, Dialogs, ExtCtrls, Graphics, HexDump, + JclStructStorage; + +const + WM_SHOWABOUT = WM_USER + 1; + +type + TfrmMain = class(TForm) + mmMain: TMainMenu; + OpenDialog: TOpenDialog; + File1: TMenuItem; + Open1: TMenuItem; + Exit1: TMenuItem; + tvDocInfo: TTreeView; + StatusBar1: TStatusBar; + il16: TImageList; + Actions1: TMenuItem; + N1: TMenuItem; + Addfolder1: TMenuItem; + Addfile1: TMenuItem; + Help1: TMenuItem; + About1: TMenuItem; + Delete1: TMenuItem; + alMain: TActionList; + acOpen: TAction; + acExit: TAction; + acAddFolder: TAction; + acAddFile: TAction; + acDelete: TAction; + acAbout: TAction; + reDetails: TRichEdit; + acEditData: TAction; + acSaveData: TAction; + Edit1: TMenuItem; + Editstream1: TMenuItem; + Savechanges1: TMenuItem; + acCut: TEditCut; + acCopy: TEditCopy; + acPaste: TEditPaste; + acUndo: TEditUndo; + Undo1: TMenuItem; + N4: TMenuItem; + Cut1: TMenuItem; + Copy1: TMenuItem; + Paste1: TMenuItem; + N5: TMenuItem; + acRename: TAction; + Rename1: TMenuItem; + popTreeView: TPopupMenu; + AddFolder2: TMenuItem; + AddFile2: TMenuItem; + Rename2: TMenuItem; + Delete2: TMenuItem; + N7: TMenuItem; + acRefresh: TAction; + Splitter1: TSplitter; + acProperties: TAction; + Properties1: TMenuItem; + acProper1: TMenuItem; + N6: TMenuItem; + acTransacted: TAction; + ransacted1: TMenuItem; + N9: TMenuItem; + acNew: TAction; + SaveDialog: TSaveDialog; + New1: TMenuItem; + N10: TMenuItem; + Refresh1: TMenuItem; + acSave: TAction; + Save1: TMenuItem; + N8: TMenuItem; + N2: TMenuItem; + acSaveAs: TAction; + SaveAs1: TMenuItem; + procedure tvDocInfoDeletion(Sender: TObject; Node: TTreeNode); + procedure tvDocInfoCollapsed(Sender: TObject; Node: TTreeNode); + procedure tvDocInfoExpanded(Sender: TObject; Node: TTreeNode); + procedure FormCreate(Sender: TObject); + procedure acOpenExecute(Sender: TObject); + procedure acExitExecute(Sender: TObject); + procedure acAddFolderExecute(Sender: TObject); + procedure acAddFileExecute(Sender: TObject); + procedure acDeleteExecute(Sender: TObject); + procedure acAboutExecute(Sender: TObject); + procedure alMainUpdate(Action: TBasicAction; + var Handled: Boolean); + procedure acEditDataExecute(Sender: TObject); + procedure acSaveDataExecute(Sender: TObject); + procedure tvDocInfoChange(Sender: TObject; Node: TTreeNode); + procedure tvDocInfoEditing(Sender: TObject; Node: TTreeNode; + var AllowEdit: Boolean); + procedure tvDocInfoEdited(Sender: TObject; Node: TTreeNode; + var S: string); + procedure acRenameExecute(Sender: TObject); + procedure acRefreshExecute(Sender: TObject); + procedure acPropertiesExecute(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure acTransactedExecute(Sender: TObject); + procedure tvDocInfoDblClick(Sender: TObject); + procedure acNewExecute(Sender: TObject); + procedure acSaveExecute(Sender: TObject); + procedure acSaveAsExecute(Sender: TObject); + private + { Private declarations } + FFilename: string; + FUpdating: boolean; + HD: THexDump; + FModified: boolean; + procedure SortTree; + // returns the folder in NOde.Data or nil if it isn't a folder + function GetFolder(Node: TTreeNode): TJclStructStorageFolder; + // returns the stream in Node.Data or nil if it isn't a stream + function GetStream(Node: TTreeNode): TStream; + // loads an exsisting or creates a new file with name AFilename + procedure LoadFile(const AFilename: string; CreateNew: boolean); + // add Storage as a subnode to ParentNode using the name AName + procedure AddFolder(ParentNode: TTreeNode; AName: string; Storage: TJclStructStorageFolder); + // add a stream in Storage with name AName as a subnode to ParentNode using the name + procedure AddFile(ParentNode: TTreeNode; AName: string; Storage: TJclStructStorageFolder); + // show the content of Stream + procedure ViewDetails(Stream: TStream); + // show the entire content of the laoded document + procedure ViewDocument; + // free the object in the Node.Data property + // recurses the subnodes of Node + procedure FreeData(const Node: TTreeNode); + // adds a file stream to Node without creating a new node + procedure UpdateFileData(Node: TTreeNode; const AName: string; + Storage: TJclStructStorageFolder); + // adds Storage to Node without creating a new node. Also adds new nodes for substorages + // and substreams + procedure UpdateFolderData(Node: TTreeNode; const AName: string; Storage: TJclStructStorageFolder); + procedure WmShowAbout(var Msg: TMEssage); message WM_SHOWABOUT; + function GetModified: boolean; + procedure SetModified(const Value: boolean); + procedure CheckModified; + function GetReadOnly: boolean; + procedure SetReadOnly(const Value: boolean); + public + { Public declarations } + property Modified: boolean read GetModified write SetModified; + property ReadOnly: boolean read GetReadOnly write SetReadOnly; + end; + +var + frmMain: TfrmMain; + +implementation +uses + ActiveX, ComObj, PropsFrm; + +{$R *.DFM} + +const + cImageClosed = 0; + cImageOpen = 1; + cImageDoc = 2; + cImageMod = 3; + +function MinimizeName(const Filename: string; Canvas: TCanvas; MaxLen: Integer): string; +var + R: TRect; +begin + Result := Filename; + if Result <> '' then + begin + UniqueString(Result); + R := Rect(0, 0, MaxLen, Canvas.TextHeight('Wq')); + if DrawText(Canvas.Handle, PChar(@Result[1]), Length(Result), R, + DT_SINGLELINE or DT_MODIFYSTRING or DT_PATH_ELLIPSIS or DT_CALCRECT or DT_NOPREFIX) = 0 then + Result := Filename; + end; +end; + +// returns true if Node.Data contains a TJclStructStorageFolder instance + +function IsFolder(Node: TTreeNode): boolean; +begin + Result := (Node <> nil) and (Node.Data <> nil) and (TObject(Node.Data) is TJclStructStorageFolder); +end; + +// finds and returns the first sibling of ASibling (or ASibling itself) that has +// Text = AName. Returns nil if sucha node couldn't be found + +function FindSibling(ASibling: TTreeNode; AName: string): TTreeNode; +begin + Result := ASibling; + if Result = nil then Exit; + // search backwards + while (Result <> nil) do + begin + if AnsiSameText(Result.Text, AName) then + Exit; + Result := Result.getPrevSibling; + end; + Result := ASibling; + // search forwards + while (Result <> nil) do + begin + if AnsiSameText(Result.Text, AName) then + Exit; + Result := Result.getNextSibling; + end; + Result := nil; +end; + +function YesNoDlg(const Caption, Msg: string): boolean; +begin + Result := Windows.MessageBox(0, PChar(Msg), PChar(Caption), MB_YESNO or MB_ICONQUESTION or MB_TASKMODAL) = IDYES; +end; + +procedure ErrorDlg(const Caption, Msg: string); +begin + Windows.MessageBox(0, PChar(Msg), PChar(Caption), MB_OK or MB_ICONERROR or MB_TASKMODAL); +end; + +procedure TfrmMain.LoadFile(const AFilename: string; CreateNew: boolean); +var + Root: TJclStructStorageFolder; + HR: HResult; + AModes: TJclStructStorageAccessModes; +begin + Screen.Cursor := crHourGlass; + FUpdating := true; + try + if (AFilename <> '') and ((TJclStructStorageFolder.IsStructured(AFilename) = S_OK)or CreateNew) then + begin + FFilename := AFilename; + tvDocInfo.Items.BeginUpdate; + try + tvDocInfo.Items.Clear; + HD.Clear; + if CreateNew then + AModes := [smCreate] + else if ReadOnly then + AModes := [smOpenRead] + else + AModes := [smOpenRead, smOpenWrite]; + AModes := AModes + [smShareDenyRead, smShareDenyWrite]; + Root := TJclStructStorageFolder.Create(FFilename, AModes, CreateNew); + AddFolder(nil, SRoot, Root); + finally + tvDocInfo.Items.EndUpdate; + end; + end + else if YesNoDlg(SConfirmConversion, SConvertFilePrompt) then + begin + HR := TJclStructStorageFolder.Convert(AFilename); + if Succeeded(HR) then + begin + ShowMessage(SConvertSuccess); + LoadFile(AFilename, false); + end + else + ErrorDlg(SError, Format(SConvertFailFmt, [SysErrorMessage(HR)])); + end; + if tvDocInfo.Items.Count > 0 then + begin + tvDocInfo.Items[0].Expand(false); + tvDocInfo.Selected := tvDocInfo.Items[0]; + tvDocInfo.Selected.Focused := true; + end; + StatusBar1.Panels[0].Text := MinimizeName(FFilename, StatusBar1.Canvas, + StatusBar1.Panels[0].Width - 4); + SortTree; + finally + Screen.Cursor := crDefault; + FUpdating := false; + Modified := false; + end; +end; + +procedure TfrmMain.tvDocInfoDeletion(Sender: TObject; Node: TTreeNode); +begin + if Node.Data <> nil then + TObject(Node.Data).Free; + Node.Data := nil; +end; + +function TfrmMain.GetStream(Node: TTreeNode): TStream; +begin + if (Node <> nil) and (Node.Data <> nil) and (TObject(Node.Data) is TStream) then + begin + Result := TStream(Node.Data); + Result.Seek(0, soFrombeginning); + end + else + Result := nil; +end; + +procedure TfrmMain.tvDocInfoCollapsed(Sender: TObject; Node: TTreeNode); +begin + Node.ImageIndex := cImageClosed; + Node.SelectedIndex := cImageClosed; +end; + +procedure TfrmMain.tvDocInfoExpanded(Sender: TObject; Node: TTreeNode); +begin + Node.ImageIndex := cImageOpen; + Node.SelectedIndex := cImageOpen; +end; + +procedure TfrmMain.ViewDetails(Stream: TStream); +var + aSize: double; +begin + if acEditData.Checked then acEditDataExecute(nil); // toggle into browse mode + HD.LoadFromStream(Stream); + if Stream <> nil then + begin + aSize := Stream.Size; + StatusBar1.Panels[1].Text := Format(SBytesFloatFmt, [aSize]); + end + else + StatusBar1.Panels[1].Text := ''; +end; + +procedure TfrmMain.ViewDocument; +var + Filename: string; + F: TFileStream; +begin + Filename := TJclStructStorageFolder(tvDocInfo.Items.getFirstNode.Data).Name; + if FileExists(Filename) then + begin + F := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone); + try + ViewDetails(F); + finally + F.Free; + end; + end; +end; + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + HD := CreateHexDump(self); + HD.Font := self.Font; + // HD.Font.Name := 'Courier New'; + HD.AddressColor := clMaroon; + HD.AnsiCharColor := clNavy; + Application.Title := Caption; +end; + +function TfrmMain.GetFolder(Node: TTreeNode): TJclStructStorageFolder; +begin + if (Node <> nil) and (Node.Data <> nil) and (TObject(Node.Data) is TJclStructStorageFolder) then + Result := TJclStructStorageFolder(Node.Data) + else + Result := nil; +end; + +procedure TfrmMain.CheckModified; +begin + if Modified and YesNoDlg(SConfirm, SConfirmSaveChanges) then + acSave.Execute; +end; + +procedure TfrmMain.acOpenExecute(Sender: TObject); +begin + // if in transacted mode, ask user to save any changes before loading a new file + CheckModified; + ReadOnly := false; + if OpenDialog.Execute then + LoadFile(OpenDialog.FileName, false); +end; + +procedure TfrmMain.acExitExecute(Sender: TObject); +begin + Close; +end; + +procedure TfrmMain.acAddFolderExecute(Sender: TObject); +var + S: string; + N: TTreeNode; + SS, SS2: TJclStructStorageFolder; +begin + if not IsFolder(tvDocInfo.Selected) then + N := tvDocInfo.Selected.Parent + else + N := tvDocInfo.Selected; + if (N = nil) then + Exit; + if InputQuery(SAddFolder, SFolderNameLabel, S) then + begin + if S = '' then + begin + ErrorDlg(SError, SErrNameEmpty); + Exit; + end; + // since a duplicate name replaces the current folder/file, we have to check + // explicitly for duplicates here so we don't add a duplicate node by mistake + if (FindSibling(tvDocInfo.Selected.getFirstChild, S) <> nil) then + begin + ErrorDlg(SError, SErrNameDuplicate); + Exit; + end; + + SS := GetFolder(N); + if not SS.Add(S, true) then + OleError(SS.LastError) + else if SS.GetFolder(S, SS2) then + begin + Modified := true; + AddFolder(N, S, SS2); + end; + end; + SortTree; +end; + +procedure TfrmMain.acAddFileExecute(Sender: TObject); +var + S: string; + N: TTreeNode; + SS: TJclStructStorageFolder; +begin + if not IsFolder(tvDocInfo.Selected) then + N := tvDocInfo.Selected.Parent + else + N := tvDocInfo.Selected; + if (N = nil) then Exit; + if InputQuery(SAddFile, SFileNameLabel, S) then + begin + if S = '' then + begin + ErrorDlg(SError, SErrNameEmpty); + Exit; + end; + // since a duplicate name replaces the current folder/file, we have to check + // explicitly for duplicates here so we don't add a duplicate node by mistake + if (FindSibling(N.getFirstChild, S) <> nil) then + begin + ErrorDlg(SError, SErrNameDuplicate); + Exit; + end; + SS := GetFolder(N); + if not SS.Add(S, false) then + OleError(SS.LastError) + else + begin + AddFile(N, S, SS); + Modified := true; + end; + end; + SortTree; +end; + +procedure TfrmMain.acDeleteExecute(Sender: TObject); +begin + if YesNoDlg(SConfirm, SDeletePrompt) then + if not TJclStructStorageFolder(tvDocInfo.Selected.Parent.Data).Delete(tvDocInfo.Selected.Text) then + OleError(TJclStructStorageFolder(tvDocInfo.Selected.Parent.Data).LastError) + else + begin + tvDocInfo.Selected.Delete; + Modified := true; + end; +end; + +procedure TfrmMain.acAboutExecute(Sender: TObject); +var + ParamsW: TMsgBoxParamsW; + ParamsA: TMsgBoxParamsA; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + begin + with ParamsW do + begin + cbSize := sizeof(TMsgBoxParamsW); + hwndOwner := Handle; + hInstance := SysInit.hInstance; + lpszText := PWideChar(WideString(SAboutMsg)); + lpszCaption := PWideChar(WideString(SAboutCaption)); + dwStyle := MB_OK or MB_USERICON; + lpszIcon := PWideChar(WideString('MAINICON')); + dwContextHelpId := 0; + lpfnMsgBoxCallback := nil; + dwLanguageId := GetUserDefaultLangID; + MessageBoxIndirectW(ParamsW); + end + end + else + with ParamsA do + begin + cbSize := sizeof(TMsgBoxParamsA); + hwndOwner := Handle; + hInstance := SysInit.hInstance; + lpszText := PChar(SAboutMsg); + lpszCaption := PChar(SAboutCaption); + dwStyle := MB_OK or MB_USERICON; + lpszIcon := PChar('MAINICON'); + dwContextHelpId := 0; + lpfnMsgBoxCallback := nil; + dwLanguageId := GetUserDefaultLangID; + MessageBoxIndirectA(ParamsA); + end; +end; + +procedure TfrmMain.alMainUpdate(Action: TBasicAction; + var Handled: Boolean); +var + IsReadOnly: boolean; +begin + IsReadOnly := ReadOnly; + acTransacted.Enabled := not IsReadOnly; + acSave.Enabled := not IsReadOnly and Modified; + acSaveAs.Enabled := not IsReadOnly and (FFilename <> ''); + acDelete.Enabled := not IsReadOnly and + (tvDocInfo.Selected <> nil) and (tvDocInfo.Selected.Parent <> nil); + acAddFolder.Enabled := not IsReadOnly and + (tvDocInfo.Selected <> nil) and not reDetails.Focused; + acAddFile.Enabled := acAddFolder.Enabled; + acEditData.Enabled := not ReadOnly and (GetStream(tvDocInfo.Selected) <> nil); + acSaveData.Enabled := not IsReadOnly and acEditData.Enabled + and acEditData.Checked and reDetails.Modified; + acRename.Enabled := not IsReadOnly and (tvDocInfo.Selected <> nil) + and (tvDocInfo.Selected.Parent <> nil); + acProperties.Enabled := (tvDocInfo.Selected <> nil); +end; + +function TreeSort(lParam1, lParam2, lParamSort: Longint): Integer; stdcall; + +begin + if IsFolder(TTreeNode(lParam1)) = IsFolder(TTreeNode(lParam2)) then + Result := AnsiCompareText(TTreeNode(lParam1).Text, TTreeNode(lParam2).Text) + else if IsFolder(TTreeNode(lParam1)) then + Result := -1 + else if IsFolder(TTreeNode(lParam2)) then + Result := 1 + else + Result := 0; +end; + +procedure TfrmMain.SortTree; +begin + tvDocInfo.CustomSort(TreeSort, 0{$IFDEF COMPILER6_UP}, true{$ENDIF}); +end; + +function TfrmMain.GetModified: boolean; +begin + // can never be modified when running in direct mode or as ReadOnly + Result := FModified and not ReadOnly and (FFilename <> '') and + acTransacted.Checked and (tvDocInfo.Items.Count > 0); +end; + +procedure TfrmMain.SetModified(const Value: boolean); +begin + FModified := Value; +end; + +function TfrmMain.GetReadOnly: boolean; +begin + Result := ofReadOnly in OpenDialog.Options; +end; + +procedure TfrmMain.SetReadOnly(const Value: boolean); +begin + if Value then + OpenDialog.Options := OpenDialog.Options + [ofReadOnly] + else + OpenDialog.Options := OpenDialog.Options - [ofReadOnly]; +end; + +procedure TfrmMain.AddFile(ParentNode: TTreeNode; AName: string; + Storage: TJclStructStorageFolder); +var + Stream: TStream; +begin + if ParentNode <> nil then + with ParentNode do + begin + ImageIndex := Ord(Expanded); + SelectedIndex := ImageIndex; + end; + if not Storage.GetFileStream(AName, Stream) then + OleError(Storage.LastError) + else + with tvDocInfo.Items.AddChildObject(ParentNode, AName, Stream) do + begin + ImageIndex := cImageDoc; + SelectedIndex := cImageDoc; + if not FUpdating then + MakeVisible; + end; +end; + +procedure TfrmMain.AddFolder(ParentNode: TTreeNode; AName: string; + Storage: TJclStructStorageFolder); +var + S: TStringlist; + i: integer; + N: TTreeNode; + ST: TJclStructStorageFolder; +begin + if ParentNode <> nil then + with ParentNode do + begin + ImageIndex := Ord(Expanded); + SelectedIndex := ImageIndex; + end; + N := tvDocInfo.Items.AddChildObject(ParentNode, AName, Storage); + with N do + begin + ImageIndex := Ord(Expanded); + SelectedIndex := ImageIndex; + if not FUpdating then + MakeVisible; + end; + + S := TStringlist.Create; + try + // folders + Storage.GetSubItems(S, true); + for i := 0 to S.Count - 1 do + begin + if not Storage.GetFolder(S[i], ST) then + OleError(Storage.LastError) + else + AddFolder(N, S[i], ST); + end; + S.Clear; + // files + Storage.GetSubItems(S, false); + for i := 0 to S.Count - 1 do + AddFile(N, S[i], Storage); + finally + S.Free; + end; +end; + +procedure TfrmMain.acEditDataExecute(Sender: TObject); +begin + acEditData.Checked := not acEditData.Checked; + if acEditData.Checked then + begin + reDetails.Visible := true; + HD.Visible := false; + reDetails.Lines.LoadFromStream(GetStream(tvDocInfo.Selected)); + reDetails.Modified := false; + reDetails.SelStart := MaxInt; + reDetails.SetFocus; + end + else + begin + HD.Visible := true; + reDetails.Visible := false; + tvDocInfoChange(Sender, tvDocInfo.Selected); + end; +end; + +procedure TfrmMain.acSaveDataExecute(Sender: TObject); +var + S: TStream; +begin + S := GetStream(tvDocInfo.Selected); + if (S <> nil) and reDetails.Modified then + begin + S.Size := 0; // clear so we don't have old data at the end of the stream (if it's shorter now) + reDetails.Lines.SaveToStream(S); // add new + Modified := true; + if (tvDocInfo.Selected <> nil) then + with tvDocInfo.Selected do + begin + ImageIndex := cImageDoc + Ord(acTransacted.Checked); + SelectedIndex := ImageIndex; + end; + end; + acEditData.Execute; // toggle into browse mode +end; + +procedure TfrmMain.tvDocInfoChange(Sender: TObject; Node: TTreeNode); +begin + if Node = tvDocInfo.Items.getFirstNode then + ViewDocument + else + ViewDetails(GetStream(Node)); +end; + +procedure TfrmMain.tvDocInfoEditing(Sender: TObject; Node: TTreeNode; + var AllowEdit: Boolean); +begin + AllowEdit := (Node <> nil) and (Node.Parent <> nil); +end; + +procedure TfrmMain.FreeData(const Node: TTreeNode); +var + N: TTreeNode; +begin + TObject(Node.Data).Free; + Node.Data := nil; + N := Node.getFirstChild; + while Assigned(N) do + begin + FreeData(N); + N := N.GetNextSibling; + end; +end; + +procedure TfrmMain.acRenameExecute(Sender: TObject); +begin + tvDocInfo.Selected.EditText; +end; + +procedure TfrmMain.UpdateFolderData(Node: TTreeNode; const AName: string; Storage: TJclStructStorageFolder); +var + SS: TJclStructStorageFolder; + S: TStringlist; + i: integer; +begin + TObject(Node.Data).Free; + Node.Data := nil; + if Storage <> nil then + begin + Node.Data := Storage; + Node.Text := AName; + end + else + Exit; + Node.DeleteChildren; + S := TStringlist.Create; + try + // sub folders + Storage.GetSubItems(S, true); + for i := 0 to S.Count - 1 do + begin + if not Storage.GetFolder(S[i], SS) then + OleError(Storage.LastError) + else + AddFolder(Node, S[i], SS); + end; + S.Clear; + // sub files + if not Storage.GetSubItems(S, false) then + OleError(Storage.LastError) + else + for i := 0 to S.Count - 1 do + AddFile(Node, S[i], Storage); + finally + S.Free; + end; +end; + +procedure TfrmMain.UpdateFileData(Node: TTreeNode; const AName: string; Storage: TJclStructStorageFolder); +var + SS: TStream; +begin + TObject(Node.Data).Free; + Node.Data := nil; + if Storage.GetFileStream(AName, SS) then + begin + Node.Data := SS; + Node.Text := AName; + end + else + OleError(Storage.LastError); +end; + +procedure TfrmMain.tvDocInfoEdited(Sender: TObject; Node: TTreeNode; + var S: string); +var + SS, SS2: TJclStructStorageFolder; + WasFolder: boolean; +begin + // this is a bit convoluted since we can't rename a node that is open + // so we have to destroy the Node.Data and recreate it again after the rename + if (Node = nil) or (Node.Parent = nil) then + begin + ErrorDlg(SError, SErrNodeEdit); + Node.EndEdit(true); + end + else + begin + SS := GetFolder(Node.Parent); + WasFolder := IsFolder(Node); + FreeData(Node); // release any storages / streams so we can rename + if (SS = nil) or not SS.Rename(Node.Text, S) then + begin + if SS <> nil then + OleError(SS.LastError) + else + ErrorDlg(SError, SErrNodeRename); + S := Node.Text; + Node.EndEdit(true); + end + else + begin // update the node's (and subnodes') Data with new storages / streams + if WasFolder then + begin + if not SS.GetFolder(S, SS2) then + OleError(SS.LastError) + else + UpdateFolderData(Node, S, SS2); + end + else + UpdateFileData(Node, S, SS); + end; + Modified := true; + end; + SortTree; +end; + +procedure TfrmMain.acRefreshExecute(Sender: TObject); +begin + SortTree; +end; + +procedure TfrmMain.acPropertiesExecute(Sender: TObject); +var + Stat: TStatStg; + B: Boolean; +begin + B := false; + if IsFolder(tvDocInfo.Selected) then + B := TJclStructStorageFolder(tvDocInfo.Selected.Data).GetStats(Stat, true) + else if tvDocInfo.Selected <> nil then + B := TJclStructStorageStream(tvDocInfo.Selected.Data).GetStats(Stat, true); + if B then + begin + TfrmProps.ShowProperties(Stat); + JclStructStorage.CoMallocFree(Stat.pwcsName); + end; +end; + +procedure TfrmMain.FormShow(Sender: TObject); +begin + PostMessage(Handle, WM_SHOWABOUT, 0, 0); +end; + +procedure TfrmMain.WmShowAbout(var Msg: TMEssage); +begin + acAbout.Execute; +end; + +procedure TfrmMain.acTransactedExecute(Sender: TObject); +begin + acTransacted.Checked := not acTransacted.Checked; + if FileExists(FFilename) then + begin + CheckModified; + LoadFile(FFilename, false); + end; +end; + +procedure TfrmMain.tvDocInfoDblClick(Sender: TObject); +begin + if (tvDocInfo.Selected <> nil) and not tvDocInfo.Selected.HasChildren then + acProperties.Execute; +end; + +procedure TfrmMain.acNewExecute(Sender: TObject); +begin + CheckModified; + ReadOnly := false; + if SaveDialog.Execute then + LoadFile(SaveDialog.Filename, true); +end; + +procedure TfrmMain.acSaveExecute(Sender: TObject); +var + N: TTreeNode; +begin + if Modified then + begin + // we must call Commit on *every* storage to save our changes (the fine print!) + N := tvDocInfo.Items.getFirstNode; + while Assigned(N) do + begin + if IsFolder(N) then + begin + TJclStructStorageFolder(N.Data).Commit; + N.ImageIndex := cImageDoc; + N.SelectedIndex := cImageDoc; + end; + N := N.GetNext; + end; + end; + Modified := false; +end; + +procedure TfrmMain.acSaveAsExecute(Sender: TObject); +var + AFile: TJclStructStorageFolder; +begin + // I know: I could just as well have done a standard FileCopy, but that's not any fun! + if SaveDialog.Execute then + begin + AFile := TJclStructStorageFolder.Create(SaveDialog.Filename, [smCreate], true); + try + AFile.Assign(TJclStructStorageFolder(tvDocInfo.Items.GetFirstNode.Data)); + finally + AFile.Free; + end; + LoadFile(SaveDialog.Filename, false); + end; +end; + +// History: + +// $Log: StructStorageExampleMain.pas,v $ +// Revision 1.1 2005/10/17 13:35:15 rrossmair +// - moved over from examples\vcl\* +// +// Revision 1.3 2004/10/02 05:47:27 marquardt +// added check for incompatible jedi.inc +// replaced jedi.inc with jvcl.inc +// +// Revision 1.2 2004/06/12 04:44:16 rrossmair +// mistakenly commited the wrong (outdated) file version at first; corrected +// +// Revision 1.1 2004/06/12 03:44:01 rrossmair +// structured storage demo initial check-in; adapted for JCL +// + +end. + diff --git a/official/1.96/examples/windows/sysinfo/SysInfoDemoMain.dfm b/official/1.96/examples/windows/sysinfo/SysInfoDemoMain.dfm new file mode 100644 index 0000000..1638a6f --- /dev/null +++ b/official/1.96/examples/windows/sysinfo/SysInfoDemoMain.dfm @@ -0,0 +1,1010 @@ +object MainForm: TMainForm + Left = 382 + Top = 187 + Width = 484 + Height = 459 + Caption = 'JCL SysInfo demo' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object pageSysInfo: TPageControl + Left = 4 + Top = 4 + Width = 468 + Height = 389 + ActivePage = tabSystemFolders + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 0 + object tabSystemFolders: TTabSheet + Caption = 'System Folders' + object Label1: TLabel + Left = 12 + Top = 16 + Width = 68 + Height = 13 + Caption = 'Common Files:' + end + object Label2: TLabel + Left = 12 + Top = 40 + Width = 69 + Height = 13 + Caption = 'Current Folder:' + end + object Label3: TLabel + Left = 12 + Top = 64 + Width = 66 + Height = 13 + Caption = 'Program Files:' + end + object Label4: TLabel + Left = 12 + Top = 88 + Width = 79 + Height = 13 + Caption = 'Windows Folder:' + end + object Label5: TLabel + Left = 12 + Top = 112 + Width = 69 + Height = 13 + Caption = 'System Folder:' + end + object Label6: TLabel + Left = 12 + Top = 136 + Width = 62 + Height = 13 + Caption = 'Temp Folder:' + end + object Label20: TLabel + Left = 12 + Top = 160 + Width = 61 + Height = 13 + Caption = 'Fonts Folder:' + end + object Label26: TLabel + Left = 12 + Top = 184 + Width = 105 + Height = 13 + Caption = 'Internet Cache Folder:' + end + object Label27: TLabel + Left = 12 + Top = 208 + Width = 73 + Height = 13 + Caption = 'Cookies Folder:' + end + object Label28: TLabel + Left = 12 + Top = 232 + Width = 67 + Height = 13 + Caption = 'History Folder:' + end + object edtCommonFiles: TEdit + Left = 124 + Top = 12 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 0 + end + object edtCurrentFolder: TEdit + Left = 124 + Top = 36 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 1 + end + object edtProgramFiles: TEdit + Left = 124 + Top = 60 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 2 + end + object edtWindowsFolder: TEdit + Left = 124 + Top = 84 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 3 + end + object edtSystemFolder: TEdit + Left = 124 + Top = 108 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 4 + end + object edtTempFolder: TEdit + Left = 124 + Top = 132 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 5 + end + object edtFontsFolder: TEdit + Left = 124 + Top = 156 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 6 + end + object edtInternetCacheFolder: TEdit + Left = 124 + Top = 180 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 7 + end + object edtCookiesFolder: TEdit + Left = 124 + Top = 204 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 8 + end + object edtHistoryFolder: TEdit + Left = 124 + Top = 228 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 9 + end + end + object tabCommonDirectories: TTabSheet + Caption = 'Common Directories' + ImageIndex = 1 + object Label30: TLabel + Left = 12 + Top = 16 + Width = 127 + Height = 13 + Caption = 'Common Startmenu Folder:' + end + object Label22: TLabel + Left = 12 + Top = 88 + Width = 123 + Height = 13 + Caption = 'Common Programs Folder:' + end + object Label23: TLabel + Left = 12 + Top = 112 + Width = 132 + Height = 13 + Caption = 'Common Desktop Directory:' + end + object Label11: TLabel + Left = 12 + Top = 40 + Width = 122 + Height = 13 + Caption = 'Common Favorites Folder:' + end + object Label15: TLabel + Left = 12 + Top = 64 + Width = 113 + Height = 13 + Caption = 'Common Startup Folder:' + end + object edtCommonStartmenuFolder: TEdit + Left = 152 + Top = 12 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 0 + end + object edtCommonProgramsFolder: TEdit + Left = 152 + Top = 84 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 1 + end + object edtCommonDesktopDirectory: TEdit + Left = 152 + Top = 108 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 2 + end + object edtCommonFavoritesFolder: TEdit + Left = 152 + Top = 36 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 3 + end + object edtCommonStartupFolder: TEdit + Left = 152 + Top = 60 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 4 + end + end + object tabCurrentUser: TTabSheet + Caption = 'Current User Profile' + ImageIndex = 2 + object Label7: TLabel + Left = 12 + Top = 16 + Width = 75 + Height = 13 + Caption = 'Desktop Folder:' + end + object Label9: TLabel + Left = 12 + Top = 40 + Width = 79 + Height = 13 + Caption = 'Programs Folder:' + end + object Label12: TLabel + Left = 12 + Top = 64 + Width = 76 + Height = 13 + Caption = 'Personal Folder:' + end + object Label13: TLabel + Left = 12 + Top = 88 + Width = 78 + Height = 13 + Caption = 'Favorites Folder:' + end + object Label14: TLabel + Left = 12 + Top = 112 + Width = 69 + Height = 13 + Caption = 'Startup Folder:' + end + object Label8: TLabel + Left = 12 + Top = 136 + Width = 62 + Height = 13 + Caption = 'Recent Files:' + end + object Label16: TLabel + Left = 12 + Top = 160 + Width = 73 + Height = 13 + Caption = 'SendTo Folder:' + end + object Label17: TLabel + Left = 12 + Top = 184 + Width = 86 + Height = 13 + Caption = 'Start menu Folder:' + end + object Label24: TLabel + Left = 12 + Top = 208 + Width = 113 + Height = 13 + Caption = 'Application Data Folder:' + end + object Label25: TLabel + Left = 12 + Top = 232 + Width = 80 + Height = 13 + Caption = 'Printhood Folder:' + end + object Label10: TLabel + Left = 12 + Top = 256 + Width = 88 + Height = 13 + Caption = 'Desktop Directory:' + end + object Label18: TLabel + Left = 12 + Top = 280 + Width = 76 + Height = 13 + Caption = 'Nethood Folder:' + end + object Label21: TLabel + Left = 12 + Top = 304 + Width = 84 + Height = 13 + Caption = 'Templates Folder:' + end + object edtDesktopFolder: TEdit + Left = 132 + Top = 12 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 0 + end + object edtProgramsFolder: TEdit + Left = 132 + Top = 36 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 1 + end + object edtPersonalFolder: TEdit + Left = 132 + Top = 60 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 2 + end + object edtFavoritesFolder: TEdit + Left = 132 + Top = 84 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 3 + end + object edtStartupFolder: TEdit + Left = 132 + Top = 108 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 4 + end + object edtRecentFilesFolder: TEdit + Left = 132 + Top = 132 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 5 + end + object edtSendToFolder: TEdit + Left = 132 + Top = 156 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 6 + end + object edtStartMenuFolder: TEdit + Left = 132 + Top = 180 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 7 + end + object edtAppdataFolder: TEdit + Left = 132 + Top = 204 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 8 + end + object edtPrintHoodFolder: TEdit + Left = 132 + Top = 228 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 9 + end + object edtDesktopDirectory: TEdit + Left = 132 + Top = 252 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 10 + end + object edtNethoodFolder: TEdit + Left = 132 + Top = 276 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 11 + end + object edtTemplatesFolder: TEdit + Left = 132 + Top = 300 + Width = 277 + Height = 21 + ReadOnly = True + TabOrder = 12 + end + end + object tabAPM: TTabSheet + Caption = 'APM' + ImageIndex = 3 + object Label19: TLabel + Left = 16 + Top = 16 + Width = 108 + Height = 13 + Caption = 'Battery Life Time (sec):' + end + object Label29: TLabel + Left = 16 + Top = 40 + Width = 127 + Height = 13 + Caption = 'Battery Full Life Time (sec):' + end + object Label31: TLabel + Left = 16 + Top = 64 + Width = 96 + Height = 13 + Caption = 'Battery Life Percent:' + end + object Label32: TLabel + Left = 16 + Top = 88 + Width = 92 + Height = 13 + Caption = 'Battery Line Status:' + end + object Label33: TLabel + Left = 16 + Top = 112 + Width = 59 + Height = 13 + Caption = 'Battery Flag:' + end + object lblAPMPlatforms: TLabel + Left = 16 + Top = 148 + Width = 289 + Height = 13 + Caption = 'APM is only available on Windows 95 / 98 / Me / 2000/ XP !' + Font.Charset = DEFAULT_CHARSET + Font.Color = clRed + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + Visible = False + end + object edtBatteryLifeTime: TEdit + Left = 152 + Top = 12 + Width = 61 + Height = 21 + Color = clInactiveCaptionText + ReadOnly = True + TabOrder = 0 + end + object edtBatteryFullLifeTime: TEdit + Left = 152 + Top = 36 + Width = 61 + Height = 21 + Color = clInactiveCaptionText + ReadOnly = True + TabOrder = 1 + end + object edtBatteryLineStatus: TEdit + Left = 152 + Top = 84 + Width = 161 + Height = 21 + Color = clInactiveCaptionText + ReadOnly = True + TabOrder = 2 + end + object edtBatteryFlag: TEdit + Left = 152 + Top = 108 + Width = 161 + Height = 21 + Color = clInactiveCaptionText + ReadOnly = True + TabOrder = 3 + end + object pgrsBatteryLife: TProgressBar + Left = 152 + Top = 62 + Width = 273 + Height = 16 + Min = 0 + Max = 100 + TabOrder = 4 + end + end + object tabMemory: TTabSheet + Caption = 'Memory' + ImageIndex = 4 + object Label34: TLabel + Left = 4 + Top = 16 + Width = 120 + Height = 13 + Caption = 'Max. application address:' + end + object Label35: TLabel + Left = 4 + Top = 40 + Width = 117 + Height = 13 + Caption = 'Min. application address:' + end + object Label36: TLabel + Left = 4 + Top = 64 + Width = 67 + Height = 13 + Caption = 'Memory Load:' + end + object Label37: TLabel + Left = 4 + Top = 88 + Width = 67 + Height = 13 + Caption = 'Swap file size:' + end + object Label38: TLabel + Left = 4 + Top = 112 + Width = 78 + Height = 13 + Caption = 'Swap file usage:' + end + object Label39: TLabel + Left = 4 + Top = 136 + Width = 107 + Height = 13 + Caption = 'Total physical memory:' + end + object Label40: TLabel + Left = 4 + Top = 160 + Width = 109 + Height = 13 + Caption = 'Avail. physical memory:' + end + object Label41: TLabel + Left = 4 + Top = 184 + Width = 97 + Height = 13 + Caption = 'Total virtual memory:' + end + object Label42: TLabel + Left = 4 + Top = 208 + Width = 99 + Height = 13 + Caption = 'Avail. virtual memory:' + end + object Label43: TLabel + Left = 4 + Top = 232 + Width = 109 + Height = 13 + Caption = 'Total page file memory:' + end + object Label44: TLabel + Left = 4 + Top = 256 + Width = 111 + Height = 13 + Caption = 'Avail. page file memory:' + end + object Bevel1: TBevel + Left = 0 + Top = 280 + Width = 457 + Height = 9 + Anchors = [akLeft, akTop, akRight] + Shape = bsTopLine + end + object Label60: TLabel + Left = 4 + Top = 288 + Width = 183 + Height = 13 + Caption = 'Windows 95/98/Me system resources:' + end + object LabelSysResources: TLabel + Left = 4 + Top = 312 + Width = 94 + Height = 13 + Caption = 'LabelSysResources' + end + object edtMaxAppAddress: TEdit + Left = 136 + Top = 12 + Width = 121 + Height = 21 + TabOrder = 0 + end + object edtMinAppAddress: TEdit + Left = 136 + Top = 36 + Width = 121 + Height = 21 + TabOrder = 1 + end + object pgrsMemLoad: TProgressBar + Left = 136 + Top = 62 + Width = 150 + Height = 16 + Min = 0 + Max = 100 + TabOrder = 2 + end + object edtSwapFileSize: TEdit + Left = 136 + Top = 84 + Width = 121 + Height = 21 + TabOrder = 3 + end + object pgrsSwapFileUsage: TProgressBar + Left = 136 + Top = 110 + Width = 150 + Height = 16 + Min = 0 + Max = 100 + TabOrder = 4 + end + object edtPhysicalTotal: TEdit + Left = 136 + Top = 132 + Width = 121 + Height = 21 + TabOrder = 5 + end + object edtPhysicalFree: TEdit + Left = 136 + Top = 156 + Width = 121 + Height = 21 + TabOrder = 6 + end + object edtVirtualTotal: TEdit + Left = 136 + Top = 180 + Width = 121 + Height = 21 + TabOrder = 7 + end + object edtVirtualFree: TEdit + Left = 136 + Top = 204 + Width = 121 + Height = 21 + TabOrder = 8 + end + object edtPageFileTotal: TEdit + Left = 136 + Top = 228 + Width = 121 + Height = 21 + TabOrder = 9 + end + object edtPageFileFree: TEdit + Left = 136 + Top = 252 + Width = 121 + Height = 21 + TabOrder = 10 + end + end + object tabKeyboard: TTabSheet + Caption = 'Keyboard' + ImageIndex = 5 + object Label45: TLabel + Left = 4 + Top = 16 + Width = 78 + Height = 13 + Caption = 'Num Lock state:' + end + object Label46: TLabel + Left = 4 + Top = 40 + Width = 80 + Height = 13 + Caption = 'Caps Lock state:' + end + object Label47: TLabel + Left = 4 + Top = 64 + Width = 82 + Height = 13 + Caption = 'Scroll Lock state:' + end + object edtNumLockState: TEdit + Left = 97 + Top = 12 + Width = 121 + Height = 21 + TabOrder = 0 + end + object edtCapsLockState: TEdit + Left = 97 + Top = 36 + Width = 121 + Height = 21 + TabOrder = 1 + end + object edtScrollLockState: TEdit + Left = 97 + Top = 60 + Width = 121 + Height = 21 + TabOrder = 2 + end + end + object tabIdentification: TTabSheet + Caption = 'Identification' + ImageIndex = 6 + object grpBIOS: TGroupBox + Left = 8 + Top = 8 + Width = 449 + Height = 117 + Caption = ' BIOS ' + TabOrder = 0 + object Label48: TLabel + Left = 18 + Top = 18 + Width = 31 + Height = 13 + Caption = 'Name:' + end + object Label49: TLabel + Left = 18 + Top = 42 + Width = 47 + Height = 13 + Caption = 'Copyright:' + end + object Label50: TLabel + Left = 18 + Top = 66 + Width = 69 + Height = 13 + Caption = 'Extended Info:' + end + object Label51: TLabel + Left = 18 + Top = 90 + Width = 26 + Height = 13 + Caption = 'Date:' + end + object edtBIOSName: TEdit + Left = 93 + Top = 14 + Width = 200 + Height = 21 + TabOrder = 0 + end + object edtBIOSCopyright: TEdit + Left = 93 + Top = 38 + Width = 200 + Height = 21 + TabOrder = 1 + end + object edtBIOSExtendedInfo: TEdit + Left = 93 + Top = 62 + Width = 121 + Height = 21 + TabOrder = 2 + end + object edtBIOSDate: TEdit + Left = 93 + Top = 86 + Width = 96 + Height = 21 + TabOrder = 3 + end + end + object grpNetwork: TGroupBox + Left = 8 + Top = 132 + Width = 449 + Height = 117 + Caption = ' Network ' + TabOrder = 1 + object Label52: TLabel + Left = 18 + Top = 18 + Width = 54 + Height = 13 + Caption = 'IP Address:' + end + object Label53: TLabel + Left = 18 + Top = 42 + Width = 67 + Height = 13 + Caption = 'MAC Address:' + end + object Label54: TLabel + Left = 18 + Top = 90 + Width = 39 + Height = 13 + Caption = 'Domain:' + end + object edtIPAddress: TEdit + Left = 93 + Top = 14 + Width = 200 + Height = 21 + TabOrder = 0 + end + object lbMACAddresses: TListBox + Left = 92 + Top = 40 + Width = 201 + Height = 42 + ItemHeight = 13 + TabOrder = 1 + end + object edtDomain: TEdit + Left = 93 + Top = 86 + Width = 200 + Height = 21 + TabOrder = 2 + end + end + object GroupBox1: TGroupBox + Left = 8 + Top = 256 + Width = 449 + Height = 97 + Caption = ' User ' + TabOrder = 2 + object Label56: TLabel + Left = 18 + Top = 18 + Width = 31 + Height = 13 + Caption = 'Name:' + end + object Label57: TLabel + Left = 18 + Top = 42 + Width = 73 + Height = 13 + Caption = 'Reg. Company:' + end + object Label58: TLabel + Left = 18 + Top = 66 + Width = 60 + Height = 13 + Caption = 'Reg. Owner:' + end + object edtUserName: TEdit + Left = 93 + Top = 14 + Width = 200 + Height = 21 + TabOrder = 0 + end + object edtRegisteredCompany: TEdit + Left = 93 + Top = 38 + Width = 200 + Height = 21 + TabOrder = 1 + end + object edtRegisteredOwner: TEdit + Left = 93 + Top = 62 + Width = 200 + Height = 21 + TabOrder = 2 + end + end + end + object tabProcesses: TTabSheet + Caption = 'Processes' + ImageIndex = 7 + object Label55: TLabel + Left = 8 + Top = 8 + Width = 95 + Height = 13 + Caption = 'Running Processes:' + end + object Label59: TLabel + Left = 8 + Top = 208 + Width = 75 + Height = 13 + Caption = 'Running Tasks:' + end + object lbProcesses: TListBox + Left = 8 + Top = 24 + Width = 445 + Height = 169 + ItemHeight = 13 + TabOrder = 0 + end + object TasksListBox: TListBox + Left = 8 + Top = 224 + Width = 445 + Height = 121 + ItemHeight = 13 + TabOrder = 1 + end + end + end + object btnUpdate: TButton + Left = 396 + Top = 400 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = '&Update' + TabOrder = 1 + OnClick = btnUpdateClick + end + object btnOk: TButton + Left = 316 + Top = 400 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = '&OK' + Default = True + TabOrder = 2 + OnClick = btnOkClick + end +end diff --git a/official/1.96/examples/windows/sysinfo/SysInfoDemoMain.pas b/official/1.96/examples/windows/sysinfo/SysInfoDemoMain.pas new file mode 100644 index 0000000..cab8ab8 --- /dev/null +++ b/official/1.96/examples/windows/sysinfo/SysInfoDemoMain.pas @@ -0,0 +1,310 @@ +unit SysInfoDemoMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ComCtrls, ExtCtrls; + +type + TMainForm = class(TForm) + pageSysInfo: TPageControl; + btnUpdate: TButton; + btnOk: TButton; + tabSystemFolders: TTabSheet; + edtCommonFiles: TEdit; + Label1: TLabel; + edtCurrentFolder: TEdit; + Label2: TLabel; + edtProgramFiles: TEdit; + Label3: TLabel; + edtWindowsFolder: TEdit; + Label4: TLabel; + edtSystemFolder: TEdit; + Label5: TLabel; + edtTempFolder: TEdit; + Label6: TLabel; + tabCommonDirectories: TTabSheet; + Label30: TLabel; + Label22: TLabel; + Label23: TLabel; + edtCommonStartmenuFolder: TEdit; + edtCommonProgramsFolder: TEdit; + edtCommonDesktopDirectory: TEdit; + Label11: TLabel; + edtCommonFavoritesFolder: TEdit; + Label15: TLabel; + edtCommonStartupFolder: TEdit; + tabCurrentUser: TTabSheet; + Label7: TLabel; + Label9: TLabel; + Label12: TLabel; + Label13: TLabel; + Label14: TLabel; + edtDesktopFolder: TEdit; + edtProgramsFolder: TEdit; + edtPersonalFolder: TEdit; + edtFavoritesFolder: TEdit; + edtStartupFolder: TEdit; + Label8: TLabel; + edtRecentFilesFolder: TEdit; + Label16: TLabel; + edtSendToFolder: TEdit; + Label17: TLabel; + edtStartMenuFolder: TEdit; + Label24: TLabel; + Label25: TLabel; + edtAppdataFolder: TEdit; + edtPrintHoodFolder: TEdit; + Label10: TLabel; + Label18: TLabel; + edtDesktopDirectory: TEdit; + edtNethoodFolder: TEdit; + Label21: TLabel; + edtTemplatesFolder: TEdit; + Label20: TLabel; + edtFontsFolder: TEdit; + Label26: TLabel; + edtInternetCacheFolder: TEdit; + Label27: TLabel; + edtCookiesFolder: TEdit; + Label28: TLabel; + edtHistoryFolder: TEdit; + tabAPM: TTabSheet; + edtBatteryLifeTime: TEdit; + Label19: TLabel; + Label29: TLabel; + edtBatteryFullLifeTime: TEdit; + Label31: TLabel; + Label32: TLabel; + edtBatteryLineStatus: TEdit; + Label33: TLabel; + edtBatteryFlag: TEdit; + pgrsBatteryLife: TProgressBar; + lblAPMPlatforms: TLabel; + tabMemory: TTabSheet; + Label34: TLabel; + edtMaxAppAddress: TEdit; + Label35: TLabel; + edtMinAppAddress: TEdit; + Label36: TLabel; + pgrsMemLoad: TProgressBar; + Label37: TLabel; + edtSwapFileSize: TEdit; + Label38: TLabel; + pgrsSwapFileUsage: TProgressBar; + Label39: TLabel; + edtPhysicalTotal: TEdit; + edtPhysicalFree: TEdit; + Label40: TLabel; + Label41: TLabel; + edtVirtualTotal: TEdit; + edtVirtualFree: TEdit; + Label42: TLabel; + Label43: TLabel; + edtPageFileTotal: TEdit; + edtPageFileFree: TEdit; + Label44: TLabel; + tabKeyboard: TTabSheet; + Label45: TLabel; + edtNumLockState: TEdit; + Label46: TLabel; + edtCapsLockState: TEdit; + Label47: TLabel; + edtScrollLockState: TEdit; + tabIdentification: TTabSheet; + grpBIOS: TGroupBox; + Label48: TLabel; + edtBIOSName: TEdit; + Label49: TLabel; + edtBIOSCopyright: TEdit; + Label50: TLabel; + edtBIOSExtendedInfo: TEdit; + Label51: TLabel; + edtBIOSDate: TEdit; + grpNetwork: TGroupBox; + Label52: TLabel; + edtIPAddress: TEdit; + Label53: TLabel; + lbMACAddresses: TListBox; + Label54: TLabel; + edtDomain: TEdit; + tabProcesses: TTabSheet; + Label55: TLabel; + lbProcesses: TListBox; + GroupBox1: TGroupBox; + Label56: TLabel; + edtUserName: TEdit; + Label57: TLabel; + edtRegisteredCompany: TEdit; + Label58: TLabel; + edtRegisteredOwner: TEdit; + TasksListBox: TListBox; + Label59: TLabel; + Bevel1: TBevel; + Label60: TLabel; + LabelSysResources: TLabel; + procedure FormCreate(Sender: TObject); + procedure btnOkClick(Sender: TObject); + procedure btnUpdateClick(Sender: TObject); + procedure FormShow(Sender: TObject); + private + procedure UpdateGUI; + public + end; + +var + MainForm: TMainForm; + +implementation + +uses + JclSysInfo, Registry; + +{$R *.DFM} + +procedure TMainForm.FormCreate(Sender: TObject); +begin + pageSysInfo.ActivePage := tabSystemFolders; +end; + +procedure TMainForm.FormShow(Sender: TObject); +begin + UpdateGUI; +end; + +procedure TMainForm.btnOkClick(Sender: TObject); +begin + Application.Terminate; +end; + +procedure TMainForm.UpdateGUI; +begin + // Directories + edtCommonFiles.Text := GetCommonFilesFolder; + edtCurrentFolder.Text := GetCurrentFolder; + edtProgramFiles.Text := GetProgramFilesFolder; + edtWindowsFolder.Text := GetWindowsFolder; + edtSystemFolder.Text := GetWindowsSystemFolder; + edtTempFolder.Text := GetWindowsTempFolder; + + edtDesktopFolder.Text := GetDesktopFolder; + edtProgramsFolder.Text := GetProgramsFolder; + edtPersonalFolder.Text := GetPersonalFolder; + edtFavoritesFolder.Text := GetFavoritesFolder; + edtStartupFolder.Text := GetStartupFolder; + edtRecentFilesFolder.Text := GetRecentFolder; + edtSendToFolder.Text := GetSendToFolder; + edtStartMenuFolder.Text := GetStartmenuFolder; + + edtDesktopDirectory.Text := GetDesktopDirectoryFolder; + edtNethoodFolder.Text := GetNethoodFolder; + edtFontsFolder.Text := GetFontsFolder; + edtTempFolder.Text := GetTemplatesFolder; + edtCommonStartmenuFolder.Text := GetCommonStartmenuFolder; + edtCommonProgramsFolder.Text := GetCommonProgramsFolder; + edtCommonStartupFolder.Text := GetCommonStartupFolder; + edtCommonDesktopDirectory.Text := GetCommonDesktopdirectoryFolder; + edtAppdataFolder.Text := GetAppdataFolder; + edtPrintHoodFolder.Text := GetPrinthoodFolder; + edtCommonFavoritesFolder.Text := GetCommonFavoritesFolder; + edtInternetCacheFolder.Text := GetInternetCacheFolder; + edtCookiesFolder.Text := GetCookiesFolder; + edtHistoryFolder.Text := GetHistoryFolder; + + // APM is only available on Windows 9x / Win2K / WinXP + if GetWindowsVersion in [wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4] then + lblAPMPlatforms.Visible := true + else + begin + lblAPMPlatforms.Visible := false; + edtBatteryLifetime.Text := IntToStr(GetAPMBatteryLifeTime); + edtBatteryFullLifeTime.Text := IntToStr(GetAPMBatteryFullLifeTime); + pgrsBatteryLife.Position := GetAPMBatteryLifePercent; + end; + + // Memory + edtMaxAppAddress.Text := IntToHex(GetMaxAppAddress, 8); + edtMinAppAddress.Text := IntToHex(GetMinAppAddress, 8); + pgrsMemLoad.Position := GetMemoryLoad; + edtSwapFileSize.Text := IntToStr(GetSwapFileSize); + pgrsSwapFileUsage.Position := GetSwapFileUsage; + + edtPhysicalTotal.Text := IntToStr(GetTotalPhysicalMemory); + edtPhysicalFree.Text := IntToStr(GetFreePhysicalMemory); + edtVirtualTotal.Text := IntToStr(GetTotalVirtualMemory); + edtVirtualFree.Text := IntToStr(GetFreeVirtualMemory); + edtPageFileTotal.Text := IntToStr(GetTotalPageFileMemory); + edtPageFileFree.Text := IntToStr(GetFreePageFileMemory); + + if IsWinNT then + LabelSysResources.Caption := 'System resources meter is not available on NT systems' + else + if not IsSystemResourcesMeterPresent then + LabelSysResources.Caption := 'System resources meter tool is not installed' + else + with GetFreeSystemResources do + LabelSysResources.Caption := Format('User: %d%%, System: %d%%, Gdi: %d%%', [UserRes, SystemRes, GdiRes]); + + // Keyboard + if GetNumLockKeyState = true then + edtNumLockState.Text := 'ON' + else + edtNumLockState.Text := 'OFF'; + + if GetScrollLockKeyState = true then + edtScrollLockState.Text := 'ON' + else + edtScrollLockState.Text := 'OFF'; + + if GetCapsLockKeyState = true then + edtCapsLockState.Text := 'ON' + else + edtCapsLockState.Text := 'OFF'; + + // BIOS + if IsWinNT then begin + grpBIOS.Caption := ' BIOS (Currently only availabe under Windows 9x) '; + edtBIOSDate.Text := DateToStr(GetBiosDate); + end + else begin + edtBIOSName.Text := GetBIOSName; + edtBIOSCopyright.Text := GetBiosCopyright; + edtBIOSExtendedInfo.Text := GetBIOSExtendedInfo; + end; + + // Network Identification + edtIPAddress.Text := GetIPAddress(GetLocalComputerName); + GetMacAddresses(GetLocalComputerName, lbMACAddresses.Items); + edtDomain.Text := GetDomainName; + + // User Identification + edtUserName.Text := GetLocalUserName; + edtRegisteredCompany.Text := GetRegisteredCompany; + edtRegisteredOwner.Text := GetRegisteredOwner; + + // Processes + lbProcesses.Items.BeginUpdate; + try + lbProcesses.Items.Clear; + RunningProcessesList(lbProcesses.Items); + finally + lbProcesses.Items.EndUpdate; + end; + + // Tasks + TasksListBox.Items.BeginUpdate; + try + TasksListBox.Items.Clear; + GetTasksList(TasksListBox.Items); + finally + TasksListBox.Items.EndUpdate; + end; +end; + +procedure TMainForm.btnUpdateClick(Sender: TObject); +begin + UpdateGUI; +end; + +end. diff --git a/official/1.96/examples/windows/sysinfo/SysInfoExample.dof b/official/1.96/examples/windows/sysinfo/SysInfoExample.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/sysinfo/SysInfoExample.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/sysinfo/SysInfoExample.dpr b/official/1.96/examples/windows/sysinfo/SysInfoExample.dpr new file mode 100644 index 0000000..5f74405 --- /dev/null +++ b/official/1.96/examples/windows/sysinfo/SysInfoExample.dpr @@ -0,0 +1,13 @@ +program SysInfoExample; + +uses + Forms, + SysInfoDemoMain in 'SysInfoDemoMain.pas' {MainForm}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/examples/windows/sysinfo/SysInfoExample.res b/official/1.96/examples/windows/sysinfo/SysInfoExample.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/examples/windows/sysinfo/SysInfoExample.res differ diff --git a/official/1.96/examples/windows/tasks/TaskDemo.dof b/official/1.96/examples/windows/tasks/TaskDemo.dof new file mode 100644 index 0000000..4a388e0 --- /dev/null +++ b/official/1.96/examples/windows/tasks/TaskDemo.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\bin + diff --git a/official/1.96/examples/windows/tasks/TaskDemo.dpr b/official/1.96/examples/windows/tasks/TaskDemo.dpr new file mode 100644 index 0000000..d90fc79 --- /dev/null +++ b/official/1.96/examples/windows/tasks/TaskDemo.dpr @@ -0,0 +1,15 @@ +program TaskDemo; + +uses + Forms, + TaskDemoMain in 'TaskDemoMain.pas' {frmMain}, + TaskDemoDataModule in 'TaskDemoDataModule.pas' {DM: TDataModule}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TDM, DM); + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/official/1.96/examples/windows/tasks/TaskDemo.res b/official/1.96/examples/windows/tasks/TaskDemo.res new file mode 100644 index 0000000..0930265 Binary files /dev/null and b/official/1.96/examples/windows/tasks/TaskDemo.res differ diff --git a/official/1.96/examples/windows/tasks/TaskDemoDataModule.dfm b/official/1.96/examples/windows/tasks/TaskDemoDataModule.dfm new file mode 100644 index 0000000..de3b739 --- /dev/null +++ b/official/1.96/examples/windows/tasks/TaskDemoDataModule.dfm @@ -0,0 +1,475 @@ +object DM: TDM + OldCreateOrder = False + OnCreate = DataModuleCreate + OnDestroy = DataModuleDestroy + Left = 297 + Top = 203 + Height = 228 + Width = 270 + object lstImage: TImageList + Left = 24 + Top = 24 + Bitmap = { + 494C010107000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000003000000001002000000000000030 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000000000008080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000080000000FF000000FF000000FF000000FF000000FF000000 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000800000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF000080000000800000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 0000800000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF000080000000800000008000000080000000800000FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 0000800000008000000000000000000000000000000080808000000080000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF0000008000808080000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF000080000000800000FFFFFF00FFFFFF000080 + 0000FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 00008000000080000000800000000000000000000000000000000000FF000000 + FF000000FF00FFFFFF00FFFFFF000000FF000000FF000000FF00FFFFFF00FFFF + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000800000FFFFFF00FFFFFF000080 + 0000FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 00008000000080000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF00FFFFFF00FFFFFF000000FF00FFFFFF00FFFFFF000000 + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF0000800000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000080 + 0000FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 00008000000000000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF00FFFFFF00FFFFFF00FFFFFF000000FF000000 + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF0000800000FFFFFF00FFFFFF0000800000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000008000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF00FFFFFF00FFFFFF00FFFFFF000000FF000000 + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF0000800000FFFFFF00FFFFFF000080000000800000FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000800000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF00FFFFFF00FFFFFF000000FF00FFFFFF00FFFFFF000000 + FF000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF000080000000800000008000000080000000800000FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000080808000000080000000 + FF000000FF00FFFFFF00FFFFFF000000FF000000FF000000FF00FFFFFF00FFFF + FF000000FF000000FF0000008000808080000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000080000000800000FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000800000FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000080000000FF000000FF000000FF000000FF000000FF000000 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000000000008080 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008484840084848400848484008484 + 8400848484008484840084848400848484008484840084848400FFFFFF00C6C6 + C60084848400C6C6C600FFFFFF00C6C6C6000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008484840084848400848484008484 + 840084848400848484008484840084848400848484008484840084848400FFFF + FF0084848400FFFFFF0084848400848484000000000000000000808080008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080008080800080808000808080000000000000000000808080008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080008080800080808000808080000000000000000000808080008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080008080800080808000808080008400000084000000840000008400 + 00000000000000000000848484008484840084848400FFFFFF00FFFFFF00FFFF + FF00840000008400000084000000840000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000808080000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000808080000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000808080000000000000000000000000008400 + 0000FF00000084000000000000000000000084848400FFFFFF00FFFFFF00FFFF + FF00840000000000000000000000000000000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 0000FFFFFF0000FFFF0000000000808080000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 0000FFFFFF0000FFFF0000000000808080000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 0000FFFFFF0000FFFF0000000000808080000000000000000000000000008400 + 000084000000FF0000008400000000000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF0084000000000000000000000000000000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 000000000000FFFFFF000000000080808000808080000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 000000000000FFFFFF000000000080808000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 000000000000FFFFFF0000000000808080000000000000000000000000008400 + 0000FF00000084000000FF00000000000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00840000000000000000000000000000000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000FF + FF00000000000000000000000000808080000000800000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF000000000000FF + FF00000000000000000000000000808080000000000000000000FFFFFF000000 + 0000FFFFFF0000000000FFFFFF0000000000FFFFFF0000FFFF000000000000FF + FF00000000000000000000000000808080000000000000000000000000008400 + 000084000000FF0000008400000000000000FFFFFF00FFFF0000FFFFFF00FFFF + 000084000000000000000000000000000000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 000000000000000000000000000080808000000080000000800000FFFF00FFFF + FF0000FFFF00FFFFFF00808080000000800000FFFF00FFFFFF00000000000000 + 000000000000000000000000000080808000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000808080000000000000000000000000008400 + 0000FF00000084000000FF00000000000000FFFF0000FFFFFF00FFFF0000FFFF + FF0084000000000000000000000000000000FFFFFF0000000000FFFFFF008080 + 800000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00000000008080800080808000000080008080800000FF + FF00FFFFFF00808080000000800080808000FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000808080000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF000000000000FFFF0000000000FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000808080000000000000000000000000008400 + 000084000000FF0000008400000000000000FFFFFF00FFFF0000FFFFFF00FFFF + 0000840000000000000000000000000000008080800000FFFF0000FFFF008080 + 8000FFFFFF0000FFFF008080800000FFFF00FFFFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000808080000000000000008000000080008080 + 800000FFFF000000800000008000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF000000000080808000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000000000FFFF000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000808080000000000000000000000000008400 + 0000FF00000084000000FF00000000000000FFFF0000FFFFFF00FFFF0000FFFF + FF00840000000000000000000000000000000000000080808000FFFFFF008080 + 800000FFFF008080800000FFFF00FFFFFF0000FFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000808080000000000080808000000080000000 + 80000000800000008000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF0000000000808080000000000000000000FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF000000000000FFFF0000FFFF000000000000FF + FF00FFFFFF0000FFFF0000000000808080000000000000000000000000008400 + 0000840000008400000084000000840000008400000084000000840000008400 + 000084000000000000000000000000000000808080008080800080808000FFFF + FF0080808000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000000000808080000000000080808000000080000000 + 800000008000FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF000000000080808000000000000000000000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF000000000000FFFF0000FFFF0000000000FFFF + FF0000FFFF00FFFFFF0000000000808080000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF0000FFFF008080800000FF + FF00FFFFFF008080800080808000808080008080800000000000000000000000 + 0000000000000000000000000000000000008080800000008000000080000000 + 8000000080008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000008080800000FFFF008080 + 800000FFFF008080800000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000800000008000808080000000 + 0000000080000000800080808000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF0000FFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000840000008400000084000000840000000000000000 + 0000000000000000000000000000000000008080800000FFFF00000000008080 + 8000FFFFFF00000000008080800000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000800000008000808080000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FFFF0000000000000000008080 + 800000FFFF000000000000000000808080000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000008000000080008080800000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000080000000 + 8000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008080 + 8000FFFFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000300000000100010000000000800100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000C001FFFFF80F0000C001FFDFF0070000 + C001FFCFE0030000C001FFC7C0010000C001FFC380000000C001FFC180000000 + C001FFC380000000C001FFC780000000C001FFCF80000000C001FFDF80000000 + C001FFFF80000000C001FFFFC0010000C001FFFFE0030000C003FFFFF0070000 + C007FFFFF80F0000C00FFFFFFFFF00000000FFFFFFFFFFFF0000C000C000C000 + 0000800080008000E007800080008000E007801000108010E007800800088008 + E007800000008000E007000000008000E007000080008000E007800080008000 + E007000080008000FFFF000100018001F81F81FF11FFFF0FF81F24FFF8FFFF87 + F81F66FFFC7FFF87FFFFE7FFFFFFFFCF00000000000000000000000000000000 + 000000000000} + end + object lstAction: TActionList + Images = lstImage + Left = 80 + Top = 24 + object actTaskProp: TAction + Category = 'Task' + Caption = '&Properties' + ImageIndex = 3 + ShortCut = 16464 + OnExecute = actTaskPropExecute + OnUpdate = actTaskPropUpdate + end + object actTaskAdd: TAction + Category = 'Task' + Caption = '&Add' + ImageIndex = 1 + ShortCut = 16462 + OnExecute = actTaskAddExecute + end + object actTaskDelete: TAction + Category = 'Task' + Caption = '&Delete' + ImageIndex = 2 + ShortCut = 16452 + OnExecute = actTaskDeleteExecute + OnUpdate = actTaskPropUpdate + end + object actTaskRefresh: TAction + Category = 'Task' + Caption = '&Refresh' + ImageIndex = 4 + ShortCut = 116 + OnExecute = actTaskRefreshExecute + end + object actTaskRun: TAction + Category = 'Task' + Caption = '&Run' + ImageIndex = 5 + ShortCut = 116 + OnExecute = actTaskRunExecute + OnUpdate = actTaskRunUpdate + end + object actTaskStop: TAction + Category = 'Task' + Caption = '&Stop' + ImageIndex = 6 + ShortCut = 8308 + OnExecute = actTaskStopExecute + OnUpdate = actTaskStopUpdate + end + object actFileExit: TAction + Category = 'File' + Caption = 'E&xit' + Hint = 'Exit|Quits the application' + ImageIndex = 0 + ShortCut = 32883 + OnExecute = actFileExitExecute + end + end +end diff --git a/official/1.96/examples/windows/tasks/TaskDemoDataModule.pas b/official/1.96/examples/windows/tasks/TaskDemoDataModule.pas new file mode 100644 index 0000000..9213af9 --- /dev/null +++ b/official/1.96/examples/windows/tasks/TaskDemoDataModule.pas @@ -0,0 +1,164 @@ +unit TaskDemoDataModule; + +interface + +uses + {$IFNDEF COMPILER6_UP} + Forms, + {$ENDIF} + SysUtils, Classes, ActnList, ImgList, Controls, StdActns, JclTask; + +type + TDM = class(TDataModule) + lstImage: TImageList; + lstAction: TActionList; + actFileExit: TAction; + actTaskProp: TAction; + actTaskAdd: TAction; + actTaskDelete: TAction; + actTaskRefresh: TAction; + actTaskRun: TAction; + actTaskStop: TAction; + procedure actTaskPropUpdate(Sender: TObject); + procedure actTaskPropExecute(Sender: TObject); + procedure actTaskAddExecute(Sender: TObject); + procedure actTaskDeleteExecute(Sender: TObject); + procedure DataModuleCreate(Sender: TObject); + procedure DataModuleDestroy(Sender: TObject); + procedure actTaskRefreshExecute(Sender: TObject); + procedure actTaskRunExecute(Sender: TObject); + procedure actTaskStopExecute(Sender: TObject); + procedure actTaskStopUpdate(Sender: TObject); + procedure actTaskRunUpdate(Sender: TObject); + procedure actFileExitExecute(Sender: TObject); + private + FTask: TJclTaskSchedule; + FOnRefresh: TNotifyEvent; + + function GetSelectedTask: TJclScheduledTask; + public + property Task: TJclTaskSchedule read FTask; + property SelectedTask: TJclScheduledTask read GetSelectedTask; + + property OnRefresh: TNotifyEvent read FOnRefresh write FOnRefresh; + end; + +var + DM: TDM; + +implementation + +uses Windows, Dialogs, TaskDemoMain; + +{$R *.dfm} + +procedure TDM.DataModuleCreate(Sender: TObject); +begin + try + if not TJclTaskSchedule.IsRunning then + TJclTaskSchedule.Start; + except + Application.HandleException(Self); + end; + + FTask := TJclTaskSchedule.Create; + FTask.Refresh; + + FOnRefresh := nil; +end; + +procedure TDM.DataModuleDestroy(Sender: TObject); +begin + FreeAndNil(FTask); +end; + +procedure TDM.actTaskPropUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(frmMain.lstTasks.Selected); +end; + +function TDM.GetSelectedTask: TJclScheduledTask; +begin + Result := TJclScheduledTask(frmMain.lstTasks.Selected.Data); +end; + +procedure TDM.actTaskPropExecute(Sender: TObject); +begin + SelectedTask.ShowPage; + SelectedTask.Save; + SelectedTask.Refresh; +end; + +procedure TDM.actTaskAddExecute(Sender: TObject); +var + TaskName: string; + ATask: TJclScheduledTask; +begin + TaskName := 'unnnamed'; + if InputQuery('Please input a task name', 'Task Name', TaskName) then + try + ATask := Task.Add(TaskName); + if ATask.ShowPage then + begin + ATask.Save; + ATask.Refresh; + if Assigned(FOnRefresh) then FOnRefresh(Self); + end + else + begin + Task.Remove(ATask); + end; + except + on E: Exception do + {$IFDEF COMPILER6_UP} + ApplicationShowException(E); + {$ELSE} + Application.ShowException(E); + {$ENDIF} + end; +end; + +procedure TDM.actTaskDeleteExecute(Sender: TObject); +begin + Task.Remove(SelectedTask); + if Assigned(FOnRefresh) then FOnRefresh(Self); +end; + +procedure TDM.actTaskRefreshExecute(Sender: TObject); +begin + FTask.Refresh; + if Assigned(FOnRefresh) then FOnRefresh(Self); +end; + +procedure TDM.actTaskRunExecute(Sender: TObject); +begin + SelectedTask.Run; +end; + +procedure TDM.actTaskStopExecute(Sender: TObject); +begin + SelectedTask.Terminate; +end; + +procedure TDM.actTaskStopUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(frmMain.lstTasks.Selected) and + (SelectedTask.Status = tsRunning); +end; + +procedure TDM.actTaskRunUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(frmMain.lstTasks.Selected) and + (SelectedTask.Status <> tsRunning); +end; + +procedure TDM.actFileExitExecute(Sender: TObject); +begin + if Assigned(Application.MainForm) then + begin + Application.HelpCommand(HELP_QUIT, 0); + Application.MainForm.Close; + end; +end; + +end. diff --git a/official/1.96/examples/windows/tasks/TaskDemoMain.dfm b/official/1.96/examples/windows/tasks/TaskDemoMain.dfm new file mode 100644 index 0000000..fd6e037 --- /dev/null +++ b/official/1.96/examples/windows/tasks/TaskDemoMain.dfm @@ -0,0 +1,217 @@ +object frmMain: TfrmMain + Left = 288 + Top = 174 + Width = 696 + Height = 480 + Caption = 'Microsoft Task Schedule Demo' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Menu = mnuMain + OldCreateOrder = False + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object SplitterV: TSplitter + Left = 0 + Top = 209 + Width = 688 + Height = 3 + Cursor = crVSplit + Align = alTop + end + object barStatus: TStatusBar + Left = 0 + Top = 415 + Width = 688 + Height = 19 + Panels = <> + SimplePanel = False + end + object lstTasks: TListView + Left = 0 + Top = 0 + Width = 688 + Height = 209 + Align = alTop + BorderStyle = bsNone + Columns = < + item + Caption = 'Name' + Width = 200 + end + item + Alignment = taCenter + Caption = 'Last Run Time' + Width = 120 + end + item + Alignment = taCenter + Caption = 'Next Run Time' + Width = 120 + end + item + AutoSize = True + Caption = 'Comment' + end> + FlatScrollBars = True + GridLines = True + ReadOnly = True + RowSelect = True + PopupMenu = mnuPopup + TabOrder = 1 + ViewStyle = vsReport + OnSelectItem = lstTasksSelectItem + end + object WebBrowser: TWebBrowser + Left = 0 + Top = 212 + Width = 688 + Height = 203 + Align = alClient + TabOrder = 2 + OnDocumentComplete = WebBrowserDocumentComplete + ControlData = { + 4C0000001B470000FB1400000000000000000000000000000000000000000000 + 000000004C000000000000000000000001000000E0D057007335CF11AE690800 + 2B2E126208000000000000004C0000000114020000000000C000000000000046 + 8000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000100000000000000000000000000000000000000} + end + object mnuMain: TMainMenu + Images = DM.lstImage + Left = 24 + Top = 40 + object mnuFile: TMenuItem + Caption = '&File' + object mnuFileExit: TMenuItem + Action = DM.actFileExit + end + end + object mnuTask: TMenuItem + Caption = '&Task' + object mnuTaskAdd: TMenuItem + Action = DM.actTaskAdd + end + object mnuTaskDelete: TMenuItem + Action = DM.actTaskDelete + end + object mnuTaskLine0: TMenuItem + Caption = '-' + end + object mnuTaskRun: TMenuItem + Action = DM.actTaskRun + end + object mnuTaskStop: TMenuItem + Action = DM.actTaskStop + end + object mnuTaskLine1: TMenuItem + Caption = '-' + end + object mnuTaskRefresh: TMenuItem + Action = DM.actTaskRefresh + end + object mnuTaskLine2: TMenuItem + Caption = '-' + end + object mnuTaskProp: TMenuItem + Action = DM.actTaskProp + end + end + end + object mnuPopup: TPopupMenu + Images = DM.lstImage + Left = 80 + Top = 40 + object popTaskAdd: TMenuItem + Action = DM.actTaskAdd + end + object popTaskDelete: TMenuItem + Action = DM.actTaskDelete + end + object popLine0: TMenuItem + Caption = '-' + end + object popTaskRun: TMenuItem + Action = DM.actTaskRun + end + object popTaskStop: TMenuItem + Action = DM.actTaskStop + end + object popLine1: TMenuItem + Caption = '-' + end + object popTaskRefresh: TMenuItem + Action = DM.actTaskRefresh + end + object popLine2: TMenuItem + Caption = '-' + end + object popTaskProp: TMenuItem + Action = DM.actTaskProp + end + end + object ppTaskInfo: TPageProducer + HTMLDoc.Strings = ( + '' + '' + '' + '' + '' + '
    ' + '' + ' ' + ' ' + ' ' + '' + ' ' + ' ' + '' + ' ' + + ' <' + + '/TR>' + '' + ' ' + '' + ' ' + '' + ' ' + ' ' + '' + + ' ' + ' ' + '' + ' ' + ' ' + '' + ' ' + ' ' + ' ' + ' ' + ' ' + ' ' + ' ' + '
    NameValue
    TaskName<#TaskName>
    AccountName<#AccountName>
    Comment<#Comment>
    Creator<#Creator>
    ErrorRetryCount<#ErrorRetryCount>
    ErrorRetryInterval<#ErrorRetryInterval>
    ExitCode<#ExitCode>
    OwnerData<#Data>
    IdleMinutes<#IdleMinutes>
    DeadlineMinutes<#DeadlineMinutes>
    MostRecentRunTime<#MostRecentRunTime>
    NextRunTime<#NextRunTime>
    Status<#Status>
    Flags<#Flags>
    ApplicationName<#ApplicationName>
    WorkingDirectory<#WorkingDirectory>
    MaxRunTime<#MaxRunTime>
    Parameters<#Parameters>
    Priority<#Priority>
    TaskFlags<#TaskFlags>
    Triggers<#Triggers>
    ' + '
    ' + '' + '') + OnHTMLTag = ppTaskInfoHTMLTag + Left = 144 + Top = 40 + end +end diff --git a/official/1.96/examples/windows/tasks/TaskDemoMain.pas b/official/1.96/examples/windows/tasks/TaskDemoMain.pas new file mode 100644 index 0000000..5c2bd45 --- /dev/null +++ b/official/1.96/examples/windows/tasks/TaskDemoMain.pas @@ -0,0 +1,244 @@ +unit TaskDemoMain; + +{$INCLUDE jcl.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, ComCtrls, Menus, ExtCtrls, OleCtrls, SHDocVw, + {$IFDEF RTL140_UP} + HTTPProd, + {$ENDIF} + HTTPApp; + +type + TfrmMain = class(TForm) + barStatus: TStatusBar; + lstTasks: TListView; + mnuMain: TMainMenu; + mnuFile: TMenuItem; + mnuFileExit: TMenuItem; + mnuPopup: TPopupMenu; + popTaskProp: TMenuItem; + mnuTask: TMenuItem; + mnuTaskProp: TMenuItem; + SplitterV: TSplitter; + WebBrowser: TWebBrowser; + ppTaskInfo: TPageProducer; + popTaskAdd: TMenuItem; + popTaskDelete: TMenuItem; + popLine0: TMenuItem; + mnuTaskAdd: TMenuItem; + mnuTaskDelete: TMenuItem; + mnuTaskLine0: TMenuItem; + mnuTaskLine2: TMenuItem; + mnuTaskRefresh: TMenuItem; + popLine2: TMenuItem; + popTaskRefresh: TMenuItem; + mnuTaskLine1: TMenuItem; + mnuTaskRun: TMenuItem; + mnuTaskStop: TMenuItem; + popLine1: TMenuItem; + popTaskRun: TMenuItem; + popTaskStop: TMenuItem; + procedure FormCreate(Sender: TObject); + procedure WebBrowserDocumentComplete(Sender: TObject; + const pDisp: IDispatch; var URL: OleVariant); + procedure lstTasksSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + procedure ppTaskInfoHTMLTag(Sender: TObject; Tag: TTag; + const TagString: String; TagParams: TStrings; + var ReplaceText: String); + procedure FormDestroy(Sender: TObject); + private + FWebBrowserInitialized: Boolean; + + function SystemTimeToString(const SysTime: TSystemTime): string; + function MsToStr(const MsTime: DWORD): string; + + procedure SetHtml(const wb: TWebBrowser; const Html: string); + procedure OnRefresh(Sender: TObject); + public + procedure Refresh; + end; + +var + frmMain: TfrmMain; + +implementation + +uses ActiveX, ComObj, TypInfo, MsHtml, TaskDemoDataModule, JclTask; + +{$R *.dfm} + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + FWebBrowserInitialized := False; + + WebBrowser.Navigate('about:blank'); + + Refresh; + + DM.OnRefresh := OnRefresh; +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + DM.OnRefresh := nil; +end; + +procedure TfrmMain.Refresh; +var + I: Integer; +begin + {$IFDEF RTL140_UP} + lstTasks.Clear; + {$ELSE} + lstTasks.Items.Clear; + {$ENDIF} + for I:=0 to DM.Task.TaskCount-1 do + with lstTasks.Items.Add, DM.Task[I] do + begin + Caption := TaskName; + Data := DM.Task[I]; + SubItems.Add(SystemTimeToString(MostRecentRunTime)); + SubItems.Add(SystemTimeToString(NextRunTime)); + SubItems.Add(Comment); + end; +end; + +function TfrmMain.SystemTimeToString(const SysTime: TSystemTime): string; +begin + if SysTime.wYear = 0 then + Result := 'Never' + else + Result := DateTimeToStr(SystemTimeToDateTime(SysTime)); +end; + +function TfrmMain.MsToStr(const MsTime: DWORD): string; +var + RealTime: TDateTime; +begin + RealTime := MsTime / MSecsPerDay; + Result := IntToStr(Trunc(RealTime)) + ' days ' + TimeToStr(RealTime); +end; + +procedure TfrmMain.SetHtml(const wb: TWebBrowser; const Html: string); +var + Stream: TStream; + Adapter: TStreamAdapter; + psi: IPersistStreamInit; +begin + Stream := TStringStream.Create(Html); + try + Adapter := TStreamAdapter.Create(Stream); + psi := wb.Document as IPersistStreamInit; + OleCheck(psi.InitNew); + OleCheck(psi.Load(Adapter)); + finally + FreeAndNil(Stream); + end; +end; + +procedure TfrmMain.OnRefresh(Sender: TObject); +begin + Refresh; +end; + +procedure TfrmMain.WebBrowserDocumentComplete(Sender: TObject; + const pDisp: IDispatch; var URL: OleVariant); +begin + if not FWebBrowserInitialized then + begin + FWebBrowserInitialized := True; + + (((pDisp as IWebBrowser2).Document as IHTMLDocument2).body as IHTMLBodyElement).scroll := 'no'; + end; +end; + +procedure TfrmMain.lstTasksSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); +begin + if Selected and Assigned(Item) then + SetHtml(WebBrowser, ppTaskInfo.Content); +end; + +procedure TfrmMain.ppTaskInfoHTMLTag(Sender: TObject; Tag: TTag; + const TagString: String; TagParams: TStrings; var ReplaceText: String); + function TaskStatusToString(const Status: TJclScheduledTaskStatus): string; + const + StatusName: array[TJclScheduledTaskStatus] of string = + ('Unknown', 'Ready', 'Running', 'Not Scheduled', 'Has Not Run'); + begin + Result := StatusName[Status]; + end; + function TaskFlagsToString(const Flags: TJclScheduledTaskFlags): string; + var + AFlag: TJclScheduledTaskFlag; + begin + for AFlag:=Low(TJclScheduledTaskFlag) to High(TJclScheduledTaskFlag) do + if AFlag in Flags then + Result := Result + GetEnumName(TypeInfo(TJclScheduledTaskFlag), Integer(AFlag)) + ' '; + if Result = '' then + Result := 'Empty'; + end; + function TriggersToHtml(const Task: TJclScheduledTask): string; + var + I: Integer; + begin + for I:=0 to Task.TriggerCount-1 do + Result := Format('%s
  • %s
    • ', [Result, Task.Triggers[I].TriggerString]); + Result := '
      ' + Result + '
    '; + end; +begin + with TJclScheduledTask(frmMain.lstTasks.Selected.Data) do + try + if CompareText(TagString, 'TaskName') = 0 then + ReplaceText := TaskName + else if CompareText(TagString, 'AccountName') = 0 then + ReplaceText := AccountName + else if CompareText(TagString, 'Comment') = 0 then + ReplaceText := Comment + else if CompareText(TagString, 'Creator') = 0 then + ReplaceText := Creator + else if CompareText(TagString, 'ErrorRetryCount') = 0 then + ReplaceText := 'Unimplemented' // IntToStr(ErrorRetryCount) + else if CompareText(TagString, 'ErrorRetryInterval') = 0 then + ReplaceText := 'Unimplemented' // IntToStr(ErrorRetryInterval) + else if CompareText(TagString, 'ExitCode') = 0 then + ReplaceText := IntToStr(ExitCode) + else if CompareText(TagString, 'Data') = 0 then + ReplaceText := IntToStr(OwnerData.Size) + ' Bytes' + else if CompareText(TagString, 'IdleMinutes') = 0 then + ReplaceText := IntToStr(IdleMinutes) + ' Minutes' + else if CompareText(TagString, 'DeadlineMinutes') = 0 then + ReplaceText := IntToStr(DeadlineMinutes) + ' Minutes' + else if CompareText(TagString, 'MostRecentRunTime') = 0 then + ReplaceText := SystemTimeToString(MostRecentRunTime) + else if CompareText(TagString, 'NextRunTime') = 0 then + ReplaceText := SystemTimeToString(NextRunTime) + else if CompareText(TagString, 'Status') = 0 then + ReplaceText := TaskStatusToString(Status) + else if CompareText(TagString, 'Flags') = 0 then + ReplaceText := TaskFlagsToString(Flags) + else if CompareText(TagString, 'ApplicationName') = 0 then + ReplaceText := ApplicationName + else if CompareText(TagString, 'WorkingDirectory') = 0 then + ReplaceText := WorkingDirectory + else if CompareText(TagString, 'MaxRunTime') = 0 then + ReplaceText := MsToStr(MaxRunTime) + else if CompareText(TagString, 'Parameters') = 0 then + ReplaceText := Parameters + else if CompareText(TagString, 'Priority') = 0 then + ReplaceText := IntToStr(Priority) + else if CompareText(TagString, 'TaskFlags') = 0 then + ReplaceText := IntToHex(TaskFlags, 8) + else if CompareText(TagString, 'Triggers') = 0 then + ReplaceText := TriggersToHtml(TJclScheduledTask(frmMain.lstTasks.Selected.Data)); + except + ReplaceText := 'Unknown'; + end; +end; + +end. diff --git a/official/1.96/experts/common/JclConfigure.ico b/official/1.96/experts/common/JclConfigure.ico new file mode 100644 index 0000000..294f6aa Binary files /dev/null and b/official/1.96/experts/common/JclConfigure.ico differ diff --git a/official/1.96/experts/common/JclImages.rc b/official/1.96/experts/common/JclImages.rc new file mode 100644 index 0000000..824804b --- /dev/null +++ b/official/1.96/experts/common/JclImages.rc @@ -0,0 +1,2 @@ +JCLSPLASH BITMAP "JclSplash.bmp" +JCLCONFIGURE ICON "JclConfigure.ico" \ No newline at end of file diff --git a/official/1.96/experts/common/JclImages.res b/official/1.96/experts/common/JclImages.res new file mode 100644 index 0000000..42a014e Binary files /dev/null and b/official/1.96/experts/common/JclImages.res differ diff --git a/official/1.96/experts/common/JclOtaActionConfigureSheet.dfm b/official/1.96/experts/common/JclOtaActionConfigureSheet.dfm new file mode 100644 index 0000000..d9f0ba3 --- /dev/null +++ b/official/1.96/experts/common/JclOtaActionConfigureSheet.dfm @@ -0,0 +1,69 @@ +object JclOtaActionConfigureFrame: TJclOtaActionConfigureFrame + Left = 0 + Top = 0 + Width = 385 + Height = 375 + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 0 + TabStop = True + object LabelActions: TLabel + Left = 16 + Top = 16 + Width = 48 + Height = 13 + Caption = 'RsActions' + FocusControl = ListViewActions + end + object LabelShortcut: TLabel + Left = 16 + Top = 333 + Width = 53 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'RsShortcut' + FocusControl = HotKeyShortcut + end + object ListViewActions: TListView + Left = 16 + Top = 35 + Width = 314 + Height = 286 + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = < + item + Caption = 'RsCaption' + Width = 150 + end + item + Caption = 'RsShortcut' + Width = 100 + end> + HideSelection = False + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + OnSelectItem = ListViewActionsSelectItem + end + object HotKeyShortcut: THotKey + Left = 80 + Top = 330 + Width = 121 + Height = 19 + Anchors = [akLeft, akBottom] + HotKey = 0 + InvalidKeys = [hcNone] + Modifiers = [] + TabOrder = 1 + OnExit = HotKeyShortcutExit + end + object ButtonRestore: TButton + Left = 208 + Top = 328 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'RsRestore' + TabOrder = 2 + OnClick = ButtonRestoreClick + end +end diff --git a/official/1.96/experts/common/JclOtaActionConfigureSheet.pas b/official/1.96/experts/common/JclOtaActionConfigureSheet.pas new file mode 100644 index 0000000..b60df4a --- /dev/null +++ b/official/1.96/experts/common/JclOtaActionConfigureSheet.pas @@ -0,0 +1,118 @@ +unit JclOtaActionConfigureSheet; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, ComCtrls, StdCtrls; + +type + TJclOtaActionConfigureFrame = class(TFrame) + ListViewActions: TListView; + LabelActions: TLabel; + HotKeyShortcut: THotKey; + LabelShortcut: TLabel; + ButtonRestore: TButton; + procedure HotKeyShortcutExit(Sender: TObject); + procedure ButtonRestoreClick(Sender: TObject); + procedure ListViewActionsSelectItem(Sender: TObject; Item: TListItem; + Selected: Boolean); + private + public + constructor Create(AOwner: TComponent); override; + procedure SaveChanges; + end; + +implementation + +{$R *.dfm} + +uses + ActnList, Menus, + ToolsApi, + JclOtaConsts, JclOtaResources, JclOtaUtils; + +{ TFrameActions } + +procedure TJclOtaActionConfigureFrame.ButtonRestoreClick(Sender: TObject); +var + AListItem: TListItem; + AAction: TAction; +begin + AListItem := ListViewActions.Selected; + if Assigned(AListItem) then + begin + AAction := TJclOTAExpertBase.GetAction(AListItem.Index); + AListItem.SubItems.Strings[0] := ShortcutToText(TShortcut(AAction.Tag)); + HotKeyShortcut.HotKey := TShortcut(AAction.Tag); + end; +end; + +constructor TJclOtaActionConfigureFrame.Create(AOwner: TComponent); +var + Index: Integer; + ANTAServices: INTAServices; + AListItem: TListItem; + AAction: TAction; +begin + inherited Create(AOwner); + + ButtonRestore.Caption := RsRestore; + LabelActions.Caption := RsActions; + LabelShortcut.Caption := RsShortcut; + ListViewActions.Columns.Items[0].Caption := RsCaption; + ListViewActions.Columns.Items[1].Caption := RsShortcut; + + Supports(BorlandIDEServices, INTAServices, ANTAServices); + if not Assigned(ANTAServices) then + raise EJclExpertException.CreateTrace(RsENoNTAServices); + + ListViewActions.SmallImages := ANTAServices.ImageList; + + for Index := 0 to TJclOTAExpertBase.GetActionCount - 1 do + begin + AListItem := ListViewActions.Items.Add; + AAction := TJclOTAExpertBase.GetAction(Index); + AListItem.ImageIndex := AAction.ImageIndex; + AListItem.Caption := AAction.Caption; + AListItem.Data := Pointer(AAction.ShortCut); + AListItem.SubItems.Add(ShortcutToText(AAction.ShortCut)); + end; +end; + +procedure TJclOtaActionConfigureFrame.HotKeyShortcutExit(Sender: TObject); +var + AListItem: TListItem; +begin + AListItem := ListViewActions.Selected; + if Assigned(AListItem) then + begin + AListItem.Data := Pointer(HotKeyShortcut.HotKey); + AListItem.SubItems.Strings[0] := ShortCutToText(HotKeyShortcut.HotKey); + end; +end; + +procedure TJclOtaActionConfigureFrame.ListViewActionsSelectItem(Sender: TObject; + Item: TListItem; Selected: Boolean); +begin + if Selected then + HotKeyShortcut.HotKey := TShortcut(Item.Data) + else + HotKeyShortcut.HotKey := scNone; +end; + +procedure TJclOtaActionConfigureFrame.SaveChanges; +var + Index: Integer; +begin + { (ahuser) In Delphi 7 the ListViewActions.Items.Count is 0 if the page was + not shown. Something must delete the items that were filled in the constructor. } + if ListViewActions.Items.Count = TJclOTAExpertBase.GetActionCount then + begin + for Index := 0 to TJclOTAExpertBase.GetActionCount - 1 do + TJclOTAExpertBase.GetAction(Index).ShortCut := + TShortcut(ListViewActions.Items.Item[Index].Data); + end; +end; + +end. diff --git a/official/1.96/experts/common/JclOtaConfigurationForm.dfm b/official/1.96/experts/common/JclOtaConfigurationForm.dfm new file mode 100644 index 0000000..f83264e --- /dev/null +++ b/official/1.96/experts/common/JclOtaConfigurationForm.dfm @@ -0,0 +1,108 @@ +object JclOtaOptionsForm: TJclOtaOptionsForm + Left = 337 + Top = 238 + Width = 562 + Height = 522 + Caption = 'RsOtaConfigurationCaption' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object SplitterSep: TSplitter + Left = 185 + Top = 0 + Height = 450 + end + object PanelName: TPanel + Left = 0 + Top = 450 + Width = 554 + Height = 38 + Align = alBottom + BevelOuter = bvNone + TabOrder = 0 + object LabelHomePage: TLabel + Left = 8 + Top = 8 + Width = 75 + Height = 13 + Cursor = crHandPoint + Caption = 'RsHomePage' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold, fsUnderline] + ParentFont = False + OnClick = LabelHomePageClick + end + object ButtonOk: TButton + Left = 391 + Top = 8 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = 'RsCaptionOk' + Default = True + ModalResult = 1 + TabOrder = 0 + end + object ButtonCancel: TButton + Left = 472 + Top = 8 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = 'RsCaptionCancel' + ModalResult = 2 + TabOrder = 1 + end + end + object PanelTree: TPanel + Left = 0 + Top = 0 + Width = 185 + Height = 450 + Align = alLeft + BevelOuter = bvNone + TabOrder = 1 + object TreeViewCategories: TTreeView + Left = 8 + Top = 8 + Width = 171 + Height = 436 + Anchors = [akLeft, akTop, akRight, akBottom] + HideSelection = False + Indent = 19 + ReadOnly = True + RightClickSelect = True + TabOrder = 0 + OnChange = TreeViewCategoriesChange + end + end + object PanelOptions: TPanel + Left = 188 + Top = 0 + Width = 366 + Height = 450 + Align = alClient + BevelOuter = bvNone + TabOrder = 2 + object LabelSelectPage: TLabel + Left = 152 + Top = 184 + Width = 65 + Height = 13 + Caption = 'RsSelectPage' + FocusControl = TreeViewCategories + end + end +end diff --git a/official/1.96/experts/common/JclOtaConfigurationForm.pas b/official/1.96/experts/common/JclOtaConfigurationForm.pas new file mode 100644 index 0000000..dd840ea --- /dev/null +++ b/official/1.96/experts/common/JclOtaConfigurationForm.pas @@ -0,0 +1,206 @@ +unit JclOtaConfigurationForm; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls, ComCtrls, + JclOtaUtils; + +type + TJclOtaOptionsForm = class(TForm) + ButtonOk: TButton; + ButtonCancel: TButton; + PanelName: TPanel; + PanelTree: TPanel; + PanelOptions: TPanel; + SplitterSep: TSplitter; + TreeViewCategories: TTreeView; + LabelSelectPage: TLabel; + LabelHomePage: TLabel; + procedure LabelHomePageClick(Sender: TObject); + procedure TreeViewCategoriesChange(Sender: TObject; Node: TTreeNode); + procedure FormDestroy(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + FSettings: TJclOTASettings; + protected + procedure CreateParams(var Params: TCreateParams); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AddPage(AControl: TControl; PageName: string; + Expert: IJclOTAOptionsCallback); + function Execute(PageName: string): Boolean; + property Settings: TJclOTASettings read FSettings; + end; + +implementation + +{$R *.dfm} + +uses + ShellApi, + JclOtaConsts, JclOtaResources; + +type + TItemDataRec = class + public + AControl: TControl; + Expert: IJclOTAOptionsCallback; + end; + +//=== TJclOtaOptionsForm ===================================================== + +procedure TJclOtaOptionsForm.AddPage(AControl: TControl; PageName: string; + Expert: IJclOTAOptionsCallback); +var + ParentNode, ChildNode: TTreeNode; + NodeName: string; + PosSeparator, Index: Integer; + AItemDataRec: TItemDataRec; +begin + ParentNode := TreeViewCategories.Items.GetFirstNode; + ChildNode := ParentNode; + + repeat + PosSeparator := Pos('\', PageName); + if PosSeparator > 0 then + begin + NodeName := Copy(PageName, 1, PosSeparator - 1); + PageName := Copy(PageName, PosSeparator + 1, Length(PageName) - PosSeparator); + while Assigned(ChildNode) and (CompareText(NodeName, ChildNode.Text) <> 0) do + ChildNode := ChildNode.getNextSibling; + if not Assigned(ChildNode) then + begin + ChildNode := TreeViewCategories.Items.AddChild(ParentNode, NodeName); + if Assigned(ParentNode) then + ParentNode.Expand(False); + end; + ParentNode := ChildNode; + end + else + begin + while Assigned(ParentNode) and (CompareText(NodeName, ParentNode.Text) <> 0) do + ParentNode := ParentNode.getNextSibling; + end; + until PosSeparator = 0; + + ChildNode := nil; + if Assigned(ParentNode) then + for Index := 0 to ParentNode.Count - 1 do + if CompareText(ParentNode.Item[Index].Text, PageName) = 0 then + ChildNode := ParentNode.Item[Index]; + + if not Assigned(ChildNode) then + begin + ChildNode := TreeViewCategories.Items.AddChild(ParentNode, PageName); + if Assigned(ParentNode) then + ParentNode.Expand(False); + end; + + AControl.Parent := PanelOptions; + AControl.SetBounds(8, 8, PanelOptions.ClientWidth - 16, PanelOptions.ClientHeight - 16); + AControl.Visible := False; + + AItemDataRec := TItemDataRec.Create; + AItemDataRec.AControl := AControl; + AItemDataRec.Expert := Expert; + ChildNode.Data := Pointer(AItemDataRec); +end; + +constructor TJclOtaOptionsForm.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FSettings := TJclOTASettings.Create(JclConfigurationSettings); +end; + +procedure TJclOtaOptionsForm.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + + // Fixing the Window Ghosting "bug" + Params.Style := params.Style or WS_POPUP; + if Assigned(Screen.ActiveForm) then + Params.WndParent := Screen.ActiveForm.Handle + else if Assigned (Application.MainForm) then + Params.WndParent := Application.MainForm.Handle + else + Params.WndParent := Application.Handle; +end; + +destructor TJclOtaOptionsForm.Destroy; +begin + FreeAndNil(FSettings); + inherited Destroy; +end; + +function TJclOtaOptionsForm.Execute(PageName: string): Boolean; +var + ATreeNode: TTreeNode; + AItemDataRec: TItemDataRec; +begin + // TODO: use PageName + ATreeNode := TreeViewCategories.Items.GetFirstNode; + if Assigned(ATreeNode) then + TreeViewCategories.Selected := ATreeNode; + + Result := ShowModal = mrOk; + + ATreeNode := TreeViewCategories.Items.GetFirstNode; + while Assigned(ATreeNode) do + begin + AItemDataRec := TItemDataRec(ATreeNode.Data); + if Assigned(AItemDataRec) then + begin + AItemDataRec.Expert.ConfigurationClosed(AItemDataRec.AControl, Result); + AItemDataRec.Free; + end; + ATreeNode := ATreeNode.GetNext; + end; +end; + +procedure TJclOtaOptionsForm.FormCreate(Sender: TObject); +begin + Caption := RsConfigurationCaption; + ButtonOk.Caption := RsOk; + ButtonCancel.Caption := RsCancel; + LabelSelectPage.Caption := RsSelectPage; + LabelHomePage.Caption := RsHomePage; + + SetBounds(Settings.LoadInteger(JclLeft, Left), + Settings.LoadInteger(JclTop, Top), + Settings.LoadInteger(JclWidth, Width), + Settings.LoadInteger(JclHeight, Height)); + PanelTree.Width := Settings.LoadInteger(JclPanelTreeWidth, PanelTree.Width); +end; + +procedure TJclOtaOptionsForm.FormDestroy(Sender: TObject); +begin + Settings.SaveInteger(JclLeft, Left); + Settings.SaveInteger(JclTop, Top); + Settings.SaveInteger(JclWidth, Width); + Settings.SaveInteger(JclHeight, Height); + Settings.SaveInteger(JclPanelTreeWidth, PanelTree.Width); +end; + +procedure TJclOtaOptionsForm.LabelHomePageClick(Sender: TObject); +begin + ShellExecute(Handle, 'open', 'http://jcl.sf.net/', '', '', SW_SHOW); +end; + +procedure TJclOtaOptionsForm.TreeViewCategoriesChange(Sender: TObject; + Node: TTreeNode); +var + Index: Integer; + AControl: TControl; +begin + if Assigned(Node.Data) then + AControl := TItemDataRec(Node.Data).AControl + else + AControl := LabelSelectPage; + for Index := 0 to PanelOptions.ControlCount - 1 do + PanelOptions.Controls[Index].Visible := PanelOptions.Controls[Index] = AControl; +end; + +end. \ No newline at end of file diff --git a/official/1.96/experts/common/JclOtaConsts.pas b/official/1.96/experts/common/JclOtaConsts.pas new file mode 100644 index 0000000..8f1e08a --- /dev/null +++ b/official/1.96/experts/common/JclOtaConsts.pas @@ -0,0 +1,143 @@ +{**************************************************************************************************} +{ } +{ 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 JclOtaConsts.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Florent Ouchet } +{ Last modified: $Date: 2006/01/08 17:16:56 $ } +{ } +{**************************************************************************************************} + +unit JclOtaConsts; + +interface + +{$I jcl.inc} + +const + DelphiRootDirKeyValue = 'RootDir'; + JediIDESubKey = 'Jedi\JCL\IDE\'; + DelphiEnvironmentVar = 'DELPHI'; + {$IFDEF COMPILER6_UP} + EnvironmentVarsKey = 'Environment Variables'; + {$ENDIF COMPÏLER6_UP} + BPLExtension = '.bpl'; + DPKExtension = '.dpk'; + MAPExtension = '.map'; + DRCExtension = '.drc'; + DPRExtention = '.dpr'; + BDSPROJExtension = '.bdsproj'; + + //=== Various constants shared by different experts ======================== + JclLeft = 'Left'; + JclTop = 'Top'; + JclWidth = 'Right'; + JclHeight = 'Height'; + + //=== Configuration ======================================================== + JclConfigurationSettings = 'JclExpertConfigurationForm'; + JclActionSettings = 'Actions'; + + //=== Configuration form =================================================== + JclPanelTreeWidth = 'PanelTreeWidth'; + JclConfigureActionName = 'ActionJCLConfigure'; + + //=== Debug Expert ========================================================= + JclDebugExpertRegKey = 'JclDebugExpert'; + JclDebugEnabledRegValue = 'JclDebugEnabled'; + MapFileOptionName = 'MapFile'; + OutputDirOptionName = 'OutputDir'; + RuntimeOnlyOptionName = 'RuntimeOnly'; + PkgDllDirOptionName = 'PkgDllDir'; + BPLOutputDirOptionName = 'PackageDPLOutput'; + LIBPREFIXOptionName = 'SOPrefix'; + LIBSUFFIXOptionName = 'SOSuffix'; + ColumnRegName = 'Column%d'; + + //=== Favorite Folders Expert ============================================== + JclFavoritesExpertName = 'JclFavoriteFoldersExpert'; + JclFavoritesListSubKey = 'Favorites'; + PictDialogFolderItemName = 'PictureDialogPath'; + BorlandImagesPath = 'Borland Shared\Images'; + FavDialogTemplateName = 'FAVDLGTEMPLATE'; + OpenPictDialogTemplateName = 'DLGTEMPLATE'; + + //=== Threads Expert ======================================================= + JclThreadsExpertName = 'JclThreadsExpert'; + MutexName = 'DebugThreadNamesMutex'; + MutexReadName = 'DebugThreadNamesReadMutex'; + MappingName = 'DebugThreadNamesMapping'; + EventName = 'DebugThreadNamesEvent'; + + //=== SIMD Expert ========================================================== + JclSIMDExpertName = 'JclSIMDExpert'; + + //=== Uses Expert ========================================================== + JclUsesExpertName = 'JclUsesExpert'; + SIniIdentifierLists = 'IdentifierLists'; + SRegDebugLibPath = 'Debug Library'; + SRegLibPath = 'Library'; + SRegWizardActive = 'Uses Wizard Active'; + SRegWizardConfirm = 'Uses Wizard Confirm'; + SRegWizardIniFile = 'Configuration File'; + + SJCLUsesWizardID = 'JEDI.JCLUsesWizard'; // wizard ID + SJCLUsesWizardName = 'JCL Uses Wizard'; // wizard name + + //=== Project analyser ===================================================== + AnalyzerViewName = 'AnalyzerView'; + +implementation + +// History: + +// $Log: JclOtaConsts.pas,v $ +// Revision 1.6 2006/01/08 17:16:56 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.5 2005/12/16 23:46:24 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.4 2005/10/26 03:29:44 rrossmair +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and $Log: JclOtaConsts.pas,v $ +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.6 2006/01/08 17:16:56 outchy +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Settings reworked. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Common window for expert configurations +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.5 2005/12/16 23:46:24 outchy +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Added expert stack form. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Added code to display call stack on expert exception. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Fixed package extension for D2006. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and CVS tags. +// +// Revision 1.3 2005/10/23 12:53:36 marquardt +// further expert cleanup and integration, use of JclRegistry +// +// Revision 1.2 2005/10/22 14:24:18 marquardt +// more expert integration and cleanup +// +// Revision 1.1 2005/10/21 12:24:41 marquardt +// experts reorganized with new directory common +// + +end. diff --git a/official/1.96/experts/common/JclOtaExceptionForm.dfm b/official/1.96/experts/common/JclOtaExceptionForm.dfm new file mode 100644 index 0000000..e83152b --- /dev/null +++ b/official/1.96/experts/common/JclOtaExceptionForm.dfm @@ -0,0 +1,62 @@ +object JclExpertExceptionForm: TJclExpertExceptionForm + Left = 157 + Top = 183 + Width = 559 + Height = 463 + BorderIcons = [biSystemMenu] + Caption = 'RsReportFormCaption' + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object LabelURL: TLabel + Left = 8 + Top = 135 + Width = 4 + Height = 16 + Cursor = crHandPoint + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -13 + Font.Name = 'Tahoma' + Font.Style = [fsBold, fsUnderline] + ParentFont = False + OnClick = LabelURLClick + end + object MemoDetails: TMemo + Left = 8 + Top = 8 + Width = 535 + Height = 121 + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + ParentColor = True + ReadOnly = True + TabOrder = 0 + end + object MemoCallStack: TMemo + Left = 8 + Top = 168 + Width = 535 + Height = 231 + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 1 + end + object ButtonClose: TButton + Left = 470 + Top = 405 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = 'RsReportClose' + ModalResult = 1 + TabOrder = 2 + end +end diff --git a/official/1.96/experts/common/JclOtaExceptionForm.pas b/official/1.96/experts/common/JclOtaExceptionForm.pas new file mode 100644 index 0000000..64e5478 --- /dev/null +++ b/official/1.96/experts/common/JclOtaExceptionForm.pas @@ -0,0 +1,142 @@ +{**************************************************************************************************} +{ } +{ 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 JclOtExceptionForm.pas. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ [outchy att users dott sourceforge dott net] } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Florent Ouchet } +{ Last modified: $Date: 2005/12/16 23:46:25 $ } +{ } +{**************************************************************************************************} + +unit JclOtaExceptionForm; + +interface + +{$I jcl.inc} +{$I crossplatform.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, + JclOtaUtils; + +type + TJclExpertExceptionForm = class(TForm) + MemoDetails: TMemo; + LabelURL: TLabel; + MemoCallStack: TMemo; + ButtonClose: TButton; + procedure LabelURLClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + protected + procedure CreateParams(var Params: TCreateParams); override; + public + procedure ShowException(AExceptionObj: TObject); + function Execute: Boolean; + end; + +implementation + +{$R *.dfm} + +uses + TypInfo, ShellApi, +{$IFDEF MSWINDOWS} + JclDebug, +{$ENDIF MSWINDOWS} + JclOtaResources; + +procedure TJclExpertExceptionForm.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + + // Fixing the Window Ghosting "bug" + Params.Style := params.Style or WS_POPUP; + if Assigned(Screen.ActiveForm) then + Params.WndParent := Screen.ActiveForm.Handle + else if Assigned (Application.MainForm) then + Params.WndParent := Application.MainForm.Handle + else + Params.WndParent := Application.Handle; +end; + +function TJclExpertExceptionForm.Execute: Boolean; +begin + Result := ShowModal = mrOk; +end; + +procedure TJclExpertExceptionForm.FormCreate(Sender: TObject); +begin + Caption := RsReportFormCaption; + MemoDetails.Lines.Text := RsExceptionDetails; + LabelURL.Caption := RsReportCaption; + ButtonClose.Caption := RsReportClose; +end; + +procedure TJclExpertExceptionForm.LabelURLClick(Sender: TObject); +begin + ShellExecute(Handle, 'open', PChar(RsReportURL), '', '', SW_SHOW); // do not localize +end; + +procedure TJclExpertExceptionForm.ShowException(AExceptionObj: TObject); +var + AStackInfoList: TJclStackInfoList; +begin + MemoCallStack.Lines.Clear; + + try + if Assigned(AExceptionObj) then + MemoCallStack.Lines.Add(RsDetailsExceptionName + AExceptionObj.ClassName); + + if AExceptionObj is Exception then + begin + MemoCallStack.Lines.Add(RsDetailsExceptionMessage + Exception(AExceptionObj).Message); +{$IFDEF MSWINDOWS} + if (AExceptionObj is EJclExpertException) then + with EJclExpertException(AExceptionObj) do + if Assigned(StackInfo) then + begin + StackInfo.AddToStrings(MemoCallStack.Lines, True, True, True, True); + Exit; + end; +{$ENDIF MSWINDOWS} + end; + +{$IFDEF MSWINDOWS} + AStackInfoList := JclCreateStackList(False, 0, nil); + try + AStackInfoList.AddToStrings(MemoCallStack.Lines, True, True, True, True); + finally + AStackInfoList.Free; + end; +{$ENDIF MSWINDOWS} + except + MemoCallStack.Lines.Add(RsErrorWhileFormatting); + end; +end; + +end. + +// History: + +// $Log: JclOtaExceptionForm.pas,v $ +// Revision 1.1 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// \ No newline at end of file diff --git a/official/1.96/experts/common/JclOtaResources.pas b/official/1.96/experts/common/JclOtaResources.pas new file mode 100644 index 0000000..19dc522 --- /dev/null +++ b/official/1.96/experts/common/JclOtaResources.pas @@ -0,0 +1,297 @@ +{**************************************************************************************************} +{ } +{ 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 JclOtaResources.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Florent Ouchet } +{ Last modified: $Date: 2006/01/08 17:16:56 $ } +{ } +{**************************************************************************************************} + +unit JclOtaResources; + +interface + +{$I jcl.inc} + +uses JclBase; + +//=== JclOtaUtils.pas ======================================================== +resourcestring + RsENoIDEServices = 'Unable to get Borland IDE Services'; + RsENoNTAServices = 'Unable to get Borland NTA Services'; + RsENoSplashServices = 'Unable to get Borland Splash Services'; + RsENoAboutServices = 'Unable to get Borland About Services'; + RsENoModuleServices = 'Unable to get Borland Module Services'; + RsENoWizardServices = 'Unable to get Borland Wizard Services'; + RsENoPackageServices = 'Unable to get Borland Package Services'; + RsENoModule = 'Unable to get Module'; + RsBadModuleHInstance = 'Unable to get module HInstance'; + RsENoRootDir = 'RootDir is empty'; + RsENoIDEMenu = 'Unable to get IDE menu'; + RsENoToolsMenu = 'Unable to get Tools menu'; + + RsAboutDialogTitle = 'JEDI Code Library'; + RsAboutCopyright = 'Copyright the JCL development team'; + RsAboutTitle = 'JEDI Code Library'; + RsAboutDescription = 'JEDI Code Library http://jcl.sf.net' + AnsiLineBreak + + 'The JCL is a member of the JEDI Project http://www.delphi-jedi.org' + AnsiLineBreak + + 'Covered under the Mozilla Public License v1.1 (MPL 1.1)' + AnsiLineBreak + + 'License available at http://www.mozilla.org/MPL/MPL-1.1.html'; + RsAboutLicenceStatus = 'MPL 1.1'; + RsJCLOptions = 'JCL Options...'; + RsActionSheet = 'Common\Actions'; + RsENoBitmapResources = 'Unable to load bitmap resource'; + RsENoEnvironmentOptions = 'Environment options are not available'; + +//=== JclExceptionForm.pas =================================================== +resourcestring + RsReportFormCaption = 'Exception in an expert of the JCL'; + RsExceptionDetails = 'An exception was raised in an expert of the JCL.' + AnsiLineBreak + + 'The JCL development team expects quality and performance for the library.' + + 'That''s why we highly encourage you to report this exception by quoting ' + + 'your version of Delphi/BCB/BDS (including patch numbers), by explaining ' + + 'steps to reproduce and by copying the call stack displayed in the box below.' + AnsiLineBreak + + 'There are several ways to report bugs in the JCL:' + AnsiLineBreak + + ' - issue tracker (recommended),' + AnsiLineBreak + + ' - jedi newsgroups,' + AnsiLineBreak + + ' - mailing list.' + AnsiLineBreak + + 'Details and guidelines for these tools are available at:'; + RsReportURL = 'http://homepages.borland.com/jedi/jcl/page24.html'; + RsReportCaption = 'JCL - Feedback&&Support - Report a bug page'; + RsDetailsExceptionName = 'Exception class name: '; + RsDetailsExceptionMessage = 'Exception message: '; + RsErrorWhileFormatting = 'An exception was raised while formatting details for the report'; + RsReportClose = '&Close'; + +//=== JclOtaActionConfigureSheet.pas ========================================= +resourcestring + RsActions = '&Actions :'; + RsCaption = 'Caption'; + RsShortcut = 'Shortcut'; + RsRestore = '&Restore'; + +//=== JclExpertConfigurationForm.pas ========================================= +resourcestring + RsConfigurationCaption = 'JCL Options'; + RsOk = '&Ok'; + RsCancel = '&Cancel'; + RsSelectPage = 'Select a page'; + RsHomePage = '&JCL Home page'; + +//=== OpenDlgFavAdapter.pas ================================================== +resourcestring + RsAdd = '<- Add'; + RsDelete = '&Delete'; + RsFavorites = '&Favorites'; + RsConfirmation = 'Confirmation'; + RsDelConfirm = 'Are you sure to delete "%s" from favorite folders?'; + +//=== JclUsesDialog.pas ====================================================== +resourcestring + RsActionSkip = 'Skip'; + RsActionAdd = 'Add'; + RsActionMove = 'Move'; + RsSectionImpl = 'to implementation uses'; + RsSectionIntf = 'to interface uses'; + RsUndeclIdent = '[Error] %s(%d) Undeclared identifier: ''%s'''; + RsConfirmChanges = '%s: Confirm changes'; + +//=== JclParseUses.pas ======================================================= +resourcestring + RsEDuplicateUnit = 'Duplicate unit ''%s'''; + RsEInvalidLibrary = 'Invalid library'; + RsEInvalidProgram = 'Invalid program'; + RsEInvalidUnit = 'Invalid unit'; + RsEInvalidUses = 'Invalid uses clause'; + +//=== ThreadExpertSharedNames.pas ============================================ +resourcestring + RsEnterMutexTimeout = 'JCL Thread Name IDE Expert Mutex Timeout'; + +//=== ProjAnalyserImpl.pas =================================================== +resourcestring + RsAnalyzeActionCaption = 'Analyze project %s'; + RsAnalyzeActionName = 'ProjectAnalyseCommand'; + RsProjectNone = '[none]'; + RsCantFindFiles = 'Can''t find MAP or executable file'; + RsBuildingProject = 'Building project %s ...'; + RsAnalyseMenuItemNotInserted = 'Can''t insert the analyse menu item'; + +//=== ProjAnalyzerFrm.pas ==================================================== +resourcestring + RsFormCaption = 'Project Analyzer - %s'; + RsStatusText = 'Units: %d, Forms: %d, Code: %d, Data: %d, Bss: %d, Resources: %d'; + RsCodeData = '(CODE+DATA)'; + +//=== JclUsesWizard.pas ====================================================== +resourcestring + RsJediOptionsCaption = 'JEDI Options'; + RsEErrorReadingBuffer = 'Error reading from edit buffer'; + RsUsesSheet = 'Uses wizard'; + +//=== JclOptionsFrame.pas ==================================================== +resourcestring + RsUsesConfigurationFile = '&Configuration file:'; + RsUsesActive = '&Active'; + RsUsesConfirm = '&Prompt to confirm changes'; + RsUsesOpenTitle = 'Select JEDI Uses wizard configuration file'; + RsUsesOpenFilters = 'Configuration files (*.ini)|*.ini|All files (*.*)|*.*'; + +//=== JclDebugIdeImpl.pas ==================================================== +resourcestring + RsENoProjectOptions = 'Project options are not available'; + RsBuildActionCaption = 'Build JCL Debug %s'; + RsBuildAllCaption = 'Build JCL Debug All Projects'; + RsBuildActionName = 'ProjectJCLBuildCommand'; + RsBuildAllActionName = 'ProjectJCLBuildAllCommand'; + RsCantInsertToInstalledPackage = 'JCL Debug IDE Expert: Can not insert debug information to installed package' + + #13#10'%s'#13#10#10'Would you like to disable inserting JCL Debug data ?'; + RsInsertDataCaption = 'Insert JCL Debug data'; + RsInsertDataActionName = 'ProjectJCLInsertDataCommand'; + RsEExecutableNotFound = 'Executable file (*.exe or *.dll) not found.' + + 'JCL debug data can''t be added to the project.'; + RsENoActiveProject = 'No active project'; + RsENoProjectMenuItem = 'Project menu item not found'; + RsENoBuildMenuItem = 'Build menu item not found'; + RsEBuildMenuItemNotInserted = 'Can''t insert the build menu item'; + RsEInsertDataMenuItemNotInserted = 'Can''t insert the insert data menu item'; + RsENoBuildAction = 'Build action not found'; + RsENoBuildAllAction = 'Build All action not found'; + RsENoProjectGroup = 'No project group'; + +//=== JclSIMDView.pas ======================================================== +resourcestring + RsENoDebuggerServices = 'Unable to get Borland Debugger Services'; + RsENoViewMenuItem = 'View menu item not found'; + RsENoDebugWindowsMenuItem = 'Debug windows menu item not found'; + +//=== JclSIMDUtils.pas ======================================================= +resourcestring + RsSIMD = 'SIMD'; + RsMMX = 'MMX'; + RsExMMX = 'Ex MMX'; + Rs3DNow = '3DNow!'; + RsEx3DNow = 'Ex 3DNow!'; + RsSSE1 = 'SSE1'; + RsSSE2 = 'SSE2'; + RsSSE3 = 'SSE3'; + RsLong = '64-bit Core'; + + RsTrademarks = + 'MMX is a trademark of Intel Corporation.' + #13#10 + + '3DNow! is a registered trademark of Advanced Micro Devices.'; + + RsNoSIMD = 'No SIMD registers found'; + RsNoSSE = 'SSE are not supported on this processor'; + RsNo128SIMD = 'No 128-bit-register SIMD'; + RsNo64SIMD = 'No 64-bit-register SIMD'; + RsNotSupportedFormat = ''; + RsNoPackedData = ''; + RsFormCreateError = 'An exception was triggered while creating the debug window : '; + RsModifyMM = 'Modification of MM%d'; + RsModifyXMM1 = 'Modification of XMM%d'; + RsModifyXMM2 = 'Modification of XMM%.2d'; + + RsVectorIE = 'IE '; + RsVectorDE = 'DE '; + RsVectorZE = 'ZE '; + RsVectorOE = 'OE '; + RsVectorUE = 'UE '; + RsVectorPE = 'PE '; + RsVectorDAZ = 'DAZ '; // (Only in Intel P4, Intel Xeon and AMD) + RsVectorIM = 'IM '; + RsVectorDM = 'DM '; + RsVectorZM = 'ZM '; + RsVectorOM = 'OM '; + RsVectorUM = 'UM '; + RsVectorPM = 'PM '; + RsVectorRC = 'RC '; + RsVectorFZ = 'FZ '; + + RsVectorIEText = 'Invalid-operation exception'; + RsVectorDEText = 'Denormal-operand exception'; + RsVectorZEText = 'Zero-divide exception'; + RsVectorOEText = 'Overflow exception'; + RsVectorUEText = 'Underflow exception'; + RsVectorPEText = 'Precision exception'; + RsVectorDAZText = 'Denormal are zeros'; // (Only in Intel P4, Intel Xeon and AMD) + RsVectorIMText = 'Invalid-operation mask'; + RsVectorDMText = 'Denormal-operand mask'; + RsVectorZMText = 'Zero-divide mask'; + RsVectorOMText = 'Overflow mask'; + RsVectorUMText = 'Underflow mask'; + RsVectorPMText = 'Precision mask'; + RsVectorRCText = 'Rounding control'; + RsVectorFZText = 'Flush to zero'; + + RsRoundToNearest = 'Round to nearest'; + RsRoundDown = 'Round down'; + RsRoundUp = 'Round up'; + RsRoundTowardZero = 'Round toward zero'; + + RsEBadRegisterDisplay = 'Bad register display'; + +//=== JclSIMDViewForm.pas ==================================================== +resourcestring + RsECantUpdateThreadContext = 'Unable to update the thread context'; + +implementation + +// History: + +// $Log: JclOtaResources.pas,v $ +// Revision 1.10 2006/01/08 17:16:56 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.9 2005/12/26 18:03:39 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.8 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.7 2005/10/27 13:50:39 rrossmair +// - cleaned up mistakenly expanded check-in comments +// +// Revision 1.6 2005/10/27 08:31:08 outchy +// Items add in the splash screen and in the about box of Delphi (requires at least D2005) +// +// Revision 1.5 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// +// Revision 1.4 2005/10/24 12:05:51 marquardt +// further cleanup +// +// Revision 1.3 2005/10/23 12:53:36 marquardt +// further expert cleanup and integration, use of JclRegistry +// +// Revision 1.2 2005/10/22 14:24:18 marquardt +// more expert integration and cleanup +// +// Revision 1.1 2005/10/21 12:24:41 marquardt +// experts reorganized with new directory common +// + +end. diff --git a/official/1.96/experts/common/JclOtaUtils.pas b/official/1.96/experts/common/JclOtaUtils.pas new file mode 100644 index 0000000..4d791ac --- /dev/null +++ b/official/1.96/experts/common/JclOtaUtils.pas @@ -0,0 +1,1218 @@ +{**************************************************************************************************} +{ } +{ 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 JclOtaUtils.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{ Contributors: } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Florent Ouchet } +{ Last modified: $Date: 2006/02/02 19:57:08 $ } +{ } +{**************************************************************************************************} + +unit JclOtaUtils; + +interface + +{$I jcl.inc} +{$I crossplatform.inc} + +uses + SysUtils, Classes, Windows, + Controls, ComCtrls, ActnList, Menus, +{$IFDEF MSWINDOWS} + JclDebug, +{$ENDIF MSWINDOWS} + ToolsAPI; + +const + MapFileOptionDetailed = 3; + +type +// note to developers +// to avoid JCL exceptions to be reported as Borland's exceptions in automatic +// bug reports, all entry points should be protected with this code model: +// uses +// JclOtaUtils; +// try +// +// except +// on ExceptionObj: TObject do +// begin +// JclExpertShowExceptionDialog(ExceptionObj); +// raise; +// end; +// end; +// entry points for experts are usually: +// - initialization sections +// - finalization sections +// - Register procedures +// - expert entry point +// - Action update events +// - Action execute events +// - notifier callback functions +// - ... (non exhaustive list) + + EJclExpertException = class (Exception) + {$IFDEF MSWINDOWS} + private + FStackInfo: TJclStackInfoList; + {$ENDIF MSWINDOWS} + public + constructor CreateTrace(const Msg: string); + {$IFDEF MSWINDOWS} + destructor Destroy; override; + property StackInfo: TJclStackInfoList read FStackInfo; + {$ENDIF MSWINDOWS} + end; + + TJclOTASettings = class (TObject) + private + FKeyName: string; + FBaseKeyName: string; + public + constructor Create(ExpertName: string); + function LoadBool(Name: string; Def: Boolean): Boolean; + function LoadString(Name: string; Def: string): string; + function LoadInteger(Name: string; Def: Integer): Integer; + procedure LoadStrings(Name: string; List: TStrings); + procedure SaveBool(Name: string; Value: Boolean); + procedure SaveString(Name: string; Value: string); + procedure SaveInteger(Name: string; Value: Integer); + procedure SaveStrings(Name: string; List: TStrings); + property KeyName: string read FKeyName; + property BaseKeyName: string read FBaseKeyName; + end; + + // Note: we MUST use an interface as the type of the Expert parameter + // and not an object to avoid a bug in C++ Builder 5 compiler. If we + // used an object, the compiler would crash or give internal error GH4148 + // being obviously lost trying to resolve almost circular references + // between this unit and the JclOtaConfigurationForm unit. + IJclOTAOptionsCallback = interface; + + TJclOTAAddPageFunc = procedure (AControl: TControl; PageName: string; + Expert: IJclOTAOptionsCallback) of object; + + IJclOTAOptionsCallback = interface + procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); + procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); + end; + + TJclOTAExpertBase = class(TInterfacedObject, IJclOTAOptionsCallback) + private + FEnvVariables: TStringList; + FRootDir: string; + FServices: IOTAServices; + FName: string; + FNTAServices: INTAServices; + FSettings: TJclOTASettings; + function GetModuleHInstance: Cardinal; + function GetActiveProject: IOTAProject; + function GetProjectGroup: IOTAProjectGroup; + function GetRootDir: string; + procedure ReadEnvVariables; + procedure ConfigurationActionUpdate(Sender: TObject); + procedure ConfigurationActionExecute(Sender: TObject); + public + class procedure AddExpert(AExpert: TJclOTAExpertBase); + class procedure RemoveExpert(AExpert: TJclOTAExpertBase); + class function GetExpertCount: Integer; + class function GetExpert(Index: Integer): TJclOTAExpertBase; + class function ConfigurationDialog(StartName: string = ''): Boolean; + class procedure CheckToolBarButton(AToolBar: TToolBar; AAction: TCustomAction); + class function GetActionCount: Integer; + class function GetAction(Index: Integer): TAction; + class function ActionSettings: TJclOtaSettings; + public + constructor Create(AName: string); virtual; + destructor Destroy; override; + + function FindExecutableName(const MapFileName, OutputDirectory: string; + var ExecutableFileName: string): Boolean; + function GetDrcFileName(const Project: IOTAProject): string; + function GetMapFileName(const Project: IOTAProject): string; + function GetOutputDirectory(const Project: IOTAProject): string; + function IsInstalledPackage(const Project: IOTAProject): Boolean; + function IsPackage(const Project: IOTAProject): Boolean; + function SubstitutePath(const Path: string): string; + + procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); virtual; + procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); virtual; + + procedure RegisterCommands; virtual; + procedure UnregisterCommands; virtual; + procedure RegisterAction(Action: TCustomAction); + procedure UnregisterAction(Action: TCustomAction); + + property ActiveProject: IOTAProject read GetActiveProject; + property Settings: TJclOTASettings read FSettings; + property Name: string read FName; + property NTAServices: INTAServices read FNTAServices; + property ProjectGroup: IOTAProjectGroup read GetProjectGroup; + property RootDir: string read GetRootDir; + property Services: IOTAServices read FServices; + + property ModuleHInstance: Cardinal read GetModuleHInstance; + end; + + TJclOTAExpert = class(TJclOTAExpertBase, IOTAWizard) + protected + procedure AfterSave; + procedure BeforeSave; + procedure Destroyed; + procedure Modified; + procedure Execute; + function GetIDString: string; + function GetName: string; + function GetState: TWizardState; + end; + +// procedure SaveOptions(const Options: IOTAOptions; const FileName: string); +function JclExpertShowExceptionDialog(AExceptionObj: TObject): Boolean; + +{$IFDEF BDS} +procedure RegisterSplashScreen; +procedure RegisterAboutBox; +{$ENDIF BDS} + +implementation + +uses + {$IFDEF HAS_UNIT_VARIANTS} + Variants, + {$ENDIF HAS_UNIT_VARIANTS} + Forms, Graphics, Dialogs, + {$IFDEF MSWINDOWS} + ImageHlp, JclRegistry, + {$ENDIF MSWINDOWS} + {$IFDEF KYLIX} + JclBorlandTools, + {$ENDIF KYLIX} + JclFileUtils, JclStrings, JclSysInfo, + JclOtaConsts, JclOtaResources, JclOtaExceptionForm, JclOtaConfigurationForm, + JclOtaActionConfigureSheet; + +{$IFDEF BDS} +{$R 'JclImages.res'} +{$ENDIF BDS} + +var + GlobalActionList: TList = nil; + GlobalActionSettings: TJclOtaSettings = nil; + GlobalExpertList: TList = nil; + ConfigurationAction: TAction = nil; + ConfigurationMenuItem: TMenuItem = nil; + ActionConfigureSheet: TJclOtaActionConfigureFrame = nil; + {$IFNDEF COMPILER6_UP} + OldFindGlobalComponentProc: TFindGlobalComponent = nil; + {$ENDIF COMPILER6_UP} + +function FindActions(const Name: string): TComponent; +var + Index: Integer; + TestAction: TCustomAction; +begin + try + Result := nil; + if Assigned(GlobalActionList) then + for Index := 0 to GlobalActionList.Count-1 do + begin + TestAction := TCustomAction(GlobalActionList.Items[Index]); + if (CompareText(Name,TestAction.Name) = 0) then + Result := TestAction; + end; + {$IFNDEF COMPILER6_UP} + if (not Assigned(Result)) and Assigned(OldFindGlobalComponentProc) then + Result := OldFindGlobalComponentProc(Name) + {$ENDIF COMPILER6_UP} + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +function JclExpertShowExceptionDialog(AExceptionObj: TObject): Boolean; +var + AJclExpertExceptionForm: TJclExpertExceptionForm; +begin + AJclExpertExceptionForm := TJclExpertExceptionForm.Create(Application); + try + AJclExpertExceptionForm.ShowException(AExceptionObj); + Result := AJclExpertExceptionForm.Execute; + finally + AJclExpertExceptionForm.Free; + end; +end; + +//=== { EJclExpertException } ================================================ + +constructor EJclExpertException.CreateTrace(const Msg: string); +begin + inherited Create(Msg); +{$IFDEF MSWINDOWS} + FStackInfo := JclCreateStackList(False, 0, nil); +{$ENDIF MSWINDOWS} +end; + +{$IFDEF MSWINDOWS} +destructor EJclExpertException.Destroy; +begin + FreeAndNil(FStackInfo); + inherited Destroy; +end; +{$ENDIF MSWINDOWS} + +{ TJclOTASettings } + +constructor TJclOTASettings.Create(ExpertName: string); +var + OTAServices: IOTAServices; +begin + inherited Create; + + Supports(BorlandIDEServices,IOTAServices,OTAServices); + if not Assigned(OTAServices) then + raise EJclExpertException.CreateTrace(RsENoIDEServices); + + FBaseKeyName := StrEnsureSuffix('\', OTAServices.GetBaseRegistryKey); + + FKeyName := BaseKeyName + JediIDESubKey + ExpertName; +end; + +function TJclOTASettings.LoadBool(Name: string; Def: Boolean): Boolean; +begin + {$IFDEF MSWINDOWS} + Result := RegReadBoolDef(HKCU, KeyName, Name, Def); + {$ELSE MSWINDOWS} + Result := Def; + {$ENDIF MSWINDOWS} +end; + +function TJclOTASettings.LoadInteger(Name: string; Def: Integer): Integer; +begin + {$IFDEF MSWINDOWS} + + Result := RegReadIntegerDef(HKCU, KeyName, Name, Def); + {$ELSE MSWINDOWS} + Result := Def; + {$ENDIF MSWINDOWS} +end; + +function TJclOTASettings.LoadString(Name, Def: string): string; +begin + {$IFDEF MSWINDOWS} + Result := RegReadStringDef(HKCU, KeyName, Name, Def); + {$ELSE MSWINDOWS} + Result := Def; + {$ENDIF MSWINDOWS} +end; + +procedure TJclOTASettings.LoadStrings(Name: string; List: TStrings); +begin + {$IFDEF MSWINDOWS} + RegLoadList(HKCU, KeyName, Name, List); + {$ELSE MSWINDOWS} + List.Clear; + {$ENDIF MSWINDOWS} +end; + +procedure TJclOTASettings.SaveBool(Name: string; Value: Boolean); +begin + {$IFDEF MSWINDOWS} + RegWriteBool(HKCU, KeyName, Name, Value); + {$ENDIF MSWINDOWS} +end; + +procedure TJclOTASettings.SaveInteger(Name: string; Value: Integer); +begin + {$IFDEF MSWINDOWS} + RegWriteInteger(HKCU, KeyName, Name, Value); + {$ENDIF MSWINDOWS} +end; + +procedure TJclOTASettings.SaveString(Name, Value: string); +begin + {$IFDEF MSWINDOWS} + RegWriteString(HKCU, KeyName, Name, Value); + {$ENDIF MSWINDOWS} +end; + +procedure TJclOTASettings.SaveStrings(Name: string; List: TStrings); +begin + {$IFDEF MSWINDOWS} + RegSaveList(HKCU, KeyName, Name, List); + {$ENDIF MSWINDOWS} +end; + +//=== { TJclOTAExpertBase } ================================================== + +class function TJclOTAExpertBase.ConfigurationDialog( + StartName: string): Boolean; +var + OptionsForm: TJclOtaOptionsForm; + Index: Integer; +begin + OptionsForm := TJclOtaOptionsForm.Create(nil); + try + for Index := 0 to GetExpertCount - 1 do + GetExpert(Index).AddConfigurationPages(OptionsForm.AddPage); + Result := OptionsForm.Execute(StartName); + finally + OptionsForm.Free; + end; +end; + +class function TJclOTAExpertBase.GetExpert(Index: Integer): TJclOTAExpertBase; +begin + if Assigned(GlobalExpertList) then + Result := TJclOTAExpertBase(GlobalExpertList.Items[Index]) + else + Result := nil; +end; + +class function TJclOTAExpertBase.GetExpertCount: Integer; +begin + if Assigned(GlobalExpertList) then + Result := GlobalExpertList.Count + else + Result := 0; +end; + +class procedure TJclOTAExpertBase.AddExpert(AExpert: TJclOTAExpertBase); +begin + if not Assigned(GlobalExpertList) then + GlobalExpertList := TList.Create; + GlobalExpertList.Add(AExpert); +end; + +class procedure TJclOTAExpertBase.RemoveExpert(AExpert: TJclOTAExpertBase); +begin + if Assigned(GlobalExpertList) then + GlobalExpertList.Remove(AExpert); +end; + +class function TJclOTAExpertBase.GetAction(Index: Integer): TAction; +begin + if Assigned(GlobalActionList) then + Result := TAction(GlobalActionList.Items[Index]) + else + Result := nil; +end; + +class function TJclOTAExpertBase.GetActionCount: Integer; +begin + if Assigned(GlobalActionList) then + Result := GlobalActionList.Count + else + Result := 0; +end; + +type + TAccessToolButton = class(TToolButton); + +class procedure TJclOTAExpertBase.CheckToolBarButton(AToolBar: TToolBar; AAction: TCustomAction); +var + Index: Integer; + AButton: TAccessToolButton; +begin + if Assigned(AToolBar) then + for Index := AToolBar.ButtonCount - 1 downto 0 do + begin + AButton := TAccessToolButton(AToolBar.Buttons[Index]); + if AButton.Action = AAction then + begin + AButton.SetToolBar(nil); + AButton.Free; + end; + end; +end; + +class function TJclOTAExpertBase.ActionSettings: TJclOtaSettings; +begin + if not Assigned(GlobalActionSettings) then + GlobalActionSettings := TJclOTASettings.Create(JclActionSettings); + Result := GlobalActionSettings; +end; + +procedure TJclOTAExpertBase.ConfigurationActionExecute(Sender: TObject); +begin + try + ConfigurationDialog(''); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclOTAExpertBase.ConfigurationActionUpdate(Sender: TObject); +begin + try + (Sender as TAction).Enabled := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclOTAExpertBase.AddConfigurationPages( + AddPageFunc: TJclOTAAddPageFunc); +begin + // AddPageFunc uses '\' as a separator in PageName to build a tree + if not Assigned(ActionConfigureSheet) then + begin + ActionConfigureSheet := TJclOtaActionConfigureFrame.Create(Application); + AddPageFunc(ActionConfigureSheet, RsActionSheet, Self); + end; + // override to customize +end; + +procedure TJclOTAExpertBase.ConfigurationClosed(AControl: TControl; + SaveChanges: Boolean); +begin + if Assigned(AControl) and (AControl = ActionConfigureSheet) then + begin + if SaveChanges then + ActionConfigureSheet.SaveChanges; + FreeAndNil(ActionConfigureSheet); + end + else + AControl.Free; + // override to customize +end; + +constructor TJclOTAExpertBase.Create(AName: string); +begin + inherited Create; + + {$IFDEF BDS} + RegisterSplashScreen; + RegisterAboutBox; + {$ENDIF BDS} + + Supports(BorlandIDEServices,IOTAServices,FServices); + if not Assigned(FServices) then + raise EJclExpertException.CreateTrace(RsENoIDEServices); + + Supports(FServices,INTAServices,FNTAServices); + if not Assigned(FNTAServices) then + raise EJclExpertException.CreateTrace(RsENoNTAServices); + + FName := AName; + FEnvVariables := TStringList.Create; + FSettings := TJclOTASettings.Create(FName); + + RegisterCommands; + + AddExpert(Self); +end; + +destructor TJclOTAExpertBase.Destroy; +begin + RemoveExpert(Self); + + UnRegisterCommands; + + FreeAndNil(FSettings); + FreeAndNil(FEnvVariables); + + FServices := nil; + FNTAServices := nil; + + inherited Destroy; +end; + +function TJclOTAExpertBase.FindExecutableName(const MapFileName, OutputDirectory: string; + var ExecutableFileName: string): Boolean; +var + Se: TSearchRec; + Res: Integer; + LatestTime: Integer; + FileName: TFileName; + {$IFDEF MSWINDOWS} + LI: LoadedImage; + {$ENDIF MSWINDOWS} +begin + LatestTime := 0; + ExecutableFileName := ''; + // the latest executable file is very likely our file + Res := SysUtils.FindFirst(ChangeFileExt(MapFileName, '.*'), faArchive, Se); + while Res = 0 do + begin + FileName := PathAddSeparator(OutputDirectory) + Se.Name; + {$IFDEF MSWINDOWS} + if MapAndLoad(PChar(FileName), nil, @LI, False, True) then + begin + if (not LI.fDOSImage) and (Se.Time > LatestTime) then + begin + ExecutableFileName := FileName; + LatestTime := Se.Time; + end; + UnMapAndLoad(@LI); + end; + {$ELSE} + if Se.Time > LatestTime then + begin + ExecutableFileName := FileName; + LatestTime := Se.Time; + end; + {$ENDIF MSWINDOWS} + Res := SysUtils.FindNext(Se); + end; + SysUtils.FindClose(Se); + Result := (ExecutableFileName <> ''); +end; + +function TJclOTAExpertBase.GetActiveProject: IOTAProject; +var + TempProjectGroup: IOTAProjectGroup; +begin + TempProjectGroup := ProjectGroup; + if Assigned(TempProjectGroup) then + Result := TempProjectGroup.ActiveProject + else + Result := nil; +end; + +function TJclOTAExpertBase.GetDrcFileName(const Project: IOTAProject): string; +begin + if not Assigned(Project) then + raise EJclExpertException.CreateTrace(RsENoActiveProject); + + Result := ChangeFileExt(Project.FileName, DRCExtension); +end; + +function TJclOTAExpertBase.GetMapFileName(const Project: IOTAProject): string; +var + ProjectFileName, OutputDirectory, LibPrefix, LibSuffix: string; +begin + if not Assigned(Project) then + raise EJclExpertException.CreateTrace(RsENoActiveProject); + + ProjectFileName := Project.FileName; + OutputDirectory := GetOutputDirectory(Project); + {$IFDEF RTL140_UP} + if not Assigned(Project.ProjectOptions) then + raise EJclExpertException.CreateTrace(RsENoProjectOptions); + LibPrefix := Trim(VarToStr(Project.ProjectOptions.Values[LIBPREFIXOptionName])); + LibSuffix := Trim(VarToStr(Project.ProjectOptions.Values[LIBSUFFIXOptionName])); + {$ELSE ~RTL140_UP} + LibPrefix := ''; + LibSuffix := ''; + {$ENDIF ~RTL140_UP} + Result := PathAddSeparator(OutputDirectory) + LibPrefix + + PathExtractFileNameNoExt(ProjectFileName) + LibSuffix + MAPExtension; +end; + +function TJclOTAExpertBase.GetModuleHInstance: Cardinal; +begin + Result := FindClassHInstance(ClassType); + if Result = 0 then + raise EJclExpertException.CreateTrace(RsBadModuleHInstance); +end; + +function TJclOTAExpertBase.GetOutputDirectory(const Project: IOTAProject): string; +begin + if not Assigned(Project) then + raise EJclExpertException.CreateTrace(RsENoActiveProject); + if not Assigned(Project.ProjectOptions) then + raise EJclExpertException.CreateTrace(RsENoProjectOptions); + + if IsPackage(Project) then + begin + Result := VarToStr(Project.ProjectOptions.Values[PkgDllDirOptionName]); + + if Result = '' then + begin + if not Assigned(FServices.GetEnvironmentOptions) then + raise EJclExpertException.CreateTrace(RsENoEnvironmentOptions); + Result := FServices.GetEnvironmentOptions.Values[BPLOutputDirOptionName]; + end; + end + else + Result := VarToStr(Project.ProjectOptions.Values[OutputDirOptionName]); + + Result := SubstitutePath(Trim(Result)); + if Result = '' then + Result := ExtractFilePath(Project.FileName); +end; + +function TJclOTAExpertBase.GetProjectGroup: IOTAProjectGroup; +var + AModuleServices: IOTAModuleServices; + AModule: IOTAModule; + I: Integer; +begin + Supports(BorlandIDEServices, IOTAModuleServices, AModuleServices); + if not Assigned(AModuleServices) then + raise EJclExpertException.CreateTrace(RsENoModuleServices); + + for I := 0 to AModuleServices.ModuleCount - 1 do + begin + AModule := AModuleServices.Modules[I]; + if not Assigned(AModule) then + raise EJclExpertException.CreateTrace(RsENoModule); + if AModule.QueryInterface(IOTAProjectGroup, Result) = S_OK then + Exit; + end; + + Result := nil; +end; + +function TJclOTAExpertBase.GetRootDir: string; +{$IFDEF KYLIX} +var + RADToolsInstallations: TJclBorRADToolInstallations; + RADToolInstallation: TJclBorRADToolInstallation; +{$ENDIF KYLIX} +begin + if FRootDir = '' then + begin + //(usc) another possibility for D7 or higher is to use IOTAServices.GetRootDirectory + {$IFDEF MSWINDOWS} + FRootDir := RegReadStringDef(HKEY_LOCAL_MACHINE, Settings.BaseKeyName, DelphiRootDirKeyValue, ''); + // (rom) bugfix if using -r switch of D9 by Dan Miser + if FRootDir = '' then + FRootDir := RegReadStringDef(HKEY_CURRENT_USER, Settings.BaseKeyName, DelphiRootDirKeyValue, ''); + {$ENDIF MSWINDOWS} + {$IFDEF KYLIX} + RADToolsInstallations := TJclBorRADToolInstallations.Create; + try + {$IFDEF KYLIX3} + {$IFDEF BCB} + RADToolInstallation := RADToolsInstallations.BCBInstallationFromVersion[3]; + {$ELSE} + RADToolInstallation := RADToolsInstallations.DelphiInstallationFromVersion[3]; + {$ENDIF BCB} + {$ELSE} + RADToolInstallation := nil; + {$ENDIF KYLIX3} + if Assigned(RADToolInstallation) then + FRootDir := RADToolInstallation.RootDir; + finally + RADToolsInstallations.Free; + end; + {$ENDIF KYLIX} + if FRootDir = '' then + raise EJclExpertException.CreateTrace(RsENoRootDir); + end; + Result := FRootDir; +end; + +function TJclOTAExpertBase.IsInstalledPackage(const Project: IOTAProject): Boolean; +var + PackageFileName, ExecutableNameNoExt: string; + APackageServices: IOTAPackageServices; + I: Integer; +begin + if not Assigned(Project) then + raise EJclExpertException.CreateTrace(RsENoActiveProject); + + Result := IsPackage(Project); + if Result then + begin + Result := False; + + if not Assigned(Project.ProjectOptions) then + raise EJclExpertException.CreateTrace(RsENoProjectOptions); + + if not Project.ProjectOptions.Values[RuntimeOnlyOptionName] then + begin + ExecutableNameNoExt := ChangeFileExt(GetMapFileName(Project), ''); + + Supports(BorlandIDEServices, IOTAPackageServices, APackageServices); + + if not Assigned(APackageServices) then + raise EJclExpertException.CreateTrace(RsENoPackageServices); + + for I := 0 to APackageServices.PackageCount - 1 do + begin + PackageFileName := ChangeFileExt(APackageServices.PackageNames[I], BPLExtension); + PackageFileName := GetModulePath(GetModuleHandle(PChar(PackageFileName))); + if AnsiSameText(ChangeFileExt(PackageFileName, ''), ExecutableNameNoExt) then + begin + Result := True; + Break; + end; + end; + end; + end; +end; + +function TJclOTAExpertBase.IsPackage(const Project: IOTAProject): Boolean; +var + FileName, FileExtension, ProjectContent: string; + Index, SourceNodePosition: Integer; + ProjectFile: TStrings; +begin + if not Assigned(Project) then + raise EJclExpertException.CreateTrace(RsENoActiveProject); + + FileName := Project.FileName; + FileExtension := ExtractFileExt(FileName); + + if AnsiSameText(FileExtension, BDSPROJExtension) and FileExists(FileName) then + begin + ProjectFile := TStringList.Create; + try + ProjectFile.LoadFromFile(FileName); + ProjectContent := ProjectFile.Text; + SourceNodePosition := AnsiPos(' 0 do + for I := 0 to FEnvVariables.Count - 1 do + begin + Name := FEnvVariables.Names[I]; + Result := StringReplace(Result, Format('$(%s)', [Name]), + FEnvVariables.Values[Name], [rfReplaceAll, rfIgnoreCase]); + end; +end; + +procedure TJclOTAExpertBase.RegisterAction(Action: TCustomAction); +begin + if Action.Name <> '' then + begin + Action.Tag := Action.ShortCut; // to restore settings + Action.ShortCut := ActionSettings.LoadInteger(Action.Name, Action.ShortCut); + end; + + if not Assigned(GlobalActionList) then + begin + GlobalActionList := TList.Create; + {$IFDEF COMPILER6_UP} + RegisterFindGlobalComponentProc(FindActions); + {$ELSE COMPILER6_UP} + if not Assigned(OldFindGlobalComponentProc) then + begin + OldFindGlobalComponentProc := FindGlobalComponent; + FindGlobalComponent := FindActions; + end; + {$ENDIF COMPILER6_UP} + end; + + GlobalActionList.Add(Action); +end; + +procedure TJclOTAExpertBase.UnregisterAction(Action: TCustomAction); +begin + if Action.Name <> '' then + ActionSettings.SaveInteger(Action.Name, Action.ShortCut); + + if Assigned(GlobalActionList) then + begin + GlobalActionList.Remove(Action); + if (GlobalActionList.Count = 0) then + begin + FreeAndNil(GlobalActionList); + {$IFDEF COMPILER6_UP} + UnRegisterFindGlobalComponentProc(FindActions); + {$ELSE COMPILER6_UP} + FindGlobalComponent := OldFindGlobalComponentProc; + {$ENDIF COMPILER6_UP} + end; + end; + + // remove action from toolbar to avoid crash when recompile package inside the IDE. + CheckToolBarButton(FNTAServices.ToolBar[sCustomToolBar], Action); + CheckToolBarButton(FNTAServices.ToolBar[sStandardToolBar], Action); + CheckToolBarButton(FNTAServices.ToolBar[sDebugToolBar], Action); + CheckToolBarButton(FNTAServices.ToolBar[sViewToolBar], Action); + CheckToolBarButton(FNTAServices.ToolBar[sDesktopToolBar], Action); + {$IFDEF COMPILER7_UP} + CheckToolBarButton(FNTAServices.ToolBar[sInternetToolBar], Action); + CheckToolBarButton(FNTAServices.ToolBar[sCORBAToolBar], Action); + {$ENDIF COMPILER7_UP} +end; + +procedure TJclOTAExpertBase.RegisterCommands; +var + JclIcon: TIcon; + Category: string; + Index: Integer; + IDEMenuItem, ToolsMenuItem: TMenuItem; +begin + if not Assigned(ConfigurationAction) then + begin + Category := ''; + for Index := 0 to NTAServices.ActionList.ActionCount - 1 do + if CompareText(NTAServices.ActionList.Actions[Index].Name, 'ToolsOptionsCommand') = 0 then + Category := NTAServices.ActionList.Actions[Index].Category; + + ConfigurationAction := TAction.Create(nil); + JclIcon := TIcon.Create; + try + // not ModuleHInstance because the resource is in JclBaseExpert.bpl + JclIcon.Handle := LoadIcon(HInstance, 'JCLCONFIGURE'); + ConfigurationAction.ImageIndex := NTAServices.ImageList.AddIcon(JclIcon); + finally + JclIcon.Free; + end; + ConfigurationAction.Caption := RsJCLOptions; + ConfigurationAction.Name := JclConfigureActionName; + ConfigurationAction.Category := Category; + ConfigurationAction.Visible := True; + ConfigurationAction.OnUpdate := ConfigurationActionUpdate; + ConfigurationAction.OnExecute := ConfigurationActionExecute; + + ConfigurationAction.ActionList := NTAServices.ActionList; + RegisterAction(ConfigurationAction); + end; + + if not Assigned(ConfigurationMenuItem) then + begin + IDEMenuItem := NTAServices.MainMenu.Items; + if not Assigned(IDEMenuItem) then + raise EJclExpertException.CreateTrace(RsENoIDEMenu); + + ToolsMenuItem := nil; + for Index := 0 to IDEMenuItem.Count - 1 do + if CompareText(IDEMenuItem.Items[Index].Name, 'ToolsMenu') = 0 then + ToolsMenuItem := IDEMenuItem.Items[Index]; + if not Assigned(ToolsMenuItem) then + raise EJclExpertException.CreateTrace(RsENoToolsMenu); + + ConfigurationMenuItem := TMenuItem.Create(nil); + ConfigurationMenuItem.Action := ConfigurationAction; + + ToolsMenuItem.Insert(0, ConfigurationMenuItem); + end; + + // override to add actions and menu items +end; + +procedure TJclOTAExpertBase.UnregisterCommands; +begin + if GetExpertCount = 0 then + begin + UnregisterAction(ConfigurationAction); + FreeAndNil(ConfigurationAction); + FreeAndNil(ConfigurationMenuItem); + end; + + // override to remove actions and menu items +end; + +//=== { TJclOTAExpert } ====================================================== + +procedure TJclOTAExpert.AfterSave; +begin +end; + +procedure TJclOTAExpert.BeforeSave; +begin +end; + +procedure TJclOTAExpert.Destroyed; +begin +end; + +procedure TJclOTAExpert.Execute; +begin +end; + +function TJclOTAExpert.GetIDString: string; +begin + Result := 'Jedi.' + ClassName; +end; + +function TJclOTAExpert.GetName: string; +begin + Result := ClassName; +end; + +function TJclOTAExpert.GetState: TWizardState; +begin + Result := []; +end; + +procedure TJclOTAExpert.Modified; +begin +end; + +{$IFDEF BDS} + +var + AboutBoxServices: IOTAAboutBoxServices = nil; + AboutBoxIndex: Integer = -1; + SplashScreenInitialized: Boolean = False; + +procedure RegisterAboutBox; +var + ProductImage: HBITMAP; +begin + if AboutBoxIndex = -1 then + begin + Supports(BorlandIDEServices,IOTAAboutBoxServices, AboutBoxServices); + if not Assigned(AboutBoxServices) then + raise EJclExpertException.CreateTrace(RsENoAboutServices); + ProductImage := LoadBitmap(FindResourceHInstance(HInstance), 'JCLSPLASH'); + if ProductImage = 0 then + raise EJclExpertException.CreateTrace(RsENoBitmapResources); + AboutBoxIndex := AboutBoxServices.AddProductInfo(RsAboutDialogTitle, + RsAboutCopyright, RsAboutTitle, RsAboutDescription, 0, + ProductImage, False, RsAboutLicenceStatus); + end; +end; + +procedure UnregisterAboutBox; +begin + if (AboutBoxIndex <> -1) and Assigned(AboutBoxServices) then + begin + AboutBoxServices.RemoveProductInfo(AboutBoxIndex); + AboutBoxIndex := -1; + AboutBoxServices := nil; + end; +end; + +procedure RegisterSplashScreen; +var + ProductImage: HBITMAP; +begin + if Assigned(SplashScreenServices) and not SplashScreenInitialized then + begin + ProductImage := LoadBitmap(FindResourceHInstance(HInstance), 'JCLSPLASH'); + if ProductImage = 0 then + raise EJclExpertException.CreateTrace(RsENoBitmapResources); + // C#Builder 1 doesn't display AddProductBitmap + //SplashScreenServices.AddProductBitmap(RsAboutDialogTitle, ProductImage, + // False, RsAboutLicenceStatus); + SplashScreenServices.AddPluginBitmap(RsAboutDialogTitle, ProductImage, + False, RsAboutLicenceStatus); + SplashScreenInitialized := True; + end; +end; + +{$ENDIF BDS} + +initialization + +finalization + +try + {$IFDEF BDS} + UnregisterAboutBox; + {$ENDIF BDS} + FreeAndNil(GlobalActionList); + FreeAndNil(GlobalActionSettings); + FreeAndNil(GlobalExpertList); +except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; +end; + +//=== Helper routines ======================================================== + +{ (rom) disabled, unused +procedure SaveOptions(const Options: IOTAOptions; const FileName: string); +var + OptArray: TOTAOptionNameArray; + I: Integer; +begin + OptArray := Options.GetOptionNames; + with TStringList.Create do + try + for I := Low(OptArray) to High(OptArray) do + Add(OptArray[I].Name + '=' + VarToStr(Options.Values[OptArray[I].Name])); + SaveToFile(FileName); + finally + Free; + end; +end; +} + +// History: + +// $Log: JclOtaUtils.pas,v $ +// Revision 1.17 2006/02/02 19:57:08 outchy +// IT3464: EFOpenError when the bdsproj is not on drive +// +// Revision 1.16 2006/01/15 19:14:41 ahuser +// Delphi 7 JCL Option bugfix and layout +// +// Revision 1.15 2006/01/08 17:16:56 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.14 2005/12/26 18:03:40 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.13 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.12 2005/10/28 04:34:27 rrossmair +// - replaced {$IFDEF RTL170_UP} by more appropriate {$IFDEF BDS} +// +// Revision 1.11 2005/10/27 13:50:39 rrossmair +// - cleaned up mistakenly expanded check-in comments +// +// Revision 1.10 2005/10/27 11:00:43 marquardt +// cleaned up the sources and created a .rc file +// +// Revision 1.9 2005/10/27 08:31:08 outchy +// Items add in the splash screen and in the about box of Delphi (requires at least D2005) +// +// Revision 1.8 2005/10/26 08:29:53 marquardt +// Kylix dummy Load results fixed +// +// Revision 1.7 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// +// Revision 1.6 2005/10/25 14:45:22 uschuster +// some changes for Kylix +// +// Revision 1.5 2005/10/25 13:00:12 marquardt +// Load and Save methods for TJclOTAExpertBase +// +// Revision 1.4 2005/10/25 08:27:22 marquardt +// minor cleanups, deactivated unused function +// +// Revision 1.3 2005/10/24 12:05:51 marquardt +// further cleanup +// +// Revision 1.2 2005/10/23 12:53:36 marquardt +// further expert cleanup and integration, use of JclRegistry +// +// Revision 1.1 2005/10/21 12:24:41 marquardt +// experts reorganized with new directory common +// +// Revision 1.3 2005/10/20 22:55:17 outchy +// Experts are now generated by the package generator. +// No WEAKPACKAGEUNIT in design-time packages. +// +// Revision 1.2 2005/10/20 17:19:30 outchy +// Moving function calls out of Asserts +// +// Revision 1.1 2005/10/03 16:15:58 rrossmair +// - moved over from jcl\examples\vcl\debugextension +// +// Revision 1.10 2005/09/17 23:01:46 outchy +// user's settings are now stored in the registry (HKEY_CURRENT_USER) +// +// Revision 1.9 2005/08/07 13:42:38 outchy +// IT3115: Adding system and user environment variables. +// +// Revision 1.8 2005/07/26 17:41:06 outchy +// Icons can now be placed in the IDE's toolbars via the customize dialog. They are restored at the IDE's startup. +// +// Revision 1.7 2005/05/08 15:43:28 outchy +// Compiler conditions modified for C++Builder +// +// Revision 1.6 2005/03/14 05:56:27 rrossmair +// - fixed issue #2752 (TJclOTAUtils.SubstitutePath does not support nested environment variables) as proposed by the reporter. +// + +end. diff --git a/official/1.96/experts/common/JclSplash.bmp b/official/1.96/experts/common/JclSplash.bmp new file mode 100644 index 0000000..eb15014 Binary files /dev/null and b/official/1.96/experts/common/JclSplash.bmp differ diff --git a/official/1.96/experts/debug/Howto.txt b/official/1.96/experts/debug/Howto.txt new file mode 100644 index 0000000..8088c05 --- /dev/null +++ b/official/1.96/experts/debug/Howto.txt @@ -0,0 +1,91 @@ +Installs IDE expert which assists to insert JCL Debug +information into executable files. This can be useful when use +source location routines from JclDebug unit. These routines +needs some kind of special information to be able to provide +source location for given address in the process. +Currently there are four options to get it work: + +1. Generate and deploy MAP file with your executable file. The + file is generated by the linker. It needs to be set in + Project|Options dialog->Linker page, Detailed checkbox. + +2. Generate and deploy JDBG file file with your executable + file. This is binary file based on MAP file but its size is + typically about 12% of original MAP file. You can generate + it by MapToJdbg tool in jcl\examples\vcl\debugextension\tools + folder. The advantage over MAP file is smaller size and better + security of the file content because it is not a plain text + file and it also contains a checksum. + +3. Generate Borland TD32 debug symbols. These symbols are + stored directly in the executable file but usually adds + several megabytes so the file is very large. The advantage + is you don't have to deploy any other file and it is easy + to generate it by checking Include TD32 debug info in + Linker option page. + +4. Insert JCL Debug info into executable file by the IDE + expert. The size of added data is similar to JDBG file but + it will be inserted directly into the executable file. This + is probably best option because it combines small size of + included data and no requirement of deploying additional + files. + In case you use this option you need install the + JclDebugIde expert. + +The IDE expert will add new item to IDE Project menu. +It adds 'Insert JCL Debug data' check item at the end +of the Project menu. When the item is checked, everytime +the project is compiled by one of following commands: +Compile, Build, Compile All Projects, Build All Projects +or Run necessary JCL debug data are automatically +inserted into the executable. Moreover, for Build and +Build All commands dialog with detailed information of +size of these data will be displayed. + +You can generate those debug data for packages and +libraries as well using the expert. Each executable file +in the project can use different option from those +listed above. It is not necessary to generate any debug +data for Borland runtime packages because the source +location code can use names of exported functions to get +procedure or method name. To get line number information +for Borland RTL and VCL/CLX units you have to check Use +Debug DCUs checkbox in Project|Options dialog -> Compiler tab. +Unfortunately it is not possible to get line number +information for Borland runtime packages because Borland +does not provide detailed MAP files for them so you get +procedure or method name only. + +In case you have more than one data source for an executable +file by an accident the best one is chosen in following order: + +1. JCL Debug data in the executable file +2. JDBG file +3. Borland TD32 symbols +4. MAP file +5. Library or Borland package exports + +It is also possible to insert JCL debug data programmatically +to the executable file by using MakeJclDbg command line tool +in jcl\examples\tools folder. You can study included makefiles +which uses this tool for building DelphiTools examples. + +Short description of getting the JclDebug functionality +in your project: + +1. Close all running instances of Delphi +2. Install JCL and IDE experts by the JCL Installer +3. Run Delphi IDE and open your project +4. Remove any TApplication.OnException handlers from + your project (if any). +5. Add new Exception Dialog by selecting + File | New | Other ... | Dialogs tab, + Select 'Exception Dialog' or + 'Exception Dialog with Send' icon, Click OK button, + Save the form (use ExceptionDialog.pas name, for + example) +6. Check Project | Insert JCL Debug data menu item +7. Do Project | Build + + diff --git a/official/1.96/experts/debug/JclDebugIdeIcon.res b/official/1.96/experts/debug/JclDebugIdeIcon.res new file mode 100644 index 0000000..a6beac5 Binary files /dev/null and b/official/1.96/experts/debug/JclDebugIdeIcon.res differ diff --git a/official/1.96/experts/debug/JclDebugIdeImpl.pas b/official/1.96/experts/debug/JclDebugIdeImpl.pas new file mode 100644 index 0000000..fd09ca7 --- /dev/null +++ b/official/1.96/experts/debug/JclDebugIdeImpl.pas @@ -0,0 +1,845 @@ +{**************************************************************************************************} +{ } +{ 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 JclDebugIdeImpl.pas. } +{ } +{ The Initial Developer of the Original Code is documented in the accompanying } +{ help file JCL.chm. Portions created by these individuals are Copyright (C) of these individuals. } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Petr Vones } +{ Last modified: August 28, 2002 } +{ } +{**************************************************************************************************} + +unit JclDebugIdeImpl; + +{$I jcl.inc} + +{$UNDEF OldStyleExpert} + +// Delphi 5 can use both kind of the expert +// Delphi 6 and + can use New expert style only + +// BCB 5 can use both kind of the expert +// BCB 6 and + can use New expert style only + +interface + +uses + Windows, Classes, Menus, ActnList, SysUtils, Graphics, Dialogs, Controls, Forms, ToolsAPI, + JclOtaUtils; + +type + TJclDebugDataInfo = record + ProjectName: string; + ExecutableFileName: TFileName; + MapFileSize, JclDebugDataSize: Integer; + LinkerBugUnit: string; + LineNumberErrors: Integer; + Success: Boolean; + end; + + TJclDebugExtension = class(TJclOTAExpert) + private + FResultInfo: array of TJclDebugDataInfo; + FStoreResults: Boolean; + FImageIndex: Integer; + FBuildError: Boolean; + {$IFNDEF OldStyleExpert} + FInsertDataItem: TMenuItem; + FInsertDataAction: TAction; + FDisabledImageIndex: Integer; + FCurrentProject: IOTAProject; + FSaveBuildProject: TAction; + FSaveBuildProjectExecute: TNotifyEvent; + FSaveBuildAllProjects: TAction; + FSaveBuildAllProjectsExecute: TNotifyEvent; + FNotifierIndex: Integer; + FOptionsModifiedState: Boolean; + FSaveMapFile: Integer; + procedure ExpertActive(Active: Boolean); + procedure HookBuildActions(Enable: Boolean); + procedure InsertDataExecute(Sender: TObject); + procedure LoadExpertValues; + procedure SaveExpertValues; + procedure BuildAllProjects(Sender: TObject); // (New) Build All Projects command hook + procedure BuildProject(Sender: TObject); // (New) Build Project command hook + {$ELSE OldStyleExpert} + FBuildAllMenuItem: TMenuItem; + FBuildAllAction: TAction; + FBuildMenuItem: TMenuItem; + FBuildAction: TAction; + procedure BuildActionExecute(Sender: TObject); // (Old) Build JCL Debug command + procedure BuildActionUpdate(Sender: TObject); + procedure BuildAllActionExecute(Sender: TObject); // (Old) Build JCL Debug All Projects command + procedure BuildAllActionUpdate(Sender: TObject); + function InsertDataToProject(const ActiveProject: IOTAProject): Boolean; + {$ENDIF OldStyleExpert} + procedure BeginStoreResults; + procedure DisplayResults; + procedure EndStoreResults; + public + constructor Create; reintroduce; + destructor Destroy; override; + {$IFNDEF OldStyleExpert} + procedure AfterCompile(Succeeded: Boolean); + procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); + {$ENDIF OldStyleExpert} + procedure RegisterCommands; override; + procedure UnregisterCommands; override; + end; + + {$IFNDEF OldStyleExpert} + TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier, IOTAIDENotifier50) + private + FDebugExtension: TJclDebugExtension; + protected + procedure AfterCompile(Succeeded: Boolean); overload; + procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload; + procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload; + procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload; + procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); + public + constructor Create(ADebugExtension: TJclDebugExtension); + end; + {$ENDIF OldStyleExpert} + +// design package entry point +procedure Register; + +// expert DLL entry point +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean; stdcall; + +implementation + +{$R JclDebugIdeIcon.res} + +uses + JclDebug, JclDebugIdeResult, + JclOtaConsts, JclOtaResources; + +procedure Register; +begin + try + RegisterPackageWizard(TJclDebugExtension.Create); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +var + JCLWizardIndex: Integer = -1; + +procedure JclWizardTerminate; +var + OTAWizardServices: IOTAWizardServices; +begin + try + if JCLWizardIndex <> -1 then + begin + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + OTAWizardServices.RemoveWizard(JCLWizardIndex); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + end; + end; +end; + +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean stdcall; +var + OTAWizardServices: IOTAWizardServices; +begin + try + TerminateProc := JclWizardTerminate; + + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + JCLWizardIndex := OTAWizardServices.AddWizard(TJclDebugExtension.Create); + + Result := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + Result := False; + end; + end; +end; + +//=== { TJclDebugExtension } ================================================= + +constructor TJclDebugExtension.Create; +begin + inherited Create(JclDebugExpertRegKey); + {$IFNDEF OldStyleExpert} + FNotifierIndex := Services.AddNotifier(TIdeNotifier.Create(Self)); + LoadExpertValues; + {$ENDIF OldStyleExpert} +end; + +destructor TJclDebugExtension.Destroy; +begin + {$IFNDEF OldStyleExpert} + if FNotifierIndex <> -1 then + Services.RemoveNotifier(FNotifierIndex); + SaveExpertValues; + {$ENDIF OldStyleExpert} + inherited Destroy; +end; + +{$IFNDEF OldStyleExpert} +procedure TJclDebugExtension.AfterCompile(Succeeded: Boolean); +var + ProjectFileName, MapFileName, ExecutableFileName: string; + OutputDirectory, LinkerBugUnit: string; + ProjOptions: IOTAProjectOptions; + ExecutableNotFound, Succ: Boolean; + MapFileSize, JclDebugDataSize, LineNumberErrors, C: Integer; + + procedure DeleteMapAndDrcFile; + begin + if FSaveMapFile <> MapFileOptionDetailed then + begin // delete MAP and DRC file + DeleteFile(MapFileName); + DeleteFile(ChangeFileExt(ProjectFileName, DrcFileExtension)); + end; + end; + +begin + if FInsertDataAction.Checked and Assigned(FCurrentProject) then + begin + ProjOptions := FCurrentProject.ProjectOptions; +{ if FSaveMapFile <> MapFileOptionDetailed then + begin + ProjOptions.Values[MapFileOptionName] := FSaveMapFile; + ProjOptions.ModifiedState := FOptionsModifiedState; + end;} +{ TODO -oPV : Temporarily removed due Delphi 6 IDE problems } + ProjectFileName := FCurrentProject.FileName; + OutputDirectory := GetOutputDirectory(FCurrentProject); + MapFileName := GetMapFileName(FCurrentProject); + if Succeeded then + begin + ExecutableNotFound := False; + LinkerBugUnit := ''; + LineNumberErrors := 0; + Succ := FileExists(MapFileName); + if Succ then + begin + Screen.Cursor := crHourGlass; + try + if FindExecutableName(MapFileName, OutputDirectory, ExecutableFileName) then + begin + Succ := InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName, + LinkerBugUnit, MapFileSize, JclDebugDataSize, LineNumberErrors); + end + else + ExecutableNotFound := True; + Screen.Cursor := crDefault; + except + Screen.Cursor := crDefault; + raise; + end; + end; + + DeleteMapAndDrcFile; + + if FStoreResults then + begin + C := Length(FResultInfo); + SetLength(FResultInfo, C + 1); + FResultInfo[C].ProjectName := ExtractFileName(ProjectFileName); + FResultInfo[C].ExecutableFileName := ExecutableFileName; + FResultInfo[C].MapFileSize := MapFileSize; + FResultInfo[C].JclDebugDataSize := JclDebugDataSize; + FResultInfo[C].LinkerBugUnit := LinkerBugUnit; + FResultInfo[C].LineNumberErrors := LineNumberErrors; + FResultInfo[C].Success := Succ; + end; + + if ExecutableNotFound then + raise EJclExpertException.CreateTrace(Format(RsEExecutableNotFound, [ProjectFileName])); + end + else + begin + FBuildError := True; + DeleteMapAndDrcFile; + end; + Pointer(FCurrentProject) := nil; + end; +end; + +procedure TJclDebugExtension.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); +var + ProjOptions: IOTAProjectOptions; +begin + if FInsertDataAction.Checked then + begin + if IsInstalledPackage(Project) then + begin + if MessageDlg(Format(RsCantInsertToInstalledPackage, [Project.FileName]), mtError, [mbYes, mbNo], 0) = mrYes then + ExpertActive(False); + Cancel := True; + end + else + begin + FCurrentProject := Project; + ProjOptions := Project.ProjectOptions; + if not Assigned(ProjOptions) then + raise EJclExpertException.CreateTrace(RsENoProjectOptions); + + FOptionsModifiedState := ProjOptions.ModifiedState; + FSaveMapFile := ProjOptions.Values[MapFileOptionName]; + if FSaveMapFile <> MapFileOptionDetailed then + ProjOptions.Values[MapFileOptionName] := MapFileOptionDetailed; + end; + end; +end; + +{$ENDIF OldStyleExpert} + +procedure TJclDebugExtension.BeginStoreResults; +begin + FBuildError := False; + FStoreResults := True; + FResultInfo := nil; +end; + +{$IFDEF OldStyleExpert} + +procedure TJclDebugExtension.BuildActionExecute(Sender: TObject); +begin + try + BeginStoreResults; + try + if InsertDataToProject(ActiveProject) then + DisplayResults; + finally + EndStoreResults; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclDebugExtension.BuildActionUpdate(Sender: TObject); +var + TempActiveProject: IOTAProject; + ProjectName: string; +begin + try + TempActiveProject := ActiveProject; + FBuildAction.Enabled := Assigned(TempActiveProject); + if Assigned(ActiveProject) then + ProjectName := ExtractFileName(TempActiveProject.FileName) + else + ProjectName := RsProjectNone; + FBuildAction.Caption := Format(RsBuildActionCaption, [ProjectName]); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclDebugExtension.BuildAllActionExecute(Sender: TObject); +var + I: Integer; + TempActiveProject: IOTAProject; + TempProjectGroup: IOTAProjectGroup; + Error: Boolean; +begin + try + TempProjectGroup := ProjectGroup; + if not Assigned(TempProjectGroup) then + raise EJclExpertException.CreateTrace(RsENoProjectGroup); + + Error := False; + BeginStoreResults; + try + for I := 0 to TempProjectGroup.ProjectCount - 1 do + begin + TempActiveProject := TempProjectGroup.Projects[I]; + TempProjectGroup.ActiveProject := TempActiveProject; + Error := not InsertDataToProject(TempActiveProject); + if Error then + Break; + end; + if not Error then + DisplayResults; + finally + EndStoreResults; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclDebugExtension.BuildAllActionUpdate(Sender: TObject); +begin + try + FBuildAllAction.Enabled := ProjectGroup <> nil; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +{$ENDIF OldStyleExpert} + +{$IFNDEF OldStyleExpert} + +procedure TJclDebugExtension.BuildAllProjects(Sender: TObject); +begin + BeginStoreResults; + try + try + FSaveBuildAllProjectsExecute(Sender); + DisplayResults; + except + on ExceptionObj: TObject do + JclExpertShowExceptionDialog(ExceptionObj); + // raise is useless because trapped by the finally section + end; + finally + EndStoreResults; + end; +end; + +procedure TJclDebugExtension.BuildProject(Sender: TObject); +begin + BeginStoreResults; + try + try + FSaveBuildProjectExecute(Sender); + DisplayResults; + except + on ExceptionObj: TObject do + JclExpertShowExceptionDialog(ExceptionObj); + // raise is useless because trapped by the finally section + end; + finally + EndStoreResults; + end; +end; + +{$ENDIF OldStyleExpert} + +procedure TJclDebugExtension.DisplayResults; +var + I: Integer; +begin + if FBuildError or (Length(FResultInfo) = 0) then + Exit; + with TJclDebugResultForm.Create(Application, Settings) do + try + for I := 0 to Length(FResultInfo) - 1 do + with ResultListView.Items.Add, FResultInfo[I] do + begin + Caption := ProjectName; + if Success then + begin + SubItems.Add(IntToStr(MapFileSize)); + SubItems.Add(IntToStr(JclDebugDataSize)); + SubItems.Add(Format('%3.1f', [JclDebugDataSize * 100 / MapFileSize])); + SubItems.Add(ExecutableFileName); + SubItems.Add(LinkerBugUnit); + if LineNumberErrors > 0 then + SubItems.Add(IntToStr(LineNumberErrors)) + else + SubItems.Add(''); + ImageIndex := 0; + end + else + begin + SubItems.Add(''); + SubItems.Add(''); + SubItems.Add(''); + SubItems.Add(ExecutableFileName); + SubItems.Add(LinkerBugUnit); + SubItems.Add(''); + ImageIndex := 1; + end; + end; + ShowModal; + finally + Free; + end; +end; + +procedure TJclDebugExtension.EndStoreResults; +begin + FStoreResults := False; + FResultInfo := nil; +end; + +{$IFNDEF OldStyleExpert} + +procedure TJclDebugExtension.ExpertActive(Active: Boolean); +begin + if (Active) then + FInsertDataAction.ImageIndex := FImageIndex + else + FInsertDataAction.ImageIndex := FDisabledImageIndex; + FInsertDataAction.Checked := Active; + HookBuildActions(Active); +end; + +procedure TJclDebugExtension.HookBuildActions(Enable: Boolean); +begin + if Enable then + begin + if Assigned(FSaveBuildProject) then + FSaveBuildProject.OnExecute := BuildProject; + if Assigned(FSaveBuildAllProjects) then + FSaveBuildAllProjects.OnExecute := BuildAllProjects; + end + else + begin + if Assigned(FSaveBuildProject) then + FSaveBuildProject.OnExecute := FSaveBuildProjectExecute; + if Assigned(FSaveBuildAllProjects) then + FSaveBuildAllProjects.OnExecute := FSaveBuildAllProjectsExecute; + end; +end; + +procedure TJclDebugExtension.InsertDataExecute(Sender: TObject); +begin + try + ExpertActive(not FInsertDataAction.Checked); + SaveExpertValues; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclDebugExtension.LoadExpertValues; +begin + ExpertActive(Settings.LoadBool(JclDebugEnabledRegValue, False)); +end; + +procedure TJclDebugExtension.SaveExpertValues; +begin + Settings.SaveBool(JclDebugEnabledRegValue, FInsertDataAction.Checked); +end; + +{$ENDIF OldStyleExpert} + +{$IFDEF OldStyleExpert} + +function TJclDebugExtension.InsertDataToProject(const ActiveProject: IOTAProject): Boolean; +var + BuildOk, Succ: Boolean; + ProjOptions: IOTAProjectOptions; + SaveMapFile: Variant; + ProjectFileName, MapFileName, ExecutableFileName: string; + OutputDirectory, LinkerBugUnit: string; + MapFileSize, JclDebugDataSize, LineNumberErrors, C: Integer; + ExecutableNotFound: Boolean; + OptionsModifiedState: Boolean; +begin + if not Assigned(ActiveProject) then + raise EJclExpertException.CreateTrace(RsENoActiveProject); + + ProjectFileName := ActiveProject.FileName; + ProjOptions := ActiveProject.ProjectOptions; + // read output directory + OutputDirectory := GetOutputDirectory(ActiveProject); + MapFileName := GetMapFileName(ActiveProject); + + OptionsModifiedState := ProjOptions.ModifiedState; + SaveMapFile := ProjOptions.Values[MapFileOptionName]; + ProjOptions.Values[MapFileOptionName] := MapFileOptionDetailed; + BuildOk := ActiveProject.ProjectBuilder.BuildProject(cmOTABuild, False); + ProjOptions.Values[MapFileOptionName] := SaveMapFile; + ProjOptions.ModifiedState := OptionsModifiedState; + + ExecutableNotFound := False; + LinkerBugUnit := ''; + LineNumberErrors := 0; + if BuildOk then + begin + Succ := FileExists(MapFileName); + if Succ then + begin + if FindExecutableName(MapFileName, OutputDirectory, ExecutableFileName) then + begin + Succ := InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName, + LinkerBugUnit, MapFileSize, JclDebugDataSize, LineNumberErrors); + end + else + begin + ExecutableNotFound := True; + Succ := False; + end; + end; + end + else + Succ := False; + if SaveMapFile <> MapFileOptionDetailed then + begin + DeleteFile(MapFileName); + DeleteFile(ChangeFileExt(ProjectFileName, DrcFileExtension)); + end; + Result := BuildOk and not ExecutableNotFound; + C := Length(FResultInfo); + SetLength(FResultInfo, C + 1); + FResultInfo[C].ProjectName := ExtractFileName(ProjectFileName); + FResultInfo[C].ExecutableFileName := ExecutableFileName; + FResultInfo[C].MapFileSize := MapFileSize; + FResultInfo[C].JclDebugDataSize := JclDebugDataSize; + FResultInfo[C].LinkerBugUnit := LinkerBugUnit; + FResultInfo[C].LineNumberErrors := LineNumberErrors; + FResultInfo[C].Success := Succ; + if ExecutableNotFound then + raise EJclExpertException.CreateTrace(Format(RsEExecutableNotFound, [ProjectFileName])); +end; + +{$ENDIF OldStyleExpert} + +procedure TJclDebugExtension.RegisterCommands; +var + IDEMainMenu: TMainMenu; + IDEProjectItem: TMenuItem; + IDEActionList: TActionList; + I: Integer; + ImageBmp: TBitmap; +begin + inherited RegisterCommands; + IDEActionList := TActionList(NTAServices.ActionList); + IDEMainMenu := NTAServices.MainMenu; + ImageBmp := TBitmap.Create; + try + ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLDEBUG'); + FImageIndex := NTAServices.AddMasked(ImageBmp, clPurple); + {$IFDEF OldStyleExpert} + FBuildAction := TAction.Create(nil); + FBuildAction.Caption := Format(RsBuildActionCaption, [RsProjectNone]); + FBuildAction.ImageIndex := FImageIndex; + FBuildAction.Visible := True; + FBuildAction.OnExecute := BuildActionExecute; + FBuildAction.OnUpdate := BuildActionUpdate; + FBuildAction.Name := RsBuildActionName; + FBuildAction.ActionList := IDEActionList; + RegisterAction(FBuildAction); + FBuildMenuItem := TMenuItem.Create(nil); + FBuildMenuItem.Action := FBuildAction; + FBuildAllAction := TAction.Create(nil); + FBuildAllAction.Caption := RsBuildAllCaption; + FBuildAllAction.ImageIndex := FImageIndex; + FBuildAllAction.Visible := True; + FBuildAllAction.OnExecute := BuildAllActionExecute; + FBuildAllAction.OnUpdate := BuildAllActionUpdate; + FBuildAllAction.Name := RsBuildAllActionName; + FBuildAllAction.ActionList := IDEActionList; + RegisterAction(FBuildAllAction); + FBuildAllMenuItem := TMenuItem.Create(nil); + FBuildAllMenuItem.Action := FBuildAllAction; + {$ELSE OldStyleExpert} + ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLNODEBUG'); + FDisabledImageIndex := NTAServices.AddMasked(ImageBmp, clPurple); + FInsertDataAction := TAction.Create(nil); + FInsertDataAction.Caption := RsInsertDataCaption; + FInsertDataAction.Visible := True; + FInsertDataAction.OnExecute := InsertDataExecute; + FInsertDataAction.ActionList := IDEActionList; + FInsertDataAction.Name := RsInsertDataActionName; + RegisterAction(FInsertDataAction); + FInsertDataItem := TMenuItem.Create(nil); + FInsertDataItem.Action := FInsertDataAction; + {$ENDIF OldStyleExpert} + finally + ImageBmp.Free; + end; + + IDEProjectItem := nil; + with IDEMainMenu do + for I := 0 to Items.Count - 1 do + if Items[I].Name = 'ProjectMenu' then + begin + IDEProjectItem := Items[I]; + Break; + end; + if not Assigned(IDEProjectItem) then + raise EJclExpertException.CreateTrace(RsENoProjectMenuItem); + + {$IFDEF OldStyleExpert} + with IDEProjectItem do + for I := 0 to Count - 1 do + if Items[I].Name = 'ProjectBuildItem' then + begin + if Assigned(Items[I].Action) then + FBuildAction.Category := TContainedAction(Items[I].Action).Category; + IDEProjectItem.Insert(I + 1, FBuildMenuItem); + System.Break; + end; + if not Assigned(FBuildMenuItem) then + raise EJclExpertException.CreateTrace(RsENoBuildMenuItem); + + with IDEProjectItem do + for I := 0 to Count - 1 do + if Items[I].Name = 'ProjectBuildAllItem' then + begin + if Assigned(Items[I].Action) then + FBuildAllAction.Category := TContainedAction(Items[I].Action).Category; + IDEProjectItem.Insert(I + 1, FBuildAllMenuItem); + System.Break; + end; + if not Assigned(FBuildMenuItem.Parent) then + raise EJclExpertException.CreateTrace(RsEBuildMenuItemNotInserted); + + {$ELSE OldStyleExpert} + with IDEProjectItem do + for I := 0 to Count - 1 do + if Items[I].Name = 'ProjectOptionsItem' then + begin + if Assigned(Items[I].Action) then + FInsertDataAction.Category := TContainedAction(Items[I].Action).Category; + IDEProjectItem.Insert(I + 1, FInsertDataItem); + System.Break; + end; + if not Assigned(FInsertDataItem.Parent) then + raise EJclExpertException.CreateTrace(RsEInsertDataMenuItemNotInserted); + + FSaveBuildProject := nil; + with IDEActionList do + for I := 0 to ActionCount - 1 do + if Actions[I].Name = 'ProjectBuildCommand' then + begin + FSaveBuildProject := TAction(Actions[I]); + FSaveBuildProjectExecute := Actions[I].OnExecute; + Break; + end; + if not Assigned(FSaveBuildProject) then + raise EJclExpertException.CreateTrace(RsENoBuildAction); + + FSaveBuildAllProjects := nil; + with IDEActionList do + for I := 0 to ActionCount - 1 do + if Actions[I].Name = 'ProjectBuildAllCommand' then + begin + FSaveBuildAllProjects := TAction(Actions[I]); + FSaveBuildAllProjectsExecute := Actions[I].OnExecute; + Break; + end; + if not Assigned(FSaveBuildProject) then + raise EJclExpertException.CreateTrace(RsENoBuildAllAction); + {$ENDIF OldStyleExpert} +end; + +procedure TJclDebugExtension.UnregisterCommands; +begin + inherited UnregisterCommands; + {$IFNDEF OldStyleExpert} + HookBuildActions(False); + UnregisterAction(FInsertDataAction); + FreeAndNil(FInsertDataItem); + FreeAndNil(FInsertDataAction); + {$ELSE OldStyleExpert} + UnregisterAction(FBuildAction); + UnregisterAction(FBuildAllAction); + FreeAndNil(FBuildMenuItem); + FreeAndNil(FBuildAction); + FreeAndNil(FBuildAllMenuItem); + FreeAndNil(FBuildAllAction); + {$ENDIF OldStyleExpert} +end; + +//=== { TIdeNotifier } ======================================================= + +{$IFNDEF OldStyleExpert} + +constructor TIdeNotifier.Create(ADebugExtension: TJclDebugExtension); +begin + inherited Create; + FDebugExtension := ADebugExtension; +end; + +procedure TIdeNotifier.AfterCompile(Succeeded: Boolean); +begin +end; + +procedure TIdeNotifier.AfterCompile(Succeeded, IsCodeInsight: Boolean); +begin + try + if not IsCodeInsight then + FDebugExtension.AfterCompile(Succeeded); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TIdeNotifier.BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); +begin + try + if not IsCodeInsight then + FDebugExtension.BeforeCompile(Project, Cancel); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TIdeNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); +begin +end; + +procedure TIdeNotifier.FileNotification(NotifyCode: TOTAFileNotification; + const FileName: string; var Cancel: Boolean); +begin +end; + +{$ENDIF ~OldStyleExpert} + +end. diff --git a/official/1.96/experts/debug/JclDebugIdeResult.dfm b/official/1.96/experts/debug/JclDebugIdeResult.dfm new file mode 100644 index 0000000..9cf8719 --- /dev/null +++ b/official/1.96/experts/debug/JclDebugIdeResult.dfm @@ -0,0 +1,228 @@ +object JclDebugResultForm: TJclDebugResultForm + Left = 305 + Top = 243 + ActiveControl = OkBtn + BorderIcons = [biSystemMenu] + Caption = 'JCL Debug data information' + ClientHeight = 303 + ClientWidth = 772 + Color = clBtnFace + Constraints.MinHeight = 300 + Constraints.MinWidth = 700 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + KeyPreview = True + OldCreateOrder = False + Position = poScreenCenter + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnResize = FormResize + Width = 772 + Height = 303 + PixelsPerInch = 96 + TextHeight = 13 + object OkBtn: TButton + Left = 348 + Top = 271 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = '&OK' + Default = True + ModalResult = 1 + TabOrder = 0 + end + object ResultListView: TListView + Left = 10 + Top = 6 + Width = 751 + Height = 254 + Hint = 'Use Ctrl+C to copy the report to the clipboard' + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = < + item + Caption = 'Project' + Width = 110 + end + item + Alignment = taRightJustify + Caption = 'MAP file size' + Width = 75 + end + item + Alignment = taRightJustify + Caption = 'JCLDebug size' + Width = 85 + end + item + Alignment = taRightJustify + Caption = 'Ratio' + end + item + Caption = 'Executable file name' + Width = 310 + end + item + Caption = 'Linker bug' + Width = 65 + end + item + Alignment = taRightJustify + Caption = 'Line errors' + end> + ColumnClick = False + ReadOnly = True + RowSelect = True + SmallImages = ImageList1 + TabOrder = 1 + ViewStyle = vsReport + end + object ImageList1: TImageList + Left = 16 + Top = 264 + Bitmap = { + 494C010102000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000001000000001002000000000000010 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF0000000000000000007F7F7F00000000007F7F7F00000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000FF000000FF00000000000000 + 8000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000080000000 + 8000000080000000800000008000000080000000800000008000000000000000 + 8000000080000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF007F7F7F00000000007F7F7F000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000080000000800000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF00000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFF + FF00000000000000800000008000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF00000000000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFF + FF00000000000000000000008000000000000000000000000000000000000000 + 0000000000000000000000000000000080000000000000008000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF007F7F7F0000000000000000000000000000000000FFFF + FF0000000000FFFFFF0000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000800000000000000080000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF0000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000000000000000000000000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF007F7F7F0000000000000000000000 + 000000000000FFFFFF0000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000000000000000000000000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF00FFFFFF007F7F7F000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF0000000000000000007F7F7F00000000007F7F7F00000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000100000000100010000000000800000000000000000000000 + 000000000000000000000000FFFFFF00FFFFFFFF00000000E01FFFFF00000000 + C00FC631000000008007E223000000000003F007000000000001F88F00000000 + 8000FC1F00000000C000FE3F00000000E000FC1F00000000F000F80F00000000 + F801F00700000000FC01E22300000000FE01C63100000000FF1FFFFF00000000 + FFFFFFFF00000000FFFFFFFF0000000000000000000000000000000000000000 + 000000000000} + end +end diff --git a/official/1.96/experts/debug/JclDebugIdeResult.pas b/official/1.96/experts/debug/JclDebugIdeResult.pas new file mode 100644 index 0000000..fde38fb --- /dev/null +++ b/official/1.96/experts/debug/JclDebugIdeResult.pas @@ -0,0 +1,221 @@ +{******************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ The contents of this file are subject to the Mozilla Public License Version } +{ 1.0 (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 JclDebugResult.pas. } +{ } +{ The Initial Developer of the Original Code is documented in the accompanying } +{ help file JCL.chm. Portions created by these individuals are Copyright (C) } +{ of these individuals. } +{ } +{ Last modified: $Date: 2006/01/08 17:16:56 $ } +{ } +{******************************************************************************} + +unit JclDebugIdeResult; + +interface + +uses + Windows, SysUtils, Classes, Controls, Forms, ComCtrls, StdCtrls, ImgList, + JclOtaUtils; + +type + TJclDebugResultForm = class(TForm) + OkBtn: TButton; + ResultListView: TListView; + ImageList1: TImageList; + procedure FormDestroy(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + private + FSettings: TJclOtaSettings; + procedure CopyReportToClipboard; + protected + procedure CreateParams(var Params: TCreateParams); override; + property Settings: TJclOtaSettings read FSettings; + public + constructor Create(AOwner: TComponent; ASettings: TJclOTASettings); reintroduce; + end; + +implementation + +{$R *.dfm} + +uses + Clipbrd, Math, + JclStrings, + JclOtaConsts; + +procedure ListViewToStrings(ListView: TListView; Strings: TStrings; + SelectedOnly: Boolean = False; Headers: Boolean = True); +var + R, C: Integer; + ColWidths: array of Word; + S: string; + + procedure AddLine; + begin + Strings.Add(TrimRight(S)); + end; + + function MakeCellStr(const Text: String; Index: Integer): String; + begin + with ListView.Columns[Index] do + if Alignment = taLeftJustify then + Result := StrPadRight(Text, ColWidths[Index] + 1) + else + Result := StrPadLeft(Text, ColWidths[Index]) + ' '; + end; + +begin + with ListView do + begin + SetLength(ColWidths, Columns.Count); + if Headers then + for C := 0 to Columns.Count - 1 do + ColWidths[C] := Length(Trim(Columns[C].Caption)); + for R := 0 to Items.Count - 1 do + if not SelectedOnly or Items[R].Selected then + begin + ColWidths[0] := Max(ColWidths[0], Length(Trim(Items[R].Caption))); + for C := 0 to Items[R].SubItems.Count - 1 do + ColWidths[C + 1] := Max(ColWidths[C + 1], Length(Trim(Items[R].SubItems[C]))); + end; + Strings.BeginUpdate; + try + if Headers then + with Columns do + begin + S := ''; + for C := 0 to Count - 1 do + S := S + MakeCellStr(Items[C].Caption, C); + AddLine; + S := ''; + for C := 0 to Count - 1 do + S := S + StringOfChar('-', ColWidths[C]) + ' '; + AddLine; + end; + for R := 0 to Items.Count - 1 do + if not SelectedOnly or Items[R].Selected then + with Items[R] do + begin + S := MakeCellStr(Caption, 0); + for C := 0 to Min(SubItems.Count, Columns.Count - 1) - 1 do + S := S + MakeCellStr(SubItems[C], C + 1); + AddLine; + end; + finally + Strings.EndUpdate; + end; + end; +end; + +//=== { TJclDebugResultForm } ================================================ + +procedure TJclDebugResultForm.CopyReportToClipboard; +var + SL: TStringList; +begin + SL := TStringList.Create; + try + ListViewToStrings(ResultListView, SL); + Clipboard.AsText := SL.Text; + finally + SL.Free; + end; +end; + +procedure TJclDebugResultForm.FormResize(Sender: TObject); +begin + OkBtn.Left := ClientWidth div 2 - OkBtn.Width div 2; +end; + +constructor TJclDebugResultForm.Create(AOwner: TComponent; ASettings: TJclOTASettings); +begin + inherited Create(AOwner); + FSettings := ASettings; +end; + +procedure TJclDebugResultForm.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + + // Fixing the Window Ghosting "bug" + Params.Style := params.Style or WS_POPUP; + if Assigned(Screen.ActiveForm) then + Params.WndParent := Screen.ActiveForm.Handle + else if Assigned (Application.MainForm) then + Params.WndParent := Application.MainForm.Handle + else + Params.WndParent := Application.Handle; +end; + +procedure TJclDebugResultForm.FormCreate(Sender: TObject); +var + Index: Integer; +begin + SetBounds(Settings.LoadInteger(JclLeft, Left), + Settings.LoadInteger(JclTop, Top), + Settings.LoadInteger(JclWidth, Width), + Settings.LoadInteger(JclHeight, Height)); + + with ResultListView.Columns do + for Index := 0 to Count - 1 do + Items[Index].Width := Settings.LoadInteger(Format(ColumnRegName, [Index]), Items[Index].Width); +end; + +procedure TJclDebugResultForm.FormDestroy(Sender: TObject); +var + Index: Integer; +begin + Settings.SaveInteger(JclLeft, Left); + Settings.SaveInteger(JclTop, Top); + Settings.SaveInteger(JclWidth, Width); + Settings.SaveInteger(JclHeight, Height); + + with ResultListView.Columns do + for Index := 0 to Count - 1 do + Settings.SaveInteger(Format(ColumnRegName, [Index]), Items[Index].Width); +end; + +procedure TJclDebugResultForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('C')) then + begin + CopyReportToClipboard; + MessageBeep(MB_OK); + end; +end; + +// History: + +// $Log: JclDebugIdeResult.pas,v $ +// Revision 1.4 2006/01/08 17:16:56 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.3 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.2 2005/10/21 12:24:41 marquardt +// experts reorganized with new directory common +// +// Revision 1.1 2005/10/03 16:15:58 rrossmair +// - moved over from jcl\examples\vcl\debugextension +// +// Revision 1.3 2004/07/25 06:29:51 rrossmair +// ImgList added to uses clause +// +end. diff --git a/official/1.96/experts/debug/JclDebugThread.pas b/official/1.96/experts/debug/JclDebugThread.pas new file mode 100644 index 0000000..62b00c4 --- /dev/null +++ b/official/1.96/experts/debug/JclDebugThread.pas @@ -0,0 +1,186 @@ +{******************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ The contents of this file are subject to the Mozilla Public License Version } +{ 1.0 (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 JclDebugThread.pas. } +{ } +{ The Initial Developer of the Original Code is documented in the accompanying } +{ help file JCL.chm. Portions created by these individuals are Copyright (C) } +{ of these individuals. } +{ } +{ Last modified: July 16, 2001 } +{ } +{******************************************************************************} + +unit JclDebugThread; + +{$I jcl.inc} + +interface + +uses + Windows, Classes, SysUtils; + +procedure RegisterThread(ThreadID: DWORD; const ThreadName: string); overload; +procedure RegisterThread(Thread: TThread; const ThreadName: string; IncludeClassName: Boolean = True); overload; + +procedure UnregisterThread(ThreadID: DWORD); overload; +procedure UnregisterThread(Thread: TThread); overload; + +procedure ChangeThreadName(ThreadID: DWORD; const ThreadName: string); overload; +procedure ChangeThreadName(Thread: TThread; const ThreadName: string; IncludeClassName: Boolean = True); overload; + +function ThreadNamesAvailable: Boolean; + +implementation + +uses + JclDebug, JclPeImage, JclSysUtils, + ThreadExpertSharedNames; + +type + PThreadRec = ^TThreadRec; + TThreadRec = record + Func: TThreadFunc; + Parameter: Pointer; + end; + + TJclDebugThreadNotifier = class(TObject) + public + procedure ThreadRegistered(ThreadID: DWORD); + end; + +var + SharedThreadNames: TSharedThreadNames; + HookImports: TJclPeMapImgHooks; + Notifier: TJclDebugThreadNotifier; + Kernel32_CreateThread: function (lpThreadAttributes: Pointer; + dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; + lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall; + Kernel32_ExitThread: procedure (dwExitCode: DWORD); stdcall; + +function NewCreateThread(lpThreadAttributes: Pointer; + dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; + lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall; +var + Instance: TObject; +begin + Result := Kernel32_CreateThread(lpThreadAttributes, dwStackSize, lpStartAddress, lpParameter, dwCreationFlags, lpThreadId); + if (Result <> 0) and (lpParameter <> nil) then + try + Instance := PThreadRec(lpParameter)^.Parameter; + if Instance is TThread then + RegisterThread(TThread(Instance), '', True); + except + end; +end; + +procedure NewExitThread(dwExitCode: DWORD); stdcall; +var + ThreadID: DWORD; +begin + ThreadID := GetCurrentThreadId; + Kernel32_ExitThread(dwExitCode); + try + UnregisterThread(ThreadID); + except + end; +end; + +function CreateThreadName(const ThreadName, ThreadClassName: string): string; +begin + if ThreadClassName <> '' then + begin + if ThreadName = '' then + Result := Format('[%s]', [ThreadClassName]) + else + Result := Format('[%s] "%s"', [ThreadClassName, ThreadName]); + end + else + Result := Format('"%s"', [ThreadName]); +end; + +procedure RegisterThread(ThreadID: DWORD; const ThreadName: string); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames.RegisterThread(ThreadID, CreateThreadName(ThreadName, '')); +end; + +procedure RegisterThread(Thread: TThread; const ThreadName: string; IncludeClassName: Boolean); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames.RegisterThread(Thread.ThreadID, CreateThreadName(ThreadName, Thread.ClassName)); +end; + +procedure UnregisterThread(ThreadID: DWORD); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames.UnregisterThread(ThreadID); +end; + +procedure UnregisterThread(Thread: TThread); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames.UnregisterThread(Thread.ThreadID); +end; + +procedure ChangeThreadName(ThreadID: DWORD; const ThreadName: string); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames[ThreadID] := CreateThreadName(ThreadName, ''); +end; + +procedure ChangeThreadName(Thread: TThread; const ThreadName: string; IncludeClassName: Boolean); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames[Thread.ThreadID] := CreateThreadName(ThreadName, Thread.ClassName); +end; + +function ThreadNamesAvailable: Boolean; +begin + Result := Assigned(SharedThreadNames); +end; + +procedure Init; +begin + if IsDebuggerAttached and TSharedThreadNames.Exists then + begin + SharedThreadNames := TSharedThreadNames.Create(False); + HookImports := TJclPeMapImgHooks.Create; + with HookImports do + begin + HookImport(SystemBase, kernel32, 'CreateThread', @NewCreateThread, @Kernel32_CreateThread); + HookImport(SystemBase, kernel32, 'ExitThread', @NewExitThread, @Kernel32_ExitThread); + end; + { TODO -oPV -cDesign : TJclDebugThread could hold its name. In case of that the name could be read in hooked CreateThread } + Notifier := TJclDebugThreadNotifier.Create; + JclDebugThreadList.OnThreadRegistered := Notifier.ThreadRegistered; + end; +end; + +//=== { TJclDebugThreadNotifier } ============================================ + +procedure TJclDebugThreadNotifier.ThreadRegistered(ThreadID: DWORD); +begin + with JclDebugThreadList do + SharedThreadNames.RegisterThread(ThreadID, + CreateThreadName(ThreadNames[ThreadID], JclDebugThreadList.ThreadClassNames[ThreadID])); +end; + +initialization + Init; + +finalization + FreeAndNil(HookImports); + FreeAndNil(SharedThreadNames); + FreeAndNil(Notifier); + +end. diff --git a/official/1.96/experts/debug/dialog/ClxExceptDlg.ico b/official/1.96/experts/debug/dialog/ClxExceptDlg.ico new file mode 100644 index 0000000..2fd6f72 Binary files /dev/null and b/official/1.96/experts/debug/dialog/ClxExceptDlg.ico differ diff --git a/official/1.96/experts/debug/dialog/ClxExceptDlg.pas b/official/1.96/experts/debug/dialog/ClxExceptDlg.pas new file mode 100644 index 0000000..45801d8 --- /dev/null +++ b/official/1.96/experts/debug/dialog/ClxExceptDlg.pas @@ -0,0 +1,755 @@ +{**************************************************************************************************} +{ } +{ 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 ClxExceptDlg.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{**************************************************************************************************} +{ } +{ Sample CLX Application exception dialog replacement (for Windows only) } +{ } +{ Last modified: $Date: 2005/10/26 03:29:44 $ } +{ } +{**************************************************************************************************} + +unit ClxExceptDlg; + +{$I jcl.inc} + +interface + +{$IFDEF DELPHI6_UP} +{$IF Defined(MSWINDOWS)} + +uses + SysUtils, Classes, Qt, QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, JclDebug; + +const + QEventType_UMCreateDetails = QEventType(Integer(QEventType_ClxUser) + $01); + + ReportToLogEnabled = $00000001; // TExceptionDialog.Tag property + DisableTextScrollbar = $00000002; // TExceptionDialog.Tag property + +type + TSimpleExceptionLog = class (TObject) + private + FLogFileHandle: THandle; + FLogFileName: string; + FLogWasEmpty: Boolean; + function GetLogOpen: Boolean; + protected + function CreateDefaultFileName: string; + public + constructor Create(const ALogFileName: string = ''); + destructor Destroy; override; + procedure CloseLog; + procedure OpenLog; + procedure Write(const Text: string; Indent: Integer = 0); overload; + procedure Write(Strings: TStrings; Indent: Integer = 0); overload; + procedure WriteStamp(SeparatorLen: Integer = 0); + property LogFileName: string read FLogFileName; + property LogOpen: Boolean read GetLogOpen; + end; + + TExcDialogSystemInfo = (siStackList, siOsInfo, siModuleList, siActiveControls); + TExcDialogSystemInfos = set of TExcDialogSystemInfo; + + TExceptionDialog = class(TForm) + OkBtn: TButton; + DetailsMemo: TMemo; + DetailsBtn: TButton; + Bevel1: TBevel; + TextLabel: TMemo; + ErrorIconImage: TImage; + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure DetailsBtnClick(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormDestroy(Sender: TObject); + procedure FormResize(Sender: TObject); + private + FDetailsVisible: Boolean; + FIsMainThead: Boolean; + FLastActiveControl: TWinControl; + FNonDetailsHeight: Integer; + FFullHeight: Integer; + FSimpleLog: TSimpleExceptionLog; + procedure CreateDetails; + function GetReportAsText: string; + procedure SetDetailsVisible(const Value: Boolean); + protected + procedure AfterCreateDetails; dynamic; + procedure BeforeCreateDetails; dynamic; + procedure CreateDetailInfo; dynamic; + procedure CreateReport(const SystemInfo: TExcDialogSystemInfos); + function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override; + procedure ReportToLog; + function ReportMaxColumns: Integer; virtual; + function ReportNewBlockDelimiterChar: Char; virtual; + procedure NextDetailBlock; + procedure UpdateTextLabelScrollbars; + public + procedure CopyReportToClipboard; + class procedure ExceptionHandler(Sender: TObject; E: Exception); + class procedure ExceptionThreadHandler(Thread: TJclDebugThread); + class procedure ShowException(E: Exception; Thread: TJclDebugThread); + property DetailsVisible: Boolean read FDetailsVisible write SetDetailsVisible; + property ReportAsText: string read GetReportAsText; + property SimpleLog: TSimpleExceptionLog read FSimpleLog; + end; + + TExceptionDialogClass = class of TExceptionDialog; + +var + ExceptionDialogClass: TExceptionDialogClass = TExceptionDialog; + +{$IFEND Defined(MSWINDOWS)} +{$ENDIF DELPHI6_UP} + +implementation + +{$IFDEF DELPHI6_UP} +{$IF Defined(MSWINDOWS)} + +{$R *.xfm} + +uses + ClipBrd, Windows, Math, + JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclSysUtils; + +resourcestring + RsAppError = '%s - application error'; + RsExceptionClass = 'Exception class: %s'; + RsExceptionAddr = 'Exception address: %p'; + RsStackList = 'Stack list, generated %s'; + RsModulesList = 'List of loaded modules:'; + RsOSVersion = 'System : %s %s, Version: %d.%d, Build: %x, "%s"'; + RsProcessor = 'Processor: %s, %s, %d MHz %s%s'; + RsScreenRes = 'Display : %dx%d pixels, %d bpp'; + RsActiveControl = 'Active Controls hierarchy:'; + RsThread = 'Thread: %s'; + RsMissingVersionInfo = '(no version info)'; + +var + ExceptionDialog: TExceptionDialog; + +//================================================================================================== +// Helper routines +//================================================================================================== + +function GetBPP: Integer; +var + DC: HDC; +begin + DC := GetDC(0); + Result := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES); + ReleaseDC(0, DC); +end; + +//-------------------------------------------------------------------------------------------------- + +function SortModulesListByAddressCompare(List: TStringList; Index1, Index2: Integer): Integer; +begin + Result := Integer(List.Objects[Index1]) - Integer(List.Objects[Index2]); +end; + +//================================================================================================== +// TApplication.HandleException method code hooking for exceptions from DLLs +//================================================================================================== + +// We need to catch the last line of TApplication.HandleException method: +// [...] +// end else +// SysUtils.ShowException(ExceptObject, ExceptAddr); +// end; + +procedure HookShowException(ExceptObject: TObject; ExceptAddr: Pointer); +begin + if JclValidateModuleAddress(ExceptAddr) and (ExceptObject.InstanceSize >= Exception.InstanceSize) then + TExceptionDialog.ExceptionHandler(nil, Exception(ExceptObject)) + else + SysUtils.ShowException(ExceptObject, ExceptAddr); +end; + +//-------------------------------------------------------------------------------------------------- + +function HookTApplicationHandleException: Boolean; +const + CallOffset = $86; + CallOffsetDebug = $63; +type + PCALLInstruction = ^TCALLInstruction; + TCALLInstruction = packed record + Call: Byte; + Address: Integer; + end; +var + TApplicationHandleExceptionAddr, SysUtilsShowExceptionAddr: Pointer; + CALLInstruction: TCALLInstruction; + CallAddress: Pointer; + NW: DWORD; + + function CheckAddressForOffset(Offset: Cardinal): Boolean; + begin + try + CallAddress := Pointer(Cardinal(TApplicationHandleExceptionAddr) + Offset); + CALLInstruction.Call := $E8; + Result := PCALLInstruction(CallAddress)^.Call = CALLInstruction.Call; + if Result then + begin + if IsCompiledWithPackages then + Result := PeMapImgResolvePackageThunk(Pointer(Integer(CallAddress) + Integer(PCALLInstruction(CallAddress)^.Address) + SizeOf(CALLInstruction))) = SysUtilsShowExceptionAddr + else + Result := PCALLInstruction(CallAddress)^.Address = Integer(SysUtilsShowExceptionAddr) - Integer(CallAddress) - SizeOf(CALLInstruction); + end; + except + Result := False; + end; + end; + +begin + TApplicationHandleExceptionAddr := PeMapImgResolvePackageThunk(@TApplication.HandleException); + SysUtilsShowExceptionAddr := PeMapImgResolvePackageThunk(@SysUtils.ShowException); + Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug); + if Result then + begin + CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction); + Result := WriteProcessMemory(GetCurrentProcess, CallAddress, @CALLInstruction, SizeOf(CALLInstruction), NW); + if Result then + FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction)); + end; +end; + +//================================================================================================== +// TSimpleExceptionLog +//================================================================================================== + +procedure TSimpleExceptionLog.CloseLog; +begin + if LogOpen then + begin + CloseHandle(FLogFileHandle); + FLogFileHandle := INVALID_HANDLE_VALUE; + FLogWasEmpty := False; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +constructor TSimpleExceptionLog.Create(const ALogFileName: string); +begin + if ALogFileName = '' then + FLogFileName := CreateDefaultFileName + else + FLogFileName := ALogFileName; + FLogFileHandle := INVALID_HANDLE_VALUE; +end; + +//-------------------------------------------------------------------------------------------------- + +function TSimpleExceptionLog.CreateDefaultFileName: string; +begin + Result := PathExtractFileDirFixed(ParamStr(0)) + PathExtractFileNameNoExt(ParamStr(0)) + '_Err.log'; +end; + +//-------------------------------------------------------------------------------------------------- + +destructor TSimpleExceptionLog.Destroy; +begin + CloseLog; + inherited; +end; + +//-------------------------------------------------------------------------------------------------- + +function TSimpleExceptionLog.GetLogOpen: Boolean; +begin + Result := FLogFileHandle <> INVALID_HANDLE_VALUE; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.OpenLog; +begin + if not LogOpen then + begin + FLogFileHandle := CreateFile(PChar(FLogFileName), GENERIC_WRITE, FILE_SHARE_READ, nil, + OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + if LogOpen then + FLogWasEmpty := SetFilePointer(FLogFileHandle, 0, nil, FILE_END) = 0; + end + else + FLogWasEmpty := False; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.Write(const Text: string; Indent: Integer); +var + S: string; + SL: TStringList; + I: Integer; +begin + if LogOpen then + begin + SL := TStringList.Create; + try + SL.Text := Text; + for I := 0 to SL.Count - 1 do + begin + S := StringOfChar(' ', Indent) + StrEnsureSuffix(AnsiCrLf, TrimRight(SL[I])); + FileWrite(Integer(FLogFileHandle), Pointer(S)^, Length(S)); + end; + finally + SL.Free; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.Write(Strings: TStrings; Indent: Integer); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Write(Strings[I], Indent); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.WriteStamp(SeparatorLen: Integer); +begin + if SeparatorLen = 0 then + SeparatorLen := 100; + SeparatorLen := Max(SeparatorLen, 20); + OpenLog; + if not FLogWasEmpty then + Write(AnsiCrLf); + Write(StrRepeat('=', SeparatorLen)); + Write(Format('= %-*s =', [SeparatorLen - 4, DateTimeToStr(Now)])); + Write(StrRepeat('=', SeparatorLen)); +end; + +//================================================================================================== +// Exception dialog +//================================================================================================== + +var + ExceptionShowing: Boolean; + +{ TExceptionDialog } + +procedure TExceptionDialog.AfterCreateDetails; +begin +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.BeforeCreateDetails; +begin +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.CopyReportToClipboard; +begin + ClipBoard.AsText := ReportAsText; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.CreateDetailInfo; +begin + CreateReport([siStackList, siOsInfo, siModuleList, siActiveControls]); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.CreateDetails; +begin + Screen.Cursor := crHourGlass; + DetailsMemo.Lines.BeginUpdate; + try + CreateDetailInfo; + ReportToLog; + AfterCreateDetails; + finally + DetailsMemo.Lines.EndUpdate; + DetailsMemo.SelStart := 0; + OkBtn.Enabled := True; + DetailsBtn.Enabled := True; + OkBtn.SetFocus; + Screen.Cursor := crDefault; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.CreateReport(const SystemInfo: TExcDialogSystemInfos); +const + MMXText: array[Boolean] of PChar = ('', 'MMX'); + FDIVText: array[Boolean] of PChar = (' [FDIV Bug]', ''); +var + SL: TStringList; + I: Integer; + ModuleName: TFileName; + CpuInfo: TCpuInfo; + C: TWinControl; + NtHeaders: PImageNtHeaders; + ModuleBase: Cardinal; + ImageBaseStr: string; + StackList: TJclStackInfoList; +begin + SL := TStringList.Create; + try + // Stack list + if siStackList in SystemInfo then + begin + StackList := JclLastExceptStackList; + if Assigned(StackList) then + begin + DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)])); + StackList.AddToStrings(DetailsMemo.Lines, False, True, True); + NextDetailBlock; + end; + end; + // System and OS information + if siOsInfo in SystemInfo then + begin + DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString, + Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion])); + GetCpuInfo(CpuInfo); + with CpuInfo do + DetailsMemo.Lines.Add(Format(RsProcessor, [Manufacturer, CpuName, + RoundFrequency(FrequencyInfo.NormFreq), + MMXText[MMX], FDIVText[IsFDIVOK]])); + DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP])); + NextDetailBlock; + end; + // Modules list + if (siModuleList in SystemInfo) and LoadedModulesList(SL, GetCurrentProcessId) then + begin + DetailsMemo.Lines.Add(RsModulesList); + SL.CustomSort(SortModulesListByAddressCompare); + for I := 0 to SL.Count - 1 do + begin + ModuleName := SL[I]; + ModuleBase := Cardinal(SL.Objects[I]); + DetailsMemo.Lines.Add(Format('[%.8x] %s', [ModuleBase, ModuleName])); + NtHeaders := PeMapImgNtHeaders(Pointer(ModuleBase)); + if (NtHeaders <> nil) and (NtHeaders^.OptionalHeader.ImageBase <> ModuleBase) then + ImageBaseStr := Format('<%.8x> ', [NtHeaders^.OptionalHeader.ImageBase]) + else + ImageBaseStr := StrRepeat(' ', 11); + if VersionResourceAvailable(ModuleName) then + with TJclFileVersionInfo.Create(ModuleName) do + try + DetailsMemo.Lines.Add(ImageBaseStr + BinFileVersion + ' - ' + FileVersion); + if FileDescription <> '' then + DetailsMemo.Lines.Add(StrRepeat(' ', 11) + FileDescription); + finally + Free; + end + else + DetailsMemo.Lines.Add(ImageBaseStr + RsMissingVersionInfo); + end; + NextDetailBlock; + end; + // Active controls + if (siActiveControls in SystemInfo) and (FLastActiveControl <> nil) then + begin + DetailsMemo.Lines.Add(RsActiveControl); + C := FLastActiveControl; + while C <> nil do + begin + DetailsMemo.Lines.Add(Format('%s "%s"', [C.ClassName, C.Name])); + C := C.Parent; + end; + NextDetailBlock; + end; + finally + SL.Free; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.DetailsBtnClick(Sender: TObject); +begin + DetailsVisible := not DetailsVisible; +end; + +//-------------------------------------------------------------------------------------------------- + +function TExceptionDialog.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; +begin + if QEvent_isQCustomEvent(Event) and (QEvent_type(Event) = QEventType_UMCreateDetails) then + begin + Update; + CreateDetails; + Result := True; + end + else + Result := inherited EventFilter(Sender, Event); +end; + +//-------------------------------------------------------------------------------------------------- + +class procedure TExceptionDialog.ExceptionHandler(Sender: TObject; E: Exception); +begin + if ExceptionShowing then + Application.ShowException(E) + else + begin + ExceptionShowing := True; + try + ShowException(E, nil); + finally + ExceptionShowing := False; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +class procedure TExceptionDialog.ExceptionThreadHandler(Thread: TJclDebugThread); +begin + if ExceptionShowing then + Application.ShowException(Thread.SyncException) + else + begin + ExceptionShowing := True; + try + ShowException(Thread.SyncException, Thread); + finally + ExceptionShowing := False; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormCreate(Sender: TObject); +begin + FSimpleLog := TSimpleExceptionLog.Create; + FFullHeight := ClientHeight; + DetailsVisible := False; + Caption := Format(RsAppError, [Application.Title]); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormDestroy(Sender: TObject); +begin + FreeAndNil(FSimpleLog); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Key = Ord('C')) and (ssCtrl in Shift) then + begin + CopyReportToClipboard; + MessageBeep(MB_OK); + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormResize(Sender: TObject); +begin + UpdateTextLabelScrollbars; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormShow(Sender: TObject); +begin + BeforeCreateDetails; + MessageBeep(MB_ICONERROR); + if FIsMainThead and (GetWindowThreadProcessId(QWidget_WinID(Handle), nil) = MainThreadID) then + QApplication_postEvent(Handle, QCustomEvent_create(QEventType_UMCreateDetails, nil)) + else + CreateDetails; +end; + +//-------------------------------------------------------------------------------------------------- + +function TExceptionDialog.GetReportAsText: string; +begin + Result := StrEnsureSuffix(AnsiCrLf, TextLabel.Text) + AnsiCrLf + DetailsMemo.Text; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.NextDetailBlock; +begin + DetailsMemo.Lines.Add(StrRepeat(ReportNewBlockDelimiterChar, ReportMaxColumns)); +end; + +//-------------------------------------------------------------------------------------------------- + +function TExceptionDialog.ReportMaxColumns: Integer; +begin + Result := 100; +end; + +//-------------------------------------------------------------------------------------------------- + +function TExceptionDialog.ReportNewBlockDelimiterChar: Char; +begin + Result := '-'; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.ReportToLog; +begin + if Tag and ReportToLogEnabled <> 0 then + begin + FSimpleLog.WriteStamp(ReportMaxColumns); + try + FSimpleLog.Write(ReportAsText); + finally + FSimpleLog.CloseLog; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.SetDetailsVisible(const Value: Boolean); +var + DetailsCaption: string; +begin + FDetailsVisible := Value; + DetailsCaption := Trim(StrRemoveChars(DetailsBtn.Caption, ['<', '>'])); + if Value then + begin + Constraints.MinHeight := FNonDetailsHeight + 100; + Constraints.MaxHeight := Screen.Height; + DetailsCaption := '<< ' + DetailsCaption; + ClientHeight := FFullHeight; + DetailsMemo.Height := FFullHeight - DetailsMemo.Top - 3; + end + else + begin + FFullHeight := ClientHeight; + DetailsCaption := DetailsCaption + ' >>'; + if FNonDetailsHeight = 0 then + begin + ClientHeight := Bevel1.Top; + FNonDetailsHeight := Height; + end + else + Height := FNonDetailsHeight; + Constraints.MinHeight := FNonDetailsHeight; + Constraints.MaxHeight := FNonDetailsHeight; + end; + DetailsBtn.Caption := DetailsCaption; + DetailsMemo.Enabled := Value; +end; + +//-------------------------------------------------------------------------------------------------- + +class procedure TExceptionDialog.ShowException(E: Exception; Thread: TJclDebugThread); +begin + if ExceptionDialog = nil then + ExceptionDialog := ExceptionDialogClass.Create(Application); + try + if Assigned(Application.MainForm) then + Application.BringToFront; + with ExceptionDialog do + begin + FIsMainThead := (GetCurrentThreadId = MainThreadID); + FLastActiveControl := Screen.ActiveControl; + TextLabel.Text := AdjustLineBreaks(StrEnsureSuffix('.', E.Message)); + UpdateTextLabelScrollbars; + DetailsMemo.Lines.Add(Format(RsExceptionClass, [E.ClassName])); + if Thread = nil then + DetailsMemo.Lines.Add(Format(RsExceptionAddr, [ExceptAddr])) + else + DetailsMemo.Lines.Add(Format(RsThread, [Thread.ThreadInfo])); + NextDetailBlock; + ShowModal; + end; + finally + FreeAndNil(ExceptionDialog); + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.UpdateTextLabelScrollbars; +begin + if Tag and DisableTextScrollbar = 0 then + begin + Canvas.Font := TextLabel.Font; + if TextLabel.Lines.Count * Canvas.TextHeight('Wg') > TextLabel.ClientHeight then + TextLabel.ScrollBars := ssVertical + else + TextLabel.ScrollBars := ssNone; + end; +end; + +//================================================================================================== +// Exception handler initialization code +//================================================================================================== + +procedure InitializeHandler; +begin + JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode]; + {$IFNDEF HOOK_DLL_EXCEPTIONS} + JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList]; + {$ENDIF HOOK_DLL_EXCEPTIONS} + JclDebugThreadList.OnSyncException := TExceptionDialog.ExceptionThreadHandler; + JclStartExceptionTracking; + {$IFDEF HOOK_DLL_EXCEPTIONS} + if HookTApplicationHandleException then + JclTrackExceptionsFromLibraries; + {$ENDIF HOOK_DLL_EXCEPTIONS} + Application.OnException := TExceptionDialog.ExceptionHandler; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure UnInitializeHandler; +begin + Application.OnException := nil; + JclDebugThreadList.OnSyncException := nil; + JclUnhookExceptions; + JclStopExceptionTracking; +end; + +//-------------------------------------------------------------------------------------------------- + +initialization + InitializeHandler; + +finalization + UnInitializeHandler; + +{$IFEND Defined(MSWINDOWS)} +{$ENDIF DELPHI6_UP} + +// History: + +// $Log: ClxExceptDlg.pas,v $ +// Revision 1.2 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/dialog/ClxExceptDlg.xfm b/official/1.96/experts/debug/dialog/ClxExceptDlg.xfm new file mode 100644 index 0000000..8a9aa92 --- /dev/null +++ b/official/1.96/experts/debug/dialog/ClxExceptDlg.xfm @@ -0,0 +1,203 @@ +object ExceptionDialog: TExceptionDialog + Left = 369 + Top = 285 + ActiveControl = OkBtn + AutoScroll = False + BorderIcons = [biSystemMenu] + Caption = 'ExceptionDialog' + ClientHeight = 255 + ClientWidth = 432 + Color = clButton + Constraints.MinWidth = 200 + Font.Color = clText + Font.Height = 11 + Font.Name = 'MS Sans Serif' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + KeyPreview = True + ParentFont = False + Position = poScreenCenter + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnResize = FormResize + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + TextWidth = 6 + object Bevel1: TBevel + Left = 3 + Top = 91 + Width = 428 + Height = 9 + Anchors = [akLeft, akTop, akRight] + Shape = bsTopLine + end + object ErrorIconImage: TImage + Left = 8 + Top = 8 + Width = 32 + Height = 32 + Picture.Data = { + 07544269746D61703A0C0000424D360C00000000000036000000280000002000 + 0000200000000100180000000000000C0000120B0000120B0000000000000000 + 0000C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4 + C8D0D4C8D0D4C8D0D48080808080808080808080808080808080808080808080 + 80C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4 + 8080808080808080808080808080808080808080808080808080808080808080 + 80808080808080808080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4808080 + 8080800000800000800000800000800000800000800000800000808080808080 + 80808080808080808080808080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4808080000080000080 + 0000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000800000 + 80000080808080808080808080808080808080C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D48080800000800000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF000080808080808080808080808080808080C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000800000800000FF0000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF0000FF000080000080808080808080808080808080C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF0000FF0000FF0000FF000080808080808080808080C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF0000FF0000FF0000FF0000FF000080808080808080808080C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF0000FF0000FF0000FF0000FF000080808080808080808080808080C8 + D0D4C8D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FFFFFFFF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FFFFFF + FF0000FF0000FF0000FF0000FF0000FF0000FF000080808080808080808080C8 + D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FFFFFFFFFFFFFF + FFFFFF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FFFFFFFFFFFF + FFFFFFFF0000FF0000FF0000FF0000FF0000FF0000FF000080808080808080C8 + D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF0000FF0000FF0000FF0000FF0000FF0000FFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFF0000FF0000FF0000FF0000FF0000FF00008080808080808080 + 8080C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFF0000FF0000FF0000FF0000FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFF0000FF0000FF0000FF0000FF0000FF0000FF00008080808080808080 + 80800000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFF0000FF0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF00008080808080 + 80800000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000 + FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF00008080808080 + 80800000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF0000 + FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF00008080808080 + 80800000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF + 0000FF0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF0000FF0000 + FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF00008080808080 + 80800000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF + 0000FF0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF0000FF0000 + FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF00008080808080 + 80800000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000FF0000 + FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF00008080808080 + 80800000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0000 + FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF000080808080C8 + D0D40000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFF0000FF0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF000080808080C8 + D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFF0000FF0000FF0000FF0000FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFF0000FF0000FF0000FF0000FF0000FF0000FF000080808080808080C8 + D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFF0000FF0000FF0000FF0000FF0000FF0000FFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFF0000FF0000FF0000FF0000FF0000FF000080808080C8D0D4C8 + D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FFFFFFFFFFFFFF + FFFFFF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FFFFFFFFFFFF + FFFFFFFF0000FF0000FF0000FF0000FF0000FF0000FF000080C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FFFFFFFF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FFFFFF + FF0000FF0000FF0000FF0000FF0000FF0000FF000080808080C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF0000FF0000FF0000FF0000FF000080808080C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF0000FF0000FF0000FF0000FF000080C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D40000800000FF0000FF0000FF0000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF0000FF0000FF0000FF000080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000800000800000FF0000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF0000FF000080000080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D40000800000FF0000FF + 0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000 + FF0000FF000080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4000080000080 + 0000800000FF0000FF0000FF0000FF0000FF0000FF0000FF0000FF0000800000 + 80000080C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4 + C8D0D4000080000080000080000080000080000080000080000080C8D0D4C8D0 + D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8D0D4C8 + D0D4} + Transparent = True + end + object OkBtn: TButton + Left = 352 + Top = 4 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = '&OK' + Default = True + ModalResult = 1 + TabOrder = 1 + end + object DetailsMemo: TMemo + Left = 4 + Top = 101 + Width = 424 + Height = 150 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Color = clText + Font.Height = 11 + Font.Name = 'Courier New' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentColor = True + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 3 + WantReturns = False + WordWrap = False + end + object DetailsBtn: TButton + Left = 352 + Top = 60 + Width = 75 + Height = 25 + Hint = 'Show or hide additional information|' + Anchors = [akTop, akRight] + Caption = '&Details' + Enabled = False + TabOrder = 2 + OnClick = DetailsBtnClick + end + object TextLabel: TMemo + Left = 56 + Top = 8 + Width = 281 + Height = 75 + Hint = 'Use Ctrl+C to copy the report to the clipboard' + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + Lines.Strings = ( + 'TextLabel') + ParentColor = True + ReadOnly = True + TabOrder = 0 + WantReturns = False + end +end diff --git a/official/1.96/experts/debug/dialog/ExceptDlg.dfm b/official/1.96/experts/debug/dialog/ExceptDlg.dfm new file mode 100644 index 0000000..530a935 --- /dev/null +++ b/official/1.96/experts/debug/dialog/ExceptDlg.dfm @@ -0,0 +1,96 @@ +object ExceptionDialog: TExceptionDialog + Left = 363 + Top = 284 + ActiveControl = OkBtn + AutoScroll = False + BorderIcons = [biSystemMenu] + Caption = 'ExceptionDialog' + ClientHeight = 255 + ClientWidth = 432 + Color = clBtnFace + Constraints.MinWidth = 200 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + KeyPreview = True + OldCreateOrder = False + Position = poScreenCenter + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnPaint = FormPaint + OnResize = FormResize + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object Bevel1: TBevel + Left = 3 + Top = 91 + Width = 428 + Height = 9 + Anchors = [akLeft, akTop, akRight] + Shape = bsTopLine + end + object OkBtn: TButton + Left = 352 + Top = 4 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = '&OK' + Default = True + ModalResult = 1 + TabOrder = 1 + end + object DetailsMemo: TMemo + Left = 4 + Top = 101 + Width = 424 + Height = 150 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + ParentColor = True + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 3 + WantReturns = False + WordWrap = False + end + object DetailsBtn: TButton + Left = 352 + Top = 60 + Width = 75 + Height = 25 + Hint = 'Show or hide additional information|' + Anchors = [akTop, akRight] + Caption = '&Details' + Enabled = False + TabOrder = 2 + OnClick = DetailsBtnClick + end + object TextLabel: TMemo + Left = 56 + Top = 8 + Width = 281 + Height = 75 + Hint = 'Use Ctrl+C to copy the report to the clipboard' + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + Ctl3D = True + Lines.Strings = ( + 'TextLabel') + ParentColor = True + ParentCtl3D = False + ReadOnly = True + TabOrder = 0 + WantReturns = False + end +end diff --git a/official/1.96/experts/debug/dialog/ExceptDlg.ico b/official/1.96/experts/debug/dialog/ExceptDlg.ico new file mode 100644 index 0000000..2fd6f72 Binary files /dev/null and b/official/1.96/experts/debug/dialog/ExceptDlg.ico differ diff --git a/official/1.96/experts/debug/dialog/ExceptDlg.pas b/official/1.96/experts/debug/dialog/ExceptDlg.pas new file mode 100644 index 0000000..b0e2e00 --- /dev/null +++ b/official/1.96/experts/debug/dialog/ExceptDlg.pas @@ -0,0 +1,745 @@ +{**************************************************************************************************} +{ } +{ 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 ExceptDlg.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{**************************************************************************************************} +{ } +{ Sample Application exception dialog replacement } +{ } +{ Last modified: $Date: 2005/10/26 03:29:44 $ } +{ } +{**************************************************************************************************} + +unit ExceptDlg; + +{$I jcl.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, JclDebug; + +const + UM_CREATEDETAILS = WM_USER + $100; + + ReportToLogEnabled = $00000001; // TExceptionDialog.Tag property + DisableTextScrollbar = $00000002; // TExceptionDialog.Tag property + +type + TSimpleExceptionLog = class (TObject) + private + FLogFileHandle: THandle; + FLogFileName: string; + FLogWasEmpty: Boolean; + function GetLogOpen: Boolean; + protected + function CreateDefaultFileName: string; + public + constructor Create(const ALogFileName: string = ''); + destructor Destroy; override; + procedure CloseLog; + procedure OpenLog; + procedure Write(const Text: string; Indent: Integer = 0); overload; + procedure Write(Strings: TStrings; Indent: Integer = 0); overload; + procedure WriteStamp(SeparatorLen: Integer = 0); + property LogFileName: string read FLogFileName; + property LogOpen: Boolean read GetLogOpen; + end; + + TExcDialogSystemInfo = (siStackList, siOsInfo, siModuleList, siActiveControls); + TExcDialogSystemInfos = set of TExcDialogSystemInfo; + + TExceptionDialog = class(TForm) + OkBtn: TButton; + DetailsMemo: TMemo; + DetailsBtn: TButton; + Bevel1: TBevel; + TextLabel: TMemo; + procedure FormPaint(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure DetailsBtnClick(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormDestroy(Sender: TObject); + procedure FormResize(Sender: TObject); + private + FDetailsVisible: Boolean; + FIsMainThead: Boolean; + FLastActiveControl: TWinControl; + FNonDetailsHeight: Integer; + FFullHeight: Integer; + FSimpleLog: TSimpleExceptionLog; + procedure CreateDetails; + function GetReportAsText: string; + procedure ReportToLog; + procedure SetDetailsVisible(const Value: Boolean); + procedure UMCreateDetails(var Message: TMessage); message UM_CREATEDETAILS; + protected + procedure AfterCreateDetails; dynamic; + procedure BeforeCreateDetails; dynamic; + procedure CreateDetailInfo; dynamic; + procedure CreateReport(const SystemInfo: TExcDialogSystemInfos); + function ReportMaxColumns: Integer; virtual; + function ReportNewBlockDelimiterChar: Char; virtual; + procedure NextDetailBlock; + procedure UpdateTextLabelScrollbars; + public + procedure CopyReportToClipboard; + class procedure ExceptionHandler(Sender: TObject; E: Exception); + class procedure ExceptionThreadHandler(Thread: TJclDebugThread); + class procedure ShowException(E: Exception; Thread: TJclDebugThread); + property DetailsVisible: Boolean read FDetailsVisible write SetDetailsVisible; + property ReportAsText: string read GetReportAsText; + property SimpleLog: TSimpleExceptionLog read FSimpleLog; + end; + + TExceptionDialogClass = class of TExceptionDialog; + +var + ExceptionDialogClass: TExceptionDialogClass = TExceptionDialog; + +implementation + +{$R *.DFM} + +uses + ClipBrd, Math, + JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclSysUtils; + +resourcestring + RsAppError = '%s - application error'; + RsExceptionClass = 'Exception class: %s'; + RsExceptionAddr = 'Exception address: %p'; + RsStackList = 'Stack list, generated %s'; + RsModulesList = 'List of loaded modules:'; + RsOSVersion = 'System : %s %s, Version: %d.%d, Build: %x, "%s"'; + RsProcessor = 'Processor: %s, %s, %d MHz %s%s'; + RsScreenRes = 'Display : %dx%d pixels, %d bpp'; + RsActiveControl = 'Active Controls hierarchy:'; + RsThread = 'Thread: %s'; + RsMissingVersionInfo = '(no version info)'; + +var + ExceptionDialog: TExceptionDialog; + +//================================================================================================== +// Helper routines +//================================================================================================== + +function GetBPP: Integer; +var + DC: HDC; +begin + DC := GetDC(0); + Result := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES); + ReleaseDC(0, DC); +end; + +//-------------------------------------------------------------------------------------------------- + +function SortModulesListByAddressCompare(List: TStringList; Index1, Index2: Integer): Integer; +begin + Result := Integer(List.Objects[Index1]) - Integer(List.Objects[Index2]); +end; + +//================================================================================================== +// TApplication.HandleException method code hooking for exceptions from DLLs +//================================================================================================== + +// We need to catch the last line of TApplication.HandleException method: +// [...] +// end else +// SysUtils.ShowException(ExceptObject, ExceptAddr); +// end; + +procedure HookShowException(ExceptObject: TObject; ExceptAddr: Pointer); +begin + if JclValidateModuleAddress(ExceptAddr) and (ExceptObject.InstanceSize >= Exception.InstanceSize) then + TExceptionDialog.ExceptionHandler(nil, Exception(ExceptObject)) + else + SysUtils.ShowException(ExceptObject, ExceptAddr); +end; + +//-------------------------------------------------------------------------------------------------- + +function HookTApplicationHandleException: Boolean; +const + CallOffset = $86; + CallOffsetDebug = $94; +type + PCALLInstruction = ^TCALLInstruction; + TCALLInstruction = packed record + Call: Byte; + Address: Integer; + end; +var + TApplicationHandleExceptionAddr, SysUtilsShowExceptionAddr: Pointer; + CALLInstruction: TCALLInstruction; + CallAddress: Pointer; + NW: DWORD; + + function CheckAddressForOffset(Offset: Cardinal): Boolean; + begin + try + CallAddress := Pointer(Cardinal(TApplicationHandleExceptionAddr) + Offset); + CALLInstruction.Call := $E8; + Result := PCALLInstruction(CallAddress)^.Call = CALLInstruction.Call; + if Result then + begin + if IsCompiledWithPackages then + Result := PeMapImgResolvePackageThunk(Pointer(Integer(CallAddress) + Integer(PCALLInstruction(CallAddress)^.Address) + SizeOf(CALLInstruction))) = SysUtilsShowExceptionAddr + else + Result := PCALLInstruction(CallAddress)^.Address = Integer(SysUtilsShowExceptionAddr) - Integer(CallAddress) - SizeOf(CALLInstruction); + end; + except + Result := False; + end; + end; + +begin + TApplicationHandleExceptionAddr := PeMapImgResolvePackageThunk(@TApplication.HandleException); + SysUtilsShowExceptionAddr := PeMapImgResolvePackageThunk(@SysUtils.ShowException); + Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug); + if Result then + begin + CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction); + Result := WriteProcessMemory(GetCurrentProcess, CallAddress, @CALLInstruction, SizeOf(CALLInstruction), NW); + if Result then + FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction)); + end; +end; + +//================================================================================================== +// TSimpleExceptionLog +//================================================================================================== + +procedure TSimpleExceptionLog.CloseLog; +begin + if LogOpen then + begin + CloseHandle(FLogFileHandle); + FLogFileHandle := INVALID_HANDLE_VALUE; + FLogWasEmpty := False; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +constructor TSimpleExceptionLog.Create(const ALogFileName: string); +begin + if ALogFileName = '' then + FLogFileName := CreateDefaultFileName + else + FLogFileName := ALogFileName; + FLogFileHandle := INVALID_HANDLE_VALUE; +end; + +//-------------------------------------------------------------------------------------------------- + +function TSimpleExceptionLog.CreateDefaultFileName: string; +begin + Result := PathExtractFileDirFixed(ParamStr(0)) + PathExtractFileNameNoExt(ParamStr(0)) + '_Err.log'; +end; + +//-------------------------------------------------------------------------------------------------- + +destructor TSimpleExceptionLog.Destroy; +begin + CloseLog; + inherited; +end; + +//-------------------------------------------------------------------------------------------------- + +function TSimpleExceptionLog.GetLogOpen: Boolean; +begin + Result := FLogFileHandle <> INVALID_HANDLE_VALUE; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.OpenLog; +begin + if not LogOpen then + begin + FLogFileHandle := CreateFile(PChar(FLogFileName), GENERIC_WRITE, FILE_SHARE_READ, nil, + OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + if LogOpen then + FLogWasEmpty := SetFilePointer(FLogFileHandle, 0, nil, FILE_END) = 0; + end + else + FLogWasEmpty := False; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.Write(const Text: string; Indent: Integer); +var + S: string; + SL: TStringList; + I: Integer; +begin + if LogOpen then + begin + SL := TStringList.Create; + try + SL.Text := Text; + for I := 0 to SL.Count - 1 do + begin + S := StringOfChar(' ', Indent) + StrEnsureSuffix(AnsiCrLf, TrimRight(SL[I])); + FileWrite(Integer(FLogFileHandle), Pointer(S)^, Length(S)); + end; + finally + SL.Free; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.Write(Strings: TStrings; Indent: Integer); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Write(Strings[I], Indent); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.WriteStamp(SeparatorLen: Integer); +begin + if SeparatorLen = 0 then + SeparatorLen := 100; + SeparatorLen := Max(SeparatorLen, 20); + OpenLog; + if not FLogWasEmpty then + Write(AnsiCrLf); + Write(StrRepeat('=', SeparatorLen)); + Write(Format('= %-*s =', [SeparatorLen - 4, DateTimeToStr(Now)])); + Write(StrRepeat('=', SeparatorLen)); +end; + +//================================================================================================== +// Exception dialog +//================================================================================================== + +var + ExceptionShowing: Boolean; + +{ TExceptionDialog } + +procedure TExceptionDialog.AfterCreateDetails; +begin +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.BeforeCreateDetails; +begin +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.CopyReportToClipboard; +begin + ClipBoard.AsText := ReportAsText; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.CreateDetailInfo; +begin + CreateReport([siStackList, siOsInfo, siModuleList, siActiveControls]); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.CreateDetails; +begin + Screen.Cursor := crHourGlass; + DetailsMemo.Lines.BeginUpdate; + try + CreateDetailInfo; + ReportToLog; + DetailsMemo.SelStart := 0; + SendMessage(DetailsMemo.Handle, EM_SCROLLCARET, 0, 0); + AfterCreateDetails; + finally + DetailsMemo.Lines.EndUpdate; + OkBtn.Enabled := True; + DetailsBtn.Enabled := True; + OkBtn.SetFocus; + Screen.Cursor := crDefault; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.CreateReport(const SystemInfo: TExcDialogSystemInfos); +const + MMXText: array[Boolean] of PChar = ('', 'MMX'); + FDIVText: array[Boolean] of PChar = (' [FDIV Bug]', ''); +var + SL: TStringList; + I: Integer; + ModuleName: TFileName; + CpuInfo: TCpuInfo; + C: TWinControl; + NtHeaders: PImageNtHeaders; + ModuleBase: Cardinal; + ImageBaseStr: string; + StackList: TJclStackInfoList; +begin + SL := TStringList.Create; + try + // Stack list + if siStackList in SystemInfo then + begin + StackList := JclLastExceptStackList; + if Assigned(StackList) then + begin + DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)])); + StackList.AddToStrings(DetailsMemo.Lines, False, True, True); + NextDetailBlock; + end; + end; + // System and OS information + if siOsInfo in SystemInfo then + begin + DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString, + Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion])); + GetCpuInfo(CpuInfo); + with CpuInfo do + DetailsMemo.Lines.Add(Format(RsProcessor, [Manufacturer, CpuName, + RoundFrequency(FrequencyInfo.NormFreq), + MMXText[MMX], FDIVText[IsFDIVOK]])); + DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP])); + NextDetailBlock; + end; + // Modules list + if (siModuleList in SystemInfo) and LoadedModulesList(SL, GetCurrentProcessId) then + begin + DetailsMemo.Lines.Add(RsModulesList); + SL.CustomSort(SortModulesListByAddressCompare); + for I := 0 to SL.Count - 1 do + begin + ModuleName := SL[I]; + ModuleBase := Cardinal(SL.Objects[I]); + DetailsMemo.Lines.Add(Format('[%.8x] %s', [ModuleBase, ModuleName])); + NtHeaders := PeMapImgNtHeaders(Pointer(ModuleBase)); + if (NtHeaders <> nil) and (NtHeaders^.OptionalHeader.ImageBase <> ModuleBase) then + ImageBaseStr := Format('<%.8x> ', [NtHeaders^.OptionalHeader.ImageBase]) + else + ImageBaseStr := StrRepeat(' ', 11); + if VersionResourceAvailable(ModuleName) then + with TJclFileVersionInfo.Create(ModuleName) do + try + DetailsMemo.Lines.Add(ImageBaseStr + BinFileVersion + ' - ' + FileVersion); + if FileDescription <> '' then + DetailsMemo.Lines.Add(StrRepeat(' ', 11) + FileDescription); + finally + Free; + end + else + DetailsMemo.Lines.Add(ImageBaseStr + RsMissingVersionInfo); + end; + NextDetailBlock; + end; + // Active controls + if (siActiveControls in SystemInfo) and (FLastActiveControl <> nil) then + begin + DetailsMemo.Lines.Add(RsActiveControl); + C := FLastActiveControl; + while C <> nil do + begin + DetailsMemo.Lines.Add(Format('%s "%s"', [C.ClassName, C.Name])); + C := C.Parent; + end; + NextDetailBlock; + end; + finally + SL.Free; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.DetailsBtnClick(Sender: TObject); +begin + DetailsVisible := not DetailsVisible; +end; + +//-------------------------------------------------------------------------------------------------- + +class procedure TExceptionDialog.ExceptionHandler(Sender: TObject; E: Exception); +begin + if ExceptionShowing then + Application.ShowException(E) + else + begin + ExceptionShowing := True; + try + ShowException(E, nil); + finally + ExceptionShowing := False; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +class procedure TExceptionDialog.ExceptionThreadHandler(Thread: TJclDebugThread); +begin + if ExceptionShowing then + Application.ShowException(Thread.SyncException) + else + begin + ExceptionShowing := True; + try + ShowException(Thread.SyncException, Thread); + finally + ExceptionShowing := False; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormCreate(Sender: TObject); +begin + FSimpleLog := TSimpleExceptionLog.Create; + FFullHeight := ClientHeight; + DetailsVisible := False; + Caption := Format(RsAppError, [Application.Title]); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormDestroy(Sender: TObject); +begin + FreeAndNil(FSimpleLog); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Key = Ord('C')) and (ssCtrl in Shift) then + begin + CopyReportToClipboard; + MessageBeep(MB_OK); + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormPaint(Sender: TObject); +begin + DrawIcon(Canvas.Handle, TextLabel.Left - GetSystemMetrics(SM_CXICON) - 15, + TextLabel.Top, LoadIcon(0, IDI_ERROR)); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormResize(Sender: TObject); +begin + UpdateTextLabelScrollbars; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.FormShow(Sender: TObject); +begin + BeforeCreateDetails; + MessageBeep(MB_ICONERROR); + if FIsMainThead and (GetWindowThreadProcessId(Handle, nil) = MainThreadID) then + PostMessage(Handle, UM_CREATEDETAILS, 0, 0) + else + CreateDetails; +end; + +//-------------------------------------------------------------------------------------------------- + +function TExceptionDialog.GetReportAsText: string; +begin + Result := StrEnsureSuffix(AnsiCrLf, TextLabel.Text) + AnsiCrLf + DetailsMemo.Text; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.NextDetailBlock; +begin + DetailsMemo.Lines.Add(StrRepeat(ReportNewBlockDelimiterChar, ReportMaxColumns)); +end; + +//-------------------------------------------------------------------------------------------------- + +function TExceptionDialog.ReportMaxColumns: Integer; +begin + Result := 100; +end; + +//-------------------------------------------------------------------------------------------------- + +function TExceptionDialog.ReportNewBlockDelimiterChar: Char; +begin + Result := '-'; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.ReportToLog; +begin + if Tag and ReportToLogEnabled <> 0 then + begin + FSimpleLog.WriteStamp(ReportMaxColumns); + try + FSimpleLog.Write(ReportAsText); + finally + FSimpleLog.CloseLog; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.SetDetailsVisible(const Value: Boolean); +var + DetailsCaption: string; +begin + FDetailsVisible := Value; + DetailsCaption := Trim(StrRemoveChars(DetailsBtn.Caption, ['<', '>'])); + if Value then + begin + Constraints.MinHeight := FNonDetailsHeight + 100; + Constraints.MaxHeight := Screen.Height; + DetailsCaption := '<< ' + DetailsCaption; + ClientHeight := FFullHeight; + DetailsMemo.Height := FFullHeight - DetailsMemo.Top - 3; + end + else + begin + FFullHeight := ClientHeight; + DetailsCaption := DetailsCaption + ' >>'; + if FNonDetailsHeight = 0 then + begin + ClientHeight := Bevel1.Top; + FNonDetailsHeight := Height; + end + else + Height := FNonDetailsHeight; + Constraints.MinHeight := FNonDetailsHeight; + Constraints.MaxHeight := FNonDetailsHeight + end; + DetailsBtn.Caption := DetailsCaption; + DetailsMemo.Enabled := Value; +end; + +//-------------------------------------------------------------------------------------------------- + +class procedure TExceptionDialog.ShowException(E: Exception; Thread: TJclDebugThread); +begin + if ExceptionDialog = nil then + ExceptionDialog := ExceptionDialogClass.Create(Application); + try + with ExceptionDialog do + begin + FIsMainThead := (GetCurrentThreadId = MainThreadID); + FLastActiveControl := Screen.ActiveControl; + TextLabel.Text := AdjustLineBreaks(StrEnsureSuffix('.', E.Message)); + UpdateTextLabelScrollbars; + DetailsMemo.Lines.Add(Format(RsExceptionClass, [E.ClassName])); + if Thread = nil then + DetailsMemo.Lines.Add(Format(RsExceptionAddr, [ExceptAddr])) + else + DetailsMemo.Lines.Add(Format(RsThread, [Thread.ThreadInfo])); + NextDetailBlock; + ShowModal; + end; + finally + FreeAndNil(ExceptionDialog); + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.UMCreateDetails(var Message: TMessage); +begin + Update; + CreateDetails; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialog.UpdateTextLabelScrollbars; +begin + if Tag and DisableTextScrollbar = 0 then + begin + Canvas.Font := TextLabel.Font; + if TextLabel.Lines.Count * Canvas.TextHeight('Wg') > TextLabel.ClientHeight then + TextLabel.ScrollBars := ssVertical + else + TextLabel.ScrollBars := ssNone; + end; +end; + +//================================================================================================== +// Exception handler initialization code +//================================================================================================== + +procedure InitializeHandler; +begin + JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode]; + {$IFNDEF HOOK_DLL_EXCEPTIONS} + JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList]; + {$ENDIF HOOK_DLL_EXCEPTIONS} + JclDebugThreadList.OnSyncException := TExceptionDialog.ExceptionThreadHandler; + JclStartExceptionTracking; + {$IFDEF HOOK_DLL_EXCEPTIONS} + if HookTApplicationHandleException then + JclTrackExceptionsFromLibraries; + {$ENDIF HOOK_DLL_EXCEPTIONS} + Application.OnException := TExceptionDialog.ExceptionHandler; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure UnInitializeHandler; +begin + Application.OnException := nil; + JclDebugThreadList.OnSyncException := nil; + JclUnhookExceptions; + JclStopExceptionTracking; +end; + +//-------------------------------------------------------------------------------------------------- + +initialization + InitializeHandler; + +finalization + UnInitializeHandler; + +// History: + +// $Log: ExceptDlg.pas,v $ +// Revision 1.2 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/dialog/ExceptDlgMail.dfm b/official/1.96/experts/debug/dialog/ExceptDlgMail.dfm new file mode 100644 index 0000000..4a06eaa --- /dev/null +++ b/official/1.96/experts/debug/dialog/ExceptDlgMail.dfm @@ -0,0 +1,106 @@ +object ExceptionDialogMail: TExceptionDialogMail + Left = 310 + Top = 255 + AutoScroll = False + BorderIcons = [biSystemMenu] + Caption = 'ExceptionDialogMail' + ClientHeight = 255 + ClientWidth = 432 + Color = clBtnFace + Constraints.MinWidth = 200 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + KeyPreview = True + OldCreateOrder = False + Position = poScreenCenter + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnPaint = FormPaint + OnResize = FormResize + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 13 + object Bevel1: TBevel + Left = 3 + Top = 91 + Width = 422 + Height = 9 + Anchors = [akLeft, akTop, akRight] + Shape = bsTopLine + end + object SendBtn: TButton + Left = 351 + Top = 32 + Width = 75 + Height = 25 + Hint = 'Send bug report using default mail client' + Anchors = [akTop, akRight] + Caption = '&Send' + TabOrder = 0 + OnClick = SendBtnClick + end + object TextLabel: TMemo + Left = 56 + Top = 8 + Width = 281 + Height = 75 + Hint = 'Use Ctrl+C to copy the report to the clipboard' + Anchors = [akLeft, akTop, akRight] + BorderStyle = bsNone + Ctl3D = True + Lines.Strings = ( + 'TextLabel') + ParentColor = True + ParentCtl3D = False + ReadOnly = True + TabOrder = 1 + WantReturns = False + end + object OkBtn: TButton + Left = 352 + Top = 4 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = '&OK' + Default = True + ModalResult = 1 + TabOrder = 2 + end + object DetailsBtn: TButton + Left = 352 + Top = 60 + Width = 75 + Height = 25 + Hint = 'Show or hide additional information|' + Anchors = [akTop, akRight] + Caption = '&Details' + Enabled = False + TabOrder = 3 + OnClick = DetailsBtnClick + end + object DetailsMemo: TMemo + Left = 4 + Top = 101 + Width = 421 + Height = 147 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + ParentColor = True + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 4 + WantReturns = False + WordWrap = False + end +end diff --git a/official/1.96/experts/debug/dialog/ExceptDlgMail.ico b/official/1.96/experts/debug/dialog/ExceptDlgMail.ico new file mode 100644 index 0000000..f2ed1d3 Binary files /dev/null and b/official/1.96/experts/debug/dialog/ExceptDlgMail.ico differ diff --git a/official/1.96/experts/debug/dialog/ExceptDlgMail.pas b/official/1.96/experts/debug/dialog/ExceptDlgMail.pas new file mode 100644 index 0000000..91081ad --- /dev/null +++ b/official/1.96/experts/debug/dialog/ExceptDlgMail.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 ExceptDlg.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{**************************************************************************************************} +{ } +{ Sample Application exception dialog replacement with sending report by the default mail client } +{ functionality } +{ } +{ Last modified: $Date: 2005/10/26 03:29:44 $ } +{ } +{**************************************************************************************************} + +unit ExceptDlgMail; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls, JclMapi, JclDebug; + +const + UM_CREATEDETAILS = WM_USER + $100; + + ReportToLogEnabled = $00000001; // TExceptionDialog.Tag property + DisableTextScrollbar = $00000002; // TExceptionDialog.Tag property + +type + TSimpleExceptionLog = class (TObject) + private + FLogFileHandle: THandle; + FLogFileName: string; + FLogWasEmpty: Boolean; + function GetLogOpen: Boolean; + protected + function CreateDefaultFileName: string; + public + constructor Create(const ALogFileName: string = ''); + destructor Destroy; override; + procedure CloseLog; + procedure OpenLog; + procedure Write(const Text: string; Indent: Integer = 0); overload; + procedure Write(Strings: TStrings; Indent: Integer = 0); overload; + procedure WriteStamp(SeparatorLen: Integer = 0); + property LogFileName: string read FLogFileName; + property LogOpen: Boolean read GetLogOpen; + end; + + TExcDialogSystemInfo = (siStackList, siOsInfo, siModuleList, siActiveControls); + TExcDialogSystemInfos = set of TExcDialogSystemInfo; + + TExceptionDialogMail = class(TForm) + SendBtn: TButton; + TextLabel: TMemo; + OkBtn: TButton; + DetailsBtn: TButton; + Bevel1: TBevel; + DetailsMemo: TMemo; + procedure SendBtnClick(Sender: TObject); + procedure FormPaint(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure DetailsBtnClick(Sender: TObject); + procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormDestroy(Sender: TObject); + procedure FormResize(Sender: TObject); + private + private + FDetailsVisible: Boolean; + FIsMainThead: Boolean; + FLastActiveControl: TWinControl; + FNonDetailsHeight: Integer; + FFullHeight: Integer; + FSimpleLog: TSimpleExceptionLog; + procedure CreateDetails; + function GetReportAsText: string; + procedure ReportToLog; + procedure SetDetailsVisible(const Value: Boolean); + procedure UMCreateDetails(var Message: TMessage); message UM_CREATEDETAILS; + protected + procedure AfterCreateDetails; dynamic; + procedure BeforeCreateDetails; dynamic; + procedure CreateDetailInfo; dynamic; + procedure CreateReport(const SystemInfo: TExcDialogSystemInfos); + function ReportMaxColumns: Integer; virtual; + function ReportNewBlockDelimiterChar: Char; virtual; + procedure NextDetailBlock; + procedure UpdateTextLabelScrollbars; + public + procedure CopyReportToClipboard; + class procedure ExceptionHandler(Sender: TObject; E: Exception); + class procedure ExceptionThreadHandler(Thread: TJclDebugThread); + class procedure ShowException(E: Exception; Thread: TJclDebugThread); + property DetailsVisible: Boolean read FDetailsVisible write SetDetailsVisible; + property ReportAsText: string read GetReportAsText; + property SimpleLog: TSimpleExceptionLog read FSimpleLog; + end; + + TExceptionDialogMailClass = class of TExceptionDialogMail; + +var + ExceptionDialogMailClass: TExceptionDialogMailClass = TExceptionDialogMail; + +implementation + +{$R *.dfm} + +uses + ClipBrd, Math, + JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclSysUtils; + +resourcestring + RsAppError = '%s - application error'; + RsExceptionClass = 'Exception class: %s'; + RsExceptionAddr = 'Exception address: %p'; + RsStackList = 'Stack list, generated %s'; + RsModulesList = 'List of loaded modules:'; + RsOSVersion = 'System : %s %s, Version: %d.%d, Build: %x, "%s"'; + RsProcessor = 'Processor: %s, %s, %d MHz %s%s'; + RsScreenRes = 'Display : %dx%d pixels, %d bpp'; + RsActiveControl = 'Active Controls hierarchy:'; + RsThread = 'Thread: %s'; + RsMissingVersionInfo = '(no version info)'; + + RsSendBugReportAddress = 'bugreport@yourdomain.com'; + RsSendBugReportSubject = 'Bug Report'; + +var + ExceptionDialogMail: TExceptionDialogMail; + +//================================================================================================== +// Helper routines +//================================================================================================== + +function GetBPP: Integer; +var + DC: HDC; +begin + DC := GetDC(0); + Result := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES); + ReleaseDC(0, DC); +end; + +//-------------------------------------------------------------------------------------------------- + +function SortModulesListByAddressCompare(List: TStringList; Index1, Index2: Integer): Integer; +begin + Result := Integer(List.Objects[Index1]) - Integer(List.Objects[Index2]); +end; + +//================================================================================================== +// TApplication.HandleException method code hooking for exceptions from DLLs +//================================================================================================== + +// We need to catch the last line of TApplication.HandleException method: +// [...] +// end else +// SysUtils.ShowException(ExceptObject, ExceptAddr); +// end; + +procedure HookShowException(ExceptObject: TObject; ExceptAddr: Pointer); +begin + if JclValidateModuleAddress(ExceptAddr) and (ExceptObject.InstanceSize >= Exception.InstanceSize) then + TExceptionDialogMail.ExceptionHandler(nil, Exception(ExceptObject)) + else + SysUtils.ShowException(ExceptObject, ExceptAddr); +end; + +//-------------------------------------------------------------------------------------------------- + +function HookTApplicationHandleException: Boolean; +const + CallOffset = $86; + CallOffsetDebug = $94; +type + PCALLInstruction = ^TCALLInstruction; + TCALLInstruction = packed record + Call: Byte; + Address: Integer; + end; +var + TApplicationHandleExceptionAddr, SysUtilsShowExceptionAddr: Pointer; + CALLInstruction: TCALLInstruction; + CallAddress: Pointer; + NW: DWORD; + + function CheckAddressForOffset(Offset: Cardinal): Boolean; + begin + try + CallAddress := Pointer(Cardinal(TApplicationHandleExceptionAddr) + Offset); + CALLInstruction.Call := $E8; + Result := PCALLInstruction(CallAddress)^.Call = CALLInstruction.Call; + if Result then + begin + if IsCompiledWithPackages then + Result := PeMapImgResolvePackageThunk(Pointer(Integer(CallAddress) + Integer(PCALLInstruction(CallAddress)^.Address) + SizeOf(CALLInstruction))) = SysUtilsShowExceptionAddr + else + Result := PCALLInstruction(CallAddress)^.Address = Integer(SysUtilsShowExceptionAddr) - Integer(CallAddress) - SizeOf(CALLInstruction); + end; + except + Result := False; + end; + end; + +begin + TApplicationHandleExceptionAddr := PeMapImgResolvePackageThunk(@TApplication.HandleException); + SysUtilsShowExceptionAddr := PeMapImgResolvePackageThunk(@SysUtils.ShowException); + Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug); + if Result then + begin + CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction); + Result := WriteProcessMemory(GetCurrentProcess, CallAddress, @CALLInstruction, SizeOf(CALLInstruction), NW); + if Result then + FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction)); + end; +end; + +//================================================================================================== +// TSimpleExceptionLog +//================================================================================================== + +procedure TSimpleExceptionLog.CloseLog; +begin + if LogOpen then + begin + CloseHandle(FLogFileHandle); + FLogFileHandle := INVALID_HANDLE_VALUE; + FLogWasEmpty := False; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +constructor TSimpleExceptionLog.Create(const ALogFileName: string); +begin + if ALogFileName = '' then + FLogFileName := CreateDefaultFileName + else + FLogFileName := ALogFileName; + FLogFileHandle := INVALID_HANDLE_VALUE; +end; + +//-------------------------------------------------------------------------------------------------- + +function TSimpleExceptionLog.CreateDefaultFileName: string; +begin + Result := PathExtractFileDirFixed(ParamStr(0)) + PathExtractFileNameNoExt(ParamStr(0)) + '_Err.log'; +end; + +//-------------------------------------------------------------------------------------------------- + +destructor TSimpleExceptionLog.Destroy; +begin + CloseLog; + inherited; +end; + +//-------------------------------------------------------------------------------------------------- + +function TSimpleExceptionLog.GetLogOpen: Boolean; +begin + Result := FLogFileHandle <> INVALID_HANDLE_VALUE; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.OpenLog; +begin + if not LogOpen then + begin + FLogFileHandle := CreateFile(PChar(FLogFileName), GENERIC_WRITE, FILE_SHARE_READ, nil, + OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + if LogOpen then + FLogWasEmpty := SetFilePointer(FLogFileHandle, 0, nil, FILE_END) = 0; + end + else + FLogWasEmpty := False; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.Write(const Text: string; Indent: Integer); +var + S: string; + SL: TStringList; + I: Integer; +begin + if LogOpen then + begin + SL := TStringList.Create; + try + SL.Text := Text; + for I := 0 to SL.Count - 1 do + begin + S := StringOfChar(' ', Indent) + StrEnsureSuffix(AnsiCrLf, TrimRight(SL[I])); + FileWrite(Integer(FLogFileHandle), Pointer(S)^, Length(S)); + end; + finally + SL.Free; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.Write(Strings: TStrings; Indent: Integer); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Write(Strings[I], Indent); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TSimpleExceptionLog.WriteStamp(SeparatorLen: Integer); +begin + if SeparatorLen = 0 then + SeparatorLen := 100; + SeparatorLen := Max(SeparatorLen, 20); + OpenLog; + if not FLogWasEmpty then + Write(AnsiCrLf); + Write(StrRepeat('=', SeparatorLen)); + Write(Format('= %-*s =', [SeparatorLen - 4, DateTimeToStr(Now)])); + Write(StrRepeat('=', SeparatorLen)); +end; + +//================================================================================================== +// Exception dialog with Send +//================================================================================================== + +var + ExceptionShowing: Boolean; + +{ TExceptionDialogMail } + +procedure TExceptionDialogMail.AfterCreateDetails; +begin + SendBtn.Enabled := True; +end; + +procedure TExceptionDialogMail.BeforeCreateDetails; +begin + SendBtn.Enabled := False; +end; + +function TExceptionDialogMail.ReportMaxColumns: Integer; +begin + Result := 78; +end; + +procedure TExceptionDialogMail.SendBtnClick(Sender: TObject); +begin + with TJclEmail.Create do + try + ParentWnd := Application.Handle; + Recipients.Add(RsSendBugReportAddress); + Subject := RsSendBugReportSubject; + Body := ReportAsText; + SaveTaskWindows; + try + Send(True); + finally + RestoreTaskWindows; + end; + finally + Free; + end; +end; + +procedure TExceptionDialogMail.CopyReportToClipboard; +begin + ClipBoard.AsText := ReportAsText; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.CreateDetailInfo; +begin + CreateReport([siStackList, siOsInfo, siModuleList, siActiveControls]); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.CreateDetails; +begin + Screen.Cursor := crHourGlass; + DetailsMemo.Lines.BeginUpdate; + try + CreateDetailInfo; + ReportToLog; + DetailsMemo.SelStart := 0; + SendMessage(DetailsMemo.Handle, EM_SCROLLCARET, 0, 0); + AfterCreateDetails; + finally + DetailsMemo.Lines.EndUpdate; + OkBtn.Enabled := True; + DetailsBtn.Enabled := True; + OkBtn.SetFocus; + Screen.Cursor := crDefault; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.CreateReport(const SystemInfo: TExcDialogSystemInfos); +const + MMXText: array[Boolean] of PChar = ('', 'MMX'); + FDIVText: array[Boolean] of PChar = (' [FDIV Bug]', ''); +var + SL: TStringList; + I: Integer; + ModuleName: TFileName; + CpuInfo: TCpuInfo; + C: TWinControl; + NtHeaders: PImageNtHeaders; + ModuleBase: Cardinal; + ImageBaseStr: string; + StackList: TJclStackInfoList; +begin + SL := TStringList.Create; + try + // Stack list + if siStackList in SystemInfo then + begin + StackList := JclLastExceptStackList; + if Assigned(StackList) then + begin + DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)])); + StackList.AddToStrings(DetailsMemo.Lines, False, True, True); + NextDetailBlock; + end; + end; + // System and OS information + if siOsInfo in SystemInfo then + begin + DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString, + Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion])); + GetCpuInfo(CpuInfo); + with CpuInfo do + DetailsMemo.Lines.Add(Format(RsProcessor, [Manufacturer, CpuName, + RoundFrequency(FrequencyInfo.NormFreq), + MMXText[MMX], FDIVText[IsFDIVOK]])); + DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP])); + NextDetailBlock; + end; + // Modules list + if (siModuleList in SystemInfo) and LoadedModulesList(SL, GetCurrentProcessId) then + begin + DetailsMemo.Lines.Add(RsModulesList); + SL.CustomSort(SortModulesListByAddressCompare); + for I := 0 to SL.Count - 1 do + begin + ModuleName := SL[I]; + ModuleBase := Cardinal(SL.Objects[I]); + DetailsMemo.Lines.Add(Format('[%.8x] %s', [ModuleBase, ModuleName])); + NtHeaders := PeMapImgNtHeaders(Pointer(ModuleBase)); + if (NtHeaders <> nil) and (NtHeaders^.OptionalHeader.ImageBase <> ModuleBase) then + ImageBaseStr := Format('<%.8x> ', [NtHeaders^.OptionalHeader.ImageBase]) + else + ImageBaseStr := StrRepeat(' ', 11); + if VersionResourceAvailable(ModuleName) then + with TJclFileVersionInfo.Create(ModuleName) do + try + DetailsMemo.Lines.Add(ImageBaseStr + BinFileVersion + ' - ' + FileVersion); + if FileDescription <> '' then + DetailsMemo.Lines.Add(StrRepeat(' ', 11) + FileDescription); + finally + Free; + end + else + DetailsMemo.Lines.Add(ImageBaseStr + RsMissingVersionInfo); + end; + NextDetailBlock; + end; + // Active controls + if (siActiveControls in SystemInfo) and (FLastActiveControl <> nil) then + begin + DetailsMemo.Lines.Add(RsActiveControl); + C := FLastActiveControl; + while C <> nil do + begin + DetailsMemo.Lines.Add(Format('%s "%s"', [C.ClassName, C.Name])); + C := C.Parent; + end; + NextDetailBlock; + end; + finally + SL.Free; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.DetailsBtnClick(Sender: TObject); +begin + DetailsVisible := not DetailsVisible; +end; + +//-------------------------------------------------------------------------------------------------- + +class procedure TExceptionDialogMail.ExceptionHandler(Sender: TObject; E: Exception); +begin + if ExceptionShowing then + Application.ShowException(E) + else + begin + ExceptionShowing := True; + try + ShowException(E, nil); + finally + ExceptionShowing := False; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +class procedure TExceptionDialogMail.ExceptionThreadHandler(Thread: TJclDebugThread); +begin + if ExceptionShowing then + Application.ShowException(Thread.SyncException) + else + begin + ExceptionShowing := True; + try + ShowException(Thread.SyncException, Thread); + finally + ExceptionShowing := False; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.FormCreate(Sender: TObject); +begin + FSimpleLog := TSimpleExceptionLog.Create; + FFullHeight := ClientHeight; + DetailsVisible := False; + Caption := Format(RsAppError, [Application.Title]); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.FormDestroy(Sender: TObject); +begin + FreeAndNil(FSimpleLog); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Key = Ord('C')) and (ssCtrl in Shift) then + begin + CopyReportToClipboard; + MessageBeep(MB_OK); + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.FormPaint(Sender: TObject); +begin + DrawIcon(Canvas.Handle, TextLabel.Left - GetSystemMetrics(SM_CXICON) - 15, + TextLabel.Top, LoadIcon(0, IDI_ERROR)); +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.FormResize(Sender: TObject); +begin + UpdateTextLabelScrollbars; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.FormShow(Sender: TObject); +begin + BeforeCreateDetails; + MessageBeep(MB_ICONERROR); + if FIsMainThead and (GetWindowThreadProcessId(Handle, nil) = MainThreadID) then + PostMessage(Handle, UM_CREATEDETAILS, 0, 0) + else + CreateDetails; +end; + +//-------------------------------------------------------------------------------------------------- + +function TExceptionDialogMail.GetReportAsText: string; +begin + Result := StrEnsureSuffix(AnsiCrLf, TextLabel.Text) + AnsiCrLf + DetailsMemo.Text; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.NextDetailBlock; +begin + DetailsMemo.Lines.Add(StrRepeat(ReportNewBlockDelimiterChar, ReportMaxColumns)); +end; + +//-------------------------------------------------------------------------------------------------- + +function TExceptionDialogMail.ReportNewBlockDelimiterChar: Char; +begin + Result := '-'; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.ReportToLog; +begin + if Tag and ReportToLogEnabled <> 0 then + begin + FSimpleLog.WriteStamp(ReportMaxColumns); + try + FSimpleLog.Write(ReportAsText); + finally + FSimpleLog.CloseLog; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.SetDetailsVisible(const Value: Boolean); +var + DetailsCaption: string; +begin + FDetailsVisible := Value; + DetailsCaption := Trim(StrRemoveChars(DetailsBtn.Caption, ['<', '>'])); + if Value then + begin + Constraints.MinHeight := FNonDetailsHeight + 100; + Constraints.MaxHeight := Screen.Height; + DetailsCaption := '<< ' + DetailsCaption; + ClientHeight := FFullHeight; + DetailsMemo.Height := FFullHeight - DetailsMemo.Top - 3; + end + else + begin + FFullHeight := ClientHeight; + DetailsCaption := DetailsCaption + ' >>'; + if FNonDetailsHeight = 0 then + begin + ClientHeight := Bevel1.Top; + FNonDetailsHeight := Height; + end + else + Height := FNonDetailsHeight; + Constraints.MinHeight := FNonDetailsHeight; + Constraints.MaxHeight := FNonDetailsHeight + end; + DetailsBtn.Caption := DetailsCaption; + DetailsMemo.Enabled := Value; +end; + +//-------------------------------------------------------------------------------------------------- + +class procedure TExceptionDialogMail.ShowException(E: Exception; Thread: TJclDebugThread); +begin + if ExceptionDialogMail = nil then + ExceptionDialogMail := TExceptionDialogMailClass.Create(Application); + try + with ExceptionDialogMail do + begin + FIsMainThead := (GetCurrentThreadId = MainThreadID); + FLastActiveControl := Screen.ActiveControl; + TextLabel.Text := AdjustLineBreaks(StrEnsureSuffix('.', E.Message)); + UpdateTextLabelScrollbars; + DetailsMemo.Lines.Add(Format(RsExceptionClass, [E.ClassName])); + if Thread = nil then + DetailsMemo.Lines.Add(Format(RsExceptionAddr, [ExceptAddr])) + else + DetailsMemo.Lines.Add(Format(RsThread, [Thread.ThreadInfo])); + NextDetailBlock; + ShowModal; + end; + finally + FreeAndNil(ExceptionDialogMail); + end; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.UMCreateDetails(var Message: TMessage); +begin + Update; + CreateDetails; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure TExceptionDialogMail.UpdateTextLabelScrollbars; +begin + if Tag and DisableTextScrollbar = 0 then + begin + Canvas.Font := TextLabel.Font; + if TextLabel.Lines.Count * Canvas.TextHeight('Wg') > TextLabel.ClientHeight then + TextLabel.ScrollBars := ssVertical + else + TextLabel.ScrollBars := ssNone; + end; +end; + +//================================================================================================== +// Exception handler initialization code +//================================================================================================== + +procedure InitializeHandler; +begin + JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode]; + {$IFNDEF HOOK_DLL_EXCEPTIONS} + JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList]; + {$ENDIF HOOK_DLL_EXCEPTIONS} + JclDebugThreadList.OnSyncException := TExceptionDialogMail.ExceptionThreadHandler; + JclStartExceptionTracking; + {$IFDEF HOOK_DLL_EXCEPTIONS} + if HookTApplicationHandleException then + JclTrackExceptionsFromLibraries; + {$ENDIF HOOK_DLL_EXCEPTIONS} + Application.OnException := TExceptionDialogMail.ExceptionHandler; +end; + +//-------------------------------------------------------------------------------------------------- + +procedure UnInitializeHandler; +begin + Application.OnException := nil; + JclDebugThreadList.OnSyncException := nil; + JclUnhookExceptions; + JclStopExceptionTracking; +end; + +//-------------------------------------------------------------------------------------------------- + +initialization + InitializeHandler; + +finalization + UnInitializeHandler; + +// History: + +// $Log: ExceptDlgMail.pas,v $ +// Revision 1.2 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/simdview/JclSIMDCpuInfo.dfm b/official/1.96/experts/debug/simdview/JclSIMDCpuInfo.dfm new file mode 100644 index 0000000..3e5ad15 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDCpuInfo.dfm @@ -0,0 +1,158 @@ +object JclFormCpuInfo: TJclFormCpuInfo + Left = 468 + Top = 438 + BorderStyle = bsDialog + Caption = 'Local CPU Informations' + ClientHeight = 208 + ClientWidth = 322 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Shell Dlg 2' + Font.Style = [] + OldCreateOrder = False + Position = poDesktopCenter + PixelsPerInch = 96 + TextHeight = 13 + object LabelName: TLabel + Left = 8 + Top = 8 + Width = 34 + Height = 13 + Caption = 'Name :' + end + object LabelVendor: TLabel + Left = 8 + Top = 40 + Width = 41 + Height = 13 + Caption = 'Vendor :' + end + object LabelFrequency: TLabel + Left = 160 + Top = 40 + Width = 58 + Height = 13 + Caption = 'Frequency :' + end + object EditName: TEdit + Left = 64 + Top = 8 + Width = 249 + Height = 21 + Enabled = False + ParentColor = True + TabOrder = 0 + Text = 'EditName' + end + object EditVendor: TEdit + Left = 64 + Top = 40 + Width = 81 + Height = 21 + Enabled = False + ParentColor = True + TabOrder = 1 + Text = 'EditVendor' + end + object EditFrequency: TEdit + Left = 232 + Top = 40 + Width = 81 + Height = 21 + Enabled = False + ParentColor = True + TabOrder = 2 + Text = 'EditFrequency' + end + object CheckBoxMMX: TCheckBox + Left = 8 + Top = 72 + Width = 137 + Height = 17 + Alignment = taLeftJustify + Caption = 'MMX' + Enabled = False + TabOrder = 3 + end + object CheckBoxExMMX: TCheckBox + Left = 8 + Top = 96 + Width = 137 + Height = 17 + Alignment = taLeftJustify + Caption = 'MMX Extensions' + Enabled = False + TabOrder = 4 + end + object CheckBox3DNow: TCheckBox + Left = 8 + Top = 120 + Width = 137 + Height = 17 + Alignment = taLeftJustify + Caption = '3DNow!' + Enabled = False + TabOrder = 5 + end + object CheckBoxEx3DNow: TCheckBox + Left = 8 + Top = 144 + Width = 137 + Height = 17 + Alignment = taLeftJustify + Caption = '3DNow! Extensions' + Enabled = False + TabOrder = 6 + end + object CheckBox64Bits: TCheckBox + Left = 160 + Top = 144 + Width = 153 + Height = 17 + Alignment = taLeftJustify + Caption = '64 bits' + Enabled = False + TabOrder = 7 + end + object CheckBoxSSE1: TCheckBox + Left = 160 + Top = 72 + Width = 153 + Height = 17 + Alignment = taLeftJustify + Caption = 'SSE Version 1' + Enabled = False + TabOrder = 8 + end + object CheckBoxSSE2: TCheckBox + Left = 160 + Top = 96 + Width = 153 + Height = 17 + Alignment = taLeftJustify + Caption = 'SSE Version 2' + Enabled = False + TabOrder = 9 + end + object CheckBoxSSE3: TCheckBox + Left = 160 + Top = 120 + Width = 153 + Height = 17 + Alignment = taLeftJustify + Caption = 'SSE Version 3' + Enabled = False + TabOrder = 10 + end + object ButtonClose: TButton + Left = 128 + Top = 176 + Width = 83 + Height = 25 + Caption = 'Close' + ModalResult = 2 + TabOrder = 11 + end +end diff --git a/official/1.96/experts/debug/simdview/JclSIMDCpuInfo.pas b/official/1.96/experts/debug/simdview/JclSIMDCpuInfo.pas new file mode 100644 index 0000000..12072d9 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDCpuInfo.pas @@ -0,0 +1,109 @@ +{**************************************************************************************************} +{ } +{ 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: JvSIMDCPUInfo.pas, released on 2005-05-09. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ [ouchet dott florent att laposte dott net] } +{ Portions created by Florent Ouchet are Copyright (C) 2004 Florent Ouchet. } +{ All Rights Reserved. } +{ } +{ You may retrieve the latest version of this file at the Project JEDI's JCL home page, } +{ located at http://jcl.sourceforge.net } +{ } +{**************************************************************************************************} + +// $Id: JclSIMDCpuInfo.pas,v 1.5 2005/12/16 23:46:25 outchy Exp $ + +unit JclSIMDCpuInfo; + +interface + +{$I jcl.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, + JclSysInfo; + +type + TJclFormCpuInfo = class(TForm) + LabelName: TLabel; + EditName: TEdit; + LabelVendor: TLabel; + EditVendor: TEdit; + LabelFrequency: TLabel; + EditFrequency: TEdit; + CheckBoxMMX: TCheckBox; + CheckBoxExMMX: TCheckBox; + CheckBox3DNow: TCheckBox; + CheckBoxEx3DNow: TCheckBox; + CheckBox64Bits: TCheckBox; + CheckBoxSSE1: TCheckBox; + CheckBoxSSE2: TCheckBox; + CheckBoxSSE3: TCheckBox; + ButtonClose: TButton; + protected + procedure CreateParams(var Params: TCreateParams); override; + public + procedure Execute(const CpuInfo: TCPUInfo); + end; + +implementation + +{$R *.dfm} + +//=== { TJclFormCpuInfo } ==================================================== + +procedure TJclFormCpuInfo.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + + // Fixing the Window Ghosting "bug" + Params.Style := params.Style or WS_POPUP; + if Assigned(Screen.ActiveForm) then + Params.WndParent := Screen.ActiveForm.Handle + else if Assigned (Application.MainForm) then + Params.WndParent := Application.MainForm.Handle + else + Params.WndParent := Application.Handle; +end; + +procedure TJclFormCpuInfo.Execute(const CpuInfo: TCPUInfo); +begin + EditName.Text := CpuInfo.CpuName; + EditVendor.Text := CpuInfo.VendorIDString; + EditFrequency.Text := IntToStr(CpuInfo.FrequencyInfo.NormFreq); + CheckBoxMMX.Checked := CpuInfo.MMX; + CheckBoxExMMX.Checked := CpuInfo.ExMMX; + CheckBox3DNow.Checked := CpuInfo._3DNow; + CheckBoxEx3DNow.Checked := CpuInfo.Ex3DNow; + CheckBox64Bits.Checked := CpuInfo.Is64Bits; + CheckBoxSSE1.Checked := CpuInfo.SSE >= 1; + CheckBoxSSE2.Checked := CpuInfo.SSE >= 2; + CheckBoxSSE3.Checked := CpuInfo.SSE >= 3; + ShowModal; +end; + +// History: + +// $Log: JclSIMDCpuInfo.pas,v $ +// Revision 1.5 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.4 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/simdview/JclSIMDIcon.dcr b/official/1.96/experts/debug/simdview/JclSIMDIcon.dcr new file mode 100644 index 0000000..e3afa55 Binary files /dev/null and b/official/1.96/experts/debug/simdview/JclSIMDIcon.dcr differ diff --git a/official/1.96/experts/debug/simdview/JclSIMDModifyForm.dfm b/official/1.96/experts/debug/simdview/JclSIMDModifyForm.dfm new file mode 100644 index 0000000..ba36d13 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDModifyForm.dfm @@ -0,0 +1,115 @@ +object JclSIMDModifyFrm: TJclSIMDModifyFrm + Left = 806 + Top = 175 + BorderStyle = bsDialog + Caption = 'JclSIMDModifyFrm' + ClientHeight = 417 + ClientWidth = 481 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poDesktopCenter + PixelsPerInch = 96 + TextHeight = 13 + object LabelDisplay: TLabel + Left = 8 + Top = 16 + Width = 40 + Height = 13 + Caption = 'Display :' + Layout = tlCenter + end + object LabelFormat: TLabel + Left = 240 + Top = 16 + Width = 38 + Height = 13 + Caption = 'Format :' + Layout = tlCenter + end + object LabelBlank: TLabel + Left = 8 + Top = 48 + Width = 123 + Height = 13 + Caption = 'Keep blank for no change' + end + object ComboBoxDisplay: TComboBox + Left = 56 + Top = 16 + Width = 137 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + TabOrder = 0 + OnChange = ComboBoxDisplayChange + Items.Strings = ( + 'Bytes' + 'Words' + 'DWords' + 'QWords' + 'Singles' + 'Doubles') + end + object ComboBoxFormat: TComboBox + Left = 288 + Top = 16 + Width = 145 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + TabOrder = 1 + OnChange = ComboBoxFormatChange + Items.Strings = ( + 'Binary' + 'Signed Decimal' + 'Unsigned Decimal' + 'Hexadecimal') + end + object PanelModify: TPanel + Left = 8 + Top = 72 + Width = 465 + Height = 265 + BevelInner = bvLowered + TabOrder = 2 + end + object ButtonOK: TButton + Left = 336 + Top = 384 + Width = 139 + Height = 25 + Caption = '&OK' + Default = True + TabOrder = 3 + OnClick = ButtonOKClick + end + object ButtonCancel: TButton + Left = 336 + Top = 352 + Width = 139 + Height = 25 + Cancel = True + Caption = '&Cancel' + ModalResult = 2 + TabOrder = 4 + end + object MemoTip: TMemo + Left = 8 + Top = 352 + Width = 313 + Height = 57 + BorderStyle = bsNone + Lines.Strings = ( + 'Tip: xmm0.byte0 will return the first byte of xmm0' + 'Valid registers are: xmm0..xmm7 (32-bit processor) or ' + 'xmm0..xmm15 (64-bit processor)' + 'Valid fields are byteX, wordX, dwordX, qwordX, singleX, doubleX') + ParentColor = True + TabOrder = 5 + end +end diff --git a/official/1.96/experts/debug/simdview/JclSIMDModifyForm.pas b/official/1.96/experts/debug/simdview/JclSIMDModifyForm.pas new file mode 100644 index 0000000..4609ab1 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDModifyForm.pas @@ -0,0 +1,565 @@ +{**************************************************************************************************} +{ } +{ 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: JvSIMDModifyForm.pas, released on 2004-10-11. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ [ouchet dott florent att laposte dott net] } +{ Portions created by Florent Ouchet are Copyright (C) 2004 Florent Ouchet. } +{ All Rights Reserved. } +{ } +{ You may retrieve the latest version of this file at the Project JEDI's JCL home page, } +{ located at http://jcl.sourceforge.net } +{ } +{**************************************************************************************************} + +// $Id: JclSIMDModifyForm.pas,v 1.9 2006/01/08 17:16:56 outchy Exp $ + +unit JclSIMDModifyForm; + +interface + +{$I jcl.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls, ToolsApi, Contnrs, + JclOtaUtils, JclSysInfo, JclSIMDUtils; + +const + WM_MODIFYCONTINUE = WM_USER + 100; + +type + TJclRegisterType = (rtXMM, rtMM); + + TJclSIMDModifyFrm = class(TForm) + ComboBoxDisplay: TComboBox; + ComboBoxFormat: TComboBox; + LabelDisplay: TLabel; + LabelFormat: TLabel; + LabelBlank: TLabel; + PanelModify: TPanel; + ButtonOK: TButton; + ButtonCancel: TButton; + MemoTip: TMemo; + procedure ComboBoxDisplayChange(Sender: TObject); + procedure ComboBoxFormatChange(Sender: TObject); + procedure ButtonOKClick(Sender: TObject); + private + FRegisterType: TJclRegisterType; + FXMMRegister: TJclXMMRegister; + FMMRegister: TJclMMRegister; + FDisplay: TJclXMMContentType; + FFormat: TJclSIMDFormat; + FDebuggerServices: IOTADebuggerServices; + FComboBoxList: TComponentList; + FLabelList: TComponentList; + FHistory: TStringList; + FThread: IOTAThread; + FTextIndex: Integer; + FExprStr: string; + FResultStr: string; + FReturnCode: Cardinal; + FCPUInfo: TCpuInfo; + FSettings: TJclOTASettings; + procedure ContinueModify; + procedure StartModify; + procedure WMModifyContinue(var Msg: TMessage); message WM_MODIFYCONTINUE; + protected + procedure CreateParams(var Params: TCreateParams); override; + property RegisterType: TJclRegisterType read FRegisterType; + property XMMRegister: TJclXMMRegister read FXMMRegister; + property MMRegister: TJclMMRegister read FMMRegister; + property DebuggerServices: IOTADebuggerServices read FDebuggerServices; + public + constructor Create(AOwner: TComponent; + ADebuggerServices: IOTADebuggerServices; ASettings: TJclOTASettings); reintroduce; + destructor Destroy; override; + function Execute(AThread: IOTAThread; ADisplay: TJclXMMContentType; + AFormat: TJclSIMDFormat; var ARegister: TJclXMMRegister; + const ACpuInfo: TCpuInfo): Boolean; overload; + function Execute(AThread: IOTAThread; ADisplay: TJclXMMContentType; + AFormat: TJclSIMDFormat; var ARegister: TJclMMRegister; + const ACpuInfo: TCpuInfo): Boolean; overload; + procedure ThreadEvaluate(const ExprStr, ResultStr: string; ReturnCode: Integer); + procedure UpdateDisplay; + procedure UpdateFormat; + procedure LoadHistory; + procedure SaveHistory; + procedure MergeHistory; + + property Display: TJclXMMContentType read FDisplay; + property Format: TJclSIMDFormat read FFormat; + property History: TStringList read FHistory; + property Thread: IOTAThread read FThread; + property Settings: TJclOTASettings read FSettings; + end; + +implementation + +{$R *.dfm} + +const + NbEdits: array [TJclRegisterType, TJclXMMContentType] of Byte = + ( + (16, 8, 4, 2, 4, 2), + ( 8, 4, 2, 1, 2, 1) + ); + + Texts: array [TJclXMMContentType] of string = + ('Byte', 'Word', 'DWord', 'QWord', 'Single', 'Double'); + + ItemFormat = 'Item%d'; + CountPropertyName = 'Count'; + + HistoryListSize = 30; + +//=== { TJclSIMDModifyFrm } ================================================== + +constructor TJclSIMDModifyFrm.Create(AOwner: TComponent; + ADebuggerServices: IOTADebuggerServices; ASettings: TJclOTASettings); +begin + inherited Create(AOwner); + + FDebuggerServices := ADebuggerServices; + FSettings := ASettings; + + FComboBoxList := TComponentList.Create(False); + FLabelList := TComponentList.Create(False); + FHistory := TStringList.Create; + FHistory.Duplicates := dupIgnore; +end; + +procedure TJclSIMDModifyFrm.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + + // Fixing the Window Ghosting "bug" + Params.Style := params.Style or WS_POPUP; + if Assigned(Screen.ActiveForm) then + Params.WndParent := Screen.ActiveForm.Handle + else if Assigned (Application.MainForm) then + Params.WndParent := Application.MainForm.Handle + else + Params.WndParent := Application.Handle; +end; + +destructor TJclSIMDModifyFrm.Destroy; +begin + FLabelList.Free; + FComboBoxList.Free; + FHistory.Free; + FDebuggerServices := nil; + + inherited Destroy; +end; + +function TJclSIMDModifyFrm.Execute(AThread: IOTAThread; ADisplay: TJclXMMContentType; + AFormat: TJclSIMDFormat; var ARegister: TJclXMMRegister; + const ACPUInfo: TCPUInfo): Boolean; +begin + FTextIndex := 0; + FRegisterType := rtXMM; + FXMMRegister := ARegister; + FFormat := AFormat; + FDisplay := ADisplay; + FThread := AThread; + FCpuInfo := ACpuInfo; + + LoadHistory; + + ComboBoxDisplay.ItemIndex := Integer(Display); + ComboBoxFormat.Enabled := Display in [xt16Bytes..xt2QWords]; + ComboBoxFormat.ItemIndex := Integer(Format); + UpdateDisplay; + + Result := ShowModal = mrOk; + + if Result then + ARegister := XMMRegister; + + MergeHistory; + SaveHistory; +end; + +function TJclSIMDModifyFrm.Execute(AThread: IOTAThread; + ADisplay: TJclXMMContentType; AFormat: TJclSIMDFormat; + var ARegister: TJclMMRegister; const ACpuInfo: TCpuInfo): Boolean; +begin + FTextIndex := 0; + FRegisterType := rtMM; + FMMRegister := ARegister; + FFormat := AFormat; + FDisplay := ADisplay; + FThread := AThread; + FCpuInfo := ACpuInfo; + + LoadHistory; + + ComboBoxDisplay.ItemIndex := Integer(Display); + ComboBoxFormat.Enabled := Display in [xt16Bytes..xt2QWords]; + ComboBoxFormat.ItemIndex := Integer(Format); + UpdateDisplay; + + Result := ShowModal = mrOk; + + if Result then + ARegister := MMRegister; + + MergeHistory; + SaveHistory; +end; + +procedure TJclSIMDModifyFrm.UpdateDisplay; +var + Index: Integer; + AComboBox: TComboBox; + ALabel: TLabel; + X, Y: Integer; +begin + MergeHistory; + while PanelModify.ControlCount > 0 do + PanelModify.Controls[0].Free; + FComboBoxList.Clear; + FLabelList.Clear; + + ComboBoxDisplay.ItemIndex := Integer(Display); + ComboBoxFormat.Enabled := Display in [xt16Bytes..xt2QWords]; + ComboBoxFormat.ItemIndex := Integer(Format); + + X := 0; + Y := 12; + for Index := 0 to NbEdits[RegisterType, Display] - 1 do + begin + AComboBox := TComboBox.Create(Self); + AComboBox.Parent := PanelModify; + AComboBox.SetBounds(X + 130, Y, 90, AComboBox.Height); + AComboBox.Tag := Index; + AComboBox.Text := ''; + AComboBox.Items.Assign(History); + FComboBoxList.Add(AComboBox); + ALabel := TLabel.Create(Self); + ALabel.Parent := PanelModify; + ALabel.SetBounds(X + 5, Y + 2, 60, ALabel.Height); + ALabel.Tag := Index; + FLabelList.Add(ALabel); + if Index = 7 then + begin + Y := 12; + X := 230; + end + else + Inc(Y, 32); + end; + UpdateFormat; +end; + +procedure TJclSIMDModifyFrm.UpdateFormat; +var + Index: Integer; + Value: TJclSIMDValue; + ALabel: TLabel; +begin + Value.Display := Display; + for Index := 0 to FLabelList.Count - 1 do + begin + ALabel := FLabelList.Items[Index] as TLabel; + case RegisterType of + rtXMM: + case Display of + xt16Bytes: + Value.ValueByte := XMMRegister.Bytes[ALabel.Tag]; + xt8Words: + Value.ValueWord := XMMRegister.Words[ALabel.Tag]; + xt4DWords: + Value.ValueDWord := XMMRegister.DWords[ALabel.Tag]; + xt2QWords: + Value.ValueQWord := XMMRegister.QWords[ALabel.Tag]; + xt4Singles: + Value.ValueSingle := XMMRegister.Singles[ALabel.Tag]; + xt2Doubles: + Value.ValueDouble := XMMRegister.Doubles[ALabel.Tag]; + end; + rtMM: + case Display of + xt16Bytes: + Value.ValueByte := MMRegister.Bytes[ALabel.Tag]; + xt8Words: + Value.ValueWord := MMRegister.Words[ALabel.Tag]; + xt4DWords: + Value.ValueDWord := MMRegister.DWords[ALabel.Tag]; + xt2QWords: + Value.ValueQWord := MMRegister.QWords; + xt4Singles: + Value.ValueSingle := MMRegister.Singles[ALabel.Tag]; + xt2Doubles: + begin + ALabel.Caption := ''; + Break; + end; + end; + end; + ALabel.Caption := SysUtils.Format('%s%d = %s', [Texts[Display], Index, FormatValue(Value, Format)]); + end; +end; + +procedure TJclSIMDModifyFrm.ComboBoxDisplayChange(Sender: TObject); +begin + try + FDisplay := TJclXMMContentType((Sender as TComboBox).ItemIndex); + UpdateDisplay; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDModifyFrm.ComboBoxFormatChange(Sender: TObject); +begin + try + FFormat := TJclSIMDFormat((Sender as TComboBox).ItemIndex); + UpdateFormat; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDModifyFrm.LoadHistory; +var + Index, Count: Integer; +begin + Count := Settings.LoadInteger(CountPropertyName, 0); + History.Clear; + + for Index := 0 to Count - 1 do + History.Add(Settings.LoadString(SysUtils.Format(ItemFormat, [Index]), '')); +end; + +procedure TJclSIMDModifyFrm.SaveHistory; +var + Index: Integer; +begin + Settings.SaveInteger(CountPropertyName, History.Count); + for Index := 0 to History.Count - 1 do + Settings.SaveString(SysUtils.Format(ItemFormat, [Index]), History.Strings[Index]); +end; + +procedure TJclSIMDModifyFrm.MergeHistory; +var + I, J: Integer; +begin + History.Duplicates := dupIgnore; + for I := 0 to PanelModify.ControlCount - 1 do + if PanelModify.Controls[I] is TComboBox then + with TComboBox(PanelModify.Controls[I]) do + begin + for J := 0 to Items.Count - 1 do + if (Items.Strings[J] <> '') and (History.IndexOf(Items.Strings[J]) = -1) then + History.Add(Items.Strings[J]); + if (Text <> '') and (History.IndexOf(Text) = -1) then + History.Add(Text); + end; + while History.Count > HistoryListSize do + History.Delete(0); +end; + +procedure TJclSIMDModifyFrm.WMModifyContinue(var Msg: TMessage); +begin + try + ContinueModify; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + //raise; no exception throw message handler + end; + end; +end; + +procedure TJclSIMDModifyFrm.StartModify; +begin + FTextIndex := -1; + FResultStr := ''; + FReturnCode := 0; + ContinueModify; +end; + +procedure TJclSIMDModifyFrm.ContinueModify; +const + ResultBufferSize = 200; +var + EvaluateResult: TOTAEvaluateResult; + AValue: TJclSIMDValue; + AComboBox: TComboBox; + ResultBuffer: array [0..ResultBufferSize-1] of Char; + ResultAddr, ResultSize: Cardinal; + CanModify: Boolean; + VectorFrame: TJclVectorFrame; +begin + if (FReturnCode <> 0) then + EvaluateResult := erError + else + EvaluateResult := erOK; + AValue.Display := Display; + GetVectorContext(Thread, VectorFrame); + while (FTextIndex < FComboBoxList.Count) and (EvaluateResult = erOK) do + begin + if (FTextIndex >= 0) and (FResultStr <> '') then + begin + if (ParseValue(FResultStr,AValue,Format)) then + case RegisterType of + rtXMM: + case AValue.Display of + xt16Bytes: + FXMMRegister.Bytes[FTextIndex] := AValue.ValueByte; + xt8Words: + FXMMRegister.Words[FTextIndex] := AValue.ValueWord; + xt4DWords: + FXMMRegister.DWords[FTextIndex] := AValue.ValueDWord; + xt2QWords: + FXMMRegister.QWords[FTextIndex] := AValue.ValueQWord; + xt4Singles: + FXMMRegister.Singles[FTextIndex] := AValue.ValueSingle; + xt2Doubles: + FXMMRegister.Doubles[FTextIndex] := AValue.ValueDouble; + end; + rtMM: + case AValue.Display of + xt16Bytes: + FMMRegister.Bytes[FTextIndex] := AValue.ValueByte; + xt8Words: + FMMRegister.Words[FTextIndex] := AValue.ValueWord; + xt4DWords: + FMMRegister.DWords[FTextIndex] := AValue.ValueDWord; + xt2QWords: + FMMRegister.QWords := AValue.ValueQWord; + xt4Singles: + FMMRegister.Singles[FTextIndex] := AValue.ValueSingle; + xt2Doubles: + EvaluateResult := erError; + end; + else + EvaluateResult := erError; + end + else + EvaluateResult := erError; + end; + if EvaluateResult = erOK then + begin + Inc(FTextIndex); + if FTextIndex < FComboBoxList.Count then + begin + AComboBox := TComboBox(FComboBoxList.Items[FTextIndex]); + FExprStr := AComboBox.Text; + if FExprStr <> '' then + begin + if not ParseValue(FExprStr, AValue, Format) then + begin + if ReplaceSIMDRegisters(FExprStr, FCPUInfo.Is64Bits, VectorFrame) then + EvaluateResult := Thread.Evaluate(FExprStr, ResultBuffer, + ResultBufferSize, CanModify, True, '', ResultAddr, ResultSize, FReturnCode) + else + EvaluateResult := erError; + if (EvaluateResult <> erDeferred) and (FReturnCode <> 0) then + EvaluateResult := erError; + if EvaluateResult = erOK then + FResultStr := ResultBuffer; + if FResultStr = '' then + EvaluateResult := erError; + end + else + begin + FResultStr := FExprStr; + EvaluateResult := erOK; + end; + end + else + FResultStr := ''; + end; + end; + end; + if (EvaluateResult = erError) and (FTextIndex < FComboBoxList.Count) then + begin + AComboBox := TComboBox(FComboBoxList.Items[FTextIndex]); + FocusControl(AComboBox); + AComboBox.SelectAll; + end + else + if (EvaluateResult = erOK) and (FTextIndex >= FComboBoxList.Count) then + ModalResult := mrOk; +end; + +procedure TJclSIMDModifyFrm.ButtonOKClick(Sender: TObject); +begin + try + StartModify; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDModifyFrm.ThreadEvaluate(const ExprStr, ResultStr: string; ReturnCode: Integer); +begin + if CompareText(FExprStr, ExprStr) = 0 then + begin + FResultStr := ResultStr; + FReturnCode := ReturnCode; + PostMessage(Handle, WM_MODIFYCONTINUE, 0, 0); + end; +end; + +// History: + +// $Log: JclSIMDModifyForm.pas,v $ +// Revision 1.9 2006/01/08 17:16:56 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.8 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.7 2005/12/04 10:10:57 obones +// Borland Developer Studio 2006 support +// +// Revision 1.6 2005/11/21 21:25:40 outchy +// Modified the get/set methods of thread context for Delphi 2005 +// +// Revision 1.5 2005/10/26 03:29:44 rrossmair +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and $Log: JclSIMDModifyForm.pas,v $ +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.9 2006/01/08 17:16:56 outchy +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Settings reworked. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Common window for expert configurations +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.8 2005/12/16 23:46:25 outchy +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Added expert stack form. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Added code to display call stack on expert exception. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Fixed package extension for D2006. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.7 2005/12/04 10:10:57 obones +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Borland Developer Studio 2006 support +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/simdview/JclSIMDTestBCB.cpp b/official/1.96/experts/debug/simdview/JclSIMDTestBCB.cpp new file mode 100644 index 0000000..c1ae00f --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDTestBCB.cpp @@ -0,0 +1,110 @@ +//----------------------------------------------------------------------------- +//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/MPL-1.1.html + +//Software distributed under the License is distributed on an "AS IS" basis, +//WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +//the specific language governing rights and limitations under the License. + +//The Original Code is: JvSIMDTest.dpr, released on 2004-10-11. + +//The Initial Developer of the Original Code is Florent Ouchet [ouchet dott florent att laposte dott net] +//Portions created by Florent Ouchet are Copyright (C) 2004 Florent Ouchet. +//All Rights Reserved. + +//Contributor(s): - + +//You may retrieve the latest version of this file at the Project JEDI's JCL home page, +//located at http://jcl.sourceforge.net + +//Known Issues: +//----------------------------------------------------------------------------- +// $Id: JclSIMDTestBCB.cpp,v 1.2 2005/10/26 03:29:44 rrossmair Exp $ +//--------------------------------------------------------------------------- + +#pragma hdrstop + +#include +#include + +//--------------------------------------------------------------------------- + +#if __BORLANDC__ == 1380 +#define BCB6 +#endif + +#if __BORLANDC__ == 1360 +#define BCB5 +#endif + +#ifdef BCB5 +#define COMPILER5_UP +#define COMPILER5 +#endif + +#ifdef BCB6 +#define COMPILER6_UP +#define COMPILER5_UP +#define COMPILER6 +#endif + +#pragma argsused +int main (int argc, char **argv) +{ + using namespace std; + float Values[4]; + int Index, ErrorCode; + char Line[256]; + + printf("Streaming SIMD Extensions of Intel Pentium and AMD Athlon processors\n"); + printf("By Ouchet Florent \n"); + printf("Released 2004,14,3\n"); + printf("All rights free\n\n"); + + for (Index=0; Index<4; Index++) { + do { + printf("Enter the floating point value %d : ",Index); + gets(Line); + ErrorCode = sscanf(Line,"%f",Values+Index); + } while (ErrorCode!=1); + } + + printf("\nCheck values :\n"); + for (Index=0; Index<4; Index++) + printf("Value %d is : %f\n",Index,Values[Index]); + + printf("\nStarting computations : Values*2 ..."); + __asm { + // breakpoint here + // hit ctrl+alt+D or go to View/Debug window and open the last item + // these instructions operate on 4-packed-single-precision floating point values + // so you should view these registers has single values + LEA EAX, Values +#ifdef COMPILER6_UP + movups xmm0, [eax] // moving Values to xmm0 + addps xmm0, xmm0 // xmm0 <- xmm0 + xmm0 + movups [eax], xmm0 // moving xmm0 to Values +#else + DB 0Fh, 10h, 00h // movups xmm0, [eax] + DB 0Fh, 58h, 0C0h // addps xmm0, xmm0 + DB 0Fh, 11h, 00h // movups [eax], xmm0 +#endif + }; + printf("Computations ended\nNow values are :\n"); + for (Index=0; Index<4; Index++) + printf("Value %d is : %f\n",Index,Values[Index]); + printf("\nProgram terminated\n"); + gets(Line); + return 0; +} +//--------------------------------------------------------------------------- + +// History: + +// $Log: JclSIMDTestBCB.cpp,v $ +// Revision 1.2 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + diff --git a/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.bpf b/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.bpf new file mode 100644 index 0000000..2b51182 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.bpf @@ -0,0 +1,5 @@ +USEUNIT("JclSIMDTestBCB.cpp"); +//--------------------------------------------------------------------------- +Ce fichier est uniquement utilisé par le gestionnaire de projets et doit être traité comme le fichier projet + +main \ No newline at end of file diff --git a/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.bpr b/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.bpr new file mode 100644 index 0000000..aa8642b --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.bpr @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + [Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1036 +CodePage=1252 + + + diff --git a/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.drc b/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.drc new file mode 100644 index 0000000..e707b3f --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.drc @@ -0,0 +1,9 @@ +/* + Generated by the Borland C++ Incremental Linker + because -GD was supplied to the linker. + + It contains compiler-generated resource bound to the executable. + If it is empty, no compiler-generated resources were bound to the + produced executable. +*/ + diff --git a/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.tds b/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.tds new file mode 100644 index 0000000..9fb6292 Binary files /dev/null and b/official/1.96/experts/debug/simdview/JclSIMDTestBCBProject.tds differ diff --git a/official/1.96/experts/debug/simdview/JclSIMDTestDelphi.dpr b/official/1.96/experts/debug/simdview/JclSIMDTestDelphi.dpr new file mode 100644 index 0000000..2f73c31 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDTestDelphi.dpr @@ -0,0 +1,95 @@ +{**************************************************************************************************} +{ } +{ 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: JvSIMDTest.dpr, released on 2004-10-11. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ [ouchet dott florent att laposte dott net] } +{ All Rights Free. } +{ } +{ You may retrieve the latest version of this file at the Project JEDI's JCL home page, } +{ located at http://jcl.sourceforge.net } +{ } +{**************************************************************************************************} + +// $Id: JclSIMDTestDelphi.dpr,v 1.2 2005/10/26 03:29:44 rrossmair Exp $ + +program JclSIMDTestDelphi; + +{$APPTYPE CONSOLE} + +{$I jedi.inc} + +uses + SysUtils, + Windows, + Dialogs; + +var + Values: array [0..3] of single; + Index, ErrorCode: Integer; + Number: String; +begin + WriteLn('Streaming SIMD Extension of Intel Pentium and AMD Athlon processors'); + WriteLn('By Ouchet Florent '); + WriteLn('Released 2004,10,12'); + WriteLn('All rights free'); + WriteLn; + for Index:=Low(Values) to High(Values) do + repeat + Write('Enter the floating point value ',Index,' : '); + ReadLn(Number); + if (DecimalSeparator<>'.') then + Number:=StringReplace(Number,DecimalSeparator,'.',[rfReplaceAll,rfIgnoreCase]); + Val(Number,Values[Index],ErrorCode); + until (ErrorCode=0); + + WriteLn; + WriteLn('Check values :'); + for Index:=Low(Values) to High(Values) do + WriteLn('Value ',Index,' is : ',Values[Index]:2:3); + + WriteLn; + WriteLn('Starting computations : Values*2 ...'); + asm + // breakpoint here + // hit ctrl+alt+D or go to View/Debug window and open the last item + // these instructions operate on 4-packed-single-precision floating point values + // so you should view these registers has single values + LEA EAX, Values +{$IFDEF COMPILER6_UP} + movups xmm0, [eax] // moving Values into xmm0 + addps xmm0, xmm0 // xmm0 :- xmm0 + xmm0 + movups [eax], xmm0 // moving xmm0 into Values +{$ELSE} + DB 0Fh, 10h, 00h // movups xmm0, [eax] + DB 0Fh, 58h, 0C0h // addps xmm0, xmm0 + DB 0Fh, 11h, 00h // movups [eax], xmm0 +{$ENDIF} + end; + WriteLn('Computations ended'); + WriteLn; + WriteLn('Now values are :'); + for Index:=Low(Values) to High(Values) do + WriteLn('Value ',Index,' is : ',Values[Index]:2:3); + WriteLn; + WriteLn('Program terminated'); + ReadLn; + +// History: + +// $Log: JclSIMDTestDelphi.dpr,v $ +// Revision 1.2 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/simdview/JclSIMDUtils.pas b/official/1.96/experts/debug/simdview/JclSIMDUtils.pas new file mode 100644 index 0000000..9cb08c3 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDUtils.pas @@ -0,0 +1,914 @@ +{**************************************************************************************************} +{ } +{ 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: JvSIMDUtils.pas, released on 2004-10-11. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ [ouchet dott florent att laposte dott net] } +{ Portions created by Florent Ouchet are Copyright (C) 2004 Florent Ouchet. } +{ All Rights Reserved. } +{ } +{ You may retrieve the latest version of this file at the Project JEDI's JCL home page, } +{ located at http://jcl.sourceforge.net } +{ } +{**************************************************************************************************} + +// $Id: JclSIMDUtils.pas,v 1.6 2005/12/16 23:46:25 outchy Exp $ + +unit JclSIMDUtils; + +{$I jcl.inc} + +interface + +uses + Windows, + ToolsAPI, + JclSysInfo, + JclOtaResources; + +type + TJclMMContentType = (mt8Bytes, mt4Words, mt2DWords, mt1QWord, mt2Singles); + + TJclMMRegister = packed record + case TJclMMContentType of + mt8Bytes: + (Bytes: array [0..7] of Byte;); + mt4Words: + (Words: array [0..3] of Word;); + mt2DWords: + (DWords: array [0..1] of Cardinal;); + mt1QWord: + (QWords: Int64;); + mt2Singles: + (Singles: array [0..1] of Single;); + end; + + TJclFPUContentType = (ftExtended, ftMM); + + TJclFPUData = packed record + case TJclFPUContentType of + ftExtended: + (FloatValue: Extended;); + ftMM: + (MMRegister: TJclMMRegister; + Reserved: Word;); + end; + + TJclFPURegister = packed record + Data: TJclFPUData; + Reserved: array [0..5] of Byte; + end; + + TJclFPURegisters = array [0..7] of TJclFPURegister; + + TJclXMMContentType = (xt16Bytes, xt8Words, xt4DWords, xt2QWords, xt4Singles, xt2Doubles); + + TJclXMMRegister = packed record + case TJclXMMContentType of + xt16Bytes: + (Bytes: array [0..15] of Byte;); + xt8Words: + (Words: array [0..7] of Word;); + xt4DWords: + (DWords: array [0..3] of Cardinal;); + xt2QWords: + (QWords: array [0..1] of Int64;); + xt4Singles: + (Singles: array [0..3] of Single;); + xt2Doubles: + (Doubles: array [0..1] of Double;); + end; + + TJclProcessorSize = (ps32Bits, ps64Bits); + + TJclXMMRegisters = packed record + case TJclProcessorSize of + ps32Bits: + (LegacyXMM: array [0..7] of TJclXMMRegister; + LegacyReserved: array [0..127] of Byte;); + ps64Bits: + (LongXMM: array [0..15] of TJclXMMRegister;); + end; + + //TJclRoundingControl = (rcRoundToNearest, //=0 + // rcRoundDown, //=1 + // rcRoundUp, //=2 + // rcRoundTowardZero); //=3 + + TJclVectorFrame = packed record + FCW: Word; // bytes from 0 to 1 + FSW: Word; // bytes from 2 to 3 + FTW: Byte; // byte 4 + Reserved1: Byte; // byte 5 + FOP: Word; // bytes from 6 to 7 + FpuIp: Cardinal; // bytes from 8 to 11 + CS: Word; // bytes from 12 to 13 + Reserved2: Word; // bytes from 14 to 15 + FpuDp: Cardinal; // bytes from 16 to 19 + DS: Word; // bytes from 20 to 21 + Reserved3: Word; // bytes from 22 to 23 + MXCSR: Cardinal; // bytes from 24 to 27 + MXCSRMask: Cardinal; // bytes from 28 to 31 + FPURegisters: TJclFPURegisters; // bytes from 32 to 159 + XMMRegisters: TJclXMMRegisters; // bytes from 160 to 415 + Reserved4: array [416..511] of Byte; // bytes from 416 to 512 + end; + + TJclContext = packed record + ScalarContext: Windows.TContext; + VectorContext: TJclVectorFrame; + end; + + PJclContext = ^TJclContext; + + TBitDescription = record + AndMask: Cardinal; + Shifting: Cardinal; + ShortName: string; + LongName: string; + end; + + TMXCSRRange = 0..14; + +const + MXCSRBitsDescriptions: array [TMXCSRRange] of TBitDescription = + ( + (AndMask: MXCSR_IE; Shifting: 0; ShortName: RsVectorIE; LongName: RsVectorIEText), + (AndMask: MXCSR_DE; Shifting: 1; ShortName: RsVectorDE; LongName: RsVectorDEText), + (AndMask: MXCSR_ZE; Shifting: 2; ShortName: RsVectorZE; LongName: RsVectorZEText), + (AndMask: MXCSR_OE; Shifting: 3; ShortName: RsVectorOE; LongName: RsVectorOEText), + (AndMask: MXCSR_UE; Shifting: 4; ShortName: RsVectorUE; LongName: RsVectorUEText), + (AndMask: MXCSR_PE; Shifting: 5; ShortName: RsVectorPE; LongName: RsVectorPEText), + (AndMask: MXCSR_DAZ; Shifting: 6; ShortName: RsVectorDAZ; LongName: RsVectorDAZText), + (AndMask: MXCSR_IM; Shifting: 7; ShortName: RsVectorIM; LongName: RsVectorIMText), + (AndMask: MXCSR_DM; Shifting: 8; ShortName: RsVectorDM; LongName: RsVectorDMText), + (AndMask: MXCSR_ZM; Shifting: 9; ShortName: RsVectorZM; LongName: RsVectorZMText), + (AndMask: MXCSR_OM; Shifting: 10; ShortName: RsVectorOM; LongName: RsVectorOMText), + (AndMask: MXCSR_UM; Shifting: 11; ShortName: RsVectorUM; LongName: RsVectorUMText), + (AndMask: MXCSR_PM; Shifting: 12; ShortName: RsVectorPM; LongName: RsVectorPMText), + (AndMask: MXCSR_RC; Shifting: 13; ShortName: RsVectorRC; LongName: RsVectorRCText), + (AndMask: MXCSR_FZ; Shifting: 15; ShortName: RsVectorFZ; LongName: RsVectorFZText) + ); + +type + TJclSIMDValue = packed record + case Display: TJclXMMContentType of + xt16Bytes: + (ValueByte: Byte;); + xt8Words: + (ValueWord: Word;); + xt4DWords: + (ValueDWord: Cardinal;); + xt2QWords: + (ValueQWord: Int64;); + xt4Singles: + (ValueSingle: Single;); + xt2Doubles: + (ValueDouble: Double;); + end; + + TJclSIMDFormat = (sfBinary, sfSigned, sfUnsigned, sfHexa); + +function FormatValue(Value: TJclSIMDValue; Format: TJclSIMDFormat): string; +function ParseValue(const StringValue: string; var Value: TJclSIMDValue; + Format: TJclSIMDFormat): Boolean; +function ReplaceSIMDRegisters(var Expression: string; Is64Bits: Boolean; + var VectorFrame: TJclVectorFrame): Boolean; + +const + CONTEXT_EXTENDED_REGISTERS = CONTEXT_i386 or $00000020; + +// return the processor frame for the specified thread, this thread must be suspended +function GetThreadContext(hThread: THandle; var lpContext: TJclContext): BOOL; stdcall; + +// set the processor frame for the specified thread, this thread must be suspended +function SetThreadContext(hThread: THandle; const lpContext: TJclContext): BOOL; stdcall; + +// return the XMM registers for the specified thread, this thread must be suspended +function GetVectorContext(AThread: IOTAThread; out VectorContext: TJclVectorFrame): Boolean; +// return the XMM registers for the specified thread, this thread must be suspended +function SetVectorContext(AThread: IOTAThread; const VectorContext: TJclVectorFrame): Boolean; + +implementation + +uses + SysUtils, Math, + JclOtaUtils; + +function FormatBinary(Value: TJclSIMDValue): string; +var + I: Byte; +const + Width: array [xt16Bytes..xt2QWords] of Byte = (8, 16, 32, 64); +begin + if not (Value.Display in [xt16Bytes, xt8Words, xt4DWords, XT2QWords]) then + raise EJclExpertException.CreateTrace(RsEBadRegisterDisplay); + + Assert(Value.Display < xt4Singles); + Result := StringOfChar('0', Width[Value.Display]); + for I := 1 to Width[Value.Display] do + begin + if (Value.ValueQWord and 1) <> 0 then + Result[Width[Value.Display] - I + 1] := '1'; + Value.ValueQWord := Value.ValueQWord shr 1; + end; +end; + +function FormatSigned(Value: TJclSIMDValue): string; +const + Width: array [xt16Bytes..xt2QWords] of Byte = (4, 6, 11, 20); +begin + if not (Value.Display in [xt16Bytes, xt8Words, xt4DWords, XT2QWords]) then + raise EJclExpertException.CreateTrace(RsEBadRegisterDisplay); + + case Value.Display of + xt16Bytes: + Result := IntToStr(Shortint(Value.ValueByte)); + xt8Words: + Result := IntToStr(Smallint(Value.ValueWord)); + xt4DWords: + Result := IntToStr(Integer(Value.ValueDWord)); + xt2QWords: + Result := IntToStr(Value.ValueQWord); + else + Result := ''; + Exit; + end; + Result := StringOfChar(' ', Width[Value.Display] - Length(Result)) + Result; +end; + +function FormatUnsigned(Value: TJclSIMDValue): string; +const + Width: array [xt16Bytes..xt2QWords] of Byte = (3, 5, 10, 20); +begin + if not (Value.Display in [xt16Bytes, xt8Words, xt4DWords, XT2QWords]) then + raise EJclExpertException.CreateTrace(RsEBadRegisterDisplay); + + case Value.Display of + xt16Bytes: + Result := IntToStr(Byte(Value.ValueByte)); + xt8Words: + Result := IntToStr(Word(Value.ValueWord)); + xt4DWords: + Result := IntToStr(Cardinal(Value.ValueDWord)); + xt2QWords: + Result := IntToStr(Value.ValueQWord); + else + Result := ''; + Exit; + end; + Result := StringOfChar(' ', Width[Value.Display] - Length(Result)) + Result; +end; + +function FormatHexa(Value: TJclSIMDValue): string; +const + Width: array [xt16Bytes..xt2QWords] of Byte = (2, 4, 8, 16); +begin + if not (Value.Display in [xt16Bytes, xt8Words, xt4DWords, XT2QWords]) then + raise EJclExpertException.CreateTrace(RsEBadRegisterDisplay); + + case Value.Display of + xt16Bytes: + Result := IntToHex(Value.ValueByte, Width[xt16Bytes]); + xt8Words: + Result := IntToHex(Value.ValueWord, Width[xt8Words]); + xt4DWords: + Result := IntToHex(Value.ValueDWord, Width[xt4DWords]); + xt2QWords: + Result := IntToHex(Value.ValueQWord, Width[xt2QWords]); + else + Result := ''; + end; +end; + +function FormatFloat(Value: TJclSIMDValue): string; +begin + if not (Value.Display in [xt4Singles, xt2Doubles]) then + raise EJclExpertException.CreateTrace(RsEBadRegisterDisplay); + + case Value.Display of + xt4Singles: + Result := FloatToStr(Value.ValueSingle); + xt2Doubles: + Result := FloatToStr(Value.ValueDouble); + else + Result := ''; + end; + Result := StringOfChar(' ', 22 - Length(Result)) + Result; // 22 = max string length of a double value +end; + +function FormatValue(Value: TJclSIMDValue; Format: TJclSIMDFormat): string; +type + TFormatFunction = function(Value: TJclSIMDValue): string; +var + FormatFunction: TFormatFunction; +begin + Result := ''; + case Format of + sfBinary: + FormatFunction := FormatBinary; + sfSigned: + FormatFunction := FormatSigned; + sfUnsigned: + FormatFunction := FormatUnsigned; + sfHexa: + FormatFunction := FormatHexa; + else + Exit; + end; + case Value.Display of + xt16Bytes..xt2QWords: + Result := FormatFunction(Value); + xt4Singles..xt2Doubles: + Result := FormatFloat(Value); + end; +end; + +function ParseBinary(StringValue: string; var Value: TJclSIMDValue): Boolean; +var + TestValue: Int64; + Index: Integer; +begin + TestValue := 0; + Result := False; + if Length(StringValue) > 64 then + Exit; + for Index := 1 to Length(StringValue) do + begin + TestValue := TestValue shl 1; + case StringValue[Index] of + '0': + ; + '1': + Inc(TestValue); + else + Exit; + end; + end; + Result := True; + case Value.Display of + xt16Bytes: + if (TestValue >= Byte($00)) and (TestValue <= Byte($FF)) then + Value.ValueByte := TestValue + else + Result := False; + xt8Words: + if (TestValue >= Word($0000)) and (TestValue <= Word($FFFF)) then + Value.ValueWord := TestValue + else + Result := False; + xt4DWords: + if (TestValue >= Cardinal($00000000)) and (TestValue <= Cardinal($FFFFFFFF)) then + Value.ValueDWord := TestValue + else + Result := False; + xt2QWords: + Value.ValueQWord := TestValue; + else + Result := False; + end; +end; + +function ParseSigned(StringValue: string; var Value: TJclSIMDValue): Boolean; +var + TestValue: Int64; + ErrorCode: Integer; +begin + Val(StringValue, TestValue, ErrorCode); + Result := ErrorCode = 0; + if Result then + case Value.Display of + xt16Bytes: + if (TestValue >= Shortint($80)) and (TestValue <= Shortint($7F)) then + Value.ValueByte := TestValue + else + Result := False; + xt8Words: + if (TestValue >= Smallint($8000)) and (TestValue <= Smallint($7FFF)) then + Value.ValueWord := TestValue + else + Result := False; + xt4DWords: + if (TestValue >= Integer($80000000)) and (TestValue <= Integer($7FFFFFFF)) then + Value.ValueDWord := TestValue + else + Result := False; + xt2QWords: + Value.ValueQWord := TestValue; + else + Result := False; + end; +end; + +function ParseUnsigned(StringValue: string; var Value: TJclSIMDValue): Boolean; +var + TestValue: Int64; + ErrorCode: Integer; +begin + Val(StringValue, TestValue, ErrorCode); + Result := ErrorCode = 0; + if Result then + case Value.Display of + xt16Bytes: + if (TestValue >= Byte($00)) and (TestValue <= Byte($FF)) then + Value.ValueByte := TestValue + else + Result := False; + xt8Words: + if (TestValue >= Word($0000)) and (TestValue <= Word($FFFF)) then + Value.ValueWord := TestValue + else + Result := False; + xt4DWords: + if (TestValue >= Cardinal($00000000)) and (TestValue <= Cardinal($FFFFFFFF)) then + Value.ValueDWord := TestValue + else + Result := False; + xt2QWords: + Value.ValueQWord := TestValue; + else + Result := False; + end; +end; + +function ParseHexa(StringValue: string; var Value: TJclSIMDValue): Boolean; +var + TestValue: Int64; + Index: Integer; +begin + TestValue := 0; + Result := False; + if Length(StringValue) > 16 then + Exit; + for Index := 1 to Length(StringValue) do + begin + TestValue := TestValue shl 4; + case StringValue[Index] of + '0': + ; + '1'..'9': + Inc(TestValue, Ord(StringValue[Index]) - Ord('0')); + 'A'..'F': + Inc(TestValue, Ord(StringValue[Index]) - Ord('A') + 10); + 'a'..'f': + Inc(TestValue, Ord(StringValue[Index]) - Ord('a') + 10); + else + Exit; + end; + end; + Result := True; + case Value.Display of + xt16Bytes: + if (TestValue >= Byte($00)) and (TestValue <= Byte($FF)) then + Value.ValueByte := TestValue + else + Result := False; + xt8Words: + if (TestValue >= Word($0000)) and (TestValue <= Word($FFFF)) then + Value.ValueWord := TestValue + else + Result := False; + xt4DWords: + if (TestValue >= Cardinal($00000000)) and (TestValue <= Cardinal($FFFFFFFF)) then + Value.ValueDWord := TestValue + else + Result := False; + xt2QWords: + Value.ValueQWord := TestValue; + else + Result := False; + end; +end; + +function ParseFloat(StringValue: string; var Value: TJclSIMDValue): Boolean; +var + TestValue: Extended; + ErrorCode: Integer; +begin + if DecimalSeparator <> '.' then + StringValue := StringReplace(StringValue, DecimalSeparator, '.', [rfReplaceAll, rfIgnoreCase]); + Val(StringValue, TestValue, ErrorCode); + Result := ErrorCode = 0; + if Result then + case Value.Display of + xt4Singles: + if (TestValue >= -MaxSingle) and (TestValue <= MaxSingle) then + Value.ValueSingle := TestValue + else + Result := False; + xt2Doubles: + if (TestValue >= MaxDouble) and (TestValue <= MaxDouble) then + Value.ValueDouble := TestValue + else + Result := False; + else + Result := False; + end; +end; + +function ParseValue(const StringValue: string; var Value: TJclSIMDValue; + Format: TJclSIMDFormat): Boolean; +type + TParseFunction = function(StringValue: string; var Value: TJclSIMDValue): Boolean; +var + ParseFunction: TParseFunction; +begin + Result := False; + case Format of + sfBinary: + ParseFunction := ParseBinary; + sfSigned: + ParseFunction := ParseSigned; + sfUnsigned: + ParseFunction := ParseUnsigned; + sfHexa: + ParseFunction := ParseHexa; + else + Exit; + end; + case Value.Display of + xt16Bytes..xt2QWords: + Result := ParseFunction(StringValue, Value); + xt4Singles..xt2Doubles: + Result := ParseFloat(StringValue, Value); + end; +end; + +function ReplaceSIMDRegisters(var Expression: string; Is64Bits: Boolean; + var VectorFrame: TJclVectorFrame): Boolean; +var + LocalString: string; + RegisterPosition: Integer; + DataPosition: Integer; + DataType: string; + Index: Integer; + RegisterIndex: Integer; + DataIndex: Integer; + ErrorCode: Integer; + NumberOfXMMRegister: Integer; + AValue: TJclSIMDValue; + ValueStr: string; + OldLength: Integer; +begin + if Is64Bits then + NumberOfXMMRegister := 16 + else + NumberOfXMMRegister := 8; + Result := False; + LocalString := AnsiUpperCase(Expression); + + RegisterPosition := AnsiPos('XMM', LocalString); + while (RegisterPosition > 0) do + begin + for Index := RegisterPosition to Length(LocalString) do + if LocalString[Index] = '.' then + Break; + if Index >= Length(LocalString) then + Exit; + Val(Copy(LocalString, RegisterPosition + 3, Index - RegisterPosition - 3), RegisterIndex, ErrorCode); + if (ErrorCode <> 0) or (RegisterIndex < 0) or (RegisterIndex >= NumberOfXMMRegister) then + Exit; + + DataPosition := Index + 1; + if DataPosition > Length(LocalString) then + Exit; + for Index := DataPosition to Length(LocalString) do + if LocalString[Index] in ['0'..'9'] then + Break; + if Index > Length(LocalString) then + Exit; + DataType := Copy(LocalString, DataPosition, Index - DataPosition); + + DataPosition := Index; + for Index := DataPosition to Length(LocalString) do + if not (LocalString[Index] in ['0'..'9']) then + Break; + Val(Copy(LocalString, DataPosition, Index - DataPosition), DataIndex, ErrorCode); + if (ErrorCode <> 0) or (DataIndex < 0) then + Exit; + + if CompareStr(DataType, 'BYTE') = 0 then + begin + if DataIndex >= 16 then + Exit; + AValue.Display := xt16Bytes; + AValue.ValueByte := VectorFrame.XMMRegisters.LongXMM[RegisterIndex].Bytes[DataIndex]; + end + else + if CompareStr(DataType, 'WORD') = 0 then + begin + if DataIndex >= 8 then + Exit; + AValue.Display := xt8Words; + AValue.ValueWord := VectorFrame.XMMRegisters.LongXMM[RegisterIndex].Words[DataIndex]; + end + else + if CompareStr(DataType, 'DWORD') = 0 then + begin + if DataIndex >= 4 then + Exit; + AValue.Display := xt4DWords; + AValue.ValueDWord := VectorFrame.XMMRegisters.LongXMM[RegisterIndex].DWords[DataIndex]; + end + else + if CompareStr(DataType, 'QWORD') = 0 then + begin + if DataIndex >= 2 then + Exit; + AValue.Display := xt2QWords; + AValue.ValueQWord := VectorFrame.XMMRegisters.LongXMM[RegisterIndex].QWords[DataIndex]; + end + else + if CompareStr(DataType, 'SINGLE') = 0 then + begin + if DataIndex >= 4 then + Exit; + AValue.Display := xt4Singles; + AValue.ValueSingle := VectorFrame.XMMRegisters.LongXMM[RegisterIndex].Singles[DataIndex]; + end + else + if CompareStr(DataType, 'DOUBLE') = 0 then + begin + if DataIndex >= 2 then + Exit; + AValue.Display := xt2Doubles; + AValue.ValueDouble := VectorFrame.XMMRegisters.LongXMM[RegisterIndex].Doubles[DataIndex]; + end + else + Exit; + ValueStr := Trim(FormatValue(AValue, sfSigned)); + if DecimalSeparator <> '.' then + ValueStr := StringReplace(ValueStr, DecimalSeparator, '.', [rfReplaceAll, rfIgnoreCase]); + if Length(ValueStr) >= Index - RegisterPosition then + begin + OldLength := Length(Expression); + SetLength(Expression, Length(Expression) + Length(ValueStr) - (Index - RegisterPosition)); + if Length(ValueStr) > Index - RegisterPosition then + Move(Expression[Index], Expression[RegisterPosition + Length(ValueStr)], OldLength - Index + 1); + Move(ValueStr[1], Expression[RegisterPosition], Length(ValueStr)); + end + else + begin + Move(ValueStr[1], Expression[RegisterPosition], Length(ValueStr)); + Move(Expression[Index], Expression[RegisterPosition + Length(ValueStr)], Length(Expression) - Index + 1); + SetLength(Expression, Length(Expression) + Length(ValueStr) - (Index - RegisterPosition)); + end; + LocalString := AnsiUpperCase(Expression); + RegisterPosition := AnsiPos('XMM', LocalString); + end; + + RegisterPosition := AnsiPos('MM', LocalString); + while (RegisterPosition > 0) do + begin + for Index := RegisterPosition to Length(LocalString) do + if LocalString[Index] = '.' then + Break; + if Index >= Length(LocalString) then + Exit; + Val(Copy(LocalString, RegisterPosition + 2, Index - RegisterPosition - 2), RegisterIndex, ErrorCode); + if (ErrorCode <> 0) or (RegisterIndex < 0) or (RegisterIndex >= 8) then + Exit; + + DataPosition := Index + 1; + if DataPosition > Length(LocalString) then + Exit; + for Index := DataPosition to Length(LocalString) do + if LocalString[Index] in ['0'..'9'] then + Break; + if Index > Length(LocalString) then + Exit; + DataType := Copy(LocalString, DataPosition, Index - DataPosition); + + DataPosition := Index; + for Index := DataPosition to Length(LocalString) do + if not (LocalString[Index] in ['0'..'9']) then + Break; + Val(Copy(LocalString, DataPosition, Index - DataPosition), DataIndex, ErrorCode); + if (ErrorCode <> 0) or (DataIndex < 0) then + Exit; + + if CompareStr(DataType, 'BYTE') = 0 then + begin + if DataIndex >= 8 then + Exit; + AValue.Display := xt16Bytes; + AValue.ValueByte := VectorFrame.FPURegisters[RegisterIndex].Data.MMRegister.Bytes[DataIndex]; + end + else + if CompareStr(DataType, 'WORD') = 0 then + begin + if DataIndex >= 4 then + Exit; + AValue.Display := xt8Words; + AValue.ValueWord := VectorFrame.FPURegisters[RegisterIndex].Data.MMRegister.Words[DataIndex]; + end + else + if CompareStr(DataType, 'DWORD') = 0 then + begin + if DataIndex >= 2 then + Exit; + AValue.Display := xt4DWords; + AValue.ValueDWord := VectorFrame.FPURegisters[RegisterIndex].Data.MMRegister.DWords[DataIndex]; + end + else + if CompareStr(DataType, 'QWORD') = 0 then + begin + if DataIndex >= 1 then + Exit; + AValue.Display := xt2QWords; + AValue.ValueQWord := VectorFrame.FPURegisters[RegisterIndex].Data.MMRegister.QWords; + end + else + if CompareStr(DataType, 'SINGLE') = 0 then + begin + if DataIndex >= 2 then + Exit; + AValue.Display := xt4Singles; + AValue.ValueSingle := VectorFrame.FPURegisters[RegisterIndex].Data.MMRegister.Singles[DataIndex]; + end + else + Exit; + ValueStr := Trim(FormatValue(AValue, sfSigned)); + if DecimalSeparator <> '.' then + ValueStr := StringReplace(ValueStr, DecimalSeparator, '.', [rfReplaceAll, rfIgnoreCase]); + if Length(ValueStr) >= Index - RegisterPosition then + begin + OldLength := Length(Expression); + SetLength(Expression, Length(Expression) + Length(ValueStr) - (Index - RegisterPosition)); + if Length(ValueStr) > Index - RegisterPosition then + Move(Expression[Index], Expression[RegisterPosition + Length(ValueStr)], OldLength - Index + 1); + Move(ValueStr[1], Expression[RegisterPosition], Length(ValueStr)); + end + else + begin + Move(ValueStr[1], Expression[RegisterPosition], Length(ValueStr)); + Move(Expression[Index], Expression[RegisterPosition + Length(ValueStr)], Length(Expression) - Index + 1); + SetLength(Expression, Length(Expression) + Length(ValueStr) - (Index - RegisterPosition)); + end; + LocalString := AnsiUpperCase(Expression); + RegisterPosition := AnsiPos('MM', LocalString); + end; + + Result := True; +end; + +function GetThreadContext(hThread: THandle; + var lpContext: TJclContext): BOOL; stdcall; external kernel32 name 'GetThreadContext'; + +function SetThreadContext(hThread: THandle; + const lpContext: TJclContext): BOOL; stdcall; external kernel32 name 'SetThreadContext'; + +function GetVectorContext(AThread: IOTAThread; out VectorContext: TJclVectorFrame): Boolean; +{$IFDEF COMPILER9_UP} +var + OTAXMMRegs: TOTAXMMRegs; + OTAThreadContext: TOTAThreadContext; +begin + Result := AThread.GetOTAXMMRegisters(OTAXMMRegs); + if Result then + begin + VectorContext.MXCSR := OTAXMMRegs.MXCSR; + VectorContext.MXCSRMask := $FFFFFFFF; + Move(OTAXMMRegs,VectorContext.XMMRegisters, SizeOf(TOTAXMMReg) * 8); + OTAThreadContext := AThread.OTAThreadContext; + VectorContext.FCW := OTAThreadContext.FloatSave.ControlWord; + VectorContext.FSW := OTAThreadContext.FloatSave.StatusWord; + VectorContext.FTW := OTAThreadContext.FloatSave.TagWord; + Move(OTAThreadContext.FloatSave.RegisterArea[00],VectorContext.FPURegisters[0],SizeOf(Extended)); + Move(OTAThreadContext.FloatSave.RegisterArea[10],VectorContext.FPURegisters[1],SizeOf(Extended)); + Move(OTAThreadContext.FloatSave.RegisterArea[20],VectorContext.FPURegisters[2],SizeOf(Extended)); + Move(OTAThreadContext.FloatSave.RegisterArea[30],VectorContext.FPURegisters[3],SizeOf(Extended)); + Move(OTAThreadContext.FloatSave.RegisterArea[40],VectorContext.FPURegisters[4],SizeOf(Extended)); + Move(OTAThreadContext.FloatSave.RegisterArea[50],VectorContext.FPURegisters[5],SizeOf(Extended)); + Move(OTAThreadContext.FloatSave.RegisterArea[60],VectorContext.FPURegisters[6],SizeOf(Extended)); + Move(OTAThreadContext.FloatSave.RegisterArea[70],VectorContext.FPURegisters[7],SizeOf(Extended)); + end; +end; +{$ELSE COMPILER9_UP} +var + ContextMemory: Pointer; + JvContext: PJclContext; +begin + GetMem(ContextMemory, SizeOf(TJclContext) + 15); + try + if (Cardinal(ContextMemory) and 15) <> 0 then + JvContext := PJclContext((Cardinal(ContextMemory) + 16) and $FFFFFFF0) + else + JvContext := ContextMemory; + JvContext^.ScalarContext.ContextFlags := CONTEXT_EXTENDED_REGISTERS; + Result := GetThreadContext(AThread.Handle,JvContext^) and + ((JvContext^.ScalarContext.ContextFlags and CONTEXT_EXTENDED_REGISTERS)<>0); + if Result then + VectorContext := JvContext^.VectorContext + else + FillChar(VectorContext, SizeOf(VectorContext), 0); + finally + FreeMem(ContextMemory); + end; +end; +{$ENDIF COMPILER9_UP} + +function SetVectorContext(AThread: IOTAThread; const VectorContext: TJclVectorFrame): Boolean; +{$IFDEF COMPILER9_UP} +var + OTAXMMRegs: TOTAXMMRegs; +begin + Result := True; + try + OTAXMMRegs.MXCSR := VectorContext.MXCSR; + Move(VectorContext.XMMRegisters,OTAXMMRegs,SizeOf(TOTAXMMReg) * 8); + AThread.SetOTAXMMRegisters(OTAXMMRegs); + except + Result := False; + end; +end; +{$ELSE COMPILER9_UP} +// MM registers can not saved (changes are overriden by the Borland's debugger) +{const + CONTEXT_FLAGS = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS + or CONTEXT_FLOATING_POINT or CONTEXT_EXTENDED_REGISTERS; +var + ContextMemory: Pointer; + JvContext: PJclContext; + Index: Integer; +begin + GetMem(ContextMemory,SizeOf(TJclContext)+15); + try + if ((Cardinal(ContextMemory) and 15)<>0) then + JvContext := PJclContext((Cardinal(ContextMemory)+16) and $FFFFFFF0) + else + JvContext := ContextMemory; + JvContext^.ScalarContext.ContextFlags := CONTEXT_FLAGS; + Result := GetThreadContext(hThread,JvContext^) and + ((JvContext^.ScalarContext.ContextFlags and CONTEXT_FLAGS) = CONTEXT_FLAGS); + if (Result) then + begin + JvContext^.ScalarContext.ContextFlags := CONTEXT_FLAGS; + JvContext^.VectorContext := VectorContext; + for Index := 0 to 7 do + Move(VectorContext.FPURegisters[Index].Data.FloatValue,JvContext^.ScalarContext.FloatSave.RegisterArea[Index*SizeOf(Extended)],SizeOf(Extended)); + Result := SetThreadContext(hThread,JvContext^); + end; + finally + FreeMem(ContextMemory); + end; +end;} +var + ContextMemory: Pointer; + JvContext: PJclContext; +begin + GetMem(ContextMemory, SizeOf(TJclContext) + 15); + try + if (Cardinal(ContextMemory) and 15) <> 0 then + JvContext := PJclContext((Cardinal(ContextMemory) + 16) and $FFFFFFF0) + else + JvContext := ContextMemory; + JvContext^.ScalarContext.ContextFlags := CONTEXT_EXTENDED_REGISTERS; + Result := GetThreadContext(AThread.Handle,JvContext^) and + ((JvContext^.ScalarContext.ContextFlags and CONTEXT_EXTENDED_REGISTERS) = CONTEXT_EXTENDED_REGISTERS); + if Result then + Result := SetThreadContext(AThread.Handle,JvContext^); + finally + FreeMem(ContextMemory); + end; +end; +{$ENDIF COMPILER9_UP} + +// History: + +// $Log: JclSIMDUtils.pas,v $ +// Revision 1.6 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.5 2005/12/04 10:10:57 obones +// Borland Developer Studio 2006 support +// +// Revision 1.4 2005/11/21 21:25:40 outchy +// Modified the get/set methods of thread context for Delphi 2005 +// +// Revision 1.3 2005/10/26 03:29:44 rrossmair +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and $Log: JclSIMDUtils.pas,v $ +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and Revision 1.6 2005/12/16 23:46:25 outchy +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and Added expert stack form. +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and Added code to display call stack on expert exception. +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and Fixed package extension for D2006. +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and Revision 1.5 2005/12/04 10:10:57 obones +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and Borland Developer Studio 2006 support +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and CVS tags. +// + +end. + diff --git a/official/1.96/experts/debug/simdview/JclSIMDView.pas b/official/1.96/experts/debug/simdview/JclSIMDView.pas new file mode 100644 index 0000000..cdac808 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDView.pas @@ -0,0 +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: JvSIMDView.pas, released on 2004-10-11. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ [ouchet dott florent att laposte dott net] } +{ Portions created by Florent Ouchet are Copyright (C) 2004 Florent Ouchet. } +{ All Rights Reserved. } +{ } +{ You may retrieve the latest version of this file at the Project JEDI's JCL home page, } +{ located at http://jcl.sourceforge.net } +{ } +{**************************************************************************************************} + +// $Id: JclSIMDView.pas,v 1.10 2006/01/08 17:16:56 outchy Exp $ + +unit JclSIMDView; + +{$I jcl.inc} + +interface + +uses + Windows, Classes, Menus, ActnList, ToolsAPI, SysUtils, Graphics, Dialogs, + Forms, ComCtrls, + JclOtaUtils, JclSIMDViewForm, JclSysInfo; + +{$R 'JclSIMDIcon.dcr'} + +type + TProcessReference = record + Process: IOTAProcess; + ID: Integer; + end; + PProcessReference = ^TProcessReference; + + TThreadReference = record + Thread: IOTAThread; + ID: Integer; + end; + PThreadReference = ^TThreadReference; + + TJclDebuggerNotifier = class; + + TJclSIMDWizard = class(TJclOTAExpert) + private + FDebuggerServices: IOTADebuggerServices; + FIndex: Integer; + FDebuggerNotifier: TJclDebuggerNotifier; + FIcon: TIcon; + FSIMDMenuItem: TMenuItem; + FViewDebugMenu: TMenuItem; + FForm: TJclSIMDViewFrm; + FCpuInfo: TCpuInfo; + FCpuInfoValid: Boolean; + protected + FSIMDAction: TAction; + procedure SIMDActionExecute(Sender: TObject); + procedure SIMDActionUpdate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + public + constructor Create; reintroduce; + destructor Destroy; override; + function CpuInfo: TCpuInfo; + function GetSIMDString: string; + procedure RegisterCommands; override; + procedure UnregisterCommands; override; + procedure RefreshThreadContext(WriteOldContext: Boolean); + procedure CloseForm; + procedure ThreadEvaluate(const ExprStr, ResultStr: string; ReturnCode: Integer); + property DebuggerServices: IOTADebuggerServices read FDebuggerServices; + end; + + TJclDebuggerNotifier = class(TNotifierObject,IOTADebuggerNotifier, + IOTAProcessNotifier, IOTAThreadNotifier) + private + FOwner: TJclSIMDWizard; + FProcessList: TList; + FThreadList: TList; + function FindProcessReference(AProcess:IOTAProcess): PProcessReference; + function FindThreadReference(AThread:IOTAThread): PThreadReference; + public + constructor Create(AOwner: TJclSIMDWizard); reintroduce; + destructor Destroy; override; + // IOTADebuggerNotifier + procedure ProcessCreated({$IFDEF RTL170_UP} const {$ENDIF} Process: IOTAProcess); + procedure ProcessDestroyed({$IFDEF RTL170_UP} const {$ENDIF} Process: IOTAProcess); + procedure BreakpointAdded({$IFDEF RTL170_UP} const {$ENDIF} Breakpoint: IOTABreakpoint); + procedure BreakpointDeleted({$IFDEF RTL170_UP} const {$ENDIF} Breakpoint: IOTABreakpoint); + // IOTAProcessNotifier + procedure ThreadCreated({$IFDEF RTL170_UP} const {$ENDIF} Thread: IOTAThread); + procedure ThreadDestroyed({$IFDEF RTL170_UP} const {$ENDIF} Thread: IOTAThread); + procedure ProcessModuleCreated({$IFDEF RTL170_UP} const {$ENDIF} ProcessModule: IOTAProcessModule); + procedure ProcessModuleDestroyed({$IFDEF RTL170_UP} const {$ENDIF} ProcessModule: IOTAProcessModule); + // IOTAThreadNotifier + procedure ThreadNotify(Reason: TOTANotifyReason); + procedure EvaluteComplete(const ExprStr, ResultStr: string; + CanModify: Boolean; ResultAddress, ResultSize: LongWord; ReturnCode: Integer); + procedure ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer); + property Owner: TJclSIMDWizard read FOwner; + end; + +// design package entry point +procedure Register; + +// expert DLL entry point +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean; stdcall; + +implementation + +uses + JclOtaConsts, JclOtaResources, + JclSIMDUtils; + +const + RsSIMDActionName = 'DebugSSECommand'; + +procedure Register; +begin + try + RegisterPackageWizard(TJclSIMDWizard.Create); + except + on ExceptObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptObj); + raise; + end; + end; +end; + +var + JCLWizardIndex: Integer = -1; + +procedure JclWizardTerminate; +var + OTAWizardServices: IOTAWizardServices; +begin + try + if JCLWizardIndex <> -1 then + begin + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + OTAWizardServices.RemoveWizard(JCLWizardIndex); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + end; + end; +end; + +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean stdcall; +var + OTAWizardServices: IOTAWizardServices; +begin + try + TerminateProc := JclWizardTerminate; + + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + JCLWizardIndex := OTAWizardServices.AddWizard(TJclSIMDWizard.Create); + + Result := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + Result := False; + end; + end; +end; + +//=== { TJclSIMDWizard } ===================================================== + +constructor TJclSIMDWizard.Create; +begin + inherited Create(JclSIMDExpertName); + FCpuInfoValid := False; + FForm := nil; +end; + +destructor TJclSIMDWizard.Destroy; +begin + DebuggerServices.RemoveNotifier(FIndex); + //FreeAndNil(FDebuggerNotifier); // Buggy !!!! + FreeAndNil(FForm); + FDebuggerServices := nil; + + inherited Destroy; +end; + +procedure TJclSIMDWizard.SIMDActionExecute(Sender: TObject); +begin + try + if CpuInfo.SSE = 0 then + raise EJclExpertException.CreateTrace(RsNoSSE); + + if not Assigned(FForm) then + begin + FForm := TJclSIMDViewFrm.Create(Application, DebuggerServices, Settings); + + FForm.Icon := FIcon; + FForm.OnDestroy := FormDestroy; + FForm.SIMDCaption := GetSIMDString; + + FForm.Show; + end + else + FForm.Show; + except + on ExceptObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptObj); + raise; + end; + end; +end; + +procedure TJclSIMDWizard.SIMDActionUpdate(Sender: TObject); +var + AProcess: IOTAProcess; + AThread: IOTAThread; + AAction: TAction; +begin + try + AAction := Sender as TAction; + + if (CpuInfo.SSE <> 0) or CPUInfo.MMX or CPUInfo._3DNow then + begin + AThread := nil; + AProcess := nil; + if DebuggerServices.ProcessCount > 0 then + AProcess := DebuggerServices.CurrentProcess; + if (AProcess <> nil) and (AProcess.ThreadCount > 0) then + AThread := AProcess.CurrentThread; + if AThread <> nil then + AAction.Enabled := AThread.State in [tsStopped, tsBlocked] + else + AAction.Enabled := False; + end + else + AAction.Enabled := False + except + on ExceptObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptObj); + raise; + end; + end; +end; + +procedure TJclSIMDWizard.CloseForm; +begin + if Assigned(FForm) then + FForm.Close; +end; + +function TJclSIMDWizard.CpuInfo: TCpuInfo; +begin + if not FCpuInfoValid then + begin + GetCpuInfo(FCpuInfo); + FCpuInfoValid := True; + end; + + Result := FCpuInfo; +end; + +procedure TJclSIMDWizard.RegisterCommands; +var + I: Integer; + IDEMenu: TMenu; + ViewMenu: TMenuItem; + Category: string; +begin + inherited RegisterCommands; + + Supports(Services, IOTADebuggerServices, FDebuggerServices); + if not Assigned(FDebuggerServices) then + raise EJclExpertException.CreateTrace(RsENoDebuggerServices); + + Category := ''; + for I := 0 to NTAServices.ActionList.ActionCount - 1 do + if CompareText(NTAServices.ActionList.Actions[I].Name, 'DebugCPUCommand') = 0 then + Category := NTAServices.ActionList.Actions[I].Category; + + FIcon := TIcon.Create; + FIcon.Handle := LoadIcon(FindResourceHInstance(ModuleHInstance), 'SIMDICON'); + + FSIMDAction := TAction.Create(nil); + FSIMDAction.Caption := RsSIMD; + FSIMDAction.Visible := True; + FSIMDAction.OnExecute := SIMDActionExecute; + FSIMDAction.OnUpdate := SIMDActionUpdate; + FSIMDAction.Category := Category; + FSIMDAction.Name := RsSIMDActionName; + FSIMDAction.ImageIndex := NTAServices.ImageList.AddIcon(FIcon); + FSIMDAction.ActionList := NTAServices.ActionList; + FSIMDAction.ShortCut := Shortcut(Ord('D'), [ssCtrl, ssAlt]); + + FSIMDMenuItem := TMenuItem.Create(nil); + FSIMDMenuItem.Action := FSIMDAction; + + IDEMenu := NTAServices.MainMenu; + if not Assigned(IDEMenu) then + raise EJclExpertException.CreateTrace(RsENoIDEMenu); + + ViewMenu := nil; + for I := 0 to IDEMenu.Items.Count - 1 do + if CompareText(IDEMenu.Items[I].Name, 'ViewsMenu') = 0 then + ViewMenu := IDEMenu.Items[I]; + if not Assigned(ViewMenu) then + raise EJclExpertException.CreateTrace(RsENoViewMenuItem); + + FViewDebugMenu := nil; + for I := 0 to ViewMenu.Count - 1 do + if CompareText(ViewMenu.Items[I].Name, 'ViewDebugItem') = 0 then + FViewDebugMenu := ViewMenu.Items[I]; + if not Assigned(FViewDebugMenu) then + raise EJclExpertException.CreateTrace(RsENoDebugWindowsMenuItem); + + FViewDebugMenu.Add(FSIMDMenuItem); + + RegisterAction(FSIMDAction); + + FDebuggerNotifier := TJclDebuggerNotifier.Create(Self); + FIndex := DebuggerServices.AddNotifier(FDebuggerNotifier); +end; + +procedure TJclSIMDWizard.UnregisterCommands; +begin + inherited UnregisterCommands; + + UnregisterAction(FSIMDAction); + FreeAndNil(FIcon); + FreeAndNil(FSIMDMenuItem); + FreeAndNil(FSIMDAction); +end; + +procedure TJclSIMDWizard.FormDestroy(Sender: TObject); +begin + FForm := nil; +end; + +function TJclSIMDWizard.GetSIMDString: string; + + function Concat(LeftValue, RightValue: string): string; + begin + if LeftValue = '' then + Result := RightValue + else + Result := LeftValue + ',' + RightValue; + end; + +begin + Result := ''; + with CpuInfo do + begin + if MMX then + Result := RsMMX; + if ExMMX then + Result := Concat(Result, RsExMMX); + if _3DNow then + Result := Concat(Result, Rs3DNow); + if Ex3DNow then + Result := Concat(Result, RsEx3DNow); + if SSE >= 1 then + Result := Concat(Result, RsSSE1); + if SSE >= 2 then + Result := Concat(Result, RsSSE2); + if SSE >= 3 then + Result := Concat(Result, RsSSE3); + if Is64Bits then + Result := Result + ',' + RsLong; + end; +end; + +procedure TJclSIMDWizard.RefreshThreadContext(WriteOldContext: Boolean); +begin + if Assigned(FForm) then + if WriteOldContext then + FForm.SetThreadValues + else + FForm.GetThreadValues; +end; + +procedure TJclSIMDWizard.ThreadEvaluate(const ExprStr, ResultStr: string; ReturnCode: Integer); +begin + if Assigned(FForm) then + FForm.ThreadEvaluate(ExprStr, ResultStr, ReturnCode); +end; + +//=== { TJclDebuggerNotifier } =============================================== + +constructor TJclDebuggerNotifier.Create(AOwner: TJclSIMDWizard); +begin + inherited Create; + + FOwner := AOwner; + FProcessList := TList.Create; + FThreadList := TList.Create; +end; + +destructor TJclDebuggerNotifier.Destroy; +var + AThreadReference: PThreadReference; + AProcessReference: PProcessReference; +begin + while FThreadList.Count > 0 do + begin + AThreadReference := PThreadReference(FThreadList.Items[0]); + AThreadReference.Thread.RemoveNotifier(AThreadReference.ID); + FThreadList.Remove(AThreadReference); + Dispose(AThreadReference); + end; + while FProcessList.Count > 0 do + begin + AProcessReference := PProcessReference(FProcessList.Items[0]); + AProcessReference.Process.RemoveNotifier(AProcessReference.ID); + FProcessList.Remove(AProcessReference); + Dispose(AProcessReference); + end; + FThreadList.Free; + FProcessList.Free; + + inherited Destroy; +end; + +procedure TJclDebuggerNotifier.BreakpointAdded({$IFDEF RTL170_UP} const {$ENDIF} Breakpoint: IOTABreakpoint); +begin + +end; + +procedure TJclDebuggerNotifier.BreakpointDeleted({$IFDEF RTL170_UP} const {$ENDIF} Breakpoint: IOTABreakpoint); +begin + +end; + +procedure TJclDebuggerNotifier.EvaluteComplete(const ExprStr, ResultStr: string; + CanModify: Boolean; ResultAddress, ResultSize: LongWord; ReturnCode: Integer); +begin + try + Owner.ThreadEvaluate(ExprStr, ResultStr, ReturnCode); + except + on ExceptObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptObj); + raise; + end; + end; +end; + +function TJclDebuggerNotifier.FindProcessReference(AProcess: IOTAProcess): PProcessReference; +var + Index: Integer; +begin + for Index := 0 to FProcessList.Count - 1 do + begin + Result := PProcessReference(FProcessList.Items[Index]); + if Result.Process = AProcess then + Exit; + end; + Result := nil; +end; + +function TJclDebuggerNotifier.FindThreadReference(AThread: IOTAThread): PThreadReference; +var + Index: Integer; +begin + for Index := 0 to FThreadList.Count - 1 do + begin + Result := PThreadReference(FThreadList.Items[Index]); + if Result.Thread = AThread then + Exit; + end; + Result := nil; +end; + +procedure TJclDebuggerNotifier.ModifyComplete(const ExprStr, ResultStr: string; ReturnCode: Integer); +begin + +end; + +procedure TJclDebuggerNotifier.ProcessCreated({$IFDEF RTL170_UP} const {$ENDIF} Process: IOTAProcess); +var + AProcessReference: PProcessReference; +begin + try + AProcessReference := FindProcessReference(Process); + if AProcessReference = nil then + begin + New(AProcessReference); + AProcessReference.Process := Process; + AProcessReference.ID := Process.AddNotifier(Self); + FProcessList.Add(AProcessReference); + end; + except + on ExceptObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptObj); + raise; + end; + end; +end; + +procedure TJclDebuggerNotifier.ProcessDestroyed({$IFDEF RTL170_UP} const {$ENDIF} Process: IOTAProcess); +var + AProcessReference: PProcessReference; + AThreadReference: PThreadReference; + Index: Integer; +begin + try + for Index := 0 to Process.ThreadCount - 1 do + begin + AThreadReference := FindThreadReference(Process.Threads[Index]); + if AThreadReference <> nil then + begin + AThreadReference.Thread.RemoveNotifier(AThreadReference.ID); + FThreadList.Remove(AThreadReference); + Dispose(AThreadReference); + end; + end; + + AProcessReference := FindProcessReference(Process); + if AProcessReference <> nil then + begin + AProcessReference.Process.RemoveNotifier(AProcessReference.ID); + FProcessList.Remove(AProcessReference); + Dispose(AProcessReference); + end; + + if Owner.DebuggerServices.ProcessCount = 1 then + Owner.CloseForm; + except + on ExceptObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptObj); + raise; + end; + end; +end; + +procedure TJclDebuggerNotifier.ProcessModuleCreated( + {$IFDEF RTL170_UP} const {$ENDIF} ProcessModule: IOTAProcessModule); +begin + +end; + +procedure TJclDebuggerNotifier.ProcessModuleDestroyed({$IFDEF RTL170_UP} const {$ENDIF} ProcessModule: IOTAProcessModule); +begin + +end; + +procedure TJclDebuggerNotifier.ThreadCreated({$IFDEF RTL170_UP} const {$ENDIF} Thread: IOTAThread); +var + AThreadReference: PThreadReference; +begin + try + AThreadReference := FindThreadReference(Thread); + if AThreadReference = nil then + begin + New(AThreadReference); + AThreadReference.Thread := Thread; + AThreadReference.ID := Thread.AddNotifier(Self); + FThreadList.Add(AThreadReference); + end; + except + on ExceptObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptObj); + raise; + end; + end; +end; + +procedure TJclDebuggerNotifier.ThreadDestroyed({$IFDEF RTL170_UP} const {$ENDIF} Thread: IOTAThread); +var + AThreadReference: PThreadReference; +begin + try + AThreadReference := FindThreadReference(Thread); + if AThreadReference <> nil then + begin + AThreadReference.Thread.RemoveNotifier(AThreadReference.ID); + FThreadList.Remove(AThreadReference); + Dispose(AThreadReference); + end; + except + on ExceptObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptObj); + raise; + end; + end; +end; + +procedure TJclDebuggerNotifier.ThreadNotify(Reason: TOTANotifyReason); +begin + try + Owner.RefreshThreadContext(False); //Reason = nrRunning); + except + on ExceptObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptObj); + raise; + end; + end; +end; + +// History: + +// $Log: JclSIMDView.pas,v $ +// Revision 1.10 2006/01/08 17:16:56 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.9 2005/12/26 18:03:40 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.8 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.7 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/simdview/JclSIMDViewForm.dfm b/official/1.96/experts/debug/simdview/JclSIMDViewForm.dfm new file mode 100644 index 0000000..dff67d1 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDViewForm.dfm @@ -0,0 +1,184 @@ +object JclSIMDViewFrm: TJclSIMDViewFrm + Left = 67 + Top = 78 + ClientHeight = 278 + ClientWidth = 429 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter: TSplitter + Left = 371 + Top = 0 + Height = 278 + Align = alRight + end + object ListBoxRegs: TListBox + Left = 0 + Top = 0 + Width = 371 + Height = 278 + Style = lbOwnerDrawFixed + Align = alClient + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Courier New' + Font.Style = [] + ItemHeight = 16 + ParentFont = False + PopupMenu = PopupMenuRegs + TabOrder = 0 + OnDrawItem = ListBoxRegsDrawItem + OnMouseDown = ListBoxesMouseDown + end + object ListBoxMXCSR: TListBox + Left = 374 + Top = 0 + Width = 55 + Height = 278 + Style = lbOwnerDrawFixed + Align = alRight + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Courier New' + Font.Style = [] + ItemHeight = 16 + ParentFont = False + PopupMenu = PopupMenuMXCSR + TabOrder = 1 + OnDrawItem = ListBoxMXCSRDrawItem + OnMouseDown = ListBoxesMouseDown + OnMouseMove = ListBoxMXCSRMouseMove + end + object PopupMenuRegs: TPopupMenu + Left = 64 + Top = 48 + object MenuItemDisplay: TMenuItem + Caption = '&Display' + object MenuItemBytes: TMenuItem + Caption = '&Bytes' + ShortCut = 16437 + OnClick = MenuItemDisplayClick + end + object MenuItemWords: TMenuItem + Caption = '&Words' + ShortCut = 16438 + OnClick = MenuItemDisplayClick + end + object MenuItemDWords: TMenuItem + Caption = '&Double Words' + ShortCut = 16439 + OnClick = MenuItemDisplayClick + end + object MenuItemQWords: TMenuItem + Caption = '&Quads Words' + ShortCut = 16440 + OnClick = MenuItemDisplayClick + end + object MenuItemSeparator1: TMenuItem + Caption = '-' + end + object MenuItemSingles: TMenuItem + Caption = '&Singles' + ShortCut = 16441 + OnClick = MenuItemDisplayClick + end + object MenuItemDoubles: TMenuItem + Caption = '&Doubles' + ShortCut = 16432 + OnClick = MenuItemDisplayClick + end + end + object MenuItemFormat: TMenuItem + Caption = '&Format' + object MenuItemBinary: TMenuItem + Caption = '&Binary' + ShortCut = 16433 + OnClick = MenuItemFormatClick + end + object MenuItemSigned: TMenuItem + Caption = '&Signed decimal' + ShortCut = 16434 + OnClick = MenuItemFormatClick + end + object MenuItemUnsigned: TMenuItem + Caption = '&Unsigned decimal' + ShortCut = 16435 + OnClick = MenuItemFormatClick + end + object MenuItemHexa: TMenuItem + Caption = '&Hexadecimal' + ShortCut = 16436 + OnClick = MenuItemFormatClick + end + end + object MenuItemModify: TMenuItem + Action = ActionModify + end + object MenuItemEmptyMM: TMenuItem + Action = ActionEmpty + end + object MenuItemEmptyAll: TMenuItem + Action = ActionEmptyAll + end + object MenuItemSeparator2: TMenuItem + Caption = '-' + end + object MenuItemStayOnTop: TMenuItem + Action = ActionStayOnTop + end + object MenuItemCpuInfo: TMenuItem + Caption = 'CPU Informations...' + OnClick = MenuItemCpuInfoClick + end + end + object PopupMenuMXCSR: TPopupMenu + Left = 384 + Top = 48 + object MenuItemComplement: TMenuItem + Action = ActionComplement + end + end + object ActionListOptions: TActionList + Left = 120 + Top = 48 + object ActionStayOnTop: TAction + Caption = '&Stay on top' + OnExecute = ActionStayOnTopExecute + OnUpdate = ActionStayOnTopUpdate + end + object ActionModify: TAction + Caption = '&Modify' + OnExecute = ActionModifyExecute + OnUpdate = ActionModifyUpdate + end + object ActionComplement: TAction + Caption = '&Complement bit' + ShortCut = 16468 + OnExecute = ActionComplementExecute + OnUpdate = ActionComplementUpdate + end + object ActionEmpty: TAction + Caption = '&Empty MM register' + OnExecute = ActionEmptyExecute + OnUpdate = ActionEmptyUpdate + end + object ActionEmptyAll: TAction + Caption = 'Empty &all MM registers' + OnExecute = ActionEmptyAllExecute + OnUpdate = ActionEmptyAllUpdate + end + end +end diff --git a/official/1.96/experts/debug/simdview/JclSIMDViewForm.pas b/official/1.96/experts/debug/simdview/JclSIMDViewForm.pas new file mode 100644 index 0000000..5da5278 --- /dev/null +++ b/official/1.96/experts/debug/simdview/JclSIMDViewForm.pas @@ -0,0 +1,982 @@ +{**************************************************************************************************} +{ } +{ 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: JvSIMDViewForm.pas, released on 2004-10-11. } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet } +{ [ouchet dott florent att laposte dott net] } +{ Portions created by Florent Ouchet are Copyright (C) 2004 Florent Ouchet. } +{ All Rights Reserved. } +{ } +{ You may retrieve the latest version of this file at the Project JEDI's JCL home page, } +{ located at http://jcl.sourceforge.net } +{ } +{**************************************************************************************************} + +// $Id: JclSIMDViewForm.pas,v 1.9 2006/01/08 17:16:56 outchy Exp $ + +unit JclSIMDViewForm; + +{$I jcl.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ToolsApi, Grids, ExtCtrls, Menus, ActnList, + JclOtaUtils, JclSysInfo, JclSIMDUtils, JclSIMDModifyForm; + +type + TJclSIMDViewFrm = class(TForm) + Splitter: TSplitter; + ListBoxRegs: TListBox; + ListBoxMXCSR: TListBox; + PopupMenuRegs: TPopupMenu; + PopupMenuMXCSR: TPopupMenu; + MenuItemComplement: TMenuItem; + MenuItemBinary: TMenuItem; + MenuItemSigned: TMenuItem; + MenuItemUnsigned: TMenuItem; + MenuItemHexa: TMenuItem; + MenuItemDisplay: TMenuItem; + MenuItemFormat: TMenuItem; + MenuItemBytes: TMenuItem; + MenuItemWords: TMenuItem; + MenuItemDWords: TMenuItem; + MenuItemQWords: TMenuItem; + MenuItemSeparator1: TMenuItem; + MenuItemSingles: TMenuItem; + MenuItemDoubles: TMenuItem; + MenuItemSeparator2: TMenuItem; + MenuItemStayOnTop: TMenuItem; + MenuItemModify: TMenuItem; + MenuItemCpuInfo: TMenuItem; + ActionListOptions: TActionList; + ActionStayOnTop: TAction; + ActionModify: TAction; + ActionComplement: TAction; + ActionEmpty: TAction; + ActionEmptyAll: TAction; + MenuItemEmptyMM: TMenuItem; + MenuItemEmptyAll: TMenuItem; + procedure FormDestroy(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure ListBoxMXCSRDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); + procedure ListBoxMXCSRMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); + procedure ListBoxRegsDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); + procedure MenuItemFormatClick(Sender: TObject); + procedure MenuItemDisplayClick(Sender: TObject); + procedure MenuItemCpuInfoClick(Sender: TObject); + procedure ActionStayOnTopUpdate(Sender: TObject); + procedure ActionStayOnTopExecute(Sender: TObject); + procedure ActionModifyUpdate(Sender: TObject); + procedure ActionModifyExecute(Sender: TObject); + procedure ActionComplementExecute(Sender: TObject); + procedure ActionComplementUpdate(Sender: TObject); + procedure ActionEmptyUpdate(Sender: TObject); + procedure ActionEmptyAllUpdate(Sender: TObject); + procedure ActionEmptyExecute(Sender: TObject); + procedure ActionEmptyAllExecute(Sender: TObject); + procedure ListBoxesMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + private + FDebuggerServices: IOTADebuggerServices; + FVectorFrame: TJclVectorFrame; + FDisplay: TJclXMMContentType; + FFormat: TJclSIMDFormat; + FCpuInfo: TCpuInfo; + FSIMDCaption: string; + FNbMMRegister: Integer; + FNbXMMRegister: Integer; + FOldThreadID: LongWord; + FOldThreadState: TOTAThreadState; + FModifyForm: TJclSIMDModifyFrm; + FMXCSRChanged: array [TMXCSRRange] of Boolean; + FRegisterChanged: array of Boolean; + FSettings: TJclOtaSettings; + procedure SetDisplay(const Value: TJclXMMContentType); + procedure SetFormat(const Value: TJclSIMDFormat); + protected + procedure DoClose(var Action: TCloseAction); override; + procedure UpdateActions; override; + procedure CreateParams(var Params: TCreateParams); override; + public + constructor Create(AOwner: TComponent; ADebuggerServices: IOTADebuggerServices; + ASettings: TJclOtaSettings); reintroduce; + destructor Destroy; override; + procedure ThreadEvaluate(const ExprStr, ResultStr: string; ReturnCode: Integer); + procedure SetThreadValues; + procedure GetThreadValues; + property CpuInfo: TCpuInfo read FCpuInfo; + property Format: TJclSIMDFormat read FFormat write SetFormat; + property Display: TJclXMMContentType read FDisplay write SetDisplay; + property SIMDCaption: string read FSIMDCaption write FSIMDCaption; + property DebuggerServices: IOTADebuggerServices read FDebuggerServices; + property NbMMRegister: Integer read FNbMMRegister; + property NbXMMRegister: Integer read FNbXMMRegister; + property Settings: TJclOtaSettings read FSettings; + end; + +implementation + +uses + TypInfo, + JclOtaResources, JclOtaConsts, + JclSIMDCpuInfo; + +{$R *.dfm} + +constructor TJclSIMDViewFrm.Create(AOwner: TComponent; + ADebuggerServices: IOTADebuggerServices; ASettings: TJclOTASettings); +var + I: TMXCSRRange; + J: Integer; +begin + inherited Create(AOwner); + + FDebuggerServices := ADebuggerServices; + FOldThreadID := 0; + FOldThreadState := tsNone; + FSettings := ASettings; + + JclSysInfo.GetCpuInfo(FCpuInfo); + + // the behaviour of Delphi and C++Builder overrides all changes made on + // the floating point context of the debugged thread when it is run + // (even using step into and step over). + // to be uncommented as soon as Borland changes this behaviour + {if CpuInfo.MMX or CPUInfo._3DNow then + FNbMMRegister := 8 + else + FNbMMRegister := 0;} + + FNbMMRegister := 0; + + if CpuInfo.SSE = 0 then + FNbXMMRegister := 0 + else + if CpuInfo.Is64Bits then + FNbXMMRegister := 17 + else + FNbXMMRegister := 9; + + ListBoxMXCSR.Items.Clear; + with CpuInfo do + for I := Low(TMXCSRRange) to High(TMXCSRRange) do + ListBoxMXCSR.Items.Add('0'); + ListBoxRegs.Items.Clear; + + SetLength(FRegisterChanged,NbMMRegister + NbXMMRegister); + for J := 0 to NbMMRegister + NbXMMRegister - 1 do + // MM registers (MMX) + XMM registers (SSE) + 1 cardinal (MXCSR) + ListBoxRegs.Items.Add(''); + + MenuItemBinary.Tag := Integer(sfBinary); + MenuItemSigned.Tag := Integer(sfSigned); + MenuItemUnsigned.Tag := Integer(sfUnsigned); + MenuItemHexa.Tag := Integer(sfHexa); + MenuItemBytes.Tag := Integer(xt16Bytes); + MenuItemWords.Tag := Integer(xt8Words); + MenuItemDWords.Tag := Integer(xt4DWords); + MenuItemQWords.Tag := Integer(xt2QWords); + MenuItemSingles.Tag := Integer(xt4Singles); + MenuItemDoubles.Tag := Integer(xt2Doubles); + + Format := sfHexa; + Display := xt8Words; + + GetThreadValues; +end; + +procedure TJclSIMDViewFrm.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + + // Fixing the Window Ghosting "bug" + Params.Style := params.Style or WS_POPUP; + if Assigned(Screen.ActiveForm) then + Params.WndParent := Screen.ActiveForm.Handle + else if Assigned (Application.MainForm) then + Params.WndParent := Application.MainForm.Handle + else + Params.WndParent := Application.Handle; +end; + +destructor TJclSIMDViewFrm.Destroy; +begin + SetLength(FRegisterChanged,0); + FDebuggerServices := nil; + + inherited Destroy; +end; + +procedure TJclSIMDViewFrm.ListBoxMXCSRDrawItem(Control: TWinControl; + Index: Integer; Rect: TRect; State: TOwnerDrawState); +begin + try + with (Control as TListBox), Canvas do + begin + if not (odFocused in State) then + begin + Pen.Color := Brush.Color; + if odSelected in State then + Font.Color := clWindow; + end; + Rectangle(Rect); + TextOut(Rect.Left + 2, Rect.Top, MXCSRBitsDescriptions[Index].ShortName); + if FMXCSRChanged[Index] then + Font.Color := clRed; + TextOut(Rect.Left + 2 + TextExtent(MXCSRBitsDescriptions[Index].ShortName).cx, Rect.Top, Items[Index]); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ListBoxMXCSRMouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +var + AIndex: Integer; + AText: string; +begin + try + if Shift <> [] then + Application.HideHint + else + with Sender as TListBox do + begin + AIndex := ItemAtPos(Point(X,Y),True); + if (AIndex >= 0) and (AIndex < Items.Count) then + begin + with MXCSRBitsDescriptions[AIndex] do + begin + AText := LongName; + if AndMask = MXCSR_RC then + case (FVectorFrame.MXCSR and AndMask) shr Shifting of + 0: + AText := SysUtils.Format('%s (%s)', [AText, RsRoundToNearest]); + 1: + AText := SysUtils.Format('%s (%s)', [AText, RsRoundDown]); + 2: + AText := SysUtils.Format('%s (%s)', [AText, RsRoundUp]); + 3: + AText := SysUtils.Format('%s (%s)', [AText, RsRoundTowardZero]); + end; + if AText <> Hint then + begin + Hint := AText; + Application.HideHint; + Application.ActivateHint(Point(X, Y)); + end; + end; + end + else + begin + Hint := ''; + Application.HideHint; + end; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ListBoxRegsDrawItem(Control: TWinControl; Index: Integer; + Rect: TRect; State: TOwnerDrawState); +var + AText: string; +begin + try + with (Control as TListBox), Canvas do + begin + if not (odFocused in State) then + begin + Pen.Color := Brush.Color; + if odSelected in State then + Font.Color := clWindow; + end; + Rectangle(Rect); + if Index < NbMMRegister then + AText := SysUtils.Format('MM%d ', [Index]) + else + if Index < NbMMRegister + NbXMMRegister - 1 then + begin + if CpuInfo.Is64Bits then + AText := SysUtils.Format('XMM%.2d ', [Index - NbMMRegister]) + else + AText := SysUtils.Format('XMM%d ', [Index - NbMMRegister]); + end + else + AText := 'MXCSR '; + TextOut(Rect.Left + 2, Rect.Top, AText); + if FRegisterChanged[Index] then + Font.Color := clRed; + TextOut(Rect.Left + 2 + TextExtent(AText).cx, Rect.Top, Items[Index]); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.GetThreadValues; +var + NewVectorFrame: TJclVectorFrame; + NewBitValue, OldBitValue: Cardinal; + Index: Integer; + AProcess: IOTAProcess; + AThread: IOTAThread; + + function ChangedFlag(const Value1, Value2: TJclXMMRegister): Boolean; overload; + begin + Result := (Value1.QWords[0] <> Value2.QWords[0]) or (Value1.QWords[1] <> Value2.QWords[1]); + end; + + function ChangedFlag(const Value1, Value2: TJclMMRegister): Boolean; overload; + begin + Result := Value1.QWords <> Value2.QWords; + end; + + function FormatReg(const AReg: TJclXMMRegister): string; overload; + var + I: Integer; + Value: TJclSIMDValue; + begin + Result := ''; + Value.Display := Display; + case Display of + xt16Bytes: + for I := High(AReg.Bytes) downto Low(AReg.Bytes) do + begin + Value.ValueByte := AReg.Bytes[I]; + Result := Result + ' ' + FormatValue(Value, Format); + end; + xt8Words: + for I := High(AReg.Words) downto Low(AReg.Words) do + begin + Value.ValueWord := AReg.Words[I]; + Result := Result + ' ' + FormatValue(Value, Format); + end; + xt4DWords: + for I := High(AReg.DWords) downto Low(AReg.DWords) do + begin + Value.ValueDWord := AReg.DWords[I]; + Result := Result + ' ' + FormatValue(Value, Format); + end; + xt2QWords: + for I := High(AReg.QWords) downto Low(AReg.QWords) do + begin + Value.ValueQWord := AReg.QWords[I]; + Result := Result + ' ' + FormatValue(Value, Format); + end; + xt4Singles: + for I := High(AReg.Singles) downto Low(AReg.Singles) do + begin + Value.ValueSingle := AReg.Singles[I]; + Result := Result + ' ' + FormatValue(Value, sfBinary); + end; + xt2Doubles: + for I := High(AReg.Doubles) downto Low(AReg.Doubles) do + begin + Value.ValueDouble := AReg.Doubles[I]; + Result := Result + ' ' + FormatValue(Value, sfBinary); + end; + end; + end; + + function FormatReg(const AReg: TJclFPUData; Index: Cardinal): string; overload; + var + I: Integer; + Value: TJclSIMDValue; + begin + Result := ''; + Value.Display := Display; + + if (AReg.Reserved = $FFFF) and ((NewVectorFrame.FTW and (1 shl Index)) <> 0) then + case Display of + xt16Bytes: + for I := High(AReg.MMRegister.Bytes) downto Low(AReg.MMRegister.Bytes) do + begin + Value.ValueByte := AReg.MMRegister.Bytes[I]; + Result := Result + ' ' + FormatValue(Value, Format); + end; + xt8Words: + for I := High(AReg.MMRegister.Words) downto Low(AReg.MMRegister.Words) do + begin + Value.ValueWord := AReg.MMRegister.Words[I]; + Result := Result + ' ' + FormatValue(Value, Format); + end; + xt4DWords: + for I := High(AReg.MMRegister.DWords) downto Low(AReg.MMRegister.DWords) do + begin + Value.ValueDWord := AReg.MMRegister.DWords[I]; + Result := Result + ' ' + FormatValue(Value, Format); + end; + xt2QWords: + begin + Value.ValueQWord := AReg.MMRegister.QWords; + Result := FormatValue(Value, Format); + end; + xt4Singles: + for I := High(AReg.MMRegister.Singles) downto Low(AReg.MMRegister.Singles) do + begin + Value.ValueSingle := AReg.MMRegister.Singles[I]; + Result := Result + ' ' + FormatValue(Value, sfBinary); + end; + xt2Doubles: + Result := RsNotSupportedFormat; + end + else + Result := RsNoPackedData; + end; + +begin + AProcess := nil; + AThread := nil; + if DebuggerServices.ProcessCount > 0 then + AProcess := DebuggerServices.CurrentProcess; + if (AProcess <> nil) and (AProcess.ThreadCount > 0) then + AThread := AProcess.CurrentThread; + + if (AThread = nil) or (AThread.State = tsNone) or + (AThread.GetOSThreadID = 0) or (AThread.Handle = 0) then + begin + Close; + Exit; + end; + + case AThread.State of + tsStopped: + begin + if DebuggerServices.CurrentProcess.ThreadCount > 1 then + Caption := SysUtils.Format('%s Thread : %d', [SIMDCaption,AThread.GetOSThreadID]) + else + Caption := SIMDCaption; + + GetVectorContext(AThread,NewVectorFrame); + + for Index := 0 to ListBoxMXCSR.Items.Count - 1 do + with ListBoxMXCSR, Items, MXCSRBitsDescriptions[Index] do + begin + NewBitValue := NewVectorFrame.MXCSR and AndMask; + OldBitValue := FVectorFrame.MXCSR and AndMask; + FMXCSRChanged[Index] := NewBitValue <> OldBitValue; + Strings[Index] := IntToStr(NewBitValue shr Shifting); + end; + ListBoxMXCSR.Invalidate; + + for Index := 0 to NbMMRegister - 1 do + begin + FRegisterChanged[Index] := ChangedFlag(NewVectorFrame.FPURegisters[Index].Data.MMRegister, + FVectorFrame.FPURegisters[Index].Data.MMRegister); + ListBoxRegs.Items.Strings[Index] := FormatReg(NewVectorFrame.FPURegisters[Index].Data, Index); + end; + + if FNbXMMRegister > 0 then + begin + for Index := 0 to FNbXMMRegister - 2 do + begin + FRegisterChanged[Index + NbMMRegister] := ChangedFlag(NewVectorFrame.XMMRegisters.LongXMM[Index], + FVectorFrame.XMMRegisters.LongXMM[Index]); + ListBoxRegs.Items.Strings[Index + NbMMRegister] := FormatReg(NewVectorFrame.XMMRegisters.LongXMM[Index]); + end; + + FRegisterChanged[NbMMRegister + NbXMMRegister - 1] := NewVectorFrame.MXCSR <> FVectorFrame.MXCSR; + ListBoxRegs.Items.Strings[NbMMRegister + NbXMMRegister - 1] := IntToHex(NewVectorFrame.MXCSR, 8); + end; + ListBoxRegs.Invalidate; + + FVectorFrame := NewVectorFrame; + end; + tsRunnable: + Caption := SysUtils.Format('%s ', [SIMDCaption]); + tsBlocked: + Caption := SysUtils.Format('%s ', [SIMDCaption]); + end; +end; + +procedure TJclSIMDViewFrm.SetThreadValues; +begin + if not SetVectorContext(DebuggerServices.CurrentProcess.CurrentThread,FVectorFrame) then + raise EJclExpertException.Create(RsECantUpdateThreadContext); +end; + +procedure TJclSIMDViewFrm.MenuItemFormatClick(Sender: TObject); +begin + try + Format := TJclSIMDFormat((Sender as TMenuItem).Tag); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.SetDisplay(const Value: TJclXMMContentType); +var + AEnabled: Boolean; +begin + FDisplay := Value; + MenuItemBytes.Checked := Value = xt16Bytes; + MenuItemWords.Checked := Value = xt8Words; + MenuItemDWords.Checked := Value = xt4DWords; + MenuItemQWords.Checked := Value = xt2QWords; + MenuItemSingles.Checked := Value = xt4Singles; + MenuItemDoubles.Checked := Value = xt2Doubles; + + AEnabled := not (Value in [xt4Singles, xt2Doubles]); + MenuItemBinary.Enabled := AEnabled; + MenuItemSigned.Enabled := AEnabled; + MenuItemUnsigned.Enabled := AEnabled; + MenuItemHexa.Enabled := AEnabled; + + GetThreadValues; +end; + +procedure TJclSIMDViewFrm.SetFormat(const Value: TJclSIMDFormat); +begin + FFormat := Value; + MenuItemBinary.Checked := Value = sfBinary; + MenuItemSigned.Checked := Value = sfSigned; + MenuItemUnsigned.Checked := Value = sfUnsigned; + MenuItemHexa.Checked := Value = sfHexa; + + GetThreadValues; +end; + +procedure TJclSIMDViewFrm.MenuItemDisplayClick(Sender: TObject); +begin + try + Display := TJclXMMContentType((Sender as TMenuItem).Tag); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.DoClose(var Action: TCloseAction); +begin + Action := caFree; +end; + +procedure TJclSIMDViewFrm.FormCreate(Sender: TObject); +begin + SetBounds( + Settings.LoadInteger('Left', Left), + Settings.LoadInteger('Top', Top), + Settings.LoadInteger('Width', Width), + Settings.LoadInteger('Height', Height)); + + if Left < 0 then + Left := 0; + if Top < 0 then + Top := 0; + if Width > Screen.Width then + Width := Screen.Width; + if (Left + Width) > Screen.DesktopWidth then + Left := Screen.DesktopWidth - Width; + if Height > Screen.Height then + Height := Screen.Height; + if (Top + Height) > Screen.DesktopHeight then + Top := Screen.DesktopHeight - Height; + + Format := TJclSIMDFormat(GetEnumValue(TypeInfo(TJclSIMDFormat), + Settings.LoadString('Format', GetEnumName(TypeInfo(TJclSIMDFormat), Integer(sfHexa))))); + Display := TJclXMMContentType(GetEnumValue(TypeInfo(TJclXMMContentType), + Settings.LoadString('Display', GetEnumName(TypeInfo(TJclXMMContentType), Integer(xt8Words))))); + + if Settings.LoadInteger('StayOnTop', 0) = 1 then + FormStyle := fsStayOnTop + else + FormStyle := fsNormal; +end; + +procedure TJclSIMDViewFrm.FormDestroy(Sender: TObject); +begin + Settings.SaveInteger('Left', Left); + Settings.SaveInteger('Top', Top); + Settings.SaveInteger('Width', Width); + Settings.SaveInteger('Height', Height); + Settings.SaveString('Display', GetEnumName(TypeInfo(TJclXMMContentType), Integer(Display))); + Settings.SaveString('Format', GetEnumName(TypeInfo(TJclSIMDFormat), Integer(Format))); + Settings.SaveInteger('StayOnTop', Ord(FormStyle = fsStayOnTop)); +end; + +procedure TJclSIMDViewFrm.MenuItemCpuInfoClick(Sender: TObject); +var + FormCPUInfo: TJclFormCpuInfo; +begin + try + FormCPUInfo := TJclFormCpuInfo.Create(Self); + try + FormCPUInfo.Execute(CpuInfo); + finally + FormCPUInfo.Free; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.UpdateActions; +var + CurrentThreadID: Cardinal; + AProcess: IOTAProcess; + AThread: IOTAThread; + ANewThreadState: TOTAThreadState; +begin + inherited UpdateActions; + + CurrentThreadID := 0; + AProcess := nil; + AThread := nil; + + if DebuggerServices.ProcessCount > 0 then + AProcess := DebuggerServices.CurrentProcess; + if (AProcess <> nil) and (AProcess.ThreadCount > 0) then + AThread := AProcess.CurrentThread; + if AThread <> nil then + begin + ANewThreadState := AThread.State; + if ANewThreadState in [tsStopped, tsBlocked] then + CurrentThreadID := AThread.GetOSThreadID; + if (CurrentThreadID <> 0) and ((CurrentThreadID <> FOldThreadID) or (ANewThreadState <> FOldThreadState)) then + begin + FOldThreadID := CurrentThreadID; + FOldThreadState := ANewThreadState; + GetThreadValues; + end; + end; +end; + +procedure TJclSIMDViewFrm.ThreadEvaluate(const ExprStr, ResultStr: string; + ReturnCode: Integer); +begin + if Assigned(FModifyForm) then + FModifyForm.ThreadEvaluate(ExprStr, ResultStr, ReturnCode); +end; + +procedure TJclSIMDViewFrm.ActionStayOnTopUpdate(Sender: TObject); +var + AAction: TAction; +begin + try + AAction := Sender as TAction; + AAction.Checked := FormStyle = fsStayOnTop; + AAction.Enabled := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ActionStayOnTopExecute(Sender: TObject); +begin + try + if FormStyle = fsStayOnTop then + FormStyle := fsNormal + else + FormStyle := fsStayOnTop; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ActionModifyUpdate(Sender: TObject); +var + AProcess: IOTAProcess; + AThread: IOTAThread; + AItemIndex: Integer; +begin + try + AProcess := DebuggerServices.CurrentProcess; + AThread := nil; + AItemIndex := ListBoxRegs.ItemIndex; + if NbXMMRegister > 0 then + Inc(AItemIndex); + + if Assigned(AProcess) then + AThread := AProcess.CurrentThread; + + (Sender as TAction).Enabled := Assigned(AThread) and (AThread.State = tsStopped) and + (AItemIndex >= 0) and (AItemIndex < (NbMMRegister + NbXMMRegister)); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ActionModifyExecute(Sender: TObject); +var + AItemIndex: Integer; +begin + try + AItemIndex := ListBoxRegs.ItemIndex; + if AItemIndex >= 0 then + try + FModifyForm := TJclSIMDModifyFrm.Create(Self, DebuggerServices, Settings); + FModifyForm.Icon.Assign(Self.Icon); + + if AItemIndex < NbMMRegister then + begin + FModifyForm.Caption := SysUtils.Format(RsModifyMM, [AItemIndex]); + if FModifyForm.Execute(DebuggerServices.CurrentProcess.CurrentThread, Display, + Format, FVectorFrame.FPURegisters[AItemIndex].Data.MMRegister ,FCpuInfo) then + begin + FVectorFrame.FPURegisters[AItemIndex].Data.Reserved := $FFFF; + FVectorFrame.FTW := FVectorFrame.FTW or (1 shl AItemIndex); + SetThreadValues; + GetThreadValues; + FRegisterChanged[AItemIndex] := True; + ListBoxRegs.Invalidate; + end; + end else + begin + if CpuInfo.Is64Bits then + FModifyForm.Caption := SysUtils.Format(RsModifyXMM2, [AItemIndex - NbMMRegister]) + else + FModifyForm.Caption := SysUtils.Format(RsModifyXMM1, [AItemIndex - NbMMRegister]); + if FModifyForm.Execute(DebuggerServices.CurrentProcess.CurrentThread, Display, + Format, FVectorFrame.XMMRegisters.LongXMM[AItemIndex - NbMMRegister], FCpuInfo) then + begin + SetThreadValues; + GetThreadValues; + FRegisterChanged[AItemIndex] := True; + ListBoxRegs.Invalidate; + end; + end; + finally + FreeAndNil(FModifyForm); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ActionEmptyUpdate(Sender: TObject); +var + AProcess: IOTAProcess; + AThread: IOTAThread; + AItemIndex: Integer; +begin + try + AProcess := DebuggerServices.CurrentProcess; + AThread := nil; + AItemIndex := ListBoxRegs.ItemIndex; + if Assigned(AProcess) then + AThread := AProcess.CurrentThread; + (Sender as TAction).Enabled := Assigned(AThread) and (AThread.State = tsStopped) and + (AItemIndex >= 0) and (AItemIndex < NbMMRegister) and + ((FVectorFrame.FTW and (1 shl AItemIndex)) <> 0) and + (FVectorFrame.FPURegisters[AItemIndex].Data.Reserved = $FFFF); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ActionEmptyExecute(Sender: TObject); +var + AItemIndex: Integer; +begin + try + AItemIndex := ListBoxRegs.ItemIndex; + FVectorFrame.FTW := FVectorFrame.FTW and not (1 shl AItemIndex); + FVectorFrame.FPURegisters[AItemIndex].Data.FloatValue := 0.0; + SetThreadValues; + GetThreadValues; + FRegisterChanged[AItemIndex] := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ActionEmptyAllUpdate(Sender: TObject); +var + AProcess: IOTAProcess; + AThread: IOTAThread; + AItemIndex: Integer; +begin + try + AProcess := DebuggerServices.CurrentProcess; + AThread := nil; + AItemIndex := ListBoxRegs.ItemIndex; + if Assigned(AProcess) then + AThread := AProcess.CurrentThread; + (Sender as TAction).Enabled := (AItemIndex >= 0) and (AItemIndex < NbMMRegister) and + Assigned(AThread) and (AThread.State = tsStopped); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ActionEmptyAllExecute(Sender: TObject); +var + Index: Integer; +begin + try + FVectorFrame.FTW := 0; + for Index := Low(FVectorFrame.FPURegisters) to High(FVectorFrame.FPURegisters) do + FVectorFrame.FPURegisters[Index].Data.FloatValue := 0.0; + SetThreadValues; + GetThreadValues; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ActionComplementUpdate(Sender: TObject); +begin + try + (Sender as TAction).Enabled := ListBoxMXCSR.ItemIndex >= 0; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ActionComplementExecute(Sender: TObject); +var + BitValue: Cardinal; + OldMXCSRValue: Cardinal; +begin + try + if ListBoxMXCSR.ItemIndex >= 0 then + with MXCSRBitsDescriptions[ListBoxMXCSR.ItemIndex] do + begin + OldMXCSRValue := FVectorFrame.MXCSR; + BitValue := (Cardinal(FVectorFrame.MXCSR) and AndMask) shr Shifting; + Inc(BitValue); + FVectorFrame.MXCSR := (FVectorFrame.MXCSR and (not AndMask)) or ((BitValue shl Shifting) and AndMask); + SetThreadValues; + FVectorFrame.MXCSR := OldMXCSRValue; + GetThreadValues; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclSIMDViewFrm.ListBoxesMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + AListBox: TListBox; +begin + try + if Button = mbRight then + begin + AListBox := Sender as TListBox; + AListBox.ItemIndex := AListBox.ItemAtPos(Point(X, Y), True); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +// History: + +// $Log: JclSIMDViewForm.pas,v $ +// Revision 1.9 2006/01/08 17:16:56 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.8 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.7 2005/12/04 10:10:57 obones +// Borland Developer Studio 2006 support +// +// Revision 1.6 2005/11/21 21:25:40 outchy +// Modified the get/set methods of thread context for Delphi 2005 +// +// Revision 1.5 2005/10/26 03:29:44 rrossmair +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and $Log: JclSIMDViewForm.pas,v $ +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.9 2006/01/08 17:16:56 outchy +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Settings reworked. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Common window for expert configurations +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.8 2005/12/16 23:46:25 outchy +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Added expert stack form. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Added code to display call stack on expert exception. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Fixed package extension for D2006. +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Revision 1.7 2005/12/04 10:10:57 obones +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and Borland Developer Studio 2006 support +// - improved header information, added $Date: 2006/01/08 17:16:56 $ and CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/threadnames/JclIdeThreadStatus.pas b/official/1.96/experts/debug/threadnames/JclIdeThreadStatus.pas new file mode 100644 index 0000000..1b996d0 --- /dev/null +++ b/official/1.96/experts/debug/threadnames/JclIdeThreadStatus.pas @@ -0,0 +1,200 @@ +{**************************************************************************************************} +{ } +{ 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 JclIdeThreadStatus.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{**************************************************************************************************} +{ } +{ Delphi IDE debugger Thread Status window extension. } +{ } +{ Unit owner: Petr Vones } +{ Last modified: $Date: 2005/10/26 03:29:44 $ } +{ } +{**************************************************************************************************} + +unit JclIdeThreadStatus; + +{$I jcl.inc} + +interface + +uses + Windows, Classes, SysUtils; + +procedure RegisterThread(ThreadID: DWORD; const ThreadName: string); overload; +procedure RegisterThread(Thread: TThread; const ThreadName: string; IncludeClassName: Boolean = True); overload; + +procedure UnregisterThread(ThreadID: DWORD); overload; +procedure UnregisterThread(Thread: TThread); overload; + +procedure ChangeThreadName(ThreadID: DWORD; const ThreadName: string); overload; +procedure ChangeThreadName(Thread: TThread; const ThreadName: string; IncludeClassName: Boolean = True); overload; + +function ThreadNamesAvailable: Boolean; + +implementation + +uses + JclDebug, JclPeImage, JclSysUtils, + ThreadExpertSharedNames; + +type + PThreadRec = ^TThreadRec; + TThreadRec = record + Func: TThreadFunc; + Parameter: Pointer; + end; + +var + SharedThreadNames: TSharedThreadNames; + HookImports: TJclPeMapImgHooks; + Kernel32_CreateThread: function(lpThreadAttributes: Pointer; + dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; + lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall; + Kernel32_ExitThread: procedure(dwExitCode: DWORD); stdcall; + {$IFDEF DELPHI7_UP} + Kernel32_ResumeThread: function(hThread: THandle): DWORD; stdcall; + {$ENDIF DELPHI7_UP} + +function NewCreateThread(lpThreadAttributes: Pointer; + dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; + lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall; +var + Instance: TObject; +begin + Result := Kernel32_CreateThread(lpThreadAttributes, dwStackSize, lpStartAddress, + lpParameter, dwCreationFlags, lpThreadId); + if (Result <> 0) and (lpParameter <> nil) then + try + Instance := PThreadRec(lpParameter)^.Parameter; + if Instance is TJclDebugThread then + RegisterThread(TJclDebugThread(Instance), TJclDebugThread(Instance).ThreadName, True) + else + if Instance is TThread then + RegisterThread(TThread(Instance), '', True); + except + end; +end; + +procedure NewExitThread(dwExitCode: DWORD); stdcall; +var + ThreadID: DWORD; +begin + ThreadID := GetCurrentThreadId; + try + UnregisterThread(ThreadID); + except + end; + Kernel32_ExitThread(dwExitCode); +end; + +{$IFDEF DELPHI7_UP} +function NewResumeThread(hThread: THandle): DWORD; stdcall; +begin + Result := Kernel32_ResumeThread(hThread); + if Result <= 1 then + try + SharedThreadNames.UpdateResumeStatus; + except + end; +end; +{$ENDIF DELPHI7_UP} + +function CreateThreadName(const ThreadName, ThreadClassName: string): string; +begin + if ThreadClassName <> '' then + begin + if ThreadName = '' then + Result := Format('[%s]', [ThreadClassName]) + else + Result := Format('[%s] "%s"', [ThreadClassName, ThreadName]); + end + else + Result := Format('"%s"', [ThreadName]); +end; + +procedure RegisterThread(ThreadID: DWORD; const ThreadName: string); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames.RegisterThread(ThreadID, CreateThreadName(ThreadName, '')); +end; + +procedure RegisterThread(Thread: TThread; const ThreadName: string; IncludeClassName: Boolean); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames.RegisterThread(Thread.ThreadID, CreateThreadName(ThreadName, Thread.ClassName)); +end; + +procedure UnregisterThread(ThreadID: DWORD); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames.UnregisterThread(ThreadID); +end; + +procedure UnregisterThread(Thread: TThread); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames.UnregisterThread(Thread.ThreadID); +end; + +procedure ChangeThreadName(ThreadID: DWORD; const ThreadName: string); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames[ThreadID] := CreateThreadName(ThreadName, ''); +end; + +procedure ChangeThreadName(Thread: TThread; const ThreadName: string; IncludeClassName: Boolean); +begin + if Assigned(SharedThreadNames) then + SharedThreadNames[Thread.ThreadID] := CreateThreadName(ThreadName, Thread.ClassName); +end; + +function ThreadNamesAvailable: Boolean; +begin + Result := Assigned(SharedThreadNames); +end; + +procedure Init; +begin + if IsDebuggerAttached and TSharedThreadNames.Exists then + begin + SharedThreadNames := TSharedThreadNames.Create(False); + HookImports := TJclPeMapImgHooks.Create; + with HookImports do + begin + HookImport(SystemBase, kernel32, 'CreateThread', @NewCreateThread, @Kernel32_CreateThread); + HookImport(SystemBase, kernel32, 'ExitThread', @NewExitThread, @Kernel32_ExitThread); + {$IFDEF DELPHI7_UP} + HookImport(SystemBase, kernel32, 'ResumeThread', @NewResumeThread, @Kernel32_ResumeThread); + {$ENDIF DELPHI7_UP} + end; + end; +end; + +initialization + Init; + +finalization + FreeAndNil(HookImports); + FreeAndNil(SharedThreadNames); + +// History: + +// $Log: JclIdeThreadStatus.pas,v $ +// Revision 1.3 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/threadnames/ThreadExpertSharedNames.pas b/official/1.96/experts/debug/threadnames/ThreadExpertSharedNames.pas new file mode 100644 index 0000000..e356d08 --- /dev/null +++ b/official/1.96/experts/debug/threadnames/ThreadExpertSharedNames.pas @@ -0,0 +1,336 @@ +{**************************************************************************************************} +{ } +{ 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 ThreadExpertSharedNames.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Petr Vones } +{ Last modified: $Date: 2005/10/26 03:29:44 $ } +{ } +{**************************************************************************************************} + +unit ThreadExpertSharedNames; + +{$I jcl.inc} + +interface + +uses + Windows, SysUtils, Classes, + JclBase, JclFileUtils, JclSynch; + +type + TSharedThreadNames = class(TObject) + private + FIdeMode: Boolean; + FMapping: TJclSwapFileMapping; + FMutex: TJclMutex; + FNotifyEvent: TJclEvent; + FProcessID: DWORD; + FReadMutex: TJclMutex; + FView: TJclFileMappingView; + function GetThreadName(ThreadID: DWORD): string; + procedure InternalRegisterThread(ThreadID: DWORD; const ThreadName: string; UpdateOnly: Boolean); + procedure SetThreadName(ThreadID: DWORD; const Value: string); + protected + function EnterMutex: Boolean; + public + constructor Create(IdeMode: Boolean); + destructor Destroy; override; + procedure Cleanup(ProcessID: DWORD); + class function Exists: Boolean; + procedure RegisterThread(ThreadID: DWORD; const ThreadName: string); + function ThreadNameTimoeut(ThreadID, Timeout: DWORD; var ThreadName: string): Boolean; + procedure UnregisterThread(ThreadID: DWORD); + procedure UpdateResumeStatus; + property ThreadName[ThreadID: DWORD]: string read GetThreadName write SetThreadName; default; + property NotifyEvent: TJclEvent read FNotifyEvent; + end; + +implementation + +uses + JclOtaConsts, JclOtaResources, JclSysUtils; + +const + MaxThreadCount = 256; + IdeEnterMutexTimeout = 5000; + +type + TThreadName = record + ThreadID: DWORD; + ProcessID: DWORD; + ThreadName: ShortString; + end; + + PThreadNames = ^TThreadNames; + TThreadNames = record + Count: Integer; + Threads: array [0..MaxThreadCount - 1] of TThreadName; + end; + +procedure SetIdeDebuggerThreadName(ThreadID: DWORD; const ThreadName: string); +type + TThreadNameInfo = record + FType: Longword; // must be 0x1000 + FName: PChar; // pointer to name (in user address space) + FThreadID: Longword; // thread ID (-1 indicates caller thread) + FFlags: Longword; // reserved for future use, must be zero + end; +var + ThreadNameInfo: TThreadNameInfo; +begin + ThreadNameInfo.FType := $1000; + ThreadNameInfo.FName := PChar(ThreadName); + ThreadNameInfo.FThreadID := ThreadID; + ThreadNameInfo.FFlags := 0; + try + RaiseException($406D1388, 0, SizeOf(ThreadNameInfo) div SizeOf(Longword), @ThreadNameInfo); + except + end; +end; + +//=== { TSharedThreadNames } ================================================= + +constructor TSharedThreadNames.Create(IdeMode: Boolean); +begin + inherited Create; + FIdeMode := IdeMode; + FMutex := TJclMutex.Create(nil, False, MutexName); + FReadMutex := TJclMutex.Create(nil, False, MutexReadName); + FMapping := TJclSwapFileMapping.Create(MappingName, PAGE_READWRITE, SizeOf(TThreadNames), nil); + FView := TJclFileMappingView.Create(FMapping, FILE_MAP_ALL_ACCESS, 0, 0); + FNotifyEvent := TJclEvent.Create(nil, False, False, EventName); + FProcessID := GetCurrentProcessId; +end; + +destructor TSharedThreadNames.Destroy; +begin + Cleanup(FProcessID); + FreeAndNil(FMapping); + FreeAndNil(FMutex); + FreeAndNil(FReadMutex); + FreeAndNil(FNotifyEvent); + inherited Destroy; +end; + +procedure TSharedThreadNames.Cleanup(ProcessID: DWORD); +var + I: Integer; +begin + if EnterMutex then + try + with PThreadNames(FView.Memory)^ do + for I := Low(Threads) to High(Threads) do + with Threads[I] do + if ProcessID = ProcessID then + begin + FReadMutex.WaitForever; + try + ProcessID := 0; + ThreadID := 0; + ThreadName := ''; + finally + FReadMutex.Release; + end; + end; + finally + FMutex.Release; + end; +end; + +function TSharedThreadNames.EnterMutex: Boolean; +begin + if FIdeMode then + begin + case FMutex.WaitFor(IdeEnterMutexTimeout) of + wrSignaled: + Result := True; + wrTimeout: + raise Exception.Create(RsEnterMutexTimeout); + else + Result := False; + end; + end + else + begin + Sleep(0); // Prevent random deadlocks with IDE + Result := FMutex.WaitForever = wrSignaled; + end; +end; + +class function TSharedThreadNames.Exists: Boolean; +{$IFDEF DELPHI7_UP} +begin + Result := True; +end; +{$ELSE DELPHI7_UP} +var + H: THandle; +begin + H := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(MutexName)); + Result := (H <> 0); + if Result then + CloseHandle(H); +end; +{$ENDIF DELPHI7_UP} + +function TSharedThreadNames.GetThreadName(ThreadID: DWORD): string; +var + I: Integer; +begin + Result := ''; + if FReadMutex.WaitForever = wrSignaled then + try + with PThreadNames(FView.Memory)^ do + for I := Low(Threads) to High(Threads) do + if Threads[I].ThreadID = ThreadID then + begin + Result := Threads[I].ThreadName; + Break; + end; + finally + FReadMutex.Release; + end; +end; + +procedure TSharedThreadNames.InternalRegisterThread(ThreadID: DWORD; const ThreadName: string; UpdateOnly: Boolean); +var + I, Slot: Integer; + NeedNotify: Boolean; +begin + if EnterMutex then + try + Slot := -1; + NeedNotify := ThreadID = MainThreadID; + with PThreadNames(FView.Memory)^ do + begin + for I := Low(Threads) to High(Threads) do + if Threads[I].ThreadID = ThreadID then + begin + Slot := I; + NeedNotify := True; + Break; + end + else + if (not UpdateOnly) and (Slot = -1) and (Threads[I].ThreadID = 0) then + Slot := I; + if Slot <> -1 then + begin + FReadMutex.WaitForever; + try + Threads[Slot].ProcessID := FProcessID; + Threads[Slot].ThreadID := ThreadID; + Threads[Slot].ThreadName := ThreadName; + finally + FReadMutex.Release; + end; + end; + end; + {$IFDEF DELPHI7_UP} + SetIdeDebuggerThreadName(ThreadID, ThreadName); + {$ENDIF DELPHI7_UP} + if NeedNotify then + FNotifyEvent.SetEvent; + finally + FMutex.Release; + end; +end; + +procedure TSharedThreadNames.RegisterThread(ThreadID: DWORD; const ThreadName: string); +begin + InternalRegisterThread(ThreadID, ThreadName, False); +end; + +procedure TSharedThreadNames.SetThreadName(ThreadID: DWORD; const Value: string); +begin + InternalRegisterThread(ThreadID, Value, True); +end; + +function TSharedThreadNames.ThreadNameTimoeut(ThreadID, Timeout: DWORD; var ThreadName: string): Boolean; +var + I: Integer; +begin + Result := FReadMutex.WaitFor(Timeout) = wrSignaled; + if Result then + try + with PThreadNames(FView.Memory)^ do + for I := Low(Threads) to High(Threads) do + if Threads[I].ThreadID = ThreadID then + begin + ThreadName := Threads[I].ThreadName; + Break; + end; + finally + FReadMutex.Release; + end; +end; + +procedure TSharedThreadNames.UnregisterThread(ThreadID: DWORD); +var + I: Integer; +begin + EnterMutex; + try + with PThreadNames(FView.Memory)^ do + for I := Low(Threads) to High(Threads) do + if Threads[I].ThreadID = ThreadID then + begin + FReadMutex.WaitForever; + try + Threads[I].ProcessID := 0; + Threads[I].ThreadID := 0; + Threads[I].ThreadName := ''; + finally + FReadMutex.Release; + end; + Break; + end; + finally + FMutex.Release; + end; +end; + +procedure TSharedThreadNames.UpdateResumeStatus; +var + I: Integer; +begin + EnterMutex; + try + with PThreadNames(FView.Memory)^ do + for I := Low(Threads) to High(Threads) do + if Threads[I].ThreadID <> 0 then + begin + FReadMutex.WaitForever; + try + SetIdeDebuggerThreadName(Threads[I].ThreadID, Threads[I].ThreadName); + finally + FReadMutex.Release; + end; + end; + finally + FMutex.Release; + end; +end; + +// History: + +// $Log: ThreadExpertSharedNames.pas,v $ +// Revision 1.4 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/threadnames/ThreadExpertUnit.pas b/official/1.96/experts/debug/threadnames/ThreadExpertUnit.pas new file mode 100644 index 0000000..69b8618 --- /dev/null +++ b/official/1.96/experts/debug/threadnames/ThreadExpertUnit.pas @@ -0,0 +1,422 @@ +{**************************************************************************************************} +{ } +{ 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 ThreadExpertUnit.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Petr Vones } +{ Last modified: $Date: 2006/01/08 17:16:56 $ } +{ } +{**************************************************************************************************} + +unit ThreadExpertUnit; + +{$I jcl.inc} + +interface + +uses + Windows, Classes, SysUtils, ToolsAPI, ComCtrls, Dialogs, + ThreadExpertSharedNames, + JclOtaUtils, JclSynch; + +type + TNameChangeThread = class; + + TJclThreadsExpert = class(TJclOTAExpert) + private + DebuggerServices: IOTADebuggerServices; + FProcessesCount: Integer; + FNameChangeThread: TNameChangeThread; + FNotifierIndex: Integer; + FSharedThreadNames: TSharedThreadNames; + FThreadsStatusListView: TListView; + function GetThreadsStatusListView: TListView; + function GetThreadsStatusListViewFound: Boolean; + procedure ListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange); + function UpdateItem(Item: TListItem): Boolean; + public + constructor Create; reintroduce; + destructor Destroy; override; + procedure UpdateContent; + property ProcessesCount: Integer read FProcessesCount; + property ThreadsStatusListView: TListView read GetThreadsStatusListView; + property ThreadsStatusListViewFound: Boolean read GetThreadsStatusListViewFound; + end; + + TDebuggerNotifier = class(TNotifierObject, IOTADebuggerNotifier) + private + FExpert: TJclThreadsExpert; + protected + procedure BreakpointAdded({$IFDEF RTL170_UP} const {$ENDIF} Breakpoint: IOTABreakpoint); + procedure BreakpointDeleted({$IFDEF RTL170_UP} const {$ENDIF} Breakpoint: IOTABreakpoint); + procedure ProcessCreated({$IFDEF RTL170_UP} const {$ENDIF} Process: IOTAProcess); + procedure ProcessDestroyed({$IFDEF RTL170_UP} const {$ENDIF} Process: IOTAProcess); + public + constructor Create(AExpert: TJclThreadsExpert); + end; + + TNameChangeThread = class(TThread) + private + FExpert: TJclThreadsExpert; + FNotifyEvent: TJclEvent; + FTerminateEvent: THandle; + procedure TryFindThreadsStatusListView; + procedure UpdateRequest; + protected + procedure Execute; override; + public + constructor Create(AExpert: TJclThreadsExpert; ANotifyEvent: TJclEvent); + destructor Destroy; override; + procedure TerminateThread; + end; + +// design package entry point +procedure Register; + +// expert DLL entry point +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean; stdcall; + +implementation + +uses + Forms, Controls, + JclSysUtils, + JclOtaConsts, JclOtaResources; + +const + ThreadsStatusListViewFindPeriod = 2000; + ReadNameTimeout = 500; + +procedure Register; +begin + try + RegisterPackageWizard(TJclThreadsExpert.Create); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +var + JCLWizardIndex: Integer = -1; + +procedure JclWizardTerminate; +var + OTAWizardServices: IOTAWizardServices; +begin + try + if JCLWizardIndex <> -1 then + begin + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + OTAWizardServices.RemoveWizard(JCLWizardIndex); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + end; + end; +end; + +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean stdcall; +var + OTAWizardServices: IOTAWizardServices; +begin + try + TerminateProc := JclWizardTerminate; + + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + JCLWizardIndex := OTAWizardServices.AddWizard(TJclThreadsExpert.Create); + + Result := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + Result := False; + end; + end; +end; + +//== { TJclThreadsExpert } =================================================== + +constructor TJclThreadsExpert.Create; +begin + inherited Create(JclThreadsExpertName); + DebuggerServices := BorlandIDEServices as IOTADebuggerServices; + FSharedThreadNames := TSharedThreadNames.Create(True); + FNotifierIndex := DebuggerServices.AddNotifier(TDebuggerNotifier.Create(Self)); + FNameChangeThread := TNameChangeThread.Create(Self, FSharedThreadNames.NotifyEvent); +end; + +destructor TJclThreadsExpert.Destroy; +begin + if FNotifierIndex <> -1 then + DebuggerServices.RemoveNotifier(FNotifierIndex); + if Assigned(FThreadsStatusListView) then + FThreadsStatusListView.OnChange := nil; + FNameChangeThread.TerminateThread; + FreeAndNil(FNameChangeThread); + FreeAndNil(FSharedThreadNames); + inherited Destroy; +end; + +function TJclThreadsExpert.GetThreadsStatusListView: TListView; +var + I: Integer; + F: TForm; +begin + if FThreadsStatusListView = nil then + begin + F := nil; + with Screen do + for I := 0 to FormCount - 1 do + if Forms[I].ClassName = 'TThreadStatus' then + begin + F := Forms[I]; + Break; + end; + if F <> nil then + with F do + for I := 0 to ControlCount -1 do + if Controls[I] is TListView then + begin + FThreadsStatusListView := TListView(Controls[I]); + Break; + end; + if FThreadsStatusListView <> nil then + FThreadsStatusListView.OnChange := ListViewChange; + end; + Result := FThreadsStatusListView; +end; + +function TJclThreadsExpert.GetThreadsStatusListViewFound: Boolean; +begin + Result := Assigned(FThreadsStatusListView); +end; + +procedure TJclThreadsExpert.ListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange); +begin + try + if Change = ctText then + UpdateItem(Item); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclThreadsExpert.UpdateContent; +var + I: Integer; +begin + try + with ThreadsStatusListView do + begin + {Items.BeginUpdate; + try} + for I := 0 to Items.Count - 1 do + if not UpdateItem(Items[I]) then + Break; + {finally + Items.EndUpdate; + end;} + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +var + CaptionChanging: Boolean; + +function TJclThreadsExpert.UpdateItem(Item: TListItem): Boolean; +var + TID: DWORD; + Caption, ThreadName: string; +begin + Result := True; + if CaptionChanging then + Exit; + Caption := Item.Caption; + if (Length(Caption) >= 9) and (Caption[1] = '$') then + begin + Caption := Copy(Caption, 1, 9); + TID := StrToInt(Caption); + Result := FSharedThreadNames.ThreadNameTimoeut(TID, ReadNameTimeout, ThreadName); + if Result then + begin + CaptionChanging := True; + try + Item.Caption := Format('%s %s', [Caption, ThreadName]); + finally + CaptionChanging := False; + end; + end; + end; +end; + +//=== { TDebuggerNotifier } ================================================== + +constructor TDebuggerNotifier.Create(AExpert: TJclThreadsExpert); +begin + FExpert := AExpert; +end; + +procedure TDebuggerNotifier.BreakpointAdded({$IFDEF RTL170_UP} const {$ENDIF} Breakpoint: IOTABreakpoint); +begin +end; + +procedure TDebuggerNotifier.BreakpointDeleted({$IFDEF RTL170_UP} const {$ENDIF} Breakpoint: IOTABreakpoint); +begin +end; + +procedure TDebuggerNotifier.ProcessCreated({$IFDEF RTL170_UP} const {$ENDIF} Process: IOTAProcess); +begin + try + FExpert.GetThreadsStatusListView; + Inc(FExpert.FProcessesCount); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TDebuggerNotifier.ProcessDestroyed({$IFDEF RTL170_UP} const {$ENDIF} Process: IOTAProcess); +begin + try + Dec(FExpert.FProcessesCount); + FExpert.FSharedThreadNames.Cleanup(Process.ProcessId); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +//=== { TNameChangeThread } ================================================== + +constructor TNameChangeThread.Create(AExpert: TJclThreadsExpert; ANotifyEvent: TJclEvent); +begin + inherited Create(True); + Priority := tpLowest; + FExpert := AExpert; + FNotifyEvent := ANotifyEvent; + FTerminateEvent := CreateEvent(nil, True, False, nil); + Resume; +end; + +destructor TNameChangeThread.Destroy; +begin + CloseHandle(FTerminateEvent); + inherited Destroy; +end; + +procedure TNameChangeThread.Execute; +var + WaitHandles: array [0..1] of THandle; + WaitTimeout: DWORD; +begin + WaitHandles[0] := FTerminateEvent; + WaitHandles[1] := FNotifyEvent.Handle; + WaitTimeout := ThreadsStatusListViewFindPeriod; + repeat + case Windows.WaitForMultipleObjects(2, @WaitHandles, False, WaitTimeout) of + WAIT_OBJECT_0: + Break; + WAIT_OBJECT_0 + 1: + begin + Synchronize(UpdateRequest); + Sleep(30); // To prevent overload the IDE by many update requests + end; + WAIT_TIMEOUT: + if FExpert.ProcessesCount > 0 then + begin + if not FExpert.ThreadsStatusListViewFound then + Synchronize(TryFindThreadsStatusListView); + if FExpert.ThreadsStatusListViewFound then + WaitTimeout := INFINITE; + end; + end; + until Terminated; +end; + +procedure TNameChangeThread.TerminateThread; +begin + Terminate; + SetEvent(FTerminateEvent); + WaitFor; +end; + +procedure TNameChangeThread.TryFindThreadsStatusListView; +begin + if FExpert.GetThreadsStatusListView <> nil then + FExpert.UpdateContent; +end; + +procedure TNameChangeThread.UpdateRequest; +begin + FExpert.UpdateContent; +end; + +// History: + +// $Log: ThreadExpertUnit.pas,v $ +// Revision 1.7 2006/01/08 17:16:56 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.6 2005/12/26 18:03:40 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.5 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.4 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags +// + +end. diff --git a/official/1.96/experts/debug/tools/MakeJclDbg.dof b/official/1.96/experts/debug/tools/MakeJclDbg.dof new file mode 100644 index 0000000..e957ac9 --- /dev/null +++ b/official/1.96/experts/debug/tools/MakeJclDbg.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin + diff --git a/official/1.96/experts/debug/tools/MakeJclDbg.dpr b/official/1.96/experts/debug/tools/MakeJclDbg.dpr new file mode 100644 index 0000000..7dc5410 --- /dev/null +++ b/official/1.96/experts/debug/tools/MakeJclDbg.dpr @@ -0,0 +1,132 @@ +{**************************************************************************************************} +{ } +{ 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 MakeJclDbg.dpr. } +{ } +{ The Initial Developer of the Original Code is documented in the accompanying } +{ help file JCL.chm. Portions created by these individuals are Copyright (C) of these individuals. } +{ } +{**************************************************************************************************} +{ } +{ Command line tool for inserting JCL debug data created from MAP files into executable files } +{ } +{ Last modified: March 13, 2002 } +{ } +{**************************************************************************************************} + +program MakeJclDbg; + +{$I jcl.inc} + +{$APPTYPE CONSOLE} + +uses + Windows, Classes, SysUtils, + JclDebug, JclFileUtils, JclPeImage, JclStrings; + +var + JdbgFlag, InsertToExeFlag: Boolean; + +function MakeDebugData(const FileNames: string): Boolean; +var + FilesList: TStringList; + I: Integer; + MapFileSize, BinDataSize: Integer; + FileName, ExecutableFileName: TFileName; + LinkerBugUnit: string; + + procedure FindExecutableFileName(const MapFileName: TFileName); + var + ExecFilesList: TStringList; + I, ValidCnt: Integer; + begin + ExecutableFileName := ''; + ValidCnt := 0; + ExecFilesList := TStringList.Create; + try + if AdvBuildFileList(ChangeFileExt(MapFileName, '.*'), faArchive, ExecFilesList, amSubSetOf, [flFullNames]) then + with ExecFilesList do + begin + for I := 0 to Count - 1 do + if IsValidPeFile(Strings[I]) then + begin + Objects[I] := Pointer(True); + Inc(ValidCnt); + if ExecutableFileName = '' then + ExecutableFileName := Strings[I]; + end; + case ValidCnt of + 0: WriteLn(#13#10'Can not find any executable file for the MAP file.'); + 1: Write(' -> ' + ExtractFileName(ExecutableFileName)); + else + ExecutableFileName := ''; + WriteLn(#13#10'Ambiguous executable file names:'); + for I := 0 to Count - 1 do + if Boolean(Objects[I]) then + WriteLn(Strings[I]); + end; + end; + finally + ExecFilesList.Free; + end; + end; + +begin + Result := True; + FilesList := TStringList.Create; + try + if AdvBuildFileList(FileNames, faArchive, FilesList, amSubSetOf, [flFullNames]) then + for I := 0 to FilesList.Count - 1 do + begin + FileName := FilesList[I]; + if ExtractFileExt(FileName) <> '.map' then + Continue; + Write(#13#10, FilesList[I]); + Result := False; + if JdbgFlag then + Result := ConvertMapFileToJdbgFile(FileName); + if InsertToExeFlag then + begin + FindExecutableFileName(FileName); + Result := (ExecutableFileName <> ''); + if Result then + Result := InsertDebugDataIntoExecutableFile(ExecutableFileName, + FileName, LinkerBugUnit, MapFileSize, BinDataSize); + end; + if Result then + WriteLn(' ... OK') + else + begin + WriteLn(' ... ERROR!'); + Break; + end; + end; + finally + FilesList.Free; + end; +end; + +begin + WriteLn('Make JCL debug data command line utility. (c) 2002 Project JEDI'); + JdbgFlag := AnsiSameText(ParamStr(1), '-J'); + InsertToExeFlag := AnsiSameText(ParamStr(1), '-E'); + if (ParamCount <> 2) or not (JdbgFlag xor InsertToExeFlag) then + begin + WriteLn('Usage: MAKEJCLDBG - '); + WriteLn(' J - Create .JDBG files'); + WriteLn(' E - Insert debug data into executable files'); + WriteLn('Executable files must be in the same directory like MAP files'); + end + else + if not MakeDebugData(ParamStr(2)) then + Halt(1); +end. diff --git a/official/1.96/experts/debug/tools/MapToJdbg.dof b/official/1.96/experts/debug/tools/MapToJdbg.dof new file mode 100644 index 0000000..e957ac9 --- /dev/null +++ b/official/1.96/experts/debug/tools/MapToJdbg.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin + diff --git a/official/1.96/experts/debug/tools/MapToJdbg.dpr b/official/1.96/experts/debug/tools/MapToJdbg.dpr new file mode 100644 index 0000000..59a76c6 --- /dev/null +++ b/official/1.96/experts/debug/tools/MapToJdbg.dpr @@ -0,0 +1,14 @@ +program MapToJdbg; + +uses + Forms, + MapToJdbgMain in 'MapToJdbgMain.pas' {MainForm}; + +{$R *.RES} + +begin + Application.Initialize; + Application.Title := 'MAP to JDBG'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/experts/debug/tools/MapToJdbg.res b/official/1.96/experts/debug/tools/MapToJdbg.res new file mode 100644 index 0000000..1fefc8d Binary files /dev/null and b/official/1.96/experts/debug/tools/MapToJdbg.res differ diff --git a/official/1.96/experts/debug/tools/MapToJdbgMain.dfm b/official/1.96/experts/debug/tools/MapToJdbgMain.dfm new file mode 100644 index 0000000..625cf45 --- /dev/null +++ b/official/1.96/experts/debug/tools/MapToJdbgMain.dfm @@ -0,0 +1,577 @@ +object MainForm: TMainForm + Left = 275 + Top = 222 + Width = 692 + Height = 444 + Caption = 'MAP to JDBG format conversion utility' + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 300 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Menu = MainMenu1 + OldCreateOrder = False + Position = poDefaultPosOnly + ShowHint = True + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object ToolBar1: TToolBar + Left = 0 + Top = 0 + Width = 684 + Height = 24 + AutoSize = True + Caption = 'ToolBar1' + Flat = True + Images = ImageList1 + Indent = 4 + TabOrder = 0 + object ToolButton1: TToolButton + Left = 4 + Top = 0 + Action = Open1 + end + object ToolButton3: TToolButton + Left = 27 + Top = 0 + Width = 8 + Caption = 'ToolButton3' + ImageIndex = 2 + Style = tbsSeparator + end + object ToolButton2: TToolButton + Left = 35 + Top = 0 + Action = Convert1 + end + end + object StatusBar1: TStatusBar + Left = 0 + Top = 379 + Width = 684 + Height = 19 + Panels = < + item + Width = 250 + end + item + Width = 90 + end + item + Width = 50 + end> + SimplePanel = False + end + object FilesListView: TListView + Left = 0 + Top = 24 + Width = 684 + Height = 355 + Align = alClient + Columns = < + item + Caption = 'Name' + Width = 100 + end + item + Alignment = taRightJustify + Caption = 'MAP file size' + Width = 75 + end + item + Alignment = taRightJustify + Caption = 'JDBG file size' + Width = 80 + end + item + Alignment = taRightJustify + Caption = 'Ratio' + end + item + Caption = 'Full path name' + Width = 240 + end + item + Caption = 'Linker bug' + Width = 65 + end + item + Caption = 'Line errors' + Width = 65 + end> + ColumnClick = False + HotTrackStyles = [] + ReadOnly = True + RowSelect = True + SmallImages = ImageList1 + TabOrder = 2 + ViewStyle = vsReport + end + object MainMenu1: TMainMenu + Images = ImageList1 + Left = 8 + Top = 344 + object File1: TMenuItem + Caption = 'File' + object Open2: TMenuItem + Action = Open1 + end + object N1: TMenuItem + Caption = '-' + end + object Exit2: TMenuItem + Action = Exit1 + end + end + object Run1: TMenuItem + Caption = 'Run' + object Convert2: TMenuItem + Action = Convert1 + end + end + end + object ActionList1: TActionList + Images = ImageList1 + Left = 40 + Top = 344 + object Exit1: TAction + Caption = 'Exit' + Hint = 'Exit the application' + ImageIndex = 0 + OnExecute = Exit1Execute + end + object Open1: TAction + Caption = 'Open ...' + Hint = 'Open MAP file(s)' + ImageIndex = 2 + ShortCut = 16463 + OnExecute = Open1Execute + end + object Convert1: TAction + Caption = 'Convert' + Hint = 'Start conversion' + ImageIndex = 1 + ShortCut = 120 + OnExecute = Convert1Execute + OnUpdate = Convert1Update + end + end + object ImageList1: TImageList + Left = 72 + Top = 344 + Bitmap = { + 494C010105000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000003000000001002000000000000030 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF0000000000000000007F7F7F00000000007F7F7F00000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF007F7F7F00000000007F7F7F000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000FF00000000000000FF000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000FF00000000000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000080000000000000008000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000FF000000800000000000000080000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF000000000000000000000000000000FF000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000000000000000000000000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000FF000000 + FF000000FF0000000000000000007F7F7F00000000007F7F7F00000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 80000000800000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 8000000080000000800000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF000000000000000000008484000084 + 8400008484000084840000848400008484000084840000848400008484000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF000000000000FFFF00000000000084 + 8400008484000084840000848400008484000084840000848400008484000084 + 8400000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF0000FFFF000000 + 0000008484000084840000848400008484000084840000848400008484000084 + 8400008484000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000FFFF00FFFFFF0000FF + FF00000000000084840000848400008484000084840000848400008484000084 + 84000084840000848400000000000000000000000000000000000000FF000000 + FF000000FF000000FF000000FF000000FF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000007F7F7F000000FF000000 + FF0000000000000000000000FF000000FF000000FF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF000000 + 00000000000000000000FFFFFF00FFFFFF000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 0000000000000000000000000000000000007F7F7F000000FF00000000000000 + 00000000000000000000000000000000FF000000FF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FF000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 8000000080000000800000FFFF000000000000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000FF000000FF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000FFFF0000FFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FF000000FF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000FFFF0000FFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 8000FFFF0000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000FFFF0000FFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000007F7F + 7F000000FF000000000000000000000000000000000000000000000000000000 + 8000FFFF0000FFFF00000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000300000000100010000000000800100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFF000000000000FFFF000000000000 + C631000000000000E223000000000000F007000000000000F88F000000000000 + FC1F000000000000FE3F000000000000FC1F000000000000F80F000000000000 + F007000000000000E223000000000000C631000000000000FFFF000000000000 + FFFF000000000000FFFF000000000000C0078000FFFFFFFFC0078000FFFFFFFF + C007C000001FF9FFC007E000000FF0FFC007F0000007F0FFC007F8000003E07F + C007FC000001C07FC007FE000000843FC007FF00001F1E3FC007FF80001FFE1F + C0078380001FFF1FC00783E08FF1FF8FC00783E0FFF9FFC7C00783E0FF75FFE3 + C0078384FF8FFFF8C007FFFEFFFFFFFF00000000000000000000000000000000 + 000000000000} + end + object OpenDialog1: TOpenDialog + Filter = 'MAP files (*.map)|*.map' + Options = [ofHideReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Title = 'Select MAP file(s) to convert' + Left = 104 + Top = 344 + end +end diff --git a/official/1.96/experts/debug/tools/MapToJdbgMain.pas b/official/1.96/experts/debug/tools/MapToJdbgMain.pas new file mode 100644 index 0000000..786fc50 --- /dev/null +++ b/official/1.96/experts/debug/tools/MapToJdbgMain.pas @@ -0,0 +1,211 @@ +{**************************************************************************************************} +{ } +{ 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 MapToJdbgMain.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Petr Vones } +{ Last modified: $Date: 2005/10/26 03:29:44 $ } +{ } +{**************************************************************************************************} +unit MapToJdbgMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, ImgList, ActnList, Menus, ToolWin; + +type + TMainForm = class(TForm) + ToolBar1: TToolBar; + MainMenu1: TMainMenu; + ActionList1: TActionList; + ImageList1: TImageList; + StatusBar1: TStatusBar; + Exit1: TAction; + Open1: TAction; + Convert1: TAction; + File1: TMenuItem; + Open2: TMenuItem; + N1: TMenuItem; + Exit2: TMenuItem; + OpenDialog1: TOpenDialog; + FilesListView: TListView; + ToolButton1: TToolButton; + ToolButton2: TToolButton; + ToolButton3: TToolButton; + Run1: TMenuItem; + Convert2: TMenuItem; + procedure Exit1Execute(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure Open1Execute(Sender: TObject); + procedure Convert1Execute(Sender: TObject); + procedure Convert1Update(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.DFM} + +uses + JclCounter, JclDebug, JclFileUtils, JclUnitConv; + +resourcestring + RsConverting = 'Converting ...'; + RsConversionStatus = '%d file(s) converted, Conversion time: %5.3f sec.'; + RsLinkerBugs = 'Linker bugs: %d'; + +procedure TMainForm.FormCreate(Sender: TObject); +var + MapFileName: TFileName; +begin + MapFileName := ParamStr(1); + if MapFileName <> '' then + begin + ConvertMapFileToJdbgFile(MapFileName); + Application.ShowMainForm := False; + Application.Terminate; + end; +end; + +procedure TMainForm.Exit1Execute(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.Open1Execute(Sender: TObject); +var + I, FileSize: Integer; +begin + with OpenDialog1 do + begin + FileName := ''; + if Execute then + begin + with FilesListView.Items do + begin + BeginUpdate; + try + Clear; + for I := 0 to Files.Count - 1 do + with Add do + begin + Caption := PathExtractFileNameNoExt(Files[I]); + FileSize := FileGetSize(Files[I]); + SubItems.AddObject(IntToStr(FileSize), Pointer(FileSize)); + SubItems.Add(''); + SubItems.Add(''); + SubItems.Add(Files[I]); + SubItems.Add(''); + SubItems.Add(''); + ImageIndex := 1; + end; + finally + EndUpdate; + end; + end; + StatusBar1.Panels[0].Text := ''; + end; + end; +end; + +procedure TMainForm.Convert1Execute(Sender: TObject); +var + I, JdbgFileSize, FilesConverted, LineNumberErrors, LinkerBugCnt: Integer; + MapFileName, JdbgFileName: TFileName; + Ratio: Extended; + LinkerBugUnit: string; + Cnt: TJclCounter; +begin + Screen.Cursor := crHourGlass; + try + with FilesListView do + begin + StatusBar1.Panels[0].Text := RsConverting; + StatusBar1.Panels[1].Text := ''; + StatusBar1.Update; + Items.BeginUpdate; + for I := 0 to Items.Count - 1 do + with Items[I] do + begin + SubItems[1] := ''; + SubItems[2] := ''; + SubItems[4] := ''; + SubItems[5] := ''; + ImageIndex := 1; + end; + Items.EndUpdate; + Update; + FilesConverted := 0; + LinkerBugCnt := 0; + StartCount(Cnt); + for I := 0 to Items.Count - 1 do + begin + with Items[I] do + begin + MapFileName := SubItems[3]; + JdbgFileName := ChangeFileExt(MapFileName, JclDbgFileExtension); + if ConvertMapFileToJdbgFile(MapFileName, LinkerBugUnit, LineNumberErrors) then + begin + ImageIndex := 3; + JdbgFileSize := FileGetSize(JdbgFileName); + Ratio := JdbgFileSize * 100 / Integer(SubItems.Objects[0]); + SubItems[1] := IntToStr(JdbgFileSize); + SubItems[2] := Format('%3.1f %%', [Ratio]); + SubItems[4] := LinkerBugUnit; + if LinkerBugUnit <> '' then + Inc(LinkerBugCnt); + if LineNumberErrors > 0 then + SubItems[5] := IntToStr(LineNumberErrors); + Inc(FilesConverted); + end + else + begin + SubItems[0] := ''; + ImageIndex := 4; + end; + end; + Update; + end; + StatusBar1.Panels[0].Text := Format(RsConversionStatus, [FilesConverted, StopCount(Cnt)]); + StatusBar1.Panels[1].Text := Format(RsLinkerBugs, [LinkerBugCnt]); + end; + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.Convert1Update(Sender: TObject); +begin + Convert1.Enabled := FilesListView.Items.Count > 0; +end; + +// History: + +// $Log: MapToJdbgMain.pas,v $ +// Revision 1.2 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/tools/TlbToMap.dof b/official/1.96/experts/debug/tools/TlbToMap.dof new file mode 100644 index 0000000..e957ac9 --- /dev/null +++ b/official/1.96/experts/debug/tools/TlbToMap.dof @@ -0,0 +1,3 @@ +[Directories] +OutputDir=..\..\..\..\bin + diff --git a/official/1.96/experts/debug/tools/TlbToMap.dpr b/official/1.96/experts/debug/tools/TlbToMap.dpr new file mode 100644 index 0000000..e00cdfe --- /dev/null +++ b/official/1.96/experts/debug/tools/TlbToMap.dpr @@ -0,0 +1,14 @@ +program TlbToMap; + +uses + Forms, + TlbToMapMain in 'TlbToMapMain.pas' {MainForm}; + +{$R *.RES} + +begin + Application.Initialize; + Application.Title := 'TLB to MAP'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/experts/debug/tools/TlbToMap.res b/official/1.96/experts/debug/tools/TlbToMap.res new file mode 100644 index 0000000..267e471 Binary files /dev/null and b/official/1.96/experts/debug/tools/TlbToMap.res differ diff --git a/official/1.96/experts/debug/tools/TlbToMapMain.dfm b/official/1.96/experts/debug/tools/TlbToMapMain.dfm new file mode 100644 index 0000000..f702f91 --- /dev/null +++ b/official/1.96/experts/debug/tools/TlbToMapMain.dfm @@ -0,0 +1,592 @@ +object MainForm: TMainForm + Left = 274 + Top = 174 + Width = 430 + Height = 346 + Caption = 'Type Library to MAP file' + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 300 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Menu = MainMenu1 + OldCreateOrder = False + Position = poDefaultPosOnly + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 0 + Top = 239 + Width = 422 + Height = 3 + Cursor = crVSplit + Align = alBottom + MinSize = 10 + ResizeStyle = rsUpdate + Visible = False + end + object ToolBar1: TToolBar + Left = 0 + Top = 0 + Width = 422 + Height = 24 + AutoSize = True + Caption = 'ToolBar1' + Flat = True + Images = ImageList1 + Indent = 4 + TabOrder = 0 + Wrapable = False + object ToolButton1: TToolButton + Left = 4 + Top = 0 + Action = Open1 + end + object ToolButton3: TToolButton + Left = 27 + Top = 0 + Width = 8 + Caption = 'ToolButton3' + ImageIndex = 2 + Style = tbsSeparator + end + object ToolButton2: TToolButton + Left = 35 + Top = 0 + Action = CreateMAP1 + end + object ToolButton4: TToolButton + Left = 58 + Top = 0 + Action = CreateJDBG1 + end + end + object StatusBar1: TStatusBar + Left = 0 + Top = 281 + Width = 422 + Height = 19 + Panels = < + item + Width = 50 + end> + SimplePanel = False + end + object MethodsListView: TListView + Left = 0 + Top = 24 + Width = 422 + Height = 215 + Align = alClient + Columns = < + item + Caption = 'Method' + Width = 200 + end + item + Alignment = taRightJustify + Caption = 'Address' + Width = 70 + end> + ColumnClick = False + OwnerData = True + ReadOnly = True + RowSelect = True + SmallImages = ImageList1 + TabOrder = 2 + ViewStyle = vsReport + OnData = MethodsListViewData + end + object VersionMemo: TMemo + Left = 0 + Top = 242 + Width = 422 + Height = 39 + Align = alBottom + ReadOnly = True + TabOrder = 3 + Visible = False + end + object MainMenu1: TMainMenu + Images = ImageList1 + Left = 8 + Top = 248 + object File1: TMenuItem + Caption = 'File' + object Open2: TMenuItem + Action = Open1 + end + object N1: TMenuItem + Caption = '-' + end + object Exit2: TMenuItem + Action = Exit1 + end + end + object Run1: TMenuItem + Caption = 'Run' + object Convert2: TMenuItem + Action = CreateMAP1 + end + object CreateJDBGfile1: TMenuItem + Action = CreateJDBG1 + end + end + end + object ActionList1: TActionList + Images = ImageList1 + Left = 40 + Top = 248 + object Exit1: TAction + Caption = 'Exit' + Hint = 'Exit the application' + ImageIndex = 0 + OnExecute = Exit1Execute + end + object Open1: TAction + Caption = 'Open ...' + Hint = 'Open Type Library' + ImageIndex = 2 + ShortCut = 16463 + OnExecute = Open1Execute + end + object CreateMAP1: TAction + Caption = 'Create MAP file' + Hint = 'Create MAP file' + ImageIndex = 1 + ShortCut = 120 + OnExecute = CreateMAP1Execute + OnUpdate = CreateMAP1Update + end + object CreateJDBG1: TAction + Tag = 1 + Caption = 'Create JDBG file' + Hint = 'Create JDBG file' + ImageIndex = 4 + ShortCut = 8312 + OnExecute = CreateMAP1Execute + OnUpdate = CreateMAP1Update + end + end + object ImageList1: TImageList + Left = 72 + Top = 248 + Bitmap = { + 494C010105000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000003000000001002000000000000030 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF0000000000FF000000FF000000FF00000000000000FFFFFF00FFFFFF000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF0000000000FF00000000000000FFFFFF00FFFFFF00FFFFFF000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 00000000FF000000FF000000FF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00000000007F7F7F0000FFFF007F7F7F0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF0000FFFF0000FFFF0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000007F7F7F0000FFFF007F7F7F0000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF + 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFF0000FFFF0000FFFF + 000000000000FFFF000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000FFFF + 0000FFFF0000FFFF000000000000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFF0000FFFF0000FFFF00000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 800000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 80000000800000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 8000000080000000800000FFFF0000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF0000000000000000000000000000000000000000000000000000000000FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF000000000000000000008484000084 + 8400008484000084840000848400008484000084840000848400008484000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000848484008484840000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + FF000000FF000000FF0000000000FFFFFF000000000000FFFF00000000000084 + 8400008484000084840000848400008484000084840000848400008484000084 + 8400000000000000000000000000000000000000000000000000000000000000 + 0000000000008484840000000000000000000000000084848400008484000084 + 8400000000008484840000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF0000FFFF000000 + 0000008484000084840000848400008484000084840000848400008484000084 + 8400008484000000000000000000000000000000000000000000000000000000 + FF00000000008484840084848400848484000084840000848400008484000084 + 8400008484000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000FFFF00FFFFFF0000FF + FF00000000000084840000848400008484000084840000848400008484000084 + 8400008484000084840000000000000000000000000000000000000000000000 + FF000000FF000000000084848400848484000084840000FFFF00008484000084 + 8400008484000084840000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF0000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF0000FFFF00FFFF + FF0000FFFF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000084840000FFFF0000FFFF000084 + 8400008484000084840000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF000000 + 00000000000000000000FFFFFF00FFFFFF000000000000FFFF00FFFFFF0000FF + FF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000840000008400000084000000000000000000008484000084 + 8400000000000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000FFFFFF0000000000FFFFFF0000FFFF00FFFF + FF0000FFFF00FFFFFF0000FFFF00FFFFFF0000FFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000840000000000000000008484840084848400848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 8000000080000000800000FFFF000000000000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFFF00FFFFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF0000008400000000000000000084848400FF00000084840000FF0000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000FFFF0000FFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008484000084840000FF0000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 800000008000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000FFFF0000FFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FF000000FF0000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 8000FFFF0000000080000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000FFFF0000FFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008484000084840000FF0000008400 + 0000000000000000000000000000000000000000000000000000000000000000 + 8000FFFF0000FFFF00000000000000FFFF0000FFFF0000FFFF0000FFFF0000FF + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000300000000100010000000000800100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000080000000000000008000000000000000 + C000000000000000E000000000000000F000000000000000F800000000000000 + FC00000000000000040000000000000006000000000000000180000000000000 + 01C00000000000000000000000000000C060000000000000C060000000000000 + F060000000000000F006000000000000C0078000FFFFFFFFC0078000FFFFFFFF + C007C000001FFFE7C007E000000FFFC3C007F0000007FB83C007F8000003E003 + C007FC000001E003C007FE000000E003C007FF00001FE0CFC007FF80001FE307 + C0078380001FE607C00783E08FF1FF07C00783E0FFF9FF87C00783E0FF75FF0F + C0078384FF8FFFFFC007FFFEFFFFFFFF00000000000000000000000000000000 + 000000000000} + end + object OpenDialog1: TOpenDialog + Filter = + 'Type Library files (*.tlb;*.olb;*.dll;*.exe;*.ocx)|*.tlb;*.olb;*' + + '.dll;*.exe;*.ocx|All files (*.*)|*.*' + Options = [ofHideReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Left = 104 + Top = 248 + end +end diff --git a/official/1.96/experts/debug/tools/TlbToMapMain.pas b/official/1.96/experts/debug/tools/TlbToMapMain.pas new file mode 100644 index 0000000..c703344 --- /dev/null +++ b/official/1.96/experts/debug/tools/TlbToMapMain.pas @@ -0,0 +1,396 @@ +{**************************************************************************************************} +{ } +{ 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 TlbToMapMain.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Petr Vones } +{ Last modified: $Date: 2005/10/26 03:29:44 $ } +{ } +{**************************************************************************************************} +unit TlbToMapMain; + +interface + +{$I jcl.inc} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + ComCtrls, ImgList, ActnList, Menus, ToolWin, StdCtrls, ExtCtrls; + +type + TMainForm = class(TForm) + ToolBar1: TToolBar; + MainMenu1: TMainMenu; + ActionList1: TActionList; + ImageList1: TImageList; + StatusBar1: TStatusBar; + Exit1: TAction; + Open1: TAction; + CreateMAP1: TAction; + File1: TMenuItem; + Open2: TMenuItem; + N1: TMenuItem; + Exit2: TMenuItem; + OpenDialog1: TOpenDialog; + MethodsListView: TListView; + ToolButton1: TToolButton; + ToolButton2: TToolButton; + ToolButton3: TToolButton; + Run1: TMenuItem; + Convert2: TMenuItem; + CreateJDBG1: TAction; + ToolButton4: TToolButton; + CreateJDBGfile1: TMenuItem; + VersionMemo: TMemo; + Splitter1: TSplitter; + procedure Exit1Execute(Sender: TObject); + procedure Open1Execute(Sender: TObject); + procedure CreateMAP1Execute(Sender: TObject); + procedure CreateMAP1Update(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure MethodsListViewData(Sender: TObject; Item: TListItem); + private + FFileName: TFileName; + FMembersList: TStringList; + procedure SetFileName(const Value: TFileName); + public + procedure OpenTypeLibrary(const FileName: TFileName); + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.DFM} + +uses + ComObj, ActiveX, + JclBase, JclDebug, JclFileUtils, JclPeImage, JclSysInfo, JclSysUtils; + +resourcestring + RsReading = 'Reading type library ...'; + RsNoTypeLib = 'The file does not contain valid Type Library.'; + RsNoCoClass = 'Type library does not contain any CoClasses.'; + +// Reference: +// Improve Your Debugging by Generating Symbols from COM Type Libraries +// Matt Pietrek - Microsoft Systems Journal, March 1999 +// http://msdn.microsoft.com/library/periodic/period99/comtype.htm + +type + TJclTypeLibScanner = class (TObject) + private + FMembersList: TStrings; + FModuleFileName: TFileName; + FTypeLib: ITypeLib; + FValidFormat: Boolean; + protected + procedure Scan; + public + constructor Create(const FileName: TFileName); + destructor Destroy; override; + property MembersList: TStrings read FMembersList; + property ModuleFileName: TFileName read FModuleFileName; + property ValidFormat: Boolean read FValidFormat; + end; + +{ TJclTypeLibScanner } + +constructor TJclTypeLibScanner.Create(const FileName: TFileName); +begin + FMembersList := TStringList.Create; + FValidFormat := Succeeded(LoadTypeLib(PWideChar(WideString(FileName)), FTypeLib)); + if FValidFormat then + Scan; +end; + +destructor TJclTypeLibScanner.Destroy; +begin + FreeAndNil(FMembersList); + inherited; +end; + +procedure TJclTypeLibScanner.Scan; +var + TypeInfondex, FuncIndex: Integer; + TypeInfo: ITypeInfo; + TypeAttr: PTypeAttr; + RefType: HRefType; + + function GetTypeInfoName(TI: ITypeInfo; MemID: TMemberID): string; + var + Name: WideString; + begin + if Succeeded(TI.GetDocumentation(MemID, @Name, nil, nil, nil)) then + Result := Name + else + Result := ''; + end; + + procedure EnumTypeInfoMembers(MemTypeInfo: ITypeInfo; MemTypeAttr: PTypeAttr; + MemUnknown: IUnknown); + var + VTable: DWORD; + InterfaceName, MemberName, Name: string; + I: Integer; + FuncDesc: PFuncDesc; + Addr: DWORD; + begin + VTable := PDWORD(MemUnknown)^; + if MemTypeAttr.cFuncs = 0 then + Exit; + InterfaceName := GetTypeInfoName(MemTypeInfo, -1); + for I := 0 to MemTypeAttr.cFuncs - 1 do + begin + MemTypeInfo.GetFuncDesc(I, FuncDesc); + MemberName := GetTypeInfoName(MemTypeInfo, FuncDesc.memid); + Addr := PDWORD(Integer(VTable) + FuncDesc.oVft)^; + if FModuleFileName = '' then + FModuleFileName := GetModulePath(ModuleFromAddr(Pointer(Addr))); + Dec(Addr, ModuleFromAddr(Pointer(Addr))); + Name := InterfaceName + '.' + MemberName; + case FuncDesc.invkind of + INVOKE_PROPERTYGET: + Name := Name + '_Get'; + INVOKE_PROPERTYPUT: + Name := Name + '_Put'; + INVOKE_PROPERTYPUTREF: + Name := Name + '_PutRef'; + end; + MemTypeInfo.ReleaseFuncDesc(FuncDesc); + FMembersList.AddObject(Name, Pointer(Addr)); + end; + end; + + procedure ProcessReferencedTypeInfo; + var + RefTypeInfo: ITypeInfo; + RefTypeAttr: PTypeAttr; + Unknown: IUnknown; + R: HRESULT; + begin + if Succeeded(TypeInfo.GetRefTypeInfo(RefType, RefTypeInfo)) and + Succeeded(RefTypeInfo.GetTypeAttr(RefTypeAttr)) then + begin + R := CoCreateInstance(TypeAttr.guid, nil, CLSCTX_INPROC_SERVER or CLSCTX_INPROC_HANDLER, + RefTypeAttr.guid, Unknown); + if Succeeded(R) and (Unknown <> nil) then + EnumTypeInfoMembers(RefTypeInfo, RefTypeAttr, Unknown); + RefTypeInfo.ReleaseTypeAttr(RefTypeAttr); + end; + end; + +begin + for TypeInfondex := 0 to FTypeLib.GetTypeInfoCount - 1 do + begin + FTypeLib.GetTypeInfo(TypeInfondex, TypeInfo); + if Succeeded(TypeInfo.GetTypeAttr(TypeAttr)) then + begin + if TypeAttr.typeKind = TKIND_COCLASS then + for FuncIndex := 0 to TypeAttr.cImplTypes - 1 do + if Succeeded(TypeInfo.GetRefTypeOfImplType(FuncIndex, RefType)) then + ProcessReferencedTypeInfo; + TypeInfo.ReleaseTypeAttr(TypeAttr); + end; + end; + FTypeLib := nil; +end; + +{ TMainForm } + +procedure TMainForm.FormCreate(Sender: TObject); +begin + FMembersList := TStringList.Create; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FMembersList); +end; + +procedure TMainForm.Exit1Execute(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.Open1Execute(Sender: TObject); +begin + with OpenDialog1 do + begin + FileName := ''; + if Execute then + OpenTypeLibrary(FileName); + end; +end; + +function SortPublicsByValue(List: TStringList; Index1, Index2: Integer): Integer; +begin + Result := DWORD(List.Objects[Index1]) - DWORD(List.Objects[Index2]); +end; + +procedure TMainForm.CreateMAP1Execute(Sender: TObject); +var + MapList: TStringList; + PeImage: TJclPeImage; + LoAddress, HiAddress: DWORD; + CodeSection: TImageSectionHeader; + MapFileName: TFileName; + + procedure WriteList; + var + I: Integer; + begin + for I := 0 to FMembersList.Count - 1 do + MapList.Add(Format(' 0001:%.8x %s', + [DWORD(FMembersList.Objects[I]) - CodeSection.VirtualAddress, FMembersList[I]])); + end; + +begin + Screen.Cursor := crHourGlass; + MapList := TStringList.Create; + PeImage := TJclPeImage.Create; + try + PeImage.FileName := FFileName; + CodeSection := PeImage.ImageSectionHeaders[0]; + FMembersList.CustomSort(SortPublicsByValue); + LoAddress := DWORD(FMembersList.Objects[0]); + HiAddress := DWORD(FMembersList.Objects[FMembersList.Count - 1]); + FMembersList.Sort; + Assert(LoAddress >= CodeSection.VirtualAddress); + MapList.Add(''); + MapList.Add(' Start Length Name Class'); + MapList.Add(Format(' %.4x:%.8x %.8xH %s CODE', + [1, CodeSection.VirtualAddress, CodeSection.Misc.VirtualSize, + PeImage.ImageSectionNames[0]])); + MapList.Add(''); + MapList.Add(''); + MapList.Add('Detailed map of segments'); + MapList.Add(''); + MapList.Add(Format(' 0001:00000000 %.8xH C=CODE S=.text G=(none) M=%s', + [HiAddress, PathExtractFileNameNoExt(FFileName)])); + MapList.Add(''); + MapList.Add(''); + MapList.Add('Address Publics by Name'); + MapList.Add(''); + WriteList; + MapList.Add(''); + MapList.Add(''); + FMembersList.CustomSort(SortPublicsByValue); + MapList.Add('Address Publics by Value'); + MapList.Add(''); + WriteList; + FMembersList.Sort; + MapFileName := ChangeFileExt(FFileName, '.map'); + MapList.SaveToFile(MapFileName); + if TAction(Sender).Tag = 1 then + begin + ConvertMapFileToJdbgFile(MapFileName); + DeleteFile(MapFileName); + end; + finally + PeImage.Free; + MapList.Free; + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.CreateMAP1Update(Sender: TObject); +begin + TAction(Sender).Enabled := MethodsListView.Items.Count > 0; +end; + +procedure TMainForm.MethodsListViewData(Sender: TObject; Item: TListItem); +begin + with Item do + begin + Caption := FMembersList[Index]; + SubItems.Add(Format('%p', [Pointer(FMembersList.Objects[Index])])); + ImageIndex := 3; + end; +end; + +procedure TMainForm.OpenTypeLibrary(const FileName: TFileName); +var + TypeLibScanner: TJclTypeLibScanner; + ErrorMsg: string; +begin + Screen.Cursor := crHourGlass; + try + FMembersList.Clear; + MethodsListView.Items.Count := 0; + MethodsListView.Repaint; + StatusBar1.Panels[0].Text := RsReading; + StatusBar1.Repaint; + TypeLibScanner := TJclTypeLibScanner.Create(FileName); + try + if TypeLibScanner.ValidFormat and (TypeLibScanner.MembersList.Count > 0) then + begin + FMembersList.Assign(TypeLibScanner.MembersList); + FMembersList.Sort; + MethodsListView.Items.Count := FMembersList.Count; + MethodsListView.Invalidate; + SetFileName(TypeLibScanner.ModuleFileName); + end + else + begin + Screen.Cursor := crDefault; + SetFileName(''); + if TypeLibScanner.ValidFormat then + ErrorMsg := RsNoCoClass + else + ErrorMsg := RsNoTypeLib; + with Application do + MessageBox(PChar(ErrorMsg), PChar(Title), MB_ICONERROR or MB_OK); + end; + finally + TypeLibScanner.Free; + end; + finally + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.SetFileName(const Value: TFileName); +begin + FFileName := Value; + StatusBar1.Panels[0].Text := Value; + StatusBar1.Repaint; + VersionMemo.Lines.Clear; + if VersionResourceAvailable(Value) then + with TJclFileVersionInfo.Create(Value) do + try + VersionMemo.Lines.Assign(Items); + finally + Free; + end; + DisableAlign; + VersionMemo.Visible := VersionMemo.Lines.Count > 0; + Splitter1.Visible := VersionMemo.Visible; + EnableAlign; + VersionMemo.Repaint; +end; + +// History: + +// $Log: TlbToMapMain.pas,v $ +// Revision 1.2 2005/10/26 03:29:44 rrossmair +// - improved header information, added Date and Log CVS tags. +// + +end. diff --git a/official/1.96/experts/debug/tools/Tools.bpg b/official/1.96/experts/debug/tools/Tools.bpg new file mode 100644 index 0000000..99d9643 --- /dev/null +++ b/official/1.96/experts/debug/tools/Tools.bpg @@ -0,0 +1,26 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = MakeJclDbg.exe MapToJdbg.exe TlbToMap.exe +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +MakeJclDbg.exe: MakeJclDbg.dpr + $(DCC) + +MapToJdbg.exe: MapToJdbg.dpr + $(DCC) + +TlbToMap.exe: TlbToMap.dpr + $(DCC) + + diff --git a/official/1.96/experts/debug/tools/makejcldbg.res b/official/1.96/experts/debug/tools/makejcldbg.res new file mode 100644 index 0000000..ba101a9 Binary files /dev/null and b/official/1.96/experts/debug/tools/makejcldbg.res differ diff --git a/official/1.96/experts/favfolders/FavDlg.rc b/official/1.96/experts/favfolders/FavDlg.rc new file mode 100644 index 0000000..9f54e54 --- /dev/null +++ b/official/1.96/experts/favfolders/FavDlg.rc @@ -0,0 +1,5 @@ +FAVDLGTEMPLATE DIALOG 0, 0, 340, 20 +STYLE WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS | DS_CONTROL +FONT 8, "Courier New" +BEGIN +END diff --git a/official/1.96/experts/favfolders/FavDlg.res b/official/1.96/experts/favfolders/FavDlg.res new file mode 100644 index 0000000..0659c10 Binary files /dev/null and b/official/1.96/experts/favfolders/FavDlg.res differ diff --git a/official/1.96/experts/favfolders/IdeOpenDlgFavoriteUnit.pas b/official/1.96/experts/favfolders/IdeOpenDlgFavoriteUnit.pas new file mode 100644 index 0000000..0e0ba0a --- /dev/null +++ b/official/1.96/experts/favfolders/IdeOpenDlgFavoriteUnit.pas @@ -0,0 +1,187 @@ +{**************************************************************************************************} +{ } +{ 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 IdeOpenDlgFavoriteUnit.pas. } +{ } +{ The Initial Developer of the Original Code is Petr Vones. } +{ Portions created by Petr Vones are Copyright (C) of Petr Vones. } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Petr Vones } +{ Last modified: $Date: 2006/01/08 17:16:57 $ } +{ } +{**************************************************************************************************} + +unit IdeOpenDlgFavoriteUnit; + +interface + +{$I jcl.inc} + +uses + SysUtils, + ToolsAPI, OpenDlgFavAdapter, + JclOtaUtils; + +type + TJclOpenDialogsFavoriteExpert = class(TJclOTAExpert) + private + FFavOpenDialog: TFavOpenDialog; + procedure DialogClose(Sender: TObject); + procedure DialogShow(Sender: TObject); + public + constructor Create; reintroduce; + destructor Destroy; override; + end; + +// design package entry point +procedure Register; + +// expert DLL entry point +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean; stdcall; + +implementation + +uses + JclFileUtils, JclSysInfo, + JclOtaConsts, JclOtaResources; + +procedure Register; +begin + try + RegisterPackageWizard(TJclOpenDialogsFavoriteExpert.Create); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +var + JCLWizardIndex: Integer = -1; + +procedure JclWizardTerminate; +var + OTAWizardServices: IOTAWizardServices; +begin + try + if JCLWizardIndex <> -1 then + begin + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + OTAWizardServices.RemoveWizard(JCLWizardIndex); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + end; + end; +end; + +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean stdcall; +var + OTAWizardServices: IOTAWizardServices; +begin + try + TerminateProc := JclWizardTerminate; + + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + JCLWizardIndex := OTAWizardServices.AddWizard(TJclOpenDialogsFavoriteExpert.Create); + + Result := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + Result := False; + end; + end; +end; + +constructor TJclOpenDialogsFavoriteExpert.Create; +begin + inherited Create(JclFavoritesExpertName); + FFavOpenDialog := InitializeFavOpenDialog; + FFavOpenDialog.DisableHelpButton := True; + FFavOpenDialog.HookDialogs; + FFavOpenDialog.OnClose := DialogClose; + FFavOpenDialog.OnShow := DialogShow; + FFavOpenDialog.PictureDialogLastFolder := Settings.LoadString(PictDialogFolderItemName, + PathAddSeparator(GetCommonFilesFolder) + BorlandImagesPath); +end; + +destructor TJclOpenDialogsFavoriteExpert.Destroy; +begin + FFavOpenDialog.UnhookDialogs; + inherited Destroy; +end; + +procedure TJclOpenDialogsFavoriteExpert.DialogClose(Sender: TObject); +begin + Settings.SaveStrings(JclFavoritesListSubKey, FFavOpenDialog.FavoriteFolders); + Settings.SaveString(PictDialogFolderItemName, FFavOpenDialog.PictureDialogLastFolder); +end; + +procedure TJclOpenDialogsFavoriteExpert.DialogShow(Sender: TObject); +begin + Settings.LoadStrings(JclFavoritesListSubKey, FFavOpenDialog.FavoriteFolders); +end; + +// History: + +// $Log: IdeOpenDlgFavoriteUnit.pas,v $ +// Revision 1.8 2006/01/08 17:16:57 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.7 2005/12/26 18:03:41 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.6 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.5 2005/10/26 03:29:44 rrossmair +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and $Log: IdeOpenDlgFavoriteUnit.pas,v $ +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.8 2006/01/08 17:16:57 outchy +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Settings reworked. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Common window for expert configurations +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.7 2005/12/26 18:03:41 outchy +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Enhanced bds support (including C#1 and D8) +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Introduction of dll experts +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Project types in templates +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.6 2005/12/16 23:46:25 outchy +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Added expert stack form. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Added code to display call stack on expert exception. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Fixed package extension for D2006. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and CVS tags. +// + +end. diff --git a/official/1.96/experts/favfolders/OpenDlgFavAdapter.pas b/official/1.96/experts/favfolders/OpenDlgFavAdapter.pas new file mode 100644 index 0000000..8a12dfc --- /dev/null +++ b/official/1.96/experts/favfolders/OpenDlgFavAdapter.pas @@ -0,0 +1,550 @@ +{**************************************************************************************************} +{ } +{ 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 } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Petr Vones } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/26 18:03:41 $ +// For history see end of file + +unit OpenDlgFavAdapter; + +interface + +{$I jcl.inc} + +uses + Windows, Messages, Classes, SysUtils, Controls, StdCtrls, ExtCtrls, + JclPeImage; + +type + TFavOpenDialog = class (TObject) + private + FAddButton: TButton; + FDeleteMode: Boolean; + FDisableHelpButton: Boolean; + FDisablePlacesBar: Boolean; + FFavoriteComboBox: TComboBox; + FFavoriteFolders: TStrings; + FFavoritePanel: TPanel; + FHandle: HWND; + FHooks: TJclPeMapImgHooks; + FIsOpenPictDialog: Boolean; + FParentWnd: HWND; + FParentWndInstance: Pointer; + FOldParentWndInstance: Pointer; + FPictureDialogLastFolder: string; + FWndInstance: Pointer; + FOldWndInstance: Pointer; + FOnClose: TNotifyEvent; + FOnShow: TNotifyEvent; + procedure AddButtonClick(Sender: TObject); + procedure FavoriteComboBoxClick(Sender: TObject); + function GetCurrentFolder: string; + function GetFileNameEditWnd: HWND; + procedure SetCurrentFolder(const Value: string); + procedure SetDeleteMode(const Value: Boolean); + protected + procedure AdjustControlPos; + procedure DialogFolderChange; + procedure DialogShow; + procedure DoClose; + procedure DoShow; + procedure ParentWndProc(var Message: TMessage); virtual; + procedure WndProc(var Message: TMessage); virtual; + property CurrentFolder: string read GetCurrentFolder write SetCurrentFolder; + property DeleteMode: Boolean read FDeleteMode write SetDeleteMode; + property FileNameEditWnd: HWND read GetFileNameEditWnd; + public + constructor Create; + destructor Destroy; override; + procedure HookDialogs; + procedure LoadFavorites(const FileName: string); + procedure UnhookDialogs; + property DisableHelpButton: Boolean read FDisableHelpButton write FDisableHelpButton; + property DisablePlacesBar: Boolean read FDisablePlacesBar write FDisablePlacesBar; + property FavoriteFolders: TStrings read FFavoriteFolders; + property IsOpenPictDialog: Boolean read FIsOpenPictDialog; + property PictureDialogLastFolder: string read FPictureDialogLastFolder write FPictureDialogLastFolder; + property OnClose: TNotifyEvent read FOnClose write FOnClose; + property OnShow: TNotifyEvent read FOnShow write FOnShow; + end; + +function InitializeFavOpenDialog: TFavOpenDialog; + +implementation + +uses + {$IFNDEF RTL140_UP} + Forms, + {$ENDIF ~RTL140_UP} + CommDlg, Dlgs, + JclFileUtils, JclStrings, JclSysInfo, JclSysUtils, + JclOtaConsts, JclOtaResources, JclOtaUtils; + +{$R FavDlg.res} + +type + TGetOpenFileName = function (var OpenFile: TOpenFilename): Bool; stdcall; + +var + OldGetOpenFileName: TGetOpenFileName; + OldGetSaveFileName: TGetOpenFileName; + OldExplorerHook: function(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall; + FavOpenDialog: TFavOpenDialog; + +function NewExplorerHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall; +begin + Result := OldExplorerHook(Wnd, Msg, WParam, LParam); + if (Msg = WM_INITDIALOG) and Assigned(FavOpenDialog) then + begin + FavOpenDialog.FHandle := Wnd; + FavOpenDialog.FOldWndInstance := Pointer(SetWindowLong(Wnd, GWL_WNDPROC, Longint(FavOpenDialog.FWndInstance))); + CallWindowProc(FavOpenDialog.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(FavOpenDialog) then + FavOpenDialog.FIsOpenPictDialog := False; + if Flags and OFN_ENABLETEMPLATE = 0 then + begin + OldExplorerHook := lpfnHook; + lpfnHook := NewExplorerHook; + lpTemplateName := FavDialogTemplateName; + hInstance := FindResourceHInstance(FindClassHInstance(TFavOpenDialog)); + Flags := Flags or OFN_ENABLETEMPLATE; + if Assigned(FavOpenDialog) then + begin + if FavOpenDialog.DisableHelpButton then + Flags := Flags and (not OFN_SHOWHELP); + {$IFDEF DELPHI6_UP} + if FavOpenDialog.DisablePlacesBar and (lStructSize = SizeOf(TOpenFilename)) then + FlagsEx := FlagsEx or OFN_EX_NOPLACESBAR; + {$ENDIF DELPHI6_UP} + end; + end + else + if (StrIComp(lpTemplateName, OpenPictDialogTemplateName) = 0) and Assigned(FavOpenDialog) then + begin + FavOpenDialog.FIsOpenPictDialog := True; + OldExplorerHook := lpfnHook; + lpfnHook := NewExplorerHook; + InitDir := FavOpenDialog.PictureDialogLastFolder; + if DirectoryExists(InitDir) then + lpstrInitialDir := PChar(FavOpenDialog.PictureDialogLastFolder) + else + FavOpenDialog.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; + +function InitializeFavOpenDialog: TFavOpenDialog; +begin + if not Assigned(FavOpenDialog) then + FavOpenDialog := TFavOpenDialog.Create; + Result := FavOpenDialog; +end; + +//=== { TFavOpenDialog } ===================================================== + +constructor TFavOpenDialog.Create; +begin + inherited Create; + FFavoriteFolders := TStringList.Create; + FHooks := TJclPeMapImgHooks.Create; + FParentWndInstance := MakeObjectInstance(ParentWndProc); + FWndInstance := MakeObjectInstance(WndProc); + FFavoritePanel := TPanel.Create(nil); + with FFavoritePanel do + begin + Name := 'FavoritePanel'; + BevelOuter := bvNone; + Caption := ''; + FullRepaint := False; + FFavoriteComboBox := TComboBox.Create(FFavoritePanel); + with FFavoriteComboBox do + begin + SetBounds(6, 14, 300, Height); + Style := csDropDownList; + Sorted := True; + OnClick := FavoriteComboBoxClick; + Parent := FFavoritePanel; + end; + with TStaticText.Create(FFavoritePanel) do + begin + AutoSize := False; + SetBounds(6, 0, 100, 14); + Caption := RsFavorites; + FocusControl := FFavoriteComboBox; + Parent := FFavoritePanel; + end; + FAddButton := TButton.Create(FFavoritePanel); + with FAddButton do + begin + SetBounds(333, 14, 75, 23); + Caption := RsAdd; + OnClick := AddButtonClick; + Parent := FFavoritePanel; + end; + end; +end; + +destructor TFavOpenDialog.Destroy; +begin + UnhookDialogs; + FreeObjectInstance(FParentWndInstance); + FreeObjectInstance(FWndInstance); + FreeAndNil(FFavoritePanel); + FreeAndNil(FFavoriteFolders); + FreeAndNil(FHooks); + inherited Destroy; +end; + +procedure TFavOpenDialog.AddButtonClick(Sender: TObject); +var + I: Integer; + Path: string; +begin + if DeleteMode then + begin + I := FFavoriteComboBox.ItemIndex; + Path := FFavoriteComboBox.Items[I]; + if MessageBox(FHandle, PChar(Format(RsDelConfirm, [Path])), PChar(RsConfirmation), + MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = ID_YES then + begin + FFavoriteComboBox.Items.Delete(I); + DeleteMode := False; + end; + end + else + begin + Path := CurrentFolder; + I := FFavoriteComboBox.Items.IndexOf(Path); + if I = -1 then + begin + FFavoriteComboBox.Items.Add(Path); + I := FFavoriteComboBox.Items.IndexOf(Path); + FFavoriteComboBox.ItemIndex := I; + DeleteMode := True; + end; + end; +end; + +procedure TFavOpenDialog.AdjustControlPos; +var + ParentRect, FileNameEditRect, OkButtonRect: TRect; + + procedure GetDlgItemRect(ItemID: Integer; var R: TRect); + begin + GetWindowRect(GetDlgItem(FParentWnd, ItemID), R); + MapWindowPoints(0, FParentWnd, R, 2); + end; + +begin + GetWindowRect(FParentWnd, ParentRect); + if GetDlgItem(FParentWnd, edt1) <> 0 then + GetDlgItemRect(edt1, FileNameEditRect) + else + GetDlgItemRect(cmb1, FileNameEditRect); + GetDlgItemRect(1, OkButtonRect); + +// Salvatore Besso: Changes to avoid truncation of Add button. I don't know why, but debugging I +// have discovered that ParentRect.Right was equal to 1024, ie Screen.Width. I also can't figure +// out why I can't preserve original help button that disappears using this expert. +// As visible in the changes, favorite panel width is just left of the original button column. + + if IsWin2k or IsWinXP then + FAddButton.Width := 65; + FFavoritePanel.Width := OkButtonRect.Left - 1; + FFavoriteComboBox.Width := FFavoritePanel.Width - FFavoriteComboBox.Left - FAddButton.Width - 16; + FAddButton.Left := FFavoriteComboBox.Width + 14; +end; + +procedure TFavOpenDialog.DialogFolderChange; +var + Path: string; +begin + Path := CurrentFolder; + with FFavoriteComboBox do + begin + ItemIndex := Items.IndexOf(Path); + DeleteMode := (ItemIndex <> -1); + end; +end; + +procedure TFavOpenDialog.DialogShow; +var + PreviewRect: TRect; +begin + FParentWnd := GetParent(FHandle); + if IsOpenPictDialog then + DoShow + else + begin + GetClientRect(FHandle, PreviewRect); + PreviewRect.Top := PreviewRect.Bottom - 43; + FFavoritePanel.BoundsRect := PreviewRect; + FFavoritePanel.ParentWindow := FHandle; + if IsWin2k or IsWinXP then + FOldParentWndInstance := Pointer(SetWindowLong(FParentWnd, GWL_WNDPROC, Longint(FParentWndInstance))); + AdjustControlPos; + try + DoShow; + finally + FFavoriteComboBox.Items.Assign(FavoriteFolders); + end; + end; +end; + +procedure TFavOpenDialog.DoClose; +begin + if Assigned(FOnClose) then + FOnClose(Self); +end; + +procedure TFavOpenDialog.DoShow; +begin + if Assigned(FOnShow) then + FOnShow(Self); +end; + +procedure TFavOpenDialog.FavoriteComboBoxClick(Sender: TObject); +begin + with FFavoriteComboBox do + if ItemIndex <> - 1 then + CurrentFolder := FFavoriteComboBox.Items[ItemIndex]; +end; + +function TFavOpenDialog.GetCurrentFolder: string; +var + Path: array [0..MAX_PATH] of Char; +begin + SetString(Result, Path, SendMessage(FParentWnd, CDM_GETFOLDERPATH, SizeOf(Path), Integer(@Path))); + StrResetLength(Result); +end; + +function TFavOpenDialog.GetFileNameEditWnd: HWND; +begin + Result := GetDlgItem(FParentWnd, edt1); + if Result = 0 then + Result := GetDlgItem(FParentWnd, cmb13); +end; + +procedure TFavOpenDialog.HookDialogs; + procedure HookImportsForModule(ModuleBase: Pointer); + const + comdlg32 = 'comdlg32.dll'; + begin + if ModuleBase <> nil then + begin + FHooks.HookImport(ModuleBase, comdlg32, 'GetOpenFileNameA', @NewGetOpenFileName, @OldGetOpenFileName); + FHooks.HookImport(ModuleBase, comdlg32, 'GetSaveFileNameA', @NewGetSaveFileName, @OldGetSaveFileName); + end; + end; +var + Pe: TJclPeImage; + I: Integer; + HookedModule: LongWord; +begin + { 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; +end; + +procedure TFavOpenDialog.LoadFavorites(const FileName: string); +begin + if FileExists(FileName) then + FavoriteFolders.LoadFromFile(FileName) + else + FavoriteFolders.Clear; +end; + +procedure TFavOpenDialog.ParentWndProc(var Message: TMessage); +begin + with Message do + begin + Result := CallWindowProc(FOldParentWndInstance, FParentWnd, Msg, WParam, LParam); + if Msg = WM_SIZE then + AdjustControlPos; + end; +end; + +procedure TFavOpenDialog.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; + +procedure TFavOpenDialog.SetDeleteMode(const Value: Boolean); +begin + if FDeleteMode <> Value then + begin + FDeleteMode := Value; + if FDeleteMode then + FAddButton.Caption := RsDelete + else + FAddButton.Caption := RsAdd; + FFavoriteComboBox.Invalidate; + end; +end; + +procedure TFavOpenDialog.UnhookDialogs; +var + I: Integer; +begin + I := 0; + while I < FHooks.Count do + if not FHooks[I].Unhook then + Inc(I); +end; + +procedure TFavOpenDialog.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: + DialogShow; + CDN_FOLDERCHANGE: + if not IsOpenPictDialog then + DialogFolderChange; + CDN_FILEOK: + if IsOpenPictDialog then + FPictureDialogLastFolder := CurrentFolder; + end; + Default; + end; + WM_DESTROY: + begin + if not IsOpenPictDialog then + FavoriteFolders.Assign(FFavoriteComboBox.Items); + try + DoClose; + Default; + finally + if not IsOpenPictDialog then + FFavoritePanel.ParentWindow := 0; + FParentWnd := 0; + end; + end; + WM_NCDESTROY: + begin + Default; + FHandle := 0; + end; + else + Default; + end; + end; +end; + +initialization + +finalization + +try + FreeAndNil(FavOpenDialog); +except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; +end; + + +// History: + +// $Log: OpenDlgFavAdapter.pas,v $ +// Revision 1.4 2005/12/26 18:03:41 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.3 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.2 2005/10/21 12:24:41 marquardt +// experts reorganized with new directory common +// +// Revision 1.1 2005/10/03 16:27:37 rrossmair +// - moved over from jcl\examples\vcl\idefavopendialogs +// +// Revision 1.5 2005/02/26 17:36:01 rrossmair +// - applied Salvatore Besso's fix for truncation of Add button when using large fonts. +// - some cleaning, module header updated. +// + +end. diff --git a/official/1.96/experts/projectanalyzer/ProjAnalyzerFrm.dfm b/official/1.96/experts/projectanalyzer/ProjAnalyzerFrm.dfm new file mode 100644 index 0000000..1ed5a0f --- /dev/null +++ b/official/1.96/experts/projectanalyzer/ProjAnalyzerFrm.dfm @@ -0,0 +1,872 @@ +object ProjectAnalyzerForm: TProjectAnalyzerForm + Left = 362 + Top = 263 + BorderIcons = [biSystemMenu] + BorderStyle = bsSizeToolWin + Caption = 'Project Analyzer' + ClientHeight = 456 + ClientWidth = 402 + Color = clBtnFace + Constraints.MinHeight = 250 + Constraints.MinWidth = 290 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object UnitListView: TListView + Left = 0 + Top = 40 + Width = 402 + Height = 397 + Align = alClient + Columns = < + item + Caption = 'Name' + ImageIndex = 0 + Width = 150 + end + item + Alignment = taRightJustify + Caption = 'Size' + Width = 70 + end + item + Caption = 'Group' + Width = 85 + end + item + Caption = 'Package' + Width = 90 + end> + ReadOnly = True + RowSelect = True + PopupMenu = PopupMenuUnitView + SmallImages = ExplorerItemImages + TabOrder = 0 + ViewStyle = vsReport + OnColumnClick = UnitListViewColumnClick + OnCompare = UnitListViewCompare + end + object ToolBarMain: TToolBar + Left = 0 + Top = 0 + Width = 402 + Height = 40 + AutoSize = True + ButtonHeight = 36 + ButtonWidth = 50 + Caption = 'ToolBarMain' + EdgeBorders = [ebTop, ebBottom] + Images = ExplorerItemImages + Indent = 4 + PopupMenu = PopupMenuToolbar + ShowCaptions = True + TabOrder = 1 + object ToolButtonCopy: TToolButton + Left = 4 + Top = 0 + Action = ActionCopy + end + object ToolButtonSave: TToolButton + Left = 54 + Top = 0 + Action = ActionSave + end + object ToolButtonSeparator: TToolButton + Left = 104 + Top = 0 + Width = 8 + ImageIndex = 3 + Style = tbsSeparator + end + object ToolButtonDetails: TToolButton + Left = 112 + Top = 0 + Action = ActionShowDetails + Grouped = True + Style = tbsCheck + end + object ToolButtonSummary: TToolButton + Left = 162 + Top = 0 + Action = ActionShowSummary + Grouped = True + Style = tbsCheck + end + object ToolButtonDfms: TToolButton + Left = 212 + Top = 0 + Action = ActionShowDfms + Grouped = True + Style = tbsCheck + end + end + object StatusBarMain: TStatusBar + Left = 0 + Top = 437 + Width = 402 + Height = 19 + Panels = < + item + Width = 50 + end> + end + object ExplorerItemImages: TImageList + Left = 8 + Top = 392 + Bitmap = { + 494C010112001300040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000005000000001002000000000000050 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F000000 + 00007F7F7F007F7F7F0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF000000 + 0000BFBFBF00BFBFBF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF + BF00BFBFBF00BFBFBF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000FFFFFF00000000000000000000000000FFFF + FF000000000000000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000FFFFFF00FFFFFF0000000000000000000000 + 00000000000000000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFF0000FFFF + 0000FFFF0000FFFF0000FFFF0000FFFFFF00FFFFFF0000000000FFFFFF000000 + FF00FFFFFF00FF000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000BFBFBF0000000000FF000000FF000000FF00 + 00000000FF00FF000000FF0000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF000000 + FF00FFFFFF00FF000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF00000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFF + FF00FFFFFF00FF000000FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF0000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF00000000000000000000000000FF000000FF000000FF00 + 0000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF00 + 0000FF000000FF000000FF000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF00000000000000000000000000BFBFBF00BFBFBF00FF00 + 0000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF00 + 0000FF000000BFBFBF00BFBFBF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000FF000000840000008400000000000000000000000000000000000000 + 8400000084000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000084848400848484008484 + 8400848484008484840084848400848484008484840084848400848484008484 + 8400848484008484840084848400000000000000000000000000848484008484 + 8400848484008484840084848400848484008484840084848400848484008484 + 8400848484008484840000000000000000000000000000000000000000000000 + 00000000FF000000FF00000084000000840000000000000000000000FF000000 + FF00000084008484840000000000000000000000000000000000000000000000 + 000000000000000000000000000000FFFF007F7F7F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000FFFF00000000000000000084848400FFFFFF0000FF + FF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FF + FF00C6C6C60000FFFF008484840000000000000000000000000084848400FFFF + FF0000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6 + C60000FFFF008484840000000000000000000000000000000000000000000000 + 0000000000000000FF000000FF0000008400000000000000FF000000FF000000 + FF00000084008484840000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000007F7F7F007F7F + 7F0000000000000000007F7F7F00000000000000000084848400FFFFFF00C6C6 + C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6 + C60000FFFF00C6C6C60084848400000000000000000084848400FFFFFF0000FF + FF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FF + FF00C6C6C6000000000084848400000000000000000000000000000000000000 + FF0000000000848484000000FF000000FF000000FF000000FF00000084000000 + 84000084840000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F007F7F7F0000FFFF00000000000000000084848400FFFFFF0000FF + FF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FF + FF00C6C6C60000FFFF0084848400000000000000000084848400FFFFFF00C6C6 + C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6 + C600848484000000000084848400000000000000000000000000000000000000 + FF000000FF00000000000000FF000000FF000000FF000000FF0000FFFF000084 + 84000084840000848400000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007F7F7F0000FFFF0000FFFF00000000000000000084848400FFFFFF00C6C6 + C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6 + C60000FFFF00C6C6C600848484000000000084848400FFFFFF00C6C6C60000FF + FF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FF + FF00000000008484840084848400000000000000000000000000000000000000 + FF000000FF000000FF00000000000000FF000000FF000000FF0000FFFF000084 + 84000084840000848400000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF00000000000000000000000000FFFFFF0000000000000000000000 + 00000000FF0000000000000000007F7F7F000000000084848400FFFFFF0000FF + FF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FF + FF00C6C6C60000FFFF00848484000000000084848400FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008484 + 840000000000C6C6C60084848400000000000000000000000000000000000000 + FF000000FF00000084000000FF000000FF000000FF000000FF00008484000084 + 84000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + FF000000FF000000FF0000000000000000000000000084848400FFFFFF00C6C6 + C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6 + C60000FFFF00C6C6C60084848400000000008484840084848400848484008484 + 8400848484008484840084848400848484008484840084848400848484008484 + 84008484840000FFFF0084848400000000000000000000000000000000000000 + FF000000FF00000084000000FF000000FF000000FF0000008400000084008484 + 84008484840000000000000000000000000000000000FFFFFF00000000000000 + 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000 + FF000000FF000000FF000000FF00000000000000000084848400FFFFFF0000FF + FF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FF + FF00C6C6C60000FFFF0084848400000000000000000084848400FFFFFF00C6C6 + C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6 + C60000FFFF00C6C6C60084848400000000000000000000000000000000000000 + FF00000084000000FF000000FF000000FF000000FF000000FF00000084000000 + 84008484840000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000 + FF000000FF000000FF000000FF000000FF000000000084848400FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0084848400000000000000000084848400FFFFFF0000FF + FF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C600FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0084848400000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000FF00848400000000FF000000FF000000 + 84000000840000008400000000000000000000000000FFFFFF00000000000000 + 0000FFFFFF000000000000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000000000084848400C6C6C60000FF + FF00C6C6C60000FFFF00C6C6C60000FFFF00C6C6C60084848400848484008484 + 8400848484008484840084848400000000000000000084848400FFFFFF00C6C6 + C60000FFFF00C6C6C60000FFFF00C6C6C600FFFFFF0084848400848484008484 + 8400848484008484840084848400000000000000000000000000000000000000 + 00000000FF000000FF000000FF000000000000000000FF0000000000FF000000 + FF000000FF0000008400000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000 + FF000000FF000000FF000000000000000000000000000000000084848400C6C6 + C60000FFFF00C6C6C60000FFFF00C6C6C6008484840000000000000000000000 + 000000000000000000000000000000000000000000000000000084848400FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008484840000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008484000084840000FF0000008400 + 00000000FF0000000000000000000000000000000000FFFFFF0000000000BFBF + BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000 + FF000000FF000000FF0000000000000000000000000000000000000000008484 + 8400848484008484840084848400848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 8400848484008484840084848400848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000 + FF000000FF000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000C6C6C600C6C6C6008484840084848400000000000000 + 0000848484008484840084848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 0000C6C6C600C6C6C600C6C6C600C6C6C6008484840084848400848484008484 + 8400000000000000000084848400848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000848484008484840000000000000000000000000000000000C6C6C600C6C6 + C600C6C6C600C6C6C600C6C6C600C6C6C6008484840084848400848484008484 + 8400848484000000000084848400000000000000000000000000000000000000 + 0000000000008484840084848400848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484840084848400848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484840000000000000000000000000084848400008484000084 + 84000000000084848400000000000000000084848400C6C6C600C6C6C600C6C6 + C600C6C6C600C6C6C600FFFFFF00FFFFFF008484840084848400848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000848484008484840000000000848484008484 + 8400848484008484840000000000000000000000000000000000000000000000 + 0000000000000000000000000000848484008484840000000000848484008484 + 8400848484008484840000000000000000000000000000000000000000000000 + FF00000000008484840084848400848484000084840000848400008484000084 + 84000084840000000000000000000000000084848400C6C6C600C6C6C600C6C6 + C600FFFFFF00FFFFFF008484840084848400FFFFFF00FFFFFF00848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 000000FF000000FF000000840000000000008484840000FF000000FF000000FF + 000000FF00008484840000000000000000000000000000000000000000000000 + 000000FFFF0000FFFF0000848400000000008484840000FFFF0000FFFF0000FF + FF0000FFFF008484840000000000000000000000000000000000000000000000 + FF000000FF000000000084848400848484000084840000FFFF00008484000084 + 84000084840000848400000000000000000084848400C6C6C600FFFFFF00FFFF + FF00848484008484840000000000848484008484840000000000FFFFFF00FFFF + FF008484840000000000000000000000000000000000000000000000000000FF + 000000FF000000FF00000084000000000000848484000084000000FF000000FF + 000000FF000084848400000000000000000000000000000000000000000000FF + FF0000FFFF0000FFFF000084840000000000848484000084840000FFFF0000FF + FF0000FFFF008484840000000000000000000000000000000000000000000000 + FF000000FF000000FF0000000000000000000084840000FFFF0000FFFF000084 + 84000084840000848400000000000000000084848400FFFFFF00848484008484 + 84000000FF000000FF0000848400008484000084840000848400000000000000 + 0000FFFFFF00000000000000000000000000000000008484840000FF000000FF + 000000FF0000848484000084000000000000000000000000000000FF000000FF + 000000FF0000848484000000000000000000000000008484840000FFFF0000FF + FF0000FFFF00848484000084840000000000000000000000000000FFFF0000FF + FF0000FFFF008484840000000000000000000000000000000000000000000000 + FF000000FF000000840000008400000084000000000000000000008484000084 + 8400000000000000000000000000000000000000000084848400848484000000 + FF000000FF000000FF000084840000FFFF000084840000848400008484000000 + 00000000000000000000000000000000000000000000000000008484840000FF + 0000848484008484840000840000008400000084000000FF000000FF000000FF + 000000FF000084848400000000000000000000000000000000008484840000FF + FF00848484008484840000848400008484000084840000FFFF0000FFFF0000FF + FF0000FFFF008484840000000000000000000000000000000000000000000000 + FF000000FF000000840000000000000000008484840084848400848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + FF000000FF000000840000848400848484008484840000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 84000000000084848400008400000084000000FF000000FF000000FF00000000 + 000000FF00000000000000000000000000000000000000000000000000008484 + 84000000000084848400008484000084840000FFFF0000FFFF0000FFFF000000 + 000000FFFF000000000000000000000000000000000000000000000000000000 + FF0000008400000000000000000084848400FF00000084840000FF0000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + FF00000084000000840000000000000000000000000084848400848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 000000000000848484000084000000FF000000FF000000FF0000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000848484000084840000FFFF0000FFFF0000FFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008484000084840000FF0000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 8400000084000000000084848400C6C6C600C6C6C60084848400848484008484 + 8400848484008484840000000000000000000000000000000000000000000000 + 0000000000008484840000FF000000FF000000FF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484840000FFFF0000FFFF0000FFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FF000000FF0000000000 + 0000848484000000000000000000000000000000000000000000000000008484 + 8400C6C6C600C6C6C600C6C6C600C6C6C600C6C6C60084848400848484008484 + 8400848484008484840000000000000000000000000000000000000000000000 + 000000000000000000008484840000FF00000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000008484840000FFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008484000084840000FF0000008400 + 0000000000000000000000000000000000000000000084848400FFFFFF00C6C6 + C600C6C6C600C6C6C600C6C6C6008484840084848400C6C6C600C6C6C600C6C6 + C600C6C6C6000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000084848400FFFF + FF00C6C6C6008484840084848400C6C6C600C6C6C600C6C6C600000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 840084848400C6C6C600C6C6C600000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 8400848484008484840000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 8400848484008484840000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 8400000000000000000084848400000000000000000084848400000000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484840084848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484840084848400000000000000000000000000000000000000 + 0000000000000000000000000000000000008484840000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 8400000000000000000084848400000000000000000084848400848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 0000848484000000000000000000000000000000000084848400008484000084 + 8400008484000000000084848400848484000000000000000000000000000000 + 0000848484000000000000000000000000000000000084848400008484008484 + 8400008484000000000084848400000000000000000000000000000000000000 + 000000000000848484008484840084848400C6C6C60084848400000000000000 + 0000000000000000000000000000000000000000000084848400848484000000 + 0000848484008484840000000000848484008484840000000000000000008484 + 8400848484008484840084848400000000000000000000000000000000008484 + 8400848484008484840000000000000000000000000000848400008484000084 + 8400008484000084840000000000848484000000000000000000000000008484 + 8400848484008484840000000000000000000000000000848400848484000000 + 0000000000000084840000000000848484000000000000000000000000008484 + 840084848400FFFFFF00C6C6C600FFFFFF00C6C6C60084848400848484000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 8400848484000000000084848400000000008484840000848400008484000000 + 000084848400000000000000000000000000000000000000FF00000000000000 + 0000848484008484840084848400848484000084840000848400008484000084 + 840000848400008484000000000084848400000000000000FF00000000000000 + 0000848484008484840084848400848484000084840084848400000000000000 + 000000000000000000000000000084848400000000000000000084848400C6C6 + C600FFFFFF00C6C6C600FFFFFF00C6C6C600C6C6C60084848400848484008484 + 84000000000000000000000000000000000000000000000000000000FF000000 + 0000848484008484840084848400008484000084840000848400008484000084 + 840000000000000000000000000000000000000000000000FF000000FF000000 + FF00000000008484840084848400848484000084840000FFFF00008484000084 + 840000848400008484000084840000000000000000000000FF00848484000000 + FF00000000008484840084848400848484000084840084848400848484000000 + 000000000000000000000084840084848400000000000000000084848400FFFF + FF00C6C6C600FFFFFF00C6C6C600FFFFFF00C6C6C60084848400848484008484 + 84008484840000000000000000000000000000000000848484000000FF000000 + FF000000000084848400848484000084840000FFFF0000848400008484000084 + 840000848400848484008484840000000000000000000000FF000000FF000000 + FF000000FF000000000000000000848484000084840000FFFF0000FFFF000084 + 840000848400008484000084840000000000000000000000FF00848484000000 + 00000000FF000000000000000000848484000084840000FFFF00848484008484 + 840000000000000000000084840000000000000000000000000084848400C6C6 + C600FFFFFF00FFFFFF00C6C6C600C6C6C600C6C6C60084848400848484008484 + 84008484840000000000000000000000000000000000000000000000FF000000 + FF000000FF0000000000000000000084840000FFFF0000FFFF00008484000084 + 840000848400000000000000000000000000000000000000FF000000FF000000 + FF0000008400000084000000840000000000000000008484840000FFFF0000FF + FF0000848400008484000000000000000000000000000000FF00848484000000 + 000000000000848484008484840000000000000000000000000000FFFF008484 + 840084848400008484000000000000000000000000000000000084848400FFFF + FF00C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600848484008484 + 84008484840000000000000000000000000000000000000000000000FF000000 + FF00000084000000840000008400000000000000000000848400008484000000 + 000084848400000000000000000000000000000000000000FF000000FF000000 + 8400000084000000840000008400000000000000000000000000008484000084 + 840000848400000000000000000000000000000000000000FF00848484008484 + 8400848484000000840000008400000000000000000000000000008484000084 + 840000848400000000000000000000000000000000000000000084848400C6C6 + C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C6008484 + 84008484840000000000000000000000000000000000848484000000FF000000 + FF00000084008484840000000000848484008484840084848400848484008484 + 840000000000848484008484840000000000000000000000FF000000FF000000 + 8400000084000000000000000000848484008484840084848400848484008484 + 840084848400848484000000000000000000000000000000FF00848484000000 + 8400000084000000000000000000848484008484840084848400848484008484 + 840084848400848484000000000000000000000000000000000084848400C6C6 + C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C6008484 + 84008484840000000000000000000000000000000000000000000000FF000000 + 8400000000000000000084848400FF00000084840000FF000000000000008484 + 840084848400000000000000000000000000000000000000FF00000084000000 + 000000000000000000008484840000000000FF00000084840000FF000000FF00 + 000000000000848484000000000000000000000000000000FF00000084000000 + 000000000000000000008484840084848400FF00000084840000FF000000FF00 + 0000000000008484840000000000000000000000000000000000000000008484 + 8400C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6 + C600848484008484840000000000000000000000000000000000000000008484 + 84000000000000000000848484008484000084840000FF000000000000008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFF000000000000FF000000FF000000FF00 + 0000000000008484840000000000000000000000000000000000000000000000 + 00000000000000000000FFFF0000848484000000000000000000000000000000 + 0000000000008484840000000000000000000000000000000000000000000000 + 000084848400C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600848484008484 + 8400000000000000000000000000000000000000000084848400848484000000 + 000084848400848484000000000084848400FF000000FF000000000000008484 + 8400000000008484840084848400000000000000000000000000000000000000 + 0000000000000000000000000000000000008484000084840000FF000000FF00 + 0000000000008484840000000000000000000000000000000000000000000000 + 0000000000000000000000000000848484000000000000000000000000000000 + 0000000000008484840000000000000000000000000000000000000000000000 + 00000000000084848400C6C6C600C6C6C6008484840084848400000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 84000000000000000000848484008484000084840000FF000000840000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFF000000000000FF000000FF000000FF00 + 0000000000008484840000000000000000000000000000000000000000000000 + 00000000000000000000FFFF0000848484000000000000000000000000000000 + 0000000000008484840000000000000000000000000000000000000000000000 + 0000000000000000000084848400848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008484 + 8400000000000000000084848400000000000000000084848400000000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008484000084840000FF000000FF00 + 0000840000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000848484008484840084848400848484008484 + 8400840000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF + 0000FFFF00000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000C6C6C600C6C6C6008484840084848400000000000000 + 0000848484008484840084848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000C6C6C600C6C6C600C6C6C600C6C6C6008484840084848400848484008484 + 8400000000000000000084848400848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000C6C6C600C6C6 + C600C6C6C600C6C6C600C6C6C600C6C6C6008484840084848400848484008484 + 8400848484000000000084848400000000000000000000000000000000000000 + 0000000000008484840084848400848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000080808000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000000000000000000000000000000000084848400C6C6C600C6C6C600C6C6 + C600C6C6C600C6C6C600FFFFFF00FFFFFF008484840084848400848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000848484008484840000000000848484008484 + 8400848484008484840000000000000000000000000000000000000000000000 + 000000000000000000008080800080808000FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000808080008080800000000000000000000000000000000000FFFFFF00FFFF + FF000000000000000000000000000000000084848400C6C6C600C6C6C600C6C6 + C600FFFFFF00FFFFFF008484840084848400FFFFFF00FFFFFF00848484008484 + 8400848484000000000000000000000000000000000000000000000000000000 + FF00000000008484840000840000000000008484840000FF000000FF000000FF + 000000FF00008484840000000000000000000000000000000000000000000000 + 00000000000000000000808080000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000FFFFFF000000 + 00000000000000000000000000000000000084848400C6C6C600FFFFFF00FFFF + FF00848484008484840000000000848484008484840000000000FFFFFF00FFFF + FF00848484000000000000000000000000000000000000000000000000000000 + FF000000FF00000000008484840000FFFF00848484000084000000FF000000FF + 000000FF00008484840000000000000000000000000000000000000000000000 + 00000000000080808000808080000000000000000000FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000080808000808080000000000000000000FFFFFF00FFFFFF000000 + 00000000000000000000000000000000000084848400FFFFFF00848484008484 + 84000000FF000000FF0000848400008484000084840000848400000000000000 + 0000FFFFFF0000000000000000000000000000000000848484000000FF000000 + FF000000FF00000000000000000000FFFF00000000000000000000FF000000FF + 000000FF00008484840000000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000808080000000000000000000FFFFFF00000000000000 + 0000000000000000000000000000000000000000000084848400848484000000 + FF000000FF000000FF000084840000FFFF000084840000848400008484008484 + 8400848484000000000000000000000000000000000000000000848484000000 + FF000000FF000000FF0000000000000000000084000000FF000000FF000000FF + 000000FF00008484840000000000000000000000000000000000000000000000 + 0000808080008080800000000000000000000000000000000000FFFFFF00FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000008080800080808000FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF00000084000084840000FFFF0000FFFF0000848400008484000084 + 8400000000000000000000000000000000000000000000000000000000000000 + FF000000FF0000008400000084000000840000FF000000FF000000FF00008484 + 000000FF00000000000000000000000000000000000000000000000000000000 + 0000808080008080800080808000808080008080800080808000808080008080 + 8000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000080808000FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF000000FF000000840084848400848484000084840000848400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF0000008400848484000084000000FF000000FF000000FF0000FF0000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + FF0000008400FF00000084840000FF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484840000FF000000FF000000FF000084840000FF0000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484000084840000FF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000008484840000FF000084840000FF000000FF0000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000FF000000FF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000008484000084840000FF0000008400 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484000084840000FF0000008400000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000500000000100010000000000800200000000000000000000 + 000000000000000000000000FFFFFF00FF00FFFF00000000FF00000000000000 + FF00000000000000FF0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000230000000000000001000000000000 + 00000000000000000023000000000000006300000000000000C3000000000000 + 0107FFFF0000000003FFFFFF00000000FFFFFFFFFFFFFC00FFFFFFFFFFFFFC00 + C000E000F1E7FC008000C000F0C3FC008000C000F883000080008000E0030000 + 80008000E003000080000000E003000080000000E00F002380000000E0070001 + 80008000E007000080008000F003002380018001F1830063C07FC07FFF0700C3 + E0FFE0FFFFFF0107FFFFFFFFFFFF03FFFFFFFC07FFFFFFFFFFFFF001FFFFFFFF + FFE7C000FFFFFFFFFFC30001F8FFF8FFFB830003F043F043E0030003E003E003 + E0030003C003C003E003000380038003E0CF8007C003C003E307E003E817E817 + E607E001F83FF83FFF07E001F87FF87FFF87C003FCFFFCFFFF0F8007FFFFFFFF + FFFFC03FFFFFFFFFFFFFE1FFFFFFFFFFFFFFFFFFFFE3FFE3FFFFEDB7FFC1FFC1 + FF3FED87F780F781F81F8001E380E398E00FE5078000803CC007C0078001801C + C00380018001900DC003C007808398C3C003C19781C781C7C003800186038603 + C003CC079D039C03E003EC07FE83FCF3F00F8001FF03FEF3F83FEC17FE83FCF3 + FCFFEDB7FF07FE07FFFFFFFFFE07FE07FFFFFFFFFC07FFFFFFFFFFFFF001FFFF + FFFFFFFFC000FFFFFFFFFFFF0001F8FFFE7FF00F0003F043FC3FF3CF0003E003 + FDBFFBDF0003C003F99FF99F00038003FBDFFDBF8007C003F3CFFC3FE00FE007 + F00FFE7FE03FE007FFFFFFFFE07FF807FFFFFFFFF87FFC07FFFFFFFFFC7FFF0F + FFFFFFFFF87FFFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000 + 000000000000} + end + object ActionListProjectAnalyser: TActionList + Images = ExplorerItemImages + Left = 40 + Top = 392 + object ActionCopy: TAction + Caption = 'Copy' + Hint = 'Copy to clipboard' + ImageIndex = 15 + OnExecute = ActionCopyExecute + end + object ActionSave: TAction + Caption = 'Save' + Hint = 'Save to text file' + ImageIndex = 16 + OnExecute = ActionSaveExecute + end + object ActionShowDetails: TAction + Tag = 1 + Caption = 'Details' + Hint = 'Detailed view' + ImageIndex = 3 + OnExecute = ActionShowDetailsExecute + OnUpdate = ActionShowDetailsUpdate + end + object ActionShowSummary: TAction + Tag = 1 + Caption = 'Summary' + Checked = True + Hint = 'Summary view' + ImageIndex = 2 + OnExecute = ActionShowSummaryExecute + OnUpdate = ActionShowSummaryUpdate + end + object ActionShowDfms: TAction + Tag = 1 + Caption = 'Forms' + Hint = 'Forms list' + ImageIndex = 17 + OnExecute = ActionShowDfmsExecute + OnUpdate = ActionShowDfmsUpdate + end + end + object PopupMenuUnitView: TPopupMenu + Left = 72 + Top = 392 + object MenuItemDetails: TMenuItem + Action = ActionShowDetails + end + object MenuItemSummary: TMenuItem + Action = ActionShowSummary + end + object MenuItemDfms: TMenuItem + Action = ActionShowDfms + end + object MenuItemSeparator: TMenuItem + Caption = '-' + end + object MenuItemCopy: TMenuItem + Action = ActionCopy + end + object MenuItemSave: TMenuItem + Action = ActionSave + end + end + object PopupMenuToolbar: TPopupMenu + Left = 104 + Top = 392 + object TextLabelsItem: TMenuItem + Caption = 'Text labels' + Checked = True + OnClick = TextLabelsItemClick + end + end + object SaveDialogProjectAnalyser: TSaveDialog + DefaultExt = 'txt' + Filter = 'Text files (*.txt)|*.txt|All Files (*.*)|*.*' + Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing] + Left = 136 + Top = 392 + end +end diff --git a/official/1.96/experts/projectanalyzer/ProjAnalyzerFrm.pas b/official/1.96/experts/projectanalyzer/ProjAnalyzerFrm.pas new file mode 100644 index 0000000..1c7e465 --- /dev/null +++ b/official/1.96/experts/projectanalyzer/ProjAnalyzerFrm.pas @@ -0,0 +1,651 @@ +{******************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ 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 ProjAnalyzerFrm.pas. } +{ } +{ The Initial Developer of the Original Code is documented in the accompanying } +{ help file JCL.chm. Portions created by these individuals are Copyright (C) } +{ of these individuals. } +{ } +{ Unit owner: Petr Vones } +{ Last modified: July 22, 2001 } +{ } +{******************************************************************************} + +unit ProjAnalyzerFrm; + +interface + +{$I jcl.inc} + +uses + Windows, SysUtils, Classes, Controls, Forms, Dialogs, + ComCtrls, ActnList, Menus, ClipBrd, ImgList, ToolWin, + JclDebug, + JclOtaUtils; + +type + TUnitItem = record + Name: string; + Size: Integer; + Group: string; + end; + + TPackageUnitItem = record + UnitName: string; + PackageName: string; + end; + + TProjectAnalyserView = (pavDetails, pavSummary, pavDfms); + + TProjectAnalyzerForm = class(TForm) + UnitListView: TListView; + ExplorerItemImages: TImageList; + ToolBarMain: TToolBar; + ActionListProjectAnalyser: TActionList; + PopupMenuUnitView: TPopupMenu; + ToolButtonDetails: TToolButton; + ActionShowDetails: TAction; + ActionShowSummary: TAction; + MenuItemDetails: TMenuItem; + MenuItemSummary: TMenuItem; + ToolButtonSummary: TToolButton; + ToolButtonSeparator: TToolButton; + ToolButtonCopy: TToolButton; + ToolButtonSave: TToolButton; + ActionCopy: TAction; + ActionSave: TAction; + PopupMenuToolbar: TPopupMenu; + TextLabelsItem: TMenuItem; + MenuItemSeparator: TMenuItem; + MenuItemCopy: TMenuItem; + MenuItemSave: TMenuItem; + SaveDialogProjectAnalyser: TSaveDialog; + StatusBarMain: TStatusBar; + ActionShowDfms: TAction; + ToolButtonDfms: TToolButton; + MenuItemDfms: TMenuItem; + procedure ActionShowDfmsUpdate(Sender: TObject); + procedure ActionShowSummaryUpdate(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure UnitListViewColumnClick(Sender: TObject; Column: TListColumn); + procedure UnitListViewCompare(Sender: TObject; Item1, Item2: TListItem; + Data: Integer; var Compare: Integer); + procedure ActionShowDetailsExecute(Sender: TObject); + procedure ActionShowSummaryExecute(Sender: TObject); + procedure TextLabelsItemClick(Sender: TObject); + procedure ActionCopyExecute(Sender: TObject); + procedure ActionSaveExecute(Sender: TObject); + procedure ActionShowDfmsExecute(Sender: TObject); + procedure ActionShowDetailsUpdate(Sender: TObject); + private + FCodeSize: Integer; + FDataSize: Integer; + FBssSize: Integer; + FPackageUnits: array of TPackageUnitItem; + FUnits: array of TUnitItem; + FDfms: array of TUnitItem; + FUnitsSum: TStringList; + FSettings: TJclOtaSettings; + FView: TProjectAnalyserView; + procedure OnMapSegmentEvent(Sender: TObject; const Address: TJclMapAddress; + Length: Integer; const ClassName, UnitName: string); + procedure SetStatusBarText(const Value: string); + procedure ClearData; + protected + procedure CreateParams(var Params: TCreateParams); override; + public + constructor Create(AOwner: TComponent; ASettings: TJclOtaSettings); reintroduce; + destructor Destroy; override; + procedure ClearContent; + function FindPackageForUnitName(const UnitName: string): string; + procedure ShowDfms; + procedure ShowDetails; + procedure ShowSummary; + procedure SetFileName(const FileName, MapFileName: TFileName; const ProjectName: string); + property StatusBarText: string write SetStatusBarText; + property Settings: TJclOtaSettings read FSettings; + property View: TProjectAnalyserView read FView; + end; + +var + ProjectAnalyzerForm: TProjectAnalyzerForm; + +implementation + +{$R *.dfm} + +uses + JclLogic, JclOtaResources, JclPeImage, JclStrings, + JclOtaConsts; + +procedure JvListViewSortClick(Column: TListColumn; AscendingSortImage: Integer; + DescendingSortImage: Integer); +var + ListView: TListView; + I: Integer; +begin + ListView := TListColumns(Column.Collection).Owner as TListView; + ListView.Columns.BeginUpdate; + try + with ListView.Columns do + for I := 0 to Count - 1 do + Items[I].ImageIndex := -1; + if ListView.Tag and $FF = Column.Index then + ListView.Tag := ListView.Tag xor $100 + else + ListView.Tag := Column.Index; + if ListView.Tag and $100 = 0 then + Column.ImageIndex := AscendingSortImage + else + Column.ImageIndex := DescendingSortImage; + finally + ListView.Columns.EndUpdate; + end; +end; + +procedure JvListViewCompare(ListView: TListView; Item1, Item2: TListItem; var Compare: Integer); +var + ColIndex: Integer; + + function FmtStrToInt(S: string): Integer; + var + I: Integer; + begin + I := 1; + while I <= Length(S) do + if not (S[I] in ['0'..'9', '-']) then + Delete(S, I, 1) + else + Inc(I); + Result := StrToInt(S); + end; + +begin + with ListView do + begin + ColIndex := Tag and $FF - 1; + if Columns[ColIndex + 1].Alignment = taLeftJustify then + begin + if ColIndex = -1 then + Compare := AnsiCompareText(Item1.Caption, Item2.Caption) + else + Compare := AnsiCompareText(Item1.SubItems[ColIndex], Item2.SubItems[ColIndex]); + end + else + begin + if ColIndex = -1 then + Compare := FmtStrToInt(Item1.Caption) - FmtStrToInt(Item2.Caption) + else + Compare := FmtStrToInt(Item1.SubItems[ColIndex]) - FmtStrToInt(Item2.SubItems[ColIndex]); + end; + if (Tag and $100) <> 0 then + Compare := -Compare; + end; +end; + +procedure JvListViewToStrings(ListView: TListView; Strings: TStrings; + SelectedOnly: Boolean; Headers: Boolean); +var + R, C: Integer; + ColWidths: array of Word; + S: string; + + procedure AddLine; + begin + Strings.Add(TrimRight(S)); + end; + + function MakeCellStr(const Text: string; Index: Integer): string; + begin + with ListView.Columns[Index] do + if Alignment = taLeftJustify then + Result := StrPadRight(Text, ColWidths[Index] + 1) + else + Result := StrPadLeft(Text, ColWidths[Index]) + ' '; + end; + +begin + SetLength(S, 256); + with ListView do + begin + SetLength(ColWidths, Columns.Count); + if Headers then + for C := 0 to Columns.Count - 1 do + ColWidths[C] := Length(Trim(Columns[C].Caption)); + for R := 0 to Items.Count - 1 do + if not SelectedOnly or Items[R].Selected then + begin + ColWidths[0] := Max(ColWidths[0], Length(Trim(Items[R].Caption))); + for C := 0 to Items[R].SubItems.Count - 1 do + ColWidths[C + 1] := Max(ColWidths[C + 1], Length(Trim(Items[R].SubItems[C]))); + end; + Strings.BeginUpdate; + try + if Headers then + with Columns do + begin + S := ''; + for C := 0 to Count - 1 do + S := S + MakeCellStr(Items[C].Caption, C); + AddLine; + S := ''; + for C := 0 to Count - 1 do + S := S + StringOfChar('-', ColWidths[C]) + ' '; + AddLine; + end; + for R := 0 to Items.Count - 1 do + if not SelectedOnly or Items[R].Selected then + with Items[R] do + begin + S := MakeCellStr(Caption, 0); + for C := 0 to Min(SubItems.Count, Columns.Count - 1) - 1 do + S := S + MakeCellStr(SubItems[C], C + 1); + AddLine; + end; + finally + Strings.EndUpdate; + end; + end; +end; + +function IntToExtended(I: Integer): Extended; +begin + Result := I; +end; + +//=== { TProjectAnalyzerForm } =============================================== + +procedure TProjectAnalyzerForm.FormCreate(Sender: TObject); +var + Index: Integer; +begin + FUnitsSum := TStringList.Create; + FUnitsSum.Sorted := True; + FUnitsSum.Duplicates := dupIgnore; + + SetBounds(Settings.LoadInteger(JclLeft, Left), + Settings.LoadInteger(JclTop, Top), + Settings.LoadInteger(JclWidth, Width), + Settings.LoadInteger(JclHeight, Height)); + + FView := TProjectAnalyserView(Settings.LoadInteger(AnalyzerViewName, Integer(pavDetails))); + + with UnitListView.Columns do + for Index := 0 to Count - 1 do + Items[Index].Width := Settings.LoadInteger(Format(ColumnRegName, [Index]), Items[Index].Width); +end; + +procedure TProjectAnalyzerForm.FormDestroy(Sender: TObject); +var + Index: Integer; +begin + Settings.SaveInteger(JclLeft, Left); + Settings.SaveInteger(JclTop, Top); + Settings.SaveInteger(JclWidth, Width); + Settings.SaveInteger(JclHeight, Height); + Settings.SaveInteger(AnalyzerViewName, Integer(FView)); + with UnitListView.Columns do + for Index := 0 to Count - 1 do + Settings.SaveInteger(Format(ColumnRegName, [Index]), Items[Index].Width); + + FreeAndNil(FUnitsSum); +end; + +procedure TProjectAnalyzerForm.SetFileName(const FileName, MapFileName: TFileName; const ProjectName: string); +var + MapParser: TJclMapParser; + BorImage: TJclPeBorImage; + PackagesList: TStringList; + I, U, C, ResourcesSize: Integer; + ShortPackageName: string; +begin + ClearData; + Caption := Format(RsFormCaption, [ProjectName]); + MapParser := TJclMapParser.Create(MapFileName); + try + MapParser.OnSegment := OnMapSegmentEvent; + MapParser.Parse; + finally + MapParser.Free; + end; + BorImage := TJclPeBorImage.Create(True); + PackagesList := TStringList.Create; + try + PeImportedLibraries(FileName, PackagesList, False, True); + C := 0; + for I := 0 to PackagesList.Count - 1 do + begin + BorImage.FileName := PackagesList[I]; + if BorImage.IsPackage then + begin + ShortPackageName := ExtractFileName(PackagesList[I]); + with BorImage.PackageInfo do + for U := 0 to ContainsCount - 1 do + begin + SetLength(FPackageUnits, C + 1); + FPackageUnits[C].UnitName := ContainsNames[U]; + FPackageUnits[C].PackageName := ShortPackageName; + Inc(C); + end; + end; + end; + BorImage.FileName := FileName; + ResourcesSize := BorImage.Directories[IMAGE_DIRECTORY_ENTRY_RESOURCE].Size; + with BorImage do + begin + SetLength(FDfms, FormCount); + for I := 0 to FormCount - 1 do + begin + FDfms[I].Name := Forms[I].FormObjectName; + FDfms[I].Size := Forms[I].ResItem.RawEntryDataSize; + end; + end; + finally + BorImage.Free; + PackagesList.Free; + end; + StatusBarMain.Panels[0].Text := Format(RsStatusText, + [FUnitsSum.Count, Length(FDfms), FCodeSize, FDataSize, FBssSize, ResourcesSize]); + case View of + pavDetails: + ShowDetails; + pavSummary: + ShowSummary; + else + ShowDfms; + end; +end; + +procedure TProjectAnalyzerForm.ShowDetails; +var + I: Integer; +begin + FView := pavDetails; + with UnitListView do + begin + Items.BeginUpdate; + Items.Clear; + for I := 0 to Length(FUnits) - 1 do + with Items.Add, FUnits[I] do + begin + Caption := Name; + SubItems.Add(Format('%.0n', [IntToExtended(Size)])); + SubItems.Add(Group); + SubItems.Add(FindPackageForUnitName(Name)); + case Group[1] of + 'D': + ImageIndex := 3; + 'B': + ImageIndex := 4; + else + ImageIndex := 2; + end; + end; + AlphaSort; + Items.EndUpdate; + end; +end; + +procedure TProjectAnalyzerForm.ShowSummary; +var + I: Integer; +begin + FView := pavSummary; + with UnitListView do + begin + Items.BeginUpdate; + Items.Clear; + for I := 0 to FUnitsSum.Count - 1 do + with Items.Add, FUnitsSum do + begin + Caption := Strings[I]; + SubItems.Add(Format('%.0n', [IntToExtended(Integer(Objects[I]))])); + SubItems.Add(RsCodeData); + SubItems.Add(FindPackageForUnitName(Strings[I])); + ImageIndex := 2; + end; + AlphaSort; + Items.EndUpdate; + end; +end; + +procedure TProjectAnalyzerForm.ShowDfms; +var + I: Integer; +begin + FView := pavDfms; + with UnitListView do + begin + Items.BeginUpdate; + Items.Clear; + for I := 0 to Length(FDfms) - 1 do + with Items.Add do + begin + Caption := FDfms[I].Name; + SubItems.Add(Format('%.0n', [IntToExtended(FDfms[I].Size)])); + SubItems.Add(''); + SubItems.Add(''); + ImageIndex := ActionShowDfms.ImageIndex; + end; + AlphaSort; + Items.EndUpdate; + end; +end; + +procedure TProjectAnalyzerForm.OnMapSegmentEvent(Sender: TObject; const Address: TJclMapAddress; + Length: Integer; const ClassName, UnitName: string); +var + C: Integer; + ClassName1: Char; +begin + C := System.Length(FUnits); + SetLength(FUnits, C + 1); + if System.Length(ClassName) > 0 then + ClassName1 := ClassName[1] + else + ClassName1 := #0; + FUnits[C].Name := UnitName; + FUnits[C].Size := Length; + FUnits[C].Group := ClassName; + case ClassName1 of + 'B': + begin + Inc(FBssSize, Length); + Length := 0; + end; + 'C': + Inc(FCodeSize, Length); + 'D': + Inc(FDataSize, Length); + end; + C := FUnitsSum.IndexOf(UnitName); + if C = -1 then + FUnitsSum.AddObject(UnitName, Pointer(Length)) + else + FUnitsSum.Objects[C] := Pointer(Integer(FUnitsSum.Objects[C]) + Length); +end; + +procedure TProjectAnalyzerForm.UnitListViewColumnClick(Sender: TObject; Column: TListColumn); +begin + JvListViewSortClick(Column, 0, 1); + TListView(Sender).AlphaSort; +end; + +procedure TProjectAnalyzerForm.UnitListViewCompare(Sender: TObject; + Item1, Item2: TListItem; Data: Integer; var Compare: Integer); +begin + JvListViewCompare(TListView(Sender), Item1, Item2, Compare); +end; + +procedure TProjectAnalyzerForm.ActionShowDetailsExecute(Sender: TObject); +begin + ShowDetails; +end; + +procedure TProjectAnalyzerForm.ActionShowDetailsUpdate(Sender: TObject); +var + AAction: TAction; +begin + AAction := Sender as TAction; + + AAction.Enabled := (Length(FUnits) > 0); + AAction.Checked := View = pavDetails; +end; + +procedure TProjectAnalyzerForm.ActionShowSummaryExecute(Sender: TObject); +begin + ShowSummary; +end; + +procedure TProjectAnalyzerForm.ActionShowSummaryUpdate(Sender: TObject); +var + AAction: TAction; +begin + AAction := Sender as TAction; + + AAction.Enabled := (Length(FUnits) > 0); + AAction.Checked := View = pavSummary; +end; + +procedure TProjectAnalyzerForm.ActionShowDfmsExecute(Sender: TObject); +begin + ShowDfms; +end; + +procedure TProjectAnalyzerForm.ActionShowDfmsUpdate(Sender: TObject); +var + AAction: TAction; +begin + AAction := Sender as TAction; + + AAction.Enabled := (Length(FUnits) > 0); + AAction.Checked := View = pavDfms; +end; + +procedure TProjectAnalyzerForm.TextLabelsItemClick(Sender: TObject); +begin + TextLabelsItem.Checked := not TextLabelsItem.Checked; + ToolBarMain.ShowCaptions := TextLabelsItem.Checked; + ToolBarMain.ButtonHeight := 0; + ToolBarMain.ButtonWidth := 0; +end; + +procedure TProjectAnalyzerForm.ActionCopyExecute(Sender: TObject); +var + SL: TStringList; +begin + SL := TStringList.Create; + try + JvListViewToStrings(UnitListView, SL, False, True); + SL.Add(''); + SL.Add(StatusBarMain.Panels[0].Text); + Clipboard.AsText := SL.Text; + finally + SL.Free; + end; +end; + +constructor TProjectAnalyzerForm.Create(AOwner: TComponent; + ASettings: TJclOtaSettings); +begin + inherited Create(AOwner); + FSettings := ASettings; +end; + +procedure TProjectAnalyzerForm.CreateParams(var Params: TCreateParams); +begin + inherited CreateParams(Params); + + // Fixing the Window Ghosting "bug" + Params.Style := params.Style or WS_POPUP; + if Assigned(Screen.ActiveForm) then + Params.WndParent := Screen.ActiveForm.Handle + else if Assigned (Application.MainForm) then + Params.WndParent := Application.MainForm.Handle + else + Params.WndParent := Application.Handle; +end; + +destructor TProjectAnalyzerForm.Destroy; +begin + ProjectAnalyzerForm := nil; + inherited Destroy; +end; + +procedure TProjectAnalyzerForm.ActionSaveExecute(Sender: TObject); +var + SL: TStringList; +begin + with SaveDialogProjectAnalyser do + begin + FileName := ''; + if Execute then + begin + SL := TStringList.Create; + try + JvListViewToStrings(UnitListView, SL, False, True); + SL.SaveToFile(FileName); + finally + SL.Free; + end; + end; + end; +end; + +function TProjectAnalyzerForm.FindPackageForUnitName(const UnitName: string): string; +var + I: Integer; +begin + Result := ''; + if UnitName <> 'SysInit' then + for I := 0 to Length(FPackageUnits) - 1 do + if FPackageUnits[I].UnitName = UnitName then + begin + Result := FPackageUnits[I].PackageName; + Break; + end; +end; + +procedure TProjectAnalyzerForm.SetStatusBarText(const Value: string); +begin + with StatusBarMain do + begin + Panels[0].Text := Value; + Repaint; + end; +end; + +procedure TProjectAnalyzerForm.ClearContent; +begin + ClearData; + StatusBarText := ''; + UnitListView.Items.BeginUpdate; + UnitListView.Items.Clear; + UnitListView.Items.EndUpdate; + Show; + Repaint; +end; + +procedure TProjectAnalyzerForm.ClearData; +begin + FDfms := nil; + FUnits := nil; + FUnitsSum.Clear; + FCodeSize := 0; + FDataSize := 0; + FBssSize := 0; + FPackageUnits := nil; +end; + +end. diff --git a/official/1.96/experts/projectanalyzer/ProjAnalyzerIcon.res b/official/1.96/experts/projectanalyzer/ProjAnalyzerIcon.res new file mode 100644 index 0000000..bf406de Binary files /dev/null and b/official/1.96/experts/projectanalyzer/ProjAnalyzerIcon.res differ diff --git a/official/1.96/experts/projectanalyzer/ProjAnalyzerImpl.pas b/official/1.96/experts/projectanalyzer/ProjAnalyzerImpl.pas new file mode 100644 index 0000000..8507bd1 --- /dev/null +++ b/official/1.96/experts/projectanalyzer/ProjAnalyzerImpl.pas @@ -0,0 +1,299 @@ +{**************************************************************************************************} +{ } +{ 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 ProjAnalyzerImpl.pas. } +{ } +{ The Initial Developer of the Original Code is documented in the accompanying } +{ help file JCL.chm. Portions created by these individuals are Copyright (C) of these individuals. } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Petr Vones } +{ Last modified: March 17, 2002 } +{ } +{**************************************************************************************************} + +unit ProjAnalyzerImpl; + +{$I jcl.inc} + +interface + +uses + Classes, Menus, ActnList, ToolsAPI, SysUtils, Graphics, Dialogs, Forms, + JclOtaUtils, ProjAnalyzerFrm; + +type + TJclProjectAnalyzerExpert = class(TJclOTAExpert) + private + FBuildMenuItem: TMenuItem; + FBuildAction: TAction; + procedure ActionExecute(Sender: TObject); + procedure ActionUpdate(Sender: TObject); + public + constructor Create; reintroduce; + destructor Destroy; override; + procedure RegisterCommands; override; + procedure UnregisterCommands; override; + end; + +// design package entry point +procedure Register; + +// expert DLL entry point +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean; stdcall; + +implementation + +{$R ProjAnalyzerIcon.res} + +uses + JclDebug, JclFileUtils, JclOtaConsts, + JclOtaResources; + +procedure Register; +begin + try + RegisterPackageWizard(TJclProjectAnalyzerExpert.Create); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +var + JCLWizardIndex: Integer; + +procedure JclWizardTerminate; +var + OTAWizardServices: IOTAWizardServices; +begin + try + if JCLWizardIndex <> -1 then + begin + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + OTAWizardServices.RemoveWizard(JCLWizardIndex); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + end; + end; +end; + +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean stdcall; +var + OTAWizardServices: IOTAWizardServices; +begin + try + TerminateProc := JclWizardTerminate; + + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + JCLWizardIndex := OTAWizardServices.AddWizard(TJclProjectAnalyzerExpert.Create); + + Result := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + Result := False; + end; + end; +end; + +//=== { TJclProjectAnalyzerExpert } ========================================== + +constructor TJclProjectAnalyzerExpert.Create; +begin + inherited Create('JclProjectAnalyzerExpert'); +end; + +destructor TJclProjectAnalyzerExpert.Destroy; +begin + FreeAndNil(ProjectAnalyzerForm); + inherited Destroy; +end; + +procedure TJclProjectAnalyzerExpert.ActionExecute(Sender: TObject); +var + TempActiveProject: IOTAProject; + BuildOK, Succ: Boolean; + ProjOptions: IOTAProjectOptions; + SaveMapFile: Variant; + OutputDirectory, ProjectFileName, MapFileName, ExecutableFileName: string; + ProjectName: string; + OptionsModifiedState: Boolean; +begin + try + TempActiveProject := ActiveProject; + if not Assigned(TempActiveProject) then + raise EJclExpertException.CreateTrace(RsENoActiveProject); + + ProjectFileName := TempActiveProject.FileName; + ProjectName := ExtractFileName(ProjectFileName); + Succ := False; + + ProjOptions := TempActiveProject.ProjectOptions; + if not Assigned(ProjOptions) then + raise EJclExpertException.CreateTrace(RsENoProjectOptions); + + OutputDirectory := GetOutputDirectory(TempActiveProject); + MapFileName := GetMapFileName(TempActiveProject); + + if ProjectAnalyzerForm = nil then + begin + ProjectAnalyzerForm := TProjectAnalyzerForm.Create(Application, Settings); + ProjectAnalyzerForm.Show; + end; + ProjectAnalyzerForm.ClearContent; + ProjectAnalyzerForm.StatusBarText := Format(RsBuildingProject, [ProjectName]); + + OptionsModifiedState := ProjOptions.ModifiedState; + SaveMapFile := ProjOptions.Values[MapFileOptionName]; + ProjOptions.Values[MapFileOptionName] := MapFileOptionDetailed; + BuildOK := TempActiveProject.ProjectBuilder.BuildProject(cmOTABuild, False); + ProjOptions.Values[MapFileOptionName] := SaveMapFile; + ProjOptions.ModifiedState := OptionsModifiedState; + + if BuildOK then + begin // Build was successful, continue ... + Succ := FileExists(MapFileName) and FindExecutableName(MapFileName, OutputDirectory, ExecutableFileName); + if Succ then + begin // MAP files was created + ProjectAnalyzerForm.SetFileName(ExecutableFileName, MapFileName, ProjectName); + ProjectAnalyzerForm.Show; + end; + if SaveMapFile <> MapFileOptionDetailed then + begin // delete MAP and DRC file + DeleteFile(MapFileName); + DeleteFile(ChangeFileExt(MapFileName, DrcFileExtension)); + end; + end; + if not Succ then + begin + ProjectAnalyzerForm.StatusBarText := ''; + if BuildOK then + MessageDlg(RsCantFindFiles, mtError, [mbOk], 0); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclProjectAnalyzerExpert.ActionUpdate(Sender: TObject); +var + TempActiveProject: IOTAProject; + ProjectName: string; +begin + try + TempActiveProject := ActiveProject; + if Assigned(TempActiveProject) then + ProjectName := ExtractFileName(TempActiveProject.FileName) + else + ProjectName := ''; + FBuildAction.Enabled := Assigned(TempActiveProject); + if not FBuildAction.Enabled then + ProjectName := RsProjectNone; + FBuildAction.Caption := Format(RsAnalyzeActionCaption, [ProjectName]); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclProjectAnalyzerExpert.RegisterCommands; +var + IDEMainMenu: TMainMenu; + IDEProjectItem: TMenuItem; + IDEActionList: TActionList; + I: Integer; + ImageBmp: TBitmap; +begin + inherited RegisterCommands; + + FBuildAction := TAction.Create(nil); + FBuildAction.Caption := Format(RsAnalyzeActionCaption, [RsProjectNone]); + FBuildAction.Visible := True; + FBuildAction.OnExecute := ActionExecute; + FBuildAction.OnUpdate := ActionUpdate; + FBuildAction.Name := RsAnalyzeActionName; + ImageBmp := TBitmap.Create; + try + ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'PROJANALYZER'); + FBuildAction.ImageIndex := NTAServices.AddMasked(ImageBmp, clOlive); + finally + ImageBmp.Free; + end; + + IDEMainMenu := NTAServices.MainMenu; + IDEProjectItem := nil; + with IDEMainMenu do + for I := 0 to Items.Count - 1 do + if Items[I].Name = 'ProjectMenu' then + begin + IDEProjectItem := Items[I]; + Break; + end; + if not Assigned(IDEProjectItem) then + raise EJclExpertException.CreateTrace(RsENoProjectMenuItem); + + with IDEProjectItem do + for I := 0 to Count - 1 do + if Items[I].Name = 'ProjectInformationItem' then + begin + IDEActionList := TActionList(NTAServices.ActionList); + if Assigned(Items[I].Action) then + FBuildAction.Category := TContainedAction(Items[I].Action).Category; + FBuildAction.ActionList := IDEActionList; + RegisterAction(FBuildAction); + FBuildMenuItem := TMenuItem.Create(nil); + FBuildMenuItem.Action := FBuildAction; + + IDEProjectItem.Insert(I + 1, FBuildMenuItem); + + System.Break; + end; + if not Assigned(FBuildMenuItem.Parent) then + raise EJclExpertException.CreateTrace(RsAnalyseMenuItemNotInserted); +end; + +procedure TJclProjectAnalyzerExpert.UnregisterCommands; +begin + inherited UnregisterCommands; + + UnregisterAction(FBuildAction); + FreeAndNil(FBuildMenuItem); + FreeAndNil(FBuildAction); +end; + +end. diff --git a/official/1.96/experts/useswizard/History.txt b/official/1.96/experts/useswizard/History.txt new file mode 100644 index 0000000..13c4919 --- /dev/null +++ b/official/1.96/experts/useswizard/History.txt @@ -0,0 +1,25 @@ +06-JUN-2002 TOndrej + - fixed bug in TUsesList.IndexOf + - added JCL identifier lists + +22-JAN-2002 TOndrej + - merged changes by Robert Marquardt + - resourcestrings for SelectDirectory captions + - disabled unit platform warnings in JCLOptionsFrame.pas + - localized dcc32.exe strings + - fixed loading from registry: + - open with KEY_READ acces + - try HKEY_LOCAL_MACHINE in case HKEY_CURRENT_USER fails + +21-JAN-2002 Robert Marquardt + - coding style changes + - FrameJCLOptions tab order + - Delphi 5 compatibility + +20-JAN-2002 TOndrej + - initial source code + - wizard + - notifier + - options tab sheet + - parsing of compiler messages + diff --git a/official/1.96/experts/useswizard/JCLOptionsFrame.dfm b/official/1.96/experts/useswizard/JCLOptionsFrame.dfm new file mode 100644 index 0000000..9bda12f --- /dev/null +++ b/official/1.96/experts/useswizard/JCLOptionsFrame.dfm @@ -0,0 +1,59 @@ +object FrameJclOptions: TFrameJclOptions + Left = 0 + Top = 0 + Width = 404 + Height = 103 + TabOrder = 0 + TabStop = True + Width = 404 + Height = 103 + object LabelIniFile: TLabel + Left = 16 + Top = 18 + Width = 116 + Height = 13 + Caption = 'RsUsesConfigurationFile' + end + object CheckBoxWizardActive: TCheckBox + Left = 16 + Top = 49 + Width = 201 + Height = 17 + Caption = 'RsUsesActive' + TabOrder = 2 + end + object CheckBoxWizardConfirm: TCheckBox + Left = 16 + Top = 72 + Width = 201 + Height = 17 + Caption = 'RsUsesConfirm' + TabOrder = 3 + end + object EditIniFile: TEdit + Left = 111 + Top = 15 + Width = 253 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + end + object ButtonIniFile: TButton + Left = 370 + Top = 15 + Width = 18 + Height = 21 + Anchors = [akTop, akRight] + Caption = '...' + TabOrder = 1 + OnClick = ButtonIniFileClick + end + object OpenDialog: TOpenDialog + DefaultExt = 'ini' + Filter = 'RsUsesOpenFilters' + FilterIndex = 0 + Title = 'RsUsesOpenTitle' + Left = 280 + Top = 56 + end +end diff --git a/official/1.96/experts/useswizard/JCLOptionsFrame.pas b/official/1.96/experts/useswizard/JCLOptionsFrame.pas new file mode 100644 index 0000000..04d8251 --- /dev/null +++ b/official/1.96/experts/useswizard/JCLOptionsFrame.pas @@ -0,0 +1,154 @@ +{**************************************************************************************************} +{ } +{ 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 JclOptionsFrame.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: } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Robert Marquardt } +{ Last modified: $Date: 2006/01/08 17:16:57 $ } +{ } +{**************************************************************************************************} + +unit JclOptionsFrame; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, ComCtrls; + +type + TFrameJclOptions = class(TFrame) + ButtonIniFile: TButton; + CheckBoxWizardActive: TCheckBox; + CheckBoxWizardConfirm: TCheckBox; + EditIniFile: TEdit; + LabelIniFile: TLabel; + OpenDialog: TOpenDialog; + procedure ButtonIniFileClick(Sender: TObject); + private + function GetActive: Boolean; + function GetConfigFileName: TFileName; + function GetConfirmChanges: Boolean; + procedure SetActive(const Value: Boolean); + procedure SetConfigFileName(const Value: TFileName); + procedure SetConfirmChanges(const Value: Boolean); + public + constructor Create(AOwner: TComponent); override; + property Active: Boolean read GetActive write SetActive; + property ConfirmChanges: Boolean read GetConfirmChanges write SetConfirmChanges; + property ConfigFileName: TFileName read GetConfigFileName write SetConfigFileName; + end; + +implementation + +uses + ToolsAPI, + JclRegistry, JclUsesWizard, + JclOtaConsts, JclOtaResources, JclOtaUtils; + +{$R *.dfm} + +constructor TFrameJclOptions.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + OpenDialog.Filter := RsUsesOpenFilters; + OpenDialog.Title := RsUsesOpenTitle; + LabelIniFile.Caption := RsUsesConfigurationFile; + CheckBoxWizardActive.Caption := RsUsesActive; + CheckBoxWizardConfirm.Caption := RsUsesConfirm; +end; + +function TFrameJclOptions.GetActive: Boolean; +begin + Result := CheckBoxWizardActive.Checked; +end; + +function TFrameJclOptions.GetConfigFileName: TFileName; +begin + Result := EditIniFile.Text; +end; + +function TFrameJclOptions.GetConfirmChanges: Boolean; +begin + Result := CheckBoxWizardConfirm.Checked; +end; + +procedure TFrameJclOptions.SetActive(const Value: Boolean); +begin + CheckBoxWizardActive.Checked := True; +end; + +procedure TFrameJclOptions.SetConfigFileName(const Value: TFileName); +begin + EditIniFile.Text := Value; +end; + +procedure TFrameJclOptions.SetConfirmChanges(const Value: Boolean); +begin + CheckBoxWizardConfirm.Checked := Value; +end; + +procedure TFrameJclOptions.ButtonIniFileClick(Sender: TObject); +begin + try + with OpenDialog do + begin + InitialDir := ExtractFilePath(EditIniFile.Text); + FileName := EditIniFile.Text; + if Execute then + EditIniFile.Text := FileName; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +// History: + +// $Log: JCLOptionsFrame.pas,v $ +// Revision 1.6 2006/01/08 17:16:57 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.5 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.4 2005/10/26 03:29:44 rrossmair +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and $Log: JCLOptionsFrame.pas,v $ +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.6 2006/01/08 17:16:57 outchy +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Settings reworked. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Common window for expert configurations +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.5 2005/12/16 23:46:25 outchy +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Added expert stack form. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Added code to display call stack on expert exception. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Fixed package extension for D2006. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and CVS tags. +// + +end. diff --git a/official/1.96/experts/useswizard/JCLUsesWizard.pas b/official/1.96/experts/useswizard/JCLUsesWizard.pas new file mode 100644 index 0000000..a1fa83b --- /dev/null +++ b/official/1.96/experts/useswizard/JCLUsesWizard.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 JclUsesWizard.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: } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Robert Marquardt } +{ Last modified: $Date: 2006/01/08 17:16:57 $ } +{ } +{**************************************************************************************************} + +unit JclUsesWizard; + +{$I jcl.inc} + +interface + +uses + SysUtils, Windows, Classes, Messages, Forms, Controls, StdCtrls, ComCtrls, + ExtCtrls, + ToolsAPI, + JclOtaUtils, JclOptionsFrame; + +type + TWizardAction = (waSkip, waAddToImpl, waAddToIntf, waMoveToIntf); + PErrorInfo = ^TErrorInfo; + TErrorInfo = record + // parsed from compiler message + UnitName: array [0..MAX_PATH - 1] of Char; + LineNumber: Integer; + Identifier: array [0..MAX_PATH - 1] of Char; + // resolved by wizard + UsesName: array [0..MAX_PATH - 1] of Char; // unit name to be added to uses clause + end; + + TJCLUsesWizard = class(TJclOTAExpert) + private + FActive: Boolean; + FApplicationIdle: TIdleEvent; + FConfirmChanges: Boolean; + FErrors: TList; + FIdentifierLists: TStrings; + FIniFile: string; + FNotifierIndex: Integer; + FFrameJclOptions: TFrameJclOptions; + procedure SetIniFile(const Value: string); + procedure AppIdle(Sender: TObject; var Done: Boolean); + procedure ClearErrors; + function DoConfirmChanges(ChangeList: TStrings): TModalResult; + procedure InitializeIdentifierLists; + procedure ProcessCompilerMessages(Messages: TStrings); + procedure ProcessUses; + procedure ResolveUsesName(Error: PErrorInfo); + procedure SetActive(Value: Boolean); + procedure SetConfirmChanges(Value: Boolean); + public + Value: Integer; + constructor Create; reintroduce; + destructor Destroy; override; + function LoadFromRegistry: Boolean; + procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override; + procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override; + property Active: Boolean read FActive write SetActive; + property ConfirmChanges: Boolean read FConfirmChanges write SetConfirmChanges; + property IniFile: string read FIniFile write SetIniFile; + end; + + TJCLUsesWizardNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier, IOTAIDENotifier50) + private + FWizard: TJclUsesWizard; + public + { IOTAIDENotifier } + procedure AfterCompile(Succeeded: Boolean); overload; + procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload; + procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean); + { IOTAIDENotifier50 } + procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload; + procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload; + public + constructor Create(AWizard: TJclUsesWizard); reintroduce; + property Wizard: TJclUsesWizard read FWizard; + end; + +// design package entry point +procedure Register; + +// expert DLL entry point +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean; stdcall; + +implementation + +uses + IniFiles, + JclFileUtils, JclParseUses, JclRegistry, JclUsesDialog, + JclOtaConsts, JclOtaResources; + +function FindClassForm(const AClassName: string): TForm; +var + I: Integer; +begin + Result := nil; + with Screen do + for I := 0 to FormCount - 1 do + if Forms[I].ClassNameIs(AClassName) then + begin + Result := Forms[I]; + Break; + end; +end; + +function GetActiveProject: IOTAProject; +var + ProjectGroup: IOTAProjectGroup; + I: Integer; +begin + Result := nil; + + with BorlandIDEServices as IOTAModuleServices do + begin + ProjectGroup := nil; + for I := 0 to ModuleCount - 1 do + if Supports(Modules[I], IOTAProjectGroup, ProjectGroup) then + Break; + + if Assigned(ProjectGroup) then + Result := ProjectGroup.ActiveProject + else + for I := 0 to ModuleCount - 1 do + if Supports(Modules[I], IOTAProject, Result) then + Break; + end; +end; + +function GetLineNumber(S1, S2: PChar): Integer; +var + P: PChar; +begin + if S2 < S1 then + Result := 0 + else + begin + Result := 1; + P := StrPos(S1, #13#10); + while (P <> nil) and (P <= S2) do + begin + Inc(Result); + + P := StrPos(P + 2, #13#10); + end; + end; +end; + +//=== { TLine } ============================================================== + +// TLine 'guessed' from coreide60.bpl + +type + TLine = class(TObject) + public + constructor Create; virtual; + destructor Destroy; override; + function GetLineText: string; virtual; + end; + +{ TLine stubs } + +constructor TLine.Create; +begin +end; + +destructor TLine.Destroy; +begin + inherited Destroy; +end; + +function TLine.GetLineText: string; +begin + Result := ''; +end; + +// the message treeview is custom drawn; hence this hack + +procedure GetCompilerMessages(List: TStrings); +var + MessageViewForm: TForm; + I: Integer; + TreeView: TTreeView; + Node: TTreeNode; + Line: TLine; +begin + // if TMsgWindow exists all messages are sent to it + MessageViewForm := FindClassForm('TMsgWindow'); + if MessageViewForm = nil then // otherwise TMessageViewForm is used + MessageViewForm := FindClassForm('TMessageViewForm'); + + if Assigned(MessageViewForm) then + begin + TreeView := nil; + with MessageViewForm do + for I := 0 to ControlCount - 1 do + if Controls[I].ClassNameIs('TTreeMessageView') then + begin + TreeView := Controls[I] as TTreeView; + Break; + end; + + if Assigned(TreeView) then + begin + with TreeView do + begin + Node := Items.GetFirstNode; + while Node <> nil do + begin + Line := TLine(Node.Data); + + if Assigned(Line) then + List.Add(Line.GetLineText); + + Node := Node.GetNext; + end; + end; + end; + end; +end; + +function ReadEditorBuffer(Buffer: IOTAEditBuffer): string; +const + BufSize = 1024; +var + Reader: IOTAEditReader; + Stream: TStringStream; + ReaderPos, Read: Integer; + Buf: array [0..BufSize] of Char; +begin + Result := ''; + if Buffer = nil then + Exit; + + Reader := Buffer.CreateReader; + Stream := TStringStream.Create(''); + try + ReaderPos := 0; + repeat + Read := Reader.GetText(ReaderPos, @Buf, BufSize); + Inc(ReaderPos, Read); + if (Read < 0) or (Read > BufSize) then + raise EJclExpertException.CreateTrace(RsEErrorReadingBuffer); + Buf[Read] := #0; + Stream.WriteString(Buf); + until Read < BufSize; + + Result := Stream.DataString; + finally + Stream.Free; + end; +end; + +function ReadString(S: PChar; Len: Integer): string; +begin + SetString(Result, S, Len); +end; + +//=== { TJCLUsesWizardNotifier } ============================================= + +// TJCLUsesWizardNotifier private: IOTAIDENotifier + +procedure TJCLUsesWizardNotifier.AfterCompile(Succeeded: Boolean); +begin + // do nothing +end; + +procedure TJCLUsesWizardNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); +begin + // do nothing +end; + +procedure TJCLUsesWizardNotifier.FileNotification(NotifyCode: TOTAFileNotification; + const FileName: string; var Cancel: Boolean); +begin + // do nothing +end; + +//=== { TJCLUsesWizardNotifier } ============================================= + +// TJCLUsesWizardNotifier private: IOTAIDENotifier50 + +procedure TJCLUsesWizardNotifier.AfterCompile(Succeeded, IsCodeInsight: Boolean); +var + Messages: TStrings; +begin + try + if IsCodeInsight or Succeeded then + Exit; + + Messages := TStringList.Create; + try + GetCompilerMessages(Messages); + if Assigned(Wizard) then + Wizard.ProcessCompilerMessages(Messages); + finally + Messages.Free; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJCLUsesWizardNotifier.BeforeCompile(const Project: IOTAProject; + IsCodeInsight: Boolean; var Cancel: Boolean); +begin + // do nothing +end; + +constructor TJCLUsesWizardNotifier.Create(AWizard: TJclUsesWizard); +begin + inherited Create; + + FWizard := AWizard; +end; + +//=== { TJCLUsesWizard } ===================================================== + +// private + +procedure TJCLUsesWizard.AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); +begin + inherited AddConfigurationPages(AddPageFunc); + FFrameJclOptions := TFrameJclOptions.Create(nil); + FFrameJclOptions.Active := Active; + FFrameJclOptions.ConfirmChanges := ConfirmChanges; + FFrameJclOptions.ConfigFileName := IniFile; + AddPageFunc(FFrameJclOptions, RsUsesSheet, Self); +end; + +procedure TJCLUsesWizard.ConfigurationClosed(AControl: TControl; + SaveChanges: Boolean); +begin + if Assigned(AControl) and (AControl = FFrameJclOptions) then + begin + if SaveChanges then + begin + Active := FFrameJclOptions.Active; + ConfirmChanges := FFrameJclOptions.ConfirmChanges; + IniFile := FFrameJclOptions.ConfigFileName; + end; + FreeAndNil(FFrameJclOptions); + end + else + inherited ConfigurationClosed(AControl, SaveChanges); +end; + +procedure TJCLUsesWizard.AppIdle(Sender: TObject; var Done: Boolean); +begin + Application.OnIdle := FApplicationIdle; + FApplicationIdle := nil; + + if FErrors.Count = 0 then + Exit; + + ProcessUses; +end; + +procedure TJCLUsesWizard.ClearErrors; +var + I: Integer; + P: PErrorInfo; +begin + for I := 0 to FErrors.Count - 1 do + begin + P := FErrors[I]; + FreeMem(P); + end; + FErrors.Clear; +end; + +function TJCLUsesWizard.DoConfirmChanges(ChangeList: TStrings): TModalResult; +var + Dialog: TFormUsesConfirm; +begin + Dialog := TFormUsesConfirm.Create(nil, ChangeList, FErrors); + try + Result := Dialog.ShowModal; + finally + Dialog.Free; + end; +end; + +// load identifier lists +// each line represents one JCL unit in the following format: +// =,,... + +procedure TJCLUsesWizard.InitializeIdentifierLists; +var + IniFile: TIniFile; + I: Integer; + IdentListFileName: string; + IdentList: TStrings; +begin + FIdentifierLists.Clear; + + IniFile := TIniFile.Create(FIniFile); + try + IdentList := TStringList.Create; + try + IniFile.ReadSection(SIniIdentifierLists, FIdentifierLists); + for I := 0 to FIdentifierLists.Count - 1 do + begin + IdentListFileName := IniFile.ReadString(SIniIdentifierLists, FIdentifierLists[I], + ChangeFileExt(FIdentifierLists[I], '.txt')); + if ExtractFilePath(IdentListFileName) = '' then + IdentListFileName := ExtractFilePath(FIniFile) + IdentListFileName; + + IdentList.LoadFromFile(IdentListFileName); + FIdentifierLists[I] := FIdentifierLists[I] + '=' + IdentList.CommaText; + end; + finally + IdentList.Free; + end; + finally + IniFile.Free; + end; +end; + +// load localized strings for the undeclared identifier error + +procedure TJCLUsesWizard.ProcessCompilerMessages(Messages: TStrings); +const + SIdentFormatSpec = '%s'; +var + I: Integer; + Error: PErrorInfo; + SError: string; + SUndeclaredIdent: string; + + procedure LoadDcc32Strings; + const + {$IFDEF COMPILER6} + SErrorID = 4147; // 'Error' + SUndeclaredIdentID = 47; // 'Undeclared identifier: ''%s''' + {$ELSE} + SErrorID = 4200; + SUndeclaredIdentID = 2; + {$ENDIF COMPILER6} + var + Dcc32FileName: string; + Dcc32: HMODULE; + ResString: TResStringRec; + S: string; + begin + SError := ''; + SUndeclaredIdent := ''; + + Dcc32FileName := 'dcc32.exe'; + + // try to retrieve and prepend Delphi bin path + S := (BorlandIDEServices as IOTAServices).GetBaseRegistryKey; + {$IFDEF COMPILER6_UP} + if RegKeyExists(HKEY_CURRENT_USER, S) then + Dcc32FileName := PathAddSeparator(RegReadString(HKEY_CURRENT_USER, S, 'RootDir')) + 'Bin\' + Dcc32FileName + else + {$ENDIF COMPILER6_UP} + if RegKeyExists(HKEY_LOCAL_MACHINE, S) then + Dcc32FileName := PathAddSeparator(RegReadString(HKEY_LOCAL_MACHINE, S, 'RootDir')) + 'Bin\' + Dcc32FileName; + + // try to load localized resources first + Dcc32 := LoadResourceModule(PChar(Dcc32FileName)); + if Dcc32 = 0 then // if not found try the executable + Dcc32 := LoadLibraryEx(PChar(Dcc32FileName), 0, LOAD_LIBRARY_AS_DATAFILE); + if Dcc32 = 0 then + Exit; + + try + ResString.Module := @Dcc32; + ResString.Identifier := SErrorID; + SError := LoadResString(@ResString); + + ResString.Identifier := SUndeclaredIdentID; + SUndeclaredIdent := LoadResString(@ResString); + finally + FreeLibrary(Dcc32); + end; + end; + + // example error message: [Error] Unit1.pas(37): Undeclared identifier: 'GetWindowsFolder' + + function ParseMessage(const Msg: string; var Error: PErrorInfo): Boolean; + var + P, P1, P2: PChar; + UnitName: string; + LineNumber: Integer; + Identifier: string; + begin + Result := False; + Error := nil; + P := PChar(Msg); + + // check opening bracket + if P^ <> '[' then + Exit; + Inc(P); + + // check severity + if StrLComp(P, PChar(SError), Length(SError)) <> 0 then + Exit; + Inc(P, Length(SError)); + + // check closing bracket + if P^ <> ']' then + Exit; + Inc(P); + + // check space + if P^ <> ' ' then + Exit; + Inc(P); + + // read unit name + UnitName := ''; + while P^ <> '(' do + begin + if P^ = #0 then + Break; + + UnitName := UnitName + P^; + + Inc(P); + end; + if UnitName = '' then + Exit; + if P^ <> '(' then + Exit; + Inc(P); + + // read line number + LineNumber := 0; + while P^ <> ')' do + begin + if P^ = #0 then + Break; + + LineNumber := LineNumber * 10 + Ord(P^) - Ord('0'); + + Inc(P); + end; + if LineNumber = 0 then + Exit; + if P^ <> ')' then + Exit; + Inc(P); + + // check colon + if P^ <> ':' then + Exit; + Inc(P); + + // check space + if P^ <> ' ' then + Exit; + Inc(P); + + // check text + Identifier := ''; + P1 := PChar(SUndeclaredIdent); + + // check text up to '%s' + P2 := StrPos(P1, SIdentFormatSpec); + if P2 = nil then + Exit; + if StrLComp(P, P1, P2 - P1) <> 0 then + Exit; + + P1 := P + (P2 - P1); + + // check text after '%s' + Inc(P2, Length(SIdentFormatSpec)); + P := StrEnd(P); + Dec(P, StrLen(P2)); + + if StrComp(P, P2) <> 0 then + Exit; + + // copy identifier + while P1 < P do + begin + Identifier := Identifier + P1^; + Inc(P1); + end; + if Identifier = '' then + Exit; + + // match + Error := AllocMem(SizeOf(TErrorInfo)); + try + StrLCopy(Error^.UnitName, PChar(UnitName), Length(Error^.UnitName)); + Error^.LineNumber := LineNumber; + StrLCopy(Error^.Identifier, PChar(Identifier), Length(Error^.Identifier)); + + Result := True; + except + FreeMem(Error); + raise; + end; + end; + +begin + ClearErrors; + if not Assigned(Messages) then + Exit; + + LoadDcc32Strings; + for I := 0 to Messages.Count - 1 do + if ParseMessage(Messages[I], Error) then + FErrors.Add(Error); + + for I := 0 to FErrors.Count - 1 do + ResolveUsesName(FErrors[I]); + + for I := FErrors.Count - 1 downto 0 do + begin + Error := FErrors[I]; + if Error^.UsesName = '' then + begin + FreeMem(Error); + FErrors.Delete(I); + end; + end; + + Application.ProcessMessages; + + FApplicationIdle := Application.OnIdle; + Application.OnIdle := AppIdle; +end; + +procedure TJCLUsesWizard.ProcessUses; +var + GoalSource: string; + Goal: TCustomGoal; + I: Integer; + ChangeList: TStrings; + IntfLength, ImplLength: Integer; + Writer: IOTAEditWriter; + Project: IOTAProject; +begin + GoalSource := ''; + with BorlandIDEServices as IOTAEditorServices do + if Assigned(TopBuffer) then + GoalSource := ReadEditorBuffer(TopBuffer) + else + Exit; + + Goal := CreateGoal(PChar(GoalSource)); + if not Assigned(Goal) then + Exit; + + try + if Goal is TProgramGoal then + with TProgramGoal(Goal) do + begin + IntfLength := Length(UsesList.Text); + ChangeList := TStringList.Create; + try + for I := 0 to FErrors.Count - 1 do + with PErrorInfo(FErrors[I])^ do + if (UsesName <> '') and (ChangeList.IndexOf(UsesName) = -1) then + ChangeList.AddObject(UsesName, TObject(waAddToIntf)); + + if not FConfirmChanges or (DoConfirmChanges(ChangeList) = mrOK) then + begin + for I := ChangeList.Count - 1 downto 0 do + case TWizardAction(ChangeList.Objects[I]) of + waAddToImpl, waAddToIntf: + if UsesList.Count = 0 then + UsesList.Add(ChangeList[I]) + else + UsesList.Insert(0, ChangeList[I]); + end; + + with BorlandIDEServices as IOTAEditorServices do + if Assigned(TopBuffer) then + begin + Writer := TopBuffer.CreateUndoableWriter; + try + Writer.CopyTo(Length(TextBeforeUses)); + Writer.DeleteTo(Length(TextBeforeUses) + IntfLength); + Writer.Insert(PChar(UsesList.Text)); + Writer.CopyTo(Length(GoalSource)); + finally + Writer := nil; + end; + end; + + // attempt to recompile + Project := GetActiveProject; + if Assigned(Project) and Assigned(Project.ProjectBuilder) then + Project.ProjectBuilder.BuildProject(cmOTAMake, True, True); + end; + finally + ChangeList.Free; + end; + end + else + if Goal is TLibraryGoal then + with TLibraryGoal(Goal) do + begin + IntfLength := Length(UsesList.Text); + ChangeList := TStringList.Create; + try + for I := 0 to FErrors.Count - 1 do + with PErrorInfo(FErrors[I])^ do + if (UsesName <> '') and (ChangeList.IndexOf(UsesName) = -1) then + ChangeList.AddObject(UsesName, TObject(waAddToIntf)); + + if not FConfirmChanges or (DoConfirmChanges(ChangeList) = mrOK) then + begin + for I := ChangeList.Count - 1 downto 0 do + case TWizardAction(ChangeList.Objects[I]) of + waAddToImpl, waAddToIntf: + if UsesList.Count = 0 then + UsesList.Add(ChangeList[I]) + else + UsesList.Insert(0, ChangeList[I]); + end; + + with BorlandIDEServices as IOTAEditorServices do + if Assigned(TopBuffer) then + begin + Writer := TopBuffer.CreateUndoableWriter; + try + Writer.CopyTo(Length(TextBeforeUses)); + Writer.DeleteTo(Length(TextBeforeUses) + IntfLength); + Writer.Insert(PChar(UsesList.Text)); + Writer.CopyTo(Length(GoalSource)); + finally + Writer := nil; + end; + end; + + // attempt to recompile + Project := GetActiveProject; + if Assigned(Project) and Assigned(Project.ProjectBuilder) then + Project.ProjectBuilder.BuildProject(cmOTAMake, True, True); + end; + finally + ChangeList.Free; + end; + end + else + if Goal is TUnitGoal then + with TUnitGoal(Goal) do + begin + IntfLength := Length(UsesIntf.Text); + ImplLength := Length(UsesImpl.Text); + ChangeList := TStringList.Create; + try + for I := 0 to FErrors.Count - 1 do + with PErrorInfo(FErrors[I])^ do + if (UsesName <> '') and (ChangeList.IndexOf(UsesName) = -1) then + begin + if LineNumber < GetLineNumber(PChar(GoalSource), PChar(GoalSource) + Length(TextBeforeIntf) + + IntfLength + Length(TextAfterIntf)) then // error in interface section + begin + if UsesImpl.IndexOf(UsesName) = -1 then + ChangeList.AddObject(UsesName, TObject(waAddToIntf)) + else + ChangeList.AddObject(UsesName, TObject(waMoveToIntf)); + end + else // error in implementation section + ChangeList.AddObject(UsesName, TObject(waAddToImpl)); + end; + + if not FConfirmChanges or (DoConfirmChanges(ChangeList) = mrOK) then + begin + for I := ChangeList.Count - 1 downto 0 do + case TWizardAction(ChangeList.Objects[I]) of + waAddToImpl: + if UsesImpl.Count = 0 then + UsesImpl.Add(ChangeList[I]) + else + UsesImpl.Insert(0, ChangeList[I]); + waAddToIntf: + if UsesIntf.Count = 0 then + UsesIntf.Add(ChangeList[I]) + else + UsesIntf.Insert(0, ChangeList[I]); + waMoveToIntf: + begin + if UsesIntf.Count = 0 then + UsesIntf.Add(ChangeList[I]) + else + UsesIntf.Insert(0, ChangeList[I]); + UsesImpl.Remove(UsesImpl.IndexOf(ChangeList[I])); + end; + else + ChangeList.Delete(I); + end; + + if ChangeList.Count = 0 then + Exit; + + with BorlandIDEServices as IOTAEditorServices do + if Assigned(TopBuffer) then + begin + Writer := TopBuffer.CreateUndoableWriter; + try + Writer.CopyTo(Length(TextBeforeIntf)); + Writer.DeleteTo(Length(TextBeforeIntf) + IntfLength); + Writer.Insert(PChar(UsesIntf.Text)); + Writer.CopyTo(Length(TextBeforeIntf) + IntfLength + Length(TextAfterIntf)); + Writer.DeleteTo(Length(TextBeforeIntf) + IntfLength + Length(TextAfterIntf) + ImplLength); + Writer.Insert(PChar(UsesImpl.Text)); + Writer.CopyTo(Length(GoalSource)); + finally + Writer := nil; + end; + end; + + // attempt to recompile + Project := GetActiveProject; + if Assigned(Project) and Assigned(Project.ProjectBuilder) then + Project.ProjectBuilder.BuildProject(cmOTAMake, True, True); + end; + finally + ChangeList.Free; + end; + end; + finally + Goal.Free; + end; +end; + +procedure TJCLUsesWizard.ResolveUsesName(Error: PErrorInfo); +var + I: Integer; + Identifiers: TStrings; + IdentifierIndex: Integer; +begin + if FIdentifierLists.Count = 0 then + InitializeIdentifierLists; + + Identifiers := TStringList.Create; + try + with FIdentifierLists do + for I := 0 to Count - 1 do + begin + Identifiers.CommaText := Values[Names[I]]; + with Error^ do + begin + IdentifierIndex := Identifiers.IndexOf(Identifier); + if IdentifierIndex <> -1 then + begin + StrLCopy(UsesName, PChar(Names[I]), Length(UsesName)); + Break; + end; + end; + end; + finally + Identifiers.Free; + end; +end; + +procedure TJCLUsesWizard.SetActive(Value: Boolean); +begin + if Value <> FActive then + begin + if Value then + begin + with BorlandIDEServices as IOTAServices do + FNotifierIndex := AddNotifier(TJCLUsesWizardNotifier.Create(Self)); + + FActive := FNotifierIndex <> -1; + end + else + begin + if FNotifierIndex <> -1 then + with BorlandIDEServices as IOTAServices do + RemoveNotifier(FNotifierIndex); + + FNotifierIndex := -1; + FActive := False; + end; + end; +end; + +procedure TJCLUsesWizard.SetConfirmChanges(Value: Boolean); +begin + if Value <> FConfirmChanges then + begin + FConfirmChanges := Value; + end; +end; + +procedure TJCLUsesWizard.SetIniFile(const Value: string); +begin + FIniFile := Value; +end; + +//=== { TJCLUsesWizard } ===================================================== + +// public + +constructor TJCLUsesWizard.Create; +begin + inherited Create(JclUsesExpertName); + FIdentifierLists := TStringList.Create; + FErrors := TList.Create; + FActive := False; + FConfirmChanges := False; + FNotifierIndex := -1; + + LoadFromRegistry; +end; + +destructor TJCLUsesWizard.Destroy; +begin + SetActive(False); + ClearErrors; + FErrors.Free; + FIdentifierLists.Free; + inherited Destroy; +end; + +function TJCLUsesWizard.LoadFromRegistry: Boolean; +var + S: string; + Root: DelphiHKEY; +begin + S := (BorlandIDEServices as IOTAServices).GetBaseRegistryKey + '\' + JediIDESubKey + JclUsesExpertName; + Root := HKEY_CURRENT_USER; + Result := RegKeyExists(Root, S); + if not Result then + begin + Root := HKEY_LOCAL_MACHINE; + Result := RegKeyExists(Root, S); + end; + SetActive(RegReadBoolDef(Root, S, SRegWizardActive, False)); + FConfirmChanges := RegReadBoolDef(Root, S, SRegWizardConfirm, True); + FIniFile := RegReadStringDef(Root, S, SRegWizardIniFile, ''); +end; + +// create and register wizard instance + +procedure Register; +begin + try + RegisterPackageWizard(TJCLUsesWizard.Create); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +var + JCLWizardIndex: Integer = -1; + +procedure JclWizardTerminate; +var + OTAWizardServices: IOTAWizardServices; +begin + try + if JCLWizardIndex <> -1 then + begin + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + OTAWizardServices.RemoveWizard(JCLWizardIndex); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + end; + end; +end; + +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean stdcall; +var + OTAWizardServices: IOTAWizardServices; +begin + try + TerminateProc := JclWizardTerminate; + + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + JCLWizardIndex := OTAWizardServices.AddWizard(TJCLUsesWizard.Create); + + Result := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + Result := False; + end; + end; +end; + +// History: + +// $Log: JCLUsesWizard.pas,v $ +// Revision 1.9 2006/01/08 17:16:57 outchy +// Settings reworked. +// Common window for expert configurations +// +// Revision 1.8 2005/12/26 18:03:41 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.7 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.6 2005/10/26 03:29:44 rrossmair +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and $Log: JCLUsesWizard.pas,v $ +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.9 2006/01/08 17:16:57 outchy +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Settings reworked. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Common window for expert configurations +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.8 2005/12/26 18:03:41 outchy +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Enhanced bds support (including C#1 and D8) +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Introduction of dll experts +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Project types in templates +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Revision 1.7 2005/12/16 23:46:25 outchy +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Added expert stack form. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Added code to display call stack on expert exception. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and Fixed package extension for D2006. +// - improved header information, added $Date: 2006/01/08 17:16:57 $ and CVS tags. +// + +end. diff --git a/official/1.96/experts/useswizard/Jcl8087.txt b/official/1.96/experts/useswizard/Jcl8087.txt new file mode 100644 index 0000000..15d35cd --- /dev/null +++ b/official/1.96/experts/useswizard/Jcl8087.txt @@ -0,0 +1,20 @@ +ClearPending8087Exceptions +Get8087ControlWord +Get8087Infinity +Get8087Precision +Get8087Rounding +Get8087StatusWord +GetMasked8087Exceptions +GetPending8087Exceptions +Mask8087Exceptions +Set8087ControlWord +Set8087Infinity +Set8087Precision +Set8087Rounding +SetMasked8087Exceptions +T8087Exception +T8087Exceptions +T8087Infinity +T8087Precision +T8087Rounding +Unmask8087Exceptions diff --git a/official/1.96/experts/useswizard/JclAppInst.txt b/official/1.96/experts/useswizard/JclAppInst.txt new file mode 100644 index 0000000..a897e25 --- /dev/null +++ b/official/1.96/experts/useswizard/JclAppInst.txt @@ -0,0 +1,5 @@ +ReadMessageCheck +ReadMessageData +ReadMessageString +ReadMessageStrings +TJclAppInstances diff --git a/official/1.96/experts/useswizard/JclBase.txt b/official/1.96/experts/useswizard/JclBase.txt new file mode 100644 index 0000000..4402b83 --- /dev/null +++ b/official/1.96/experts/useswizard/JclBase.txt @@ -0,0 +1,20 @@ +EJclError +EJclInternalError +EJclWin32Error +I64ToCardinals +TDynByteArray +TDynCardinalArray +TDynDoubleArray +TDynExtendedArray +TDynFloatArray +TDynIInterfaceArray +TDynInt64Array +TDynIntegerArray +TDynLongIntArray +TDynObjectArray +TDynPointerArray +TDynShortIntArray +TDynSingleArray +TDynSmallIntArray +TDynStringArray +TDynWordArray diff --git a/official/1.96/experts/useswizard/JclCIL.txt b/official/1.96/experts/useswizard/JclCIL.txt new file mode 100644 index 0000000..e3be0ec --- /dev/null +++ b/official/1.96/experts/useswizard/JclCIL.txt @@ -0,0 +1,10 @@ +EJclCliInstructionError +EJclCliInstructionStreamInvalid +TJclBinaryInstruction +TJclClrILGenerator +TJclInstruction +TJclInstructionDumpILOption +TJclInstructionDumpILOptions +TJclInstructionParamType +TJclOpCode +TJclUnaryInstruction diff --git a/official/1.96/experts/useswizard/JclCLR.txt b/official/1.96/experts/useswizard/JclCLR.txt new file mode 100644 index 0000000..8d83e19 --- /dev/null +++ b/official/1.96/experts/useswizard/JclCLR.txt @@ -0,0 +1,20 @@ +TJclClrBlobRecord +TJclClrBlobStream +TJclClrComboIndex +TJclClrGuidStream +TJclClrHeaderEx +TJclClrHeapKind +TJclClrImageFlag +TJclClrImageFlags +TJclClrResourceRecord +TJclClrStream +TJclClrStringsStream +TJclClrTable +TJclClrTableKind +TJclClrTableRow +TJclClrTableStream +TJclClrUserStringStream +TJclClrVTableFixupRecord +TJclClrVTableKind +TJclClrVTableKinds +TJclPeMetadata diff --git a/official/1.96/experts/useswizard/JclCOM.txt b/official/1.96/experts/useswizard/JclCOM.txt new file mode 100644 index 0000000..407488e --- /dev/null +++ b/official/1.96/experts/useswizard/JclCOM.txt @@ -0,0 +1,19 @@ +CATID_SafeForScripting +CLSID_StdComponentCategoriesMgr +CreateComponentCategory +EInvalidParam +GetDCOMVersion +GetMDACVersion +IsDCOMEnabled +IsDCOMInstalled +MarshalInterMachineInterfaceInStream +MarshalInterMachineInterfaceInVarArray +MarshalInterProcessInterfaceInStream +MarshalInterProcessInterfaceInVarArray +MarshalInterThreadInterfaceInVarArray +RegisterCLSIDInCategory +ResetIStreamToStart +SizeOfIStreamContents +StreamToVariantArray +UnRegisterCLSIDInCategory +VariantArrayToStream diff --git a/official/1.96/experts/useswizard/JclComplex.txt b/official/1.96/experts/useswizard/JclComplex.txt new file mode 100644 index 0000000..d2eec84 --- /dev/null +++ b/official/1.96/experts/useswizard/JclComplex.txt @@ -0,0 +1,4 @@ +EpsilonSqr +MaxTerm +TComplexKind +TJclComplex diff --git a/official/1.96/experts/useswizard/JclCompression.txt b/official/1.96/experts/useswizard/JclCompression.txt new file mode 100644 index 0000000..2e9fcaf --- /dev/null +++ b/official/1.96/experts/useswizard/JclCompression.txt @@ -0,0 +1,12 @@ +EJclCompressionError +TJclCompressionStream +TJclCompressStream +TJclDecompressStream +TJclGZIPCompressionStream +TJclGZIPDecompressionStream +TJclRARCompressionStream +TJclRARDecompressionStream +TJclTARCompressionStream +TJclTARDecompressionStream +TJclZLibCompressStream +TJclZLibDecompressStream diff --git a/official/1.96/experts/useswizard/JclConsole.txt b/official/1.96/experts/useswizard/JclConsole.txt new file mode 100644 index 0000000..d148ed0 --- /dev/null +++ b/official/1.96/experts/useswizard/JclConsole.txt @@ -0,0 +1,24 @@ +TJclConsole +TJclConsoleInputMode +TJclConsoleInputModes +TJclConsoleOutputMode +TJclConsoleOutputModes +TJclInputBuffer +TJclInputCtrlEvent +TJclInputRecordArray +TJclScreenBackColor +TJclScreenBuffer +TJclScreenBufferAfterResizeEvent +TJclScreenBufferBeforeResizeEvent +TJclScreenBufferTextHorizontalAlign +TJclScreenBufferTextVerticalAlign +TJclScreenCharacter +TJclScreenCursor +TJclScreenCursorSize +TJclScreenCustomTextAttribute +TJclScreenFont +TJclScreenFontColor +TJclScreenFontStyle +TJclScreenFontStyles +TJclScreenTextAttribute +TJclScreenWindow diff --git a/official/1.96/experts/useswizard/JclCounter.txt b/official/1.96/experts/useswizard/JclCounter.txt new file mode 100644 index 0000000..b2819dc --- /dev/null +++ b/official/1.96/experts/useswizard/JclCounter.txt @@ -0,0 +1,4 @@ +EJclCounterError +StartCount +StopCount +TJclCounter diff --git a/official/1.96/experts/useswizard/JclDateTime.txt b/official/1.96/experts/useswizard/JclDateTime.txt new file mode 100644 index 0000000..a5497ba --- /dev/null +++ b/official/1.96/experts/useswizard/JclDateTime.txt @@ -0,0 +1,54 @@ +CenturyOfDate +CreationDateTimeOfFile +DateTimeToDosDateTime +DateTimeToFileTime +DateTimeToLocalDateTime +DateTimeToSystemTime +DateTimeToUnixTime +DayOfDate +DayOfTheYear +DayOfTheYearToDateTime +DaysInMonth +DecodeDate +DosDateTimeToDateTime +DosDateTimeToFileTime +DosDateTimeToStr +DosDateTimeToSystemTime +EasterSunday +EJclDateTimeError +EncodeDate +FATDatesEqual +FileTimeToDateTime +FileTimeToDosDateTime +FileTimeToLocalDateTime +FileTimeToStr +FileTimeToSystemTime +FileTimeToUnixTime +FormatDateTime +GetISOYearNumberOfDays +HourOfTime +HoursToMSecs +IsISOLongYear +IsLeapYear +ISODayOfWeek +ISOWeekNumber +ISOWeekToDateTime +LastAccessDateTimeOfFile +LastWriteDateTimeOfFile +LocalDateTimeToDateTime +LocalDateTimeToFileTime +Make4DigitYear +MakeYear4Digit +MinuteOfTime +MinutesToMSecs +MonthOfDate +SecondOfTime +SecondsToMSecs +SystemTimeToDosDateTime +SystemTimeToFileTime +SystemTimeToStr +TimeOfDateTimeToMSecs +TimeOfDateTimeToSeconds +UnixTimeToDateTime +UnixTimeToFileTime +YearOfDate diff --git a/official/1.96/experts/useswizard/JclDebug.txt b/official/1.96/experts/useswizard/JclDebug.txt new file mode 100644 index 0000000..a8fe70b --- /dev/null +++ b/official/1.96/experts/useswizard/JclDebug.txt @@ -0,0 +1,78 @@ +__FILE_OF_ADDR__ +__LINE__ +__LINE_OF_ADDR__ +__MAP__ +__MAP_OF_ADDR__ +__MODULE__ +__MODULE_OF_ADDR__ +__PROC__ +__PROC_OF_ADDR__ +AssertKindOf +Caller +ClearLocationData +ConvertMapFileToJdbgFile +DebugInfoAvailable +EnableCrashOnCtrlScroll +ExtractClassName +ExtractMethodName +FileByLevel +FileOfAddr +GetLocationInfo +GetLocationInfoStr +InsertDebugDataIntoExecutableFile +IsDebuggerAttached +IsHandleValid +JclCreateExceptFrameList +JclCreateStackList +JclExceptionTrackingActive +JclLastExceptFrameList +JclLastExceptStackList +JclLastExceptStackListToStrings +JclStackTrackingOptions +JclStartExceptionTracking +JclStopExceptionTracking +JclTrackExceptionsFromLibraries +JclValidateModuleAddress +LineByLevel +LineOfAddr +MapByLevel +MapOfAddr +ModuleByLevel +ModuleOfAddr +ProcByLevel +ProcOfAddr +TExceptFrameKind +TJclAbstractMapParser +TJclBinDebugGenerator +TJclBinDebugScanner +TJclDebugInfoBinary +TJclDebugInfoExports +TJclDebugInfoList +TJclDebugInfoMap +TJclDebugInfoSource +TJclDebugInfoTD32 +TJclDebugThread +TJclDebugThreadList +TJclDebugThreadNotifyEvent +TJclExceptFrame +TJclExceptFrameList +TJclLocationInfo +TJclMapClassTableEvent +TJclMapLineNumbersEvent +TJclMapLineNumberUnitEvent +TJclMapParser +TJclMapPublicsEvent +TJclMapScanner +TJclMapSegmentEvent +TJclModuleInfo +TJclModuleInfoList +TJclStackBaseList +TJclStackInfoItem +TJclStackInfoList +TJclStackTrackingOption +TJclStackTrackingOptions +TJclThreadIDNotifyEvent +Trace +TraceFmt +TraceLoc +TraceLocFmt diff --git a/official/1.96/experts/useswizard/JclExprEval.txt b/official/1.96/experts/useswizard/JclExprEval.txt new file mode 100644 index 0000000..56bed5d --- /dev/null +++ b/official/1.96/experts/useswizard/JclExprEval.txt @@ -0,0 +1,44 @@ +EJclExprEvalError +TCompiledEvaluator +TCompiledExpression +TEasyEvaluator +TEvaluator +TExprAbstractFuncSym +TExprBinary32FuncSym +TExprBinary64FuncSym +TExprBinary80FuncSym +TExprBinaryFuncSym +TExprCompileParser +TExprConst32Sym +TExprConst64Sym +TExprConst80Sym +TExprConstSym +TExprContext +TExpressionCompiler +TExprEvalParser +TExprFloat32FuncSym +TExprFloat64FuncSym +TExprFloat80FuncSym +TExprFuncSym +TExprHashContext +TExprLexer +TExprNode +TExprNodeFactory +TExprSetContext +TExprSimpleLexer +TExprSym +TExprTernary32FuncSym +TExprTernary64FuncSym +TExprTernary80FuncSym +TExprTernaryFuncSym +TExprToken +TExprUnary32FuncSym +TExprUnary64FuncSym +TExprUnary80FuncSym +TExprUnaryFuncSym +TExprVar32Sym +TExprVar64Sym +TExprVar80Sym +TExprVirtMach +TExprVirtMachNodeFactory +TExprVirtMachOp diff --git a/official/1.96/experts/useswizard/JclFileUtils.txt b/official/1.96/experts/useswizard/JclFileUtils.txt new file mode 100644 index 0000000..693acfd --- /dev/null +++ b/official/1.96/experts/useswizard/JclFileUtils.txt @@ -0,0 +1,125 @@ +BuildFileList +CloseVolume +CreateEmptyFile +DeleteDirectory +DelTree +DelTreeEx +DirectoryExists +DiskInDrive +EJclFileMappingError +EJclFileMappingViewError +EJclFileUtilsError +EJclFileVersionInfoError +EJclPathError +EJclTempFileStreamError +EnumDirectories +EnumFiles +FileAttributesStr +FileBackup +FileCopy +FileCreateTemp +FileDelete +FileExists +FileGetDisplayName +FileGetGroupName +FileGetOwnerName +FileGetSize +FileGetTempName +FileGetTypeName +FileMove +FileRestore +FileSearch +FindUnusedFileName +ForceDirectories +FormatVersionString +GetBackupFileName +GetDirectorySize +GetDriveTypeStr +GetFileAgeCoherence +GetFileAttributeList +GetFileAttributeListEx +GetFileCreation +GetFileInformation +GetFileLastAccess +GetFileLastWrite +GetModulePath +GetSizeOfFile +GetStandardFileInfo +IJclFileEnumerator +IsDirectory +IsFileAttributeMatch +IsFileNameMatch +IsRootDirectory +LockVolume +OpenVolume +OSFileTypeToString +OSIdentToString +PathAddExtension +PathAddSeparator +PathAppend +PathBuildRoot +PathCanonicalize +PathCommonPrefix +PathCompactPath +PathExtractElements +PathExtractFileDirFixed +PathExtractFileNameNoExt +PathExtractPathDepth +PathGetDepth +PathGetLongName +PathGetLongName2 +PathGetRelativePath +PathGetShortName +PathGetTempPath +PathIsAbsolute +PathIsChild +PathIsDiskDevice +PathIsUNC +PathRemoveExtension +PathRemoveSeparator +SetDirCreation +SetDirLastAccess +SetDirLastWrite +SetFileCreation +SetFileLastAccess +SetFileLastWrite +ShredFile +TAttributeInterest +TCompactPath +TFileEnumeratorSyncMode +TFileFlag +TFileFlags +TFileHandler +TFileHandlerEx +TFileListOption +TFileListOptions +TFileSearchOption +TFileSearchOptions +TFileSearchTerminationEvent +TFileVersionFormat +TJclAttributeMatch +TJclCustomFileAttrMask +TJclCustomFileMapping +TJclFileAttributeMask +TJclFileEnumerator +TJclFileMapping +TJclFileMappingRoundOffset +TJclFileMappingStream +TJclFileMappingView +TJclFileMaskComparator +TJclFileVersionInfo +TJclMappedTextReader +TJclMappedTextReaderIndex +TJclSwapFileMapping +TJclTempFileStream +UnlockVolume +VerifyFileAttributeMask +VersionExtractFileInfo +VersionExtractProductInfo +VersionFixedFileInfo +VersionFixedFileInfoString +VersionResourceAvailable +Win32BackupFile +Win32DeleteFile +Win32MoveFileReplaceExisting +Win32RestoreFile diff --git a/official/1.96/experts/useswizard/JclGraphUtils.txt b/official/1.96/experts/useswizard/JclGraphUtils.txt new file mode 100644 index 0000000..dcee1f3 --- /dev/null +++ b/official/1.96/experts/useswizard/JclGraphUtils.txt @@ -0,0 +1,92 @@ +BlendLine +BlendLineEx +BlendMem +BlendMemEx +BlendReg +BlendRegEx +BlueComponent +BrightColor +BrightColorChannel +CIED65ToCIED50 +CIELABToBGR +ClipCodes +ClipLine +CMYKToBGR +Color32 +ColorToHTML +CombineMem +CombineReg +DarkColor +DarkColorChannel +DialogUnitsToPixelsX +DialogUnitsToPixelsY +DottedLineTo +DrawPolyLine +EColorConversionError +EMMS +GetColorBlue +GetColorFlag +GetColorGreen +GetColorRed +GetRGBValue +Gray32 +GreenComponent +HLSToRGB +HSLToRGB +Intensity +NullPoint +NullRect +OpenGLColorToWinColor +PixelsToDialogUnitsX +PixelsToDialogUnitsY +PointAssign +PointCopy +PointEqual +PointIsNull +PointMove +RectAssign +RectAssignPoints +RectBounds +RectCenter +RectCopy +RectEqual +RectFitToScreen +RectGrow +RectGrowX +RectGrowY +RectHeight +RectIncludesPoint +RectIncludesRect +RectIntersection +RectIntersectRect +RectIsEmpty +RectIsNull +RectIsSquare +RectIsValid +RectMove +RectMoveTo +RectNormalize +RectsAreValid +RectUnion +RectWidth +RedComponent +RGBAToBGRA +RGBToBGR +RGBToHLS +RGBToHSL +SetAlpha +SetBitmapColors +SetColorBlue +SetColorFlag +SetColorGreen +SetColorRed +SetRGBValue +ShortenString +TArrayOfColor32 +TClipCode +TClipCodes +TColor32 +THLSValue +TPointArray +WinColor +WinColorToOpenGLColor diff --git a/official/1.96/experts/useswizard/JclGraphics.txt b/official/1.96/experts/useswizard/JclGraphics.txt new file mode 100644 index 0000000..5f8638e --- /dev/null +++ b/official/1.96/experts/useswizard/JclGraphics.txt @@ -0,0 +1,61 @@ +ApplyLUT +BitmapToIcon +BitmapToJPeg +BlockTransfer +ColorToGrayscale +CreateRegionFromBitmap +DrawBitmap +EJclGraphicsError +ExtractIconCount +FillGradient +GetAntialiasedBitmap +GetIconFromBitmap +IconToBitmap +IdentityMatrix +IntensityToAlpha +Invert +InvertRGB +JPegToBitmap +PolygonAS +PolygonFS +PolygonTS +PolyLineAS +PolyLineFS +PolyLineTS +PolyPolygonAS +PolyPolygonFS +PolyPolygonTS +SaveIconToFile +ScreenShot +SetBorderTransparent +SetGamma +Stretch +StretchTransfer +TColorChannel +TConversionKind +TDrawMode +TDynDynIntegerArrayArray +TDynDynPointArrayArray +TDynDynPointArrayArrayF +TDynPointArray +TDynPointArrayF +TGradientDirection +TJclBitmap32 +TJclByteMap +TJclCustomMap +TJclDesktopCanvas +TJclLinearTransformation +TJclRegion +TJclRegionBitmapMode +TJclRegionCombineOperator +TJclRegionInfo +TJclRegionKind +TJclThreadPersistent +TJclTransformation +TPolyFillMode +Transform +TResamplingFilter +TScanLine +TScanLines +TStretchFilter +WriteIcon diff --git a/official/1.96/experts/useswizard/JclHookExcept.txt b/official/1.96/experts/useswizard/JclHookExcept.txt new file mode 100644 index 0000000..a6f12f0 --- /dev/null +++ b/official/1.96/experts/useswizard/JclHookExcept.txt @@ -0,0 +1,12 @@ +JclAddExceptNotifier +JclBelongsHookedCode +JclExceptionsHooked +JclHookedExceptModulesList +JclInitializeLibrariesHookExcept +JclRemoveExceptNotifier +JclReplaceExceptObj +JclUnhookExceptions +JclUnkookExceptionsInModule +TJclExceptNotifyMethod +TJclExceptNotifyPriority +TJclModuleArray diff --git a/official/1.96/experts/useswizard/JclIniFiles.txt b/official/1.96/experts/useswizard/JclIniFiles.txt new file mode 100644 index 0000000..b3ce910 --- /dev/null +++ b/official/1.96/experts/useswizard/JclIniFiles.txt @@ -0,0 +1,7 @@ +IniReadInteger +IniReadString +IniReadStrings +IniWriteBool +IniWriteInteger +IniWriteString +IniWriteStrings diff --git a/official/1.96/experts/useswizard/JclLANMan.txt b/official/1.96/experts/useswizard/JclLANMan.txt new file mode 100644 index 0000000..372656c --- /dev/null +++ b/official/1.96/experts/useswizard/JclLANMan.txt @@ -0,0 +1,22 @@ +CreateAccount +CreateGlobalGroup +CreateLocalAccount +CreateLocalGroup +DeleteAccount +DeleteLocalAccount +DeleteLocalGroup +GetGlobalGroups +GetLocalGroups +GlobalGroupExists +IsLocalAccount +LocalGroupExists +LookupGroupName +ParseAccountName +TNetUserAuthFlag +TNetUserAuthFlags +TNetUserFlag +TNetUserFlags +TNetUserInfoFlag +TNetUserInfoFlags +TNetUserPriv +TNetWellKnownRID diff --git a/official/1.96/experts/useswizard/JclLocales.txt b/official/1.96/experts/useswizard/JclLocales.txt new file mode 100644 index 0000000..5636eab --- /dev/null +++ b/official/1.96/experts/useswizard/JclLocales.txt @@ -0,0 +1,11 @@ +TJclAvailableKeybLayout +TJclKeybLayoutFlag +TJclKeybLayoutFlags +TJclKeyboardLayout +TJclKeyboardLayoutList +TJclLocaleDateFormats +TJclLocaleInfo +TJclLocalesDays +TJclLocalesKind +TJclLocalesList +TJclLocalesMonths diff --git a/official/1.96/experts/useswizard/JclLogic.txt b/official/1.96/experts/useswizard/JclLogic.txt new file mode 100644 index 0000000..8daeeed --- /dev/null +++ b/official/1.96/experts/useswizard/JclLogic.txt @@ -0,0 +1,31 @@ +BitsHighest +BitsLowest +BitsNeeded +BitsToBooleans +BooleansToBits +ClearBit +ClearBitBuffer +CountBitsCleared +CountBitsSet +DecLimit +DecLimitClamp +Digits +IncLimit +IncLimitClamp +LRot +Max +Min +OrdToBinary +ReverseBits +ReverseBytes +RRot +Sar +SetBit +SetBitBuffer +SwapOrd +TBooleanArray +TestBit +TestBitBuffer +TestBits +ToggleBit +ToggleBitBuffer diff --git a/official/1.96/experts/useswizard/JclMIDI.txt b/official/1.96/experts/useswizard/JclMIDI.txt new file mode 100644 index 0000000..d5bbd61 --- /dev/null +++ b/official/1.96/experts/useswizard/JclMIDI.txt @@ -0,0 +1,12 @@ +EJclMIDIError +GetMidiOutputs +IJclMIDIOut +MIDINoteToStr +MIDIOut +MIDISingleNoteTuningData +TJclMIDIOut +TMIDIChannel +TMIDIDataByte +TMIDIDataWord +TMIDINotes +TMIDIStatusByte diff --git a/official/1.96/experts/useswizard/JclMapi.txt b/official/1.96/experts/useswizard/JclMapi.txt new file mode 100644 index 0000000..cbf41b3 --- /dev/null +++ b/official/1.96/experts/useswizard/JclMapi.txt @@ -0,0 +1,21 @@ +EJclMapiError +JclSimpleBringUpSendMailDialog +JclSimpleSendFax +JclSimpleSendMail +MapiCheck +MapiErrorMessage +TJclEmail +TJclEmailFindOption +TJclEmailFindOptions +TJclEmailLogonOption +TJclEmailLogonOptions +TJclEmailReadMsg +TJclEmailReadOption +TJclEmailReadOptions +TJclEmailRecip +TJclEmailRecipKind +TJclEmailRecips +TJclMapiClient +TJclMapiClientConnect +TJclSimpleMapi +TJclTaskWindowsList diff --git a/official/1.96/experts/useswizard/JclMath.txt b/official/1.96/experts/useswizard/JclMath.txt new file mode 100644 index 0000000..e53fa69 --- /dev/null +++ b/official/1.96/experts/useswizard/JclMath.txt @@ -0,0 +1,172 @@ +AbsSqr +Ackermann +ArcCos +ArcCosH +ArcCot +ArcCotH +ArcCsc +ArcCscH +ArcSec +ArcSecH +ArcSin +ArcSinH +ArcTan +ArcTan2 +ArcTanH +Bernstein +CalcMachineEps +CalcMachineEpsDouble +CalcMachineEpsExtended +CalcMachineEpsSingle +Catalan +Cbrt10 +Cbrt100 +Cbrt2 +Cbrt3 +CbrtPi +Ceiling +CheckCrc16 +CheckCrc16_A +CheckCrc16_P +CheckCrc32 +CheckCrc32_A +CheckCrc32_P +CommercialRound +CompleteDelphiSet +Conjugate +Cos +CosH +Cot +CotH +Coversine +Crc16 +Crc16_A +Crc16_P +Crc32 +Crc32_A +Crc32_P +Csc +CscH +DegMinSecToFloat +Diff +DomainCheck +E +EJclMathError +EJclNaNSignal +EmptyDelphiSet +EnsureRange +EpsDouble +EpsExtended +Epsilon +EpsSingle +Equal +EulerMascheroni +Exp +Exsecans +Factorial +Fibonacci +FloatingPointClass +FloatsEqual +FloatToDegMinSec +Floor +GCD +GetNaNTag +GetParity +GoldenMean +Haversine +hLn2Pi +Inv +inv2Pi +IsFloatZero +IsInfinite +IsNaN +IsPrime +IsPrimeFactor +IsPrimeRM +IsPrimeTD +ISqrt +IsRelativePrime +IsSpecialValue +IsZero +LCM +Ln +Ln10 +Ln2 +LnPi +Log2 +Log3 +LogBase10 +LogBase2 +LogBaseN +LogE +LogPi +MakeQuietNaN +MakeSignalingNaN +MaxAngle +MaxFloat +MaxFloatingPoint +MaxTanH +MinedDoubleArray +MineDoubleBuffer +MinedSingleArray +MineSingleBuffer +MinFloat +MinFloatingPoint +ModFloat +Neg +Norm +NormalizeAngle +Pi +PiOn2 +PiOn3 +PiOn4 +PolarComplex +Power +PowerInt +PrecisionTolerance +PrimeFactors +Product +Pythagoras +Quotient +RectComplex +RemainderFloat +Root +Sec +SecH +SetPrecisionTolerance +SetPrecisionToleranceToEpsilon +SetPrimalityTest +Sgn +Signe +Sin +SinCos +SinH +Sqrt10 +Sqrt2 +Sqrt2Pi +Sqrt3 +Sqrt5 +SqrtPi +Sum +SwapFloats +Tan +TanH +TDelphiSet +TenToY +TFloatingPointClass +ThreeEpsDouble +ThreeEpsExtended +ThreeEpsilon +ThreeEpsSingle +ThreePi +TJclASet +TJclFlatSet +TJclRational +TJclSparseFlatSet +TNaNTag +TPrimalityTestMethod +TruncPower +TwoPi +TwoToPower63 +TwoToY +Versine diff --git a/official/1.96/experts/useswizard/JclMetadata.txt b/official/1.96/experts/useswizard/JclMetadata.txt new file mode 100644 index 0000000..b589ffd --- /dev/null +++ b/official/1.96/experts/useswizard/JclMetadata.txt @@ -0,0 +1,129 @@ +EJclMetadataError +TJclClrArrayData +TJclClrArraySign +TJclClrAssemblyFlag +TJclClrAssemblyFlags +TJclClrClassLayout +TJclClrClassSemantics +TJclClrCustomModifierSign +TJclClrElementType +TJclClrExceptionClauseFlag +TJclClrExceptionClauseFlags +TJclClrExceptionHandler +TJclClrLocalVar +TJclClrLocalVarFlag +TJclClrLocalVarFlags +TJclClrLocalVarSign +TJclClrMemberAccess +TJclClrMethodBody +TJclClrMethodCodeType +TJclClrMethodFlag +TJclClrMethodFlags +TJclClrMethodImplFlag +TJclClrMethodImplFlags +TJclClrMethodParam +TJclClrMethodRetType +TJclClrMethodSign +TJclClrMethodSignFlag +TJclClrMethodSignFlags +TJclClrParamKind +TJclClrParamKinds +TJclClrSignature +TJclClrStringFormatting +TJclClrTableAssembly +TJclClrTableAssemblyOS +TJclClrTableAssemblyOSRow +TJclClrTableAssemblyProcessor +TJclClrTableAssemblyProcessorRow +TJclClrTableAssemblyRef +TJclClrTableAssemblyRefOS +TJclClrTableAssemblyRefOSRow +TJclClrTableAssemblyRefProcessor +TJclClrTableAssemblyRefProcessorRow +TJclClrTableAssemblyRefRow +TJclClrTableAssemblyRow +TJclClrTableClassLayout +TJclClrTableClassLayoutRow +TJclClrTableConstant +TJclClrTableConstantRow +TJclClrTableCustomAttribute +TJclClrTableCustomAttributeRow +TJclClrTableDeclSecurity +TJclClrTableDeclSecurityRow +TJclClrTableENCLog +TJclClrTableENCLogRow +TJclClrTableENCMap +TJclClrTableENCMapRow +TJclClrTableEventDef +TJclClrTableEventDefRow +TJclClrTableEventFlag +TJclClrTableEventFlags +TJclClrTableEventMap +TJclClrTableEventMapRow +TJclClrTableEventPtr +TJclClrTableEventPtrRow +TJclClrTableExportedType +TJclClrTableExportedTypeRow +TJclClrTableFieldDef +TJclClrTableFieldDefFlag +TJclClrTableFieldDefFlags +TJclClrTableFieldDefRow +TJclClrTableFieldDefVisibility +TJclClrTableFieldLayout +TJclClrTableFieldLayoutRow +TJclClrTableFieldMarshal +TJclClrTableFieldMarshalRow +TJclClrTableFieldPtr +TJclClrTableFieldPtrRow +TJclClrTableFieldRVA +TJclClrTableFieldRVARow +TJclClrTableFile +TJclClrTableFileRow +TJclClrTableImplMap +TJclClrTableImplMapRow +TJclClrTableInterfaceImpl +TJclClrTableInterfaceImplRow +TJclClrTableManifestResource +TJclClrTableManifestResourceRow +TJclClrTableManifestResourceVisibility +TJclClrTableMemberRef +TJclClrTableMemberRefRow +TJclClrTableMethodDef +TJclClrTableMethodDefRow +TJclClrTableMethodImpl +TJclClrTableMethodImplRow +TJclClrTableMethodPtr +TJclClrTableMethodPtrRow +TJclClrTableMethodSemantics +TJclClrTableMethodSemanticsRow +TJclClrTableMethodSpec +TJclClrTableMethodSpecRow +TJclClrTableModule +TJclClrTableModuleRef +TJclClrTableModuleRefRow +TJclClrTableModuleRow +TJclClrTableNestedClass +TJclClrTableNestedClassRow +TJclClrTableParamDef +TJclClrTableParamDefRow +TJclClrTableParamPtr +TJclClrTableParamPtrRow +TJclClrTablePropertyDef +TJclClrTablePropertyDefRow +TJclClrTablePropertyFlag +TJclClrTablePropertyFlags +TJclClrTablePropertyMap +TJclClrTablePropertyMapRow +TJclClrTablePropertyPtr +TJclClrTablePropertyPtrRow +TJclClrTableStandAloneSig +TJclClrTableStandAloneSigRow +TJclClrTableTypeDef +TJclClrTableTypeDefRow +TJclClrTableTypeRef +TJclClrTableTypeRefRow +TJclClrTableTypeSpec +TJclClrTableTypeSpecRow +TJclClrTypeAttribute +TJclClrTypeAttributes +TJclClrTypeVisibility diff --git a/official/1.96/experts/useswizard/JclMime.txt b/official/1.96/experts/useswizard/JclMime.txt new file mode 100644 index 0000000..328262b --- /dev/null +++ b/official/1.96/experts/useswizard/JclMime.txt @@ -0,0 +1,18 @@ +MimeDecode +MimeDecodedSize +MimeDecodeFile +MimeDecodePartial +MimeDecodePartialEnd +MimeDecodeStream +MimeDecodeString +MimeEncode +MimeEncodedSize +MimeEncodedSizeNoCRLF +MimeEncodeFile +MimeEncodeFileNoCRLF +MimeEncodeFullLines +MimeEncodeNoCRLF +MimeEncodeStream +MimeEncodeStreamNoCRLF +MimeEncodeString +MimeEncodeStringNoCRLF diff --git a/official/1.96/experts/useswizard/JclMiscel.txt b/official/1.96/experts/useswizard/JclMiscel.txt new file mode 100644 index 0000000..525fdb7 --- /dev/null +++ b/official/1.96/experts/useswizard/JclMiscel.txt @@ -0,0 +1,12 @@ +CreateProcAsUser +CreateProcAsUserEx +EJclCreateProcessError +ExitWindows +LogOffOS +PowerOffOS +RebootOS +SetDisplayResolution +ShutDownOS +WinExec32 +WinExec32AndRedirectOutput +WinExec32AndWait diff --git a/official/1.96/experts/useswizard/JclMultimedia.txt b/official/1.96/experts/useswizard/JclMultimedia.txt new file mode 100644 index 0000000..765e922 --- /dev/null +++ b/official/1.96/experts/useswizard/JclMultimedia.txt @@ -0,0 +1,23 @@ +EJclMciError +EJclMixerError +EJclMmTimerError +GetCDAudioTrackList +GetCdInfo +GetMciErrorMessage +IsMediaPresentInDrive +MixerLeftRightToArray +MMCheck +OpenCdMciDevice +OpenCloseCdDrive +TJclCdMediaInfo +TJclCdTrackInfoArray +TJclCdTrackType +TJclMixer +TJclMixerDestination +TJclMixerDevice +TJclMixerLine +TJclMixerLineControl +TJclMixerSource +TJclMultimediaTimer +TMmNotificationKind +TMmTimerKind diff --git a/official/1.96/experts/useswizard/JclNTFS.txt b/official/1.96/experts/useswizard/JclNTFS.txt new file mode 100644 index 0000000..9ff84bd --- /dev/null +++ b/official/1.96/experts/useswizard/JclNTFS.txt @@ -0,0 +1,45 @@ +EJclNtfsError +NtfsCreateHardLink +NtfsCreateHardLinkA +NtfsCreateHardLinkW +NtfsCreateJunctionPoint +NtfsDeleteHardLinks +NtfsDeleteJunctionPoint +NtfsDeleteReparsePoint +NtfsFileHasReparsePoint +NtfsFindFirstStream +NtfsFindHardLinks +NtfsFindNextStream +NtfsFindStreamClose +NtfsGetAllocRangeEntry +NtfsGetCompression +NtfsGetHardLinkInfo +NtfsGetJunctionPointDestination +NtfsGetReparsePoint +NtfsGetReparseTag +NtfsGetSparse +NtfsIsFolderMountPoint +NtfsMountDeviceAsDrive +NtfsMountVolume +NtfsOpLockAckClosePending +NtfsOpLockBreakAckNo2 +NtfsOpLockBreakAcknowledge +NtfsOpLockBreakNotify +NtfsQueryAllocRanges +NtfsReparsePointsSupported +NtfsRequestOpLock +NtfsSetCompression +NtfsSetDefaultFileCompression +NtfsSetDirectoryTreeCompression +NtfsSetFileCompression +NtfsSetPathCompression +NtfsSetReparsePoint +NtfsSetSparse +NtfsSparseStreamsSupported +NtfsZeroDataByHandle +NtfsZeroDataByName +TFileCompressionState +TFindStreamData +TOpLock +TStreamId +TStreamIds diff --git a/official/1.96/experts/useswizard/JclParseUses.pas b/official/1.96/experts/useswizard/JclParseUses.pas new file mode 100644 index 0000000..73a696e --- /dev/null +++ b/official/1.96/experts/useswizard/JclParseUses.pas @@ -0,0 +1,902 @@ +{**************************************************************************************************} +{ } +{ 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: } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Robert Marquardt } +{ Last modified: $Date: 2005/12/16 23:46:25 $ } +{ } +{**************************************************************************************************} + +unit JclParseUses; + +{$I jcl.inc} + +interface + +uses + Classes, SysUtils, + JclOtaUtils; + +type + EUsesListError = class(EJclExpertException); + + TUsesList = class(TObject) + 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(TObject) + 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; + +implementation + +uses + {$IFDEF HAS_UNIT_RTLCONSTS} + RtlConsts, + {$ELSE} + Consts, + {$ENDIF HAS_UNIT_RTLCONSTS} + JclOtaResources; + +const + Blanks: TSysCharSet = [#9, #10, #13, ' ']; + SLibrary = 'library'; + SProgram = 'program'; + SUnit = 'unit'; + SUses = 'uses'; + +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 := P^ in ['A'..'Z', '_', 'a'..'z']; + if Result then + begin + Inc(P); + while P^ in ['0'..'9', 'A'..'Z', '_', 'a'..'z'] do + Inc(P); + end; +end; + +function CheckKeyword(var P: PChar; Keyword: PChar): Boolean; +var + KeywordLen: Integer; +begin + KeywordLen := StrLen(Keyword); + Result := StrLComp(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 := StrLComp(P, Keyword, KeywordLen) = 0; +end; + +function ReadIdentifier(var P: PChar): string; +var + PStart: PChar; +begin + Result := ''; + + if P^ in ['A'..'Z', '_', 'a'..'z'] then + begin + PStart := P; + + Inc(P); + while P^ in ['0'..'9', 'A'..'Z', '_', 'a'..'z'] do + Inc(P); + + SetString(Result, PStart, P - PStart); + end; +end; + +procedure SkipChars(var P: PChar; Chars: TSysCharSet); +begin + while P^ in Chars do + Inc(P); +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; + SkipChars(P, Blanks); + 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.CreateTrace(RsEInvalidUses); + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + + while not (P^ in [#0, '''']) do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + ';': + begin + Inc(P); + Break; + end; + else + raise EUsesListError.CreateTrace(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.CreateTrace(RsEInvalidUses); + + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(Result); + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + + while not (P^ in [#0, '''']) do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + ';': + Break; + else + raise EUsesListError.CreateTrace(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.CreateTrace(Format(SListIndexError, [Index])); + + P := PChar(FText); + if not CheckKeyword(P, SUses) then + raise EUsesListError.CreateTrace(RsEInvalidUses); + I := -1; + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + PIdentifier := P; + if not CheckIdentifier(P) then + raise EUsesListError.CreateTrace(RsEInvalidUses); + + Inc(I); + if I = Index then + begin + while PIdentifier^ in ['0'..'9', 'A'..'Z', '_', 'a'..'z'] 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.CreateTrace(RsEInvalidUses); + Inc(P); + + while not (P^ in [#0, '''']) do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + ';': + Break; + else + raise EUsesListError.CreateTrace(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.CreateTrace(Format(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.CreateTrace(RsEInvalidUses); + + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateTrace(RsEInvalidUses); + + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + + while not (P^ in [#0, '''']) do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(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.CreateTrace(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.CreateTrace(RsEInvalidUses); + + I := -1; + while P^ <> #0 do + begin + SkipCommentsAndBlanks(P); + PIdentifier := P; + if not CheckIdentifier(P) then + raise EUsesListError.CreateTrace(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.CreateTrace(RsEInvalidUses); + Inc(P); + + while not (P^ in [#0, '''']) do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + ';': + Break; + else + raise EUsesListError.CreateTrace(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.CreateTrace(Format(SListIndexError, [Index])); + I := IndexOf(UnitName); + if I <> -1 then + raise EUsesListError.CreateTrace(Format(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.CreateTrace(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.CreateTrace(RsEInvalidUses); + SkipCommentsAndBlanks(P); + + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + + while not (P^ in [#0, '''']) do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + SkipCommentsAndBlanks(P); + end; + + case P^ of + ',': + Inc(P); + else + raise EUsesListError.CreateTrace(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.CreateTrace(Format(SListIndexError, [Index])); + + P := PChar(FText); + if not CheckKeyword(P, SUses) then + raise EUsesListError.CreateTrace(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.CreateTrace(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.CreateTrace(RsEInvalidUses); + Inc(P); + + while not (P^ in [#0, '''']) do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(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.CreateTrace(RsEInvalidUses); + end; + // remove trailing spaces, if any + PIdentifier := PChar(FText) + DelPos - 1; + P := PIdentifier; + SkipChars(P, Blanks); + 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.CreateTrace(RsEInvalidUses); + + SkipCommentsAndBlanks(P); + if PeekKeyword(P, 'in') then + begin + Inc(P, 2); + SkipCommentsAndBlanks(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(RsEInvalidUses); + Inc(P); + + while not (P^ in [#0, '''']) do + Inc(P); + if P^ <> '''' then + raise EUsesListError.CreateTrace(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.CreateTrace(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.CreateTrace(RsEInvalidProgram); + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateTrace(RsEInvalidProgram); + SkipCommentsAndBlanks(P); + if P^ <> ';' then + raise EUsesListError.CreateTrace(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.CreateTrace(RsEInvalidLibrary); + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateTrace(RsEInvalidLibrary); + SkipCommentsAndBlanks(P); + if P^ <> ';' then + raise EUsesListError.CreateTrace(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); + if not CheckKeyword(P, SUnit) then + raise EUsesListError.CreateTrace(RsEInvalidUnit); + SkipCommentsAndBlanks(P); + if not CheckIdentifier(P) then + raise EUsesListError.CreateTrace(RsEInvalidUnit); + SkipCommentsAndBlanks(P); + if P^ <> ';' then + raise EUsesListError.CreateTrace(RsEInvalidUnit); + Inc(P); + // check 'interface' label + SkipCommentsAndBlanks(P); + if not CheckKeyword(P, 'interface') then + raise EUsesListError.CreateTrace(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 + SkipChars(P, [#1..#255] - Blanks); + SkipCommentsAndBlanks(P); + end; + if not CheckKeyword(P, 'implementation') then + raise EUsesListError.CreateTrace(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; + +// History: + +// $Log: JclParseUses.pas,v $ +// Revision 1.4 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.3 2005/10/26 03:29:44 rrossmair +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and $Log: JclParseUses.pas,v $ +// - improved header information, added $Date$ and Revision 1.4 2005/12/16 23:46:25 outchy +// - improved header information, added $Date$ and Added expert stack form. +// - improved header information, added $Date$ and Added code to display call stack on expert exception. +// - improved header information, added $Date$ and Fixed package extension for D2006. +// - improved header information, added $Date$ and CVS tags. +// + +end. diff --git a/official/1.96/experts/useswizard/JclPeImage.txt b/official/1.96/experts/useswizard/JclPeImage.txt new file mode 100644 index 0000000..3970966 --- /dev/null +++ b/official/1.96/experts/useswizard/JclPeImage.txt @@ -0,0 +1,87 @@ +EJclPeImageError +IsValidPeFile +PeBorDependedPackages +PeBorFormNames +PeBorUnmangleName +PeClearCheckSum +PeCreateNameHintTable +PeCreateRequiredImportList +PeDbgImgLibraryName +PeDbgImgNtHeaders +PeDoesExportFunction +PeDoesImportFunction +PeDoesImportLibrary +PeExportedFunctions +PeExportedNames +PeExportedVariables +PeFindMissingImports +PeGetNtHeaders +PeImportedFunctions +PeImportedLibraries +PeInsertSection +PeIsExportFunctionForwarded +PeIsExportFunctionForwardedEx +PeIsNameMangled +PeMapFindResource +PeMapImgExportedVariables +PeMapImgFindSection +PeMapImgLibraryName +PeMapImgNtHeaders +PeMapImgResolvePackageThunk +PeMapImgSections +PeReadLinkerTimeStamp +PeRebaseImage +PeResourceKindNames +PeSmartFunctionNameSame +PeStripFunctionAW +PeUnmangleName +PeUpdateCheckSum +PeUpdateLinkerTimeStamp +PeVerifyCheckSum +TJclBorUmResult +TJclBorUmSymbolKind +TJclBorUmSymbolModifier +TJclBorUmSymbolModifiers +TJclLoadConfig +TJclPeBorForm +TJclPeBorImage +TJclPeBorImagesCache +TJclPeCertificate +TJclPeCertificateList +TJclPeCLRHeader +TJclPeDebugList +TJclPeExportFuncItem +TJclPeExportFuncList +TJclPeExportSort +TJclPeHeader +TJclPeImage +TJclPeImageBaseList +TJclPeImagesCache +TJclPeImageStatus +TJclPeImportFuncItem +TJclPeImportKind +TJclPeImportLibItem +TJclPeImportLibSort +TJclPeImportList +TJclPeImportSort +TJclPeLinkerProducer +TJclPeMapImgHookItem +TJclPeMapImgHooks +TJclPeNameSearch +TJclPeNameSearchFoundEvent +TJclPeNameSearchNotifyEvent +TJclPeNameSearchOption +TJclPeNameSearchOptions +TJclPePackageInfo +TJclPeRelocEntry +TJclPeRelocList +TJclPeResolveCheck +TJclPeResourceItem +TJclPeResourceKind +TJclPeResourceList +TJclPeResourceRawStream +TJclPeRootResourceList +TJclPeSectionStream +TJclPeUmResult +TJclSmartCompOption +TJclSmartCompOptions diff --git a/official/1.96/experts/useswizard/JclPrint.txt b/official/1.96/experts/useswizard/JclPrint.txt new file mode 100644 index 0000000..79a1041 --- /dev/null +++ b/official/1.96/experts/useswizard/JclPrint.txt @@ -0,0 +1,9 @@ +DirectPrint +DPGetDefaultPrinter +DPSetDefaultPrinter +EJclPrinterError +GetDefaultPrinterName +GetPrinterResolution +PrintMemo +SetPrinterPixelsPerInch +TJclPrintSet diff --git a/official/1.96/experts/useswizard/JclRTF.txt b/official/1.96/experts/useswizard/JclRTF.txt new file mode 100644 index 0000000..942aeec --- /dev/null +++ b/official/1.96/experts/useswizard/JclRTF.txt @@ -0,0 +1,2 @@ +TJclRTFProducer +JclRTFToPlainText diff --git a/official/1.96/experts/useswizard/JclRTTI.txt b/official/1.96/experts/useswizard/JclRTTI.txt new file mode 100644 index 0000000..0dee41d --- /dev/null +++ b/official/1.96/experts/useswizard/JclRTTI.txt @@ -0,0 +1,38 @@ +EJclRTTI +IJclBaseInfo +IJclClassTypeInfo +IJclDynArrayTypeInfo +IJclEnumerationTypeInfo +IJclEventParamInfo +IJclEventTypeInfo +IJclFloatTypeInfo +IJclInfoWriter +IJclInt64TypeInfo +IJclInterfaceTypeInfo +IJclOrdinalRangeTypeInfo +IJclOrdinalTypeInfo +IJclPropInfo +IJclSetTypeInfo +IJclStringTypeInfo +IJclTypeInfo +JclEnumValueToIdent +JclGenerateEnumType +JclGenerateEnumTypeBasedOn +JclGenerateSetType +JclGenerateSubRange +JclGUIDToString +JclIntToSet +JclIsClass +JclIsClassByName +JclSetToInt +JclSetToList +JclSetToStr +JclStringToGUID +JclStrToSet +JclStrToTypedInt +JclTypedIntToStr +JclTypeInfo +RemoveTypeInfo +TJclInfoStringsWriter +TJclInfoWriter +TJclPropSpecKind diff --git a/official/1.96/experts/useswizard/JclRegistry.txt b/official/1.96/experts/useswizard/JclRegistry.txt new file mode 100644 index 0000000..cb31d16 --- /dev/null +++ b/official/1.96/experts/useswizard/JclRegistry.txt @@ -0,0 +1,61 @@ +EJclRegistryError +RegCreateKey +RegDeleteEntry +RegDeleteKeyTree +RegDelList +RegGetDataSize +RegGetDataType +RegGetKeyNames +RegGetValueNames +RegHasSubKeys +RegisterAutoExec +RegKeyExists +RegLoadList +RegReadAnsiString +RegReadAnsiStringDef +RegReadBinary +RegReadBinaryDef +RegReadBool +RegReadBoolDef +RegReadCardinal +RegReadCardinalDef +RegReadDouble +RegReadDoubleDef +RegReadDWORD +RegReadDWORDDef +RegReadExtended +RegReadExtendedDef +RegReadInt64 +RegReadInt64Def +RegReadInteger +RegReadIntegerDef +RegReadMultiSz +RegReadMultiSzDef +RegReadSingle +RegReadSingleDef +RegReadString +RegReadStringDef +RegReadUInt64 +RegReadUInt64Def +RegReadWideMultiSz +RegReadWideMultiSzDef +RegReadWideString +RegReadWideStringDef +RegSaveList +RegWriteAnsiString +RegWriteBinary +RegWriteBool +RegWriteCardinal +RegWriteDouble +RegWriteDWORD +RegWriteExtended +RegWriteInt64 +RegWriteInteger +RegWriteMultiSz +RegWriteSingle +RegWriteString +RegWriteUInt64 +RegWriteWideMultiSz +RegWriteWideString +TExecKind +UnregisterAutoExec diff --git a/official/1.96/experts/useswizard/JclResources.txt b/official/1.96/experts/useswizard/JclResources.txt new file mode 100644 index 0000000..dfc517b --- /dev/null +++ b/official/1.96/experts/useswizard/JclResources.txt @@ -0,0 +1,737 @@ +_EDIXMLError002 +_EDIXMLError003 +_EDIXMLError004 +_EDIXMLError005 +_EDIXMLError006 +_EDIXMLError007 +_EDIXMLError008 +_EDIXMLError009 +_EDIXMLError010 +_EDIXMLError011 +_EDIXMLError012 +_EDIXMLError013 +_EDIXMLError014 +_EDIXMLError015 +_EDIXMLError016 +_EDIXMLError017 +_EDIXMLError018 +_EDIXMLError019 +_EDIXMLError020 +_EDIXMLError021 +_EDIXMLError022 +_EDIXMLError023 +_EDIXMLError024 +_EDIXMLError025 +_EDIXMLError026 +_EDIXMLError027 +_EDIXMLError028 +_EDIXMLError029 +_EDIXMLError030 +_EDIXMLError031 +_EDIXMLError032 +_EDIXMLError033 +_EDIXMLError034 +_EDIXMLError035 +_EDIXMLError036 +_EDIXMLError037 +_EDIXMLError038 +_EDIXMLError039 +_EDIXMLError040 +_EDIXMLError041 +_EDIXMLError042 +_EDIXMLError043 +_EDIXMLError044 +_EDIXMLError045 +_EDIXMLError046 +_EDIXMLError047 +_EDIXMLError048 +_EDIXMLError049 +_EDIXMLError050 +_EDIXMLError051 +_EDIXMLError052 +_EDIXMLError053 +_EDIXMLError054 +_EDIXMLError055 +_EDIXMLError056 +_EDIXMLError057 +_EDIXMLError058 +_EDIXMLError059 +_EDIXMLError060 +_EDIXMLError061 +_EDIXMLError062 +_PsPePkgLibrary +_RsArchitect +_RsAssertUnpairedEndUpdate +_RsAttrAnyFile +_RsAttrArchive +_RsAttrCompressed +_RsAttrDirectory +_RsAttrEncrypted +_RsAttrHidden +_RsAttrNormal +_RsAttrOffline +_RsAttrReadOnly +_RsAttrReparsePoint +_RsAttrSparseFile +_RsAttrSystemFile +_RsAttrTemporary +_RsAttrVolumeID +_RsBCBName +_RsBitmapExtension +_RsBitsPerSampleNotSupported +_RsBlankSearchString +_RsBorlandStudioProjects +_RsCannotCreateDir +_RsCannotRaiseSignal +_RsCannotWriteRefStream +_RsCDRomDrive +_RsClientServer +_RsClrCopyright +_RsCmdLineToolOutputInvalid +_RsComFailedStreamRead +_RsComFailedStreamWrite +_RsComInvalidParam +_RsComplexInvalidString +_RsCompressionOperationNotSupported +_RsCompressionReadNotSupported +_RsCompressionResetNotSupported +_RsCompressionSeekNotSupported +_RsCompressionWriteNotSupported +_RsCompressionZLibError +_RsCompressionZLibZBufError +_RsCompressionZLibZDataError +_RsCompressionZLibZErrNo +_RsCompressionZLibZMemError +_RsCompressionZLibZStreamError +_RsCompressionZLibZVersionError +_RsConvTempBelowAbsoluteZero +_RsCreateCompatibleDc +_RsCreateFileMapping +_RsCreateFileMappingView +_RsCreateProcAccessDenied +_RsCreateProcBuild1057Error +_RsCreateProcCommandNotFound +_RsCreateProcFailed +_RsCreateProcLogonFailed +_RsCreateProcLogonUserError +_RsCreateProcNTRequiredError +_RsCreateProcOSVersionError +_RsCreateProcPrivilegeMissing +_RsCreateProcPrivilegesMissing +_RsCreateProcSetDesktopSecurityError +_RsCreateProcSetStationSecurityError +_RsDateConversion +_RsDebugAssertValidPointer +_RsDebugAssertValidString +_RsDebugMapFileExtension +_RsDebugNoProcessInfo +_RsDebugSnapshot +_RsDeclarationFormat +_RsDefaultFileTypeName +_RsDelphiName +_RsDelTreePathIsEmpty +_RsDestinationBitmapEmpty +_RsDeviceMode +_RsDibHandleAllocation +_RsDivByZero +_RsDynArrayError +_RsEDIError001 +_RsEDIError002 +_RsEDIError003 +_RsEDIError004 +_RsEDIError005 +_RsEDIError006 +_RsEDIError007 +_RsEDIError008 +_RsEDIError009 +_RsEDIError010 +_RsEDIError011 +_RsEDIError012 +_RsEDIError013 +_RsEDIError014 +_RsEDIError015 +_RsEDIError016 +_RsEDIError017 +_RsEDIError018 +_RsEDIError019 +_RsEDIError020 +_RsEDIError021 +_RsEDIError022 +_RsEDIError023 +_RsEDIError024 +_RsEDIError025 +_RsEDIError026 +_RsEDIError027 +_RsEDIError028 +_RsEDIError029 +_RsEDIError030 +_RsEDIError031 +_RsEDIError032 +_RsEDIError033 +_RsEDIError034 +_RsEDIError035 +_RsEDIError036 +_RsEDIError037 +_RsEDIError038 +_RsEDIError039 +_RsEDIError040 +_RsEDIError041 +_RsEDIError042 +_RsEDIError043 +_RsEDIError044 +_RsEDIError045 +_RsEDIError046 +_RsEDIError047 +_RsEDIError048 +_RsEDIError049 +_RsEDIError050 +_RsEDIError051 +_RsEDIError052 +_RsEDIError053 +_RsEDIError054 +_RsEDIError055 +_RsEDIError056 +_RsEDIError057 +_RsEDIError058 +_RsEFunctionNotFound +_RsEIllegalQueueCapacity +_RsELibraryNotFound +_RsEmptyArray +_RsENoCollection +_RsEnterprise +_RsEOpenGLInfo +_RsEOperationNotSupported +_RsEOutOfBounds +_RsEValueNotFound +_RsExprEvalEndArgs +_RsExprEvalExprNotFound +_RsExprEvalExprPtrNotFound +_RsExprEvalExprRefCountAssertion +_RsExprEvalFactorExpected +_RsExprEvalFirstArg +_RsExprEvalNextArg +_RsExprEvalRParenExpected +_RsExprEvalUnknownSymbol +_RsFailedToObtainSize +_RsFileIndexOutOfRange +_RsFileMappingInvalidHandle +_RsFileMappingOpenFile +_RsFileSearchAttrInconsistency +_RsFileStreamCreate +_RsFileUtilsAttrUnavailable +_RsFileUtilsLanguageIndex +_RsFileUtilsNoVersionInfo +_RsFormatBadArgumentType +_RsFormatBadArgumentTypeEx +_RsFormatNoArgument +_RsFormatNoArgumentEx +_RsFormatSyntaxError +_RsHardDisk +_RsHasNotTD32Info +_RsInconsistentPath +_RsIndexOufOfRange +_RsIndexOutOfRange +_RsIndexOutOfRangePaper +_RsInstructionStreamInvalid +_RsIntelCacheDescr01 +_RsIntelCacheDescr02 +_RsIntelCacheDescr03 +_RsIntelCacheDescr04 +_RsIntelCacheDescr06 +_RsIntelCacheDescr08 +_RsIntelCacheDescr0A +_RsIntelCacheDescr0C +_RsIntelCacheDescr22 +_RsIntelCacheDescr23 +_RsIntelCacheDescr25 +_RsIntelCacheDescr29 +_RsIntelCacheDescr2C +_RsIntelCacheDescr30 +_RsIntelCacheDescr40 +_RsIntelCacheDescr41 +_RsIntelCacheDescr42 +_RsIntelCacheDescr43 +_RsIntelCacheDescr44 +_RsIntelCacheDescr45 +_RsIntelCacheDescr50 +_RsIntelCacheDescr51 +_RsIntelCacheDescr52 +_RsIntelCacheDescr5B +_RsIntelCacheDescr5C +_RsIntelCacheDescr5D +_RsIntelCacheDescr60 +_RsIntelCacheDescr66 +_RsIntelCacheDescr67 +_RsIntelCacheDescr68 +_RsIntelCacheDescr70 +_RsIntelCacheDescr71 +_RsIntelCacheDescr72 +_RsIntelCacheDescr79 +_RsIntelCacheDescr7A +_RsIntelCacheDescr7B +_RsIntelCacheDescr7C +_RsIntelCacheDescr7D +_RsIntelCacheDescr7F +_RsIntelCacheDescr82 +_RsIntelCacheDescr83 +_RsIntelCacheDescr84 +_RsIntelCacheDescr85 +_RsIntelCacheDescr86 +_RsIntelCacheDescr87 +_RsIntelCacheDescrB0 +_RsIntelCacheDescrB3 +_RsIntelCacheDescrF0 +_RsIntelCacheDescrF1 +_RsIntelUnknownCache +_RsInvalidArgument +_RsInvalidDigit +_RsInvalidDigitValue +_RsInvalidEmptyStringItem +_RsInvalidHandleForRegion +_RsInvalidPrinter +_RsInvalidRational +_RsInvalidRegion +_RsInvalidRegionInfo +_RsInvalidSampleSize +_RsInvalidSignatureData +_RsJpegExtension +_RsLoadFromStreamSize +_RsLocalVarSigOutOfRange +_RsMakeUTCTime +_RsMapiErrACCESS_DENIED +_RsMapiErrAMBIGUOUS_RECIPIENT +_RsMapiErrATTACHMENT_NOT_FOUND +_RsMapiErrATTACHMENT_OPEN_FAILURE +_RsMapiErrATTACHMENT_WRITE_FAILURE +_RsMapiErrBAD_RECIPTYPE +_RsMapiErrDISK_FULL +_RsMapiErrFAILURE +_RsMapiErrINSUFFICIENT_MEMORY +_RsMapiErrINVALID_EDITFIELDS +_RsMapiErrINVALID_MESSAGE +_RsMapiErrINVALID_RECIPS +_RsMapiErrINVALID_SESSION +_RsMapiErrLOGIN_FAILURE +_RsMapiErrMESSAGE_IN_USE +_RsMapiErrNETWORK_FAILURE +_RsMapiErrNO_MESSAGES +_RsMapiErrNOT_SUPPORTED +_RsMapiError +_RsMapiErrTEXT_TOO_LARGE +_RsMapiErrTOO_MANY_FILES +_RsMapiErrTOO_MANY_RECIPIENTS +_RsMapiErrTOO_MANY_SESSIONS +_RsMapiErrTYPE_NOT_SUPPORTED +_RsMapiErrUNKNOWN_RECIPIENT +_RsMapiErrUSER_ABORT +_RsMapiInvalidIndex +_RsMapiMailBCC +_RsMapiMailBody +_RsMapiMailCC +_RsMapiMailNoClient +_RsMapiMailORIG +_RsMapiMailSubject +_RsMapiMailTO +_RsMapiMissingExport +_RsMapSizeFmt +_RsMathDomainError +_RsMetSectInitialize +_RsMetSectInvalidParameter +_RsMetSectNameEmpty +_RsMidiInUnknownError +_RsMidiInvalidChannelNum +_RsMidiOutUnknownError +_RsMMCdTimeFormat +_RsMmCdTrackNo +_RsMmInconsistentId +_RsMmMciErrorPrefix +_RsMmMixerAnalog +_RsMmMixerAuxiliary +_RsMmMixerCompactDisc +_RsMmMixerCtlNotFound +_RsMmMixerDestination +_RsMmMixerDigital +_RsMmMixerHeadphones +_RsMmMixerLine +_RsMmMixerMicrophone +_RsMmMixerMonitor +_RsMmMixerNoDevices +_RsMmMixerPcSpeaker +_RsMmMixerSource +_RsMmMixerSpeakers +_RsMmMixerSynthesizer +_RsMmMixerTelephone +_RsMmMixerUndefined +_RsMmMixerVoiceIn +_RsMmMixerWaveIn +_RsMmMixerWaveOut +_RsMmNoCdAudio +_RsMmSetEvent +_RsMmTimerActive +_RsMmTimerBeginPeriod +_RsMmTimerGetCaps +_RsMMTrackAudio +_RsMMTrackOther +_RsMmUnknownError +_RsNAEndDocument +_RsNAEndPage +_RsNaNSignal +_RsNaNTagError +_RsNASendData +_RsNAStartDocument +_RsNAStartPage +_RsNATransmission +_RsNeedUpdate +_RsNoBitmapForRegion +_RsNoCounter +_RsNoDeviceContextForWindow +_RsNoLocalVarSig +_RsNoNaN +_RsNonPositiveArray +_RsNtfsUnableToDeleteSymbolicLink +_RsNumericConstantTooLarge +_RsOctaveA +_RsOctaveASharp +_RsOctaveB +_RsOctaveC +_RsOctaveCSharp +_RsOctaveD +_RsOctaveDSharp +_RsOctaveE +_RsOctaveF +_RsOctaveFSharp +_RsOctaveG +_RsOctaveGSharp +_RsOpenGLInfoError +_RsOSVersionWin2000 +_RsOSVersionWin2003 +_RsOSVersionWin95 +_RsOSVersionWin95OSR2 +_RsOSVersionWin98 +_RsOSVersionWin98SE +_RsOSVersionWinME +_RsOSVersionWinNT3 +_RsOSVersionWinNT4 +_RsOSVersionWinXP +_RsPathInvalidDrive +_RsPeAddressOfEntryPoint +_RsPeBaseOfCode +_RsPeBaseOfData +_RsPeCantOpen +_RsPeCharacteristics +_RsPeCheckSum +_RsPeCriticalSectionDefaultTimeout +_RsPeCSDVersion +_RsPeDEBUG_BORLAND +_RsPeDEBUG_CODEVIEW +_RsPeDEBUG_COFF +_RsPeDEBUG_EXCEPTION +_RsPeDEBUG_FIXUP +_RsPeDEBUG_FPO +_RsPeDEBUG_MISC +_RsPeDEBUG_OMAP_FROM_SRC +_RsPeDEBUG_OMAP_TO_SRC +_RsPeDEBUG_UNKNOWN +_RsPeDeCommitFreeBlockThreshold +_RsPeDeCommitTotalFreeThreshold +_RsPeDllCharacteristics +_RsPeEditList +_RsPeFileAlignment +_RsPeGlobalFlagsClear +_RsPeGlobalFlagsSet +_RsPeImageBase +_RsPeImageVersion +_RsPeImg_00 +_RsPeImg_01 +_RsPeImg_02 +_RsPeImg_03 +_RsPeImg_04 +_RsPeImg_05 +_RsPeImg_06 +_RsPeImg_07 +_RsPeImg_08 +_RsPeImg_09 +_RsPeImg_10 +_RsPeImg_11 +_RsPeImg_12 +_RsPeImg_13 +_RsPeImg_14 +_RsPeLinkerVersion +_RsPeLoaderFlags +_RsPeLockPrefixTable +_RsPeMachine +_RsPeMACHINE_ALPHA +_RsPeMACHINE_I386 +_RsPeMACHINE_POWERPC +_RsPeMACHINE_R10000 +_RsPeMACHINE_R3000 +_RsPeMACHINE_R4000 +_RsPeMACHINE_UNKNOWN +_RsPeMagic +_RsPeMaximumAllocationSize +_RsPeNotAvailableForAttached +_RsPeNotPE +_RsPeNotResDir +_RsPeNumberOfRvaAndSizes +_RsPeNumberOfSections +_RsPeNumberOfSymbols +_RsPeOperatingSystemVersion +_RsPePkgBCB4Produced +_RsPePkgDelphi4Produced +_RsPePkgDesignOnly +_RsPePkgExecutable +_RsPePkgIgnoreDupUnits +_RsPePkgImplicit +_RsPePkgMain +_RsPePkgNeverBuild +_RsPePkgOrgWeak +_RsPePkgPackage +_RsPePkgProducerUndefined +_RsPePkgRunOnly +_RsPePkgV3Produced +_RsPePkgWeak +_RsPePointerToSymbolTable +_RsPeProcessAffinityMask +_RsPeProcessHeapFlags +_RsPeReadOnlyStream +_RsPeReserved +_RsPersonal +_RsPeSectionAlignment +_RsPeSectionNotFound +_RsPeSignature +_RsPeSizeOfCode +_RsPeSizeOfHeaders +_RsPeSizeOfHeapCommit +_RsPeSizeOfHeapReserve +_RsPeSizeOfImage +_RsPeSizeOfInitializedData +_RsPeSizeOfOptionalHeader +_RsPeSizeOfStackCommit +_RsPeSizeOfStackReserve +_RsPeSizeOfUninitializedData +_RsPeSubsystem +_RsPeSUBSYSTEM_NATIVE +_RsPeSUBSYSTEM_OS2_CUI +_RsPeSUBSYSTEM_POSIX_CUI +_RsPeSUBSYSTEM_RESERVED8 +_RsPeSUBSYSTEM_UNKNOWN +_RsPeSUBSYSTEM_WINDOWS_CUI +_RsPeSUBSYSTEM_WINDOWS_GUI +_RsPeSubsystemVersion +_RsPeTimeDateStamp +_RsPeVersion +_RsPeVirtualMemoryThreshold +_RsPeWin32VersionValue +_RsPowerComplex +_RsPowerInfinite +_RsProductTypeAdvancedServer +_RsProductTypeDatacenterServer +_RsProductTypePersonal +_RsProductTypeProfessional +_RsProductTypeServer +_RsProductTypeWorkStation +_RsProfessional +_RsPS10X14 +_RsPS11X17 +_RsPSA3 +_RsPSA4 +_RsPSA4Small +_RsPSA5 +_RsPSB4 +_RsPSB5 +_RsPSCSheet +_RsPSDSheet +_RsPSEnv10 +_RsPSEnv11 +_RsPSEnv12 +_RsPSEnv14 +_RsPSEnv9 +_RsPSESheet +_RsPSExecutive +_RsPSFolio +_RsPSLedger +_RsPSLegal +_RsPSLetter +_RsPSLetterSmall +_RsPSNote +_RsPSQuarto +_RsPSStatement +_RsPSTabloid +_RsPSUnknown +_RsPSUser +_RsRamDisk +_RsRangeError +_RsRationalDivByZero +_RsRegionCouldNotCreated +_RsRegionDataOutOfBound +_RsRemoteDrive +_RsRemovableDrive +_RsRetrievingPaperSource +_RsRetrievingSource +_RsRTTIArrayOf +_RsRTTIBasedOn +_RsRTTIBits +_RsRTTIClassName +_RsRTTIConst +_RsRTTIDefault +_RsRTTIElNeedCleanup +_RsRTTIElSize +_RsRTTIElType +_RsRTTIFalse +_RsRTTIField +_RsRTTIFlags +_RsRTTIFloatType +_RsRTTIGUID +_RsRTTIIndex +_RsRTTIInvalidBaseType +_RsRTTIInvalidGUIDString +_RsRTTIMaxLen +_RsRTTIMaxValue +_RsRTTIMethodKind +_RsRTTIMinValue +_RsRTTIName +_RsRTTINameList +_RsRTTIOrdinal +_RsRTTIOrdinalType +_RsRTTIOut +_RsRTTIParamCount +_RsRTTIParent +_RsRTTIPropCount +_RsRTTIPropRead +_RsRTTIPropStored +_RsRTTIPropWrite +_RsRTTIReturnType +_RsRTTIStaticMethod +_RsRTTITrue +_RsRTTIType +_RsRTTITypeError +_RsRTTITypeInfoAt +_RsRTTITypeKind +_RsRTTIUnitName +_RsRTTIUnknownIdentifier +_RsRTTIValueOutOfRange +_RsRTTIVar +_RsRTTIVarType +_RsRTTIVirtualMethod +_RsScheduleDayInRange +_RsScheduleDayNotSupported +_RsScheduleEndBeforeStart +_RsScheduleIndexValueSup +_RsScheduleIndexValueZero +_RsScheduleIntervalZero +_RsScheduleInvalidTime +_RsScheduleMonthInRange +_RsScheduleNoDaySpecified +_RsSelectObjectInDc +_RsSourceBitmapEmpty +_RsSourceBitmapInvalid +_RsSPInfo +_RsSpoolerDocName +_RsStandard +_RsStringHashMapDuplicate +_RsStringHashMapInvalidNode +_RsStringHashMapMustBeEmpty +_RsStringHashMapNoTraits +_RsStringToBoolean +_RsSynchAttachDispatcher +_RsSynchAttachWin32Handle +_RsSynchCreateEvent +_RsSynchCreateMutex +_RsSynchCreateSemaphore +_RsSynchCreateWaitableTimer +_RsSynchDuplicateWin32Handle +_RsSynchInitCriticalSection +_RsSynchOpenEvent +_RsSynchOpenMutex +_RsSynchOpenSemaphore +_RsSynchOpenWaitableTimer +_RsSysErrorMessageFmt +_RsSystemIdleProcess +_RsSystemProcess +_RsTempConvTypeError +_RsUnableToAccessValue +_RsUnableToOpenKeyRead +_RsUnableToOpenKeyWrite +_RsUnexpectedDataType +_RsUnexpectedValue +_RsUnknownAttribute +_RsUnknownClassLayout +_RsUnknownDrive +_RsUnknownManifestResource +_RsUnknownStringFormatting +_RsUpdatePackName +_RsUpdatingPrinter +_RsUREBaseString +_RsURECharacterClassOpen +_RsUREExpressionEmpty +_RsUREInvalidCharProperty +_RsUREInvalidRepeatRange +_RsURERepeatRangeOpen +_RsUREUnbalancedGroup +_RsUREUnexpectedEOS +_RsVclIncludeDir +_RsVft2DrvCOMM +_RsVft2DrvDISPLAY +_RsVft2DrvINSTALLABLE +_RsVft2DrvKEYBOARD +_RsVft2DrvLANGUAGE +_RsVft2DrvMOUSE +_RsVft2DrvNETWORK +_RsVft2DrvPRINTER +_RsVft2DrvSOUND +_RsVft2DrvSYSTEM +_RsVft2FontRASTER +_RsVft2FontTRUETYPE +_RsVft2FontVECTOR +_RsVftApp +_RsVftDll +_RsVftDrv +_RsVftFont +_RsVftStaticLib +_RsVftUnknown +_RsVftVxd +_RsViewNeedsMapping +_RsVMTMemoryWriteError +_RsVosDesignedFor +_RsVosDos +_RsVosDosWindows16 +_RsVosDosWindows32 +_RsVosNT +_RsVosNTWindows32 +_RsVosOS216 +_RsVosOS216PM16 +_RsVosOS232 +_RsVosOS232PM32 +_RsVosPM16 +_RsVosPM32 +_RsVosUnknown +_RsVosWindows16 +_RsVosWindows32 +_RsWin32Prefix +_RsWrongDataType +_SEFTextSetsCode_Elm0_Desc +_SEFTextSetsCode_Elm1_Desc +_SEFTextSetsCode_Elm2_Desc +_SEFTextSetsCode_Elm4_Desc +_SEFTextSetsCode_Seg0_Desc +_SEFTextSetsCode_Seg1_Desc +_SEFTextSetsCode_Seg2_Desc +_SEFTextSetsCode_Seg3_Desc +_SEFTextSetsCode_Seg4_Desc +_SEFTextSetsCode_Seg5_Desc +_SEFTextSetsCode_Seg6_Desc +_SEFTextSetsCode_Seg7_Desc +_SEFTextSetsCode_Set0_Desc +_SEFTextSetsCode_Set1_Desc +_SEFTextSetsCode_Set2_Desc +_SEFTextSetsCode_Set3_Desc +_SEFTextSetsCode_Set4_Desc +_SEFTextSetsCode_Set5_Desc +_SErrBadMagic +_SErrBadOption +_SErrLibNotLoaded +_SErrNoMatch +_SErrNoMemory +_SErrNoSubString +_SErrNull +_SErrUnknownNode diff --git a/official/1.96/experts/useswizard/JclSchedule.txt b/official/1.96/experts/useswizard/JclSchedule.txt new file mode 100644 index 0000000..4bb9882 --- /dev/null +++ b/official/1.96/experts/useswizard/JclSchedule.txt @@ -0,0 +1,16 @@ +CreateSchedule +EqualTimeStamps +ESchedule +IJclDailySchedule +IJclMonthlySchedule +IJclSchedule +IJclScheduleDayFrequency +IJclWeeklySchedule +IJclYearlySchedule +IsNullTimeStamp +NullStamp +TScheduleEndKind +TScheduleIndexKind +TScheduleRecurringKind +TScheduleWeekDay +TScheduleWeekDays diff --git a/official/1.96/experts/useswizard/JclSecurity.txt b/official/1.96/experts/useswizard/JclSecurity.txt new file mode 100644 index 0000000..cec1e7c --- /dev/null +++ b/official/1.96/experts/useswizard/JclSecurity.txt @@ -0,0 +1,12 @@ +CreateNullDacl +EnableProcessPrivilege +EnableThreadPrivilege +FreeTokenInformation +GetInteractiveUserName +GetPrivilegeDisplayName +GetUserObjectName +IsAdministrator +IsPrivilegeEnabled +LookupAccountBySid +QueryTokenInformation +SetUserObjectFullAccess diff --git a/official/1.96/experts/useswizard/JclShell.txt b/official/1.96/experts/useswizard/JclShell.txt new file mode 100644 index 0000000..7afe5aa --- /dev/null +++ b/official/1.96/experts/useswizard/JclShell.txt @@ -0,0 +1,61 @@ +DisplayContextMenuPidl +DisplayPropDialog +DriveToPidlBind +GetFileExeType +GetFileNameIcon +GetSpecialFolderLocation +GetSystemIcon +OpenFolder +OpenSpecialFolder +OverlayIcon +OverlayIconShared +OverlayIconShortCut +PathToPidl +PathToPidlBind +PidlBindToParent +PidlCompare +PidlCopy +PidlFree +PidlGetDepth +PidlGetLength +PidlGetNext +PidlToPath +RtdlMsiGetComponentPath +RtdlMsiGetShortcutTarget +RtdlMsiLibHandle +SHAllocMem +SHDeleteFiles +SHDeleteFolder +SHDllGetVersion +ShellExec +ShellExecAndWait +ShellExecEx +ShellFindExecutable +ShellLinkCreate +ShellLinkCreateSystem +ShellLinkFree +ShellLinkIcon +ShellLinkResolve +ShellOpenAs +ShellRasDial +ShellRunControlPanel +SHEnumFolderClose +SHEnumFolderFirst +SHEnumFolderNext +SHEnumSpecialFolderFirst +SHFreeMem +SHGetItemInfoTip +SHGetMem +SHReallocMem +SHRenameFile +StrRetFreeMem +StrRetToString +TEnumFolderFlag +TEnumFolderFlags +TEnumFolderRec +TJclFileExeType +TSHDeleteOption +TSHDeleteOptions +TShellLink +TSHRenameOption +TSHRenameOptions diff --git a/official/1.96/experts/useswizard/JclStatistics.txt b/official/1.96/experts/useswizard/JclStatistics.txt new file mode 100644 index 0000000..e25f03f --- /dev/null +++ b/official/1.96/experts/useswizard/JclStatistics.txt @@ -0,0 +1,24 @@ +BinomialCoeff +Combinations +EJclStatisticsError +GeometricMean +HarmonicMean +HeronianMean +IsPositiveFloatArray +MaxFloatArray +MaxFloatArrayIndex +Median +MedianUnsorted +MinFloatArray +MinFloatArrayIndex +Permutation +PopulationVariance +PopulationVarianceAndMean +SampleVariance +SampleVarianceAndMean +StdError +SumFloatArray +SumOfSquares +SumPairProductFloatArray +SumSquareDiffFloatArray +SumSquareFloatArray diff --git a/official/1.96/experts/useswizard/JclStrHashMap.txt b/official/1.96/experts/useswizard/JclStrHashMap.txt new file mode 100644 index 0000000..5b55437 --- /dev/null +++ b/official/1.96/experts/useswizard/JclStrHashMap.txt @@ -0,0 +1,14 @@ +CaseSensitiveTraits +DataHash +EJclStringHashMapError +Iterate_Dispose +Iterate_FreeMem +Iterate_FreeObjects +StrHash +TCaseInsensitiveTraits +TCaseSensitiveTraits +TextHash +THashNode +TIterateMethod +TStringHashMap +TStringHashMapTraits diff --git a/official/1.96/experts/useswizard/JclStrings.txt b/official/1.96/experts/useswizard/JclStrings.txt new file mode 100644 index 0000000..b1486b1 --- /dev/null +++ b/official/1.96/experts/useswizard/JclStrings.txt @@ -0,0 +1,141 @@ +AllocateMultiSz +AllocateWideMultiSz +BooleanToStr +CharEqualNoCase +CharHex +CharIPos +CharIsAlpha +CharIsAlphaNum +CharIsBlank +CharIsControl +CharIsDelete +CharIsDigit +CharIsLower +CharIsNumberChar +CharIsPrintable +CharIsPunctuation +CharIsReturn +CharIsSpace +CharIsUpper +CharIsWhiteSpace +CharLastPos +CharLower +CharPos +CharReplace +CharToggleCase +CharType +CharUpper +FileToString +FreeMultiSz +FreePCharVector +FreeWideMultiSz +MultiSzDup +MultiSzLength +MultiSzToStrings +PCharVectorCount +PCharVectorToStrings +StrAddRef +StrAfter +StrAllocSize +StrAnsiToOem +StrBefore +StrBetween +StrCenter +StrCharCount +StrCharPosLower +StrCharPosUpper +StrCharsCount +StrChopRight +StrCompare +StrCompareRange +StrConsistsOfNumberChars +StrContainsChars +StrDecRef +StrDoubleQuote +StrEnsureNoPrefix +StrEnsureNoSuffix +StrEnsurePrefix +StrEnsureSuffix +StrEscapedToString +StrFillChar +StrFind +StrHasPrefix +StrILastPos +StrIndex +StringsToMultiSz +StringsToPCharVector +StringsToStr +StringToFile +StrIPos +StrIsAlpha +StrIsAlphaNum +StrIsAlphaNumUnderscore +StrIsDigit +StrIsOneOf +StrIsSubset +StrIToStrings +StrKeepChars +StrLastPos +StrLeft +StrLen +StrLength +StrLower +StrLowerBuff +StrLowerInPlace +StrMatch +StrMatches +StrMid +StrMove +StrNIPos +StrNormIndex +StrNPos +StrOemToAnsi +StrPadLeft +StrPadRight +StrPrefixIndex +StrProper +StrProperBuff +StrQuote +StrRefCount +StrRemoveChars +StrRepeat +StrRepeatLength +StrReplace +StrReplaceButChars +StrReplaceChar +StrReplaceChars +StrResetLength +StrRestOf +StrReverse +StrReverseInPlace +StrRight +StrSame +StrSearch +StrSingleQuote +StrSmartCase +StrStrCount +StrStringToEscaped +StrStripNonNumberChars +StrToFloatSafe +StrToHex +StrToIntSafe +StrToken +StrTokens +StrTokenToStrings +StrToStrings +StrTrimCharLeft +StrTrimCharRight +StrTrimCharsLeft +StrTrimCharsRight +StrTrimQuotes +StrUpper +StrUpperBuff +StrUpperInPlace +StrWord +TrimStrings +TrimStringsLeft +TrimStringsRight +WideMultiSzDup +WideMultiSzLength +WideMultiSzToWideStrings +WideStringsToWideMultiSz diff --git a/official/1.96/experts/useswizard/JclSvcCtrl.txt b/official/1.96/experts/useswizard/JclSvcCtrl.txt new file mode 100644 index 0000000..52cdb39 --- /dev/null +++ b/official/1.96/experts/useswizard/JclSvcCtrl.txt @@ -0,0 +1,16 @@ +GetServiceStatusByName +GetServiceStatusWaitingIfPending +StartServiceByName +StopServiceByName +TJclNtService +TJclSCManager +TJclServiceControlAccepted +TJclServiceControlAccepteds +TJclServiceErrorControlType +TJclServiceGroup +TJclServiceSortOrderType +TJclServiceStartType +TJclServiceState +TJclServiceStates +TJclServiceType +TJclServiceTypes diff --git a/official/1.96/experts/useswizard/JclSynch.txt b/official/1.96/experts/useswizard/JclSynch.txt new file mode 100644 index 0000000..aed5c6c --- /dev/null +++ b/official/1.96/experts/useswizard/JclSynch.txt @@ -0,0 +1,38 @@ +EJclCriticalSectionError +EJclDispatcherObjectError +EJclEventError +EJclMeteredSectionError +EJclMutexError +EJclSemaphoreError +EJclWaitableTimerError +EJclWin32HandleObjectError +LockedAdd +LockedCompareExchange +LockedDec +LockedExchange +LockedExchangeAdd +LockedExchangeDec +LockedExchangeInc +LockedExchangeSub +LockedInc +LockedSub +QueryCriticalSection +QueryEvent +QueryMutex +QuerySemaphore +QueryTimer +TJclCriticalSection +TJclCriticalSectionEx +TJclDispatcherObject +TJclEvent +TJclMeteredSection +TJclMultiReadExclusiveWrite +TJclMutex +TJclOptex +TJclSemaphore +TJclWaitableTimer +TJclWaitResult +TMrewPreferred +TMrewThreadInfoArray +WaitAlertableForMultipleObjects +WaitForMultipleObjects diff --git a/official/1.96/experts/useswizard/JclSysInfo.txt b/official/1.96/experts/useswizard/JclSysInfo.txt new file mode 100644 index 0000000..15530e3 --- /dev/null +++ b/official/1.96/experts/useswizard/JclSysInfo.txt @@ -0,0 +1,140 @@ +CPUID +CreateEnvironmentBlock +DelEnvironmentVar +DestroyEnvironmentBlock +ExpandEnvironmentVar +GetAPMBatteryFlag +GetAPMBatteryFlags +GetAPMBatteryFullLifeTime +GetAPMBatteryLifePercent +GetAPMBatteryLifeTime +GetAPMLineStatus +GetAppdataFolder +GetBIOSCopyright +GetBIOSDate +GetBIOSExtendedInfo +GetBIOSName +GetCapsLockKeyState +GetCommonAppdataFolder +GetCommonDesktopdirectoryFolder +GetCommonFavoritesFolder +GetCommonFilesFolder +GetCommonProgramsFolder +GetCommonStartmenuFolder +GetCommonStartupFolder +GetCookiesFolder +GetCpuInfo +GetCPUSpeed +GetCurrentFolder +GetDesktopDirectoryFolder +GetDesktopFolder +GetDomainName +GetEnvironmentVar +GetEnvironmentVars +GetFavoritesFolder +GetFontsFolder +GetFreePageFileMemory +GetFreePhysicalMemory +GetFreeSystemResources +GetFreeVirtualMemory +GetHistoryFolder +GetIntelCacheDescription +GetInternetCacheFolder +GetIPAddress +GetKeyState +GetLocalComputerName +GetLocalUserName +GetMacAddresses +GetMainAppWndFromPid +GetMaxAppAddress +GetMemoryLoad +GetMinAppAddress +GetNethoodFolder +GetNumLockKeyState +GetOpenGLVersion +GetOSVersionString +GetPersonalFolder +GetPidFromProcessName +GetPrinthoodFolder +GetProcessNameFromPid +GetProcessNameFromWnd +GetProfileFolder +GetProgramFilesFolder +GetProgramsFolder +GetRecentFolder +GetRegisteredCompany +GetRegisteredOwner +GetScrollLockKeyState +GetSendToFolder +GetShellProcessHandle +GetShellProcessName +GetStartmenuFolder +GetStartupFolder +GetSwapFileSize +GetSwapFileUsage +GetTasksList +GetTemplatesFolder +GetTotalPageFileMemory +GetTotalPhysicalMemory +GetTotalVirtualMemory +GetUserDomainName +GetVolumeFileSystem +GetVolumeFileSystemFlags +GetVolumeName +GetVolumeSerialNumber +GetWindowCaption +GetWindowIcon +GetWindowsFolder +GetWindowsServicePackVersion +GetWindowsServicePackVersionString +GetWindowsSystemFolder +GetWindowsTempFolder +GetWindowsVersion +GetWindowsVersionString +IntelCacheDescription +IsMainAppWindow +IsSystemModule +IsSystemResourcesMeterPresent +IsWin2003 +IsWin2K +IsWin95 +IsWin95OSR2 +IsWin98 +IsWin98SE +IsWindowResponding +IsWinME +IsWinNT +IsWinNT3 +IsWinNT31 +IsWinNT35 +IsWinNT351 +IsWinNT4 +IsWinXP +LoadedModulesList +ModuleFromAddr +NtProductType +NtProductTypeString +PageSize +ProcessorCount +ReadTimeStampCounter +RoundFrequency +RoundToAllocGranularity64 +RoundToAllocGranularityPtr +RunningProcessesList +SetEnvironmentVar +SetGlobalEnvironmentVariable +TAPMBatteryFlag +TAPMBatteryFlags +TAPMLineStatus +TCacheInfo +TEnvironmentOption +TEnvironmentOptions +TerminateApp +TerminateTask +TestFDIVInstruction +TFileSystemFlag +TFileSystemFlags +TFreeSysResKind +TJclTerminateAppResult +TNtProductType +TWindowsVersion diff --git a/official/1.96/experts/useswizard/JclSysUtils.txt b/official/1.96/experts/useswizard/JclSysUtils.txt new file mode 100644 index 0000000..1d3589f --- /dev/null +++ b/official/1.96/experts/useswizard/JclSysUtils.txt @@ -0,0 +1,73 @@ +ClearObjectList +DynArrayCompareAnsiString +DynArrayCompareAnsiText +DynArrayCompareByte +DynArrayCompareCardinal +DynArrayCompareDouble +DynArrayCompareExtended +DynArrayCompareFloat +DynArrayCompareInt64 +DynArrayCompareInteger +DynArrayCompareShortInt +DynArrayCompareSingle +DynArrayCompareSmallInt +DynArrayCompareString +DynArrayCompareText +DynArrayCompareWord +EJclConversionError +EJclVMTError +Execute +FreeMemAndNil +FreeObjectList +GetAndFillMem +GetClassParent +GetDynamicAddressList +GetDynamicIndexList +GetDynamicMethod +GetDynamicMethodCount +GetFieldTable +GetImplementorOfInterface +GetInitTable +GetMethodEntry +GetMethodTable +GetModuleSymbol +GetModuleSymbolEx +GetVirtualMethod +GetVirtualMethodCount +Guard +GuardAllocMem +GuardGetMem +HasDynamicMethod +Iff +IMultiSafeGuard +IntToBool +IntToStrZeroPad +ISafeGuard +IsClass +IsCompiledWithPackages +IsObject +LoadModule +LoadModuleEx +PAnsiCharOrNil +PCharOrNil +PWideCharOrNil +ReadKey +ReadModuleData +SearchDynArray +SearchSortedList +SearchSortedUntyped +SetClassParent +SetVirtualMethod +SizeOfMem +SortDynArray +StrToBoolean +SystemTObjectInstance +TDigitCount +TDigitValue +TJclNumericFormat +TJclReferenceMemoryStream +TNumericSystemBase +TTextHandler +UnloadModule +WriteModuleData +WriteProtectedMemory diff --git a/official/1.96/experts/useswizard/JclTD32.txt b/official/1.96/experts/useswizard/JclTD32.txt new file mode 100644 index 0000000..7a7350b --- /dev/null +++ b/official/1.96/experts/useswizard/JclTD32.txt @@ -0,0 +1,10 @@ +TJclGlobalProcSymbolInfo +TJclLineInfo +TJclLocalProcSymbolInfo +TJclModuleInfo +TJclPeBorTD32Image +TJclProcSymbolInfo +TJclSourceModuleInfo +TJclSymbolInfo +TJclTD32InfoParser +TJclTD32InfoScanner diff --git a/official/1.96/experts/useswizard/JclUnicode.txt b/official/1.96/experts/useswizard/JclUnicode.txt new file mode 100644 index 0000000..8604a0d --- /dev/null +++ b/official/1.96/experts/useswizard/JclUnicode.txt @@ -0,0 +1,153 @@ +CodeBlockFromChar +CodePageFromLocale +ExpandANSIString +GetCharSetFromLocale +KeyboardCodePage +KeyUnicode +MaximumUCS2 +MaximumUCS4 +MaximumUTF16 +ReplacementCharacter +StrAllocW +StrBufSizeW +StrCatW +StrCompW +StrCopyW +StrDisposeW +StrECopyW +StrEndW +StrICompW +StringToWideStringEx +StrLCatW +StrLCompW +StrLCopyW +StrLenW +StrLICompW +StrMoveW +StrNewW +StrNScanW +StrPCopyW +StrPLCopyW +StrPosW +StrRNScanW +StrRScanW +StrScanW +StrSwapByteOrder +SurrogateHighEnd +SurrogateHighStart +SurrogateLowEnd +SurrogateLowStart +TCharacterCategories +TCharacterCategory +TConfirmConversionEvent +TDFA +TDFAStates +TDynWideCharArray +TFontCharSet +TNormalizationForm +TranslateString +TSearchEngine +TSearchFlag +TSearchFlags +TUcCClass +TUcEquivalentList +TUcExpressionList +TUCS2Array +TUCS4Array +TUcState +TUcStateList +TUcStateTable +TUcSymbol +TUcSymbolTable +TUcSymbolTableEntry +TUcTransitions +TUnicodeBlock +TUREBuffer +TURESearch +TUTBMSearch +TWideStringItemList +TWideStringList +TWideStrings +UnicodeCaseFold +UnicodeComposePair +UnicodeIsAlpha +UnicodeIsAlphaNum +UnicodeIsBlank +UnicodeIsCased +UnicodeIsClosePunctuation +UnicodeIsComposed +UnicodeIsConnectionPunctuation +UnicodeIsControl +UnicodeIsCurrency +UnicodeIsDash +UnicodeIsDefined +UnicodeIsDigit +UnicodeIsEnclosing +UnicodeIsFinalPunctuation +UnicodeIsFormatControl +UnicodeIsGraph +UnicodeIsHan +UnicodeIsHangul +UnicodeIsHexDigit +UnicodeIsIdentifierPart +UnicodeIsIdentifierStart +UnicodeIsInitialPunctuation +UnicodeIsIsoControl +UnicodeIsLeftToRight +UnicodeIsLetterNumber +UnicodeIsLineSeparator +UnicodeIsLower +UnicodeIsMark +UnicodeIsMath +UnicodeIsMirroring +UnicodeIsModifier +UnicodeIsModifierSymbol +UnicodeIsNeutral +UnicodeIsNonBreaking +UnicodeIsNonSpacing +UnicodeIsNonSpacingMark +UnicodeIsNumber +UnicodeIsOpenPunctuation +UnicodeIsParagraphSeparator +UnicodeIsPrintable +UnicodeIsPrivate +UnicodeIsPunctuation +UnicodeIsQuotationMark +UnicodeIsRightToLeft +UnicodeIsSeparator +UnicodeIsSpace +UnicodeIsSpacingMark +UnicodeIsStrong +UnicodeIsSurrogate +UnicodeIsSymbol +UnicodeIsSymmetric +UnicodeIsTitle +UnicodeIsUndefined +UnicodeIsUpper +UnicodeIsWeak +UnicodeIsWhiteSpace +UnicodeNumberLookup +UnicodeToLower +UnicodeToTitle +UnicodeToUpper +UTF8ToWideString +WideAdjustLineBreaks +WideCaseFolding +WideCharPos +WideCompareText +WideCompose +WideCRLF +WideDecompose +WideExtractQuotedStr +WideLowerCase +WideNormalize +WideQuotedStr +WideSameText +WideStringOfChar +WideStringToStringEx +WideStringToUTF8 +WideTitleCase +WideTrim +WideTrimLeft +WideTrimRight +WideUpperCase diff --git a/official/1.96/experts/useswizard/JclUnitConv.txt b/official/1.96/experts/useswizard/JclUnitConv.txt new file mode 100644 index 0000000..9616f81 --- /dev/null +++ b/official/1.96/experts/useswizard/JclUnitConv.txt @@ -0,0 +1,114 @@ +BarToPascal +CartesianToCylinder +CartesianToPolar +CartesianToSpheric +CelsiusTo +CelsiusToFahrenheit +CelsiusToKelvin +CelsiusToRankine +CelsiusToReaumur +CmToInch +ConvertTemperature +CwtUkToKg +CwtUsToKg +CyclePerDeg +CyclePerGrad +CyclePerRad +CycleToDeg +CycleToGrad +CycleToRad +CylinderToCartesian +DegPerCycle +DegPerGrad +DegPerRad +DegToCycle +DegToDms +DegToDmsStr +DegToGrad +DegToRad +DmsToDeg +DmsToRad +ETemperatureConversionError +EUnitConversionError +FahrenheitTo +FahrenheitToCelsius +FahrenheitToKelvin +FahrenheitToRankine +FahrenheitToReaumur +FeetToMetre +GalCanToGalUs +GalCanToLitre +GalUkToGalUs +GalUkToLitre +GalUsToGalCan +GalUsToGalUk +GalUsToLitre +GradPerCycle +GradPerDeg +GradPerRad +GradToCycle +GradToDeg +GradToRad +HowAOneLinerCanBiteYou +HpElectricToWatt +HpMetricToWatt +InchToCm +KaratToKg +KelvinTo +KelvinToCelsius +KelvinToFahrenheit +KelvinToRankine +KelvinToReaumur +KgToCwtUk +KgToCwtUs +KgToKarat +KgToLb +KgToLton +KgToOz +KgToQrUk +KgToQrUs +KgToSton +KmToNm +KmToSm +KnotToMs +LbToKg +LitreToGalCan +LitreToGalUk +LitreToGalUs +LtonToKg +MakePercentage +MetreToFeet +MetreToYard +MsToKnot +NmToKm +OzToKg +PascalToAt +PascalToBar +PascalToTorr +PolarToCartesian +QrUkToKg +QrUsToKg +RadPerCycle +RadPerDeg +RadPerGrad +RadToCycle +RadToDeg +RadToGrad +RankineTo +RankineToCelsius +RankineToFahrenheit +RankineToKelvin +RankineToReaumur +ReaumurTo +ReaumurToCelsius +ReaumurToFahrenheit +ReaumurToKelvin +ReaumurToRankine +SmToKm +SphericToCartesian +StonToKg +TorrToPascal +TTemperatureType +WattToHpElectric +WattToHpMetric +YardToMetre diff --git a/official/1.96/experts/useswizard/JclUnitVersioning.txt b/official/1.96/experts/useswizard/JclUnitVersioning.txt new file mode 100644 index 0000000..d161d6a --- /dev/null +++ b/official/1.96/experts/useswizard/JclUnitVersioning.txt @@ -0,0 +1,7 @@ +RegisterUnitVersion +TCustomUnitVersioningProvider +TUnitVersion +TUnitVersionInfo +TUnitVersioning +TUnitVersioningModule +UnregisterUnitVersion diff --git a/official/1.96/experts/useswizard/JclUsesDialog.dfm b/official/1.96/experts/useswizard/JclUsesDialog.dfm new file mode 100644 index 0000000..fcc2bab --- /dev/null +++ b/official/1.96/experts/useswizard/JclUsesDialog.dfm @@ -0,0 +1,199 @@ +object FormUsesConfirm: TFormUsesConfirm + Left = 494 + Top = 371 + ActiveControl = ButtonOK + Caption = 'Confirm changes' + ClientHeight = 217 + ClientWidth = 427 + Color = clBtnFace + Constraints.MinHeight = 200 + Constraints.MinWidth = 300 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poDesktopCenter + PixelsPerInch = 96 + TextHeight = 13 + object ButtonOK: TButton + Left = 257 + Top = 184 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = 'OK' + Default = True + ModalResult = 1 + TabOrder = 0 + OnClick = ButtonOKClick + end + object ButtonCancel: TButton + Left = 345 + Top = 184 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 1 + end + object TreeViewChanges: TTreeView + Left = 8 + Top = 8 + Width = 410 + Height = 161 + Anchors = [akLeft, akTop, akRight, akBottom] + Images = TreeImages + Indent = 19 + ReadOnly = True + TabOrder = 2 + OnKeyPress = TreeViewChangesKeyPress + OnMouseDown = TreeViewChangesMouseDown + end + object TreeImages: TImageList + Left = 8 + Top = 176 + Bitmap = { + 494C010102000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000001000000001002000000000000010 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080000000000000000000000000000000000000000000000000008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000808080000000 + 0000FFFFFF000000000000000000FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000808080000000 + 0000FFFFFF00000000000000000000000000FFFFFF0000000000000000000000 + 0000FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF000000000000000000000000000000000000000000FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00000000000000000000000000FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF000000000000000000000000000000000000000000FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000808080000000 + 0000FFFFFF00000000000000000000000000FFFFFF0000000000000000000000 + 0000FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000808080000000 + 0000FFFFFF000000000000000000FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000808080000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000808080000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000808080000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080000000000000000000000000000000000000000000000000008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000100000000100010000000000800000000000000000000000 + 000000000000000000000000FFFFFF00FFFFFFFF00000000FFFFFFFF00000000 + E007E00700000000C003C00300000000C003C00300000000C003C00300000000 + C003C00300000000C003C00300000000C003C00300000000C003C00300000000 + C003C00300000000C003C00300000000C003C00300000000E007E00700000000 + FFFFFFFF00000000FFFFFFFF0000000000000000000000000000000000000000 + 000000000000} + end +end diff --git a/official/1.96/experts/useswizard/JclUsesDialog.pas b/official/1.96/experts/useswizard/JclUsesDialog.pas new file mode 100644 index 0000000..7c337de --- /dev/null +++ b/official/1.96/experts/useswizard/JclUsesDialog.pas @@ -0,0 +1,210 @@ +{**************************************************************************************************} +{ } +{ 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 JclUsesDialog.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: } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Robert Marquardt } +{ Last modified: $Date: 2005/12/16 23:46:25 $ } +{ } +{**************************************************************************************************} + +unit JclUsesDialog; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ComCtrls, ImgList; + +type + TFormUsesConfirm = class(TForm) + ButtonCancel: TButton; + ButtonOK: TButton; + TreeImages: TImageList; + TreeViewChanges: TTreeView; + procedure ButtonOKClick(Sender: TObject); + procedure TreeViewChangesKeyPress(Sender: TObject; var Key: Char); + procedure TreeViewChangesMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + private + FChangeList: TStrings; + FErrors: TList; + function ToggleNode(Node: TTreeNode): Boolean; + public + constructor Create(AOwner: TComponent; AChangeList: TStrings; Errors: TList); reintroduce; + end; + +implementation + +uses + CommCtrl, + JclOtaResources, JclOtaUtils, JclUsesWizard; + +{$R *.dfm} + +constructor TFormUsesConfirm.Create(AOwner: TComponent; AChangeList: TStrings; Errors: TList); +const + ActionStrings: array [TWizardAction] of string = + (RsActionSkip, RsActionAdd, RsActionAdd, RsActionMove); + SectionStrings: array [TWizardAction] of string = + ('', RsSectionImpl, RsSectionIntf, RsSectionIntf); +var + I, J: Integer; + Node: TTreeNode; +begin + inherited Create(AOwner); + FChangeList := AChangeList; + FErrors := Errors; + for I := 0 to FChangeList.Count - 1 do + begin + Node := TreeViewChanges.Items.AddChildObject(nil, Format('%d. %s %s %s', + [I + 1, ActionStrings[TWizardAction(FChangeList.Objects[I])], FChangeList[I], + SectionStrings[TWizardAction(FChangeList.Objects[I])]]), Pointer(I)); + for J := 0 to FErrors.Count - 1 do + with PErrorInfo(FErrors[J])^ do + if AnsiCompareText(UsesName, FChangeList[I]) = 0 then + with TreeViewChanges.Items.AddChild(Node, Format(RsUndeclIdent, + [UnitName, LineNumber, Identifier, UsesName])) do + begin + ImageIndex := -1; + SelectedIndex := -1; + end; + case TWizardAction(FChangeList.Objects[I]) of + waSkip: + Node.ImageIndex := 0; + else + Node.ImageIndex := 1; + end; + Node.SelectedIndex := Node.ImageIndex; + + Node.Expand(True); + end; + if FErrors.Count > 0 then + with PErrorInfo(FErrors[0])^ do + Caption := Format(RsConfirmChanges, [UnitName]); +end; + +function TFormUsesConfirm.ToggleNode(Node: TTreeNode): Boolean; +begin + if Node.ImageIndex = 0 then + begin + Node.ImageIndex := 1; + Node.SelectedIndex := 1; + Result := True; + end + else + if Node.ImageIndex = 1 then + begin + Node.ImageIndex := 0; + Node.SelectedIndex := 0; + Result := True; + end + else + Result := False; +end; + +procedure TFormUsesConfirm.ButtonOKClick(Sender: TObject); +var + Node: TTreeNode; +begin + try + with TreeViewChanges do + begin + Node := Items.GetFirstNode; + while Assigned(Node) do + begin + if Node.ImageIndex = 0 then + FChangeList.Objects[Integer(Node.Data)] := TObject(waSkip); + Node := Node.GetNextSibling; + end; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TFormUsesConfirm.TreeViewChangesKeyPress(Sender: TObject; var Key: Char); +var + Node: TTreeNode; +begin + try + if Key = ' ' then + begin + Node := TreeViewChanges.Selected; + if Assigned(Node) then + begin + if Node.Level > 0 then + Node := Node.Parent; + ToggleNode(Node); + Key := #0; + end; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TFormUsesConfirm.TreeViewChangesMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + Node: TTreeNode; +begin + try + with TreeViewChanges do + if htOnIcon in GetHitTestInfoAt(X, Y) then + begin + Node := GetNodeAt(X, Y); + if Assigned(Node) then + ToggleNode(Node); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +// History: + +// $Log: JclUsesDialog.pas,v $ +// Revision 1.4 2005/12/16 23:46:25 outchy +// Added expert stack form. +// Added code to display call stack on expert exception. +// Fixed package extension for D2006. +// +// Revision 1.3 2005/10/26 03:29:44 rrossmair +// - improved header information, added $Date: 2005/12/16 23:46:25 $ and $Log: JclUsesDialog.pas,v $ +// - improved header information, added $Date$ and Revision 1.4 2005/12/16 23:46:25 outchy +// - improved header information, added $Date$ and Added expert stack form. +// - improved header information, added $Date$ and Added code to display call stack on expert exception. +// - improved header information, added $Date$ and Fixed package extension for D2006. +// - improved header information, added $Date$ and CVS tags. +// + +end. diff --git a/official/1.96/experts/useswizard/JclWideStrings.txt b/official/1.96/experts/useswizard/JclWideStrings.txt new file mode 100644 index 0000000..5fdfa06 --- /dev/null +++ b/official/1.96/experts/useswizard/JclWideStrings.txt @@ -0,0 +1,38 @@ +MoveWideChar +StrAllocW +StrCatW +StrCompW +StrCopyW +StrDisposeW +StrECopyW +StrEndW +StrIComp +StrLCatW +StrLCompW +StrLCopyW +StrLenW +StrLICompW +StrLICompW2 +StrMoveW +StrNewW +StrPCopyW +StrPLCopyW +StrPosW +StrRScanW +StrScanW +TrimLeftLengthW +TrimLeftW +TrimRightLengthW +TrimRightW +TrimW +TSearchFlag +TSearchFlags +TWideFileOptions +TWideFileOptionsType +TWStringItem +TWStringList +TWStrings +WideCharToChar +WideExtractQuotedStr +WidePos +WideQuotedStr diff --git a/official/1.96/experts/useswizard/JclWin32.txt b/official/1.96/experts/useswizard/JclWin32.txt new file mode 100644 index 0000000..10d4ab5 --- /dev/null +++ b/official/1.96/experts/useswizard/JclWin32.txt @@ -0,0 +1,102 @@ +BackupSeek +CheckSumMappedFile +DeleteVolumeMountPoint +EnumCalendarInfoExA +GetCalendarInfoA +GetCalendarInfoW +GetFileSecurity +GetFileSecurityA +GetFileSecurityW +GetImageUnusedHeaderBytes +GetVolumeNameForVolumeMountPoint +IMAGE_FIRST_SECTION +IMAGE_ORDINAL +IMAGE_ORDINAL32 +IMAGE_ORDINAL64 +IMAGE_SNAP_BY_ORDINAL +IMAGE_SNAP_BY_ORDINAL32 +IMAGE_SNAP_BY_ORDINAL64 +ImageDirectoryEntryToData +ImageRvaToSection +ImageRvaToVa +IsReparseTagHighLatency +IsReparseTagMicrosoft +IsReparseTagNameSurrogate +LANGIDFROMLCID +MAKELANGID +MAKELCID +MAKESORTLCID +MapAndLoad +NetApiBufferFree +Netbios +NetGroupAdd +NetGroupAddUser +NetGroupDel +NetGroupDelUser +NetGroupEnum +NetGroupGetInfo +NetGroupGetUsers +NetGroupSetInfo +NetGroupSetUsers +NetLocalGroupAdd +NetLocalGroupAddMember +NetLocalGroupAddMembers +NetLocalGroupDel +NetLocalGroupDelMember +NetLocalGroupDelMembers +NetLocalGroupEnum +NetLocalGroupGetInfo +NetLocalGroupGetMembers +NetLocalGroupSetInfo +NetLocalGroupSetMembers +NetUserAdd +NetUserChangePassword +NetUserDel +NetUserEnum +NetUserGetGroups +NetUserGetInfo +NetUserGetLocalGroups +NetUserModalsGet +NetUserModalsSet +NetUserSetGroups +NetUserSetInfo +PRIMARYLANGID +ReBaseImage +RtdlDeleteVolumeMountPoint +RtdlEnumCalendarInfoExA +RtdlGetCalendarInfoA +RtdlGetCalendarInfoW +RtdlGetVolumeNameForVolumeMountPoint +RtdlNetApiBufferFree +RtdlNetBios +RtdlNetGroupAdd +RtdlNetGroupDel +RtdlNetGroupEnum +RtdlNetLocalGroupAdd +RtdlNetLocalGroupAddMembers +RtdlNetLocalGroupDel +RtdlNetLocalGroupEnum +RtdlNetUserAdd +RtdlNetUserDel +RtdlSetNamedSecurityInfoW +RtdlSetVolumeMountPoint +RtdlSetWaitableTimer +SECURITY_CREATOR_SID_AUTHORITY +SECURITY_LOCAL_SID_AUTHORITY +SECURITY_NON_UNIQUE_AUTHORITY +SECURITY_NT_AUTHORITY +SECURITY_NULL_SID_AUTHORITY +SECURITY_RESOURCE_MANAGER_AUTHORITY +SECURITY_WORLD_SID_AUTHORITY +SetFileSecurity +SetFileSecurityA +SetFileSecurityW +SetNamedSecurityInfoW +SetVolumeMountPoint +SetWaitableTimer +SORTIDFROMLCID +SORTVERSIONFROMLCID +SUBLANGID +TouchFileTimes +UnDecorateSymbolName +UnMapAndLoad diff --git a/official/1.96/experts/useswizard/JclWinMIDI.txt b/official/1.96/experts/useswizard/JclWinMIDI.txt new file mode 100644 index 0000000..e5d58bc --- /dev/null +++ b/official/1.96/experts/useswizard/JclWinMIDI.txt @@ -0,0 +1,5 @@ +IJclWinMidiOut +MidiInCheck +MidiOut +MidiOutCheck +TStereoChannel diff --git a/official/1.96/experts/useswizard/JediUsesWizard.ini b/official/1.96/experts/useswizard/JediUsesWizard.ini new file mode 100644 index 0000000..8df4da4 --- /dev/null +++ b/official/1.96/experts/useswizard/JediUsesWizard.ini @@ -0,0 +1,53 @@ +[IdentifierLists] +Jcl8087=Jcl8087.txt +JclAppInst=JclAppInst.txt +JclBase=JclBase.txt +JclCIL=JclCIL.txt +JclCLR=JclCLR.txt +JclCOM=JclCOM.txt +JclComplex=JclComplex.txt +JclCompression=JclCompression.txt +JclConsole=JclConsole.txt +JclCounter=JclCounter.txt +JclDateTime=JclDateTime.txt +JclDebug=JclDebug.txt +JclExprEval=JclExprEval.txt +JclFileUtils=JclFileUtils.txt +JclGraphics=JclGraphics.txt +JclGraphUtils=JclGraphUtils.txt +JclHookExcept=JclHookExcept.txt +JclIniFiles=JclIniFiles.txt +JclLANMan=JclLANMan.txt +JclLocales=JclLocales.txt +JclLogic=JclLogic.txt +JclMapi=JclMapi.txt +JclMath=JclMath.txt +JclMetadata=JclMetadata.txt +JclMIDI=JclMIDI.txt +JclMime=JclMime.txt +JclMiscel=JclMiscel.txt +JclMultimedia=JclMultimedia.txt +JclNTFS=JclNTFS.txt +JclPeImage=JclPeImage.txt +JclPrint=JclPrint.txt +JclRegistry=JclRegistry.txt +JclResources=JclResources.txt +JclRTF=JclRTF.txt +JclRTTI=JclRTTI.txt +JclSchedule=JclSchedule.txt +JclSecurity=JclSecurity.txt +JclShell=JclShell.txt +JclStatistics=JclStatistics.txt +JclStrHashMap=JclStrHashMap.txt +JclStrings=JclStrings.txt +JclSvcCtrl=JclSvcCtrl.txt +JclSynch=JclSynch.txt +JclSysInfo=JclSysInfo.txt +JclSysUtils=JclSysUtils.txt +JclTD32=JclTD32.txt +JclUnicode=JclUnicode.txt +JclUnitConv=JclUnitConv.txt +JclUnitVersioning=JclUnitVersioning.txt +JclWideStrings=JclWideStrings.txt +JclWin32=JclWin32.txt +JclWinMIDI=JclWinMIDI.txt diff --git a/official/1.96/experts/useswizard/ReadMe.txt b/official/1.96/experts/useswizard/ReadMe.txt new file mode 100644 index 0000000..dfe7c6d --- /dev/null +++ b/official/1.96/experts/useswizard/ReadMe.txt @@ -0,0 +1,23 @@ +JEDI Uses Wizard + +This wizard watches for compiler error messages 'Undeclared identifier' (localized Delphi versions are also supported). +It keeps a static list of unit names and identifiers (stored in external text files) so it can automatically insert +appropriate unit(s) into the appropriate uses clause (with an optional confirmation prompt). +To resolve the error, a unit name may need to be added to interface uses, added to implementation uses, or moved from +implementation uses to interface uses (creating a new uses clause if needed). + +The wizard is not activated automatically after installation of this package. +To activate it, do the following: + +Install the package. +Go to Environment Options dialog. +On 'JEDI Options' tab, specify full path to the configuration file (e.g. C:\MyPath\JEDIUsesWizard.ini). +Check 'Active' checkbox. +You may want to check 'Prompt to confirm changes' checkbox, too. + +Preferences are stored in HKEY_CURRENT_USER\Software\Borland\Delphi\6.0\JCL registry key. + +Note that the JCL 1.20 identifier lists have been created manually and never tested. +The wizard code itself probably needs more testing, too. + +TOndrej (tondrej@t-online.de) diff --git a/official/1.96/experts/versioncontrol/JclVersionCtrlCVSImpl.pas b/official/1.96/experts/versioncontrol/JclVersionCtrlCVSImpl.pas new file mode 100644 index 0000000..bf39757 --- /dev/null +++ b/official/1.96/experts/versioncontrol/JclVersionCtrlCVSImpl.pas @@ -0,0 +1,378 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Florent Ouchet } +{ Last modified: $Date: 2006/01/25 20:32:29 $ } +{ Revision: $Revision: 1.2 $ } +{ } +{**************************************************************************************************} + +unit JclVersionCtrlCVSImpl; + +{$I jcl.inc} + +interface + +uses + SysUtils, Windows, Classes, Graphics, + VersionControlImpl; + +type + TJclVersionControlCVS = class (TJclVersionControlPlugin) + private + FTortoiseCVSAct: string; + protected + function GetSupportedActions: TJclVersionControlActions; override; + function GetFileActions(const FileName: string): TJclVersionControlActions; override; + function GetSandboxActions(const SdBxName: string): TJclVersionControlActions; override; + function GetIcon(const Action: TJclVersionControlAction): Integer; override; + function GetEnabled: Boolean; override; + function GetName: string; override; + public + constructor Create(const AExpert: TJclVersionControlExpert); override; + function GetSandboxNames(const FileName: string; SdBxNames: TStrings): Boolean; override; + function ExecuteAction(const FileName: string; + const Action: TJclVersionControlAction): Boolean; override; + end; + +implementation + +uses + JclFileUtils, JclRegistry, + JclOtaUtils, JclOtaResources, JclOtaConsts; + +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'; + +resourcestring + RsVersionCtrlCVSName = 'cvs'; + RsEEmptyFileName = 'Error: empty file name'; + RSENoTortoiseCVS = 'TortoiseCVS is not detected on the system'; + +//=== TJclVersionControlCVS ================================================== + +constructor TJclVersionControlCVS.Create(const AExpert: TJclVersionControlExpert); +begin + inherited Create(AExpert); + FTortoiseCVSAct := RegReadStringDef(HKLM, JclVersionCtrlCVSRegKeyName, + JclVersionCtrlCVSRegValueName, ''); + + if FTortoiseCVSAct <> '' then + FTortoiseCVSAct := PathAddSeparator(FTortoiseCVSAct) + JclVersionCtrlCVSTortoiseAct; +end; + +function TJclVersionControlCVS.ExecuteAction(const FileName: string; + const Action: TJclVersionControlAction): Boolean; + function CallTortoiseCVSAct(const ActionName: string): Boolean; + var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; + CurrentDir, CommandLine: string; + begin + FillChar(StartupInfo,SizeOf(TStartupInfo),#0); + FillChar(ProcessInfo,SizeOf(TProcessInformation),#0); + startupInfo.cb := SizeOf(TStartupInfo); + startupInfo.dwFlags := STARTF_USESHOWWINDOW; + startupInfo.wShowWindow := SW_SHOW; + + if FileName = '' then + raise EJclExpertException.CreateTrace(RsEEmptyFileName); + if not Enabled then + raise EJClExpertException.CreateTrace(RsENoTortoiseCVS); + + if FileName[Length(FileName)] = PathSeparator 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: string): TJclVersionControlActions; +var + CvsDirectory, EntriesFileName: string; + Entries: TStrings; + Index: Integer; + FileNameLine: string; + Added: Boolean; +begin + Result := inherited GetFileActions(FileName); + + CvsDirectory := PathAddSeparator(ExtractFilePath(FileName)) + JclVersionCtrlCVSDirectory; + FileNameLine := Format('/%s/', [ExtractFileName(AnsiUpperCaseFileName(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, AnsiUpperCase(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.GetSupportedActions: TJclVersionControlActions; +begin + Result := inherited GetSupportedActions; + 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.GetIcon( + const Action: TJclVersionControlAction): Integer; +var + LibraryName: string; +begin + LibraryName := PathAddSeparator(ExtractFilePath(FTortoiseCVSAct)) + JclVersionCtrlCVSTrtseShlDLL; + + case Action of + vcaAdd, + vcaAddSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 'IDI_ADD'); + vcaGraph, + vcaLog, + vcaLogSandbox, + vcaBlame: + Result := Expert.CacheResourceIcon(LibraryName, 'IDI_LOG'); + vcaBranch, + vcaBranchSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 'IDI_BRANCH'); + vcaCheckOutSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 'IDI_CHECKOUT'); + vcaCommit, + vcaCommitSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 'IDI_COMMIT'); + vcaDiff: + Result := Expert.CacheResourceIcon(LibraryName, 'IDI_COMPARE'); + vcaLock, + vcaLockSandbox, + vcaStatus, + vcaStatusSandbox, + vcaTag, + vcaTagSandBox: + Result := -1; + vcaUpdate, + vcaUpdateSandbox, + vcaUpdateTo, + vcaUpdateSandboxTo: + Result := Expert.CacheResourceIcon(LibraryName, 'IDI_UPDATE'); + vcaUnlock, + vcaUnlockSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 'IDI_REVERT'); + else + Result := inherited GetIcon(Action); + end; +end; + +function TJclVersionControlCVS.GetName: string; +begin + Result := RsVersionCtrlCVSName; +end; + +function TJclVersionControlCVS.GetSandboxActions( + const SdBxName: string): TJclVersionControlActions; +var + CvsDirectory: string; +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: string; + SdBxNames: TStrings): Boolean; +var + DirectoryName: string; + Index: Integer; +begin + Result := True; + + SdBxNames.BeginUpdate; + try + SdBxNames.Clear; + + if Enabled then + for Index := Length(FileName) downto 1 do + if FileName[Index] = PathSeparator 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 + +try + TJclVersionControlExpert.RegisterPluginClass(TJclVersionControlCVS); +except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; +end; + +finalization + +try + TJclVersionControlExpert.UnregisterPluginClass(TJclVersionControlCVS); +except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; +end; + +// History: + +// $Log: JclVersionCtrlCVSImpl.pas,v $ +// Revision 1.2 2006/01/25 20:32:29 outchy +// Fixed issue with invalid cvs subdirectory +// +// Revision 1.1 2006/01/15 00:51:22 outchy +// cvs support in version control expert +// version control expert integration in the installer +// + +end. diff --git a/official/1.96/experts/versioncontrol/JclVersionCtrlCommonOptions.dfm b/official/1.96/experts/versioncontrol/JclVersionCtrlCommonOptions.dfm new file mode 100644 index 0000000..7d0beb0 --- /dev/null +++ b/official/1.96/experts/versioncontrol/JclVersionCtrlCommonOptions.dfm @@ -0,0 +1,191 @@ +object JclVersionCtrlOptionsFrame: TJclVersionCtrlOptionsFrame + Left = 0 + Top = 0 + Width = 389 + Height = 409 + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 0 + TabStop = True + object LabelIcons: TLabel + Left = 16 + Top = 106 + Width = 39 + Height = 13 + Caption = 'RsIcons' + FocusControl = ComboBoxIcons + end + object LabelMenuOrganization: TLabel + Left = 16 + Top = 130 + Width = 99 + Height = 13 + Caption = 'RsMenuOrganization' + FocusControl = TreeViewMenu + end + object CheckBoxHideActions: TCheckBox + Left = 16 + Top = 31 + Width = 185 + Height = 17 + Caption = 'RsHideUnsupportedActions' + TabOrder = 0 + end + object ComboBoxIcons: TComboBox + Left = 72 + Top = 103 + Width = 145 + Height = 21 + Style = csDropDownList + ItemHeight = 13 + TabOrder = 1 + Items.Strings = ( + 'RsNoIcon' + 'RsJCLIcons' + 'RsAutoIcons') + end + object TreeViewMenu: TTreeView + Left = 16 + Top = 149 + Width = 260 + Height = 245 + Anchors = [akLeft, akTop, akRight, akBottom] + HideSelection = False + Indent = 19 + RightClickSelect = True + RowSelect = True + ShowRoot = False + TabOrder = 2 + OnEdited = TreeViewMenuEdited + OnEditing = TreeViewMenuEditing + end + object CheckBoxDisableActions: TCheckBox + Left = 16 + Top = 8 + Width = 201 + Height = 17 + Caption = 'RsDisableActions' + TabOrder = 3 + end + object ButtonNewSeparator: TButton + Left = 282 + Top = 180 + Width = 87 + Height = 25 + Action = ActionNewSeparator + Anchors = [akTop, akRight] + TabOrder = 4 + end + object ButtonDelete: TButton + Left = 282 + Top = 258 + Width = 87 + Height = 25 + Action = ActionDeleteItem + Anchors = [akTop, akRight] + TabOrder = 5 + end + object ButtonRename: TButton + Left = 282 + Top = 289 + Width = 87 + Height = 25 + Action = ActionRenameItem + Anchors = [akTop, akRight] + TabOrder = 6 + end + object ButtonMoveUp: TButton + Left = 282 + Top = 336 + Width = 87 + Height = 25 + Action = ActionMoveItemUp + Anchors = [akTop, akRight] + TabOrder = 7 + end + object ButtonMoveDown: TButton + Left = 282 + Top = 367 + Width = 87 + Height = 25 + Action = ActionMoveItemDown + Anchors = [akTop, akRight] + TabOrder = 8 + end + object CheckBoxSaveConfirmation: TCheckBox + Left = 16 + Top = 54 + Width = 201 + Height = 17 + Caption = 'RsSaveConfirmation' + TabOrder = 9 + end + object ButtonNewAction: TButton + Left = 282 + Top = 211 + Width = 87 + Height = 25 + Action = ActionNewAction + Anchors = [akTop, akRight] + TabOrder = 10 + end + object ButtonNewSubMenu: TButton + Left = 282 + Top = 149 + Width = 87 + Height = 25 + Action = ActionNewSubMenu + Anchors = [akTop, akRight] + TabOrder = 11 + end + object CheckBoxActOnTopSandbox: TCheckBox + Left = 16 + Top = 77 + Width = 201 + Height = 17 + Caption = 'RsActOnTopSandbox' + TabOrder = 12 + end + object ActionListVersionCtrl: TActionList + Left = 256 + Top = 64 + object ActionNewSubMenu: TAction + Caption = 'RsNewSubMenu' + OnExecute = ActionNewSubMenuExecute + OnUpdate = ActionNewSubMenuUpdate + end + object ActionNewSeparator: TAction + Caption = 'RsNewSeparator' + OnExecute = ActionNewSeparatorExecute + OnUpdate = ActionNewSeparatorUpdate + end + object ActionNewAction: TAction + Caption = 'RsNewAction' + OnExecute = ActionNewActionExecute + OnUpdate = ActionNewActionUpdate + end + object ActionDeleteItem: TAction + Caption = 'RsDeleteItem' + OnExecute = ActionDeleteItemExecute + OnUpdate = ActionDeleteItemUpdate + end + object ActionRenameItem: TAction + Caption = 'RsRenameItem' + OnExecute = ActionRenameItemExecute + OnUpdate = ActionRenameItemUpdate + end + object ActionMoveItemUp: TAction + Caption = 'RsMoveItemUp' + OnExecute = ActionMoveItemUpExecute + OnUpdate = ActionMoveItemUpUpdate + end + object ActionMoveItemDown: TAction + Caption = 'RsMoveItemDown' + OnExecute = ActionMoveItemDownExecute + OnUpdate = ActionMoveItemDownUpdate + end + end + object PopupMenuActions: TPopupMenu + Left = 296 + Top = 64 + end +end diff --git a/official/1.96/experts/versioncontrol/JclVersionCtrlCommonOptions.pas b/official/1.96/experts/versioncontrol/JclVersionCtrlCommonOptions.pas new file mode 100644 index 0000000..86a6a54 --- /dev/null +++ b/official/1.96/experts/versioncontrol/JclVersionCtrlCommonOptions.pas @@ -0,0 +1,576 @@ +{**************************************************************************************************} +{ } +{ 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 JclVersionCtrlCommonOptions.pas } +{ } +{ The Initial Developer of the Original Code is Florent Ouchet. } +{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. } +{ } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Florent Ouchet } +{ Last modified: $Date: 2006/01/15 20:58:03 $ } +{ Revision: $Revision: 1.2 $ } +{ } +{**************************************************************************************************} + +unit JclVersionCtrlCommonOptions; + +{$I jcl.inc} + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ComCtrls, ActnList, Menus; + +type + TJclVersionCtrlOptionsFrame = class(TFrame) + CheckBoxHideActions: TCheckBox; + LabelIcons: TLabel; + ComboBoxIcons: TComboBox; + TreeViewMenu: TTreeView; + LabelMenuOrganization: TLabel; + CheckBoxDisableActions: TCheckBox; + ButtonNewSeparator: TButton; + ButtonDelete: TButton; + ButtonRename: TButton; + ButtonMoveUp: TButton; + ButtonMoveDown: TButton; + ActionListVersionCtrl: TActionList; + ActionNewSeparator: TAction; + ActionDeleteItem: TAction; + ActionRenameItem: TAction; + ActionMoveItemUp: TAction; + ActionMoveItemDown: TAction; + CheckBoxSaveConfirmation: TCheckBox; + PopupMenuActions: TPopupMenu; + ActionNewAction: TAction; + ButtonNewAction: TButton; + ActionNewSubMenu: TAction; + ButtonNewSubMenu: TButton; + CheckBoxActOnTopSandbox: TCheckBox; + procedure ActionActOnTopSandboxUpdate(Sender: TObject); + procedure ActionNewActionExecute(Sender: TObject); + procedure ActionNewActionUpdate(Sender: TObject); + procedure ActionRenameItemExecute(Sender: TObject); + procedure ActionNewSubMenuExecute(Sender: TObject); + procedure ActionNewSubMenuUpdate(Sender: TObject); + procedure ActionNewSeparatorExecute(Sender: TObject); + procedure ActionMoveItemUpExecute(Sender: TObject); + procedure ActionMoveItemDownExecute(Sender: TObject); + procedure ActionDeleteItemExecute(Sender: TObject); + procedure ActionSaveConfirmationUpdate(Sender: TObject); + procedure ActionRenameItemUpdate(Sender: TObject); + procedure ActionNewSeparatorUpdate(Sender: TObject); + procedure ActionMoveItemUpUpdate(Sender: TObject); + procedure ActionMoveItemDownUpdate(Sender: TObject); + procedure ActionHideUnSupportedActionsUpdate(Sender: TObject); + procedure ActionDisableActionsUpdate(Sender: TObject); + procedure ActionDeleteItemUpdate(Sender: TObject); + procedure TreeViewMenuEditing(Sender: TObject; Node: TTreeNode; + var AllowEdit: Boolean); + procedure TreeViewMenuEdited(Sender: TObject; Node: TTreeNode; var S: string); + private + FMenuTree: TStrings; + function GetActOnTopSandbox: Boolean; + procedure SetActOnTopSandbox(const Value: Boolean); + function GetSaveConfirmation: Boolean; + procedure SetSaveConfirmation(const Value: Boolean); + function GetDisableActions: Boolean; + function GetHideActions: Boolean; + function GetIconType: Integer; + function GetMenuTree: TStrings; + procedure SetDisableActions(const Value: Boolean); + procedure SetHideActions(const Value: Boolean); + procedure SetIconType(const Value: Integer); + procedure SetMenuTree(const Value: TStrings); + procedure MenuItemNewActionClick(Sender: TObject); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetIconTypeNames(const Names: TStrings); + procedure SetActions(const Actions: array of TCustomAction); + property ActOnTopSandbox: Boolean read GetActOnTopSandbox write SetActOnTopSandbox; + property DisableActions: Boolean read GetDisableActions write SetDisableActions; + property HideActions: Boolean read GetHideActions write SetHideActions; + property IconType: Integer read GetIconType write SetIconType; + property MenuTree: TStrings read GetMenuTree write SetMenuTree; + property SaveConfirmation: Boolean read GetSaveConfirmation write SetSaveConfirmation; + end; + +implementation + +{$R *.dfm} + +uses + TypInfo, ToolsAPI, + JclStrings, + JclOtaUtils, JclOtaResources, VersionControlImpl; + +resourcestring + RsEInvalidMenuCaption = 'Menu caption cannot contain \, _ and numbers'; + RsDisableActions = '&Enable/disable actions'; + RsHideUnsupportedActions = '&Hide unsupported actions'; + RsSaveConfirmation = '&Save confirmation'; + RsActOnTopSandBox = '&Act on top sandbox'; + RsIcons = '&Icons:'; + RsNewItem = 'New item'; + RsNewSeparator = 'New &separator'; + RsNewSubMenu = 'New s&ub menu'; + RsNewAction = 'New &action'; + RsDeleteItem = '&Delete'; + RsRenameItem = '&Rename'; + RsMoveItemUp = 'Move &up'; + RsMoveItemDown = 'Move &down'; + RsMenuOrganization = 'Menu &organization:'; + RsNoIcon = 'No icon'; + RsJCLIcons = 'JCL icons'; + RsAutoIcons = 'Automatic'; + +//=== TJclVersionCtrlOptionsFrame ============================================ + +procedure TJclVersionCtrlOptionsFrame.ActionActOnTopSandboxUpdate( + Sender: TObject); +begin + TAction(Sender).Enabled := True; +end; + +procedure TJclVersionCtrlOptionsFrame.ActionDeleteItemExecute(Sender: TObject); +var + ATreeNode: TTreeNode; +begin + ATreeNode := TreeViewMenu.Selected; + if Assigned(ATreeNode) then + ATreeNode.Delete; +end; + +procedure TJclVersionCtrlOptionsFrame.ActionDeleteItemUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(TreeViewMenu.Selected); +end; + +procedure TJclVersionCtrlOptionsFrame.ActionDisableActionsUpdate( + Sender: TObject); +begin + TAction(Sender).Enabled := True; +end; + +procedure TJclVersionCtrlOptionsFrame.ActionHideUnSupportedActionsUpdate( + Sender: TObject); +begin + TAction(Sender).Enabled := True; +end; + +procedure TJclVersionCtrlOptionsFrame.ActionMoveItemDownExecute( + Sender: TObject); +var + ATreeNode, BTreeNode: TTreeNode; +begin + ATreeNode := TreeViewMenu.Selected; + BTreeNode := ATreeNode.getNextSibling; + if Assigned(BTreeNode) then + BTreeNode.MoveTo(ATreeNode, naInsert); +end; + +procedure TJclVersionCtrlOptionsFrame.ActionMoveItemDownUpdate(Sender: TObject); +var + ATreeNode: TTreeNode; +begin + ATreeNode := TreeViewMenu.Selected; + if Assigned(ATreeNode) then + ATreeNode := ATreeNode.getNextSibling; + TAction(Sender).Enabled := Assigned(ATreeNode); +end; + +procedure TJclVersionCtrlOptionsFrame.ActionMoveItemUpExecute(Sender: TObject); +var + ATreeNode, BTreeNode: TTreeNode; +begin + ATreeNode := TreeViewMenu.Selected; + BTreeNode := ATreeNode.getPrevSibling; + ATreeNode.MoveTo(BTreeNode, naInsert); +end; + +procedure TJclVersionCtrlOptionsFrame.ActionMoveItemUpUpdate(Sender: TObject); +var + ATreeNode: TTreeNode; +begin + ATreeNode := TreeViewMenu.Selected; + if Assigned(ATreeNode) then + ATreeNode := ATreeNode.getPrevSibling; + TAction(Sender).Enabled := Assigned(ATreeNode); +end; + +procedure TJclVersionCtrlOptionsFrame.ActionNewActionExecute(Sender: TObject); +var + APoint: TPoint; +begin + APoint.X := 0; + APoint.Y := ButtonNewAction.Height; + APoint := ButtonNewAction.ClientToScreen(APoint); + PopupMenuActions.Popup(APoint.X, APoint.Y); +end; + +procedure TJclVersionCtrlOptionsFrame.ActionNewActionUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := True; +end; + +procedure TJclVersionCtrlOptionsFrame.ActionNewSubMenuExecute( + Sender: TObject); +var + ATreeNode, NewTreeNode: TTreeNode; +begin + ATreeNode := TreeViewMenu.Selected; + + if Assigned(ATreeNode) and Assigned(ATreeNode.Parent) then + ATreeNode := ATreeNode.Parent; + + if Assigned(ATreeNode) and (ATreeNode.getNextSibling <> nil) then + NewTreeNode := TreeViewMenu.Items.Insert(ATreeNode.getNextSibling, RsNewItem) + else + NewTreeNode := TreeViewMenu.Items.Add(ATreeNode, RsNewItem); + + NewTreeNode.ImageIndex := -1; + NewTreeNode.SelectedIndex := -1; + NewTreeNode.Data := nil; + + NewTreeNode.EditText; +end; + +procedure TJclVersionCtrlOptionsFrame.ActionNewSubMenuUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := True; +end; + +procedure TJclVersionCtrlOptionsFrame.ActionNewSeparatorExecute(Sender: TObject); +var + ATreeNode, NewTreeNode: TTreeNode; +begin + ATreeNode := TreeViewMenu.Selected; + + if Assigned(ATreeNode) and (ATreeNode.getNextSibling <> nil) then + NewTreeNode := TreeViewMenu.Items.Insert(ATreeNode.getNextSibling, '-') + else + NewTreeNode := TreeViewMenu.Items.Add(ATreeNode, '-'); + + NewTreeNode.ImageIndex := -1; + NewTreeNode.SelectedIndex := -1; + NewTreeNode.Data := nil; +end; + +procedure TJclVersionCtrlOptionsFrame.ActionNewSeparatorUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(TreeViewMenu.Selected); +end; + +procedure TJclVersionCtrlOptionsFrame.ActionRenameItemExecute(Sender: TObject); +var + ATreeNode: TTreeNode; +begin + ATreeNode := TreeViewMenu.Selected; + if Assigned(ATreeNode) then + ATreeNode.EditText; +end; + +procedure TJclVersionCtrlOptionsFrame.ActionRenameItemUpdate(Sender: TObject); +var + ATreeNode: TTreeNode; +begin + ATreeNode := TreeViewMenu.Selected; + TAction(Sender).Enabled := Assigned(ATreeNode) and (ATreeNode.Text <> '-') + and not Assigned(ATreeNode.Data); +end; + +procedure TJclVersionCtrlOptionsFrame.ActionSaveConfirmationUpdate( + Sender: TObject); +begin + TAction(Sender).Enabled := True; +end; + +constructor TJclVersionCtrlOptionsFrame.Create(AOwner: TComponent); +var + NTAServices: INTAServices; +begin + inherited Create(AOwner); + FMenuTree := TStringList.Create; + + Supports(BorlandIDEServices, INTAServices, NTAServices); + if not Assigned(NTAServices) then + raise EJclExpertException.CreateTrace(RsENoNTAServices); + + TreeViewMenu.Images := NTAServices.ImageList; + PopupMenuActions.Images := NTAServices.ImageList; + + CheckBoxActOnTopSandbox.Caption := RsActOnTopSandBox; + CheckBoxDisableActions.Caption := RsDisableActions; + CheckBoxHideActions.Caption := RsHideUnsupportedActions; + CheckBoxSaveConfirmation.Caption := RsSaveConfirmation; + ActionNewSubMenu.Caption := RsNewSubMenu; + ActionNewSeparator.Caption := RsNewSeparator; + ActionNewAction.Caption := RsNewAction; + ActionDeleteItem.Caption := RsDeleteItem; + ActionRenameItem.Caption := RsRenameItem; + ActionMoveItemUp.Caption := RsMoveItemUp; + ActionMoveItemDown.Caption := RsMoveItemDown; + LabelIcons.Caption := RsIcons; + LabelMenuOrganization.Caption := RsMenuOrganization; + ComboBoxIcons.Items.Strings[0] := RsNoIcon; + ComboBoxIcons.Items.Strings[1] := RsJCLIcons; + ComboBoxIcons.Items.Strings[2] := RsAutoIcons; +end; + +destructor TJclVersionCtrlOptionsFrame.Destroy; +begin + FMenuTree.Free; + inherited Destroy; +end; + +function TJclVersionCtrlOptionsFrame.GetActOnTopSandbox: Boolean; +begin + Result := CheckBoxActOnTopSandbox.Checked; +end; + +function TJclVersionCtrlOptionsFrame.GetDisableActions: Boolean; +begin + Result := CheckBoxDisableActions.Checked; +end; + +function TJclVersionCtrlOptionsFrame.GetHideActions: Boolean; +begin + Result := CheckBoxHideActions.Checked; +end; + +function TJclVersionCtrlOptionsFrame.GetIconType: Integer; +begin + Result := ComboBoxIcons.ItemIndex - 3; +end; + +function TJclVersionCtrlOptionsFrame.GetMenuTree: TStrings; +var + ATreeNode, BTreeNode: TTreeNode; + ItemName: string; + AAction: TCustomAction; + Index: Integer; +begin + FMenuTree.Clear; + ATreeNode := TreeViewMenu.Items.GetFirstNode; + while Assigned(ATreeNode) do + begin + AAction := TCustomAction(ATreeNode.Data); + ItemName := ''; + if Assigned(AAction) then + for Index := 0 to PopupMenuActions.Items.Count - 1 do + if TCustomAction(PopupMenuActions.Items.Items[Index].Tag) = AAction then + ItemName := GetEnumName(TypeInfo(TJclVersionControlAction), Index); + + if ItemName = '' then + ItemName := ATreeNode.Text; + + FMenuTree.Add(Format('%d%s', [ATreeNode.Index, ItemName])); + + BTreeNode := ATreeNode.getFirstChild; + while Assigned(BTreeNode) do + begin + AAction := TCustomAction(BTreeNode.Data); + ItemName := ''; + if Assigned(AAction) then + for Index := 0 to PopupMenuActions.Items.Count - 1 do + if TCustomAction(PopupMenuActions.Items.Items[Index].Tag) = AAction then + ItemName := GetEnumName(TypeInfo(TJclVersionControlAction), Index); + + if ItemName = '' then + ItemName := BTreeNode.Text; + + FMenuTree.Add(Format('%d%s%d', [ATreeNode.Index, ItemName, BTreeNode.Index])); + + BTreeNode := BTreeNode.getNextSibling; + end; + ATreeNode := ATreeNode.getNextSibling; + end; + Result := FMenuTree; +end; + +function TJclVersionCtrlOptionsFrame.GetSaveConfirmation: Boolean; +begin + Result := CheckBoxSaveConfirmation.Checked; +end; + +procedure TJclVersionCtrlOptionsFrame.MenuItemNewActionClick(Sender: TObject); +var + AAction: TCustomAction; + ATreeNode, NewTreeNode: TTreeNode; +begin + AAction := TCustomAction((Sender as TMenuItem).Tag); + + ATreeNode := TreeViewMenu.Selected; + if Assigned(ATreeNode.Data) or (ATreeNode.Text = '-') then + begin + if Assigned(ATreeNode) and (ATreeNode.getNextSibling <> nil) then + NewTreeNode := TreeViewMenu.Items.Insert(ATreeNode.getNextSibling, AAction.Caption) + else + NewTreeNode := TreeViewMenu.Items.Add(ATreeNode, AAction.Caption); + end + else + begin + NewTreeNode := TreeViewMenu.Items.AddChildFirst(ATreeNode, AAction.Caption); + ATreeNode.Expand(False); + end; + + NewTreeNode.Data := AAction; + NewTreeNode.ImageIndex := AAction.ImageIndex; + NewTreeNode.SelectedIndex := AAction.ImageIndex; +end; + +procedure TJclVersionCtrlOptionsFrame.SetActions( + const Actions: array of TCustomAction); +var + Index: Integer; + AMenuItem: TMenuItem; +begin + for Index := Low(Actions) to High(Actions) do + begin + AMenuItem := TMenuItem.Create(Self); + AMenuItem.Tag := Integer(Actions[Index]); + AMenuItem.Caption := Actions[Index].Caption; + AMenuItem.ImageIndex := Actions[Index].ImageIndex; + AMenuItem.OnClick := MenuItemNewActionClick; + PopupMenuActions.Items.Add(AMenuItem); + end; +end; + +procedure TJclVersionCtrlOptionsFrame.SetActOnTopSandbox(const Value: Boolean); +begin + CheckBoxActOnTopSandbox.Checked := Value; +end; + +procedure TJclVersionCtrlOptionsFrame.SetDisableActions(const Value: Boolean); +begin + CheckBoxDisableActions.Checked := Value; +end; + +procedure TJclVersionCtrlOptionsFrame.SetHideActions(const Value: Boolean); +begin + CheckBoxHideActions.Checked := Value; +end; + +procedure TJclVersionCtrlOptionsFrame.SetIconType(const Value: Integer); +begin + ComboBoxIcons.ItemIndex := Value + 3; +end; + +procedure TJclVersionCtrlOptionsFrame.SetIconTypeNames(const Names: TStrings); +var + Index: Integer; +begin + for Index := ComboBoxIcons.Items.Count - 1 downto 3 do + ComboBoxIcons.Items.Delete(Index); + ComboBoxIcons.Items.AddStrings(Names); +end; + +procedure TJclVersionCtrlOptionsFrame.SetMenuTree(const Value: TStrings); +var + ATreeNode, BTreeNode: TTreeNode; + Index, IndexB: Integer; + Item, ItemName: string; + AAction: Integer; + ControlAction: TCustomAction; +begin + TreeViewMenu.Items.Clear; + ATreeNode := nil; + for Index := 0 to Value.Count - 1 do + begin + Item := Value.Strings[Index]; + IndexB := GetItemIndexB(Item); + ItemName := GetItemName(Item); + AAction := GetEnumValue(TypeInfo(TJclVersionControlAction), ItemName); + + if IndexB = -1 then + begin + if (AAction = -1) or (ItemName = '-') then + begin + ATreeNode := TreeViewMenu.Items.Add(nil, ItemName); + ATreeNode.ImageIndex := -1; + ATreeNode.SelectedIndex := -1; + ATreeNode.Data := nil; + end + else + begin + ControlAction := TCustomAction(PopupMenuActions.Items.Items[AAction].Tag); + ATreeNode := TreeViewMenu.Items.Add(nil, StrRemoveChars(ControlAction.Caption, ['&'])); + ATreeNode.Data := ControlAction; + ATreeNode.ImageIndex := ControlAction.ImageIndex; + ATreeNode.SelectedIndex := ControlAction.ImageIndex; + ATreeNode := nil; + end; + end + else + begin + if not Assigned(ATreeNode) then + Abort; + + if (AAction = -1) or (ItemName = '-') then + begin + BTreeNode := TreeViewMenu.Items.AddChild(ATreeNode, ItemName); + BTreeNode.ImageIndex := -1; + BTreeNode.SelectedIndex := -1; + BTreeNode.Data := nil; + end + else + begin + ControlAction := TCustomAction(PopupMenuActions.Items.Items[AAction].Tag); + BTreeNode := TreeViewMenu.Items.AddChild(ATreeNode, StrRemoveChars(ControlAction.Caption, ['&'])); + BTreeNode.ImageIndex := ControlAction.ImageIndex; + BTreeNode.SelectedIndex := ControlAction.ImageIndex; + BTreeNode.Data := ControlAction; + end; + ATreeNode.Expand(False); + end; + end; +end; + +procedure TJclVersionCtrlOptionsFrame.SetSaveConfirmation(const Value: Boolean); +begin + CheckBoxSaveConfirmation.Checked := Value; +end; + +procedure TJclVersionCtrlOptionsFrame.TreeViewMenuEdited(Sender: TObject; + Node: TTreeNode; var S: string); +begin + if StrContainsChars(S, ['\', '_', '0'..'9'], True) then + begin + S := Node.Text; + MessageDlg(RsEInvalidMenuCaption, mtError, [mbAbort], 0); + end; +end; + +procedure TJclVersionCtrlOptionsFrame.TreeViewMenuEditing(Sender: TObject; + Node: TTreeNode; var AllowEdit: Boolean); +begin + AllowEdit := Assigned(Node) and (Node.Text <> '-') and not Assigned(Node.Data); +end; + +// History: + +// $Log: JclVersionCtrlCommonOptions.pas,v $ +// Revision 1.2 2006/01/15 20:58:03 outchy +// Delphi 5 support: no TCustomAction.AutoCheck property +// Removed unused resources +// +// Revision 1.1 2006/01/15 00:51:22 outchy +// cvs support in version control expert +// version control expert integration in the installer +// + +end. diff --git a/official/1.96/experts/versioncontrol/JclVersionCtrlSVNImpl.pas b/official/1.96/experts/versioncontrol/JclVersionCtrlSVNImpl.pas new file mode 100644 index 0000000..e78f0c4 --- /dev/null +++ b/official/1.96/experts/versioncontrol/JclVersionCtrlSVNImpl.pas @@ -0,0 +1,424 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Florent Ouchet } +{ Last modified: $Date: 2006/01/26 06:15:17 $ } +{ Revision: $Revision: 1.3 $ } +{ } +{**************************************************************************************************} + +unit JclVersionCtrlSVNImpl; + +{$I jcl.inc} + +interface + +uses + SysUtils, Classes, Windows, Graphics, + VersionControlImpl; + +type + TJclVersionControlSVN = class (TJclVersionControlPlugin) + private + FTortoiseSVNProc: string; + protected + function GetSupportedActions: TJclVersionControlActions; override; + function GetFileActions(const FileName: string): TJclVersionControlActions; override; + function GetSandboxActions(const SdBxName: string): TJclVersionControlActions; override; + function GetIcon(const Action: TJclVersionControlAction): Integer; override; + function GetEnabled: Boolean; override; + function GetName: string; override; + public + constructor Create(const AExpert: TJclVersionControlExpert); override; + destructor Destroy; override; + function GetSandboxNames(const FileName: string; SdBxNames: TStrings): Boolean; override; + function ExecuteAction(const FileName: string; + const Action: TJclVersionControlAction): Boolean; override; + end; + +implementation + +uses + JclFileUtils, JclRegistry, + JclOtaUtils, JclOtaResources, JclOtaConsts; + +const + JclVersionCtrlRegKeyName = 'SOFTWARE\TortoiseSVN'; + JclVersionCtrlRegValueName = 'ProcPath'; + 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'; + + JclVersionCtrlSVNDirectories: array [0..1] of string = + ( JclVersionCtrlSVNDirectory1, JclVersionCtrlSVNDirectory2 ); + +resourcestring + RsVersionCtrlSVNName = 'subversion'; + RsEEmptyFileName = 'Error: empty file name'; + RSENoTortoiseSVN = 'TortoiseSVN is not detected on the system'; + +//=== TJclVersionControlSVN ================================================== + +constructor TJclVersionControlSVN.Create(const AExpert: TJclVersionControlExpert); +begin + inherited Create(AExpert); + FTortoiseSVNProc := RegReadStringDef(HKLM, JclVersionCtrlRegKeyName, JclVersionCtrlRegValueName, ''); +end; + +destructor TJclVersionControlSVN.Destroy; +begin + inherited Destroy; +end; + +function TJclVersionControlSVN.ExecuteAction(const FileName: string; + const Action: TJclVersionControlAction): Boolean; + function CallTortoiseSVNProc(const ActionName: string; + const Param: string = ''): Boolean; + var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; + CurrentDir, CommandLine: string; + begin + FillChar(StartupInfo,SizeOf(TStartupInfo),#0); + FillChar(ProcessInfo,SizeOf(TProcessInformation),#0); + startupInfo.cb := SizeOf(TStartupInfo); + startupInfo.dwFlags := STARTF_USESHOWWINDOW; + startupInfo.wShowWindow := SW_SHOW; + + if FileName = '' then + raise EJclExpertException.CreateTrace(RsEEmptyFileName); + if not Enabled then + raise EJClExpertException.CreateTrace(RsENoTortoiseSVN); + + if FileName[Length(FileName)] = PathSeparator 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: string): TJclVersionControlActions; +var + EntryFile: string; + Entries: TStrings; + IndexDir, IndexEntry: Integer; + FileNameValue: string; +begin + Result := inherited GetFileActions(FileName); + + if Enabled then + begin + Entries := TStringList.Create; + try + FileNameValue := Format('NAME="%s"', [ExtractFileName(AnsiUpperCaseFileName(FileName))]); + + for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do + begin + EntryFile := PathAddSeparator(ExtractFilePath(FileName)) + + JclVersionCtrlSVNDirectories[IndexDir] + JclVersionCtrlSVNEntryFile; + + if FileExists(EntryFile) then + begin + Entries.LoadFromFile(EntryFile); + + for IndexEntry := 0 to Entries.Count - 1 do + if Pos(FileNameValue, AnsiUpperCase(Entries.Strings[IndexEntry])) > 0 then + begin + // TODO: check modifications + Result := Result + [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; + Result := Result + [vcaAdd]; + end; +end; + +function TJclVersionControlSVN.GetSupportedActions: TJclVersionControlActions; +begin + Result := inherited GetSupportedActions; + 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.GetIcon( + const Action: TJclVersionControlAction): Integer; +var + LibraryName: string; +begin + LibraryName := PathAddSeparator(ExtractFilePath(FTortoiseSVNProc)) + JclVersionCtrlSVNTortoiseDLL; + + case Action of + vcaAdd, + vcaAddSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 124); + vcaBlame: + Result := Expert.CacheResourceIcon(LibraryName, 5146); + vcaBranch, + vcaBranchSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 132); + vcaCheckOutSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 121); + vcaCommit, + vcaCommitSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 123); + vcaDiff: + Result := Expert.CacheResourceIcon(LibraryName, 135); + vcaGraph: + Result := Expert.CacheResourceIcon(LibraryName, 5151); + vcaLog, + vcaLogSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 136); + vcaLock, + vcaLockSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 5152); + vcaMerge, + vcaMergeSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 129); + vcaRename: + Result := Expert.CacheResourceIcon(LibraryName, 134); + vcaRepoBrowser: + Result := Expert.CacheResourceIcon(LibraryName, 5145); + vcaRevert, + vcaRevertSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 125); + vcaStatus, + vcaStatusSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 143); + vcaTag, + vcaTagSandBox: + Result := Expert.CacheResourceIcon(LibraryName, 132); + vcaUpdate, + vcaUpdateSandbox, + vcaUpdateTo, + vcaUpdateSandboxTo: + Result := Expert.CacheResourceIcon(LibraryName, 122); + vcaUnlock, + vcaUnlockSandbox: + Result := Expert.CacheResourceIcon(LibraryName, 5153); + else + Result := inherited GetIcon(Action); + end; + +end; + +function TJclVersionControlSVN.GetName: string; +begin + Result := RsVersionCtrlSVNName; +end; + +function TJclVersionControlSVN.GetSandboxActions( + const SdBxName: string): TJclVersionControlActions; +var + SvnDirectory: string; + IndexDir: Integer; +begin + Result := inherited GetSandboxActions(SdBxName); + + if Enabled then + begin + for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do + begin + SvnDirectory := sdBxName + JclVersionCtrlSVNDirectories[IndexDir]; + + if DirectoryExists(SvnDirectory) then + begin + Result := Result + [vcaAddSandbox, vcaBranchSandbox, vcaCommitSandbox, + vcaLogSandbox, vcaLockSandbox, vcaMergeSandbox, vcaRevertSandbox, + vcaStatusSandbox, vcaTagSandBox, vcaUpdateSandbox, vcaUpdateSandboxTo, + vcaUnlockSandbox]; + Exit; + end; + end; + // not in a sandbox + Result := Result + [vcaCheckOutSandbox]; + end; +end; + +function TJclVersionControlSVN.GetSandboxNames(const FileName: string; + SdBxNames: TStrings): Boolean; +var + DirectoryName: string; + IndexDir, IndexFileName: Integer; +begin + Result := True; + + SdBxNames.BeginUpdate; + try + SdBxNames.Clear; + + if Enabled then + for IndexFileName := Length(FileName) downto 1 do + if FileName[IndexFileName] = PathSeparator then + begin + for IndexDir := Low(JclVersionCtrlSVNDirectories) to High(JclVersionCtrlSVNDirectories) do + begin + DirectoryName := Copy(FileName, 1, IndexFileName) + JclVersionCtrlSVNDirectories[IndexDir]; + if DirectoryExists(DirectoryName) then + SdBxNames.Add(DirectoryName); + end; + end; + finally + SdBxNames.EndUpdate; + end; + + if SdBxNames.Count = 0 then + Result := inherited GetSandboxNames(FileName, SdBxNames); +end; + +initialization + +try + TJclVersionControlExpert.RegisterPluginClass(TJclVersionControlSVN); +except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; +end; + +finalization + +try + TJclVersionControlExpert.UnregisterPluginClass(TJclVersionControlSVN); +except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; +end; + +// History: + +// $Log: JclVersionCtrlSVNImpl.pas,v $ +// Revision 1.3 2006/01/26 06:15:17 outchy +// Repository browser now works +// +// Revision 1.2 2006/01/25 20:33:27 outchy +// Added _svn as a valid subdirectory +// +// Revision 1.1 2006/01/15 00:51:22 outchy +// cvs support in version control expert +// version control expert integration in the installer +// + +end. diff --git a/official/1.96/experts/versioncontrol/VersionControlImpl.pas b/official/1.96/experts/versioncontrol/VersionControlImpl.pas new file mode 100644 index 0000000..4a08bf3 --- /dev/null +++ b/official/1.96/experts/versioncontrol/VersionControlImpl.pas @@ -0,0 +1,2166 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Elahn Ientile } +{ Last modified: $Date: 2006/02/02 08:06:36 $ } +{ Revision: $Revision: 1.8 $ } +{ } +{**************************************************************************************************} + +unit VersionControlImpl; + +{$I jcl.inc} + +interface + +uses + SysUtils, Classes, Graphics, Controls, Menus, ActnList, Dialogs, + ToolsAPI, +{$IFNDEF COMPILER8_UP} + Idemenuaction, // dependency walker reports a class TPopupAction in + // unit Idemenuaction in designide.bpl used by the IDE to display tool buttons + // with a drop down menu, this class seems to have the same interface + // as TControlAction defined in Controls.pas for newer versions of Delphi +{$ENDIF COMPILER8_UP} + JclOtaUtils, JclVersionCtrlCommonOptions; + +type + TJclVersionControlAction = ( + 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 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 + ); + + TJclVersionControlActions = set of TJclVersionControlAction; + + TJclVersionControlExpert = class; + + TJclVersionControlPlugin = class + private + FExpert: TJclVersionControlExpert; + protected + // get supported actions by the plugin + function GetSupportedActions: TJclVersionControlActions; virtual; + // get actions for the current file + function GetFileActions(const FileName: string): TJclVersionControlActions; virtual; + // get actions for the current sandbox (sandbox can be not yet initialized) + function GetSandboxActions(const SdBxName: string): TJclVersionControlActions; virtual; + // get icon for the action + function GetIcon(const Action: TJclVersionControlAction): Integer; 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(const AExpert: TJclVersionControlExpert); reintroduce; virtual; + // 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: string; SdBxNames: TStrings): Boolean; virtual; + // execute the action of a file or on a sandbox + function ExecuteAction(const FileName: string; + const Action: TJclVersionControlAction): Boolean; virtual; + property SupportActions: TJclVersionControlActions read GetSupportedActions; + property FileActions[const FileName: string]: TJclVersionControlActions read GetFileActions; + property SandboxActions[const SdBxName: string]: TJclVersionControlActions read GetSandboxActions; + property Icons[const Action: TJclVersionControlAction]: Integer read GetIcon; + property Enabled: Boolean read GetEnabled; + property Expert: TJclVersionControlExpert read FExpert; + property Name: string read GetName; + end; + + TJclVersionControlPluginClass = class of TJclVersionControlPlugin; + + TJclVersionControlCache = class (TObject) + private + FSandboxList: TList; + FFileName: string; + FPlugin: TJclVersionControlPlugin; + FActions: TJclVersionControlActions; + FValidityTime: TDateTime; + FSupported: Boolean; + function GetSandBox(Index: Integer): string; + function GetSandboxAction(Index: Integer): TJclVersionControlActions; + function GetSandboxCount: Integer; + public + constructor Create(APlugin: TJclVersionControlPlugin; AFileName: string); + destructor Destroy; override; + function GetValid(const ATime: TDateTime): Boolean; + property Plugin: TJclVersionControlPlugin read FPlugin; + property FileName: string read FFileName; + property Actions: TJclVersionControlActions read FActions; + property SandBoxes[Index: Integer]: string read GetSandBox; + property SandBoxActions[Index: Integer]: TJclVersionControlActions read GetSandboxAction; + property SandBoxCount: Integer read GetSandboxCount; + property Supported: Boolean read FSupported; + end; + + TJclVersionControlExpert = class (TJclOTAExpert) + private + FVersionCtrlMenu: TMenuItem; + FActions: array [TJclVersionControlAction] of TCustomAction; + FPluginList: TList; + FIconCache: TList; + FFileCache: TList; + FLastPlugin: TJclVersionControlPlugin; + FModuleServices: IOTAModuleServices; + FHideActions: Boolean; + FIconType: Integer; + FActOnTopSandbox: Boolean; + FSaveConfirmation: Boolean; + FDisableActions: Boolean; + FOptionsFrame: TJclVersionCtrlOptionsFrame; + FMenuOrganization: TStringList; + procedure RefreshIcon(const AAction: TCustomAction); + function GetPlugin(Index: Integer): TJclVersionControlPlugin; + function GetPluginCount: Integer; + procedure SetIconType(const Value: Integer); + + procedure ActionUpdate(Sender: TObject); + procedure ActionExecute(Sender: TObject); + procedure IDEActionMenuClick(Sender: TObject); + procedure SubItemClick(Sender: TObject); + procedure DropDownMenuPopup(Sender: TObject); + procedure IDEVersionCtrlMenuClick(Sender: TObject); + procedure RefreshIcons; + procedure RefreshMenu; + procedure CleanSubMenus(const AMenuItem: TMenuItem); + function GetCurrentCache: TJclVersionControlCache; + function GetCurrentPlugin: TJclVersionControlPlugin; + function GetCurrentFileName: string; + public + constructor Create; reintroduce; + destructor Destroy; override; + procedure RegisterCommands; override; + procedure UnregisterCommands; override; + procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override; + procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override; + function CacheResourceIcon(const ResourceFile: string; const ResourceID: Integer): Integer; overload; + function CacheResourceIcon(const ResourceFile: string; const ResourceName: string): Integer; overload; + function SaveModules(const FileName: string; + const IncludeSubDirectories: Boolean): Boolean; + function GetFileCache(const FileName: string; const Plugin: TJclVersionControlPlugin): TJclVersionControlCache; + + property ModuleServices: IOTAModuleServices read FModuleServices; + property ActOnTopSandbox: Boolean read FActOnTopSandbox write FActOnTopSandbox; + property DisableActions: Boolean read FDisableActions write FDisableActions; + property HideActions: Boolean read FHideActions write FHideActions; + property SaveConfirmation: Boolean read FSaveConfirmation write FSaveConfirmation; + property IconType: Integer read FIconType write SetIconType; + property CurrentCache: TJclVersionControlCache read GetCurrentCache; + property CurrentPlugin: TJclVersionControlPlugin read GetCurrentPlugin; + property CurrentFileName: string read GetCurrentFileName; + property PluginCount: Integer read GetPluginCount; + property Plugins[Index: Integer]: TJclVersionControlPlugin read GetPlugin; + // plugin functions + private + procedure ClassRegistered(const APluginClass: TJclVersionControlPluginClass); + procedure ClassUnregistered(const APluginClass: TJclVersionControlPluginClass); + public + class procedure RegisterPluginClass(const APluginClass: TJclVersionControlPluginClass); + class procedure UnregisterPluginClass(const APluginClass: TJclVersionControlPluginClass); + end; + + TJclVersionControlSystemPlugin = class (TJclVersionControlPlugin) + protected + function GetSupportedActions: TJclVersionControlActions; override; + function GetFileActions(const FileName: string): TJclVersionControlActions; override; + function GetSandboxActions(const SdBxName: string): TJclVersionControlActions; override; + function GetIcon(const Action: TJclVersionControlAction): Integer; override; + function GetEnabled: Boolean; override; + function GetName: string; override; + public + function GetSandboxNames(const FileName: string; SdBxNames: TStrings): Boolean; override; + function ExecuteAction(const FileName: string; + const Action: TJclVersionControlAction): Boolean; override; + end; + +{$IFDEF COMPILER8_UP} + TDropDownAction = TControlAction; +{$ELSE COMPILER8_UP} + TDropDownAction = TPopupAction; +{$ENDIF COMPILER8_UP} + +// design package entry point +procedure Register; + +// expert DLL entry point +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean; stdcall; + +function GetItemIndexA(const Item: string): Integer; +function GetItemIndexB(const Item: string): Integer; +function GetItemName(const Item: string): string; + +implementation + +uses + Windows, Forms, TypInfo, + JclDebug, JclFileUtils, JclRegistry, JclShell, JclStrings, + JclOtaConsts, JclOtaResources; + +//=== VersionControlImpl.pas =================================================== +const + JclVersionCtrlMenuName = 'JclVersionCtrlMenu'; + // 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'; + // 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'; + JclVersionCtrlIconTypeAutoValue = 'auto'; + JclVersionCtrlIconTypeNoIconValue = 'noicon'; + JclVersionCtrlIconTypeJclIconValue = 'jclicons'; + +resourcestring + RsVersionCtrlMenuCaption = 'Jcl &Version'; + 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 Folder'; // 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 + 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 + + RsSvnMenuItemNotInserted = 'Can''t insert the ''%s'' menu item'; + RsENoToolsMenuItem = 'Tools menu item not found'; + RsVersionControlSheet = 'Version control'; + RsActionCategory = 'Jedi Code Library'; + RsVersionCtrlSystemName = 'System'; + +procedure Register; +begin + try + RegisterPackageWizard(TJclVersionControlExpert.Create); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +var + JCLWizardIndex: Integer = -1; + +procedure JclWizardTerminate; +var + OTAWizardServices: IOTAWizardServices; +begin + try + if JCLWizardIndex <> -1 then + begin + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + OTAWizardServices.RemoveWizard(JCLWizardIndex); + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + end; + end; +end; + +function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices; + RegisterProc: TWizardRegisterProc; + var TerminateProc: TWizardTerminateProc): Boolean stdcall; +var + OTAWizardServices: IOTAWizardServices; +begin + try + TerminateProc := JclWizardTerminate; + + Supports(BorlandIDEServices, IOTAWizardServices, OTAWizardServices); + if not Assigned(OTAWizardServices) then + raise EJclExpertException.CreateTrace(RsENoWizardServices); + + JCLWizardIndex := OTAWizardServices.AddWizard(TJclVersionControlExpert.Create); + + Result := True; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + Result := False; + end; + end; +end; + +function GetItemIndexA(const Item: string): Integer; +var + Index: Integer; +begin + Result := 0; + for Index := 1 to Length(Item) do + if not (Item[Index] in AnsiDecDigits) then + begin + Result := StrToInt(Copy(Item, 1, Index - 1)); + Exit; + end; + Abort; +end; + +function GetItemIndexB(const Item: string): Integer; +var + Index: Integer; +begin + Result := -1; + for Index := Length(Item) downto 1 do + if not (Item[Index] in AnsiDecDigits) then + begin + if Index < Length(Item) then + Result := StrToInt(Copy(Item, Index + 1, Length(Item) - Index)); + Exit; + end; +end; + +function GetItemName(const Item: string): string; +var + Index1, Index2: Integer; +begin + for Index1 := 1 to Length(Item) do + if not (Item[Index1] in AnsiDecDigits) then + begin + if Index1 = 1 then + Abort; + Break; + end; + + for Index2 := Length(Item) downto 1 do + if not (Item[Index2] in AnsiDecDigits) then + Break; + + Result := Copy(Item, Index1, Index2 - Index1 + 1); +end; + +function MenuOrganizationSort(List: TStringList; Index1, Index2: Integer): Integer; +var + Item1, Item2: string; + Index1A, Index1B, Index2A, Index2B: Integer; +begin + Item1 := List.Strings[Index1]; + Item2 := List.Strings[Index2]; + Index1A := GetItemIndexA(Item1); + Index1B := GetItemIndexB(Item1); + Index2A := GetItemIndexA(Item2); + Index2B := GetItemIndexB(Item2); + + if Index1A < Index2A then + Result := -1 + else if Index1A > Index2A then + Result := 1 + else if Index1B < Index2B then + Result := -1 + else if Index1B > Index2B then + Result := 1 + else + Result := 0; +end; + +type + TJclVersionControlActionRec = record + Sandbox: Boolean; + SaveFile: Boolean; + AllPlugins: Boolean; + Caption: string; + ActionName: string; + end; + +const + VersionControlActionInfos: array [TJclVersionControlAction] of TJclVersionControlActionRec = + ( (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: 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) + ); + +//=== { TJclIconCacheInfo } ========================================================== + +type + TJclIconCacheInfo = class (TObject) + private + FFileName: string; + FIconIndex: Integer; + FResourceName: string; + public + property FileName: string read FFileName write FFileName; + property ResourceName: string read FResourceName write FResourceName; + property IconIndex: Integer read FIconIndex write FIconIndex; + end; + +//=== { TJclVersionControlExpert } =================================================== + +var + PluginClassList: TList = nil; + ExpertInstanceList: TList = nil; + +class procedure TJclVersionControlExpert.RegisterPluginClass( + const APluginClass: TJclVersionControlPluginClass); +var + Index: Integer; +begin + if not Assigned(PluginClassList) then + PluginClassList := TList.Create; + PluginClassList.Add(APluginClass); + if Assigned(ExpertInstanceList) then + for Index := 0 to ExpertInstanceList.Count - 1 do + TJclVersionControlExpert(ExpertInstanceList.Items[Index]).ClassRegistered(APluginClass); +end; + +class procedure TJclVersionControlExpert.UnregisterPluginClass( + const APluginClass: TJclVersionControlPluginClass); +var + Index: Integer; +begin + if Assigned(PluginClassList) then + PluginClassList.Remove(APluginClass); + if Assigned(ExpertInstanceList) then + for Index := 0 to ExpertInstanceList.Count - 1 do + TJclVersionControlExpert(ExpertInstanceList.Items[Index]).ClassUnregistered(APluginClass); +end; + +{function TJclVersionControlExpert.ActiveModuleFileName(ASave, IncludeFamily: Boolean): string; +var + ModuleServices: IOTAModuleServices; + lModule: IOTAModule; + lExt, lFileName: string; +begin + try + Supports(BorlandIDEServices, IOTAModuleServices, ModuleServices); + if not Assigned(ModuleServices) then + raise EJclExpertException.CreateTrace(RsENoModuleServices); + lModule := ModuleServices.CurrentModule; + if (lModule = nil) or (lModule.FileSystem <> '') then + Result := '' + else + begin + Result := lModule.CurrentEditor.FileName; + if ASave then + lModule.Save(False, False); + if IncludeFamily and (lModule.ModuleFileCount > 1) then + begin + lExt := ExtractFileExt(Result); + if (lExt = '.pas') then + begin + lFileName := ChangeFileExt(Result, '.dfm'); + if FileExists(lFileName) then + Result := Result + '*' + lFileName; + end + else if (lExt = '.dfm') then + begin + lFileName := ChangeFileExt(Result, '.pas'); + if FileExists(lFileName) then + Result := Result + '*' + lFileName; + end + end; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; } + +procedure TJclVersionControlExpert.ActionExecute(Sender: TObject); +var + Index: Integer; + AAction: TCustomAction; + AControlAction: TJclVersionControlAction; + APlugin: TJclVersionControlPlugin; + AFileName: string; + AFileCache: TJclVersionControlCache; +begin + try + AAction := Sender as TCustomAction; + for AControlAction := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do + if FActions[AControlAction] = AAction then + begin + if VersionControlActionInfos[AControlAction].Sandbox then + begin + AFileCache := CurrentCache; + if not Assigned(AFileCache) or VersionControlActionInfos[AControlAction].AllPlugins then + Exit; + if ActOnTopSandbox then + begin + for Index := AFileCache.SandboxCount - 1 downto 0 do + if AControlAction in AFileCache.SandboxActions[Index] then + begin + if VersionControlActionInfos[AControlAction].SaveFile then + SaveModules(AFileCache.SandBoxes[Index], True); + AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], AControlAction); + Exit; + end; + end + else + begin + for Index := 0 to AFileCache.SandboxCount - 1 do + if AControlAction in AFileCache.SandboxActions[Index] then + begin + if VersionControlActionInfos[AControlAction].SaveFile then + SaveModules(AFileCache.SandBoxes[Index], True); + AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], AControlAction); + Exit; + end; + end; + end + else + begin + AFileName := CurrentFileName; + if VersionControlActionInfos[AControlAction].SaveFile then + SaveModules(AFileName, False); + + if VersionControlActionInfos[AControlAction].AllPlugins then + begin + for Index := 0 to FPluginList.Count - 1 do + begin + AFileCache := GetFileCache(AFileName, + TJclVersionControlPlugin(FPluginList.Items[Index])); + + if AControlAction in AFileCache.Actions then + begin + AFileCache.Plugin.ExecuteAction(AFileName, AControlAction); + Exit; + end; + end; + end + else + begin + APlugin := CurrentPlugin; + if Assigned(APlugin) then + APlugin.ExecuteAction(AFileName, AControlAction); + end; + end; + Exit; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclVersionControlExpert.ActionUpdate(Sender: TObject); +var + IndexSandbox, IndexPlugin: Integer; + AAction: TCustomAction; + AControlAction: TJclVersionControlAction; + AFileCache: TJclVersionControlCache; + AFileName: string; +begin + try + AAction := Sender as TCustomAction; + AFileCache := CurrentCache; + + if IconType = -1 then + begin + if Assigned(AFileCache) then + FLastPlugin := AFileCache.Plugin + else + FLastPlugin := nil; + RefreshIcon(AAction); + end; + + for AControlAction := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do + if FActions[AControlAction] = AAction then + begin + if HideActions and not VersionControlActionInfos[AControlAction].AllPlugins then + AAction.Visible := Assigned(AFileCache) and Assigned(AFileCache.Plugin) + and (AControlAction in AFileCache.Plugin.SupportActions) + else + AAction.Visible := True; + + if DisableActions then + begin + if VersionControlActionInfos[AControlAction].Sandbox then + begin + if VersionControlActionInfos[AControlAction].AllPlugins then + begin + AFileName := CurrentFileName; + for IndexPlugin := 0 to FPluginList.Count - 1 do + begin + AFileCache := GetFileCache(AFileName, + TJclVersionControlPlugin(FPluginList.Items[IndexPlugin])); + for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do + if AControlAction in AFileCache.SandBoxActions[IndexSandbox] then + begin + AAction.Enabled := True; + Exit; + end; + AAction.Enabled := False; + Exit; + end; + end + else // work for all plugin + begin + if Assigned(AFileCache) then + begin + for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do + if AControlAction in AFileCache.SandBoxActions[IndexSandbox] then + begin + AAction.Enabled := True; + Exit; + end; + AAction.Enabled := False; + Exit; + end + else + AAction.Enabled := False; + end; + Exit; + end + else // file + begin + if VersionControlActionInfos[AControlAction].AllPlugins then + begin + AFileName := CurrentFileName; + for IndexPlugin := 0 to FPluginList.Count - 1 do + begin + AFileCache := GetFileCache(AFileName, + TJclVersionControlPlugin(FPluginList.Items[IndexPlugin])); + if AControlAction in AFileCache.Actions then + begin + AAction.Enabled := True; + Exit; + end; + end; + AAction.Enabled := False; + Exit; + end + else // only the current plugin + begin + AFileCache := CurrentCache; + AAction.Enabled := Assigned(AFileCache) and (AControlAction in AFileCache.Actions); + end; + end; + end + else + AAction.Enabled := True; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclVersionControlExpert.AddConfigurationPages( + AddPageFunc: TJclOTAAddPageFunc); +var + Index: Integer; + IconTypeNames: TStrings; +begin + inherited AddConfigurationPages(AddPageFunc); + FOptionsFrame := TJclVersionCtrlOptionsFrame.Create(nil); + FOptionsFrame.DisableActions := DisableActions; + FOptionsFrame.HideActions := HideActions; + FOptionsFrame.SaveConfirmation := SaveConfirmation; + FOptionsFrame.ActOnTopSandbox := ActOnTopSandbox; + IconTypeNames := TStringList.Create; + try + for Index := 0 to FPluginList.Count - 1 do + IconTypeNames.Add(TJclVersionControlPlugin(FPluginList.Items[Index]).Name); + FOptionsFrame.SetIconTypeNames(IconTypeNames); + finally + IconTypeNames.Free; + end; + FOptionsFrame.SetActions(FActions); + // after SetActions + FOptionsFrame.MenuTree := FMenuOrganization; + FOptionsFrame.IconType := IconType; + AddPageFunc(FOptionsFrame, RsVersionControlSheet, Self); +end; + +function TJclVersionControlExpert.CacheResourceIcon(const ResourceFile: string; + const ResourceID: Integer): Integer; +var + ResourceName: string; +begin + SetLength(ResourceName, SizeOf(ResourceID)); + Move(ResourceID, ResourceName[1], SizeOf(ResourceID)); + Result := CacheResourceIcon(ResourceFile, ResourceName); +end; + +function TJclVersionControlExpert.CacheResourceIcon(const ResourceFile: string; + const ResourceName: string): Integer; +var + Index: Integer; + AIconCacheInfo: TJclIconCacheInfo; + AIcon: TIcon; + FileModule: HMODULE; + ResourceID: Integer; +begin + for Index := 0 to FIconCache.Count - 1 do + begin + AIconCacheInfo := TJclIconCacheInfo(FIconCache.Items[Index]); + if (CompareText(AIconCacheInfo.ResourceName, ResourceName) = 0) and + (CompareText(AIconCacheInfo.FileName, ResourceFile) = 0) then + begin + Result := AIconCacheInfo.IconIndex; + Exit; + end; + end; + Result := -1; + AIconCacheInfo := TJclIconCacheInfo.Create; + AIconCacheInfo.FileName := ResourceFile; + AIconCacheInfo.ResourceName := ResourceName; + FileModule := LoadLibraryEx(PChar(ResourceFile), 0, LOAD_LIBRARY_AS_DATAFILE); + if FileModule <> 0 then + try + AIcon := TIcon.Create; + try + if (Length(ResourceName) = 4) and (ResourceName[3] = #0) and (ResourceName[4] = #0) then + begin + Move(ResourceName[1], ResourceID, SizeOf(ResourceID)); + AIcon.Handle := LoadIcon(FileModule, PChar(ResourceID)); + end + else + AIcon.Handle := LoadIcon(FileModule, PChar(ResourceName)); + Result := NTAServices.ImageList.AddIcon(AIcon); + finally + AIcon.Free; + end; + finally + FreeLibrary(FileModule); + end; + + AIconCacheInfo := TJclIconCacheInfo.Create; + AIconCacheInfo.FileName := ResourceFile; + AIconCacheInfo.ResourceName := ResourceName; + AIconCacheInfo.IconIndex := Result; + FIconCache.Add(AIconCacheInfo); +end; + +procedure TJclVersionControlExpert.ClassRegistered( + const APluginClass: TJclVersionControlPluginClass); +begin + FPluginList.Add(APluginClass.Create(Self)); +end; + +procedure TJclVersionControlExpert.ClassUnregistered( + const APluginClass: TJclVersionControlPluginClass); +var + Index: Integer; + APlugin: TJclVersionControlPlugin; + AFileCache: TJclVersionControlCache; +begin + for Index := FPluginList.Count - 1 downto 0 do + begin + APlugin := TJclVersionControlPlugin(FPluginList.Items[Index]); + if APlugin = FLastPlugin then + FLastPlugin := nil; + if APlugin.ClassType = APluginClass then + begin + APlugin.Free; + FPluginList.Delete(Index); + end; + end; + for Index := FFileCache.Count 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; +end; + +procedure TJclVersionControlExpert.CleanSubMenus(const AMenuItem: TMenuItem); +var + Index: Integer; + BMenuItem: TMenuItem; +begin + if Assigned(AMenuItem) then + for Index := AMenuItem.Count - 1 downto 0 do + begin + BMenuItem := AMenuItem.Items[Index]; + CleanSubMenus(BMenuItem); + BMenuItem.Free; + end; +end; + +procedure TJclVersionControlExpert.ConfigurationClosed(AControl: TControl; + SaveChanges: Boolean); +begin + if (AControl = FOptionsFrame) and Assigned(FOptionsFrame) then + begin + if SaveChanges then + begin + DisableActions := FOptionsFrame.DisableActions; + HideActions := FOptionsFrame.HideActions; + SaveConfirmation := FOptionsFrame.SaveConfirmation; + ActOnTopSandbox := FOptionsFrame.ActOnTopSandbox; + FMenuOrganization.Assign(FOptionsFrame.MenuTree); + IconType := FOptionsFrame.IconType; + RefreshMenu; + end; + FreeAndNil(FOptionsFrame); + end + else + inherited ConfigurationClosed(AControl, SaveChanges); +end; + +constructor TJclVersionControlExpert.Create; +var + Index: Integer; +begin + Supports(BorlandIDEServices, IOTAModuleServices, FModuleServices); + if not Assigned(FModuleServices) then + raise EJclExpertException.CreateTrace(RsENoModuleServices); + + FMenuOrganization := TStringList.Create; + FPluginList := TList.Create; + FIconCache := TList.Create; + FFileCache := TList.Create; + + for Index := 0 to PluginClassList.Count - 1 do + FPluginList.Add(TJclVersionControlPluginClass(PluginClassList.Items[Index]).Create(Self)); + + inherited Create('JclVersionControlExpert'); + + if not Assigned(ExpertInstanceList) then + ExpertInstanceList := TList.Create; + ExpertInstanceList.Add(Self); +end; + +destructor TJclVersionControlExpert.Destroy; +var + Index: Integer; +begin + ExpertInstanceList.Remove(Self); + + inherited Destroy; + + for Index := FPluginList.Count - 1 downto 0 do + TJclVersionControlPlugin(FPluginList.Items[Index]).Free; + FPluginList.Free; + + for Index := FIconCache.Count - 1 downto 0 do + TJclIconCacheInfo(FIconCache.Items[Index]).Free; + FIconCache.Free; + + for Index := FFileCache.Count - 1 downto 0 do + TJclVersionControlCache(FFileCache.Items[Index]).Free; + + FMenuOrganization.Free; +end; + +procedure TJclVersionControlExpert.DropDownMenuPopup(Sender: TObject); +var + APopupMenu: TPopupMenu; + AMenuItem: TMenuItem; + AControlAction: TJclVersionControlAction; + AFileCache: TJclVersionControlCache; + IndexPlugin, IndexSandbox: Integer; + AFileName: string; +begin + try + APopupMenu := Sender as TPopupMenu; + AControlAction := TJclVersionControlAction(APopupMenu.Tag); + + CleanSubMenus(APopupMenu.Items); + + if VersionControlActionInfos[AControlAction].AllPlugins then + begin + AFileName := CurrentFileName; + for IndexPlugin := 0 to FPluginList.Count - 1 do + begin + AFileCache := GetFileCache(AFileName, + TJclVersionControlPlugin(FPluginList.Items[IndexPlugin])); + for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do + if AControlAction in AFileCache.SandBoxActions[IndexSandbox] then + begin + AMenuItem := TMenuItem.Create(nil); + AMenuItem.Caption := Format('%s | %s', [AFileCache.Plugin.Name, AFileCache.SandBoxes[IndexSandbox]]); + AMenuItem.Tag := APopupMenu.Tag; + AMenuItem.OnClick := SubItemClick; + AMenuItem.ImageIndex := AFileCache.Plugin.Icons[AControlAction]; + APopupMenu.Items.Add(AMenuItem); + end; + end; + end + else + begin + AFileCache := CurrentCache; + if Assigned(AFileCache) then + for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do + if AControlAction in AFileCache.SandBoxActions[IndexSandbox] then + begin + AMenuItem := TMenuItem.Create(nil); + AMenuItem.Caption := AFileCache.SandBoxes[IndexSandbox]; + AMenuItem.Tag := APopupMenu.Tag; + AMenuItem.OnClick := SubItemClick; + AMenuItem.ImageIndex := AFileCache.Plugin.Icons[AControlAction]; + APopupMenu.Items.Add(AMenuItem); + end; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +function TJclVersionControlExpert.GetCurrentCache: TJclVersionControlCache; +var + Index: Integer; + AFileName: string; + APlugin: TJclVersionControlPlugin; +begin + AFileName := CurrentFileName; + for Index := 0 to FPluginList.Count - 1 do + begin + APlugin := TJclVersionControlPlugin(FPluginList.Items[Index]); + Result := GetFileCache(AFileName, APlugin); + if Result.Supported then + Exit; + end; + Result := nil; +end; + +function TJclVersionControlExpert.GetCurrentFileName: string; +var + AOTAModule: IOTAModule; +begin + AOTAModule := ModuleServices.CurrentModule; + if Assigned(AOTAModule) and (AOTAModule.FileSystem = '') then + Result := AOTAModule.FileName + else + Result := ''; +end; + +function TJclVersionControlExpert.GetCurrentPlugin: TJclVersionControlPlugin; +var + Index: Integer; + AFileCacheInfo: TJclVersionControlCache; + AFileName: string; +begin + AFileName := CurrentFileName; + for Index := 0 to FPluginList.Count - 1 do + begin + Result := TJclVersionControlPlugin(FPluginList.Items[Index]); + AFileCacheInfo := GetFileCache(AFileName, Result); + if AFileCacheInfo.Supported then + Exit; + end; + Result := nil; +end; + +function TJclVersionControlExpert.GetFileCache(const FileName: string; + const Plugin: TJclVersionControlPlugin): TJclVersionControlCache; +var + Index: Integer; + AFileCache: TJclVersionControlCache; + ATime: TDateTime; +begin + ATime := Date; + Result := nil; + + for Index := FFileCache.Count - 1 downto 0 do + begin + AFileCache := TJclVersionControlCache(FFileCache.Items[Index]); + if 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); + FFileCache.Add(Result); + end; +end; + +function TJclVersionControlExpert.GetPlugin( + Index: Integer): TJclVersionControlPlugin; +begin + Result := TJclVersionControlPlugin(FPluginList.Items[Index]); +end; + +function TJclVersionControlExpert.GetPluginCount: Integer; +begin + Result := FPluginList.Count; +end; + +procedure TJclVersionControlExpert.IDEActionMenuClick(Sender: TObject); +var + AMenuItem, SubMenuItem: TMenuItem; + AControlAction: TJclVersionControlAction; + IndexSandbox, IndexPlugin, IndexItem: Integer; + AFileCache: TJclVersionControlCache; + AFileName: string; +begin + try + AMenuItem := Sender as TMenuItem; + // do not delete the dummy subitem + for IndexItem := AMenuItem.Count - 1 downto 1 do + AMenuItem.Items[IndexItem].Free; + AControlAction := TJclVersionControlAction(AMenuItem.Tag); + + if VersionControlActionInfos[AControlAction].AllPlugins then + begin + for IndexPlugin := 0 to FPluginList.Count - 1 do + begin + AFileName := CurrentFileName; + AFileCache := GetFileCache(AFileName, + TJclVersionControlPlugin(FPluginList.Items[IndexPlugin])); + for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do + if AControlAction in AFileCache.SandBoxActions[IndexSandbox] then + begin + SubMenuItem := TMenuItem.Create(nil); + SubMenuItem.Caption := Format('%s | %s', [AFileCache.Plugin.Name, AFileCache.SandBoxes[IndexSandbox]]); + SubMenuItem.Tag := Integer(AControlAction); + SubMenuItem.OnClick := SubItemClick; + SubMenuItem.ImageIndex := AFileCache.Plugin.Icons[AControlAction]; + AMenuItem.Add(SubMenuItem); + end; + end; + end + else + begin + AFileCache := CurrentCache; + + if Assigned(AFileCache) then + for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do + if AControlAction in AFileCache.SandBoxActions[IndexSandbox] then + begin + SubMenuItem := TMenuItem.Create(nil); + SubMenuItem.Caption := AFileCache.SandBoxes[IndexSandbox]; + SubMenuItem.Tag := Integer(AControlAction); + SubMenuItem.OnClick := SubItemClick; + SubMenuItem.ImageIndex := AFileCache.Plugin.Icons[AControlAction]; + AMenuItem.Add(SubMenuItem); + end; + end; + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclVersionControlExpert.IDEVersionCtrlMenuClick(Sender: TObject); + procedure UpdateMenuItem(const AMenuItem: TMenuItem); + var + BMenuItem: TMenuItem; + IndexMenu, IndexSandbox: Integer; + AControlAction: TJclVersionControlAction; + AFileCache: TJclVersionControlCache; + AEnabled: Boolean; + IndexPlugin: Integer; + AFileName: string; + begin + for IndexMenu := 0 to AMenuItem.Count - 1 do + begin + BMenuItem := AMenuItem.Items[IndexMenu]; + if BMenuItem.Tag = -1 then + UpdateMenuItem(BMenuItem) + else if BMenuItem.Tag >= 0 then + begin + AControlAction := TJclVersionControlAction(BMenuItem.Tag); + if VersionControlActionInfos[AControlAction].Sandbox then + begin + AFileCache := CurrentCache; + + if IconType = -1 then + begin + if VersionControlActionInfos[AControlAction].AllPlugins then + begin + BMenuItem.ImageIndex := -1; + for IndexPlugin := 0 to FPluginList.Count - 1 do + begin + BMenuItem.ImageIndex := TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]).Icons[AControlAction]; + if BMenuItem.ImageIndex > -1 then + Break; + end; + end + else if Assigned(AFileCache) and Assigned(AFileCache.Plugin) then + BMenuItem.ImageIndex := AFileCache.Plugin.GetIcon(AControlAction) + else + BMenuItem.ImageIndex := -1; + end; + + if HideActions and not VersionControlActionInfos[AControlAction].AllPlugins then + BMenuItem.Visible := Assigned(AFileCache.Plugin) + and (AControlAction in AFileCache.Plugin.SupportActions) + else + BMenuItem.Visible := True; + + if DisableActions then + begin + AEnabled := False; + if VersionControlActionInfos[AControlAction].AllPlugins then + begin + AFileName := CurrentFileName; + for IndexPlugin := 0 to FPluginList.Count - 1 do + begin + AFileCache := GetFileCache(AFileName, + TJclVersionControlPlugin(FPluginList.Items[IndexPlugin])); + for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do + if AControlAction in AFileCache.SandBoxActions[IndexSandbox] then + begin + AEnabled := True; + Break; + end; + + if AEnabled then + Break; + end; + end + else if Assigned(AFileCache) then + begin + for IndexSandbox := 0 to AFileCache.SandboxCount - 1 do + if AControlAction in AFileCache.SandboxActions[IndexSandbox] then + begin + AEnabled := True; + Break; + end; + end; + BMenuItem.Enabled := AEnabled; + end + else + BMenuItem.Enabled := True; + end; + end; + end; + end; +begin + try + UpdateMenuItem(FVersionCtrlMenu); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclVersionControlExpert.RefreshIcon(const AAction: TCustomAction); +var + ControlAction: TJclVersionControlAction; + IndexPlugin: Integer; +begin + if not Assigned(AAction) then + Exit; + + for ControlAction := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do + if FActions[ControlAction] = AAction then + begin + case IconType of + // No icon + -3 : + AAction.ImageIndex := -1; + // JCL icons + // TODO: create resources + -2 : + AAction.ImageIndex := -1; + // auto icons + -1 : + if VersionControlActionInfos[ControlAction].AllPlugins then + begin + for IndexPlugin := 0 to FPluginList.Count - 1 do + begin + AAction.ImageIndex := TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]).Icons[ControlAction]; + if AAction.ImageIndex > -1 then + Break; + end; + end + else + begin + if Assigned(FLastPlugin) then + AAction.ImageIndex := FLastPlugin.GetIcon(ControlAction) + else + AAction.ImageIndex := -1; + end; + // Specific icons + 0..High(Integer) : + if IconType < FPluginList.Count then + AAction.ImageIndex := TJclVersionControlPlugin(FPluginList.Items[IconType]).Icons[ControlAction] + else + AAction.ImageIndex := -1; + end; + Exit; + end; +end; + +procedure TJclVersionControlExpert.RefreshIcons; +var + ControlAction: TJclVersionControlAction; + IndexPlugin: Integer; +begin + for ControlAction := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do + if Assigned(FActions[ControlAction]) then + begin + case IconType of + // No icon + -3 : + FActions[ControlAction].ImageIndex := -1; + // JCL icons + // TODO: create resources + -2 : + FActions[ControlAction].ImageIndex := -1; + // Auto icons + -1 : + if VersionControlActionInfos[ControlAction].AllPlugins then + begin + for IndexPlugin := 0 to FPluginList.Count - 1 do + begin + FActions[ControlAction].ImageIndex := TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]).Icons[ControlAction]; + if FActions[ControlAction].ImageIndex > -1 then + Break; + end; + end + else + begin + if Assigned(FLastPlugin) then + FActions[ControlAction].ImageIndex := FLastPlugin.Icons[ControlAction] + else + FActions[ControlAction].ImageIndex := -1; + end; + // Specific icons + 0..High(Integer) : + if IconType < FPluginList.Count then + FActions[ControlAction].ImageIndex := TJclVersionControlPlugin(FPluginList.Items[IconType]).Icons[ControlAction] + else + FActions[ControlAction].ImageIndex := -1; + end; + end; +end; + +procedure TJclVersionControlExpert.RefreshMenu; + procedure LoadDefaultMenu; + var + Action: TJclVersionControlAction; + begin + FMenuOrganization.Clear; + for Action := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do + FMenuOrganization.Add(Format('%d%s', [Integer(Action), GetEnumName(TypeInfo(TJclVersionControlAction), Integer(Action))])); + end; +var + Index, IndexA, IndexB, ActionIndex: Integer; + SubMenuItem, ActionMenuItem, DummyMenuItem: TMenuItem; + Item, ItemName: string; + AAction: TCustomAction; +begin + CleanSubMenus(FVersionCtrlMenu); + + if FMenuOrganization.Count > 0 then + try + FMenuOrganization.CustomSort(MenuOrganizationSort); + except + LoadDefaultMenu; + end + else + LoadDefaultMenu; + + SubMenuItem := nil; + for Index := 0 to FMenuOrganization.Count - 1 do + begin + Item := FMenuOrganization.Strings[Index]; + IndexA := GetItemIndexA(Item); + IndexB := GetItemIndexB(Item); + ItemName := GetItemName(Item); + ActionIndex := GetEnumValue(TypeInfo(TJclVersionControlAction), ItemName); + + if IndexB = -1 then + begin + if FVersionCtrlMenu.Count <> IndexA then + Abort; + + if (ActionIndex = -1) or (ItemName = '-') then + begin + SubMenuItem := TMenuItem.Create(nil); + SubMenuItem.Caption := ItemName; + SubMenuItem.Tag := -1; + FVersionCtrlMenu.Add(SubMenuItem); + end + else + begin + ActionMenuItem := TMenuItem.Create(nil); + AAction := FActions[TJclVersionControlAction(ActionIndex)]; + if VersionControlActionInfos[TJclVersionControlAction(ActionIndex)].Sandbox then + begin + ActionMenuItem.Caption := AAction.Caption; + ActionMenuItem.ShortCut := AAction.ShortCut; + ActionMenuItem.ImageIndex := AAction.ImageIndex; + ActionMenuItem.Tag := ActionIndex; + ActionMenuItem.OnClick := IDEActionMenuClick; + + // to always have the arrow in the parent menu item + DummyMenuItem := TMenuItem.Create(nil); + DummyMenuItem.Visible := False; + DummyMenuItem.Tag := -2; + ActionMenuItem.Add(DummyMenuItem); + end + else + ActionMenuItem.Action := AAction; + FVersionCtrlMenu.Add(ActionMenuItem); + SubMenuItem := nil; + end; + end + else + begin + if (not Assigned(SubMenuItem)) or (SubMenuItem.Count <> IndexB) then + Abort; + if (ActionIndex = -1) or (ItemName = '-') then + begin + ActionMenuItem := TMenuItem.Create(nil); + ActionMenuItem.Caption := ItemName; + end + else + begin + ActionMenuItem := TMenuItem.Create(nil); + AAction := FActions[TJclVersionControlAction(ActionIndex)]; + if VersionControlActionInfos[TJclVersionControlAction(ActionIndex)].Sandbox then + begin + ActionMenuItem.Caption := AAction.Caption; + ActionMenuItem.ShortCut := AAction.ShortCut; + ActionMenuItem.ImageIndex := AAction.ImageIndex; + ActionMenuItem.Tag := ActionIndex; + ActionMenuItem.OnClick := IDEActionMenuClick; + + // to always have the arrow in the parent menu item + DummyMenuItem := TMenuItem.Create(nil); + DummyMenuItem.Visible := False; + DummyMenuItem.Tag := -2; + ActionMenuItem.Add(DummyMenuItem); + end + else + ActionMenuItem.Action := AAction; + end; + SubMenuItem.Add(ActionMenuItem); + end; + end; +end; + +procedure TJclVersionControlExpert.RegisterCommands; +var + IDEMainMenu: TMainMenu; + IDEToolsItem: TMenuItem; + IDEActionList: TCustomActionList; + I: Integer; + AAction: TCustomAction; + ADropDownAction: TDropDownAction; + IconTypeStr: string; + ControlAction: TJclVersionControlAction; +begin + inherited RegisterCommands; + + Settings.LoadStrings(JclVersionCtrlMenuOrganizationName, FMenuOrganization); + SaveConfirmation := Settings.LoadBool(JclVersionCtrlSaveConfirmationName, True); + DisableActions := Settings.LoadBool(JclVersionCtrlDisableActionsName, True); + HideActions := Settings.LoadBool(JclVersionCtrlHideActionsName, False); + IconTypeStr := Settings.LoadString(JclVersionCtrlIconTypeName, JclVersionCtrlIconTypeAutoValue); + ActOnTopSandbox := Settings.LoadBool(JclVersionCtrlActOnTopSandboxName, False); + + FIconType := -1; + if IconTypeStr = JclVersionCtrlIconTypeNoIconValue then + FIconType := -3 + else if IconTypeStr = JclVersionCtrlIconTypeJclIconValue then + FIconType := -2 + else if IconTypeStr = JclVersionCtrlIconTypeAutoValue then + FIconType := -1 + else for I := 0 to FPluginList.Count - 1 do + if IconTypeStr = TJclVersionControlPlugin(FPluginList.Items[I]).Name then + FIconType := I; + + IDEMainMenu := NTAServices.MainMenu; + IDEToolsItem := nil; + for I := 0 to IDEMainMenu.Items.Count - 1 do + if IDEMainMenu.Items[I].Name = 'ToolsMenu' then + begin + IDEToolsItem := IDEMainMenu.Items[I]; + Break; + end; + if not Assigned(IDEToolsItem) then + raise EJclExpertException.CreateTrace(RsENoToolsMenuItem); + + IDEActionList := NTAServices.ActionList; + + FVersionCtrlMenu := TMenuItem.Create(nil); + FVersionCtrlMenu.Caption := RsVersionCtrlMenuCaption; + FVersionCtrlMenu.Name := JclVersionCtrlMenuName; + FVersionCtrlMenu.OnClick := IDEVersionCtrlMenuClick; + IDEMainMenu.Items.Insert(IDEToolsItem.MenuIndex + 1, FVersionCtrlMenu); + if not Assigned(FVersionCtrlMenu.Parent) then + raise EJclExpertException.CreateTrace(Format(RsSvnMenuItemNotInserted, [FVersionCtrlMenu.Caption])); + + for ControlAction := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do + begin + if VersionControlActionInfos[ControlAction].Sandbox then + begin + ADropDownAction := TDropDownAction.Create(nil); + ADropDownAction.DropdownMenu := TPopupMenu.Create(nil); + ADropDownAction.DropdownMenu.AutoPopup := True; + ADropDownAction.DropdownMenu.AutoHotkeys := maManual; + ADropDownAction.DropdownMenu.Tag := Integer(ControlAction); + ADropDownAction.DropdownMenu.OnPopup := DropDownMenuPopup; + AAction := ADropDownAction; + end + else + AAction := TAction.Create(nil); + + AAction.Caption := VersionControlActionInfos[ControlAction].Caption; + AAction.Name := VersionControlActionInfos[ControlAction].ActionName; + AAction.Visible := True; + AAction.ActionList := IDEActionList; + AAction.OnExecute := ActionExecute; + AAction.OnUpdate := ActionUpdate; + AAction.Category := RsActionCategory; + RegisterAction(AAction); + FActions[ControlAction] := AAction; + end; + + RefreshIcons; + + RefreshMenu; +end; + +function TJclVersionControlExpert.SaveModules(const FileName: string; + const IncludeSubDirectories: Boolean): Boolean; +var + Module: IOTAModule; + Index: Integer; + Save: Boolean; +begin + Result := True; + + for Index := 0 to ModuleServices.ModuleCount - 1 do + begin + Module := ModuleServices.Modules[Index]; + + if Module.FileSystem <> '' then + begin + if IncludeSubDirectories then + Save := PathIsChild(Module.FileName, FileName) + else + Save := Module.FileName = FileName; + + if Save then + Module.Save(False, True); + end; + end; +end; + +procedure TJclVersionControlExpert.SetIconType(const Value: Integer); +begin + if Value <> FIconType then + begin + FIconType := Value; + RefreshIcons; + end; +end; + +procedure TJclVersionControlExpert.SubItemClick(Sender: TObject); +var + APlugin: TJclVersionControlPlugin; + AMenuItem: TMenuItem; + AAction: TCustomAction; + Directory, PluginName: string; + PosSeparator, IndexPlugin: Integer; + ControlAction: TJclVersionControlAction; +begin + try + APlugin := CurrentPlugin; + if Sender is TCustomAction then + begin + AAction := TCustomAction(Sender); + ControlAction := TJclVersionControlAction(AAction.Tag); + Directory := AAction.Caption; + end + else if Sender is TMenuItem then + begin + AMenuItem := TMenuItem(Sender); + ControlAction := TJclVersionControlAction(AMenuItem.Tag); + Directory := AMenuItem.Caption; + end + else + Exit; + + Directory := StrRemoveChars(Directory, ['&']); + + if VersionControlActionInfos[ControlAction].AllPlugins then + begin + PosSeparator := Pos('|', Directory); + PluginName := StrLeft(Directory, PosSeparator - 2); + Directory := StrRight(Directory, Length(Directory) - PosSeparator - 1); + for IndexPlugin := 0 to FPluginList.Count - 1 do + begin + APlugin := TJclVersionControlPlugin(FPluginList.Items[IndexPlugin]); + if SameText(APlugin.Name, PluginName) then + Break; + APlugin := nil; + end; + + if not Assigned(APlugin) then + Exit; + end; + + if VersionControlActionInfos[ControlAction].SaveFile then + SaveModules(Directory, True); + if Assigned(APlugin) then + APlugin.ExecuteAction(Directory , ControlAction); + except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; + end; +end; + +procedure TJclVersionControlExpert.UnregisterCommands; +var + ControlAction: TJclVersionControlAction; + ADropDownAction: TDropDownAction; +begin + inherited UnregisterCommands; + + Settings.SaveStrings(JclVersionCtrlMenuOrganizationName, FMenuOrganization); + Settings.SaveBool(JclVersionCtrlSaveConfirmationName, SaveConfirmation); + Settings.SaveBool(JclVersionCtrlDisableActionsName, DisableActions); + Settings.SaveBool(JclVersionCtrlHideActionsName, HideActions); + Settings.SaveBool(JclVersionCtrlActOnTopSandboxName, ActOnTopSandbox); + case FIconType of + -3: + Settings.SaveString(JclVersionCtrlIconTypeName, JclVersionCtrlIconTypeNoIconValue); + -2: + Settings.SaveString(JclVersionCtrlIconTypeName, JclVersionCtrlIconTypeJclIconValue); + -1: + Settings.SaveString(JclVersionCtrlIconTypeName, JclVersionCtrlIconTypeAutoValue); + 0..High(Integer): + Settings.SaveString(JclVersionCtrlIconTypeName, TJclVersionControlPlugin(FPluginList.Items[IconType]).Name); + end; + + for ControlAction := Low(TJclVersionControlAction) to High(TJclVersionControlAction) do + begin + UnregisterAction(FActions[ControlAction]); + if FActions[ControlAction] is TDropDownAction then + begin + ADropDownAction := TDropDownAction(FActions[ControlAction]); + if Assigned(ADropDownAction.DropDownMenu) then + begin + CleanSubMenus(ADropDownAction.DropDownMenu.Items); + ADropDownAction.DropDownMenu.Free; + ADropDownAction.DropDownMenu := nil; + end; + end; + FreeAndNil(FActions[ControlAction]); + end; + CleanSubMenus(FVersionCtrlMenu); + FreeAndNil(FVersionCtrlMenu); + FVersionCtrlMenu := nil; +end; + +//=== TJclVersionControlPlugin =============================================== + +constructor TJclVersionControlPlugin.Create(const AExpert: TJclVersionControlExpert); +begin + inherited Create; + FExpert := AExpert; +end; + +function TJclVersionControlPlugin.ExecuteAction(const FileName: string; + const Action: TJclVersionControlAction): Boolean; +begin + Result := False; +end; + +function TJclVersionControlPlugin.GetEnabled: Boolean; +begin + Result := False; +end; + +function TJclVersionControlPlugin.GetFileActions( + const FileName: string): TJclVersionControlActions; +begin + Result := []; +end; + +function TJclVersionControlPlugin.GetSupportedActions: TJclVersionControlActions; +begin + Result := []; +end; + +function TJclVersionControlPlugin.GetIcon( + const Action: TJclVersionControlAction): Integer; +begin + Result := -1; +end; + +function TJclVersionControlPlugin.GetName: string; +begin + Result := ''; +end; + +function TJclVersionControlPlugin.GetSandboxActions( + const SdBxName: string): TJclVersionControlActions; +begin + Result := []; +end; + +function TJclVersionControlPlugin.GetSandboxNames(const FileName: string; + SdBxNames: TStrings): Boolean; +var + Index: Integer; +begin + Result := False; + + SdBxNames.BeginUpdate; + try + SdBxNames.Clear; + for Index := Length(FileName) downto 1 do + if FileName[Index] = PathSeparator then + begin + SdBxNames.Add(Copy(FileName, 1, Index)); + end; + finally + SdBxNames.EndUpdate; + end; +end; + +//=== TJclVersionControlSystemPlugin ========================================= + +function TJclVersionControlSystemPlugin.ExecuteAction(const FileName: string; + const Action: TJclVersionControlAction): Boolean; +begin + case Action of + vcaContextMenu: + Result := DisplayContextMenu(0, FileName, Mouse.CursorPos); + vcaExplore: + Result := OpenFolder(PathExtractFileDirFixed(FileName), Application.Handle, True); + vcaExploreSandbox: + Result := OpenFolder(FileName, Application.Handle, True); + vcaProperties, + vcaPropertiesSandbox: + Result := DisplayPropDialog(Application.Handle, FileName); + else + Result := inherited ExecuteAction(FileName, Action); + end; +end; + +function TJclVersionControlSystemPlugin.GetEnabled: Boolean; +begin + Result := True; +end; + +function TJclVersionControlSystemPlugin.GetFileActions( + const FileName: string): TJclVersionControlActions; +begin + Result := [vcaContextMenu, vcaExplore, vcaExploreSandbox, vcaProperties, vcaPropertiesSandbox]; +end; + +function TJclVersionControlSystemPlugin.GetIcon( + const Action: TJclVersionControlAction): Integer; +begin + case Action of + vcaContextMenu: + Result := -1; + vcaExplore, + vcaExploreSandbox: + Result := Expert.CacheResourceIcon('Explorer.exe', 101); + vcaProperties, + vcaPropertiesSandbox: + Result := Expert.CacheResourceIcon('Shell32.dll', 4); + else + Result := inherited GetIcon(Action); + end; +end; + +function TJclVersionControlSystemPlugin.GetName: string; +begin + Result := RsVersionCtrlSystemName; +end; + +function TJclVersionControlSystemPlugin.GetSandboxActions( + const SdBxName: string): TJclVersionControlActions; +begin + Result := [vcaExploreSandbox, vcaPropertiesSandbox]; +end; + +function TJclVersionControlSystemPlugin.GetSandboxNames(const FileName: string; + SdBxNames: TStrings): Boolean; +begin + Result := inherited GetSandboxNames(FileName, SdBxNames); +end; + +function TJclVersionControlSystemPlugin.GetSupportedActions: TJclVersionControlActions; +begin + Result := [vcaContextMenu, vcaExplore, vcaExploreSandbox, vcaProperties, vcaPropertiesSandbox]; +end; + +//=== TJclVersionControlActionsCache ========================================= + +type + TJclVersionControlActionsCache = class (TObject) + private + FSandbox: string; + FActions: TJclVersionControlActions; + public + constructor Create(ASandbox: string; AActions: TJclVersionControlActions); + property Sandbox: string read FSandbox; + property Actions: TJclVersionControlActions read FActions; + end; + +constructor TJclVersionControlActionsCache.Create(ASandbox: string; + AActions: TJclVersionControlActions); +begin + inherited Create; + FSandbox := ASandbox; + FActions := AActions; +end; + +//=== TJclVersionControlCache ================================================ + +constructor TJclVersionControlCache.Create(APlugin: TJclVersionControlPlugin; + AFileName: string); +var + Index: Integer; + SandboxNames: TStrings; +begin + inherited Create; + + FSandboxList := TList.Create; + FFileName := AFileName; + FPlugin := APlugin; + // TODO: cache time validity customization + FValidityTime := Date + 5.0 / SecsPerDay; + 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): string; +begin + Result := TJclVersionControlActionsCache(FSandboxList.Items[Index]).Sandbox; +end; + +function TJclVersionControlCache.GetSandboxAction( + Index: Integer): TJclVersionControlActions; +begin + Result := TJclVersionControlActionsCache(FSandboxList.Items[Index]).Actions; +end; + +function TJclVersionControlCache.GetSandboxCount: Integer; +begin + Result := FSandboxList.Count; +end; + +function TJclVersionControlCache.GetValid(const ATime: TDateTime): Boolean; +begin + Result := (ATime - FValidityTime) < 0; +end; + +initialization + +try + TJclVersionControlExpert.RegisterPluginClass(TJclVersionControlSystemPlugin); +except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; +end; + +finalization + +try + TJclVersionControlExpert.RegisterPluginClass(TJclVersionControlSystemPlugin); + FreeAndNil(ExpertInstanceList); + FreeAndNil(PluginClassList); +except + on ExceptionObj: TObject do + begin + JclExpertShowExceptionDialog(ExceptionObj); + raise; + end; +end; + +// History: + +// $Log: VersionControlImpl.pas,v $ +// Revision 1.8 2006/02/02 08:06:36 elahn +// Add "Explore Folder" to TJclVersionControlSystemPlugin. Change RsVersionCtrlContextMenuCaption to "Context Menu (right-click)". +// +// Revision 1.7 2006/01/25 20:34:38 outchy +// Multiple plugins can be active at the same time. +// New plugin for common (system) actions. +// +// Revision 1.6 2006/01/19 07:58:11 elahn +// Bugfix - ContextMenu not appearing at Mouse.CursorPos +// +// Revision 1.5 2006/01/15 20:58:03 outchy +// Delphi 5 support: no TCustomAction.AutoCheck property +// Removed unused resources +// +// Revision 1.4 2006/01/15 11:33:21 outchy +// cvs support in version control expert +// version control expert integration in the installer +// + +end. diff --git a/official/1.96/help/JCLHELP.HLP b/official/1.96/help/JCLHELP.HLP new file mode 100644 index 0000000..3400d05 Binary files /dev/null and b/official/1.96/help/JCLHELP.HLP differ diff --git a/official/1.96/help/JclHelp.GID b/official/1.96/help/JclHelp.GID new file mode 100644 index 0000000..01cc7cf Binary files /dev/null and b/official/1.96/help/JclHelp.GID differ diff --git a/official/1.96/help/JclHelp.als b/official/1.96/help/JclHelp.als new file mode 100644 index 0000000..5da3af9 --- /dev/null +++ b/official/1.96/help/JclHelp.als @@ -0,0 +1,6640 @@ +ecolorconversionerror +ecolorconversionerror_object +einvalidparam +einvalidparam_object +ejclborradexception +ejclborradexception_object +ejclcliinstructionerror +ejclcliinstructionerror_object +ejclcliinstructionstreaminvalid +ejclcliinstructionstreaminvalid_object +ejclcommandlinetoolerror +ejclcommandlinetoolerror_object +ejclcompressionerror +ejclcompressionerror_object +ejclconcurrentmodificationerror +ejclconcurrentmodificationerror_object +ejclconversionerror +ejclconversionerror_object +ejclcountererror +ejclcountererror_object +ejclcreateprocesserror +ejclcreateprocesserror_object +ejclcriticalsectionerror +ejclcriticalsectionerror_object +ejcldatetimeerror +ejcldatetimeerror_object +ejcldispatcherobjecterror +ejcldispatcherobjecterror_object +ejclerror +ejclerror_object +ejcleventerror +ejcleventerror_object +ejclexprevalerror +ejclexprevalerror_object +ejclfilemappingerror +ejclfilemappingerror_object +ejclfilemappingviewerror +ejclfilemappingviewerror_object +ejclfileutilserror +ejclfileutilserror_object +ejclfileversioninfoerror +ejclfileversioninfoerror_object +ejclgraphicserror +ejclgraphicserror_object +ejclillegalargumenterror +ejclillegalargumenterror_object +ejclillegalstateerror +ejclillegalstateerror_object +ejclinternalerror +ejclinternalerror_object +ejclmapierror +ejclmapierror_errorcode +ejclmapierror_object +ejclmatherror +ejclmatherror_object +ejclmcierror +ejclmcierror_create +ejclmcierror_createfmt +ejclmcierror_createres +ejclmcierror_mcierrormsg +ejclmcierror_mcierrorno +ejclmcierror_object +ejclmetadataerror +ejclmetadataerror_object +ejclmeteredsectionerror +ejclmeteredsectionerror_object +ejclmidierror +ejclmidierror_object +ejclmixererror +ejclmixererror_object +ejclmmtimererror +ejclmmtimererror_object +ejclmutexerror +ejclmutexerror_object +ejclnansignal +ejclnansignal_create +ejclnansignal_object +ejclnansignal_tag +ejclnosuchelementerror +ejclnosuchelementerror_object +ejclntfserror +ejclntfserror_object +ejcloperationnotsupportederror +ejcloperationnotsupportederror_object +ejcloutofboundserror +ejcloutofboundserror_object +ejclpatherror +ejclpatherror_object +ejclpeimageerror +ejclpeimageerror_object +ejclprintererror +ejclprintererror_object +ejclregistryerror +ejclregistryerror_object +ejclrttierror +ejclrttierror_object +ejclsemaphoreerror +ejclsemaphoreerror_object +ejclstatisticserror +ejclstatisticserror_object +ejclstringhashmaperror +ejclstringhashmaperror_object +ejclstructstorageerror +ejclstructstorageerror_object +ejcltempfilestreamerror +ejcltempfilestreamerror_object +ejclunicodeerror +ejclunicodeerror_object +ejclvmterror +ejclvmterror_object +ejclwaitabletimererror +ejclwaitabletimererror_object +ejclwin32error +ejclwin32error_create +ejclwin32error_createfmt +ejclwin32error_createres +ejclwin32error_lasterror +ejclwin32error_lasterrormsg +ejclwin32error_object +ejclwin32handleobjecterror +ejclwin32handleobjecterror_object +epcreerror +epcreerror_createres +epcreerror_errorcode +epcreerror_object +eschedule +eschedule_object +etemperatureconversionerror +etemperatureconversionerror_object +eunitconversionerror +eunitconversionerror_object +ijclarray +ijclarray_getobject +ijclarray_items +ijclarray_object +ijclarray_setobject +ijclbaseinfo +ijclbaseinfo_declarationto +ijclbaseinfo_object +ijclbaseinfo_writeto +ijclclasstypeinfo +ijclclasstypeinfo_classref +ijclclasstypeinfo_getclassref +ijclclasstypeinfo_getparent +ijclclasstypeinfo_getproperties +ijclclasstypeinfo_getpropertycount +ijclclasstypeinfo_getpropnames +ijclclasstypeinfo_gettotalpropertycount +ijclclasstypeinfo_getunitname +ijclclasstypeinfo_object +ijclclasstypeinfo_parent +ijclclasstypeinfo_properties +ijclclasstypeinfo_propertycount +ijclclasstypeinfo_propnames +ijclclasstypeinfo_totalpropertycount +ijclclasstypeinfo_unitname +ijclcloneable +ijclcloneable_clone +ijclcloneable_object +ijclcollection +ijclcollection_add +ijclcollection_addall +ijclcollection_clear +ijclcollection_contains +ijclcollection_containsall +ijclcollection_equals +ijclcollection_first +ijclcollection_isempty +ijclcollection_last +ijclcollection_object +ijclcollection_remove +ijclcollection_removeall +ijclcollection_retainall +ijclcollection_size +ijclcommandlinetool +ijclcommandlinetool_addpathoption +ijclcommandlinetool_execute +ijclcommandlinetool_exename +ijclcommandlinetool_getexename +ijclcommandlinetool_getoptions +ijclcommandlinetool_getoutput +ijclcommandlinetool_getoutputcallback +ijclcommandlinetool_object +ijclcommandlinetool_options +ijclcommandlinetool_output +ijclcommandlinetool_outputcallback +ijclcommandlinetool_setoutputcallback +ijcldailyschedule +ijcldailyschedule_everyweekday +ijcldailyschedule_geteveryweekday +ijcldailyschedule_getinterval +ijcldailyschedule_interval +ijcldailyschedule_object +ijcldailyschedule_seteveryweekday +ijcldailyschedule_setinterval +ijcldynarraytypeinfo +ijcldynarraytypeinfo_elementsize +ijcldynarraytypeinfo_elementsneedcleanup +ijcldynarraytypeinfo_elementtype +ijcldynarraytypeinfo_getelementsize +ijcldynarraytypeinfo_getelementsneedcleanup +ijcldynarraytypeinfo_getelementtype +ijcldynarraytypeinfo_getunitname +ijcldynarraytypeinfo_getvartype +ijcldynarraytypeinfo_object +ijcldynarraytypeinfo_unitname +ijcldynarraytypeinfo_vartype +ijclenumerationtypeinfo +ijclenumerationtypeinfo_basetype +ijclenumerationtypeinfo_getbasetype +ijclenumerationtypeinfo_getnames +ijclenumerationtypeinfo_getunitname +ijclenumerationtypeinfo_indexofname +ijclenumerationtypeinfo_names +ijclenumerationtypeinfo_object +ijclenumerationtypeinfo_unitname +ijcleventparaminfo +ijcleventparaminfo_flags +ijcleventparaminfo_getflags +ijcleventparaminfo_getname +ijcleventparaminfo_getparam +ijcleventparaminfo_getrecsize +ijcleventparaminfo_gettypename +ijcleventparaminfo_name +ijcleventparaminfo_object +ijcleventparaminfo_param +ijcleventparaminfo_recsize +ijcleventparaminfo_typename +ijcleventtypeinfo +ijcleventtypeinfo_getmethodkind +ijcleventtypeinfo_getparametercount +ijcleventtypeinfo_getparameters +ijcleventtypeinfo_getresulttypename +ijcleventtypeinfo_methodkind +ijcleventtypeinfo_object +ijcleventtypeinfo_parametercount +ijcleventtypeinfo_parameters +ijcleventtypeinfo_resulttypename +ijclfileenumerator +ijclfileenumerator_attributemask +ijclfileenumerator_casesensitivesearch +ijclfileenumerator_filemask +ijclfileenumerator_filesizemax +ijclfileenumerator_filesizemin +ijclfileenumerator_filllist +ijclfileenumerator_foreach +ijclfileenumerator_getattributemask +ijclfileenumerator_getcasesensitivesearch +ijclfileenumerator_getfilemask +ijclfileenumerator_getfilemasks +ijclfileenumerator_getfilesizemax +ijclfileenumerator_getfilesizemin +ijclfileenumerator_getincludehiddensubdirectories +ijclfileenumerator_getincludesubdirectories +ijclfileenumerator_getlastchangeafter +ijclfileenumerator_getlastchangeafterstr +ijclfileenumerator_getlastchangebefore +ijclfileenumerator_getlastchangebeforestr +ijclfileenumerator_getonenterdirectory +ijclfileenumerator_getonterminatetask +ijclfileenumerator_getoption +ijclfileenumerator_getoptions +ijclfileenumerator_getrootdirectory +ijclfileenumerator_getrunningtasks +ijclfileenumerator_getsubdirectorymask +ijclfileenumerator_getsynchronizationmode +ijclfileenumerator_includehiddensubdirectories +ijclfileenumerator_includesubdirectories +ijclfileenumerator_lastchangeafter +ijclfileenumerator_lastchangeafterasstring +ijclfileenumerator_lastchangebefore +ijclfileenumerator_lastchangebeforeasstring +ijclfileenumerator_object +ijclfileenumerator_onenterdirectory +ijclfileenumerator_onterminatetask +ijclfileenumerator_rootdirectory +ijclfileenumerator_runningtasks +ijclfileenumerator_setattributemask +ijclfileenumerator_setcasesensitivesearch +ijclfileenumerator_setfilemask +ijclfileenumerator_setfilemasks +ijclfileenumerator_setfilesizemax +ijclfileenumerator_setfilesizemin +ijclfileenumerator_setincludehiddensubdirectories +ijclfileenumerator_setincludesubdirectories +ijclfileenumerator_setlastchangeafter +ijclfileenumerator_setlastchangeafterstr +ijclfileenumerator_setlastchangebefore +ijclfileenumerator_setlastchangebeforestr +ijclfileenumerator_setonenterdirectory +ijclfileenumerator_setonterminatetask +ijclfileenumerator_setoption +ijclfileenumerator_setoptions +ijclfileenumerator_setrootdirectory +ijclfileenumerator_setsubdirectorymask +ijclfileenumerator_setsynchronizationmode +ijclfileenumerator_stopalltasks +ijclfileenumerator_stoptask +ijclfileenumerator_subdirectorymask +ijclfileenumerator_synchronizationmode +ijclfloattypeinfo +ijclfloattypeinfo_floattype +ijclfloattypeinfo_getfloattype +ijclfloattypeinfo_object +ijclinfowriter +ijclinfowriter_getwrap +ijclinfowriter_indent +ijclinfowriter_object +ijclinfowriter_outdent +ijclinfowriter_setwrap +ijclinfowriter_wrap +ijclinfowriter_write +ijclinfowriter_writeln +ijclint64typeinfo +ijclint64typeinfo_getmaxvalue +ijclint64typeinfo_getminvalue +ijclint64typeinfo_maxvalue +ijclint64typeinfo_minvalue +ijclint64typeinfo_object +ijclinterfacetypeinfo +ijclinterfacetypeinfo_flags +ijclinterfacetypeinfo_getflags +ijclinterfacetypeinfo_getguid +ijclinterfacetypeinfo_getparent +ijclinterfacetypeinfo_getpropertycount +ijclinterfacetypeinfo_getunitname +ijclinterfacetypeinfo_guid +ijclinterfacetypeinfo_object +ijclinterfacetypeinfo_parent +ijclinterfacetypeinfo_propertycount +ijclinterfacetypeinfo_unitname +ijclintfarray +ijclintfarray_getobject +ijclintfarray_items +ijclintfarray_object +ijclintfarray_setobject +ijclintfcloneable +ijclintfcloneable_clone +ijclintfcloneable_object +ijclintfcollection +ijclintfcollection_add +ijclintfcollection_addall +ijclintfcollection_clear +ijclintfcollection_contains +ijclintfcollection_containsall +ijclintfcollection_equals +ijclintfcollection_first +ijclintfcollection_isempty +ijclintfcollection_last +ijclintfcollection_object +ijclintfcollection_remove +ijclintfcollection_removeall +ijclintfcollection_retainall +ijclintfcollection_size +ijclintfintfmap +ijclintfintfmap_clear +ijclintfintfmap_containskey +ijclintfintfmap_containsvalue +ijclintfintfmap_equals +ijclintfintfmap_getvalue +ijclintfintfmap_isempty +ijclintfintfmap_keyset +ijclintfintfmap_object +ijclintfintfmap_putall +ijclintfintfmap_putvalue +ijclintfintfmap_remove +ijclintfintfmap_size +ijclintfintfmap_values +ijclintfiterator +ijclintfiterator_add +ijclintfiterator_getobject +ijclintfiterator_hasnext +ijclintfiterator_hasprevious +ijclintfiterator_next +ijclintfiterator_nextindex +ijclintfiterator_object +ijclintfiterator_previous +ijclintfiterator_previousindex +ijclintfiterator_remove +ijclintfiterator_setobject +ijclintflist +ijclintflist_getobject +ijclintflist_indexof +ijclintflist_insert +ijclintflist_insertall +ijclintflist_lastindexof +ijclintflist_object +ijclintflist_remove +ijclintflist_setobject +ijclintflist_sublist +ijclintfqueue +ijclintfqueue_contains +ijclintfqueue_dequeue +ijclintfqueue_empty +ijclintfqueue_enqueue +ijclintfqueue_object +ijclintfqueue_size +ijclintfset +ijclintfset_intersect +ijclintfset_object +ijclintfset_subtract +ijclintfset_union +ijclintfsortedset +ijclintfsortedset_headset +ijclintfsortedset_object +ijclintfsortedset_subset +ijclintfsortedset_tailset +ijclintfstack +ijclintfstack_contains +ijclintfstack_empty +ijclintfstack_object +ijclintfstack_pop +ijclintfstack_push +ijclintfstack_size +ijclintftree +ijclintftree_gettraverseorder +ijclintftree_object +ijclintftree_settraverseorder +ijclintftree_traverseorder +ijcliterator +ijcliterator_add +ijcliterator_getobject +ijcliterator_hasnext +ijcliterator_hasprevious +ijcliterator_next +ijcliterator_nextindex +ijcliterator_object +ijcliterator_previous +ijcliterator_previousindex +ijcliterator_remove +ijcliterator_setobject +ijcllist +ijcllist_getobject +ijcllist_indexof +ijcllist_insert +ijcllist_insertall +ijcllist_items +ijcllist_lastindexof +ijcllist_object +ijcllist_remove +ijcllist_setobject +ijcllist_sublist +ijclmap +ijclmap_clear +ijclmap_containskey +ijclmap_containsvalue +ijclmap_equals +ijclmap_getvalue +ijclmap_isempty +ijclmap_items +ijclmap_keyset +ijclmap_object +ijclmap_putall +ijclmap_putvalue +ijclmap_remove +ijclmap_size +ijclmap_values +ijclmidiout +ijclmidiout_activenotes +ijclmidiout_getmidistatus +ijclmidiout_localcontrol +ijclmidiout_midistatus +ijclmidiout_name +ijclmidiout_noteison +ijclmidiout_object +ijclmidiout_resetallcontrollers +ijclmidiout_runningstatusenabled +ijclmidiout_selectprogram +ijclmidiout_sendbalancechange +ijclmidiout_sendbalancechangehr +ijclmidiout_sendbreathcontrolchange +ijclmidiout_sendbreathcontrolchangehr +ijclmidiout_sendchannelpressure +ijclmidiout_sendchannelvolumechange +ijclmidiout_sendchannelvolumechangehr +ijclmidiout_sendcontrolchange +ijclmidiout_sendcontrolchangehr +ijclmidiout_senddataentry +ijclmidiout_senddataentryhr +ijclmidiout_sendexpressionchange +ijclmidiout_sendexpressionchangehr +ijclmidiout_sendfootcontrollerchange +ijclmidiout_sendfootcontrollerchangehr +ijclmidiout_sendmessage +ijclmidiout_sendmodulationwheelchange +ijclmidiout_sendmodulationwheelchangehr +ijclmidiout_sendnoteoff +ijclmidiout_sendnoteon +ijclmidiout_sendpanchange +ijclmidiout_sendpanchangehr +ijclmidiout_sendpitchwheelchange +ijclmidiout_sendpitchwheelpos +ijclmidiout_sendpolyphonickeypressure +ijclmidiout_sendportamentotimechange +ijclmidiout_sendportamentotimechangehr +ijclmidiout_sendprogramchange +ijclmidiout_sendsinglenotetuningchange +ijclmidiout_sendswitchchange +ijclmidiout_switchactivenotesoff +ijclmidiout_switchallnotesoff +ijclmidiout_switchallsoundoff +ijclmidiout_switchhold2 +ijclmidiout_switchlegato +ijclmidiout_switchlocalcontrol +ijclmidiout_switchmonomodeon +ijclmidiout_switchomnimodeoff +ijclmidiout_switchomnimodeon +ijclmidiout_switchpolymodeon +ijclmidiout_switchportamento +ijclmidiout_switchsoftpedal +ijclmidiout_switchsostenuto +ijclmidiout_switchsustain +ijclmonthlyschedule +ijclmonthlyschedule_day +ijclmonthlyschedule_getday +ijclmonthlyschedule_getindexkind +ijclmonthlyschedule_getindexvalue +ijclmonthlyschedule_getinterval +ijclmonthlyschedule_indexkind +ijclmonthlyschedule_indexvalue +ijclmonthlyschedule_interval +ijclmonthlyschedule_object +ijclmonthlyschedule_setday +ijclmonthlyschedule_setindexkind +ijclmonthlyschedule_setindexvalue +ijclmonthlyschedule_setinterval +ijclmsdossys +ijclmsdossys_autoscan +ijclmsdossys_bootdelay +ijclmsdossys_bootgui +ijclmsdossys_bootkeys +ijclmsdossys_bootmenu +ijclmsdossys_bootmenudefault +ijclmsdossys_bootmenudelay +ijclmsdossys_bootmulti +ijclmsdossys_bootsafe +ijclmsdossys_bootwarn +ijclmsdossys_bootwin +ijclmsdossys_dblspace +ijclmsdossys_doublebuffer +ijclmsdossys_drvspace +ijclmsdossys_getautoscan +ijclmsdossys_getbootdelay +ijclmsdossys_getbootgui +ijclmsdossys_getbootkeys +ijclmsdossys_getbootmenu +ijclmsdossys_getbootmenudefault +ijclmsdossys_getbootmenudelay +ijclmsdossys_getbootmulti +ijclmsdossys_getbootsafe +ijclmsdossys_getbootwarn +ijclmsdossys_getbootwin +ijclmsdossys_getdblspace +ijclmsdossys_getdoublebuffer +ijclmsdossys_getdrvspace +ijclmsdossys_gethostwinbootdrv +ijclmsdossys_getloadtop +ijclmsdossys_getlogo +ijclmsdossys_getnetwork +ijclmsdossys_getuninstalldir +ijclmsdossys_getwinbootdir +ijclmsdossys_getwindir +ijclmsdossys_getwinver +ijclmsdossys_hostwinbootdrv +ijclmsdossys_loadtop +ijclmsdossys_logo +ijclmsdossys_network +ijclmsdossys_object +ijclmsdossys_setautoscan +ijclmsdossys_setbool +ijclmsdossys_setbootdelay +ijclmsdossys_setbootgui +ijclmsdossys_setbootkeys +ijclmsdossys_setbootmenu +ijclmsdossys_setbootmenudefault +ijclmsdossys_setbootmenudelay +ijclmsdossys_setbootmulti +ijclmsdossys_setbootsafe +ijclmsdossys_setbootwarn +ijclmsdossys_setbootwin +ijclmsdossys_setdblspace +ijclmsdossys_setdoublebuffer +ijclmsdossys_setdrvspace +ijclmsdossys_sethostwinbootdrv +ijclmsdossys_setloadtop +ijclmsdossys_setlogo +ijclmsdossys_setnetwork +ijclmsdossys_setstring +ijclmsdossys_setuninstalldir +ijclmsdossys_setwinbootdir +ijclmsdossys_setwindir +ijclmsdossys_setwinver +ijclmsdossys_uninstalldir +ijclmsdossys_winbootdir +ijclmsdossys_windir +ijclmsdossys_winver +ijclmultiintfintfmap +ijclmultiintfintfmap_count +ijclmultiintfintfmap_getvalues +ijclmultiintfintfmap_object +ijclordinalrangetypeinfo +ijclordinalrangetypeinfo_getmaxvalue +ijclordinalrangetypeinfo_getminvalue +ijclordinalrangetypeinfo_maxvalue +ijclordinalrangetypeinfo_minvalue +ijclordinalrangetypeinfo_object +ijclordinaltypeinfo +ijclordinaltypeinfo_getordinaltype +ijclordinaltypeinfo_object +ijclordinaltypeinfo_ordinaltype +ijclpropinfo +ijclpropinfo_default +ijclpropinfo_getdefault +ijclpropinfo_getindex +ijclpropinfo_getname +ijclpropinfo_getnameindex +ijclpropinfo_getproptype +ijclpropinfo_getreader +ijclpropinfo_getreadertype +ijclpropinfo_getreadervalue +ijclpropinfo_getstoredproc +ijclpropinfo_getstoredtype +ijclpropinfo_getstoredvalue +ijclpropinfo_getwriter +ijclpropinfo_getwritertype +ijclpropinfo_getwritervalue +ijclpropinfo_hasdefault +ijclpropinfo_hasindex +ijclpropinfo_index +ijclpropinfo_isstored +ijclpropinfo_name +ijclpropinfo_nameindex +ijclpropinfo_object +ijclpropinfo_proptype +ijclpropinfo_reader +ijclpropinfo_readertype +ijclpropinfo_readervalue +ijclpropinfo_storedproc +ijclpropinfo_storedtype +ijclpropinfo_storedvalue +ijclpropinfo_writer +ijclpropinfo_writertype +ijclpropinfo_writervalue +ijclqueue +ijclqueue_contains +ijclqueue_dequeue +ijclqueue_empty +ijclqueue_enqueue +ijclqueue_object +ijclqueue_size +ijclschedule +ijclschedule_daycount +ijclschedule_endcount +ijclschedule_enddate +ijclschedule_endtype +ijclschedule_getendcount +ijclschedule_getenddate +ijclschedule_getendtype +ijclschedule_getrecurringtype +ijclschedule_getstartdate +ijclschedule_inittosavedstate +ijclschedule_lasttriggered +ijclschedule_nextevent +ijclschedule_nexteventfrom +ijclschedule_nexteventfromnow +ijclschedule_object +ijclschedule_recurringtype +ijclschedule_reset +ijclschedule_setendcount +ijclschedule_setenddate +ijclschedule_setendtype +ijclschedule_setrecurringtype +ijclschedule_setstartdate +ijclschedule_startdate +ijclschedule_triggercount +ijclscheduledayfrequency +ijclscheduledayfrequency_endtime +ijclscheduledayfrequency_getendtime +ijclscheduledayfrequency_getinterval +ijclscheduledayfrequency_getstarttime +ijclscheduledayfrequency_interval +ijclscheduledayfrequency_object +ijclscheduledayfrequency_setendtime +ijclscheduledayfrequency_setinterval +ijclscheduledayfrequency_setstarttime +ijclscheduledayfrequency_starttime +ijclscreentextattribute +ijclscreentextattribute_bgcolor +ijclscreentextattribute_bghighlight +ijclscreentextattribute_color +ijclscreentextattribute_getbgcolor +ijclscreentextattribute_getbghighlight +ijclscreentextattribute_getcolor +ijclscreentextattribute_gethighlight +ijclscreentextattribute_getstyle +ijclscreentextattribute_gettextattribute +ijclscreentextattribute_highlight +ijclscreentextattribute_object +ijclscreentextattribute_setbgcolor +ijclscreentextattribute_setbghighlight +ijclscreentextattribute_setcolor +ijclscreentextattribute_sethighlight +ijclscreentextattribute_setstyle +ijclscreentextattribute_settextattribute +ijclscreentextattribute_style +ijclscreentextattribute_textattribute +ijclset +ijclset_intersect +ijclset_object +ijclset_subtract +ijclset_union +ijclsettypeinfo +ijclsettypeinfo_basetype +ijclsettypeinfo_getaslist +ijclsettypeinfo_getbasetype +ijclsettypeinfo_object +ijclsettypeinfo_setaslist +ijclsortedmap +ijclsortedmap_firstkey +ijclsortedmap_headmap +ijclsortedmap_lastkey +ijclsortedmap_object +ijclsortedmap_submap +ijclsortedmap_tailmap +ijclsortedset +ijclsortedset_headset +ijclsortedset_object +ijclsortedset_subset +ijclsortedset_tailset +ijclstack +ijclstack_contains +ijclstack_empty +ijclstack_object +ijclstack_pop +ijclstack_push +ijclstack_size +ijclstrarray +ijclstrarray_getstring +ijclstrarray_items +ijclstrarray_object +ijclstrarray_setstring +ijclstrcollection +ijclstrcollection_add +ijclstrcollection_addall +ijclstrcollection_appenddelimited +ijclstrcollection_appendfromstrings +ijclstrcollection_appendtostrings +ijclstrcollection_clear +ijclstrcollection_contains +ijclstrcollection_containsall +ijclstrcollection_equals +ijclstrcollection_first +ijclstrcollection_getasdelimited +ijclstrcollection_getasstrings +ijclstrcollection_isempty +ijclstrcollection_last +ijclstrcollection_loaddelimited +ijclstrcollection_loadfromstrings +ijclstrcollection_object +ijclstrcollection_remove +ijclstrcollection_removeall +ijclstrcollection_retainall +ijclstrcollection_savetostrings +ijclstrcollection_size +ijclstringtypeinfo +ijclstringtypeinfo_getmaxlength +ijclstringtypeinfo_maxlength +ijclstringtypeinfo_object +ijclstrintfmap +ijclstrintfmap_clear +ijclstrintfmap_containskey +ijclstrintfmap_containsvalue +ijclstrintfmap_equals +ijclstrintfmap_getvalue +ijclstrintfmap_isempty +ijclstrintfmap_keyset +ijclstrintfmap_object +ijclstrintfmap_putall +ijclstrintfmap_putvalue +ijclstrintfmap_remove +ijclstrintfmap_size +ijclstrintfmap_values +ijclstriterator +ijclstriterator_add +ijclstriterator_getstring +ijclstriterator_hasnext +ijclstriterator_hasprevious +ijclstriterator_next +ijclstriterator_nextindex +ijclstriterator_object +ijclstriterator_previous +ijclstriterator_previousindex +ijclstriterator_remove +ijclstriterator_setstring +ijclstrlist +ijclstrlist_getstring +ijclstrlist_indexof +ijclstrlist_insert +ijclstrlist_insertall +ijclstrlist_items +ijclstrlist_lastindexof +ijclstrlist_object +ijclstrlist_remove +ijclstrlist_setstring +ijclstrlist_sublist +ijclstrmap +ijclstrmap_clear +ijclstrmap_containskey +ijclstrmap_containsvalue +ijclstrmap_equals +ijclstrmap_getvalue +ijclstrmap_isempty +ijclstrmap_items +ijclstrmap_keyset +ijclstrmap_object +ijclstrmap_putall +ijclstrmap_putvalue +ijclstrmap_remove +ijclstrmap_size +ijclstrmap_values +ijclstrqueue +ijclstrqueue_contains +ijclstrqueue_dequeue +ijclstrqueue_empty +ijclstrqueue_enqueue +ijclstrqueue_object +ijclstrqueue_size +ijclstrset +ijclstrset_intersect +ijclstrset_object +ijclstrset_subtract +ijclstrset_union +ijclstrstack +ijclstrstack_contains +ijclstrstack_empty +ijclstrstack_object +ijclstrstack_pop +ijclstrstack_push +ijclstrstack_size +ijclstrstrmap +ijclstrstrmap_clear +ijclstrstrmap_containskey +ijclstrstrmap_containsvalue +ijclstrstrmap_equals +ijclstrstrmap_getvalue +ijclstrstrmap_isempty +ijclstrstrmap_items +ijclstrstrmap_keyofvalue +ijclstrstrmap_keyset +ijclstrstrmap_object +ijclstrstrmap_putall +ijclstrstrmap_putvalue +ijclstrstrmap_remove +ijclstrstrmap_size +ijclstrstrmap_values +ijclstrstrsortedmap +ijclstrstrsortedmap_firstkey +ijclstrstrsortedmap_headmap +ijclstrstrsortedmap_lastkey +ijclstrstrsortedmap_object +ijclstrstrsortedmap_submap +ijclstrstrsortedmap_tailmap +ijclstrtree +ijclstrtree_gettraverseorder +ijclstrtree_object +ijclstrtree_settraverseorder +ijclstrtree_traverseorder +ijcltree +ijcltree_gettraverseorder +ijcltree_object +ijcltree_settraverseorder +ijcltree_traverseorder +ijcltypeinfo +ijcltypeinfo_getname +ijcltypeinfo_gettypedata +ijcltypeinfo_gettypeinfo +ijcltypeinfo_gettypekind +ijcltypeinfo_name +ijcltypeinfo_object +ijcltypeinfo_typedata +ijcltypeinfo_typeinfo +ijcltypeinfo_typekind +ijclweeklyschedule +ijclweeklyschedule_daysofweek +ijclweeklyschedule_getdaysofweek +ijclweeklyschedule_getinterval +ijclweeklyschedule_interval +ijclweeklyschedule_object +ijclweeklyschedule_setdaysofweek +ijclweeklyschedule_setinterval +ijclwinmidiout +ijclwinmidiout_channelvolume +ijclwinmidiout_getchannelvolume +ijclwinmidiout_getvolume +ijclwinmidiout_object +ijclwinmidiout_setchannelvolume +ijclwinmidiout_setvolume +ijclwinmidiout_volume +ijclyearlyschedule +ijclyearlyschedule_day +ijclyearlyschedule_getday +ijclyearlyschedule_getindexkind +ijclyearlyschedule_getindexvalue +ijclyearlyschedule_getinterval +ijclyearlyschedule_getmonth +ijclyearlyschedule_indexkind +ijclyearlyschedule_indexvalue +ijclyearlyschedule_interval +ijclyearlyschedule_month +ijclyearlyschedule_object +ijclyearlyschedule_setday +ijclyearlyschedule_setindexkind +ijclyearlyschedule_setindexvalue +ijclyearlyschedule_setinterval +ijclyearlyschedule_setmonth +imultisafeguard +imultisafeguard_additem +imultisafeguard_count +imultisafeguard_freeitem +imultisafeguard_getcount +imultisafeguard_getitem +imultisafeguard_items +imultisafeguard_object +imultisafeguard_releaseitem +isafeguard +isafeguard_freeitem +isafeguard_getitem +isafeguard_item +isafeguard_object +isafeguard_releaseitem +itablecandumpil +itablecandumpil_object +tcaseinsensitivetraits +tcaseinsensitivetraits_compare +tcaseinsensitivetraits_hash +tcaseinsensitivetraits_object +tcasesensitivetraits +tcasesensitivetraits_compare +tcasesensitivetraits_hash +tcasesensitivetraits_object +tcompiledevaluator +tcompiledevaluator_compile +tcompiledevaluator_create +tcompiledevaluator_destroy +tcompiledevaluator_evaluate +tcompiledevaluator_object +tcustomunitversioningprovider +tcustomunitversioningprovider_create +tcustomunitversioningprovider_loadmoduleunitversioninginfo +tcustomunitversioningprovider_object +tcustomunitversioningprovider_releasemoduleunitversioninginfo +teasyevaluator +teasyevaluator_addconst +teasyevaluator_addfunc +teasyevaluator_addvar +teasyevaluator_clear +teasyevaluator_create +teasyevaluator_destroy +teasyevaluator_extcontextset +teasyevaluator_internalcontextset +teasyevaluator_object +teasyevaluator_remove +tedi_ansix12_document +tedi_ansix12_document_addlooptodoc +tedi_ansix12_document_advancesegspecindex +tedi_ansix12_document_create +tedi_ansix12_document_destroy +tedi_ansix12_document_editsdoptions +tedi_ansix12_document_erroroccured +tedi_ansix12_document_fediloopstack +tedi_ansix12_document_feditransactionset +tedi_ansix12_document_feditransactionsetspec +tedi_ansix12_document_feditsdoptions +tedi_ansix12_document_ferroroccured +tedi_ansix12_document_formatdocument +tedi_ansix12_document_object +tedi_ansix12_document_setspecificationpointers +tedi_ansix12_document_validatedata +tedi_ansix12_document_validatesegspecindex +tedi_unedifact_document +tedi_unedifact_document_addlooptodoc +tedi_unedifact_document_advancesegspecindex +tedi_unedifact_document_create +tedi_unedifact_document_destroy +tedi_unedifact_document_editsdoptions +tedi_unedifact_document_erroroccured +tedi_unedifact_document_fediloopstack +tedi_unedifact_document_fedimessage +tedi_unedifact_document_fedimessagespec +tedi_unedifact_document_feditsdoptions +tedi_unedifact_document_ferroroccured +tedi_unedifact_document_formatdocument +tedi_unedifact_document_object +tedi_unedifact_document_setspecificationpointers +tedi_unedifact_document_validatedata +tedi_unedifact_document_validatesegspecindex +tedicompositeelement +tedicompositeelement_addelement +tedicompositeelement_addelements +tedicompositeelement_appendelement +tedicompositeelement_appendelements +tedicompositeelement_assemble +tedicompositeelement_create +tedicompositeelement_deleteelement +tedicompositeelement_deleteelements +tedicompositeelement_destroy +tedicompositeelement_disassemble +tedicompositeelement_element +tedicompositeelement_elements +tedicompositeelement_insertelement +tedicompositeelement_insertelements +tedicompositeelement_internalassigndelimiters +tedicompositeelement_internalcreateedidataobject +tedicompositeelement_internalcreateelement +tedicompositeelement_object +tedidataobject +tedidataobject_assemble +tedidataobject_create +tedidataobject_customdata1 +tedidataobject_customdata2 +tedidataobject_data +tedidataobject_datalength +tedidataobject_delimiters +tedidataobject_destroy +tedidataobject_disassemble +tedidataobject_fcustomdata1 +tedidataobject_fcustomdata2 +tedidataobject_fdata +tedidataobject_fdelimiters +tedidataobject_fedidot +tedidataobject_ferrorlog +tedidataobject_flength +tedidataobject_fparent +tedidataobject_fspecpointer +tedidataobject_fstate +tedidataobject_getdata +tedidataobject_object +tedidataobject_parent +tedidataobject_setdata +tedidataobject_specpointer +tedidataobject_state +tedidataobjectgroup +tedidataobjectgroup_addedidataobject +tedidataobjectgroup_addedidataobjects +tedidataobjectgroup_appendedidataobject +tedidataobjectgroup_appendedidataobjects +tedidataobjectgroup_create +tedidataobjectgroup_createobjecttype +tedidataobjectgroup_deleteedidataobject +tedidataobjectgroup_deleteedidataobjects +tedidataobjectgroup_destroy +tedidataobjectgroup_edidataobject +tedidataobjectgroup_edidataobjectcount +tedidataobjectgroup_edidataobjects +tedidataobjectgroup_fcreateobjecttype +tedidataobjectgroup_fedidataobjects +tedidataobjectgroup_fgroupisparent +tedidataobjectgroup_getcount +tedidataobjectgroup_getedidataobject +tedidataobjectgroup_getindexpositionfromparent +tedidataobjectgroup_indexisvalid +tedidataobjectgroup_insertedidataobject +tedidataobjectgroup_insertedidataobjects +tedidataobjectgroup_internalassigndelimiters +tedidataobjectgroup_internalcreateedidataobject +tedidataobjectgroup_object +tedidataobjectgroup_setedidataobject +tedidataobjectlist +tedidataobjectlist_createlistitem +tedidataobjectlist_edidataobject +tedidataobjectlist_object +tedidataobjectlistitem +tedidataobjectlistitem_edidataobject +tedidataobjectlistitem_object +tedidelimiters +tedidelimiters_create +tedidelimiters_ed +tedidelimiters_edlen +tedidelimiters_object +tedidelimiters_sd +tedidelimiters_sdlen +tedidelimiters_ss +tedidelimiters_sslen +tedielement +tedielement_assemble +tedielement_create +tedielement_disassemble +tedielement_getindexpositionfromparent +tedielement_object +tedielementspec +tedielementspec_assemble +tedielementspec_create +tedielementspec_description +tedielementspec_destroy +tedielementspec_disassemble +tedielementspec_elementid +tedielementspec_elementtype +tedielementspec_id +tedielementspec_maximumlength +tedielementspec_minimumlength +tedielementspec_notes +tedielementspec_object +tedielementspec_position +tedielementspec_requirementdesignator +tedielementspec_reserveddata +tedifile +tedifile_addinterchange +tedifile_addinterchanges +tedifile_appendinterchange +tedifile_appendinterchanges +tedifile_assemble +tedifile_create +tedifile_deleteinterchange +tedifile_deleteinterchanges +tedifile_destroy +tedifile_disassemble +tedifile_fileid +tedifile_filename +tedifile_insertinterchange +tedifile_insertinterchanges +tedifile_interchange +tedifile_interchangecontrolcount +tedifile_interchanges +tedifile_internalalternatedelimitersdetection +tedifile_internalassigndelimiters +tedifile_internalcreateedidataobject +tedifile_internalcreateinterchangecontrol +tedifile_internaldelimitersdetection +tedifile_loadfromfile +tedifile_object +tedifile_options +tedifile_reloadfromfile +tedifile_saveastofile +tedifile_savetofile +tedifilespec +tedifilespec_create +tedifilespec_findfunctionalgroupspec +tedifilespec_findinterchangecontrolspec +tedifilespec_findtransactionsetspec +tedifilespec_internalcreateinterchangecontrol +tedifilespec_internaldelimitersdetection +tedifilespec_object +tedifunctionalgroup +tedifunctionalgroup_addmessage +tedifunctionalgroup_addmessages +tedifunctionalgroup_appendmessage +tedifunctionalgroup_appendmessages +tedifunctionalgroup_assemble +tedifunctionalgroup_create +tedifunctionalgroup_deletemessage +tedifunctionalgroup_deletemessages +tedifunctionalgroup_destroy +tedifunctionalgroup_disassemble +tedifunctionalgroup_insertmessage +tedifunctionalgroup_insertmessages +tedifunctionalgroup_internalassigndelimiters +tedifunctionalgroup_internalcreateedidataobject +tedifunctionalgroup_internalcreateheadertrailersegments +tedifunctionalgroup_internalcreatemessage +tedifunctionalgroup_message +tedifunctionalgroup_messagecount +tedifunctionalgroup_messages +tedifunctionalgroup_object +tedifunctionalgroup_segmentune +tedifunctionalgroup_segmentung +tedifunctionalgroupsegment +tedifunctionalgroupsegment_create +tedifunctionalgroupsegment_internalassigndelimiters +tedifunctionalgroupsegment_object +tedifunctionalgroupsegmentgsspec +tedifunctionalgroupsegmentgsspec_assemblereserveddata +tedifunctionalgroupsegmentgsspec_create +tedifunctionalgroupsegmentgsspec_disassemblereserveddata +tedifunctionalgroupsegmentgsspec_object +tedifunctionalgroupsegmentspec +tedifunctionalgroupsegmentspec_create +tedifunctionalgroupsegmentspec_internalassigndelimiters +tedifunctionalgroupsegmentspec_object +tedifunctionalgroupspec +tedifunctionalgroupspec_agencycodeid +tedifunctionalgroupspec_fgdescription +tedifunctionalgroupspec_findtransactionsetspec +tedifunctionalgroupspec_functionalgroupid +tedifunctionalgroupspec_id +tedifunctionalgroupspec_internalcreateheadertrailersegments +tedifunctionalgroupspec_internalcreatetransactionset +tedifunctionalgroupspec_object +tedifunctionalgroupspec_versionreleaseid +tediinterchangecontrol +tediinterchangecontrol_addfunctionalgroup +tediinterchangecontrol_addfunctionalgroups +tediinterchangecontrol_addmessage +tediinterchangecontrol_addmessages +tediinterchangecontrol_appendfunctionalgroup +tediinterchangecontrol_appendfunctionalgroups +tediinterchangecontrol_appendmessage +tediinterchangecontrol_appendmessages +tediinterchangecontrol_assemble +tediinterchangecontrol_create +tediinterchangecontrol_destroy +tediinterchangecontrol_disassemble +tediinterchangecontrol_fcreateobjecttype +tediinterchangecontrol_insertfunctionalgroup +tediinterchangecontrol_insertfunctionalgroups +tediinterchangecontrol_insertmessage +tediinterchangecontrol_insertmessages +tediinterchangecontrol_internalassigndelimiters +tediinterchangecontrol_internalcreateedidataobject +tediinterchangecontrol_internalcreatefunctionalgroup +tediinterchangecontrol_internalcreateheadertrailersegments +tediinterchangecontrol_internalcreatemessage +tediinterchangecontrol_object +tediinterchangecontrol_segmentuna +tediinterchangecontrol_segmentunb +tediinterchangecontrol_segmentunz +tediinterchangecontrolsegment +tediinterchangecontrolsegment_create +tediinterchangecontrolsegment_internalassigndelimiters +tediinterchangecontrolsegment_object +tediinterchangecontrolsegmentisaspec +tediinterchangecontrolsegmentisaspec_assemble +tediinterchangecontrolsegmentisaspec_assemblereserveddata +tediinterchangecontrolsegmentisaspec_create +tediinterchangecontrolsegmentisaspec_disassemble +tediinterchangecontrolsegmentisaspec_disassemblereserveddata +tediinterchangecontrolsegmentisaspec_object +tediinterchangecontrolsegmentspec +tediinterchangecontrolsegmentspec_create +tediinterchangecontrolsegmentspec_internalassigndelimiters +tediinterchangecontrolsegmentspec_object +tediinterchangecontrolspec +tediinterchangecontrolspec_findfunctionalgroupspec +tediinterchangecontrolspec_findtransactionsetspec +tediinterchangecontrolspec_icdescription +tediinterchangecontrolspec_internalcreatefunctionalgroup +tediinterchangecontrolspec_internalcreateheadertrailersegments +tediinterchangecontrolspec_object +tediinterchangecontrolspec_standardid +tediinterchangecontrolspec_versionid +tediloopstack +tediloopstack_create +tediloopstack_debug +tediloopstack_destroy +tediloopstack_doaddloop +tediloopstack_fcheckassignedediobject +tediloopstack_fflags +tediloopstack_flags +tediloopstack_fonaddloop +tediloopstack_fstack +tediloopstack_getsafestackindex +tediloopstack_object +tediloopstack_onaddloop +tediloopstack_peek +tediloopstack_pop +tediloopstack_push +tediloopstack_setstackpointer +tediloopstack_size +tediloopstack_stack +tediloopstack_updatestackdata +tediloopstack_updatestackobject +tediloopstack_validateloopstack +tedimessage +tedimessage_addsegment +tedimessage_addsegments +tedimessage_appendsegment +tedimessage_appendsegments +tedimessage_assemble +tedimessage_create +tedimessage_deletesegment +tedimessage_deletesegments +tedimessage_destroy +tedimessage_disassemble +tedimessage_insertsegment +tedimessage_insertsegments +tedimessage_internalassigndelimiters +tedimessage_internalcreateedidataobject +tedimessage_internalcreateheadertrailersegments +tedimessage_internalcreatesegment +tedimessage_object +tedimessage_segment +tedimessage_segmentcount +tedimessage_segments +tedimessage_segmentunh +tedimessage_segmentunt +tedimessageloop +tedimessageloop_addloop +tedimessageloop_appendsegment +tedimessageloop_assemble +tedimessageloop_create +tedimessageloop_deleteedidataobjects +tedimessageloop_destroy +tedimessageloop_disassemble +tedimessageloop_findloop +tedimessageloop_findsegment +tedimessageloop_fownerloopid +tedimessageloop_fparentloopid +tedimessageloop_fparentmessage +tedimessageloop_internalassigndelimiters +tedimessageloop_internalcreateedidataobject +tedimessageloop_object +tedimessageloop_ownerloopid +tedimessageloop_parentloopid +tedimessageloop_parentmessage +tedimessagesegment +tedimessagesegment_create +tedimessagesegment_internalassigndelimiters +tedimessagesegment_object +tediobject +tediobject_object +tediobjectlist +tediobjectlist_add +tediobjectlist_clear +tediobjectlist_count +tediobjectlist_create +tediobjectlist_createlistitem +tediobjectlist_currentitem +tediobjectlist_delete +tediobjectlist_destroy +tediobjectlist_ediobject +tediobjectlist_extract +tediobjectlist_fcount +tediobjectlist_fcurrentitem +tediobjectlist_ffirstitem +tediobjectlist_find +tediobjectlist_findediobject +tediobjectlist_finditembyname +tediobjectlist_first +tediobjectlist_flastitem +tediobjectlist_foptions +tediobjectlist_fownsobjects +tediobjectlist_getediobject +tediobjectlist_indexisvalid +tediobjectlist_indexof +tediobjectlist_insert +tediobjectlist_item +tediobjectlist_last +tediobjectlist_next +tediobjectlist_object +tediobjectlist_options +tediobjectlist_ownsobjects +tediobjectlist_prior +tediobjectlist_remove +tediobjectlist_returnlistitemsbyname +tediobjectlist_setediobject +tediobjectlist_updatecount +tediobjectlist_updateindexes +tediobjectlistitem +tediobjectlistitem_create +tediobjectlistitem_destroy +tediobjectlistitem_ediobject +tediobjectlistitem_fediobject +tediobjectlistitem_fitemindex +tediobjectlistitem_fname +tediobjectlistitem_fnextitem +tediobjectlistitem_fparent +tediobjectlistitem_fprioritem +tediobjectlistitem_freeandniledidataobject +tediobjectlistitem_getindexpositionfromparent +tediobjectlistitem_itemindex +tediobjectlistitem_name +tediobjectlistitem_nextitem +tediobjectlistitem_object +tediobjectlistitem_parent +tediobjectlistitem_prioritem +tedisefcompositeelement +tedisefcompositeelement_addrepeatingpattern +tedisefcompositeelement_addsubelement +tedisefcompositeelement_appendrepeatingpattern +tedisefcompositeelement_appendsubelement +tedisefcompositeelement_assemble +tedisefcompositeelement_assign +tedisefcompositeelement_assignelementordinals +tedisefcompositeelement_bindtextsets +tedisefcompositeelement_clone +tedisefcompositeelement_compositeelementid +tedisefcompositeelement_create +tedisefcompositeelement_deleterepeatingpattern +tedisefcompositeelement_deletesubelement +tedisefcompositeelement_destroy +tedisefcompositeelement_disassemble +tedisefcompositeelement_elements +tedisefcompositeelement_extractrepeatingpattern +tedisefcompositeelement_extractsubelement +tedisefcompositeelement_getelementobjectlist +tedisefcompositeelement_gettextsetslocation +tedisefcompositeelement_insertrepeatingpattern +tedisefcompositeelement_insertsubelement +tedisefcompositeelement_object +tedisefcompositeelement_ordinal +tedisefcompositeelement_outofsequenceordinal +tedisefcompositeelement_repeatcount +tedisefcompositeelement_requirementdesignator +tedisefcompositeelement_textsets +tedisefcompositeelement_textsetslocation +tedisefcompositeelement_userattribute +tedisefdataobject +tedisefdataobject_assemble +tedisefdataobject_clone +tedisefdataobject_create +tedisefdataobject_data +tedisefdataobject_datalength +tedisefdataobject_destroy +tedisefdataobject_disassemble +tedisefdataobject_fdata +tedisefdataobject_ferrorlog +tedisefdataobject_fid +tedisefdataobject_flength +tedisefdataobject_fowneritemref +tedisefdataobject_fparent +tedisefdataobject_fseffile +tedisefdataobject_fstate +tedisefdataobject_getdata +tedisefdataobject_id +tedisefdataobject_object +tedisefdataobject_owneritemref +tedisefdataobject_parent +tedisefdataobject_seffile +tedisefdataobject_setdata +tedisefdataobject_setparent +tedisefdataobject_state +tedisefdataobject_updateowneritemname +tedisefdataobjectgroup +tedisefdataobjectgroup_create +tedisefdataobjectgroup_destroy +tedisefdataobjectgroup_edisefdataobject +tedisefdataobjectgroup_edisefdataobjectcount +tedisefdataobjectgroup_edisefdataobjects +tedisefdataobjectgroup_fedisefdataobjects +tedisefdataobjectgroup_object +tedisefdataobjectlist +tedisefdataobjectlist_add +tedisefdataobjectlist_createlistitem +tedisefdataobjectlist_edisefdataobject +tedisefdataobjectlist_finditembyname +tedisefdataobjectlist_first +tedisefdataobjectlist_getobjectbyitembyname +tedisefdataobjectlist_insert +tedisefdataobjectlist_last +tedisefdataobjectlist_next +tedisefdataobjectlist_object +tedisefdataobjectlist_prior +tedisefdataobjectlistitem +tedisefdataobjectlistitem_edisefdataobject +tedisefdataobjectlistitem_linktoobject +tedisefdataobjectlistitem_nextitem +tedisefdataobjectlistitem_object +tedisefdataobjectlistitem_prioritem +tedisefdataobjectlistitem_updatename +tedisefelement +tedisefelement_assemble +tedisefelement_assign +tedisefelement_bindtextsets +tedisefelement_clone +tedisefelement_cloneassubelement +tedisefelement_create +tedisefelement_destroy +tedisefelement_disassemble +tedisefelement_elementid +tedisefelement_elementtype +tedisefelement_fediseftextsets +tedisefelement_felementtype +tedisefelement_fmaximumlength +tedisefelement_fminimumlength +tedisefelement_fordinal +tedisefelement_foutofsequenceordinal +tedisefelement_frepeatcount +tedisefelement_frequirementdesignator +tedisefelement_fuserattribute +tedisefelement_gettextsetslocation +tedisefelement_maximumlength +tedisefelement_minimumlength +tedisefelement_object +tedisefelement_ordinal +tedisefelement_outofsequenceordinal +tedisefelement_repeatcount +tedisefelement_requirementdesignator +tedisefelement_textsets +tedisefelement_textsetslocation +tedisefelement_userattribute +tediseffile +tediseffile_assemble +tediseffile_clone +tediseffile_codes +tediseffile_coms +tediseffile_create +tediseffile_destroy +tediseffile_disassemble +tediseffile_elms +tediseffile_filename +tediseffile_ini +tediseffile_loadfromfile +tediseffile_object +tediseffile_savetofile +tediseffile_segs +tediseffile_sets +tediseffile_std +tediseffile_textsets +tediseffile_unload +tediseffile_ver +tedisefloop +tedisefloop_addloop +tedisefloop_addsegment +tedisefloop_appendloop +tedisefloop_appendsegment +tedisefloop_assemble +tedisefloop_clone +tedisefloop_create +tedisefloop_deleteloop +tedisefloop_deletesegment +tedisefloop_destroy +tedisefloop_disassemble +tedisefloop_extractloop +tedisefloop_extractsegment +tedisefloop_insertloop +tedisefloop_insertsegment +tedisefloop_loopid +tedisefloop_maximumrepeat +tedisefloop_object +tedisefloop_parentloopid +tedisefloop_parentset +tedisefloop_parenttable +tedisefobject +tedisefobject_object +tedisefrepeatingpattern +tedisefrepeatingpattern_addrepeatingpattern +tedisefrepeatingpattern_appendrepeatingpattern +tedisefrepeatingpattern_assemble +tedisefrepeatingpattern_baseparent +tedisefrepeatingpattern_clone +tedisefrepeatingpattern_create +tedisefrepeatingpattern_deleterepeatingpattern +tedisefrepeatingpattern_destroy +tedisefrepeatingpattern_disassemble +tedisefrepeatingpattern_extractrepeatingpattern +tedisefrepeatingpattern_insertrepeatingpattern +tedisefrepeatingpattern_object +tedisefrepeatingpattern_repeatcount +tedisefrepeatingpattern_setparent +tedisefsegment +tedisefsegment_addcompositeelement +tedisefsegment_addelement +tedisefsegment_addrepeatingpattern +tedisefsegment_appendcompositeelement +tedisefsegment_appendelement +tedisefsegment_appendrepeatingpattern +tedisefsegment_assemble +tedisefsegment_assign +tedisefsegment_assignelementordinals +tedisefsegment_bindelementtextsets +tedisefsegment_bindtextsets +tedisefsegment_clone +tedisefsegment_create +tedisefsegment_deletecompositeelement +tedisefsegment_deleteelement +tedisefsegment_deleterepeatingpattern +tedisefsegment_destroy +tedisefsegment_disassemble +tedisefsegment_elements +tedisefsegment_extractcompositeelement +tedisefsegment_extractelement +tedisefsegment_extractrepeatingpattern +tedisefsegment_getelementobjectlist +tedisefsegment_gettextsetslocation +tedisefsegment_insertcompositeelement +tedisefsegment_insertelement +tedisefsegment_insertrepeatingpattern +tedisefsegment_maximumuse +tedisefsegment_object +tedisefsegment_ordinal +tedisefsegment_outofsequenceordinal +tedisefsegment_ownerloopid +tedisefsegment_parentloopid +tedisefsegment_parentset +tedisefsegment_parenttable +tedisefsegment_position +tedisefsegment_positionincrement +tedisefsegment_requirementdesignator +tedisefsegment_resetpositioninc +tedisefsegment_segmentid +tedisefsegment_textsets +tedisefsegment_textsetslocation +tedisefsegment_userattribute +tedisefset +tedisefset_addtable +tedisefset_appendtable +tedisefset_assemble +tedisefset_assignsegmentordinals +tedisefset_assignsegmentpositions +tedisefset_bindsegmenttextsets +tedisefset_bindtextsets +tedisefset_clone +tedisefset_create +tedisefset_deletetable +tedisefset_destroy +tedisefset_disassemble +tedisefset_extracttable +tedisefset_getsegmentobjectlist +tedisefset_gettextsetslocation +tedisefset_inserttable +tedisefset_object +tedisefset_table +tedisefset_tables +tedisefset_textsets +tedisefset_textsetslocation +tedisefsubelement +tedisefsubelement_assemble +tedisefsubelement_clone +tedisefsubelement_create +tedisefsubelement_destroy +tedisefsubelement_disassemble +tedisefsubelement_object +tediseftable +tediseftable_addloop +tediseftable_addsegment +tediseftable_appendloop +tediseftable_appendsegment +tediseftable_assemble +tediseftable_clone +tediseftable_create +tediseftable_deleteloop +tediseftable_deletesegment +tediseftable_destroy +tediseftable_disassemble +tediseftable_extractloop +tediseftable_extractsegment +tediseftable_insertloop +tediseftable_insertsegment +tediseftable_object +tediseftable_sefset +tediseftext +tediseftext_assemble +tediseftext_create +tediseftext_data +tediseftext_description +tediseftext_destroy +tediseftext_disassemble +tediseftext_fdata +tediseftext_fedisefwheretype +tediseftext_ftext +tediseftext_fwhat +tediseftext_fwhere +tediseftext_getdata +tediseftext_object +tediseftext_setdata +tediseftext_text +tediseftext_what +tediseftext_where +tediseftext_wherelocation +tediseftextset +tediseftextset_assemble +tediseftextset_create +tediseftextset_destroy +tediseftextset_disassemble +tediseftextset_object +tediseftextsets +tediseftextsets_gettext +tediseftextsets_object +tediseftextsets_settext +tediseftospectranslator +tediseftospectranslator_create +tediseftospectranslator_destroy +tediseftospectranslator_object +tedisegment +tedisegment_addcompositeelement +tedisegment_addcompositeelements +tedisegment_addelement +tedisegment_addelements +tedisegment_appendcompositeelement +tedisegment_appendcompositeelements +tedisegment_appendelement +tedisegment_appendelements +tedisegment_assemble +tedisegment_create +tedisegment_deleteelement +tedisegment_deleteelements +tedisegment_destroy +tedisegment_disassemble +tedisegment_elementcount +tedisegment_insertcompositeelement +tedisegment_insertcompositeelements +tedisegment_insertelement +tedisegment_insertelements +tedisegment_internalassigndelimiters +tedisegment_internalcreatecompositeelement +tedisegment_internalcreateedidataobject +tedisegment_internalcreateelement +tedisegment_object +tedisegment_segmentid +tedisegmentspec +tedisegmentspec_assemble +tedisegmentspec_assemblereserveddata +tedisegmentspec_create +tedisegmentspec_description +tedisegmentspec_destroy +tedisegmentspec_disassemble +tedisegmentspec_disassemblereserveddata +tedisegmentspec_id +tedisegmentspec_internalcreateelement +tedisegmentspec_maximumusage +tedisegmentspec_notes +tedisegmentspec_object +tedisegmentspec_ownerloopid +tedisegmentspec_parentloopid +tedisegmentspec_position +tedisegmentspec_requirementdesignator +tedisegmentspec_reserveddata +tedisegmentspec_section +tedisegmentspec_validateelementindexpositions +tedispectoseftranslator +tedispectoseftranslator_create +tedispectoseftranslator_destroy +tedispectoseftranslator_object +tedispectoseftranslator_translatelooptosefset +tedispectoseftranslator_translatetosefelement +tedispectoseftranslator_translatetosefelementtextsets +tedispectoseftranslator_translatetoseffile +tedispectoseftranslator_translatetosefsegment +tedispectoseftranslator_translatetosefsegmenttextsets +tedispectoseftranslator_translatetosefset +teditransactionset +teditransactionset_addsegment +teditransactionset_addsegments +teditransactionset_appendsegment +teditransactionset_appendsegments +teditransactionset_assemble +teditransactionset_create +teditransactionset_deletesegment +teditransactionset_deletesegments +teditransactionset_destroy +teditransactionset_disassemble +teditransactionset_insertsegment +teditransactionset_insertsegments +teditransactionset_internalassigndelimiters +teditransactionset_internalcreateedidataobject +teditransactionset_internalcreateheadertrailersegments +teditransactionset_internalcreatesegment +teditransactionset_object +teditransactionset_segment +teditransactionset_segmentcount +teditransactionset_segments +teditransactionset_segmentse +teditransactionset_segmentst +teditransactionsetdocument +teditransactionsetdocument_addlooptodoc +teditransactionsetdocument_advancesegspecindex +teditransactionsetdocument_create +teditransactionsetdocument_destroy +teditransactionsetdocument_editsdoptions +teditransactionsetdocument_erroroccured +teditransactionsetdocument_fediloopstack +teditransactionsetdocument_feditransactionset +teditransactionsetdocument_feditransactionsetspec +teditransactionsetdocument_feditsdoptions +teditransactionsetdocument_ferroroccured +teditransactionsetdocument_formatdocument +teditransactionsetdocument_object +teditransactionsetdocument_setspecificationpointers +teditransactionsetdocument_validatedata +teditransactionsetdocument_validatesegspecindex +teditransactionsetloop +teditransactionsetloop_addloop +teditransactionsetloop_appendsegment +teditransactionsetloop_assemble +teditransactionsetloop_create +teditransactionsetloop_deleteedidataobjects +teditransactionsetloop_destroy +teditransactionsetloop_disassemble +teditransactionsetloop_findloop +teditransactionsetloop_findsegment +teditransactionsetloop_fownerloopid +teditransactionsetloop_fparentloopid +teditransactionsetloop_fparenttransactionset +teditransactionsetloop_internalassigndelimiters +teditransactionsetloop_internalcreateedidataobject +teditransactionsetloop_object +teditransactionsetloop_ownerloopid +teditransactionsetloop_parentloopid +teditransactionsetloop_parenttransactionset +teditransactionsetsegment +teditransactionsetsegment_create +teditransactionsetsegment_internalassigndelimiters +teditransactionsetsegment_object +teditransactionsetsegmentspec +teditransactionsetsegmentspec_create +teditransactionsetsegmentspec_internalassigndelimiters +teditransactionsetsegmentspec_object +teditransactionsetsegmentstspec +teditransactionsetsegmentstspec_assemblereserveddata +teditransactionsetsegmentstspec_create +teditransactionsetsegmentstspec_disassemblereserveddata +teditransactionsetsegmentstspec_object +teditransactionsetspec +teditransactionsetspec_id +teditransactionsetspec_internalcreateheadertrailersegments +teditransactionsetspec_internalcreatesegment +teditransactionsetspec_object +teditransactionsetspec_transactionsetid +teditransactionsetspec_tsdescription +teditransactionsetspec_validatesegmentindexpositions +tedixmlansix12formattranslator +tedixmlansix12formattranslator_converttoedisegment +tedixmlansix12formattranslator_converttoeditransaction +tedixmlansix12formattranslator_converttoxmlsegment +tedixmlansix12formattranslator_converttoxmltransaction +tedixmlansix12formattranslator_create +tedixmlansix12formattranslator_destroy +tedixmlansix12formattranslator_object +tedixmlattributes +tedixmlattributes_checkattribute +tedixmlattributes_combineattributes +tedixmlattributes_create +tedixmlattributes_destroy +tedixmlattributes_getattributestring +tedixmlattributes_getattributevalue +tedixmlattributes_object +tedixmlattributes_parseattributes +tedixmlattributes_setattribute +tedixmldataobject +tedixmldataobject_assemble +tedixmldataobject_attributes +tedixmldataobject_create +tedixmldataobject_customdata1 +tedixmldataobject_customdata2 +tedixmldataobject_data +tedixmldataobject_datalength +tedixmldataobject_delimiters +tedixmldataobject_destroy +tedixmldataobject_disassemble +tedixmldataobject_fattributes +tedixmldataobject_fcustomdata1 +tedixmldataobject_fcustomdata2 +tedixmldataobject_fdata +tedixmldataobject_fdelimiters +tedixmldataobject_fedidot +tedixmldataobject_ferrorlog +tedixmldataobject_flength +tedixmldataobject_fparent +tedixmldataobject_fspecpointer +tedixmldataobject_fstate +tedixmldataobject_getdata +tedixmldataobject_object +tedixmldataobject_parent +tedixmldataobject_setdata +tedixmldataobject_specpointer +tedixmldataobject_state +tedixmldataobjectgroup +tedixmldataobjectgroup_addgroup +tedixmldataobjectgroup_addsegment +tedixmldataobjectgroup_appendedidataobject +tedixmldataobjectgroup_create +tedixmldataobjectgroup_deleteedidataobject +tedixmldataobjectgroup_deleteedidataobjects +tedixmldataobjectgroup_destroy +tedixmldataobjectgroup_edidataobject +tedixmldataobjectgroup_edidataobjects +tedixmldataobjectgroup_fedidataobjects +tedixmldataobjectgroup_getedidataobject +tedixmldataobjectgroup_insertedidataobject +tedixmldataobjectgroup_insertgroup +tedixmldataobjectgroup_insertsegment +tedixmldataobjectgroup_internalassigndelimiters +tedixmldataobjectgroup_internalcreatedataobjectgroup +tedixmldataobjectgroup_object +tedixmldataobjectgroup_searchforsegmentindatastring +tedixmldataobjectgroup_setedidataobject +tedixmldelimiters +tedixmldelimiters_assignmentdelimiter +tedixmldelimiters_bcdatad +tedixmldelimiters_bcdatalength +tedixmldelimiters_bofetd +tedixmldelimiters_bofetdlength +tedixmldelimiters_btd +tedixmldelimiters_btdlength +tedixmldelimiters_create +tedixmldelimiters_doublequote +tedixmldelimiters_ecdatad +tedixmldelimiters_ecdatalength +tedixmldelimiters_etd +tedixmldelimiters_etdlength +tedixmldelimiters_object +tedixmldelimiters_singlequote +tedixmldelimiters_spacedelimiter +tedixmlelement +tedixmlelement_assemble +tedixmlelement_cdata +tedixmlelement_create +tedixmlelement_disassemble +tedixmlelement_fcdata +tedixmlelement_getindexpositionfromparent +tedixmlelement_internalassigndelimiters +tedixmlelement_object +tedixmlfile +tedixmlfile_assemble +tedixmlfile_create +tedixmlfile_destroy +tedixmlfile_disassemble +tedixmlfile_fileid +tedixmlfile_filename +tedixmlfile_internalassigndelimiters +tedixmlfile_internalcreatedataobjectgroup +tedixmlfile_loadfromfile +tedixmlfile_object +tedixmlfile_reloadfromfile +tedixmlfile_saveastofile +tedixmlfile_savetofile +tedixmlfile_xmlfileheader +tedixmlfileheader +tedixmlfileheader_attributes +tedixmlfileheader_create +tedixmlfileheader_delimiters +tedixmlfileheader_destroy +tedixmlfileheader_object +tedixmlfileheader_outputadditionalxmlheaderattributes +tedixmlfileheader_outputxmlheader +tedixmlfileheader_parsexmlheader +tedixmlfileheader_xmlnamespaceoption +tedixmlfunctionalgroup +tedixmlfunctionalgroup_assemble +tedixmlfunctionalgroup_create +tedixmlfunctionalgroup_destroy +tedixmlfunctionalgroup_disassemble +tedixmlfunctionalgroup_internalassigndelimiters +tedixmlfunctionalgroup_internalcreatedataobjectgroup +tedixmlfunctionalgroup_object +tedixmlfunctionalgroup_segmentge +tedixmlfunctionalgroup_segmentgs +tedixmlfunctionalgroupsegment +tedixmlfunctionalgroupsegment_create +tedixmlfunctionalgroupsegment_internalassigndelimiters +tedixmlfunctionalgroupsegment_object +tedixmlinterchangecontrol +tedixmlinterchangecontrol_assemble +tedixmlinterchangecontrol_create +tedixmlinterchangecontrol_destroy +tedixmlinterchangecontrol_disassemble +tedixmlinterchangecontrol_internalassigndelimiters +tedixmlinterchangecontrol_internalcreatedataobjectgroup +tedixmlinterchangecontrol_object +tedixmlinterchangecontrol_segmentiea +tedixmlinterchangecontrol_segmentisa +tedixmlinterchangecontrolsegment +tedixmlinterchangecontrolsegment_create +tedixmlinterchangecontrolsegment_internalassigndelimiters +tedixmlinterchangecontrolsegment_object +tedixmlobject +tedixmlobject_object +tedixmlsegment +tedixmlsegment_addelement +tedixmlsegment_addelements +tedixmlsegment_appendelement +tedixmlsegment_appendelements +tedixmlsegment_assemble +tedixmlsegment_create +tedixmlsegment_deleteelement +tedixmlsegment_deleteelements +tedixmlsegment_destroy +tedixmlsegment_disassemble +tedixmlsegment_element +tedixmlsegment_elements +tedixmlsegment_getindexpositionfromparent +tedixmlsegment_insertelement +tedixmlsegment_insertelements +tedixmlsegment_internalassigndelimiters +tedixmlsegment_internalcreateelement +tedixmlsegment_object +tedixmlsegment_segmentid +tedixmltransactionset +tedixmltransactionset_assemble +tedixmltransactionset_create +tedixmltransactionset_destroy +tedixmltransactionset_disassemble +tedixmltransactionset_internalassigndelimiters +tedixmltransactionset_internalcreatedataobjectgroup +tedixmltransactionset_object +tedixmltransactionset_segmentse +tedixmltransactionset_segmentst +tedixmltransactionsetloop +tedixmltransactionsetloop_assemble +tedixmltransactionsetloop_create +tedixmltransactionsetloop_destroy +tedixmltransactionsetloop_disassemble +tedixmltransactionsetloop_internalassigndelimiters +tedixmltransactionsetloop_internalcreatedataobjectgroup +tedixmltransactionsetloop_object +tedixmltransactionsetloop_parenttransactionset +tedixmltransactionsetsegment +tedixmltransactionsetsegment_create +tedixmltransactionsetsegment_internalassigndelimiters +tedixmltransactionsetsegment_object +tevaluator +tevaluator_create +tevaluator_destroy +tevaluator_evaluate +tevaluator_object +texprabstractfuncsym +texprabstractfuncsym_compilefirstarg +texprabstractfuncsym_compilenextarg +texprabstractfuncsym_endargs +texprabstractfuncsym_evalfirstarg +texprabstractfuncsym_evalnextarg +texprabstractfuncsym_object +texprbinary32funcsym +texprbinary32funcsym_compile +texprbinary32funcsym_create +texprbinary32funcsym_evaluate +texprbinary32funcsym_object +texprbinary64funcsym +texprbinary64funcsym_compile +texprbinary64funcsym_create +texprbinary64funcsym_evaluate +texprbinary64funcsym_object +texprbinary80funcsym +texprbinary80funcsym_compile +texprbinary80funcsym_create +texprbinary80funcsym_evaluate +texprbinary80funcsym_object +texprbinaryfuncsym +texprbinaryfuncsym_compile +texprbinaryfuncsym_create +texprbinaryfuncsym_evaluate +texprbinaryfuncsym_object +texprcompileparser +texprcompileparser_compile +texprcompileparser_compileexpr +texprcompileparser_compilefactor +texprcompileparser_compileidentfactor +texprcompileparser_compilesignedfactor +texprcompileparser_compilesimpleexpr +texprcompileparser_compileterm +texprcompileparser_context +texprcompileparser_create +texprcompileparser_lexer +texprcompileparser_nodefactory +texprcompileparser_object +texprconst32sym +texprconst32sym_compile +texprconst32sym_create +texprconst32sym_evaluate +texprconst32sym_object +texprconst64sym +texprconst64sym_compile +texprconst64sym_create +texprconst64sym_evaluate +texprconst64sym_object +texprconst80sym +texprconst80sym_compile +texprconst80sym_create +texprconst80sym_evaluate +texprconst80sym_object +texprconstsym +texprconstsym_compile +texprconstsym_create +texprconstsym_evaluate +texprconstsym_object +texprcontext +texprcontext_find +texprcontext_object +texpressioncompiler +texpressioncompiler_clear +texpressioncompiler_compile +texpressioncompiler_create +texpressioncompiler_delete +texpressioncompiler_destroy +texpressioncompiler_object +texpressioncompiler_remove +texprevalparser +texprevalparser_context +texprevalparser_create +texprevalparser_evalexpr +texprevalparser_evalfactor +texprevalparser_evalidentfactor +texprevalparser_evalsignedfactor +texprevalparser_evalsimpleexpr +texprevalparser_evalterm +texprevalparser_evaluate +texprevalparser_lexer +texprevalparser_object +texprfloat32funcsym +texprfloat32funcsym_compile +texprfloat32funcsym_create +texprfloat32funcsym_evaluate +texprfloat32funcsym_object +texprfloat64funcsym +texprfloat64funcsym_compile +texprfloat64funcsym_create +texprfloat64funcsym_evaluate +texprfloat64funcsym_object +texprfloat80funcsym +texprfloat80funcsym_compile +texprfloat80funcsym_create +texprfloat80funcsym_evaluate +texprfloat80funcsym_object +texprfuncsym +texprfuncsym_compile +texprfuncsym_create +texprfuncsym_evaluate +texprfuncsym_object +texprhashcontext +texprhashcontext_add +texprhashcontext_create +texprhashcontext_destroy +texprhashcontext_find +texprhashcontext_object +texprhashcontext_remove +texprlexer +texprlexer_create +texprlexer_currtok +texprlexer_fcurrtok +texprlexer_ftokenasnumber +texprlexer_ftokenasstring +texprlexer_nexttok +texprlexer_object +texprlexer_reset +texprlexer_tokenasnumber +texprlexer_tokenasstring +texprnode +texprnode_adddep +texprnode_create +texprnode_depcount +texprnode_deplist +texprnode_deps +texprnode_destroy +texprnode_object +texprnodefactory +texprnodefactory_add +texprnodefactory_callbinary32func +texprnodefactory_callbinary64func +texprnodefactory_callbinary80func +texprnodefactory_callbinaryfunc +texprnodefactory_callfloat32func +texprnodefactory_callfloat64func +texprnodefactory_callfloat80func +texprnodefactory_callfloatfunc +texprnodefactory_callternary32func +texprnodefactory_callternary64func +texprnodefactory_callternary80func +texprnodefactory_callternaryfunc +texprnodefactory_callunary32func +texprnodefactory_callunary64func +texprnodefactory_callunary80func +texprnodefactory_callunaryfunc +texprnodefactory_compare +texprnodefactory_divide +texprnodefactory_loadconst32 +texprnodefactory_loadconst64 +texprnodefactory_loadconst80 +texprnodefactory_loadvar +texprnodefactory_loadvar32 +texprnodefactory_loadvar64 +texprnodefactory_loadvar80 +texprnodefactory_multiply +texprnodefactory_negate +texprnodefactory_object +texprnodefactory_subtract +texprsetcontext +texprsetcontext_add +texprsetcontext_contexts +texprsetcontext_count +texprsetcontext_create +texprsetcontext_delete +texprsetcontext_destroy +texprsetcontext_extract +texprsetcontext_find +texprsetcontext_internallist +texprsetcontext_object +texprsetcontext_remove +texprsimplelexer +texprsimplelexer_buf +texprsimplelexer_create +texprsimplelexer_fbuf +texprsimplelexer_fcurrpos +texprsimplelexer_nexttok +texprsimplelexer_object +texprsimplelexer_reset +texprsimplelexer_setbuf +texprsym +texprsym_compile +texprsym_compileparser +texprsym_create +texprsym_evalparser +texprsym_evaluate +texprsym_ident +texprsym_lexer +texprsym_nodefactory +texprsym_object +texprternary32funcsym +texprternary32funcsym_compile +texprternary32funcsym_create +texprternary32funcsym_evaluate +texprternary32funcsym_object +texprternary64funcsym +texprternary64funcsym_compile +texprternary64funcsym_create +texprternary64funcsym_evaluate +texprternary64funcsym_object +texprternary80funcsym +texprternary80funcsym_compile +texprternary80funcsym_create +texprternary80funcsym_evaluate +texprternary80funcsym_object +texprternaryfuncsym +texprternaryfuncsym_compile +texprternaryfuncsym_create +texprternaryfuncsym_evaluate +texprternaryfuncsym_object +texprunary32funcsym +texprunary32funcsym_compile +texprunary32funcsym_create +texprunary32funcsym_evaluate +texprunary32funcsym_object +texprunary64funcsym +texprunary64funcsym_compile +texprunary64funcsym_create +texprunary64funcsym_evaluate +texprunary64funcsym_object +texprunary80funcsym +texprunary80funcsym_compile +texprunary80funcsym_create +texprunary80funcsym_evaluate +texprunary80funcsym_object +texprunaryfuncsym +texprunaryfuncsym_compile +texprunaryfuncsym_create +texprunaryfuncsym_evaluate +texprunaryfuncsym_object +texprvar32sym +texprvar32sym_compile +texprvar32sym_create +texprvar32sym_evaluate +texprvar32sym_object +texprvar64sym +texprvar64sym_compile +texprvar64sym_create +texprvar64sym_evaluate +texprvar64sym_object +texprvar80sym +texprvar80sym_compile +texprvar80sym_create +texprvar80sym_evaluate +texprvar80sym_object +texprvirtmach +texprvirtmach_add +texprvirtmach_addconst +texprvirtmach_clear +texprvirtmach_create +texprvirtmach_destroy +texprvirtmach_execute +texprvirtmach_object +texprvirtmachnodefactory +texprvirtmachnodefactory_add +texprvirtmachnodefactory_callfloatfunc +texprvirtmachnodefactory_compare +texprvirtmachnodefactory_create +texprvirtmachnodefactory_destroy +texprvirtmachnodefactory_gencode +texprvirtmachnodefactory_loadconst32 +texprvirtmachnodefactory_loadvar32 +texprvirtmachnodefactory_object +texprvirtmachop +texprvirtmachop_execute +texprvirtmachop_foutput +texprvirtmachop_object +texprvirtmachop_outputloc +tjclabstractcontainer +tjclabstractcontainer_create +tjclabstractcontainer_destroy +tjclabstractcontainer_entercriticalsection +tjclabstractcontainer_object +tjclabstractmapparser +tjclabstractmapparser_classtableitem +tjclabstractmapparser_create +tjclabstractmapparser_destroy +tjclabstractmapparser_flastunitfilename +tjclabstractmapparser_flastunitname +tjclabstractmapparser_linenumbersitem +tjclabstractmapparser_linenumberunititem +tjclabstractmapparser_linkerbug +tjclabstractmapparser_linkerbugunitname +tjclabstractmapparser_mapstringtofilename +tjclabstractmapparser_mapstringtostr +tjclabstractmapparser_object +tjclabstractmapparser_parse +tjclabstractmapparser_publicsbynameitem +tjclabstractmapparser_publicsbyvalueitem +tjclabstractmapparser_segmentitem +tjclabstractmapparser_stream +tjclansiregex +tjclansiregex_capturecount +tjclansiregex_captureoffset +tjclansiregex_captures +tjclansiregex_compile +tjclansiregex_create +tjclansiregex_destroy +tjclansiregex_errormessage +tjclansiregex_erroroffset +tjclansiregex_match +tjclansiregex_object +tjclansiregex_options +tjclappinstances +tjclappinstances_appwnds +tjclappinstances_bringappwindowtofront +tjclappinstances_checkinstance +tjclappinstances_checkmultipleinstances +tjclappinstances_checksingleinstance +tjclappinstances_create +tjclappinstances_destroy +tjclappinstances_getapplicationwnd +tjclappinstances_initdata +tjclappinstances_instancecount +tjclappinstances_instanceindex +tjclappinstances_killinstance +tjclappinstances_messageid +tjclappinstances_notifyinstances +tjclappinstances_object +tjclappinstances_processids +tjclappinstances_removeinstance +tjclappinstances_sendcmdlineparams +tjclappinstances_senddata +tjclappinstances_sendstring +tjclappinstances_sendstrings +tjclappinstances_setforegroundwindow98 +tjclappinstances_switchto +tjclappinstances_usernotify +tjclarraylist +tjclarraylist_add +tjclarraylist_addall +tjclarraylist_capacity +tjclarraylist_clear +tjclarraylist_clone +tjclarraylist_contains +tjclarraylist_containsall +tjclarraylist_create +tjclarraylist_destroy +tjclarraylist_equals +tjclarraylist_first +tjclarraylist_freeobject +tjclarraylist_getobject +tjclarraylist_grow +tjclarraylist_indexof +tjclarraylist_insert +tjclarraylist_insertall +tjclarraylist_isempty +tjclarraylist_last +tjclarraylist_lastindexof +tjclarraylist_object +tjclarraylist_ownsobjects +tjclarraylist_remove +tjclarraylist_removeall +tjclarraylist_retainall +tjclarraylist_setobject +tjclarraylist_size +tjclarraylist_sublist +tjclarrayset +tjclarrayset_add +tjclarrayset_addall +tjclarrayset_contains +tjclarrayset_insert +tjclarrayset_intersect +tjclarrayset_object +tjclarrayset_subtract +tjclarrayset_union +tjclaset +tjclaset_clear +tjclaset_getbit +tjclaset_getrange +tjclaset_invert +tjclaset_object +tjclaset_setbit +tjclaset_setrange +tjclavailablekeyblayout +tjclavailablekeyblayout_identifier +tjclavailablekeyblayout_identifiername +tjclavailablekeyblayout_layoutfile +tjclavailablekeyblayout_layoutfileexists +tjclavailablekeyblayout_layoutid +tjclavailablekeyblayout_load +tjclavailablekeyblayout_name +tjclavailablekeyblayout_object +tjclbcbinstallation +tjclbcbinstallation_configfilename +tjclbcbinstallation_create +tjclbcbinstallation_destroy +tjclbcbinstallation_getenvironmentvariables +tjclbcbinstallation_getlatestupdatepackforversion +tjclbcbinstallation_object +tjclbcbinstallation_packagesourcefileextension +tjclbcbinstallation_projectsourcefileextension +tjclbcbinstallation_radtoolkind +tjclbcbinstallation_radtoolname +tjclbcc32 +tjclbcc32_create +tjclbcc32_getexename +tjclbcc32_object +tjclbcc32_supportslibsuffix +tjclbdsinstallation +tjclbdsinstallation_cleanpackagecache +tjclbdsinstallation_compiledelphipackage +tjclbdsinstallation_compiledelphiproject +tjclbdsinstallation_create +tjclbdsinstallation_dualpackageinstallation +tjclbdsinstallation_getborlandstudioprojectsdir +tjclbdsinstallation_getbploutputpath +tjclbdsinstallation_getdcpoutputpath +tjclbdsinstallation_getdefaultprojectsdir +tjclbdsinstallation_getenvironmentvariables +tjclbdsinstallation_getlatestupdatepackforversion +tjclbdsinstallation_getname +tjclbdsinstallation_getvclincludedir +tjclbdsinstallation_object +tjclbdsinstallation_packagesourcefileextension +tjclbdsinstallation_projectsourcefileextension +tjclbdsinstallation_radtoolkind +tjclbdsinstallation_radtoolname +tjclbdsinstallation_registerpackage +tjclbdsinstallation_unregisterpackage +tjclbinaryinstruction +tjclbinaryinstruction_object +tjclbinarynode +tjclbinarynode_color +tjclbinarynode_left +tjclbinarynode_object +tjclbinarynode_parent +tjclbinarynode_right +tjclbinarynode_tjclbinarynode=recordobj +tjclbinarytree +tjclbinarytree_add +tjclbinarytree_addall +tjclbinarytree_clear +tjclbinarytree_clone +tjclbinarytree_contains +tjclbinarytree_containsall +tjclbinarytree_create +tjclbinarytree_destroy +tjclbinarytree_equals +tjclbinarytree_first +tjclbinarytree_gettraverseorder +tjclbinarytree_isempty +tjclbinarytree_last +tjclbinarytree_object +tjclbinarytree_remove +tjclbinarytree_removeall +tjclbinarytree_retainall +tjclbinarytree_settraverseorder +tjclbinarytree_size +tjclbindebuggenerator +tjclbindebuggenerator_calculatechecksum +tjclbindebuggenerator_create +tjclbindebuggenerator_createdata +tjclbindebuggenerator_datastream +tjclbindebuggenerator_destroy +tjclbindebuggenerator_object +tjclbindebugscanner +tjclbindebugscanner_cachelinenumbers +tjclbindebugscanner_cacheprocnames +tjclbindebugscanner_checkformat +tjclbindebugscanner_create +tjclbindebugscanner_datatostr +tjclbindebugscanner_ismodulenamevalid +tjclbindebugscanner_linenumberfromaddr +tjclbindebugscanner_makeptr +tjclbindebugscanner_modulename +tjclbindebugscanner_modulenamefromaddr +tjclbindebugscanner_modulestartfromaddr +tjclbindebugscanner_object +tjclbindebugscanner_procnamefromaddr +tjclbindebugscanner_readvalue +tjclbindebugscanner_sourcenamefromaddr +tjclbindebugscanner_validformat +tjclbitmap32 +tjclbitmap32_assign +tjclbitmap32_assignto +tjclbitmap32_bitmaphandle +tjclbitmap32_bitmapinfo +tjclbitmap32_bits +tjclbitmap32_clear +tjclbitmap32_clipline +tjclbitmap32_cliplinef +tjclbitmap32_create +tjclbitmap32_defineproperties +tjclbitmap32_delete +tjclbitmap32_destroy +tjclbitmap32_draw +tjclbitmap32_drawhorzline +tjclbitmap32_drawline +tjclbitmap32_drawmode +tjclbitmap32_drawto +tjclbitmap32_drawvertline +tjclbitmap32_empty +tjclbitmap32_fillrect +tjclbitmap32_font +tjclbitmap32_fontchanged +tjclbitmap32_fonthandle +tjclbitmap32_framerects +tjclbitmap32_framerectts +tjclbitmap32_framerecttsp +tjclbitmap32_getpixelb +tjclbitmap32_getstipplecolor +tjclbitmap32_handle +tjclbitmap32_linetos +tjclbitmap32_loadfromfile +tjclbitmap32_loadfromstream +tjclbitmap32_masteralpha +tjclbitmap32_moveto +tjclbitmap32_object +tjclbitmap32_onchange +tjclbitmap32_onchanging +tjclbitmap32_outercolor +tjclbitmap32_pencolor +tjclbitmap32_pixel +tjclbitmap32_pixelptr +tjclbitmap32_raiserectts +tjclbitmap32_rasterx +tjclbitmap32_rasterxf +tjclbitmap32_rastery +tjclbitmap32_rasteryf +tjclbitmap32_readdata +tjclbitmap32_rendertext +tjclbitmap32_resetalpha +tjclbitmap32_resetstipplecounter +tjclbitmap32_savetofile +tjclbitmap32_savetostream +tjclbitmap32_scanline +tjclbitmap32_set_t256 +tjclbitmap32_set_ts256 +tjclbitmap32_setpixel +tjclbitmap32_setpixelt +tjclbitmap32_setsize +tjclbitmap32_setstipple +tjclbitmap32_stipplecounter +tjclbitmap32_stipplestep +tjclbitmap32_stretchfilter +tjclbitmap32_textextent +tjclbitmap32_textheight +tjclbitmap32_textout +tjclbitmap32_textwidth +tjclbitmap32_updatefont +tjclbitmap32_writedata +tjclborlandcommandlinetool +tjclborlandcommandlinetool_addpathoption +tjclborlandcommandlinetool_checkoutputvalid +tjclborlandcommandlinetool_create +tjclborlandcommandlinetool_destroy +tjclborlandcommandlinetool_execute +tjclborlandcommandlinetool_filename +tjclborlandcommandlinetool_getexename +tjclborlandcommandlinetool_getfilename +tjclborlandcommandlinetool_getoptions +tjclborlandcommandlinetool_getoutput +tjclborlandcommandlinetool_getoutputcallback +tjclborlandcommandlinetool_object +tjclborlandcommandlinetool_options +tjclborlandcommandlinetool_output +tjclborlandcommandlinetool_outputcallback +tjclborlandcommandlinetool_setoutputcallback +tjclborlandmake +tjclborlandmake_getexename +tjclborlandmake_object +tjclborlandopenhelp +tjclborlandopenhelp_addhelpfile +tjclborlandopenhelp_contentfilename +tjclborlandopenhelp_gidfilename +tjclborlandopenhelp_indexfilename +tjclborlandopenhelp_linkfilename +tjclborlandopenhelp_object +tjclborlandopenhelp_projectfilename +tjclborlandopenhelp_removehelpfile +tjclborradtoolidepackages +tjclborradtoolidepackages_addexpert +tjclborradtoolidepackages_addidepackage +tjclborradtoolidepackages_addpackage +tjclborradtoolidepackages_count +tjclborradtoolidepackages_create +tjclborradtoolidepackages_destroy +tjclborradtoolidepackages_expertcount +tjclborradtoolidepackages_expertdescriptions +tjclborradtoolidepackages_expertfilenames +tjclborradtoolidepackages_idecount +tjclborradtoolidepackages_idepackagedescriptions +tjclborradtoolidepackages_idepackagefilenames +tjclborradtoolidepackages_object +tjclborradtoolidepackages_packagedescriptions +tjclborradtoolidepackages_packagedisabled +tjclborradtoolidepackages_packageentrytofilename +tjclborradtoolidepackages_packagefilenames +tjclborradtoolidepackages_readpackages +tjclborradtoolidepackages_removedisabled +tjclborradtoolidepackages_removeexpert +tjclborradtoolidepackages_removeidepackage +tjclborradtoolidepackages_removepackage +tjclborradtoolidetool +tjclborradtoolidetool_checkindex +tjclborradtoolidetool_count +tjclborradtoolidetool_create +tjclborradtoolidetool_indexofpath +tjclborradtoolidetool_indexoftitle +tjclborradtoolidetool_key +tjclborradtoolidetool_object +tjclborradtoolidetool_parameters +tjclborradtoolidetool_path +tjclborradtoolidetool_title +tjclborradtoolidetool_workingdir +tjclborradtoolinstallation +tjclborradtoolinstallation_addmissingpathitems +tjclborradtoolinstallation_addtodebugdcupath +tjclborradtoolinstallation_addtolibrarybrowsingpath +tjclborradtoolinstallation_addtolibrarysearchpath +tjclborradtoolinstallation_anyinstancerunning +tjclborradtoolinstallation_bcc32 +tjclborradtoolinstallation_binfoldername +tjclborradtoolinstallation_bploutputpath +tjclborradtoolinstallation_bpr2mak +tjclborradtoolinstallation_commandlinetools +tjclborradtoolinstallation_compilebcbpackage +tjclborradtoolinstallation_compilebcbproject +tjclborradtoolinstallation_compiledelphipackage +tjclborradtoolinstallation_compiledelphiproject +tjclborradtoolinstallation_compilepackage +tjclborradtoolinstallation_compileproject +tjclborradtoolinstallation_configdata +tjclborradtoolinstallation_configdatalocation +tjclborradtoolinstallation_configfilename +tjclborradtoolinstallation_create +tjclborradtoolinstallation_dcc +tjclborradtoolinstallation_dcc32 +tjclborradtoolinstallation_dcpoutputpath +tjclborradtoolinstallation_debugdcupath +tjclborradtoolinstallation_defaultprojectsdir +tjclborradtoolinstallation_description +tjclborradtoolinstallation_destroy +tjclborradtoolinstallation_edition +tjclborradtoolinstallation_editionastext +tjclborradtoolinstallation_environmentvariables +tjclborradtoolinstallation_extractpaths +tjclborradtoolinstallation_findfolderinpath +tjclborradtoolinstallation_getbploutputpath +tjclborradtoolinstallation_getdcpoutputpath +tjclborradtoolinstallation_getdefaultprojectsdir +tjclborradtoolinstallation_getenvironmentvariables +tjclborradtoolinstallation_getlatestupdatepackforversion +tjclborradtoolinstallation_getname +tjclborradtoolinstallation_getvclincludedir +tjclborradtoolinstallation_globals +tjclborradtoolinstallation_ideexebuildnumber +tjclborradtoolinstallation_ideexefilename +tjclborradtoolinstallation_idepackages +tjclborradtoolinstallation_idetools +tjclborradtoolinstallation_ideversionnumber +tjclborradtoolinstallation_installbcbexpert +tjclborradtoolinstallation_installbcbidepackage +tjclborradtoolinstallation_installbcbpackage +tjclborradtoolinstallation_installdelphiexpert +tjclborradtoolinstallation_installdelphiidepackage +tjclborradtoolinstallation_installdelphipackage +tjclborradtoolinstallation_installedupdatepack +tjclborradtoolinstallation_installexpert +tjclborradtoolinstallation_installidepackage +tjclborradtoolinstallation_installpackage +tjclborradtoolinstallation_isbdspersonality +tjclborradtoolinstallation_latestupdatepack +tjclborradtoolinstallation_libfoldername +tjclborradtoolinstallation_librarybrowsingpath +tjclborradtoolinstallation_librarysearchpath +tjclborradtoolinstallation_linkmapfile +tjclborradtoolinstallation_make +tjclborradtoolinstallation_mapcreate +tjclborradtoolinstallation_mapdelete +tjclborradtoolinstallation_maplink +tjclborradtoolinstallation_name +tjclborradtoolinstallation_object +tjclborradtoolinstallation_openhelp +tjclborradtoolinstallation_outputcallback +tjclborradtoolinstallation_outputfiledelete +tjclborradtoolinstallation_outputstring +tjclborradtoolinstallation_packagesourcefileextension +tjclborradtoolinstallation_palette +tjclborradtoolinstallation_personalities +tjclborradtoolinstallation_projectsourcefileextension +tjclborradtoolinstallation_radtoolkind +tjclborradtoolinstallation_radtoolname +tjclborradtoolinstallation_readinformation +tjclborradtoolinstallation_registerexpert +tjclborradtoolinstallation_registeridepackage +tjclborradtoolinstallation_registerpackage +tjclborradtoolinstallation_removefromdebugdcupath +tjclborradtoolinstallation_removefromlibrarybrowsingpath +tjclborradtoolinstallation_removefromlibrarysearchpath +tjclborradtoolinstallation_removefrompath +tjclborradtoolinstallation_repository +tjclborradtoolinstallation_rootdir +tjclborradtoolinstallation_substitutepath +tjclborradtoolinstallation_supportsbcb +tjclborradtoolinstallation_supportslibsuffix +tjclborradtoolinstallation_supportsvisualclx +tjclborradtoolinstallation_uninstallbcbexpert +tjclborradtoolinstallation_uninstallbcbidepackage +tjclborradtoolinstallation_uninstallbcbpackage +tjclborradtoolinstallation_uninstalldelphiexpert +tjclborradtoolinstallation_uninstalldelphiidepackage +tjclborradtoolinstallation_uninstalldelphipackage +tjclborradtoolinstallation_uninstallexpert +tjclborradtoolinstallation_uninstallidepackage +tjclborradtoolinstallation_uninstallpackage +tjclborradtoolinstallation_unregisterexpert +tjclborradtoolinstallation_unregisteridepackage +tjclborradtoolinstallation_unregisterpackage +tjclborradtoolinstallation_updateneeded +tjclborradtoolinstallation_valid +tjclborradtoolinstallation_vclincludedir +tjclborradtoolinstallation_versionnumber +tjclborradtoolinstallation_versionnumberstr +tjclborradtoolinstallationobject +tjclborradtoolinstallationobject_create +tjclborradtoolinstallationobject_installation +tjclborradtoolinstallationobject_object +tjclborradtoolinstallations +tjclborradtoolinstallations_anyinstancerunning +tjclborradtoolinstallations_anyupdatepackneeded +tjclborradtoolinstallations_bcbinstallationfromversion +tjclborradtoolinstallations_bcbversioninstalled +tjclborradtoolinstallations_bdsinstallationfromversion +tjclborradtoolinstallations_bdsversioninstalled +tjclborradtoolinstallations_count +tjclborradtoolinstallations_create +tjclborradtoolinstallations_delphiinstallationfromversion +tjclborradtoolinstallations_delphiversioninstalled +tjclborradtoolinstallations_destroy +tjclborradtoolinstallations_installations +tjclborradtoolinstallations_iterate +tjclborradtoolinstallations_object +tjclborradtoolinstallations_readinstallations +tjclborradtoolpalette +tjclborradtoolpalette_componentsontab +tjclborradtoolpalette_componentsontabtostrings +tjclborradtoolpalette_create +tjclborradtoolpalette_deletetabname +tjclborradtoolpalette_destroy +tjclborradtoolpalette_hiddencomponentsontab +tjclborradtoolpalette_key +tjclborradtoolpalette_object +tjclborradtoolpalette_tabnamecount +tjclborradtoolpalette_tabnameexists +tjclborradtoolpalette_tabnames +tjclborradtoolrepository +tjclborradtoolrepository_addobject +tjclborradtoolrepository_closeinifile +tjclborradtoolrepository_create +tjclborradtoolrepository_destroy +tjclborradtoolrepository_filename +tjclborradtoolrepository_findpage +tjclborradtoolrepository_inifile +tjclborradtoolrepository_object +tjclborradtoolrepository_pages +tjclborradtoolrepository_removeobjects +tjclbpr2mak +tjclbpr2mak_getexename +tjclbpr2mak_object +tjclbucket +tjclbucket_entries +tjclbucket_object +tjclbucket_tjclbucket=recordcount +tjclbytemap +tjclbytemap_assign +tjclbytemap_assignto +tjclbytemap_bytes +tjclbytemap_clear +tjclbytemap_destroy +tjclbytemap_empty +tjclbytemap_object +tjclbytemap_readfrom +tjclbytemap_setsize +tjclbytemap_valptr +tjclbytemap_value +tjclbytemap_writeto +tjclclrappdomain +tjclclrappdomain_create +tjclclrappdomain_defaultinterface +tjclclrappdomain_execute +tjclclrappdomain_host +tjclclrappdomain_load +tjclclrappdomain_object +tjclclrappdomain_unload +tjclclrappdomainsetup +tjclclrappdomainsetup_applicationbase +tjclclrappdomainsetup_applicationname +tjclclrappdomainsetup_cachepath +tjclclrappdomainsetup_configurationfile +tjclclrappdomainsetup_create +tjclclrappdomainsetup_defaultinterface +tjclclrappdomainsetup_dynamicbase +tjclclrappdomainsetup_licensefile +tjclclrappdomainsetup_object +tjclclrappdomainsetup_privatebinpath +tjclclrappdomainsetup_privatebinpathprobe +tjclclrappdomainsetup_shadowcopydirectories +tjclclrappdomainsetup_shadowcopyfiles +tjclclrarraysign +tjclclrarraysign_create +tjclclrarraysign_object +tjclclrassembly +tjclclrassembly_create +tjclclrassembly_defaultinterface +tjclclrassembly_object +tjclclrblobrecord +tjclclrblobrecord_create +tjclclrblobrecord_data +tjclclrblobrecord_dump +tjclclrblobrecord_object +tjclclrblobrecord_offset +tjclclrblobrecord_ptr +tjclclrblobstream +tjclclrblobstream_at +tjclclrblobstream_blobcount +tjclclrblobstream_blobs +tjclclrblobstream_create +tjclclrblobstream_destroy +tjclclrblobstream_object +tjclclrcustommodifiersign +tjclclrcustommodifiersign_create +tjclclrcustommodifiersign_object +tjclclrcustommodifiersign_required +tjclclrcustommodifiersign_token +tjclclrexceptionhandler +tjclclrexceptionhandler_classtoken +tjclclrexceptionhandler_create +tjclclrexceptionhandler_ehflags +tjclclrexceptionhandler_filteroffset +tjclclrexceptionhandler_flags +tjclclrexceptionhandler_handlerblock +tjclclrexceptionhandler_object +tjclclrexceptionhandler_tryblock +tjclclrfield +tjclclrfield_object +tjclclrguidstream +tjclclrguidstream_create +tjclclrguidstream_guidcount +tjclclrguidstream_guids +tjclclrguidstream_object +tjclclrheaderex +tjclclrheaderex_clrimageflag +tjclclrheaderex_create +tjclclrheaderex_destroy +tjclclrheaderex_dumpil +tjclclrheaderex_entrypointtoken +tjclclrheaderex_flags +tjclclrheaderex_hasresources +tjclclrheaderex_hasstrongnamesignature +tjclclrheaderex_hasvtablefixup +tjclclrheaderex_metadata +tjclclrheaderex_object +tjclclrheaderex_resourceat +tjclclrheaderex_resourcecount +tjclclrheaderex_resources +tjclclrheaderex_strongnamesignature +tjclclrheaderex_vtablefixupcount +tjclclrheaderex_vtablefixups +tjclclrhost +tjclclrhost_addappdomain +tjclclrhost_appdomaincount +tjclclrhost_appdomains +tjclclrhost_correquiredversion +tjclclrhost_corsystemdirectory +tjclclrhost_corversion +tjclclrhost_create +tjclclrhost_createappdomain +tjclclrhost_createdomainsetup +tjclclrhost_currentappdomain +tjclclrhost_defaultappdomain +tjclclrhost_defaultinterface +tjclclrhost_destroy +tjclclrhost_findappdomain +tjclclrhost_object +tjclclrhost_refresh +tjclclrhost_removeappdomain +tjclclrhost_start +tjclclrhost_stop +tjclclrilgenerator +tjclclrilgenerator_create +tjclclrilgenerator_destroy +tjclclrilgenerator_dumpil +tjclclrilgenerator_instructioncount +tjclclrilgenerator_instructions +tjclclrilgenerator_method +tjclclrilgenerator_object +tjclclrlocalvar +tjclclrlocalvar_elementtype +tjclclrlocalvar_flags +tjclclrlocalvar_name +tjclclrlocalvar_object +tjclclrlocalvar_token +tjclclrlocalvarsign +tjclclrlocalvarsign_create +tjclclrlocalvarsign_destroy +tjclclrlocalvarsign_localvarcount +tjclclrlocalvarsign_localvars +tjclclrlocalvarsign_object +tjclclrmethod +tjclclrmethod_defaultinterface +tjclclrmethod_object +tjclclrmethodbody +tjclclrmethodbody_code +tjclclrmethodbody_create +tjclclrmethodbody_destroy +tjclclrmethodbody_exceptionhandlercount +tjclclrmethodbody_exceptionhandlers +tjclclrmethodbody_localvarsign +tjclclrmethodbody_localvarsigndata +tjclclrmethodbody_localvarsigntoken +tjclclrmethodbody_maxstack +tjclclrmethodbody_method +tjclclrmethodbody_object +tjclclrmethodbody_size +tjclclrmethodparam +tjclclrmethodparam_arraysign +tjclclrmethodparam_byref +tjclclrmethodparam_create +tjclclrmethodparam_custommodifiercount +tjclclrmethodparam_custommodifiers +tjclclrmethodparam_destroy +tjclclrmethodparam_elementtype +tjclclrmethodparam_methodsign +tjclclrmethodparam_object +tjclclrmethodparam_token +tjclclrmethodrettype +tjclclrmethodrettype_object +tjclclrmethodsign +tjclclrmethodsign_create +tjclclrmethodsign_destroy +tjclclrmethodsign_flags +tjclclrmethodsign_object +tjclclrmethodsign_paramcount +tjclclrmethodsign_params +tjclclrmethodsign_rettype +tjclclrobject +tjclclrobject_create +tjclclrobject_fields +tjclclrobject_methods +tjclclrobject_object +tjclclrobject_properties +tjclclrproperty +tjclclrproperty_object +tjclclrresourcerecord +tjclclrresourcerecord_create +tjclclrresourcerecord_data +tjclclrresourcerecord_object +tjclclrresourcerecord_offset +tjclclrresourcerecord_rva +tjclclrsignature +tjclclrsignature_blob +tjclclrsignature_create +tjclclrsignature_inc +tjclclrsignature_ismodifiertype +tjclclrsignature_isprimitivetype +tjclclrsignature_object +tjclclrsignature_readbyte +tjclclrsignature_readelementtype +tjclclrsignature_readinteger +tjclclrsignature_readtoken +tjclclrsignature_readvalue +tjclclrsignature_uncompresscallingconv +tjclclrsignature_uncompressdata +tjclclrsignature_uncompresseddatasize +tjclclrsignature_uncompresselementtype +tjclclrsignature_uncompressfieldsignature +tjclclrsignature_uncompresssignedint +tjclclrsignature_uncompresstoken +tjclclrsignature_uncompresstypesignature +tjclclrstream +tjclclrstream_create +tjclclrstream_data +tjclclrstream_header +tjclclrstream_metadata +tjclclrstream_name +tjclclrstream_object +tjclclrstream_offset +tjclclrstream_size +tjclclrstringsstream +tjclclrstringsstream_at +tjclclrstringsstream_create +tjclclrstringsstream_destroy +tjclclrstringsstream_object +tjclclrstringsstream_offsets +tjclclrstringsstream_stringcount +tjclclrstringsstream_strings +tjclclrtable +tjclclrtable_addrow +tjclclrtable_create +tjclclrtable_data +tjclclrtable_destroy +tjclclrtable_dumpil +tjclclrtable_getcodedindextag +tjclclrtable_getcodedindexvalue +tjclclrtable_getrow +tjclclrtable_getrowcount +tjclclrtable_iswideindex +tjclclrtable_load +tjclclrtable_object +tjclclrtable_offset +tjclclrtable_readbyte +tjclclrtable_readcompressedvalue +tjclclrtable_readdword +tjclclrtable_readindex +tjclclrtable_readword +tjclclrtable_realrowcount +tjclclrtable_reset +tjclclrtable_rowcount +tjclclrtable_rows +tjclclrtable_setsize +tjclclrtable_size +tjclclrtable_stream +tjclclrtable_tablerowclass +tjclclrtable_update +tjclclrtableassembly +tjclclrtableassembly_object +tjclclrtableassembly_rows +tjclclrtableassembly_tablerowclass +tjclclrtableassemblyos +tjclclrtableassemblyos_object +tjclclrtableassemblyos_rows +tjclclrtableassemblyos_tablerowclass +tjclclrtableassemblyosrow +tjclclrtableassemblyosrow_create +tjclclrtableassemblyosrow_majorversion +tjclclrtableassemblyosrow_minorversion +tjclclrtableassemblyosrow_object +tjclclrtableassemblyosrow_platformid +tjclclrtableassemblyosrow_version +tjclclrtableassemblyprocessor +tjclclrtableassemblyprocessor_object +tjclclrtableassemblyprocessor_rows +tjclclrtableassemblyprocessor_tablerowclass +tjclclrtableassemblyprocessorrow +tjclclrtableassemblyprocessorrow_create +tjclclrtableassemblyprocessorrow_object +tjclclrtableassemblyprocessorrow_processor +tjclclrtableassemblyref +tjclclrtableassemblyref_object +tjclclrtableassemblyref_rows +tjclclrtableassemblyref_tablerowclass +tjclclrtableassemblyrefos +tjclclrtableassemblyrefos_object +tjclclrtableassemblyrefos_rows +tjclclrtableassemblyrefos_tablerowclass +tjclclrtableassemblyrefosrow +tjclclrtableassemblyrefosrow_assemblyref +tjclclrtableassemblyrefosrow_assemblyrefidx +tjclclrtableassemblyrefosrow_create +tjclclrtableassemblyrefosrow_object +tjclclrtableassemblyrefprocessor +tjclclrtableassemblyrefprocessor_object +tjclclrtableassemblyrefprocessor_rows +tjclclrtableassemblyrefprocessor_tablerowclass +tjclclrtableassemblyrefprocessorrow +tjclclrtableassemblyrefprocessorrow_assemblyref +tjclclrtableassemblyrefprocessorrow_assemblyrefidx +tjclclrtableassemblyrefprocessorrow_create +tjclclrtableassemblyrefprocessorrow_object +tjclclrtableassemblyrefrow +tjclclrtableassemblyrefrow_buildnumber +tjclclrtableassemblyrefrow_create +tjclclrtableassemblyrefrow_culture +tjclclrtableassemblyrefrow_cultureoffset +tjclclrtableassemblyrefrow_dumpil +tjclclrtableassemblyrefrow_flagmask +tjclclrtableassemblyrefrow_flags +tjclclrtableassemblyrefrow_hashvalue +tjclclrtableassemblyrefrow_hashvalueoffset +tjclclrtableassemblyrefrow_majorversion +tjclclrtableassemblyrefrow_minorversion +tjclclrtableassemblyrefrow_name +tjclclrtableassemblyrefrow_nameoffset +tjclclrtableassemblyrefrow_object +tjclclrtableassemblyrefrow_publickeyortoken +tjclclrtableassemblyrefrow_publickeyortokenoffset +tjclclrtableassemblyrefrow_revisionnumber +tjclclrtableassemblyrefrow_version +tjclclrtableassemblyrow +tjclclrtableassemblyrow_assemblyflags +tjclclrtableassemblyrow_buildnumber +tjclclrtableassemblyrow_create +tjclclrtableassemblyrow_culture +tjclclrtableassemblyrow_cultureoffset +tjclclrtableassemblyrow_dumpil +tjclclrtableassemblyrow_flagmask +tjclclrtableassemblyrow_flags +tjclclrtableassemblyrow_hashalgid +tjclclrtableassemblyrow_majorversion +tjclclrtableassemblyrow_minorversion +tjclclrtableassemblyrow_name +tjclclrtableassemblyrow_nameoffset +tjclclrtableassemblyrow_object +tjclclrtableassemblyrow_publickey +tjclclrtableassemblyrow_publickeyoffset +tjclclrtableassemblyrow_revisionnumber +tjclclrtableassemblyrow_version +tjclclrtableclasslayout +tjclclrtableclasslayout_object +tjclclrtableclasslayout_rows +tjclclrtableclasslayout_tablerowclass +tjclclrtableclasslayoutrow +tjclclrtableclasslayoutrow_classsize +tjclclrtableclasslayoutrow_create +tjclclrtableclasslayoutrow_object +tjclclrtableclasslayoutrow_packingsize +tjclclrtableclasslayoutrow_parentidx +tjclclrtableconstant +tjclclrtableconstant_object +tjclclrtableconstant_rows +tjclclrtableconstant_tablerowclass +tjclclrtableconstantrow +tjclclrtableconstantrow_create +tjclclrtableconstantrow_dumpil +tjclclrtableconstantrow_elementtype +tjclclrtableconstantrow_kind +tjclclrtableconstantrow_object +tjclclrtableconstantrow_parent +tjclclrtableconstantrow_parentidx +tjclclrtableconstantrow_value +tjclclrtableconstantrow_valueoffset +tjclclrtablecustomattribute +tjclclrtablecustomattribute_object +tjclclrtablecustomattribute_rows +tjclclrtablecustomattribute_tablerowclass +tjclclrtablecustomattributerow +tjclclrtablecustomattributerow_create +tjclclrtablecustomattributerow_dumpil +tjclclrtablecustomattributerow_method +tjclclrtablecustomattributerow_object +tjclclrtablecustomattributerow_parent +tjclclrtablecustomattributerow_parentidx +tjclclrtablecustomattributerow_typeidx +tjclclrtablecustomattributerow_value +tjclclrtablecustomattributerow_valueoffset +tjclclrtabledeclsecurity +tjclclrtabledeclsecurity_object +tjclclrtabledeclsecurity_rows +tjclclrtabledeclsecurity_tablerowclass +tjclclrtabledeclsecurityrow +tjclclrtabledeclsecurityrow_action +tjclclrtabledeclsecurityrow_create +tjclclrtabledeclsecurityrow_object +tjclclrtabledeclsecurityrow_parentidx +tjclclrtabledeclsecurityrow_permissionsetoffset +tjclclrtableenclog +tjclclrtableenclog_object +tjclclrtableenclog_rows +tjclclrtableenclog_tablerowclass +tjclclrtableenclogrow +tjclclrtableenclogrow_create +tjclclrtableenclogrow_funccode +tjclclrtableenclogrow_object +tjclclrtableencmap +tjclclrtableencmap_object +tjclclrtableencmap_rows +tjclclrtableencmap_tablerowclass +tjclclrtableencmaprow +tjclclrtableencmaprow_create +tjclclrtableencmaprow_funccode +tjclclrtableencmaprow_object +tjclclrtableeventdef +tjclclrtableeventdef_object +tjclclrtableeventdef_rows +tjclclrtableeventdef_tablerowclass +tjclclrtableeventdefrow +tjclclrtableeventdefrow_create +tjclclrtableeventdefrow_eventflags +tjclclrtableeventdefrow_eventtypeidx +tjclclrtableeventdefrow_name +tjclclrtableeventdefrow_nameoffset +tjclclrtableeventdefrow_object +tjclclrtableeventmap +tjclclrtableeventmap_object +tjclclrtableeventmap_rows +tjclclrtableeventmap_tablerowclass +tjclclrtableeventmaprow +tjclclrtableeventmaprow_create +tjclclrtableeventmaprow_eventlistidx +tjclclrtableeventmaprow_object +tjclclrtableeventmaprow_parentidx +tjclclrtableeventptr +tjclclrtableeventptr_object +tjclclrtableeventptr_rows +tjclclrtableeventptr_tablerowclass +tjclclrtableeventptrrow +tjclclrtableeventptrrow_create +tjclclrtableeventptrrow_event +tjclclrtableeventptrrow_eventidx +tjclclrtableeventptrrow_object +tjclclrtableexportedtype +tjclclrtableexportedtype_object +tjclclrtableexportedtype_rows +tjclclrtableexportedtype_tablerowclass +tjclclrtableexportedtyperow +tjclclrtableexportedtyperow_create +tjclclrtableexportedtyperow_flags +tjclclrtableexportedtyperow_implementationidx +tjclclrtableexportedtyperow_object +tjclclrtableexportedtyperow_typedefidx +tjclclrtableexportedtyperow_typename +tjclclrtableexportedtyperow_typenameoffset +tjclclrtableexportedtyperow_typenamespace +tjclclrtableexportedtyperow_typenamespaceoffset +tjclclrtablefielddef +tjclclrtablefielddef_object +tjclclrtablefielddef_rows +tjclclrtablefielddef_tablerowclass +tjclclrtablefielddefrow +tjclclrtablefielddefrow_create +tjclclrtablefielddefrow_dumpil +tjclclrtablefielddefrow_flags +tjclclrtablefielddefrow_name +tjclclrtablefielddefrow_nameoffset +tjclclrtablefielddefrow_object +tjclclrtablefielddefrow_parenttoken +tjclclrtablefielddefrow_rawflags +tjclclrtablefielddefrow_setparenttoken +tjclclrtablefielddefrow_signature +tjclclrtablefielddefrow_signatureoffset +tjclclrtablefielddefrow_visibility +tjclclrtablefieldlayout +tjclclrtablefieldlayout_object +tjclclrtablefieldlayout_rows +tjclclrtablefieldlayout_tablerowclass +tjclclrtablefieldlayoutrow +tjclclrtablefieldlayoutrow_create +tjclclrtablefieldlayoutrow_fieldidx +tjclclrtablefieldlayoutrow_object +tjclclrtablefieldlayoutrow_offset +tjclclrtablefieldmarshal +tjclclrtablefieldmarshal_object +tjclclrtablefieldmarshal_rows +tjclclrtablefieldmarshal_tablerowclass +tjclclrtablefieldmarshalrow +tjclclrtablefieldmarshalrow_create +tjclclrtablefieldmarshalrow_nativetypeoffset +tjclclrtablefieldmarshalrow_object +tjclclrtablefieldmarshalrow_parentidx +tjclclrtablefieldptr +tjclclrtablefieldptr_object +tjclclrtablefieldptr_rows +tjclclrtablefieldptr_tablerowclass +tjclclrtablefieldptrrow +tjclclrtablefieldptrrow_create +tjclclrtablefieldptrrow_field +tjclclrtablefieldptrrow_fieldidx +tjclclrtablefieldptrrow_object +tjclclrtablefieldrva +tjclclrtablefieldrva_object +tjclclrtablefieldrva_rows +tjclclrtablefieldrva_tablerowclass +tjclclrtablefieldrvarow +tjclclrtablefieldrvarow_create +tjclclrtablefieldrvarow_fieldidx +tjclclrtablefieldrvarow_object +tjclclrtablefieldrvarow_rva +tjclclrtablefile +tjclclrtablefile_object +tjclclrtablefile_rows +tjclclrtablefile_tablerowclass +tjclclrtablefilerow +tjclclrtablefilerow_containsmetadata +tjclclrtablefilerow_create +tjclclrtablefilerow_dumpil +tjclclrtablefilerow_flags +tjclclrtablefilerow_hashvalue +tjclclrtablefilerow_hashvalueoffset +tjclclrtablefilerow_name +tjclclrtablefilerow_nameoffset +tjclclrtablefilerow_object +tjclclrtableimplmap +tjclclrtableimplmap_object +tjclclrtableimplmap_rows +tjclclrtableimplmap_tablerowclass +tjclclrtableimplmaprow +tjclclrtableimplmaprow_create +tjclclrtableimplmaprow_importname +tjclclrtableimplmaprow_importnameoffset +tjclclrtableimplmaprow_importscopeidx +tjclclrtableimplmaprow_mappingflags +tjclclrtableimplmaprow_memberforwardedidx +tjclclrtableimplmaprow_object +tjclclrtableinterfaceimpl +tjclclrtableinterfaceimpl_object +tjclclrtableinterfaceimpl_rows +tjclclrtableinterfaceimpl_tablerowclass +tjclclrtableinterfaceimplrow +tjclclrtableinterfaceimplrow_classidx +tjclclrtableinterfaceimplrow_create +tjclclrtableinterfaceimplrow_dumpil +tjclclrtableinterfaceimplrow_implclass +tjclclrtableinterfaceimplrow_implinterface +tjclclrtableinterfaceimplrow_interfaceidx +tjclclrtableinterfaceimplrow_object +tjclclrtablemanifestresource +tjclclrtablemanifestresource_object +tjclclrtablemanifestresource_rows +tjclclrtablemanifestresource_tablerowclass +tjclclrtablemanifestresourcerow +tjclclrtablemanifestresourcerow_create +tjclclrtablemanifestresourcerow_dumpil +tjclclrtablemanifestresourcerow_flags +tjclclrtablemanifestresourcerow_implementationidx +tjclclrtablemanifestresourcerow_implementationrow +tjclclrtablemanifestresourcerow_name +tjclclrtablemanifestresourcerow_nameoffset +tjclclrtablemanifestresourcerow_object +tjclclrtablemanifestresourcerow_offset +tjclclrtablemanifestresourcerow_visibility +tjclclrtablememberref +tjclclrtablememberref_object +tjclclrtablememberref_rows +tjclclrtablememberref_tablerowclass +tjclclrtablememberrefrow +tjclclrtablememberrefrow_classidx +tjclclrtablememberrefrow_create +tjclclrtablememberrefrow_fullname +tjclclrtablememberrefrow_name +tjclclrtablememberrefrow_nameoffset +tjclclrtablememberrefrow_object +tjclclrtablememberrefrow_parentclass +tjclclrtablememberrefrow_signature +tjclclrtablememberrefrow_signatureoffset +tjclclrtablemethoddef +tjclclrtablemethoddef_object +tjclclrtablemethoddef_rows +tjclclrtablemethoddef_tablerowclass +tjclclrtablemethoddefrow +tjclclrtablemethoddefrow_codetype +tjclclrtablemethoddefrow_create +tjclclrtablemethoddefrow_destroy +tjclclrtablemethoddefrow_dumpil +tjclclrtablemethoddefrow_flags +tjclclrtablemethoddefrow_fullname +tjclclrtablemethoddefrow_hasparam +tjclclrtablemethoddefrow_implflags +tjclclrtablemethoddefrow_managed +tjclclrtablemethoddefrow_memberaccess +tjclclrtablemethoddefrow_methodbody +tjclclrtablemethoddefrow_methodflags +tjclclrtablemethoddefrow_methodimplflags +tjclclrtablemethoddefrow_name +tjclclrtablemethoddefrow_nameoffset +tjclclrtablemethoddefrow_newslot +tjclclrtablemethoddefrow_object +tjclclrtablemethoddefrow_paramcount +tjclclrtablemethoddefrow_paramlistidx +tjclclrtablemethoddefrow_params +tjclclrtablemethoddefrow_parenttoken +tjclclrtablemethoddefrow_rva +tjclclrtablemethoddefrow_setparenttoken +tjclclrtablemethoddefrow_signature +tjclclrtablemethoddefrow_signaturedata +tjclclrtablemethoddefrow_signatureoffset +tjclclrtablemethoddefrow_update +tjclclrtablemethodimpl +tjclclrtablemethodimpl_object +tjclclrtablemethodimpl_rows +tjclclrtablemethodimpl_tablerowclass +tjclclrtablemethodimplrow +tjclclrtablemethodimplrow_classidx +tjclclrtablemethodimplrow_create +tjclclrtablemethodimplrow_methodbodyidx +tjclclrtablemethodimplrow_methoddeclarationidx +tjclclrtablemethodimplrow_object +tjclclrtablemethodptr +tjclclrtablemethodptr_object +tjclclrtablemethodptr_rows +tjclclrtablemethodptr_tablerowclass +tjclclrtablemethodptrrow +tjclclrtablemethodptrrow_create +tjclclrtablemethodptrrow_method +tjclclrtablemethodptrrow_methodidx +tjclclrtablemethodptrrow_object +tjclclrtablemethodsemantics +tjclclrtablemethodsemantics_object +tjclclrtablemethodsemantics_rows +tjclclrtablemethodsemantics_tablerowclass +tjclclrtablemethodsemanticsrow +tjclclrtablemethodsemanticsrow_associationidx +tjclclrtablemethodsemanticsrow_create +tjclclrtablemethodsemanticsrow_methodidx +tjclclrtablemethodsemanticsrow_object +tjclclrtablemethodsemanticsrow_semantics +tjclclrtablemethodspec +tjclclrtablemethodspec_object +tjclclrtablemethodspec_rows +tjclclrtablemethodspec_tablerowclass +tjclclrtablemethodspecrow +tjclclrtablemethodspecrow_create +tjclclrtablemethodspecrow_instantiation +tjclclrtablemethodspecrow_instantiationoffset +tjclclrtablemethodspecrow_method +tjclclrtablemethodspecrow_methodidx +tjclclrtablemethodspecrow_object +tjclclrtablemodule +tjclclrtablemodule_object +tjclclrtablemodule_rows +tjclclrtablemodule_tablerowclass +tjclclrtablemoduleref +tjclclrtablemoduleref_object +tjclclrtablemoduleref_rows +tjclclrtablemoduleref_tablerowclass +tjclclrtablemodulerefrow +tjclclrtablemodulerefrow_create +tjclclrtablemodulerefrow_dumpil +tjclclrtablemodulerefrow_name +tjclclrtablemodulerefrow_nameoffset +tjclclrtablemodulerefrow_object +tjclclrtablemodulerow +tjclclrtablemodulerow_create +tjclclrtablemodulerow_dumpil +tjclclrtablemodulerow_encbaseid +tjclclrtablemodulerow_encbaseididx +tjclclrtablemodulerow_encid +tjclclrtablemodulerow_encididx +tjclclrtablemodulerow_generation +tjclclrtablemodulerow_hasencbaseid +tjclclrtablemodulerow_hasencid +tjclclrtablemodulerow_mvid +tjclclrtablemodulerow_mvididx +tjclclrtablemodulerow_name +tjclclrtablemodulerow_nameoffset +tjclclrtablemodulerow_object +tjclclrtablenestedclass +tjclclrtablenestedclass_object +tjclclrtablenestedclass_rows +tjclclrtablenestedclass_tablerowclass +tjclclrtablenestedclassrow +tjclclrtablenestedclassrow_create +tjclclrtablenestedclassrow_enclosingclassidx +tjclclrtablenestedclassrow_nestedclassidx +tjclclrtablenestedclassrow_object +tjclclrtableparamdef +tjclclrtableparamdef_object +tjclclrtableparamdef_rows +tjclclrtableparamdef_tablerowclass +tjclclrtableparamdefrow +tjclclrtableparamdefrow_create +tjclclrtableparamdefrow_dumpil +tjclclrtableparamdefrow_flagmask +tjclclrtableparamdefrow_flags +tjclclrtableparamdefrow_method +tjclclrtableparamdefrow_name +tjclclrtableparamdefrow_nameoffset +tjclclrtableparamdefrow_object +tjclclrtableparamdefrow_paramflags +tjclclrtableparamdefrow_sequence +tjclclrtableparamdefrow_setmethod +tjclclrtableparamptr +tjclclrtableparamptr_object +tjclclrtableparamptr_rows +tjclclrtableparamptr_tablerowclass +tjclclrtableparamptrrow +tjclclrtableparamptrrow_create +tjclclrtableparamptrrow_object +tjclclrtableparamptrrow_param +tjclclrtableparamptrrow_paramidx +tjclclrtablepropertydef +tjclclrtablepropertydef_object +tjclclrtablepropertydef_rows +tjclclrtablepropertydef_tablerowclass +tjclclrtablepropertydefrow +tjclclrtablepropertydefrow_create +tjclclrtablepropertydefrow_dumpil +tjclclrtablepropertydefrow_flags +tjclclrtablepropertydefrow_kindidx +tjclclrtablepropertydefrow_name +tjclclrtablepropertydefrow_nameoffset +tjclclrtablepropertydefrow_object +tjclclrtablepropertydefrow_rawflags +tjclclrtablepropertymap +tjclclrtablepropertymap_object +tjclclrtablepropertymap_rows +tjclclrtablepropertymap_tablerowclass +tjclclrtablepropertymap_update +tjclclrtablepropertymaprow +tjclclrtablepropertymaprow_add +tjclclrtablepropertymaprow_create +tjclclrtablepropertymaprow_destroy +tjclclrtablepropertymaprow_object +tjclclrtablepropertymaprow_parent +tjclclrtablepropertymaprow_parentidx +tjclclrtablepropertymaprow_properties +tjclclrtablepropertymaprow_propertycount +tjclclrtablepropertymaprow_propertylistidx +tjclclrtablepropertyptr +tjclclrtablepropertyptr_object +tjclclrtablepropertyptr_rows +tjclclrtablepropertyptr_tablerowclass +tjclclrtablepropertyptrrow +tjclclrtablepropertyptrrow__property +tjclclrtablepropertyptrrow_create +tjclclrtablepropertyptrrow_object +tjclclrtablepropertyptrrow_propertyidx +tjclclrtablerow +tjclclrtablerow_create +tjclclrtablerow_decoderesolutionscope +tjclclrtablerow_decodetypedeforref +tjclclrtablerow_dumpil +tjclclrtablerow_index +tjclclrtablerow_object +tjclclrtablerow_table +tjclclrtablerow_token +tjclclrtablerow_update +tjclclrtablestandalonesig +tjclclrtablestandalonesig_object +tjclclrtablestandalonesig_rows +tjclclrtablestandalonesig_tablerowclass +tjclclrtablestandalonesigrow +tjclclrtablestandalonesigrow_create +tjclclrtablestandalonesigrow_object +tjclclrtablestandalonesigrow_signature +tjclclrtablestandalonesigrow_signatureoffset +tjclclrtablestream +tjclclrtablestream_bigheap +tjclclrtablestream_create +tjclclrtablestream_destroy +tjclclrtablestream_dumpil +tjclclrtablestream_findtable +tjclclrtablestream_header +tjclclrtablestream_object +tjclclrtablestream_tablecount +tjclclrtablestream_tables +tjclclrtablestream_update +tjclclrtablestream_versionstring +tjclclrtabletypedef +tjclclrtabletypedef_object +tjclclrtabletypedef_rows +tjclclrtabletypedef_tablerowclass +tjclclrtabletypedefrow +tjclclrtabletypedefrow_attributes +tjclclrtabletypedefrow_classlayout +tjclclrtabletypedefrow_classsemantics +tjclclrtabletypedefrow_create +tjclclrtabletypedefrow_destroy +tjclclrtabletypedefrow_dumpil +tjclclrtabletypedefrow_extends +tjclclrtabletypedefrow_extendsidx +tjclclrtabletypedefrow_fieldcount +tjclclrtabletypedefrow_fieldlistidx +tjclclrtabletypedefrow_fields +tjclclrtabletypedefrow_flags +tjclclrtabletypedefrow_fullname +tjclclrtabletypedefrow_hasfield +tjclclrtabletypedefrow_hasmethod +tjclclrtabletypedefrow_methodcount +tjclclrtabletypedefrow_methodlistidx +tjclclrtabletypedefrow_methods +tjclclrtabletypedefrow_name +tjclclrtabletypedefrow_nameoffset +tjclclrtabletypedefrow_namespace +tjclclrtabletypedefrow_namespaceoffset +tjclclrtabletypedefrow_object +tjclclrtabletypedefrow_stringformatting +tjclclrtabletypedefrow_update +tjclclrtabletypedefrow_visibility +tjclclrtabletyperef +tjclclrtabletyperef_object +tjclclrtabletyperef_rows +tjclclrtabletyperef_tablerowclass +tjclclrtabletyperefrow +tjclclrtabletyperefrow_create +tjclclrtabletyperefrow_dumpil +tjclclrtabletyperefrow_fullname +tjclclrtabletyperefrow_name +tjclclrtabletyperefrow_nameoffset +tjclclrtabletyperefrow_namespace +tjclclrtabletyperefrow_namespaceoffset +tjclclrtabletyperefrow_object +tjclclrtabletyperefrow_resolutionscope +tjclclrtabletyperefrow_resolutionscopeidx +tjclclrtabletyperefrow_resolutionscopename +tjclclrtabletypespec +tjclclrtabletypespec_object +tjclclrtabletypespec_rows +tjclclrtabletypespec_tablerowclass +tjclclrtabletypespecrow +tjclclrtabletypespecrow_create +tjclclrtabletypespecrow_object +tjclclrtabletypespecrow_signature +tjclclrtabletypespecrow_signatureoffset +tjclclruserstringstream +tjclclruserstringstream_at +tjclclruserstringstream_object +tjclclruserstringstream_offsets +tjclclruserstringstream_stringcount +tjclclruserstringstream_strings +tjclclrvtablefixuprecord +tjclclrvtablefixuprecord_count +tjclclrvtablefixuprecord_create +tjclclrvtablefixuprecord_data +tjclclrvtablefixuprecord_kinds +tjclclrvtablefixuprecord_object +tjclclrvtablefixuprecord_rva +tjclclrvtablefixuprecord_vtablekinds +tjclcommandlinetool +tjclcommandlinetool_addpathoption +tjclcommandlinetool_create +tjclcommandlinetool_destroy +tjclcommandlinetool_execute +tjclcommandlinetool_exename +tjclcommandlinetool_getexename +tjclcommandlinetool_getoptions +tjclcommandlinetool_getoutput +tjclcommandlinetool_getoutputcallback +tjclcommandlinetool_object +tjclcommandlinetool_output +tjclcommandlinetool_setoutputcallback +tjclcomplex +tjclcomplex_absolutevalue +tjclcomplex_absolutevaluesqr +tjclcomplex_angle +tjclcomplex_aspolarstring +tjclcomplex_assign +tjclcomplex_assignone +tjclcomplex_assignzero +tjclcomplex_asstring +tjclcomplex_cadd +tjclcomplex_capproxlngamma +tjclcomplex_cconjugate +tjclcomplex_ccos +tjclcomplex_ccosh +tjclcomplex_ccot +tjclcomplex_ccoth +tjclcomplex_ccsc +tjclcomplex_ccsch +tjclcomplex_cdiv +tjclcomplex_cexp +tjclcomplex_cgamma +tjclcomplex_ci0 +tjclcomplex_cintpwr +tjclcomplex_cj0 +tjclcomplex_cln +tjclcomplex_clngamma +tjclcomplex_cmul +tjclcomplex_cneg +tjclcomplex_cnewadd +tjclcomplex_cnewapproxlngamma +tjclcomplex_cnewconjugate +tjclcomplex_cnewcos +tjclcomplex_cnewcosh +tjclcomplex_cnewcot +tjclcomplex_cnewcoth +tjclcomplex_cnewcsc +tjclcomplex_cnewcsch +tjclcomplex_cnewdiv +tjclcomplex_cnewexp +tjclcomplex_cnewgamma +tjclcomplex_cnewi0 +tjclcomplex_cnewintpwr +tjclcomplex_cnewj0 +tjclcomplex_cnewln +tjclcomplex_cnewlngamma +tjclcomplex_cnewmul +tjclcomplex_cnewneg +tjclcomplex_cnewpwr +tjclcomplex_cnewrealpwr +tjclcomplex_cnewroot +tjclcomplex_cnewsec +tjclcomplex_cnewsech +tjclcomplex_cnewsin +tjclcomplex_cnewsinh +tjclcomplex_cnewsqrt +tjclcomplex_cnewsub +tjclcomplex_cnewtan +tjclcomplex_cnewtanh +tjclcomplex_coreadd +tjclcomplex_coreapproxlngamma +tjclcomplex_corecos +tjclcomplex_corecosh +tjclcomplex_corecot +tjclcomplex_corecoth +tjclcomplex_corecsc +tjclcomplex_corecsch +tjclcomplex_corediv +tjclcomplex_coreexp +tjclcomplex_coregamma +tjclcomplex_corei0 +tjclcomplex_coreintpwr +tjclcomplex_corej0 +tjclcomplex_coreln +tjclcomplex_corelngamma +tjclcomplex_coremul +tjclcomplex_corepwr +tjclcomplex_corerealpwr +tjclcomplex_coreroot +tjclcomplex_coresec +tjclcomplex_coresech +tjclcomplex_coresin +tjclcomplex_coresinh +tjclcomplex_coresub +tjclcomplex_coretan +tjclcomplex_coretanh +tjclcomplex_cpwr +tjclcomplex_crealpwr +tjclcomplex_create +tjclcomplex_croot +tjclcomplex_csec +tjclcomplex_csech +tjclcomplex_csin +tjclcomplex_csinh +tjclcomplex_csqrt +tjclcomplex_csub +tjclcomplex_ctan +tjclcomplex_ctanh +tjclcomplex_duplicate +tjclcomplex_formatextended +tjclcomplex_fraclength +tjclcomplex_imaginarypart +tjclcomplex_object +tjclcomplex_radius +tjclcomplex_realpart +tjclcompressionstream +tjclcompressionstream_create +tjclcompressionstream_destroy +tjclcompressionstream_object +tjclcompressionstream_onprogress +tjclcompressionstream_progress +tjclcompressionstream_read +tjclcompressionstream_reset +tjclcompressionstream_seek +tjclcompressionstream_setbuffersize +tjclcompressionstream_write +tjclcompressstream +tjclcompressstream_create +tjclcompressstream_flush +tjclcompressstream_object +tjclconsole +tjclconsole_activescreen +tjclconsole_activescreenindex +tjclconsole_add +tjclconsole_alloc +tjclconsole_create +tjclconsole_default +tjclconsole_delete +tjclconsole_destroy +tjclconsole_free +tjclconsole_input +tjclconsole_inputcodepage +tjclconsole_isconsole +tjclconsole_mousebuttoncount +tjclconsole_object +tjclconsole_onclose +tjclconsole_onctrlbreak +tjclconsole_onctrlc +tjclconsole_onlogoff +tjclconsole_onshutdown +tjclconsole_outputcodepage +tjclconsole_remove +tjclconsole_screencount +tjclconsole_screens +tjclconsole_shutdown +tjclconsole_title +tjclconstantsymbolinfo +tjclconstantsymbolinfo_create +tjclconstantsymbolinfo_nameindex +tjclconstantsymbolinfo_object +tjclconstantsymbolinfo_typeindex +tjclconstantsymbolinfo_value +tjclcounter +tjclcounter_continue +tjclcounter_counting +tjclcounter_create +tjclcounter_elapsedtime +tjclcounter_getrunelapsedtime +tjclcounter_object +tjclcounter_overhead +tjclcounter_runelapsedtime +tjclcounter_start +tjclcounter_stop +tjclcriticalsection +tjclcriticalsection_create +tjclcriticalsection_createandenter +tjclcriticalsection_destroy +tjclcriticalsection_enter +tjclcriticalsection_leave +tjclcriticalsection_object +tjclcriticalsectionex +tjclcriticalsectionex_create +tjclcriticalsectionex_createex +tjclcriticalsectionex_getspintimeout +tjclcriticalsectionex_object +tjclcriticalsectionex_setspintimeout +tjclcriticalsectionex_spincount +tjclcriticalsectionex_tryenter +tjclcustomfileattrmask +tjclcustomfileattrmask_archive +tjclcustomfileattrmask_assign +tjclcustomfileattrmask_attribute +tjclcustomfileattrmask_clear +tjclcustomfileattrmask_compressed +tjclcustomfileattrmask_create +tjclcustomfileattrmask_defineproperties +tjclcustomfileattrmask_directory +tjclcustomfileattrmask_encrypted +tjclcustomfileattrmask_hidden +tjclcustomfileattrmask_match +tjclcustomfileattrmask_normal +tjclcustomfileattrmask_notcontentindexed +tjclcustomfileattrmask_object +tjclcustomfileattrmask_offline +tjclcustomfileattrmask_readonly +tjclcustomfileattrmask_rejected +tjclcustomfileattrmask_reparsepoint +tjclcustomfileattrmask_required +tjclcustomfileattrmask_sparsefile +tjclcustomfileattrmask_symlink +tjclcustomfileattrmask_system +tjclcustomfileattrmask_temporary +tjclcustomfileattrmask_volumeid +tjclcustomfilemapping +tjclcustomfilemapping_add +tjclcustomfilemapping_addat +tjclcustomfilemapping_clearviews +tjclcustomfilemapping_count +tjclcustomfilemapping_create +tjclcustomfilemapping_delete +tjclcustomfilemapping_destroy +tjclcustomfilemapping_existed +tjclcustomfilemapping_handle +tjclcustomfilemapping_indexof +tjclcustomfilemapping_internalcreate +tjclcustomfilemapping_internalopen +tjclcustomfilemapping_name +tjclcustomfilemapping_object +tjclcustomfilemapping_open +tjclcustomfilemapping_roundviewoffset +tjclcustomfilemapping_views +tjclcustommap +tjclcustommap_delete +tjclcustommap_empty +tjclcustommap_height +tjclcustommap_object +tjclcustommap_setsize +tjclcustommap_width +tjcldatasymbolinfo +tjcldatasymbolinfo_create +tjcldatasymbolinfo_nameindex +tjcldatasymbolinfo_object +tjcldatasymbolinfo_offset +tjcldatasymbolinfo_typeindex +tjcldcc32 +tjcldcc32_addprojectoptions +tjcldcc32_compile +tjcldcc32_create +tjcldcc32_execute +tjcldcc32_getexename +tjcldcc32_makepackage +tjcldcc32_makeproject +tjcldcc32_object +tjcldcc32_saveoptionstofile +tjcldcc32_setdefaultoptions +tjcldcc32_supportslibsuffix +tjcldebuginfobinary +tjcldebuginfobinary_destroy +tjcldebuginfobinary_getlocationinfo +tjcldebuginfobinary_initializesource +tjcldebuginfobinary_object +tjcldebuginfoexports +tjcldebuginfoexports_destroy +tjcldebuginfoexports_getlocationinfo +tjcldebuginfoexports_initializesource +tjcldebuginfoexports_object +tjcldebuginfolist +tjcldebuginfolist_createdebuginfo +tjcldebuginfolist_getlocationinfo +tjcldebuginfolist_itemfrommodule +tjcldebuginfolist_items +tjcldebuginfolist_object +tjcldebuginfomap +tjcldebuginfomap_destroy +tjcldebuginfomap_getlocationinfo +tjcldebuginfomap_initializesource +tjcldebuginfomap_object +tjcldebuginfosource +tjcldebuginfosource_create +tjcldebuginfosource_filename +tjcldebuginfosource_getlocationinfo +tjcldebuginfosource_initializesource +tjcldebuginfosource_module +tjcldebuginfosource_object +tjcldebuginfosource_vafromaddr +tjcldebuginfotd32 +tjcldebuginfotd32_destroy +tjcldebuginfotd32_getlocationinfo +tjcldebuginfotd32_initializesource +tjcldebuginfotd32_object +tjcldebugthread +tjcldebugthread_create +tjcldebugthread_destroy +tjcldebugthread_donotify +tjcldebugthread_dosynchandleexception +tjcldebugthread_handleexception +tjcldebugthread_object +tjcldebugthread_syncexception +tjcldebugthread_threadinfo +tjcldebugthread_threadname +tjcldebugthreadlist +tjcldebugthreadlist_create +tjcldebugthreadlist_destroy +tjcldebugthreadlist_dosyncexception +tjcldebugthreadlist_dothreadregistered +tjcldebugthreadlist_dothreadunregistered +tjcldebugthreadlist_internalregisterthread +tjcldebugthreadlist_internalunregisterthread +tjcldebugthreadlist_lock +tjcldebugthreadlist_object +tjcldebugthreadlist_onsyncexception +tjcldebugthreadlist_onthreadregistered +tjcldebugthreadlist_onthreadunregistered +tjcldebugthreadlist_registerthread +tjcldebugthreadlist_threadclassnames +tjcldebugthreadlist_threadidcount +tjcldebugthreadlist_threadids +tjcldebugthreadlist_threadinfos +tjcldebugthreadlist_threadnames +tjcldebugthreadlist_unregisterthread +tjcldecompressstream +tjcldecompressstream_create +tjcldecompressstream_object +tjcldefaultunitversioningprovider +tjcldefaultunitversioningprovider_create +tjcldefaultunitversioningprovider_destroy +tjcldefaultunitversioningprovider_loadmoduleunitversioninginfo +tjcldefaultunitversioningprovider_object +tjcldefaultunitversioningprovider_releasemoduleunitversioninginfo +tjcldelphiinstallation +tjcldelphiinstallation_configfilename +tjcldelphiinstallation_create +tjcldelphiinstallation_destroy +tjcldelphiinstallation_getenvironmentvariables +tjcldelphiinstallation_getlatestupdatepackforversion +tjcldelphiinstallation_installpackage +tjcldelphiinstallation_object +tjcldelphiinstallation_packagesourcefileextension +tjcldelphiinstallation_projectsourcefileextension +tjcldelphiinstallation_radtoolkind +tjcldelphiinstallation_radtoolname +tjcldesktopcanvas +tjcldesktopcanvas_object +tjcldispatcherobject +tjcldispatcherobject_attach +tjcldispatcherobject_destroy +tjcldispatcherobject_existed +tjcldispatcherobject_handle +tjcldispatcherobject_name +tjcldispatcherobject_object +tjcldispatcherobject_signalandwait +tjcldispatcherobject_waitalertable +tjcldispatcherobject_waitfor +tjcldispatcherobject_waitforever +tjclemail +tjclemail_address +tjclemail_attachments +tjclemail_beforeunloadclientlib +tjclemail_body +tjclemail_clear +tjclemail_create +tjclemail_decoderecips +tjclemail_delete +tjclemail_destroy +tjclemail_findfirstmessage +tjclemail_findnextmessage +tjclemail_findoptions +tjclemail_htmlbody +tjclemail_internalsendorsave +tjclemail_logoff +tjclemail_logon +tjclemail_logonoptions +tjclemail_logonoptionstoflags +tjclemail_messagereport +tjclemail_object +tjclemail_parentwnd +tjclemail_read +tjclemail_readmsg +tjclemail_recipients +tjclemail_resolvename +tjclemail_restoretaskwindows +tjclemail_save +tjclemail_savetaskwindows +tjclemail_seedmessageid +tjclemail_send +tjclemail_sessionhandle +tjclemail_sortattachments +tjclemail_subject +tjclemail_userlogged +tjclemailrecip +tjclemailrecip_address +tjclemailrecip_addressandname +tjclemailrecip_addresstype +tjclemailrecip_kind +tjclemailrecip_name +tjclemailrecip_object +tjclemailrecip_recipkindtostring +tjclemailrecip_sortingname +tjclemailrecips +tjclemailrecips_add +tjclemailrecips_addressestype +tjclemailrecips_items +tjclemailrecips_object +tjclemailrecips_originator +tjclemailrecips_sortrecips +tjclevent +tjclevent_create +tjclevent_object +tjclevent_open +tjclevent_pulse +tjclevent_resetevent +tjclevent_setevent +tjclexceptframe +tjclexceptframe_codelocation +tjclexceptframe_create +tjclexceptframe_dodetermineframekind +tjclexceptframe_excframe +tjclexceptframe_framekind +tjclexceptframe_handlerinfo +tjclexceptframe_handles +tjclexceptframe_object +tjclexceptframelist +tjclexceptframelist_addframe +tjclexceptframelist_create +tjclexceptframelist_ignorelevels +tjclexceptframelist_items +tjclexceptframelist_object +tjclexceptframelist_traceexceptionframes +tjclfileattributemask +tjclfileattributemask_archive +tjclfileattributemask_compressed +tjclfileattributemask_directory +tjclfileattributemask_encrypted +tjclfileattributemask_hidden +tjclfileattributemask_normal +tjclfileattributemask_notcontentindexed +tjclfileattributemask_object +tjclfileattributemask_offline +tjclfileattributemask_readonly +tjclfileattributemask_reparsepoint +tjclfileattributemask_sparsefile +tjclfileattributemask_symlink +tjclfileattributemask_system +tjclfileattributemask_temporary +tjclfileattributemask_volumeid +tjclfileenumerator +tjclfileenumerator__addref +tjclfileenumerator__release +tjclfileenumerator_afterconstruction +tjclfileenumerator_assign +tjclfileenumerator_attributemask +tjclfileenumerator_casesensitivesearch +tjclfileenumerator_create +tjclfileenumerator_createtask +tjclfileenumerator_destroy +tjclfileenumerator_filemask +tjclfileenumerator_filemasks +tjclfileenumerator_filesizemax +tjclfileenumerator_filesizemin +tjclfileenumerator_filllist +tjclfileenumerator_foreach +tjclfileenumerator_frefcount +tjclfileenumerator_getattributemask +tjclfileenumerator_getfilemask +tjclfileenumerator_getfilemasks +tjclfileenumerator_getfilesizemax +tjclfileenumerator_getfilesizemin +tjclfileenumerator_getincludehiddensubdirectories +tjclfileenumerator_getincludesubdirectories +tjclfileenumerator_getlastchangeafter +tjclfileenumerator_getlastchangeafterstr +tjclfileenumerator_getlastchangebefore +tjclfileenumerator_getlastchangebeforestr +tjclfileenumerator_getonenterdirectory +tjclfileenumerator_getonterminatetask +tjclfileenumerator_getoption +tjclfileenumerator_getoptions +tjclfileenumerator_getrootdirectory +tjclfileenumerator_getrunningtasks +tjclfileenumerator_getsubdirectorymask +tjclfileenumerator_getsynchronizationmode +tjclfileenumerator_includehiddensubdirectories +tjclfileenumerator_includesubdirectories +tjclfileenumerator_lastchangeafter +tjclfileenumerator_lastchangeafterasstring +tjclfileenumerator_lastchangebefore +tjclfileenumerator_lastchangebeforeasstring +tjclfileenumerator_nexttaskid +tjclfileenumerator_object +tjclfileenumerator_onenterdirectory +tjclfileenumerator_onterminatetask +tjclfileenumerator_options +tjclfileenumerator_queryinterface +tjclfileenumerator_rootdirectory +tjclfileenumerator_runningtasks +tjclfileenumerator_searchoption +tjclfileenumerator_setattributemask +tjclfileenumerator_setfilemask +tjclfileenumerator_setfilemasks +tjclfileenumerator_setfilesizemax +tjclfileenumerator_setfilesizemin +tjclfileenumerator_setincludehiddensubdirectories +tjclfileenumerator_setincludesubdirectories +tjclfileenumerator_setlastchangeafter +tjclfileenumerator_setlastchangeafterstr +tjclfileenumerator_setlastchangebefore +tjclfileenumerator_setlastchangebeforestr +tjclfileenumerator_setonenterdirectory +tjclfileenumerator_setonterminatetask +tjclfileenumerator_setoption +tjclfileenumerator_setoptions +tjclfileenumerator_setrootdirectory +tjclfileenumerator_setsubdirectorymask +tjclfileenumerator_setsynchronizationmode +tjclfileenumerator_stopalltasks +tjclfileenumerator_stoptask +tjclfileenumerator_subdirectorymask +tjclfileenumerator_synchronizationmode +tjclfileenumerator_taskterminated +tjclfilemapping +tjclfilemapping_create +tjclfilemapping_destroy +tjclfilemapping_filehandle +tjclfilemapping_object +tjclfilemappingstream +tjclfilemappingstream_close +tjclfilemappingstream_create +tjclfilemappingstream_destroy +tjclfilemappingstream_object +tjclfilemappingstream_write +tjclfilemappingview +tjclfilemappingview_create +tjclfilemappingview_createat +tjclfilemappingview_destroy +tjclfilemappingview_filemapping +tjclfilemappingview_flush +tjclfilemappingview_index +tjclfilemappingview_loadfromfile +tjclfilemappingview_loadfromstream +tjclfilemappingview_object +tjclfilemappingview_offset +tjclfilemappingview_write +tjclfilemaskcomparator +tjclfilemaskcomparator_compare +tjclfilemaskcomparator_count +tjclfilemaskcomparator_create +tjclfilemaskcomparator_exts +tjclfilemaskcomparator_filemask +tjclfilemaskcomparator_masks +tjclfilemaskcomparator_names +tjclfilemaskcomparator_object +tjclfilemaskcomparator_separator +tjclfileversioninfo +tjclfileversioninfo_attach +tjclfileversioninfo_binfileversion +tjclfileversioninfo_binproductversion +tjclfileversioninfo_checklanguageindex +tjclfileversioninfo_comments +tjclfileversioninfo_companyname +tjclfileversioninfo_create +tjclfileversioninfo_createitemsforlanguage +tjclfileversioninfo_destroy +tjclfileversioninfo_extractdata +tjclfileversioninfo_extractflags +tjclfileversioninfo_filedescription +tjclfileversioninfo_fileflags +tjclfileversioninfo_fileos +tjclfileversioninfo_filesubtype +tjclfileversioninfo_filetype +tjclfileversioninfo_fileversion +tjclfileversioninfo_fixedinfo +tjclfileversioninfo_getbinfileversion +tjclfileversioninfo_getbinproductversion +tjclfileversioninfo_getfileos +tjclfileversioninfo_getfilesubtype +tjclfileversioninfo_getfiletype +tjclfileversioninfo_getversionkeyvalue +tjclfileversioninfo_internalname +tjclfileversioninfo_items +tjclfileversioninfo_languagecount +tjclfileversioninfo_languageids +tjclfileversioninfo_languageindex +tjclfileversioninfo_languagenames +tjclfileversioninfo_languages +tjclfileversioninfo_legalcopyright +tjclfileversioninfo_legaltrademarks +tjclfileversioninfo_object +tjclfileversioninfo_originalfilename +tjclfileversioninfo_privatebuild +tjclfileversioninfo_productname +tjclfileversioninfo_productversion +tjclfileversioninfo_specialbuild +tjclfileversioninfo_translationcount +tjclfileversioninfo_translationmatcheslanguages +tjclfileversioninfo_translations +tjclfileversioninfo_versionlanguageid +tjclfileversioninfo_versionlanguagename +tjclflatset +tjclflatset_clear +tjclflatset_create +tjclflatset_destroy +tjclflatset_getbit +tjclflatset_getrange +tjclflatset_invert +tjclflatset_object +tjclflatset_setbit +tjclflatset_setrange +tjclgdatasymbolinfo +tjclgdatasymbolinfo_object +tjclglobalprocsymbolinfo +tjclglobalprocsymbolinfo_object +tjclgzipcompressionstream +tjclgzipcompressionstream_object +tjclgzipdecompressionstream +tjclgzipdecompressionstream_object +tjclhashmap +tjclhashmap_clear +tjclhashmap_clone +tjclhashmap_containskey +tjclhashmap_containsvalue +tjclhashmap_create +tjclhashmap_destroy +tjclhashmap_equals +tjclhashmap_freeobject +tjclhashmap_getvalue +tjclhashmap_growentries +tjclhashmap_hashfunction +tjclhashmap_isempty +tjclhashmap_keyset +tjclhashmap_object +tjclhashmap_ownsobjects +tjclhashmap_putall +tjclhashmap_putvalue +tjclhashmap_remove +tjclhashmap_size +tjclhashmap_values +tjclhashset +tjclhashset_add +tjclhashset_addall +tjclhashset_clear +tjclhashset_clone +tjclhashset_contains +tjclhashset_containsall +tjclhashset_create +tjclhashset_destroy +tjclhashset_equals +tjclhashset_first +tjclhashset_intersect +tjclhashset_isempty +tjclhashset_last +tjclhashset_object +tjclhashset_remove +tjclhashset_removeall +tjclhashset_retainall +tjclhashset_size +tjclhashset_subtract +tjclhashset_union +tjclinfostringswriter +tjclinfostringswriter_create +tjclinfostringswriter_object +tjclinfostringswriter_primwrite +tjclinfostringswriter_strings +tjclinfowriter +tjclinfowriter_create +tjclinfowriter_curline +tjclinfowriter_destroy +tjclinfowriter_dowrap +tjclinfowriter_dowritecompletelines +tjclinfowriter_getwrap +tjclinfowriter_indent +tjclinfowriter_indentlevel +tjclinfowriter_object +tjclinfowriter_outdent +tjclinfowriter_primwrite +tjclinfowriter_setwrap +tjclinfowriter_wrap +tjclinfowriter_write +tjclinfowriter_writeln +tjclinputbuffer +tjclinputbuffer_clear +tjclinputbuffer_console +tjclinputbuffer_create +tjclinputbuffer_destroy +tjclinputbuffer_eventcount +tjclinputbuffer_getevent +tjclinputbuffer_getevents +tjclinputbuffer_handle +tjclinputbuffer_mode +tjclinputbuffer_object +tjclinputbuffer_peekevent +tjclinputbuffer_peekevents +tjclinputbuffer_putevent +tjclinputbuffer_putevents +tjclinputbuffer_raisectrlevent +tjclinputbuffer_waitevent +tjclinstruction +tjclinstruction_create +tjclinstruction_description +tjclinstruction_dumpil +tjclinstruction_dumpiloption +tjclinstruction_fullname +tjclinstruction_getsize +tjclinstruction_load +tjclinstruction_name +tjclinstruction_object +tjclinstruction_offset +tjclinstruction_opcode +tjclinstruction_owner +tjclinstruction_param +tjclinstruction_paramtype +tjclinstruction_realopcode +tjclinstruction_save +tjclinstruction_size +tjclinstruction_wideopcode +tjclintfarraylist +tjclintfarraylist_add +tjclintfarraylist_addall +tjclintfarraylist_capacity +tjclintfarraylist_clear +tjclintfarraylist_clone +tjclintfarraylist_contains +tjclintfarraylist_containsall +tjclintfarraylist_create +tjclintfarraylist_destroy +tjclintfarraylist_equals +tjclintfarraylist_first +tjclintfarraylist_getobject +tjclintfarraylist_grow +tjclintfarraylist_indexof +tjclintfarraylist_insert +tjclintfarraylist_insertall +tjclintfarraylist_isempty +tjclintfarraylist_last +tjclintfarraylist_lastindexof +tjclintfarraylist_object +tjclintfarraylist_remove +tjclintfarraylist_removeall +tjclintfarraylist_retainall +tjclintfarraylist_setobject +tjclintfarraylist_size +tjclintfarraylist_sublist +tjclintfarrayset +tjclintfarrayset_add +tjclintfarrayset_addall +tjclintfarrayset_contains +tjclintfarrayset_insert +tjclintfarrayset_intersect +tjclintfarrayset_object +tjclintfarrayset_subtract +tjclintfarrayset_union +tjclintfbinarynode +tjclintfbinarynode_color +tjclintfbinarynode_left +tjclintfbinarynode_object +tjclintfbinarynode_parent +tjclintfbinarynode_right +tjclintfbinarynode_tjclintfbinarynode=recordobj +tjclintfbinarytree +tjclintfbinarytree_add +tjclintfbinarytree_addall +tjclintfbinarytree_clear +tjclintfbinarytree_clone +tjclintfbinarytree_contains +tjclintfbinarytree_containsall +tjclintfbinarytree_create +tjclintfbinarytree_destroy +tjclintfbinarytree_equals +tjclintfbinarytree_first +tjclintfbinarytree_gettraverseorder +tjclintfbinarytree_isempty +tjclintfbinarytree_last +tjclintfbinarytree_object +tjclintfbinarytree_remove +tjclintfbinarytree_removeall +tjclintfbinarytree_retainall +tjclintfbinarytree_settraverseorder +tjclintfbinarytree_size +tjclintfcriticalsection +tjclintfcriticalsection__addref +tjclintfcriticalsection__release +tjclintfcriticalsection_create +tjclintfcriticalsection_destroy +tjclintfcriticalsection_object +tjclintfcriticalsection_queryinterface +tjclintfhashset +tjclintfhashset_add +tjclintfhashset_addall +tjclintfhashset_clear +tjclintfhashset_clone +tjclintfhashset_contains +tjclintfhashset_containsall +tjclintfhashset_create +tjclintfhashset_destroy +tjclintfhashset_equals +tjclintfhashset_first +tjclintfhashset_intersect +tjclintfhashset_isempty +tjclintfhashset_last +tjclintfhashset_object +tjclintfhashset_remove +tjclintfhashset_removeall +tjclintfhashset_retainall +tjclintfhashset_size +tjclintfhashset_subtract +tjclintfhashset_union +tjclintfintfbucket +tjclintfintfbucket_entries +tjclintfintfbucket_object +tjclintfintfbucket_tjclintfintfbucket=recordcount +tjclintfintfhashmap +tjclintfintfhashmap_clear +tjclintfintfhashmap_clone +tjclintfintfhashmap_containskey +tjclintfintfhashmap_containsvalue +tjclintfintfhashmap_create +tjclintfintfhashmap_destroy +tjclintfintfhashmap_equals +tjclintfintfhashmap_getvalue +tjclintfintfhashmap_growentries +tjclintfintfhashmap_hashfunction +tjclintfintfhashmap_isempty +tjclintfintfhashmap_keyset +tjclintfintfhashmap_object +tjclintfintfhashmap_putall +tjclintfintfhashmap_putvalue +tjclintfintfhashmap_remove +tjclintfintfhashmap_size +tjclintfintfhashmap_values +tjclintflinkedlist +tjclintflinkedlist_add +tjclintflinkedlist_addall +tjclintflinkedlist_addfirst +tjclintflinkedlist_clear +tjclintflinkedlist_clone +tjclintflinkedlist_contains +tjclintflinkedlist_containsall +tjclintflinkedlist_create +tjclintflinkedlist_destroy +tjclintflinkedlist_equals +tjclintflinkedlist_first +tjclintflinkedlist_getobject +tjclintflinkedlist_indexof +tjclintflinkedlist_insert +tjclintflinkedlist_insertall +tjclintflinkedlist_isempty +tjclintflinkedlist_last +tjclintflinkedlist_lastindexof +tjclintflinkedlist_object +tjclintflinkedlist_remove +tjclintflinkedlist_removeall +tjclintflinkedlist_retainall +tjclintflinkedlist_setobject +tjclintflinkedlist_size +tjclintflinkedlist_sublist +tjclintflinkedlistitem +tjclintflinkedlistitem_next +tjclintflinkedlistitem_object +tjclintflinkedlistitem_tjclintflinkedlistitem=recordobj +tjclintfqueue +tjclintfqueue_contains +tjclintfqueue_create +tjclintfqueue_dequeue +tjclintfqueue_empty +tjclintfqueue_enqueue +tjclintfqueue_object +tjclintfqueue_size +tjclintfstack +tjclintfstack_contains +tjclintfstack_create +tjclintfstack_empty +tjclintfstack_grow +tjclintfstack_object +tjclintfstack_pop +tjclintfstack_push +tjclintfstack_size +tjclintfvector +tjclintfvector_add +tjclintfvector_addall +tjclintfvector_afterconstruction +tjclintfvector_beforedestruction +tjclintfvector_clear +tjclintfvector_clone +tjclintfvector_contains +tjclintfvector_containsall +tjclintfvector_create +tjclintfvector_destroy +tjclintfvector_equals +tjclintfvector_first +tjclintfvector_getobject +tjclintfvector_grow +tjclintfvector_indexof +tjclintfvector_insert +tjclintfvector_insertall +tjclintfvector_isempty +tjclintfvector_items +tjclintfvector_last +tjclintfvector_lastindexof +tjclintfvector_object +tjclintfvector_remove +tjclintfvector_removeall +tjclintfvector_retainall +tjclintfvector_setobject +tjclintfvector_size +tjclintfvector_sublist +tjclkeyboardlayout +tjclkeyboardlayout_activate +tjclkeyboardlayout_create +tjclkeyboardlayout_destroy +tjclkeyboardlayout_devicehandle +tjclkeyboardlayout_displayname +tjclkeyboardlayout_layout +tjclkeyboardlayout_localeid +tjclkeyboardlayout_localeinfo +tjclkeyboardlayout_object +tjclkeyboardlayout_unload +tjclkeyboardlayout_variationname +tjclkeyboardlayoutlist +tjclkeyboardlayoutlist_activatenextlayout +tjclkeyboardlayoutlist_activateprevlayout +tjclkeyboardlayoutlist_activelayout +tjclkeyboardlayoutlist_availablelayoutcount +tjclkeyboardlayoutlist_availablelayouts +tjclkeyboardlayoutlist_count +tjclkeyboardlayoutlist_create +tjclkeyboardlayoutlist_createavailablelayouts +tjclkeyboardlayoutlist_destroy +tjclkeyboardlayoutlist_dorefresh +tjclkeyboardlayoutlist_itemfromhkl +tjclkeyboardlayoutlist_items +tjclkeyboardlayoutlist_layoutfromlocaleid +tjclkeyboardlayoutlist_loadlayout +tjclkeyboardlayoutlist_object +tjclkeyboardlayoutlist_onrefresh +tjclkeyboardlayoutlist_refresh +tjcllabelsymbolinfo +tjcllabelsymbolinfo_create +tjcllabelsymbolinfo_nameindex +tjcllabelsymbolinfo_object +tjcllabelsymbolinfo_offset +tjclldatasymbolinfo +tjclldatasymbolinfo_object +tjcllineartransformation +tjcllineartransformation_a +tjcllineartransformation_b +tjcllineartransformation_c +tjcllineartransformation_clear +tjcllineartransformation_create +tjcllineartransformation_d +tjcllineartransformation_e +tjcllineartransformation_f +tjcllineartransformation_gettransformedbounds +tjcllineartransformation_matrix +tjcllineartransformation_object +tjcllineartransformation_preparetransform +tjcllineartransformation_rotate +tjcllineartransformation_scale +tjcllineartransformation_skew +tjcllineartransformation_transform +tjcllineartransformation_transform256 +tjcllineartransformation_translate +tjcllineinfo +tjcllineinfo_create +tjcllineinfo_lineno +tjcllineinfo_object +tjcllineinfo_offset +tjcllinkedlist +tjcllinkedlist_add +tjcllinkedlist_addall +tjcllinkedlist_addfirst +tjcllinkedlist_clear +tjcllinkedlist_clone +tjcllinkedlist_contains +tjcllinkedlist_containsall +tjcllinkedlist_create +tjcllinkedlist_destroy +tjcllinkedlist_equals +tjcllinkedlist_first +tjcllinkedlist_freeobject +tjcllinkedlist_getobject +tjcllinkedlist_indexof +tjcllinkedlist_insert +tjcllinkedlist_insertall +tjcllinkedlist_isempty +tjcllinkedlist_last +tjcllinkedlist_lastindexof +tjcllinkedlist_object +tjcllinkedlist_ownsobjects +tjcllinkedlist_remove +tjcllinkedlist_removeall +tjcllinkedlist_retainall +tjcllinkedlist_setobject +tjcllinkedlist_size +tjcllinkedlist_sublist +tjcllinkedlistitem +tjcllinkedlistitem_next +tjcllinkedlistitem_object +tjcllinkedlistitem_tjcllinkedlistitem=recordobj +tjcllocaleinfo +tjcllocaleinfo_abbreviatedcountryname +tjcllocaleinfo_abbreviateddaynames +tjcllocaleinfo_abbreviatedlangname +tjcllocaleinfo_abbreviatedmonthnames +tjcllocaleinfo_additionalcaledartypes +tjcllocaleinfo_amdesignator +tjcllocaleinfo_calendarintegerinfo +tjcllocaleinfo_calendars +tjcllocaleinfo_calendarstringinfo +tjcllocaleinfo_calendartype +tjcllocaleinfo_caltwodigityearmax +tjcllocaleinfo_centuryformatspecifier +tjcllocaleinfo_charinfo +tjcllocaleinfo_codepageansi +tjcllocaleinfo_codepagemac +tjcllocaleinfo_codepageoem +tjcllocaleinfo_countrycode +tjcllocaleinfo_create +tjcllocaleinfo_dateformats +tjcllocaleinfo_dateseparator +tjcllocaleinfo_decimalseparator +tjcllocaleinfo_defaultcodepageebcdic +tjcllocaleinfo_defaultcountrycode +tjcllocaleinfo_defaultlanguageid +tjcllocaleinfo_defaultpapersize +tjcllocaleinfo_destroy +tjcllocaleinfo_digitgrouping +tjcllocaleinfo_digitsubstitution +tjcllocaleinfo_englishcountryname +tjcllocaleinfo_englishcurrencyname +tjcllocaleinfo_englishlangname +tjcllocaleinfo_firstdayofweek +tjcllocaleinfo_firstweekofyear +tjcllocaleinfo_fontcharset +tjcllocaleinfo_fontsignature +tjcllocaleinfo_integerinfo +tjcllocaleinfo_isoabbreviatedcountryname +tjcllocaleinfo_isoabbreviatedlangname +tjcllocaleinfo_langid +tjcllocaleinfo_langidprimary +tjcllocaleinfo_langidsub +tjcllocaleinfo_languageindentifier +tjcllocaleinfo_leadingzeros +tjcllocaleinfo_leadzerosinday +tjcllocaleinfo_leadzerosinmonth +tjcllocaleinfo_leadzerosintime +tjcllocaleinfo_listitemseparator +tjcllocaleinfo_localeid +tjcllocaleinfo_localizedcountryname +tjcllocaleinfo_localizedlangname +tjcllocaleinfo_localizedsortname +tjcllocaleinfo_longdateformat +tjcllocaleinfo_longdateordering +tjcllocaleinfo_longdaynames +tjcllocaleinfo_longmonthnames +tjcllocaleinfo_measure +tjcllocaleinfo_monetarydecimalseparator +tjcllocaleinfo_monetarygrouping +tjcllocaleinfo_monetarysymbolintl +tjcllocaleinfo_monetarysymbollocal +tjcllocaleinfo_monetarythousandsseparator +tjcllocaleinfo_nativecountryname +tjcllocaleinfo_nativecurrencyname +tjcllocaleinfo_nativedigits +tjcllocaleinfo_nativelangname +tjcllocaleinfo_negativecurrencymode +tjcllocaleinfo_negativenumbermode +tjcllocaleinfo_negativesign +tjcllocaleinfo_negativesignpos +tjcllocaleinfo_numberoffractionaldigits +tjcllocaleinfo_numberofintlmonetarydigits +tjcllocaleinfo_numberoflocalmonetarydigits +tjcllocaleinfo_object +tjcllocaleinfo_pmdesignator +tjcllocaleinfo_positivecurrencymode +tjcllocaleinfo_positivesign +tjcllocaleinfo_positivesignpos +tjcllocaleinfo_posofnegativemonetarysymbol +tjcllocaleinfo_posofpositivemonetarysymbol +tjcllocaleinfo_sepofnegativemonetarysymbol +tjcllocaleinfo_sepofpositivemonetarysymbol +tjcllocaleinfo_shortdateformat +tjcllocaleinfo_shortdateordering +tjcllocaleinfo_sortid +tjcllocaleinfo_stringinfo +tjcllocaleinfo_thousandseparator +tjcllocaleinfo_timeformats +tjcllocaleinfo_timeformatspecifier +tjcllocaleinfo_timeformatstring +tjcllocaleinfo_timemarkerposition +tjcllocaleinfo_timeseparator +tjcllocaleinfo_usesystemacp +tjcllocaleinfo_yearmonthformat +tjcllocaleslist +tjcllocaleslist_codepages +tjcllocaleslist_create +tjcllocaleslist_createlist +tjcllocaleslist_destroy +tjcllocaleslist_fillstrings +tjcllocaleslist_itemfromlangid +tjcllocaleslist_itemfromlangidprimary +tjcllocaleslist_itemfromlocaleid +tjcllocaleslist_items +tjcllocaleslist_kind +tjcllocaleslist_object +tjcllocalprocsymbolinfo +tjcllocalprocsymbolinfo_object +tjclmapparser +tjclmapparser_classtableitem +tjclmapparser_linenumbersitem +tjclmapparser_linenumberunititem +tjclmapparser_object +tjclmapparser_onclasstable +tjclmapparser_onlinenumbers +tjclmapparser_onlinenumberunit +tjclmapparser_onpublicsbyname +tjclmapparser_onpublicsbyvalue +tjclmapparser_onsegment +tjclmapparser_publicsbynameitem +tjclmapparser_publicsbyvalueitem +tjclmapparser_segmentitem +tjclmappedtextreader +tjclmappedtextreader_assignto +tjclmappedtextreader_asstring +tjclmappedtextreader_chars +tjclmappedtextreader_content +tjclmappedtextreader_create +tjclmappedtextreader_createindex +tjclmappedtextreader_destroy +tjclmappedtextreader_eof +tjclmappedtextreader_gobegin +tjclmappedtextreader_indexoption +tjclmappedtextreader_init +tjclmappedtextreader_linecount +tjclmappedtextreader_lines +tjclmappedtextreader_object +tjclmappedtextreader_position +tjclmappedtextreader_positionfromline +tjclmappedtextreader_ptrfromline +tjclmappedtextreader_read +tjclmappedtextreader_readln +tjclmappedtextreader_size +tjclmappedtextreader_stringfromposition +tjclmapscanner +tjclmapscanner_classtableitem +tjclmapscanner_create +tjclmapscanner_linenumbererrors +tjclmapscanner_linenumberfromaddr +tjclmapscanner_linenumbersitem +tjclmapscanner_linenumberunititem +tjclmapscanner_modulenamefromaddr +tjclmapscanner_modulestartfromaddr +tjclmapscanner_object +tjclmapscanner_procnamefromaddr +tjclmapscanner_publicsbynameitem +tjclmapscanner_publicsbyvalueitem +tjclmapscanner_scan +tjclmapscanner_segmentitem +tjclmapscanner_sourcenamefromaddr +tjclmeteredsection +tjclmeteredsection_acquirelock +tjclmeteredsection_create +tjclmeteredsection_destroy +tjclmeteredsection_enter +tjclmeteredsection_leave +tjclmeteredsection_object +tjclmeteredsection_open +tjclmeteredsection_releaselock +tjclmidiout +tjclmidiout_activenotes +tjclmidiout_destroy +tjclmidiout_dosendmessage +tjclmidiout_getactivenotes +tjclmidiout_getmidistatus +tjclmidiout_getname +tjclmidiout_getrunningstatusenabled +tjclmidiout_isrunningstatus +tjclmidiout_name +tjclmidiout_noteison +tjclmidiout_object +tjclmidiout_resetallcontrollers +tjclmidiout_runningstatusenabled +tjclmidiout_selectprogram +tjclmidiout_sendbalancechange +tjclmidiout_sendbalancechangehr +tjclmidiout_sendbreathcontrolchange +tjclmidiout_sendbreathcontrolchangehr +tjclmidiout_sendchannelmessage +tjclmidiout_sendchannelpressure +tjclmidiout_sendchannelvolumechange +tjclmidiout_sendchannelvolumechangehr +tjclmidiout_sendcontrolchange +tjclmidiout_sendcontrolchangehr +tjclmidiout_senddataentry +tjclmidiout_senddataentryhr +tjclmidiout_sendexpressionchange +tjclmidiout_sendexpressionchangehr +tjclmidiout_sendfootcontrollerchange +tjclmidiout_sendfootcontrollerchangehr +tjclmidiout_sendmessage +tjclmidiout_sendmodulationwheelchange +tjclmidiout_sendmodulationwheelchangehr +tjclmidiout_sendnoteoff +tjclmidiout_sendnoteon +tjclmidiout_sendpanchange +tjclmidiout_sendpanchangehr +tjclmidiout_sendpitchwheelchange +tjclmidiout_sendpitchwheelpos +tjclmidiout_sendpolyphonickeypressure +tjclmidiout_sendportamentotimechange +tjclmidiout_sendportamentotimechangehr +tjclmidiout_sendprogramchange +tjclmidiout_sendsinglenotetuningchange +tjclmidiout_sendswitchchange +tjclmidiout_setrunningstatusenabled +tjclmidiout_switchactivenotesoff +tjclmidiout_switchallnotesoff +tjclmidiout_switchallsoundoff +tjclmidiout_switchhold2 +tjclmidiout_switchlegato +tjclmidiout_switchlocalcontrol +tjclmidiout_switchmonomodeon +tjclmidiout_switchomnimodeoff +tjclmidiout_switchomnimodeon +tjclmidiout_switchpolymodeon +tjclmidiout_switchportamento +tjclmidiout_switchsoftpedal +tjclmidiout_switchsostenuto +tjclmidiout_switchsustain +tjclmixer +tjclmixer_builddevices +tjclmixer_callbackwnd +tjclmixer_create +tjclmixer_destroy +tjclmixer_devicecount +tjclmixer_devices +tjclmixer_firstdevice +tjclmixer_linebyid +tjclmixer_linecontrolbyid +tjclmixer_linemute +tjclmixer_linevolume +tjclmixer_object +tjclmixer_speakersmute +tjclmixer_speakersvolume +tjclmixerdestination +tjclmixerdestination_buildsources +tjclmixerdestination_create +tjclmixerdestination_destroy +tjclmixerdestination_object +tjclmixerdestination_sourcecount +tjclmixerdestination_sources +tjclmixerdevice +tjclmixerdevice_builddestinations +tjclmixerdevice_buildlines +tjclmixerdevice_capabilities +tjclmixerdevice_close +tjclmixerdevice_create +tjclmixerdevice_destinationcount +tjclmixerdevice_destinations +tjclmixerdevice_destroy +tjclmixerdevice_deviceindex +tjclmixerdevice_findlinecontrol +tjclmixerdevice_handle +tjclmixerdevice_linebycomponenttype +tjclmixerdevice_linebyid +tjclmixerdevice_linecontrolbyid +tjclmixerdevice_linecount +tjclmixerdevice_lines +tjclmixerdevice_lineuniformvalue +tjclmixerdevice_object +tjclmixerdevice_open +tjclmixerdevice_productname +tjclmixerline +tjclmixerline_buildlinecontrols +tjclmixerline_componentstring +tjclmixerline_componenttypetostring +tjclmixerline_create +tjclmixerline_destroy +tjclmixerline_hascontroltype +tjclmixerline_id +tjclmixerline_linecontrolbytype +tjclmixerline_linecontrolcount +tjclmixerline_linecontrols +tjclmixerline_lineinfo +tjclmixerline_mixerdevice +tjclmixerline_name +tjclmixerline_object +tjclmixerlinecontrol +tjclmixerlinecontrol_controlinfo +tjclmixerlinecontrol_create +tjclmixerlinecontrol_destroy +tjclmixerlinecontrol_formatvalue +tjclmixerlinecontrol_id +tjclmixerlinecontrol_isdisabled +tjclmixerlinecontrol_islist +tjclmixerlinecontrol_ismultiple +tjclmixerlinecontrol_isuniform +tjclmixerlinecontrol_listtext +tjclmixerlinecontrol_mixerline +tjclmixerlinecontrol_name +tjclmixerlinecontrol_object +tjclmixerlinecontrol_preparecontroldetailsstruc +tjclmixerlinecontrol_uniformvalue +tjclmixerlinecontrol_value +tjclmixerlinecontrol_valuestring +tjclmixersource +tjclmixersource_create +tjclmixersource_mixerdestination +tjclmixersource_object +tjclmoduleinfo +tjclmoduleinfo_create +tjclmoduleinfo_nameindex +tjclmoduleinfo_object +tjclmoduleinfo_segment +tjclmoduleinfo_segmentcount +tjclmoduleinfolist +tjclmoduleinfolist_addmodule +tjclmoduleinfolist_buildmoduleslist +tjclmoduleinfolist_create +tjclmoduleinfolist_createitemforaddress +tjclmoduleinfolist_dynamicbuild +tjclmoduleinfolist_issystemmoduleaddress +tjclmoduleinfolist_isvalidmoduleaddress +tjclmoduleinfolist_items +tjclmoduleinfolist_modulefromaddress +tjclmoduleinfolist_object +tjclmultimediatimer +tjclmultimediatimer_beginperiod +tjclmultimediatimer_begintimer +tjclmultimediatimer_create +tjclmultimediatimer_destroy +tjclmultimediatimer_elapsed +tjclmultimediatimer_endperiod +tjclmultimediatimer_endtimer +tjclmultimediatimer_event +tjclmultimediatimer_gettime +tjclmultimediatimer_kind +tjclmultimediatimer_maxperiod +tjclmultimediatimer_minperiod +tjclmultimediatimer_notification +tjclmultimediatimer_object +tjclmultimediatimer_ontimer +tjclmultimediatimer_period +tjclmultimediatimer_timer +tjclmultimediatimer_waitfor +tjclmultireadexclusivewrite +tjclmultireadexclusivewrite_beginread +tjclmultireadexclusivewrite_beginwrite +tjclmultireadexclusivewrite_create +tjclmultireadexclusivewrite_destroy +tjclmultireadexclusivewrite_endread +tjclmultireadexclusivewrite_endwrite +tjclmultireadexclusivewrite_object +tjclmultireadexclusivewrite_release +tjclmutex +tjclmutex_create +tjclmutex_object +tjclmutex_open +tjclmutex_release +tjclntservice +tjclntservice_active +tjclntservice_close +tjclntservice_commit +tjclntservice_commitconfig +tjclntservice_continue +tjclntservice_controls +tjclntservice_controlsaccepted +tjclntservice_create +tjclntservice_delete +tjclntservice_dependentbyservicecount +tjclntservice_dependentbyservices +tjclntservice_dependentgroupcount +tjclntservice_dependentgroups +tjclntservice_dependentservicecount +tjclntservice_dependentservices +tjclntservice_description +tjclntservice_desiredaccess +tjclntservice_destroy +tjclntservice_displayname +tjclntservice_errorcontroltype +tjclntservice_filename +tjclntservice_getservicestatus +tjclntservice_group +tjclntservice_handle +tjclntservice_object +tjclntservice_open +tjclntservice_pause +tjclntservice_refresh +tjclntservice_scmanager +tjclntservice_servicename +tjclntservice_servicestate +tjclntservice_servicetypes +tjclntservice_setstarttype +tjclntservice_start +tjclntservice_starttype +tjclntservice_stop +tjclntservice_updateconfig +tjclntservice_updatedependents +tjclntservice_updatedescription +tjclntservice_updatestatus +tjclntservice_waitfor +tjclntservice_win32exitcode +tjclnumericformat +tjclnumericformat_base +tjclnumericformat_create +tjclnumericformat_digit +tjclnumericformat_digitblockseparator +tjclnumericformat_digitblocksize +tjclnumericformat_digitvalue +tjclnumericformat_exponentdivision +tjclnumericformat_floattohtml +tjclnumericformat_floattostr +tjclnumericformat_fractionalpartseparator +tjclnumericformat_getmantissaexp +tjclnumericformat_inttostr +tjclnumericformat_isdigit +tjclnumericformat_multiplier +tjclnumericformat_negativesign +tjclnumericformat_numberoffractionaldigits +tjclnumericformat_object +tjclnumericformat_paddingchar +tjclnumericformat_positivesign +tjclnumericformat_precision +tjclnumericformat_showpositivesign +tjclnumericformat_showsign +tjclnumericformat_sign +tjclnumericformat_signchar +tjclnumericformat_strtoint +tjclnumericformat_wantedprecision +tjclnumericformat_width +tjclobjnamesymbolinfo +tjclobjnamesymbolinfo_create +tjclobjnamesymbolinfo_nameindex +tjclobjnamesymbolinfo_object +tjclobjnamesymbolinfo_signature +tjcloptex +tjcloptex_create +tjcloptex_destroy +tjcloptex_enter +tjcloptex_existed +tjcloptex_leave +tjcloptex_name +tjcloptex_object +tjcloptex_spincount +tjcloptex_tryenter +tjcloptex_uniprocess +tjclpeborform +tjclpeborform_convertformtotext +tjclpeborform_displayname +tjclpeborform_formclassname +tjclpeborform_formflags +tjclpeborform_formobjectname +tjclpeborform_formposition +tjclpeborform_object +tjclpeborform_resitem +tjclpeborimage +tjclpeborimage_afteropen +tjclpeborimage_clear +tjclpeborimage_create +tjclpeborimage_createformslist +tjclpeborimage_dependedpackages +tjclpeborimage_destroy +tjclpeborimage_formcount +tjclpeborimage_formfromname +tjclpeborimage_forms +tjclpeborimage_freelibhandle +tjclpeborimage_isborlandimage +tjclpeborimage_ispackage +tjclpeborimage_libhandle +tjclpeborimage_object +tjclpeborimage_packagecompilerversion +tjclpeborimage_packageinfo +tjclpeborimagescache +tjclpeborimagescache_getpeimageclass +tjclpeborimagescache_images +tjclpeborimagescache_object +tjclpebortd32image +tjclpebortd32image_afteropen +tjclpebortd32image_checkdebugdata +tjclpebortd32image_clear +tjclpebortd32image_cleardebugdata +tjclpebortd32image_isdebuginfoinimage +tjclpebortd32image_isdebuginfointds +tjclpebortd32image_istd32debugpresent +tjclpebortd32image_object +tjclpebortd32image_td32debugdata +tjclpebortd32image_td32scanner +tjclpecertificate +tjclpecertificate_data +tjclpecertificate_header +tjclpecertificate_object +tjclpecertificatelist +tjclpecertificatelist_create +tjclpecertificatelist_createlist +tjclpecertificatelist_items +tjclpecertificatelist_object +tjclpeclrheader +tjclpeclrheader_create +tjclpeclrheader_hasmetadata +tjclpeclrheader_header +tjclpeclrheader_image +tjclpeclrheader_object +tjclpeclrheader_readheader +tjclpeclrheader_versionstring +tjclpedebuglist +tjclpedebuglist_create +tjclpedebuglist_createlist +tjclpedebuglist_items +tjclpedebuglist_object +tjclpeexportfuncitem +tjclpeexportfuncitem_address +tjclpeexportfuncitem_addressorforwardstr +tjclpeexportfuncitem_findforwardeddotpos +tjclpeexportfuncitem_forwardedfuncname +tjclpeexportfuncitem_forwardedfuncordinal +tjclpeexportfuncitem_forwardedlibname +tjclpeexportfuncitem_forwardedname +tjclpeexportfuncitem_hint +tjclpeexportfuncitem_isexportedvariable +tjclpeexportfuncitem_isforwarded +tjclpeexportfuncitem_mappedaddress +tjclpeexportfuncitem_name +tjclpeexportfuncitem_object +tjclpeexportfuncitem_ordinal +tjclpeexportfuncitem_resolvecheck +tjclpeexportfuncitem_sectionname +tjclpeexportfunclist +tjclpeexportfunclist_anyforwards +tjclpeexportfunclist_base +tjclpeexportfunclist_canperformfastnamesearch +tjclpeexportfunclist_checkforwards +tjclpeexportfunclist_create +tjclpeexportfunclist_createlist +tjclpeexportfunclist_destroy +tjclpeexportfunclist_exportdir +tjclpeexportfunclist_forwardedlibslist +tjclpeexportfunclist_functioncount +tjclpeexportfunclist_itemfromaddress +tjclpeexportfunclist_itemfromname +tjclpeexportfunclist_itemfromordinal +tjclpeexportfunclist_itemname +tjclpeexportfunclist_items +tjclpeexportfunclist_lastsortdescending +tjclpeexportfunclist_lastsorttype +tjclpeexportfunclist_name +tjclpeexportfunclist_object +tjclpeexportfunclist_ordinalvalid +tjclpeexportfunclist_prepareforfastnamesearch +tjclpeexportfunclist_smartfindname +tjclpeexportfunclist_sorted +tjclpeexportfunclist_sortlist +tjclpeexportfunclist_totalresolvecheck +tjclpeimage +tjclpeimage_afteropen +tjclpeimage_attachedimage +tjclpeimage_attachloadedmodule +tjclpeimage_calculatechecksum +tjclpeimage_certificatelist +tjclpeimage_checknotattached +tjclpeimage_clear +tjclpeimage_clrheader +tjclpeimage_create +tjclpeimage_debuglist +tjclpeimage_debugtypenames +tjclpeimage_description +tjclpeimage_destroy +tjclpeimage_directories +tjclpeimage_directoryentrytodata +tjclpeimage_directoryexists +tjclpeimage_directorynames +tjclpeimage_expandbysearchpath +tjclpeimage_expandmodulename +tjclpeimage_exportlist +tjclpeimage_filename +tjclpeimage_fileproperties +tjclpeimage_getsectionheader +tjclpeimage_getsectionname +tjclpeimage_headernames +tjclpeimage_headervalues +tjclpeimage_imagesectioncount +tjclpeimage_imagesectionheaders +tjclpeimage_imagesectionnamefromrva +tjclpeimage_imagesectionnames +tjclpeimage_importlist +tjclpeimage_isbrokenformat +tjclpeimage_isclr +tjclpeimage_issystemimage +tjclpeimage_loadconfignames +tjclpeimage_loadconfigvalues +tjclpeimage_loadedimage +tjclpeimage_mappedaddress +tjclpeimage_noexceptions +tjclpeimage_object +tjclpeimage_optionalheader +tjclpeimage_raisestatusexception +tjclpeimage_rawtova +tjclpeimage_readonlyaccess +tjclpeimage_relocationlist +tjclpeimage_resourceitemcreate +tjclpeimage_resourcelist +tjclpeimage_resourcelistcreate +tjclpeimage_rvatosection +tjclpeimage_rvatova +tjclpeimage_rvatovaex +tjclpeimage_shortsectioninfo +tjclpeimage_stamptodatetime +tjclpeimage_status +tjclpeimage_statusok +tjclpeimage_trygetnamesforordinalimports +tjclpeimage_unusedheaderbytes +tjclpeimage_verifychecksum +tjclpeimage_versioninfo +tjclpeimage_versioninfoavailable +tjclpeimagebaselist +tjclpeimagebaselist_create +tjclpeimagebaselist_image +tjclpeimagebaselist_object +tjclpeimagescache +tjclpeimagescache_clear +tjclpeimagescache_count +tjclpeimagescache_create +tjclpeimagescache_destroy +tjclpeimagescache_getpeimageclass +tjclpeimagescache_images +tjclpeimagescache_object +tjclpeimportfuncitem +tjclpeimportfuncitem_destroy +tjclpeimportfuncitem_hint +tjclpeimportfuncitem_importlib +tjclpeimportfuncitem_indirectimportname +tjclpeimportfuncitem_isbyordinal +tjclpeimportfuncitem_name +tjclpeimportfuncitem_object +tjclpeimportfuncitem_ordinal +tjclpeimportfuncitem_resolvecheck +tjclpeimportfuncitem_setindirectimportname +tjclpeimportlibitem +tjclpeimportlibitem_checkimports +tjclpeimportlibitem_count +tjclpeimportlibitem_create +tjclpeimportlibitem_createlist +tjclpeimportlibitem_filename +tjclpeimportlibitem_importdescriptor +tjclpeimportlibitem_importdirectoryindex +tjclpeimportlibitem_importkind +tjclpeimportlibitem_items +tjclpeimportlibitem_name +tjclpeimportlibitem_object +tjclpeimportlibitem_originalname +tjclpeimportlibitem_sortlist +tjclpeimportlibitem_thunkdata +tjclpeimportlibitem_totalresolvecheck +tjclpeimportlist +tjclpeimportlist_allitemcount +tjclpeimportlist_allitems +tjclpeimportlist_checkimports +tjclpeimportlist_create +tjclpeimportlist_createlist +tjclpeimportlist_destroy +tjclpeimportlist_filtermodulename +tjclpeimportlist_items +tjclpeimportlist_linkerproducer +tjclpeimportlist_makeborlandimporttableformappedimage +tjclpeimportlist_object +tjclpeimportlist_refreshallitems +tjclpeimportlist_smartfindname +tjclpeimportlist_sortallitemslist +tjclpeimportlist_sortlist +tjclpeimportlist_trygetnamesforordinalimports +tjclpeimportlist_uniquelibitemcount +tjclpeimportlist_uniquelibitemfromname +tjclpeimportlist_uniquelibitems +tjclpeimportlist_uniquelibnames +tjclpemapimghookitem +tjclpemapimghookitem_baseaddress +tjclpemapimghookitem_destroy +tjclpemapimghookitem_functionname +tjclpemapimghookitem_internalunhook +tjclpemapimghookitem_modulename +tjclpemapimghookitem_newaddress +tjclpemapimghookitem_object +tjclpemapimghookitem_originaladdress +tjclpemapimghookitem_unhook +tjclpemapimghooks +tjclpemapimghooks_hookimport +tjclpemapimghooks_iswin9xdebugthunk +tjclpemapimghooks_itemfromnewaddress +tjclpemapimghooks_itemfromoriginaladdress +tjclpemapimghooks_items +tjclpemapimghooks_object +tjclpemapimghooks_replaceimport +tjclpemapimghooks_systembase +tjclpemapimghooks_unhookall +tjclpemapimghooks_unhookbynewaddress +tjclpemetadata +tjclpemetadata_blobat +tjclpemetadata_blobcount +tjclpemetadata_blobs +tjclpemetadata_create +tjclpemetadata_destroy +tjclpemetadata_dumpil +tjclpemetadata_findstream +tjclpemetadata_flags +tjclpemetadata_guidcount +tjclpemetadata_guids +tjclpemetadata_header +tjclpemetadata_image +tjclpemetadata_maketoken +tjclpemetadata_object +tjclpemetadata_streamcount +tjclpemetadata_streams +tjclpemetadata_stringat +tjclpemetadata_stringcount +tjclpemetadata_strings +tjclpemetadata_tablecount +tjclpemetadata_tables +tjclpemetadata_tokencode +tjclpemetadata_tokenexists +tjclpemetadata_tokenindex +tjclpemetadata_tokens +tjclpemetadata_tokentable +tjclpemetadata_userstringat +tjclpemetadata_userstringcount +tjclpemetadata_userstrings +tjclpemetadata_version +tjclpemetadata_versionstring +tjclpenamesearch +tjclpenamesearch_comparename +tjclpenamesearch_create +tjclpenamesearch_dofound +tjclpenamesearch_doprocessfile +tjclpenamesearch_execute +tjclpenamesearch_object +tjclpenamesearch_onfound +tjclpenamesearch_onprocessfile +tjclpenamesearch_start +tjclpepackageinfo +tjclpepackageinfo_available +tjclpepackageinfo_contains +tjclpepackageinfo_containscount +tjclpepackageinfo_containsflags +tjclpepackageinfo_containsnames +tjclpepackageinfo_create +tjclpepackageinfo_dcpname +tjclpepackageinfo_description +tjclpepackageinfo_destroy +tjclpepackageinfo_ensureextension +tjclpepackageinfo_flags +tjclpepackageinfo_object +tjclpepackageinfo_packagemoduletypetostring +tjclpepackageinfo_packageoptionstostring +tjclpepackageinfo_producertostring +tjclpepackageinfo_readpackageinfo +tjclpepackageinfo_requires +tjclpepackageinfo_requirescount +tjclpepackageinfo_requiresnames +tjclpepackageinfo_unitinfoflagstostring +tjclperelocentry +tjclperelocentry_count +tjclperelocentry_object +tjclperelocentry_relocations +tjclperelocentry_size +tjclperelocentry_virtualaddress +tjclpereloclist +tjclpereloclist_allitemcount +tjclpereloclist_allitems +tjclpereloclist_create +tjclpereloclist_createlist +tjclpereloclist_items +tjclpereloclist_object +tjclperesourceitem +tjclperesourceitem_comparename +tjclperesourceitem_create +tjclperesourceitem_dataentry +tjclperesourceitem_destroy +tjclperesourceitem_entry +tjclperesourceitem_image +tjclperesourceitem_isdirectory +tjclperesourceitem_isname +tjclperesourceitem_langid +tjclperesourceitem_level +tjclperesourceitem_level1item +tjclperesourceitem_list +tjclperesourceitem_name +tjclperesourceitem_object +tjclperesourceitem_offsettorawdata +tjclperesourceitem_parametername +tjclperesourceitem_parentitem +tjclperesourceitem_rawentrydata +tjclperesourceitem_rawentrydatasize +tjclperesourceitem_resourcetype +tjclperesourceitem_resourcetypestr +tjclperesourceitem_subdirdata +tjclperesourcelist +tjclperesourcelist_create +tjclperesourcelist_createlist +tjclperesourcelist_directory +tjclperesourcelist_findname +tjclperesourcelist_items +tjclperesourcelist_object +tjclperesourcelist_parentitem +tjclperesourcerawstream +tjclperesourcerawstream_create +tjclperesourcerawstream_object +tjclperesourcerawstream_write +tjclperootresourcelist +tjclperootresourcelist_destroy +tjclperootresourcelist_findresource +tjclperootresourcelist_listresourcenames +tjclperootresourcelist_manifestcontent +tjclperootresourcelist_object +tjclpesectionstream +tjclpesectionstream_create +tjclpesectionstream_instance +tjclpesectionstream_object +tjclpesectionstream_sectionheader +tjclpesectionstream_write +tjclprintset +tjclprintset_binindex +tjclprintset_color +tjclprintset_copies +tjclprintset_cpitodot +tjclprintset_create +tjclprintset_custompagesetup +tjclprintset_defaultsource +tjclprintset_destroy +tjclprintset_dpix +tjclprintset_dpiy +tjclprintset_duplex +tjclprintset_getbin +tjclprintset_getbinindex +tjclprintset_getbinsourcelist +tjclprintset_getcolor +tjclprintset_getcopies +tjclprintset_getduplex +tjclprintset_getorientation +tjclprintset_getpaperindex +tjclprintset_getpaperlength +tjclprintset_getpaperlist +tjclprintset_getpapersize +tjclprintset_getpaperwidth +tjclprintset_getprinterdriver +tjclprintset_getprintername +tjclprintset_getprinterport +tjclprintset_getprintquality +tjclprintset_getscale +tjclprintset_gettruetypeoption +tjclprintset_getyresolution +tjclprintset_lpitodot +tjclprintset_object +tjclprintset_orientation +tjclprintset_paperindex +tjclprintset_paperlength +tjclprintset_papersize +tjclprintset_paperwidth +tjclprintset_printerdriver +tjclprintset_printername +tjclprintset_printerport +tjclprintset_printquality +tjclprintset_readfrominifile +tjclprintset_resetprinterdialogs +tjclprintset_saveprinterasdefault +tjclprintset_savetodefaults +tjclprintset_savetoinifile +tjclprintset_scale +tjclprintset_setbin +tjclprintset_setbinfromlist +tjclprintset_setcolor +tjclprintset_setcopies +tjclprintset_setdevicemode +tjclprintset_setduplex +tjclprintset_setorientation +tjclprintset_setpaperfromlist +tjclprintset_setpaperlength +tjclprintset_setpapersize +tjclprintset_setpaperwidth +tjclprintset_setport +tjclprintset_setprintquality +tjclprintset_setscale +tjclprintset_settruetypeoption +tjclprintset_setyresolution +tjclprintset_textoutcm +tjclprintset_textoutcpilpi +tjclprintset_textoutinch +tjclprintset_truetypeoption +tjclprintset_updatedevicemode +tjclprintset_xcmtodot +tjclprintset_xinchtodot +tjclprintset_ycmtodot +tjclprintset_yinchtodot +tjclprintset_yresolution +tjclprocsymbolinfo +tjclprocsymbolinfo_create +tjclprocsymbolinfo_nameindex +tjclprocsymbolinfo_object +tjclprocsymbolinfo_offset +tjclprocsymbolinfo_size +tjclpublicsymbolinfo +tjclpublicsymbolinfo_object +tjclqueue +tjclqueue_contains +tjclqueue_create +tjclqueue_dequeue +tjclqueue_empty +tjclqueue_enqueue +tjclqueue_object +tjclqueue_size +tjclrarcompressionstream +tjclrarcompressionstream_object +tjclrardecompressionstream +tjclrardecompressionstream_object +tjclrational +tjclrational_abs +tjclrational_add +tjclrational_asfloat +tjclrational_assign +tjclrational_assignone +tjclrational_assignzero +tjclrational_asstring +tjclrational_create +tjclrational_denominator +tjclrational_divide +tjclrational_duplicate +tjclrational_isequal +tjclrational_isone +tjclrational_iszero +tjclrational_multiply +tjclrational_negate +tjclrational_numerator +tjclrational_object +tjclrational_power +tjclrational_reciprocal +tjclrational_sgn +tjclrational_simplify +tjclrational_sqr +tjclrational_sqrt +tjclrational_subtract +tjclreferencememorystream +tjclreferencememorystream_create +tjclreferencememorystream_object +tjclreferencememorystream_write +tjclregion +tjclregion_box +tjclregion_clip +tjclregion_combine +tjclregion_copy +tjclregion_create +tjclregion_createbitmap +tjclregion_createelliptic +tjclregion_createmapwindow +tjclregion_createpath +tjclregion_createpoly +tjclregion_createpolypolygon +tjclregion_createrect +tjclregion_createregioninfo +tjclregion_createroundrect +tjclregion_destroy +tjclregion_equals +tjclregion_fill +tjclregion_fillgradient +tjclregion_frame +tjclregion_getbox +tjclregion_gethandle +tjclregion_getregioninfo +tjclregion_getregiontype +tjclregion_handle +tjclregion_invert +tjclregion_object +tjclregion_offset +tjclregion_paint +tjclregion_pointin +tjclregion_rectin +tjclregion_regiontype +tjclregion_setwindow +tjclregioninfo +tjclregioninfo_box +tjclregioninfo_count +tjclregioninfo_create +tjclregioninfo_destroy +tjclregioninfo_getcount +tjclregioninfo_getrect +tjclregioninfo_object +tjclregioninfo_rectangles +tjclscheduledtask +tjclscheduledtask_applicationname +tjclscheduledtask_maxruntime +tjclscheduledtask_object +tjclscheduledtask_parameters +tjclscheduledtask_priority +tjclscheduledtask_showpage +tjclscheduledtask_task +tjclscheduledtask_taskflags +tjclscheduledtask_workingdirectory +tjclscheduledworkitem +tjclscheduledworkitem_accountname +tjclscheduledworkitem_comment +tjclscheduledworkitem_create +tjclscheduledworkitem_creator +tjclscheduledworkitem_deadlineminutes +tjclscheduledworkitem_destroy +tjclscheduledworkitem_errorretrycount +tjclscheduledworkitem_errorretryinterval +tjclscheduledworkitem_exitcode +tjclscheduledworkitem_flags +tjclscheduledworkitem_getruntimes +tjclscheduledworkitem_idleminutes +tjclscheduledworkitem_mostrecentruntime +tjclscheduledworkitem_nextruntime +tjclscheduledworkitem_object +tjclscheduledworkitem_ownerdata +tjclscheduledworkitem_password +tjclscheduledworkitem_refresh +tjclscheduledworkitem_run +tjclscheduledworkitem_save +tjclscheduledworkitem_scheduledworkitem +tjclscheduledworkitem_setaccountinformation +tjclscheduledworkitem_status +tjclscheduledworkitem_taskname +tjclscheduledworkitem_terminate +tjclscheduledworkitem_triggercount +tjclscheduledworkitem_triggers +tjclscmanager +tjclscmanager_active +tjclscmanager_addgroup +tjclscmanager_addservice +tjclscmanager_advapi32handle +tjclscmanager_clear +tjclscmanager_close +tjclscmanager_controlaccepted +tjclscmanager_create +tjclscmanager_databasename +tjclscmanager_desiredaccess +tjclscmanager_destroy +tjclscmanager_findgroup +tjclscmanager_findservice +tjclscmanager_forderasc +tjclscmanager_fordertype +tjclscmanager_getservicelockstatus +tjclscmanager_groupcount +tjclscmanager_groups +tjclscmanager_handle +tjclscmanager_install +tjclscmanager_islocked +tjclscmanager_lock +tjclscmanager_lockduration +tjclscmanager_lockowner +tjclscmanager_machinename +tjclscmanager_object +tjclscmanager_open +tjclscmanager_orderasc +tjclscmanager_ordertype +tjclscmanager_queryserviceconfig2a +tjclscmanager_refresh +tjclscmanager_servicecount +tjclscmanager_services +tjclscmanager_servicetype +tjclscmanager_sort +tjclscmanager_unlock +tjclscreenbuffer +tjclscreenbuffer_clear +tjclscreenbuffer_create +tjclscreenbuffer_cursor +tjclscreenbuffer_destroy +tjclscreenbuffer_doresize +tjclscreenbuffer_fill +tjclscreenbuffer_font +tjclscreenbuffer_handle +tjclscreenbuffer_height +tjclscreenbuffer_info +tjclscreenbuffer_init +tjclscreenbuffer_mode +tjclscreenbuffer_object +tjclscreenbuffer_onafterresize +tjclscreenbuffer_onbeforeresize +tjclscreenbuffer_read +tjclscreenbuffer_readln +tjclscreenbuffer_size +tjclscreenbuffer_width +tjclscreenbuffer_window +tjclscreenbuffer_write +tjclscreenbuffer_writeln +tjclscreencharacter +tjclscreencharacter_character +tjclscreencharacter_create +tjclscreencharacter_gettextattribute +tjclscreencharacter_info +tjclscreencharacter_object +tjclscreencharacter_settextattribute +tjclscreencursor +tjclscreencursor_create +tjclscreencursor_info +tjclscreencursor_moveby +tjclscreencursor_moveto +tjclscreencursor_object +tjclscreencursor_position +tjclscreencursor_screenbuffer +tjclscreencursor_size +tjclscreencursor_visible +tjclscreencustomtextattribute +tjclscreencustomtextattribute_bgcolor +tjclscreencustomtextattribute_bghighlight +tjclscreencustomtextattribute_clear +tjclscreencustomtextattribute_color +tjclscreencustomtextattribute_create +tjclscreencustomtextattribute_gettextattribute +tjclscreencustomtextattribute_highlight +tjclscreencustomtextattribute_object +tjclscreencustomtextattribute_settextattribute +tjclscreencustomtextattribute_style +tjclscreencustomtextattribute_textattribute +tjclscreenfont +tjclscreenfont_create +tjclscreenfont_gettextattribute +tjclscreenfont_object +tjclscreenfont_screenbuffer +tjclscreenfont_settextattribute +tjclscreentextattribute +tjclscreentextattribute_create +tjclscreentextattribute_gettextattribute +tjclscreentextattribute_object +tjclscreentextattribute_settextattribute +tjclscreenwindow +tjclscreenwindow_bottom +tjclscreenwindow_create +tjclscreenwindow_doresize +tjclscreenwindow_height +tjclscreenwindow_left +tjclscreenwindow_maxconsolewindowsize +tjclscreenwindow_maxwindow +tjclscreenwindow_object +tjclscreenwindow_position +tjclscreenwindow_right +tjclscreenwindow_screenbuffer +tjclscreenwindow_scroll +tjclscreenwindow_size +tjclscreenwindow_top +tjclscreenwindow_width +tjclsemaphore +tjclsemaphore_create +tjclsemaphore_object +tjclsemaphore_open +tjclsemaphore_release +tjclsemaphore_releaseprev +tjclservicegroup +tjclservicegroup_add +tjclservicegroup_create +tjclservicegroup_destroy +tjclservicegroup_name +tjclservicegroup_object +tjclservicegroup_order +tjclservicegroup_remove +tjclservicegroup_scmanager +tjclservicegroup_servicecount +tjclservicegroup_services +tjclsimplemapi +tjclsimplemapi_anyclientinstalled +tjclsimplemapi_beforeunloadclient +tjclsimplemapi_beforeunloadclientlib +tjclsimplemapi_checklistindex +tjclsimplemapi_clientconnectkind +tjclsimplemapi_clientcount +tjclsimplemapi_clientlibloaded +tjclsimplemapi_clients +tjclsimplemapi_create +tjclsimplemapi_currentclientname +tjclsimplemapi_defaultclientindex +tjclsimplemapi_defaultprofilename +tjclsimplemapi_destroy +tjclsimplemapi_getclientlibname +tjclsimplemapi_loadclientlib +tjclsimplemapi_mapiaddress +tjclsimplemapi_mapideletemail +tjclsimplemapi_mapidetails +tjclsimplemapi_mapifindnext +tjclsimplemapi_mapifreebuffer +tjclsimplemapi_mapiinstalled +tjclsimplemapi_mapilogoff +tjclsimplemapi_mapilogon +tjclsimplemapi_mapireadmail +tjclsimplemapi_mapiresolvename +tjclsimplemapi_mapisavemail +tjclsimplemapi_mapisenddocuments +tjclsimplemapi_mapisendmail +tjclsimplemapi_mapiversion +tjclsimplemapi_object +tjclsimplemapi_profilecount +tjclsimplemapi_profiles +tjclsimplemapi_profilesregkey +tjclsimplemapi_readmapisettings +tjclsimplemapi_selectedclientindex +tjclsimplemapi_simplemapiinstalled +tjclsimplemapi_unloadclientlib +tjclsourcemoduleinfo +tjclsourcemoduleinfo_create +tjclsourcemoduleinfo_destroy +tjclsourcemoduleinfo_findline +tjclsourcemoduleinfo_line +tjclsourcemoduleinfo_linecount +tjclsourcemoduleinfo_nameindex +tjclsourcemoduleinfo_object +tjclsourcemoduleinfo_segment +tjclsourcemoduleinfo_segmentcount +tjclsparseflatset +tjclsparseflatset_clear +tjclsparseflatset_destroy +tjclsparseflatset_getbit +tjclsparseflatset_getrange +tjclsparseflatset_invert +tjclsparseflatset_object +tjclsparseflatset_setbit +tjclsparseflatset_setrange +tjclstack +tjclstack_contains +tjclstack_create +tjclstack_empty +tjclstack_grow +tjclstack_object +tjclstack_pop +tjclstack_push +tjclstack_size +tjclstackbaselist +tjclstackbaselist_create +tjclstackbaselist_object +tjclstackbaselist_threadid +tjclstackbaselist_timestamp +tjclstackinfoitem +tjclstackinfoitem_calleradr +tjclstackinfoitem_logicaladdress +tjclstackinfoitem_object +tjclstackinfoitem_stackinfo +tjclstackinfolist +tjclstackinfolist_addtostrings +tjclstackinfolist_create +tjclstackinfolist_destroy +tjclstackinfolist_ignorelevels +tjclstackinfolist_items +tjclstackinfolist_object +tjclstrarraylist +tjclstrarraylist_add +tjclstrarraylist_addall +tjclstrarraylist_capacity +tjclstrarraylist_clear +tjclstrarraylist_clone +tjclstrarraylist_contains +tjclstrarraylist_containsall +tjclstrarraylist_create +tjclstrarraylist_destroy +tjclstrarraylist_equals +tjclstrarraylist_first +tjclstrarraylist_getstring +tjclstrarraylist_grow +tjclstrarraylist_indexof +tjclstrarraylist_insert +tjclstrarraylist_insertall +tjclstrarraylist_isempty +tjclstrarraylist_last +tjclstrarraylist_lastindexof +tjclstrarraylist_object +tjclstrarraylist_remove +tjclstrarraylist_removeall +tjclstrarraylist_retainall +tjclstrarraylist_setstring +tjclstrarraylist_size +tjclstrarraylist_sublist +tjclstrarrayset +tjclstrarrayset_add +tjclstrarrayset_addall +tjclstrarrayset_contains +tjclstrarrayset_insert +tjclstrarrayset_intersect +tjclstrarrayset_object +tjclstrarrayset_subtract +tjclstrarrayset_union +tjclstrbinarynode +tjclstrbinarynode_color +tjclstrbinarynode_left +tjclstrbinarynode_object +tjclstrbinarynode_parent +tjclstrbinarynode_right +tjclstrbinarynode_tjclstrbinarynode=recordstr +tjclstrbinarytree +tjclstrbinarytree_add +tjclstrbinarytree_addall +tjclstrbinarytree_clear +tjclstrbinarytree_clone +tjclstrbinarytree_contains +tjclstrbinarytree_containsall +tjclstrbinarytree_create +tjclstrbinarytree_destroy +tjclstrbinarytree_equals +tjclstrbinarytree_first +tjclstrbinarytree_gettraverseorder +tjclstrbinarytree_isempty +tjclstrbinarytree_last +tjclstrbinarytree_object +tjclstrbinarytree_remove +tjclstrbinarytree_removeall +tjclstrbinarytree_retainall +tjclstrbinarytree_settraverseorder +tjclstrbinarytree_size +tjclstrbucket +tjclstrbucket_entries +tjclstrbucket_object +tjclstrbucket_tjclstrbucket=recordcount +tjclstrcollection +tjclstrcollection_add +tjclstrcollection_addall +tjclstrcollection_appenddelimited +tjclstrcollection_appendfromstrings +tjclstrcollection_appendtostrings +tjclstrcollection_clear +tjclstrcollection_contains +tjclstrcollection_containsall +tjclstrcollection_equals +tjclstrcollection_first +tjclstrcollection_getasdelimited +tjclstrcollection_getasstrings +tjclstrcollection_isempty +tjclstrcollection_last +tjclstrcollection_loaddelimited +tjclstrcollection_loadfromstrings +tjclstrcollection_object +tjclstrcollection_remove +tjclstrcollection_removeall +tjclstrcollection_retainall +tjclstrcollection_savetostrings +tjclstrcollection_size +tjclstrhashmap +tjclstrhashmap_clear +tjclstrhashmap_clone +tjclstrhashmap_containskey +tjclstrhashmap_containsvalue +tjclstrhashmap_create +tjclstrhashmap_destroy +tjclstrhashmap_equals +tjclstrhashmap_freeobject +tjclstrhashmap_getvalue +tjclstrhashmap_growentries +tjclstrhashmap_hashfunction +tjclstrhashmap_isempty +tjclstrhashmap_keyset +tjclstrhashmap_object +tjclstrhashmap_ownsobjects +tjclstrhashmap_putall +tjclstrhashmap_putvalue +tjclstrhashmap_remove +tjclstrhashmap_size +tjclstrhashmap_values +tjclstrhashset +tjclstrhashset_add +tjclstrhashset_addall +tjclstrhashset_clear +tjclstrhashset_clone +tjclstrhashset_contains +tjclstrhashset_containsall +tjclstrhashset_create +tjclstrhashset_destroy +tjclstrhashset_equals +tjclstrhashset_first +tjclstrhashset_intersect +tjclstrhashset_isempty +tjclstrhashset_last +tjclstrhashset_object +tjclstrhashset_remove +tjclstrhashset_removeall +tjclstrhashset_retainall +tjclstrhashset_size +tjclstrhashset_subtract +tjclstrhashset_union +tjclstrintfbucket +tjclstrintfbucket_entries +tjclstrintfbucket_object +tjclstrintfbucket_tjclstrintfbucket=recordcount +tjclstrintfhashmap +tjclstrintfhashmap_clear +tjclstrintfhashmap_clone +tjclstrintfhashmap_containskey +tjclstrintfhashmap_containsvalue +tjclstrintfhashmap_create +tjclstrintfhashmap_destroy +tjclstrintfhashmap_equals +tjclstrintfhashmap_getvalue +tjclstrintfhashmap_growentries +tjclstrintfhashmap_hashfunction +tjclstrintfhashmap_isempty +tjclstrintfhashmap_keyset +tjclstrintfhashmap_object +tjclstrintfhashmap_putall +tjclstrintfhashmap_putvalue +tjclstrintfhashmap_remove +tjclstrintfhashmap_size +tjclstrintfhashmap_values +tjclstrlinkedlist +tjclstrlinkedlist_add +tjclstrlinkedlist_addall +tjclstrlinkedlist_addfirst +tjclstrlinkedlist_clear +tjclstrlinkedlist_clone +tjclstrlinkedlist_contains +tjclstrlinkedlist_containsall +tjclstrlinkedlist_create +tjclstrlinkedlist_destroy +tjclstrlinkedlist_equals +tjclstrlinkedlist_first +tjclstrlinkedlist_getstring +tjclstrlinkedlist_indexof +tjclstrlinkedlist_insert +tjclstrlinkedlist_insertall +tjclstrlinkedlist_isempty +tjclstrlinkedlist_last +tjclstrlinkedlist_lastindexof +tjclstrlinkedlist_object +tjclstrlinkedlist_remove +tjclstrlinkedlist_removeall +tjclstrlinkedlist_retainall +tjclstrlinkedlist_setstring +tjclstrlinkedlist_size +tjclstrlinkedlist_sublist +tjclstrlinkedlistitem +tjclstrlinkedlistitem_next +tjclstrlinkedlistitem_object +tjclstrlinkedlistitem_tjclstrlinkedlistitem=recordstr +tjclstrqueue +tjclstrqueue_contains +tjclstrqueue_create +tjclstrqueue_dequeue +tjclstrqueue_empty +tjclstrqueue_enqueue +tjclstrqueue_object +tjclstrqueue_size +tjclstrstack +tjclstrstack_contains +tjclstrstack_create +tjclstrstack_empty +tjclstrstack_grow +tjclstrstack_object +tjclstrstack_pop +tjclstrstack_push +tjclstrstack_size +tjclstrstrbucket +tjclstrstrbucket_entries +tjclstrstrbucket_object +tjclstrstrbucket_tjclstrstrbucket=recordcount +tjclstrstrhashmap +tjclstrstrhashmap_clear +tjclstrstrhashmap_clone +tjclstrstrhashmap_containskey +tjclstrstrhashmap_containsvalue +tjclstrstrhashmap_create +tjclstrstrhashmap_destroy +tjclstrstrhashmap_equals +tjclstrstrhashmap_getvalue +tjclstrstrhashmap_growentries +tjclstrstrhashmap_hashfunction +tjclstrstrhashmap_isempty +tjclstrstrhashmap_keyofvalue +tjclstrstrhashmap_keyset +tjclstrstrhashmap_object +tjclstrstrhashmap_putall +tjclstrstrhashmap_putvalue +tjclstrstrhashmap_remove +tjclstrstrhashmap_size +tjclstrstrhashmap_values +tjclstructstoragefolder +tjclstructstoragefolder_add +tjclstructstoragefolder_assignto +tjclstructstoragefolder_check +tjclstructstoragefolder_checkresult +tjclstructstoragefolder_commit +tjclstructstoragefolder_convert +tjclstructstoragefolder_copyto +tjclstructstoragefolder_create +tjclstructstoragefolder_delete +tjclstructstoragefolder_destroy +tjclstructstoragefolder_faccessmode +tjclstructstoragefolder_fconvertedmode +tjclstructstoragefolder_ffilename +tjclstructstoragefolder_flasterror +tjclstructstoragefolder_freestats +tjclstructstoragefolder_fstorage +tjclstructstoragefolder_getfilestream +tjclstructstoragefolder_getfolder +tjclstructstoragefolder_getstats +tjclstructstoragefolder_getsubitems +tjclstructstoragefolder_intf +tjclstructstoragefolder_isstructured +tjclstructstoragefolder_lasterror +tjclstructstoragefolder_moveto +tjclstructstoragefolder_name +tjclstructstoragefolder_object +tjclstructstoragefolder_rename +tjclstructstoragefolder_revert +tjclstructstoragefolder_setelementtimes +tjclstructstoragestream +tjclstructstoragestream_check +tjclstructstoragestream_checkresult +tjclstructstoragestream_clone +tjclstructstoragestream_copyto +tjclstructstoragestream_destroy +tjclstructstoragestream_flasterror +tjclstructstoragestream_fname +tjclstructstoragestream_freestats +tjclstructstoragestream_fstream +tjclstructstoragestream_getstats +tjclstructstoragestream_intf +tjclstructstoragestream_lasterror +tjclstructstoragestream_name +tjclstructstoragestream_object +tjclstructstoragestream_read +tjclstructstoragestream_seek +tjclstructstoragestream_setsize +tjclstructstoragestream_write +tjclstrvector +tjclstrvector_add +tjclstrvector_addall +tjclstrvector_afterconstruction +tjclstrvector_beforedestruction +tjclstrvector_clear +tjclstrvector_clone +tjclstrvector_contains +tjclstrvector_containsall +tjclstrvector_create +tjclstrvector_destroy +tjclstrvector_equals +tjclstrvector_first +tjclstrvector_getstring +tjclstrvector_grow +tjclstrvector_indexof +tjclstrvector_insert +tjclstrvector_insertall +tjclstrvector_isempty +tjclstrvector_items +tjclstrvector_last +tjclstrvector_lastindexof +tjclstrvector_object +tjclstrvector_remove +tjclstrvector_removeall +tjclstrvector_retainall +tjclstrvector_setstring +tjclstrvector_size +tjclstrvector_sublist +tjclswapfilemapping +tjclswapfilemapping_create +tjclswapfilemapping_object +tjclsymbolinfo +tjclsymbolinfo_create +tjclsymbolinfo_object +tjclsymbolinfo_symboltype +tjcltarcompressionstream +tjcltarcompressionstream_object +tjcltardecompressionstream +tjcltardecompressionstream_object +tjcltaskschedule +tjcltaskschedule_add +tjcltaskschedule_create +tjcltaskschedule_delete +tjcltaskschedule_destroy +tjcltaskschedule_isrunning +tjcltaskschedule_object +tjcltaskschedule_refresh +tjcltaskschedule_remove +tjcltaskschedule_start +tjcltaskschedule_stop +tjcltaskschedule_targetcomputer +tjcltaskschedule_taskcount +tjcltaskschedule_tasks +tjcltaskschedule_taskscheduler +tjcltasktrigger +tjcltasktrigger_object +tjcltasktrigger_tasktrigger +tjcltasktrigger_trigger +tjcltasktrigger_triggerstring +tjcltasktriggers +tjcltasktriggers_add +tjcltasktriggers_additem +tjcltasktriggers_create +tjcltasktriggers_fworkitem +tjcltasktriggers_getitem +tjcltasktriggers_getowner +tjcltasktriggers_insert +tjcltasktriggers_items +tjcltasktriggers_object +tjcltasktriggers_setitem +tjcltd32infoparser +tjcltd32infoparser_analyse +tjcltd32infoparser_analysealignsymbols +tjcltd32infoparser_analyseglobaltypes +tjcltd32infoparser_analysemodules +tjcltd32infoparser_analysenames +tjcltd32infoparser_analysesourcemodules +tjcltd32infoparser_analyseunknownsubsection +tjcltd32infoparser_create +tjcltd32infoparser_data +tjcltd32infoparser_destroy +tjcltd32infoparser_findmodule +tjcltd32infoparser_findproc +tjcltd32infoparser_findsourcemodule +tjcltd32infoparser_istd32debuginfovalid +tjcltd32infoparser_istd32sign +tjcltd32infoparser_lfatova +tjcltd32infoparser_modulecount +tjcltd32infoparser_modules +tjcltd32infoparser_namecount +tjcltd32infoparser_names +tjcltd32infoparser_object +tjcltd32infoparser_sourcemodulecount +tjcltd32infoparser_sourcemodules +tjcltd32infoparser_symbolcount +tjcltd32infoparser_symbols +tjcltd32infoparser_validdata +tjcltd32infoscanner +tjcltd32infoscanner_linenumberfromaddr +tjcltd32infoscanner_modulenamefromaddr +tjcltd32infoscanner_object +tjcltd32infoscanner_procnamefromaddr +tjcltd32infoscanner_sourcenamefromaddr +tjcltempfilestream +tjcltempfilestream_create +tjcltempfilestream_destroy +tjcltempfilestream_filename +tjcltempfilestream_object +tjclthreadpersistent +tjclthreadpersistent_beginupdate +tjclthreadpersistent_changed +tjclthreadpersistent_changing +tjclthreadpersistent_create +tjclthreadpersistent_destroy +tjclthreadpersistent_endupdate +tjclthreadpersistent_lock +tjclthreadpersistent_lockcount +tjclthreadpersistent_object +tjclthreadpersistent_onchange +tjclthreadpersistent_onchanging +tjclthreadpersistent_unlock +tjclthreadpersistent_updatecount +tjcltransformation +tjcltransformation_gettransformedbounds +tjcltransformation_object +tjcltransformation_preparetransform +tjcltransformation_transform +tjcltransformation_transform256 +tjcludtsymbolinfo +tjcludtsymbolinfo_create +tjcludtsymbolinfo_nameindex +tjcludtsymbolinfo_object +tjcludtsymbolinfo_properties +tjcludtsymbolinfo_typeindex +tjclunaryinstruction +tjclunaryinstruction_object +tjclunitversioninglist +tjclunitversioninglist_add +tjclunitversioninglist_clear +tjclunitversioninglist_count +tjclunitversioninglist_create +tjclunitversioninglist_destroy +tjclunitversioninglist_items +tjclunitversioninglist_load +tjclunitversioninglist_loadfromdefaultresource +tjclunitversioninglist_loadfromdefaultsection +tjclunitversioninglist_loadfromstream +tjclunitversioninglist_object +tjclunitversioninglist_savetofile +tjclunitversioninglist_savetostream +tjclunitversioningprovidermodule +tjclunitversioningprovidermodule_create +tjclunitversioningprovidermodule_destroy +tjclunitversioningprovidermodule_infolist +tjclunitversioningprovidermodule_instance +tjclunitversioningprovidermodule_object +tjclvector +tjclvector_add +tjclvector_addall +tjclvector_afterconstruction +tjclvector_beforedestruction +tjclvector_clear +tjclvector_clone +tjclvector_contains +tjclvector_containsall +tjclvector_create +tjclvector_destroy +tjclvector_equals +tjclvector_first +tjclvector_freeobject +tjclvector_getobject +tjclvector_grow +tjclvector_indexof +tjclvector_insert +tjclvector_insertall +tjclvector_isempty +tjclvector_items +tjclvector_last +tjclvector_lastindexof +tjclvector_object +tjclvector_ownsobjects +tjclvector_remove +tjclvector_removeall +tjclvector_retainall +tjclvector_setobject +tjclvector_size +tjclvector_sublist +tjclvftpathsymbolinfo +tjclvftpathsymbolinfo_create +tjclvftpathsymbolinfo_object +tjclvftpathsymbolinfo_offset +tjclvftpathsymbolinfo_pathindex +tjclvftpathsymbolinfo_rootindex +tjclwaitabletimer +tjclwaitabletimer_cancel +tjclwaitabletimer_create +tjclwaitabletimer_object +tjclwaitabletimer_open +tjclwaitabletimer_settimer +tjclwaitabletimer_settimerapc +tjclwithsymbolinfo +tjclwithsymbolinfo_create +tjclwithsymbolinfo_nameindex +tjclwithsymbolinfo_object +tjclwithsymbolinfo_offset +tjclwithsymbolinfo_size +tjclzlibcompressstream +tjclzlibcompressstream_compressionlevel +tjclzlibcompressstream_create +tjclzlibcompressstream_destroy +tjclzlibcompressstream_flush +tjclzlibcompressstream_memlevel +tjclzlibcompressstream_method +tjclzlibcompressstream_object +tjclzlibcompressstream_reset +tjclzlibcompressstream_seek +tjclzlibcompressstream_setcompressionlevel +tjclzlibcompressstream_setmemlevel +tjclzlibcompressstream_setmethod +tjclzlibcompressstream_setstrategy +tjclzlibcompressstream_setwindowbits +tjclzlibcompressstream_strategy +tjclzlibcompressstream_windowbits +tjclzlibcompressstream_write +tjclzlibcompressstream_zlibrecord +tjclzlibdecompressstream +tjclzlibdecompressstream_create +tjclzlibdecompressstream_destroy +tjclzlibdecompressstream_object +tjclzlibdecompressstream_read +tjclzlibdecompressstream_seek +tjclzlibdecompressstream_setwindowbits +tjclzlibdecompressstream_windowbits +tjclzlibdecompressstream_zlibrecord +trectcomplex +trectcomplex_exp +trectcomplex_im +trectcomplex_object +trectcomplex_operator add +trectcomplex_operator divide +trectcomplex_operator equal +trectcomplex_operator implicit +trectcomplex_operator multiply +trectcomplex_operator negative +trectcomplex_operator notequal +trectcomplex_operator subtract +trectcomplex_re +tsearchengine +tsearchengine_addresult +tsearchengine_clear +tsearchengine_clearresults +tsearchengine_count +tsearchengine_create +tsearchengine_deleteresult +tsearchengine_destroy +tsearchengine_findall +tsearchengine_findfirst +tsearchengine_findprepare +tsearchengine_getcount +tsearchengine_getresult +tsearchengine_object +tstringhashmap +tstringhashmap_add +tstringhashmap_allocnode +tstringhashmap_clear +tstringhashmap_count +tstringhashmap_create +tstringhashmap_data +tstringhashmap_destroy +tstringhashmap_find +tstringhashmap_finddata +tstringhashmap_findnode +tstringhashmap_freenode +tstringhashmap_getdata +tstringhashmap_has +tstringhashmap_hashsize +tstringhashmap_iterate +tstringhashmap_iteratemethod +tstringhashmap_object +tstringhashmap_remove +tstringhashmap_removedata +tstringhashmap_setdata +tstringhashmap_traits +tstringhashmaptraits +tstringhashmaptraits_compare +tstringhashmaptraits_hash +tstringhashmaptraits_object +tunitversion +tunitversion_create +tunitversion_data +tunitversion_date +tunitversion_datetime +tunitversion_extra +tunitversion_logpath +tunitversion_object +tunitversion_rcsfile +tunitversion_revision +tunitversioning +tunitversioning_count +tunitversioning_create +tunitversioning_destroy +tunitversioning_findunit +tunitversioning_indexof +tunitversioning_items +tunitversioning_loadmoduleunitversioninginfo +tunitversioning_modulecount +tunitversioning_modules +tunitversioning_object +tunitversioning_registerprovider +tunitversioningmodule +tunitversioningmodule_count +tunitversioningmodule_create +tunitversioningmodule_destroy +tunitversioningmodule_findunit +tunitversioningmodule_indexof +tunitversioningmodule_instance +tunitversioningmodule_items +tunitversioningmodule_object +turesearch +turesearch_addequivalentpair +turesearch_addrange +turesearch_addstate +turesearch_addsymbolstate +turesearch_buildcharacterclass +turesearch_clear +turesearch_cleardfa +turesearch_clearurebuffer +turesearch_collectpendingoperations +turesearch_compilesymbol +turesearch_compileure +turesearch_convertregexptonfa +turesearch_executeure +turesearch_findall +turesearch_findfirst +turesearch_findprepare +turesearch_hexdigitsetup +turesearch_makeexpression +turesearch_makehexnumber +turesearch_makesymbol +turesearch_mergeequivalents +turesearch_object +turesearch_parsepropertylist +turesearch_peek +turesearch_pop +turesearch_posixccl +turesearch_probelowsurrogate +turesearch_push +turesearch_reduce +turesearch_spacesetup +turesearch_symbolsaredifferent +tutbmsearch +tutbmsearch_clear +tutbmsearch_clearpattern +tutbmsearch_compile +tutbmsearch_find +tutbmsearch_findall +tutbmsearch_findfirst +tutbmsearch_findprepare +tutbmsearch_getskipvalue +tutbmsearch_match +tutbmsearch_object +twidestringlist +twidestringlist_add +twidestringlist_changed +twidestringlist_changing +twidestringlist_clear +twidestringlist_delete +twidestringlist_destroy +twidestringlist_duplicates +twidestringlist_exchange +twidestringlist_find +twidestringlist_get +twidestringlist_getcapacity +twidestringlist_getcount +twidestringlist_getobject +twidestringlist_indexof +twidestringlist_insert +twidestringlist_object +twidestringlist_onchange +twidestringlist_onchanging +twidestringlist_put +twidestringlist_putobject +twidestringlist_setcapacity +twidestringlist_setlanguage +twidestringlist_setupdatestate +twidestringlist_sort +twidestringlist_sorted +twidestrings +twidestrings_add +twidestrings_addobject +twidestrings_addstrings +twidestrings_append +twidestrings_assign +twidestrings_assignto +twidestrings_beginupdate +twidestrings_capacity +twidestrings_clear +twidestrings_commatext +twidestrings_count +twidestrings_create +twidestrings_defineproperties +twidestrings_delete +twidestrings_doconfirmconversion +twidestrings_endupdate +twidestrings_equals +twidestrings_error +twidestrings_exchange +twidestrings_get +twidestrings_getcapacity +twidestrings_getcount +twidestrings_getobject +twidestrings_getseparatedtext +twidestrings_gettext +twidestrings_gettextstr +twidestrings_indexof +twidestrings_indexofname +twidestrings_indexofobject +twidestrings_insert +twidestrings_insertobject +twidestrings_language +twidestrings_loadfromfile +twidestrings_loadfromstream +twidestrings_move +twidestrings_names +twidestrings_normalizationform +twidestrings_object +twidestrings_objects +twidestrings_onconfirmconversion +twidestrings_put +twidestrings_putobject +twidestrings_saved +twidestrings_saveformat +twidestrings_savetofile +twidestrings_savetostream +twidestrings_saveunicode +twidestrings_setcapacity +twidestrings_setlanguage +twidestrings_settext +twidestrings_setupdatestate +twidestrings_strings +twidestrings_text +twidestrings_values +twstringlist +twstringlist_addobject +twstringlist_casesensitive +twstringlist_changed +twstringlist_changing +twstringlist_clear +twstringlist_comparestrings +twstringlist_create +twstringlist_customsort +twstringlist_delete +twstringlist_destroy +twstringlist_duplicates +twstringlist_exchange +twstringlist_find +twstringlist_getcapacity +twstringlist_getcount +twstringlist_getitem +twstringlist_getobject +twstringlist_getp +twstringlist_indexof +twstringlist_insertobject +twstringlist_object +twstringlist_onchange +twstringlist_onchanging +twstringlist_put +twstringlist_putobject +twstringlist_setcapacity +twstringlist_setupdatestate +twstringlist_sort +twstringlist_sorted +twstrings +twstrings_add +twstrings_addobject +twstrings_addstrings +twstrings_addstringsto +twstrings_append +twstrings_assign +twstrings_assignto +twstrings_beginupdate +twstrings_capacity +twstrings_clear +twstrings_commatext +twstrings_comparestrings +twstrings_count +twstrings_create +twstrings_createansistringlist +twstrings_defineproperties +twstrings_delete +twstrings_delimitedtext +twstrings_delimiter +twstrings_endupdate +twstrings_equals +twstrings_exchange +twstrings_extractname +twstrings_get +twstrings_getcapacity +twstrings_getcount +twstrings_getdelimitedtextex +twstrings_getobject +twstrings_getp +twstrings_gettext +twstrings_gettextstr +twstrings_indexof +twstrings_indexofname +twstrings_indexofobject +twstrings_insert +twstrings_insertobject +twstrings_lineseparator +twstrings_loadfromfile +twstrings_loadfromstream +twstrings_move +twstrings_names +twstrings_namevalueseparator +twstrings_object +twstrings_objects +twstrings_pstrings +twstrings_put +twstrings_putobject +twstrings_quotechar +twstrings_savetofile +twstrings_savetostream +twstrings_setcapacity +twstrings_setdelimitedtextex +twstrings_settext +twstrings_settextstr +twstrings_setupdatestate +twstrings_strings +twstrings_text +twstrings_updatecount +twstrings_valuefromindex +twstrings_values diff --git a/official/1.96/help/JclHelp.cnt b/official/1.96/help/JclHelp.cnt new file mode 100644 index 0000000..31c735d --- /dev/null +++ b/official/1.96/help/JclHelp.cnt @@ -0,0 +1,5514 @@ +:Base JclHelp.hlp>MAIN +:Title JEDI Code Library +1 JEDI Code Library +2 JEDI Code Library=id_11555 +2 Algorithms +3 Algorithms=id_11556 +3 Searching +4 Searching=id_11581 +4 Hash Maps +5 Hash Maps=id_11584 +5 Customizing TStringHashMap's node allocation strategy. +6 Customizing TStringHashMap's node allocation strategy.=id_11587 +6 TStringHashMap.AllocNode Method=id_11597 +6 TStringHashMap.FreeNode Method=id_11598 +5 EJclStringHashMapError Class +6 EJclStringHashMapError Class=id_11409 +5 THashValue Type +6 THashValue Type=id_11423 +5 TStringHashMapTraits Class +6 TStringHashMapTraits Class=id_11411 +6 TStringHashMapTraits.Compare Method=id_11601 +6 TStringHashMapTraits.Hash Method=id_11602 +5 CaseSensitiveTraits Function +6 CaseSensitiveTraits Function=id_11415 +5 CaseInsensitiveTraits Function +6 CaseInsensitiveTraits Function=id_11414 +5 TIterateFunc Type +6 TIterateFunc Type=id_11424 +5 TIterateMethod Type +6 TIterateMethod Type=id_11426 +5 THashNode Record +6 THashNode Record=id_7659 +5 THashArray Type +6 THashArray Type=id_11422 +5 TStringHashMap Class +6 TStringHashMap Class=id_11413 +6 TStringHashMap.Count Property=id_11610 +6 TStringHashMap.Data Property=id_11611 +6 TStringHashMap.HashSize Property=id_11612 +6 TStringHashMap.Traits Property=id_11613 +6 TStringHashMap.Add Method=id_11615 +6 TStringHashMap.Clear Method=id_11616 +6 TStringHashMap.Create Constructor=id_11617 +6 TStringHashMap.Destroy Destructor=id_11618 +6 TStringHashMap.Find Method=id_11608 +6 TStringHashMap.FindData Method=id_11619 +6 TStringHashMap.FindNode Method=id_11620 +6 TStringHashMap.GetData Method=id_11621 +6 TStringHashMap.Has Method=id_11607 +6 TStringHashMap.Iterate Method=id_11425 +6 TStringHashMap.IterateMethod Method=id_11427 +6 TStringHashMap.Remove Method=id_11622 +6 TStringHashMap.RemoveData Method=id_11623 +6 TStringHashMap.SetData Method=id_11624 +5 StrHash Function +6 StrHash Function=id_11420 +5 TextHash Function +6 TextHash Function=id_11421 +5 DataHash Function +6 DataHash Function=id_11416 +5 Iterate_FreeObjects Function +6 Iterate_FreeObjects Function=id_11419 +5 Iterate_Dispose Function +6 Iterate_Dispose Function=id_11417 +5 Iterate_FreeMem Function +6 Iterate_FreeMem Function=id_11418 +5 TCaseSensitiveTraits Class +6 TCaseSensitiveTraits Class=id_11412 +6 TCaseSensitiveTraits.Compare Method=id_11636 +6 TCaseSensitiveTraits.Hash Method=id_11637 +5 TCaseInsensitiveTraits Class +6 TCaseInsensitiveTraits Class=id_11410 +6 TCaseInsensitiveTraits.Compare Method=id_11641 +6 TCaseInsensitiveTraits.Hash Method=id_11642 +3 Sorting +4 Sorting=id_11582 +2 Base Services +3 Base Services=id_11557 +3 Iff Function=id_11652 +3 JclVersion Constant=id_11651 +3 Float Type=id_5253 +3 Compatibility +4 Compatibility=id_11644 +4 LongWord=id_5865 +4 TSysCharSet=id_11657 +4 TObjectList=id_269 +4 RaiseLastOSError Function=id_11658 +4 IInterface Type=id_4476 +3 Dynamic arrays +4 Dynamic arrays=id_11645 +4 TDynArray=id_11662 +4 DynArrayHigh=id_11663 +4 DynArrayAllocSize=id_11664 +4 DynArrayLength=id_11665 +4 DynArrayElemSize=id_11666 +4 DynArrayInitialize=id_11667 +4 DynArrayFinalize=id_11668 +4 DynArraySetLength=id_11669 +3 Dynamic loading +4 Dynamic loading=id_11646 +4 TModuleHandle Type=id_7713 +4 INVALID_MODULEHANDLE_VALUE Constant=id_7714 +4 LoadModule Function=id_11677 +4 LoadModuleEx Function=id_11678 +4 UnloadModule Function=id_11679 +4 GetModuleSymbol Function=id_11680 +4 GetModuleSymbolEx Function=id_11681 +4 ReadModuleData Function=id_11682 +4 WriteModuleData Function=id_11683 +3 Error Handling +4 Error Handling=id_11647 +4 EJclError Class=id_2 +4 EJclInternalError Class=id_11694 +4 EJclWin32Error Class +5 EJclWin32Error Class=id_16 +5 EJclWin32Error.LastError Property=id_18 +5 EJclWin32Error.LastErrorMsg Property=id_19 +5 EJclWin32Error.Create Constructor=id_21 +5 EJclWin32Error.CreateFmt Constructor=id_22 +5 CreateRes Constructor +6 EJclWin32Error.CreateRes Constructor (Integer)=id_23 +3 Int64 support +4 Int64 support=id_11648 +4 I64Assign=id_11707 +4 I64Copy=id_11708 +4 I64Compare=id_11709 +4 CardinalsToI64 Function=id_11710 +4 I64ToCardinals Function=id_11711 +3 Numeric formatting routines +4 Numeric formatting routines=id_11649 +4 IntToStrZeroPad Function=id_11720 +4 TJclNumericFormat Class +5 TJclNumericFormat Class=id_11719 +5 TJclNumericFormat.Base Property=id_11727 +5 TJclNumericFormat.DigitBlockSeparator Property=id_11728 +5 TJclNumericFormat.DigitBlockSize Property=id_11729 +5 TJclNumericFormat.ExponentDivision Property=id_11730 +5 TJclNumericFormat.FractionalPartSeparator Property=id_11731 +5 TJclNumericFormat.Multiplier Property=id_11732 +5 TJclNumericFormat.NegativeSign Property=id_11733 +5 TJclNumericFormat.NumberOfFractionalDigits Property=id_11734 +5 TJclNumericFormat.PaddingChar Property=id_11735 +5 TJclNumericFormat.PositiveSign Property=id_11736 +5 TJclNumericFormat.Precision Property=id_11737 +5 TJclNumericFormat.ShowPositiveSign Property=id_11738 +5 TJclNumericFormat.WantedPrecision Property=id_11739 +5 TJclNumericFormat.Width Property=id_11740 +5 TJclNumericFormat.Create Constructor=id_11742 +5 TJclNumericFormat.Digit Method=id_11743 +5 TJclNumericFormat.DigitValue Method=id_11744 +5 TJclNumericFormat.FloatToHTML Method=id_11745 +5 TJclNumericFormat.FloatToStr Method=id_11746 +5 TJclNumericFormat.GetMantissaExp Method=id_11747 +5 IntToStr Method +6 TJclNumericFormat.IntToStr Method (Int64)=id_11748 +6 TJclNumericFormat.IntToStr Method (Int64, Integer)=id_11756 +5 TJclNumericFormat.IsDigit Method +6 TJclNumericFormat.IsDigit Method=id_11749 +5 ShowSign Method +6 TJclNumericFormat.ShowSign Method (Float)=id_11750 +6 TJclNumericFormat.ShowSign Method (Int64)=id_11757 +5 TJclNumericFormat.Sign Method +6 TJclNumericFormat.Sign Method=id_11751 +5 SignChar Method +6 TJclNumericFormat.SignChar Method (Float)=id_11752 +6 TJclNumericFormat.SignChar Method (Int64)=id_11758 +5 TJclNumericFormat.StrToInt Method +6 TJclNumericFormat.StrToInt Method=id_11753 +3 Pointer manipulation +4 Pointer manipulation=id_11650 +4 PWideCharOrNil Function=id_11759 +4 PCharOrNil Function=id_11760 +2 Containers +3 Containers=id_11558 +3 TJclAbstractContainer Class +4 TJclAbstractContainer Class=id_2192 +4 TJclAbstractContainer.Create Constructor=id_1902 +4 TJclAbstractContainer.Destroy Destructor=id_1903 +4 TJclAbstractContainer.EnterCriticalSection Method=id_1904 +3 Container interfaces +4 Container interfaces=id_11764 +4 IJclCloneable Interface +5 IJclCloneable Interface=id_1873 +5 IJclCloneable.Clone Method=id_1875 +4 IJclIntfCloneable Interface +5 IJclIntfCloneable Interface=id_4413 +5 IJclIntfCloneable.Clone Method=id_4415 +4 IJclIntfIterator Interface +5 IJclIntfIterator Interface=id_4516 +5 IJclIntfIterator.Add Method=id_11806 +5 IJclIntfIterator.GetObject Method=id_11807 +5 IJclIntfIterator.HasNext Method=id_11808 +5 IJclIntfIterator.HasPrevious Method=id_11809 +5 IJclIntfIterator.Next Method=id_11810 +5 IJclIntfIterator.NextIndex Method=id_11811 +5 IJclIntfIterator.Previous Method=id_11812 +5 IJclIntfIterator.PreviousIndex Method=id_11813 +5 IJclIntfIterator.Remove Method=id_11814 +5 IJclIntfIterator.SetObject Method=id_11815 +4 IJclStrIterator Interface +5 IJclStrIterator Interface=id_5661 +5 IJclStrIterator.Add Method=id_11818 +5 IJclStrIterator.GetString Method=id_11819 +5 IJclStrIterator.HasNext Method=id_11820 +5 IJclStrIterator.HasPrevious Method=id_11821 +5 IJclStrIterator.Next Method=id_11822 +5 IJclStrIterator.NextIndex Method=id_11823 +5 IJclStrIterator.Previous Method=id_11824 +5 IJclStrIterator.PreviousIndex Method=id_11825 +5 IJclStrIterator.Remove Method=id_11826 +5 IJclStrIterator.SetString Method=id_11827 +4 IJclIterator Interface +5 IJclIterator Interface=id_2219 +5 IJclIterator.Add Method=id_11830 +5 IJclIterator.GetObject Method=id_11831 +5 IJclIterator.HasNext Method=id_11832 +5 IJclIterator.HasPrevious Method=id_11833 +5 IJclIterator.Next Method=id_11834 +5 IJclIterator.NextIndex Method=id_11835 +5 IJclIterator.Previous Method=id_11836 +5 IJclIterator.PreviousIndex Method=id_11837 +5 IJclIterator.Remove Method=id_11838 +5 IJclIterator.SetObject Method=id_11839 +4 IJclIntfCollection Interface +5 IJclIntfCollection Interface=id_4411 +5 IJclIntfCollection.Add Method=id_4416 +5 IJclIntfCollection.AddAll Method=id_4417 +5 IJclIntfCollection.Clear Method=id_4418 +5 IJclIntfCollection.Contains Method=id_4419 +5 IJclIntfCollection.ContainsAll Method=id_4420 +5 IJclIntfCollection.Equals Method=id_4421 +5 IJclIntfCollection.First Method=id_4422 +5 IJclIntfCollection.IsEmpty Method=id_4423 +5 IJclIntfCollection.Last Method=id_4424 +5 IJclIntfCollection.Remove Method=id_4425 +5 IJclIntfCollection.RemoveAll Method=id_4426 +5 IJclIntfCollection.RetainAll Method=id_4427 +5 IJclIntfCollection.Size Method=id_4428 +4 IJclStrCollection Interface +5 IJclStrCollection Interface=id_5620 +5 IJclStrCollection.Add Method=id_5530 +5 IJclStrCollection.AddAll Method=id_5531 +5 IJclStrCollection.AppendDelimited Method=id_5532 +5 IJclStrCollection.AppendFromStrings Method=id_5533 +5 IJclStrCollection.AppendToStrings Method=id_5534 +5 IJclStrCollection.Clear Method=id_5535 +5 IJclStrCollection.Contains Method=id_5536 +5 IJclStrCollection.ContainsAll Method=id_5537 +5 IJclStrCollection.Equals Method=id_5538 +5 IJclStrCollection.First Method=id_5539 +5 IJclStrCollection.GetAsDelimited Method=id_5540 +5 IJclStrCollection.GetAsStrings Method=id_5541 +5 IJclStrCollection.IsEmpty Method=id_5542 +5 IJclStrCollection.Last Method=id_5543 +5 IJclStrCollection.LoadDelimited Method=id_5544 +5 IJclStrCollection.LoadFromStrings Method=id_5545 +5 IJclStrCollection.Remove Method=id_5546 +5 IJclStrCollection.RemoveAll Method=id_5547 +5 IJclStrCollection.RetainAll Method=id_5548 +5 IJclStrCollection.SaveToStrings Method=id_5549 +5 IJclStrCollection.Size Method=id_5550 +4 IJclCollection Interface +5 IJclCollection Interface=id_1871 +5 IJclCollection.Add Method=id_1876 +5 IJclCollection.AddAll Method=id_1877 +5 IJclCollection.Clear Method=id_1878 +5 IJclCollection.Contains Method=id_1879 +5 IJclCollection.ContainsAll Method=id_1880 +5 IJclCollection.Equals Method=id_1881 +5 IJclCollection.First Method=id_1882 +5 IJclCollection.IsEmpty Method=id_1883 +5 IJclCollection.Last Method=id_1884 +5 IJclCollection.Remove Method=id_1885 +5 IJclCollection.RemoveAll Method=id_1886 +5 IJclCollection.RetainAll Method=id_1887 +5 IJclCollection.Size Method=id_1888 +4 IJclIntfList Interface +5 IJclIntfList Interface=id_6464 +5 IJclIntfList.GetObject Method=id_4432 +5 IJclIntfList.IndexOf Method=id_4433 +5 IJclIntfList.Insert Method=id_4434 +5 IJclIntfList.InsertAll Method=id_4435 +5 IJclIntfList.LastIndexOf Method=id_4436 +5 IJclIntfList.Remove Method=id_4437 +5 IJclIntfList.SetObject Method=id_4438 +5 IJclIntfList.SubList Method=id_4439 +4 IJclStrList Interface +5 IJclStrList Interface=id_6468 +5 IJclStrList.Items Property=id_5615 +5 IJclStrList.GetString Method=id_5554 +5 IJclStrList.IndexOf Method=id_5555 +5 IJclStrList.Insert Method=id_5556 +5 IJclStrList.InsertAll Method=id_5557 +5 IJclStrList.LastIndexOf Method=id_5558 +5 IJclStrList.Remove Method=id_5559 +5 IJclStrList.SetString Method=id_5560 +5 IJclStrList.SubList Method=id_5561 +4 IJclList Interface +5 IJclList Interface=id_6466 +5 IJclList.Items Property=id_1937 +5 IJclList.GetObject Method=id_1892 +5 IJclList.IndexOf Method=id_1893 +5 IJclList.Insert Method=id_1894 +5 IJclList.InsertAll Method=id_1895 +5 IJclList.LastIndexOf Method=id_1896 +5 IJclList.Remove Method=id_1897 +5 IJclList.SetObject Method=id_1898 +5 IJclList.SubList Method=id_1899 +4 IJclIntfArray Interface +5 IJclIntfArray Interface=id_11778 +5 IJclIntfArray.Items Property=id_4472 +5 IJclIntfArray.GetObject Method=id_4440 +5 IJclIntfArray.SetObject Method=id_4441 +4 IJclStrArray Interface +5 IJclStrArray Interface=id_11779 +5 IJclStrArray.Items Property=id_5616 +5 IJclStrArray.GetString Method=id_5562 +5 IJclStrArray.SetString Method=id_5563 +4 IJclArray Interface +5 IJclArray Interface=id_11780 +5 IJclArray.Items Property=id_1938 +5 IJclArray.GetObject Method=id_1900 +5 IJclArray.SetObject Method=id_1901 +4 IJclIntfSet Interface +5 IJclIntfSet Interface=id_4412 +5 IJclIntfSet.Intersect Method=id_4429 +5 IJclIntfSet.Subtract Method=id_4430 +5 IJclIntfSet.Union Method=id_4431 +4 IJclStrSet Interface +5 IJclStrSet Interface=id_5528 +5 IJclStrSet.Intersect Method=id_5551 +5 IJclStrSet.Subtract Method=id_5552 +5 IJclStrSet.Union Method=id_5553 +4 IJclSet Interface +5 IJclSet Interface=id_1872 +5 IJclSet.Intersect Method=id_1889 +5 IJclSet.Subtract Method=id_1890 +5 IJclSet.Union Method=id_1891 +4 IJclIntfTree Interface +5 IJclIntfTree Interface=id_4490 +5 IJclIntfTree.TraverseOrder Property=id_4512 +5 IJclIntfTree.GetTraverseOrder Method=id_4492 +5 IJclIntfTree.SetTraverseOrder Method=id_4493 +4 IJclStrTree Interface +5 IJclStrTree Interface=id_5635 +5 IJclStrTree.TraverseOrder Property=id_5657 +5 IJclStrTree.GetTraverseOrder Method=id_5637 +5 IJclStrTree.SetTraverseOrder Method=id_5638 +4 IJclTree Interface +5 IJclTree Interface=id_2193 +5 IJclTree.TraverseOrder Property=id_2215 +5 IJclTree.GetTraverseOrder Method=id_2195 +5 IJclTree.SetTraverseOrder Method=id_2196 +4 IJclIntfIntfMap Interface +5 IJclIntfIntfMap Interface=id_11781 +5 IJclIntfIntfMap.Clear Method=id_11880 +5 IJclIntfIntfMap.ContainsKey Method=id_11881 +5 IJclIntfIntfMap.ContainsValue Method=id_11882 +5 IJclIntfIntfMap.Equals Method=id_11883 +5 IJclIntfIntfMap.GetValue Method=id_11884 +5 IJclIntfIntfMap.IsEmpty Method=id_11885 +5 IJclIntfIntfMap.KeySet Method=id_11886 +5 IJclIntfIntfMap.PutAll Method=id_11887 +5 IJclIntfIntfMap.PutValue Method=id_11888 +5 IJclIntfIntfMap.Remove Method=id_11889 +5 IJclIntfIntfMap.Size Method=id_11890 +5 IJclIntfIntfMap.Values Method=id_11891 +4 IJclMultiIntfIntfMap Interface +5 IJclMultiIntfIntfMap Interface=id_11782 +5 IJclMultiIntfIntfMap.Count Method=id_11894 +5 IJclMultiIntfIntfMap.GetValues Method=id_11895 +4 IJclStrIntfMap Interface +5 IJclStrIntfMap Interface=id_11783 +5 IJclStrIntfMap.Clear Method=id_11898 +5 IJclStrIntfMap.ContainsKey Method=id_11899 +5 IJclStrIntfMap.ContainsValue Method=id_11900 +5 IJclStrIntfMap.Equals Method=id_11901 +5 IJclStrIntfMap.GetValue Method=id_11902 +5 IJclStrIntfMap.IsEmpty Method=id_11903 +5 IJclStrIntfMap.KeySet Method=id_11904 +5 IJclStrIntfMap.PutAll Method=id_11905 +5 IJclStrIntfMap.PutValue Method=id_11906 +5 IJclStrIntfMap.Remove Method=id_11907 +5 IJclStrIntfMap.Size Method=id_11908 +5 IJclStrIntfMap.Values Method=id_11909 +4 IJclStrStrMap Interface +5 IJclStrStrMap Interface=id_11784 +5 IJclStrStrMap.Items Property=id_11913 +5 IJclStrStrMap.Clear Method=id_11914 +5 IJclStrStrMap.ContainsKey Method=id_11915 +5 IJclStrStrMap.ContainsValue Method=id_11916 +5 IJclStrStrMap.Equals Method=id_11917 +5 IJclStrStrMap.GetValue Method=id_11918 +5 IJclStrStrMap.IsEmpty Method=id_11919 +5 IJclStrStrMap.KeyOfValue Method=id_11920 +5 IJclStrStrMap.KeySet Method=id_11921 +5 IJclStrStrMap.PutAll Method=id_11922 +5 IJclStrStrMap.PutValue Method=id_11923 +5 IJclStrStrMap.Remove Method=id_11924 +5 IJclStrStrMap.Size Method=id_11925 +5 IJclStrStrMap.Values Method=id_11926 +4 IJclStrMap Interface +5 IJclStrMap Interface=id_11785 +5 IJclStrMap.Items Property=id_11930 +5 IJclStrMap.Clear Method=id_11931 +5 IJclStrMap.ContainsKey Method=id_11932 +5 IJclStrMap.ContainsValue Method=id_11933 +5 IJclStrMap.Equals Method=id_11934 +5 IJclStrMap.GetValue Method=id_11935 +5 IJclStrMap.IsEmpty Method=id_11936 +5 IJclStrMap.KeySet Method=id_11937 +5 IJclStrMap.PutAll Method=id_11938 +5 IJclStrMap.PutValue Method=id_11939 +5 IJclStrMap.Remove Method=id_11940 +5 IJclStrMap.Size Method=id_11941 +5 IJclStrMap.Values Method=id_11942 +4 IJclMap Interface +5 IJclMap Interface=id_11786 +5 IJclMap.Items Property=id_11946 +5 IJclMap.Clear Method=id_11947 +5 IJclMap.ContainsKey Method=id_11948 +5 IJclMap.ContainsValue Method=id_11949 +5 IJclMap.Equals Method=id_11950 +5 IJclMap.GetValue Method=id_11951 +5 IJclMap.IsEmpty Method=id_11952 +5 IJclMap.KeySet Method=id_11953 +5 IJclMap.PutAll Method=id_11954 +5 IJclMap.PutValue Method=id_11955 +5 IJclMap.Remove Method=id_11956 +5 IJclMap.Size Method=id_11957 +5 IJclMap.Values Method=id_11958 +4 IJclIntfQueue Interface +5 IJclIntfQueue Interface=id_11787 +5 IJclIntfQueue.Contains Method=id_11961 +5 IJclIntfQueue.Dequeue Method=id_11962 +5 IJclIntfQueue.Empty Method=id_11963 +5 IJclIntfQueue.Enqueue Method=id_11964 +5 IJclIntfQueue.Size Method=id_11965 +4 IJclStrQueue Interface +5 IJclStrQueue Interface=id_11788 +5 IJclStrQueue.Contains Method=id_11968 +5 IJclStrQueue.Dequeue Method=id_11969 +5 IJclStrQueue.Empty Method=id_11970 +5 IJclStrQueue.Enqueue Method=id_11971 +5 IJclStrQueue.Size Method=id_11972 +4 IJclQueue Interface +5 IJclQueue Interface=id_11789 +5 IJclQueue.Contains Method=id_11975 +5 IJclQueue.Dequeue Method=id_11976 +5 IJclQueue.Empty Method=id_11977 +5 IJclQueue.Enqueue Method=id_11978 +5 IJclQueue.Size Method=id_11979 +4 IJclStrStrSortedMap Interface +5 IJclStrStrSortedMap Interface=id_11790 +5 IJclStrStrSortedMap.FirstKey Method=id_11983 +5 IJclStrStrSortedMap.HeadMap Method=id_11984 +5 IJclStrStrSortedMap.LastKey Method=id_11985 +5 IJclStrStrSortedMap.SubMap Method=id_11986 +5 IJclStrStrSortedMap.TailMap Method=id_11987 +4 IJclSortedMap Interface +5 IJclSortedMap Interface=id_11791 +5 IJclSortedMap.FirstKey Method=id_11991 +5 IJclSortedMap.HeadMap Method=id_11992 +5 IJclSortedMap.LastKey Method=id_11993 +5 IJclSortedMap.SubMap Method=id_11994 +5 IJclSortedMap.TailMap Method=id_11995 +4 IJclIntfSortedSet Interface +5 IJclIntfSortedSet Interface=id_11792 +5 IJclIntfSortedSet.HeadSet Method=id_11998 +5 IJclIntfSortedSet.SubSet Method=id_11999 +5 IJclIntfSortedSet.TailSet Method=id_12000 +4 IJclSortedSet Interface +5 IJclSortedSet Interface=id_11793 +5 IJclSortedSet.HeadSet Method=id_12003 +5 IJclSortedSet.SubSet Method=id_12004 +5 IJclSortedSet.TailSet Method=id_12005 +4 IJclIntfStack Interface +5 IJclIntfStack Interface=id_11794 +5 IJclIntfStack.Contains Method=id_12008 +5 IJclIntfStack.Empty Method=id_12009 +5 IJclIntfStack.Pop Method=id_12010 +5 IJclIntfStack.Push Method=id_12011 +5 IJclIntfStack.Size Method=id_12012 +4 IJclStrStack Interface +5 IJclStrStack Interface=id_11795 +5 IJclStrStack.Contains Method=id_12015 +5 IJclStrStack.Empty Method=id_12016 +5 IJclStrStack.Pop Method=id_12017 +5 IJclStrStack.Push Method=id_12018 +5 IJclStrStack.Size Method=id_12019 +4 IJclStack Interface +5 IJclStack Interface=id_11796 +5 IJclStack.Contains Method=id_12022 +5 IJclStack.Empty Method=id_12023 +5 IJclStack.Pop Method=id_12024 +5 IJclStack.Push Method=id_12025 +5 IJclStack.Size Method=id_12026 +4 TJclTraverseOrder Enumeration +5 TJclTraverseOrder Enumeration=id_2220 +3 Sequence containers +4 Sequence containers=id_11765 +4 Vectors +5 Vectors=id_12028 +5 TJclVector Class +6 TJclVector Class=id_12031 +6 TJclVector.Items Property=id_12069 +6 TJclVector.OwnsObjects Property=id_12070 +6 TJclVector.Add Method=id_12042 +6 TJclVector.AddAll Method=id_12043 +6 TJclVector.AfterConstruction Method=id_12044 +6 TJclVector.BeforeDestruction Method=id_12045 +6 TJclVector.Clear Method=id_12046 +6 TJclVector.Clone Method=id_12047 +6 TJclVector.Contains Method=id_12048 +6 TJclVector.ContainsAll Method=id_12049 +6 TJclVector.Create Constructor=id_12050 +6 TJclVector.Destroy Destructor=id_12051 +6 TJclVector.Equals Method=id_12052 +6 TJclVector.First Method=id_12053 +6 TJclVector.FreeObject Method=id_12054 +6 TJclVector.GetObject Method=id_12055 +6 TJclVector.Grow Method=id_12056 +6 TJclVector.IndexOf Method=id_12057 +6 TJclVector.Insert Method=id_12032 +6 TJclVector.InsertAll Method=id_12058 +6 TJclVector.IsEmpty Method=id_12059 +6 TJclVector.Last Method=id_12060 +6 TJclVector.LastIndexOf Method=id_12061 +6 Remove Method +7 TJclVector.Remove Method (Integer)=id_12062 +7 TJclVector.Remove Method (TObject)=id_12073 +6 TJclVector.RemoveAll Method +7 TJclVector.RemoveAll Method=id_12063 +6 TJclVector.RetainAll Method +7 TJclVector.RetainAll Method=id_12064 +6 TJclVector.SetObject Method +7 TJclVector.SetObject Method=id_12065 +6 TJclVector.Size Method +7 TJclVector.Size Method=id_12066 +6 TJclVector.SubList Method +7 TJclVector.SubList Method=id_12067 +5 TJclStrVector Class +6 TJclStrVector Class=id_12033 +6 TJclStrVector.Items Property=id_12104 +6 TJclStrVector.Add Method=id_12078 +6 TJclStrVector.AddAll Method=id_12079 +6 TJclStrVector.AfterConstruction Method=id_12080 +6 TJclStrVector.BeforeDestruction Method=id_12081 +6 TJclStrVector.Clear Method=id_12082 +6 TJclStrVector.Clone Method=id_12083 +6 TJclStrVector.Contains Method=id_12084 +6 TJclStrVector.ContainsAll Method=id_12085 +6 TJclStrVector.Create Constructor=id_12086 +6 TJclStrVector.Destroy Destructor=id_12087 +6 TJclStrVector.Equals Method=id_12088 +6 TJclStrVector.First Method=id_12089 +6 TJclStrVector.GetString Method=id_12090 +6 TJclStrVector.Grow Method=id_12091 +6 TJclStrVector.IndexOf Method=id_12092 +6 TJclStrVector.Insert Method=id_12034 +6 TJclStrVector.InsertAll Method=id_12093 +6 TJclStrVector.IsEmpty Method=id_12094 +6 TJclStrVector.Last Method=id_12095 +6 TJclStrVector.LastIndexOf Method=id_12096 +6 Remove Method +7 TJclStrVector.Remove Method (Integer)=id_12097 +7 TJclStrVector.Remove Method (string)=id_12107 +6 TJclStrVector.RemoveAll Method +7 TJclStrVector.RemoveAll Method=id_12098 +6 TJclStrVector.RetainAll Method +7 TJclStrVector.RetainAll Method=id_12099 +6 TJclStrVector.SetString Method +7 TJclStrVector.SetString Method=id_12100 +6 TJclStrVector.Size Method +7 TJclStrVector.Size Method=id_12101 +6 TJclStrVector.SubList Method +7 TJclStrVector.SubList Method=id_12102 +5 TJclIntfVector Class +6 TJclIntfVector Class=id_12035 +6 TJclIntfVector.Items Property=id_12138 +6 TJclIntfVector.Add Method=id_12112 +6 TJclIntfVector.AddAll Method=id_12113 +6 TJclIntfVector.AfterConstruction Method=id_12114 +6 TJclIntfVector.BeforeDestruction Method=id_12115 +6 TJclIntfVector.Clear Method=id_12116 +6 TJclIntfVector.Clone Method=id_12117 +6 TJclIntfVector.Contains Method=id_12118 +6 TJclIntfVector.ContainsAll Method=id_12119 +6 TJclIntfVector.Create Constructor=id_12120 +6 TJclIntfVector.Destroy Destructor=id_12121 +6 TJclIntfVector.Equals Method=id_12122 +6 TJclIntfVector.First Method=id_12123 +6 TJclIntfVector.GetObject Method=id_12124 +6 TJclIntfVector.Grow Method=id_12125 +6 TJclIntfVector.IndexOf Method=id_12126 +6 TJclIntfVector.Insert Method=id_12036 +6 TJclIntfVector.InsertAll Method=id_12127 +6 TJclIntfVector.IsEmpty Method=id_12128 +6 TJclIntfVector.Last Method=id_12129 +6 TJclIntfVector.LastIndexOf Method=id_12130 +6 Remove Method +7 TJclIntfVector.Remove Method (IInterface)=id_12131 +7 TJclIntfVector.Remove Method (Integer)=id_12141 +6 TJclIntfVector.RemoveAll Method +7 TJclIntfVector.RemoveAll Method=id_12132 +6 TJclIntfVector.RetainAll Method +7 TJclIntfVector.RetainAll Method=id_12133 +6 TJclIntfVector.SetObject Method +7 TJclIntfVector.SetObject Method=id_12134 +6 TJclIntfVector.Size Method +7 TJclIntfVector.Size Method=id_12135 +6 TJclIntfVector.SubList Method +7 TJclIntfVector.SubList Method=id_12136 +4 Linked Lists +5 Linked Lists=id_12029 +5 TJclLinkedList Class +6 TJclLinkedList Class=id_12142 +6 TJclLinkedList.OwnsObjects Property=id_12178 +6 TJclLinkedList.Add Method=id_12153 +6 TJclLinkedList.AddAll Method=id_12154 +6 TJclLinkedList.AddFirst Method=id_12155 +6 TJclLinkedList.Clear Method=id_12156 +6 TJclLinkedList.Clone Method=id_12157 +6 TJclLinkedList.Contains Method=id_12158 +6 TJclLinkedList.ContainsAll Method=id_12159 +6 TJclLinkedList.Create Constructor=id_12160 +6 TJclLinkedList.Destroy Destructor=id_12161 +6 TJclLinkedList.Equals Method=id_12162 +6 TJclLinkedList.First Method=id_12163 +6 TJclLinkedList.FreeObject Method=id_12164 +6 TJclLinkedList.GetObject Method=id_12165 +6 TJclLinkedList.IndexOf Method=id_12166 +6 TJclLinkedList.Insert Method=id_12143 +6 TJclLinkedList.InsertAll Method=id_12167 +6 TJclLinkedList.IsEmpty Method=id_12168 +6 TJclLinkedList.Last Method=id_12169 +6 TJclLinkedList.LastIndexOf Method=id_12170 +6 Remove Method +7 TJclLinkedList.Remove Method (Integer)=id_12171 +7 TJclLinkedList.Remove Method (TObject)=id_12181 +6 TJclLinkedList.RemoveAll Method +7 TJclLinkedList.RemoveAll Method=id_12172 +6 TJclLinkedList.RetainAll Method +7 TJclLinkedList.RetainAll Method=id_12173 +6 TJclLinkedList.SetObject Method +7 TJclLinkedList.SetObject Method=id_12174 +6 TJclLinkedList.Size Method +7 TJclLinkedList.Size Method=id_12175 +6 TJclLinkedList.SubList Method +7 TJclLinkedList.SubList Method=id_12176 +5 TJclIntfLinkedList Class +6 TJclIntfLinkedList Class=id_12144 +6 TJclIntfLinkedList.Add Method=id_12185 +6 TJclIntfLinkedList.AddAll Method=id_12186 +6 TJclIntfLinkedList.AddFirst Method=id_12187 +6 TJclIntfLinkedList.Clear Method=id_12188 +6 TJclIntfLinkedList.Clone Method=id_12189 +6 TJclIntfLinkedList.Contains Method=id_12190 +6 TJclIntfLinkedList.ContainsAll Method=id_12191 +6 TJclIntfLinkedList.Create Constructor=id_12192 +6 TJclIntfLinkedList.Destroy Destructor=id_12193 +6 TJclIntfLinkedList.Equals Method=id_12194 +6 TJclIntfLinkedList.First Method=id_12195 +6 TJclIntfLinkedList.GetObject Method=id_12196 +6 TJclIntfLinkedList.IndexOf Method=id_12197 +6 TJclIntfLinkedList.Insert Method=id_12145 +6 TJclIntfLinkedList.InsertAll Method=id_12198 +6 TJclIntfLinkedList.IsEmpty Method=id_12199 +6 TJclIntfLinkedList.Last Method=id_12200 +6 TJclIntfLinkedList.LastIndexOf Method=id_12201 +6 Remove Method +7 TJclIntfLinkedList.Remove Method (IInterface)=id_12202 +7 TJclIntfLinkedList.Remove Method (Integer)=id_12210 +6 TJclIntfLinkedList.RemoveAll Method +7 TJclIntfLinkedList.RemoveAll Method=id_12203 +6 TJclIntfLinkedList.RetainAll Method +7 TJclIntfLinkedList.RetainAll Method=id_12204 +6 TJclIntfLinkedList.SetObject Method +7 TJclIntfLinkedList.SetObject Method=id_12205 +6 TJclIntfLinkedList.Size Method +7 TJclIntfLinkedList.Size Method=id_12206 +6 TJclIntfLinkedList.SubList Method +7 TJclIntfLinkedList.SubList Method=id_12207 +5 TJclStrLinkedList Class +6 TJclStrLinkedList Class=id_12146 +6 TJclStrLinkedList.Add Method=id_12215 +6 TJclStrLinkedList.AddAll Method=id_12216 +6 TJclStrLinkedList.AddFirst Method=id_12217 +6 TJclStrLinkedList.Clear Method=id_12218 +6 TJclStrLinkedList.Clone Method=id_12219 +6 TJclStrLinkedList.Contains Method=id_12220 +6 TJclStrLinkedList.ContainsAll Method=id_12221 +6 TJclStrLinkedList.Create Constructor=id_12222 +6 TJclStrLinkedList.Destroy Destructor=id_12223 +6 TJclStrLinkedList.Equals Method=id_12224 +6 TJclStrLinkedList.First Method=id_12225 +6 TJclStrLinkedList.GetString Method=id_12226 +6 TJclStrLinkedList.IndexOf Method=id_12227 +6 TJclStrLinkedList.Insert Method=id_12147 +6 TJclStrLinkedList.InsertAll Method=id_12228 +6 TJclStrLinkedList.IsEmpty Method=id_12229 +6 TJclStrLinkedList.Last Method=id_12230 +6 TJclStrLinkedList.LastIndexOf Method=id_12231 +6 Remove Method +7 TJclStrLinkedList.Remove Method (Integer)=id_12232 +7 TJclStrLinkedList.Remove Method (string)=id_12240 +6 TJclStrLinkedList.RemoveAll Method +7 TJclStrLinkedList.RemoveAll Method=id_12233 +6 TJclStrLinkedList.RetainAll Method +7 TJclStrLinkedList.RetainAll Method=id_12234 +6 TJclStrLinkedList.SetString Method +7 TJclStrLinkedList.SetString Method=id_12235 +6 TJclStrLinkedList.Size Method +7 TJclStrLinkedList.Size Method=id_12236 +6 TJclStrLinkedList.SubList Method +7 TJclStrLinkedList.SubList Method=id_12237 +3 Associative containers +4 Associative containers=id_11766 +4 Maps +5 Maps=id_12241 +5 TJclHashMap Class +6 TJclHashMap Class=id_12243 +6 TJclHashMap.HashFunction Event=id_12244 +6 TJclHashMap.OwnsObjects Property=id_12277 +6 TJclHashMap.Clear Method=id_12259 +6 TJclHashMap.Clone Method=id_12260 +6 TJclHashMap.ContainsKey Method=id_12261 +6 TJclHashMap.ContainsValue Method=id_12262 +6 TJclHashMap.Create Constructor=id_12263 +6 TJclHashMap.Destroy Destructor=id_12264 +6 TJclHashMap.Equals Method=id_12265 +6 TJclHashMap.FreeObject Method=id_12266 +6 TJclHashMap.GetValue Method=id_12267 +6 TJclHashMap.GrowEntries Method=id_12268 +6 TJclHashMap.IsEmpty Method=id_12269 +6 TJclHashMap.KeySet Method=id_12270 +6 TJclHashMap.PutAll Method=id_12271 +6 TJclHashMap.PutValue Method=id_12272 +6 TJclHashMap.Remove Method=id_12273 +6 TJclHashMap.Size Method=id_12274 +6 TJclHashMap.Values Method=id_12275 +5 TJclIntfIntfHashMap Class +6 TJclIntfIntfHashMap Class=id_12245 +6 TJclIntfIntfHashMap.HashFunction Event=id_12246 +6 TJclIntfIntfHashMap.Clear Method=id_12284 +6 TJclIntfIntfHashMap.Clone Method=id_12285 +6 TJclIntfIntfHashMap.ContainsKey Method=id_12286 +6 TJclIntfIntfHashMap.ContainsValue Method=id_12287 +6 TJclIntfIntfHashMap.Create Constructor=id_12288 +6 TJclIntfIntfHashMap.Destroy Destructor=id_12289 +6 TJclIntfIntfHashMap.Equals Method=id_12290 +6 TJclIntfIntfHashMap.GetValue Method=id_12291 +6 TJclIntfIntfHashMap.GrowEntries Method=id_12292 +6 TJclIntfIntfHashMap.IsEmpty Method=id_12293 +6 TJclIntfIntfHashMap.KeySet Method=id_12294 +6 TJclIntfIntfHashMap.PutAll Method=id_12295 +6 TJclIntfIntfHashMap.PutValue Method=id_12296 +6 TJclIntfIntfHashMap.Remove Method=id_12297 +6 TJclIntfIntfHashMap.Size Method=id_12298 +6 TJclIntfIntfHashMap.Values Method=id_12299 +5 TJclStrIntfHashMap Class +6 TJclStrIntfHashMap Class=id_12247 +6 TJclStrIntfHashMap.HashFunction Event=id_12248 +6 TJclStrIntfHashMap.Clear Method=id_12306 +6 TJclStrIntfHashMap.Clone Method=id_12307 +6 TJclStrIntfHashMap.ContainsKey Method=id_12308 +6 TJclStrIntfHashMap.ContainsValue Method=id_12309 +6 TJclStrIntfHashMap.Create Constructor=id_12310 +6 TJclStrIntfHashMap.Destroy Destructor=id_12311 +6 TJclStrIntfHashMap.Equals Method=id_12312 +6 TJclStrIntfHashMap.GetValue Method=id_12313 +6 TJclStrIntfHashMap.GrowEntries Method=id_12314 +6 TJclStrIntfHashMap.IsEmpty Method=id_12315 +6 TJclStrIntfHashMap.KeySet Method=id_12316 +6 TJclStrIntfHashMap.PutAll Method=id_12317 +6 TJclStrIntfHashMap.PutValue Method=id_12318 +6 TJclStrIntfHashMap.Remove Method=id_12319 +6 TJclStrIntfHashMap.Size Method=id_12320 +6 TJclStrIntfHashMap.Values Method=id_12321 +5 TJclStrHashMap Class +6 TJclStrHashMap Class=id_12249 +6 TJclStrHashMap.HashFunction Event=id_12250 +6 TJclStrHashMap.OwnsObjects Property=id_12347 +6 TJclStrHashMap.Clear Method=id_12329 +6 TJclStrHashMap.Clone Method=id_12330 +6 TJclStrHashMap.ContainsKey Method=id_12331 +6 TJclStrHashMap.ContainsValue Method=id_12332 +6 TJclStrHashMap.Create Constructor=id_12333 +6 TJclStrHashMap.Destroy Destructor=id_12334 +6 TJclStrHashMap.Equals Method=id_12335 +6 TJclStrHashMap.FreeObject Method=id_12336 +6 TJclStrHashMap.GetValue Method=id_12337 +6 TJclStrHashMap.GrowEntries Method=id_12338 +6 TJclStrHashMap.IsEmpty Method=id_12339 +6 TJclStrHashMap.KeySet Method=id_12340 +6 TJclStrHashMap.PutAll Method=id_12341 +6 TJclStrHashMap.PutValue Method=id_12342 +6 TJclStrHashMap.Remove Method=id_12343 +6 TJclStrHashMap.Size Method=id_12344 +6 TJclStrHashMap.Values Method=id_12345 +5 TJclStrStrHashMap Class +6 TJclStrStrHashMap Class=id_12251 +6 TJclStrStrHashMap.HashFunction Event=id_12252 +6 TJclStrStrHashMap.Clear Method=id_12355 +6 TJclStrStrHashMap.Clone Method=id_12356 +6 TJclStrStrHashMap.ContainsKey Method=id_12357 +6 TJclStrStrHashMap.ContainsValue Method=id_12358 +6 TJclStrStrHashMap.Create Constructor=id_12359 +6 TJclStrStrHashMap.Destroy Destructor=id_12360 +6 TJclStrStrHashMap.Equals Method=id_12361 +6 TJclStrStrHashMap.GetValue Method=id_12362 +6 TJclStrStrHashMap.GrowEntries Method=id_12363 +6 TJclStrStrHashMap.IsEmpty Method=id_12364 +6 TJclStrStrHashMap.KeyOfValue Method=id_12365 +6 TJclStrStrHashMap.KeySet Method=id_12366 +6 TJclStrStrHashMap.PutAll Method=id_12367 +6 TJclStrStrHashMap.PutValue Method=id_12368 +6 TJclStrStrHashMap.Remove Method=id_12369 +6 TJclStrStrHashMap.Size Method=id_12370 +6 TJclStrStrHashMap.Values Method=id_12371 +3 Ordered sets +4 Ordered sets=id_11767 +4 TJclIntfHashSet Class +5 TJclIntfHashSet Class=id_12374 +5 TJclIntfHashSet.Add Method=id_12381 +5 TJclIntfHashSet.AddAll Method=id_12382 +5 TJclIntfHashSet.Clear Method=id_12383 +5 TJclIntfHashSet.Clone Method=id_12384 +5 TJclIntfHashSet.Contains Method=id_12385 +5 TJclIntfHashSet.ContainsAll Method=id_12386 +5 TJclIntfHashSet.Create Constructor=id_12387 +5 TJclIntfHashSet.Destroy Destructor=id_12388 +5 TJclIntfHashSet.Equals Method=id_12389 +5 TJclIntfHashSet.First Method=id_12390 +5 TJclIntfHashSet.Intersect Method=id_12391 +5 TJclIntfHashSet.IsEmpty Method=id_12392 +5 TJclIntfHashSet.Last Method=id_12393 +5 TJclIntfHashSet.Remove Method=id_12394 +5 TJclIntfHashSet.RemoveAll Method=id_12395 +5 TJclIntfHashSet.RetainAll Method=id_12396 +5 TJclIntfHashSet.Size Method=id_12397 +5 TJclIntfHashSet.Subtract Method=id_12398 +5 TJclIntfHashSet.Union Method=id_12399 +4 TJclHashSet Class +5 TJclHashSet Class=id_12375 +5 TJclHashSet.Add Method=id_12405 +5 TJclHashSet.AddAll Method=id_12406 +5 TJclHashSet.Clear Method=id_12407 +5 TJclHashSet.Clone Method=id_12408 +5 TJclHashSet.Contains Method=id_12409 +5 TJclHashSet.ContainsAll Method=id_12410 +5 TJclHashSet.Create Constructor=id_12411 +5 TJclHashSet.Destroy Destructor=id_12412 +5 TJclHashSet.Equals Method=id_12413 +5 TJclHashSet.First Method=id_12414 +5 TJclHashSet.Intersect Method=id_12415 +5 TJclHashSet.IsEmpty Method=id_12416 +5 TJclHashSet.Last Method=id_12417 +5 TJclHashSet.Remove Method=id_12418 +5 TJclHashSet.RemoveAll Method=id_12419 +5 TJclHashSet.RetainAll Method=id_12420 +5 TJclHashSet.Size Method=id_12421 +5 TJclHashSet.Subtract Method=id_12422 +5 TJclHashSet.Union Method=id_12423 +4 TJclStrHashSet Class +5 TJclStrHashSet Class=id_12376 +5 TJclStrHashSet.Add Method=id_12429 +5 TJclStrHashSet.AddAll Method=id_12430 +5 TJclStrHashSet.Clear Method=id_12431 +5 TJclStrHashSet.Clone Method=id_12432 +5 TJclStrHashSet.Contains Method=id_12433 +5 TJclStrHashSet.ContainsAll Method=id_12434 +5 TJclStrHashSet.Create Constructor=id_12435 +5 TJclStrHashSet.Destroy Destructor=id_12436 +5 TJclStrHashSet.Equals Method=id_12437 +5 TJclStrHashSet.First Method=id_12438 +5 TJclStrHashSet.Intersect Method=id_12439 +5 TJclStrHashSet.IsEmpty Method=id_12440 +5 TJclStrHashSet.Last Method=id_12441 +5 TJclStrHashSet.Remove Method=id_12442 +5 TJclStrHashSet.RemoveAll Method=id_12443 +5 TJclStrHashSet.RetainAll Method=id_12444 +5 TJclStrHashSet.Size Method=id_12445 +5 TJclStrHashSet.Subtract Method=id_12446 +5 TJclStrHashSet.Union Method=id_12447 +3 Container adapters +4 Container adapters=id_11768 +4 Stacks +5 Stacks=id_12450 +5 TJclStack Class +6 TJclStack Class=id_12453 +6 TJclStack.Contains Method=id_12460 +6 TJclStack.Create Constructor=id_12461 +6 TJclStack.Empty Method=id_12462 +6 TJclStack.Grow Method=id_12463 +6 TJclStack.Pop Method=id_12464 +6 TJclStack.Push Method=id_12465 +6 TJclStack.Size Method=id_12466 +5 TJclIntfStack Class +6 TJclIntfStack Class=id_12454 +6 TJclIntfStack.Contains Method=id_12472 +6 TJclIntfStack.Create Constructor=id_12473 +6 TJclIntfStack.Empty Method=id_12474 +6 TJclIntfStack.Grow Method=id_12475 +6 TJclIntfStack.Pop Method=id_12476 +6 TJclIntfStack.Push Method=id_12477 +6 TJclIntfStack.Size Method=id_12478 +5 TJclStrStack Class +6 TJclStrStack Class=id_12455 +6 TJclStrStack.Contains Method=id_12484 +6 TJclStrStack.Create Constructor=id_12485 +6 TJclStrStack.Empty Method=id_12486 +6 TJclStrStack.Grow Method=id_12487 +6 TJclStrStack.Pop Method=id_12488 +6 TJclStrStack.Push Method=id_12489 +6 TJclStrStack.Size Method=id_12490 +4 Queues +5 Queues=id_12451 +5 TJclQueue Class +6 TJclQueue Class=id_12493 +6 TJclQueue.Contains Method=id_12500 +6 TJclQueue.Create Constructor=id_12501 +6 TJclQueue.Dequeue Method=id_12502 +6 TJclQueue.Empty Method=id_12503 +6 TJclQueue.Enqueue Method=id_12504 +6 TJclQueue.Size Method=id_12505 +5 TJclIntfQueue Class +6 TJclIntfQueue Class=id_12494 +6 TJclIntfQueue.Contains Method=id_12511 +6 TJclIntfQueue.Create Constructor=id_12512 +6 TJclIntfQueue.Dequeue Method=id_12513 +6 TJclIntfQueue.Empty Method=id_12514 +6 TJclIntfQueue.Enqueue Method=id_12515 +6 TJclIntfQueue.Size Method=id_12516 +5 TJclStrQueue Class +6 TJclStrQueue Class=id_12495 +6 TJclStrQueue.Contains Method=id_12522 +6 TJclStrQueue.Create Constructor=id_12523 +6 TJclStrQueue.Dequeue Method=id_12524 +6 TJclStrQueue.Empty Method=id_12525 +6 TJclStrQueue.Enqueue Method=id_12526 +6 TJclStrQueue.Size Method=id_12527 +3 Specialized containers +4 Specialized containers=id_11769 +4 Arrays +5 Arrays=id_12530 +5 TJclIntfArrayList Class +6 TJclIntfArrayList Class=id_4410 +6 TJclIntfArrayList.Capacity Property=id_4473 +6 TJclIntfArrayList.Add Method=id_4442 +6 TJclIntfArrayList.AddAll Method=id_4443 +6 TJclIntfArrayList.Clear Method=id_4444 +6 TJclIntfArrayList.Clone Method=id_4445 +6 TJclIntfArrayList.Contains Method=id_4446 +6 TJclIntfArrayList.ContainsAll Method=id_4447 +6 Create Constructor +7 TJclIntfArrayList.Create Constructor (IJclIntfCollection)=id_4448 +7 TJclIntfArrayList.Create Constructor (Integer)=id_12539 +6 TJclIntfArrayList.Destroy Destructor +7 TJclIntfArrayList.Destroy Destructor=id_4449 +6 TJclIntfArrayList.Equals Method +7 TJclIntfArrayList.Equals Method=id_4450 +6 TJclIntfArrayList.First Method +7 TJclIntfArrayList.First Method=id_4451 +6 TJclIntfArrayList.GetObject Method +7 TJclIntfArrayList.GetObject Method=id_4452 +6 TJclIntfArrayList.Grow Method +7 TJclIntfArrayList.Grow Method=id_4453 +6 TJclIntfArrayList.IndexOf Method +7 TJclIntfArrayList.IndexOf Method=id_4454 +6 TJclIntfArrayList.Insert Method +7 TJclIntfArrayList.Insert Method=id_4455 +6 TJclIntfArrayList.InsertAll Method +7 TJclIntfArrayList.InsertAll Method=id_4456 +6 TJclIntfArrayList.IsEmpty Method +7 TJclIntfArrayList.IsEmpty Method=id_4457 +6 TJclIntfArrayList.Last Method +7 TJclIntfArrayList.Last Method=id_4458 +6 TJclIntfArrayList.LastIndexOf Method +7 TJclIntfArrayList.LastIndexOf Method=id_4459 +6 Remove Method +7 TJclIntfArrayList.Remove Method (IInterface)=id_4460 +7 TJclIntfArrayList.Remove Method (Integer)=id_12540 +6 TJclIntfArrayList.RemoveAll Method +7 TJclIntfArrayList.RemoveAll Method=id_4461 +6 TJclIntfArrayList.RetainAll Method +7 TJclIntfArrayList.RetainAll Method=id_4462 +6 TJclIntfArrayList.SetObject Method +7 TJclIntfArrayList.SetObject Method=id_4463 +6 TJclIntfArrayList.Size Method +7 TJclIntfArrayList.Size Method=id_4464 +6 TJclIntfArrayList.SubList Method +7 TJclIntfArrayList.SubList Method=id_4465 +5 TJclStrArrayList Class +6 TJclStrArrayList Class=id_5527 +6 TJclStrArrayList.Capacity Property=id_5617 +6 TJclStrArrayList.Add Method=id_5585 +6 TJclStrArrayList.AddAll Method=id_5586 +6 TJclStrArrayList.Clear Method=id_5587 +6 TJclStrArrayList.Clone Method=id_5588 +6 TJclStrArrayList.Contains Method=id_5589 +6 TJclStrArrayList.ContainsAll Method=id_5590 +6 Create Constructor +7 TJclStrArrayList.Create Constructor (IJclStrCollection)=id_5591 +7 TJclStrArrayList.Create Constructor (Integer)=id_12547 +6 TJclStrArrayList.Destroy Destructor +7 TJclStrArrayList.Destroy Destructor=id_5592 +6 TJclStrArrayList.Equals Method +7 TJclStrArrayList.Equals Method=id_5593 +6 TJclStrArrayList.First Method +7 TJclStrArrayList.First Method=id_5594 +6 TJclStrArrayList.GetString Method +7 TJclStrArrayList.GetString Method=id_5595 +6 TJclStrArrayList.Grow Method +7 TJclStrArrayList.Grow Method=id_5596 +6 TJclStrArrayList.IndexOf Method +7 TJclStrArrayList.IndexOf Method=id_5597 +6 TJclStrArrayList.Insert Method +7 TJclStrArrayList.Insert Method=id_5598 +6 TJclStrArrayList.InsertAll Method +7 TJclStrArrayList.InsertAll Method=id_5599 +6 TJclStrArrayList.IsEmpty Method +7 TJclStrArrayList.IsEmpty Method=id_5600 +6 TJclStrArrayList.Last Method +7 TJclStrArrayList.Last Method=id_5601 +6 TJclStrArrayList.LastIndexOf Method +7 TJclStrArrayList.LastIndexOf Method=id_5602 +6 Remove Method +7 TJclStrArrayList.Remove Method (Integer)=id_5603 +7 TJclStrArrayList.Remove Method (string)=id_12548 +6 TJclStrArrayList.RemoveAll Method +7 TJclStrArrayList.RemoveAll Method=id_5604 +6 TJclStrArrayList.RetainAll Method +7 TJclStrArrayList.RetainAll Method=id_5605 +6 TJclStrArrayList.SetString Method +7 TJclStrArrayList.SetString Method=id_5606 +6 TJclStrArrayList.Size Method +7 TJclStrArrayList.Size Method=id_5607 +6 TJclStrArrayList.SubList Method +7 TJclStrArrayList.SubList Method=id_5608 +5 TJclArrayList Class +6 TJclArrayList Class=id_1870 +6 TJclArrayList.Capacity Property=id_1939 +6 TJclArrayList.OwnsObjects Property=id_1940 +6 TJclArrayList.Add Method=id_1905 +6 TJclArrayList.AddAll Method=id_1906 +6 TJclArrayList.Clear Method=id_1907 +6 TJclArrayList.Clone Method=id_1908 +6 TJclArrayList.Contains Method=id_1909 +6 TJclArrayList.ContainsAll Method=id_1910 +6 Create Constructor +7 TJclArrayList.Create Constructor (IJclCollection, Boolean)=id_1911 +7 TJclArrayList.Create Constructor (Integer, Boolean)=id_12556 +6 TJclArrayList.Destroy Destructor +7 TJclArrayList.Destroy Destructor=id_1912 +6 TJclArrayList.Equals Method +7 TJclArrayList.Equals Method=id_1913 +6 TJclArrayList.First Method +7 TJclArrayList.First Method=id_1914 +6 TJclArrayList.FreeObject Method +7 TJclArrayList.FreeObject Method=id_1915 +6 TJclArrayList.GetObject Method +7 TJclArrayList.GetObject Method=id_1916 +6 TJclArrayList.Grow Method +7 TJclArrayList.Grow Method=id_1917 +6 TJclArrayList.IndexOf Method +7 TJclArrayList.IndexOf Method=id_1918 +6 TJclArrayList.Insert Method +7 TJclArrayList.Insert Method=id_1919 +6 TJclArrayList.InsertAll Method +7 TJclArrayList.InsertAll Method=id_1920 +6 TJclArrayList.IsEmpty Method +7 TJclArrayList.IsEmpty Method=id_1921 +6 TJclArrayList.Last Method +7 TJclArrayList.Last Method=id_1922 +6 TJclArrayList.LastIndexOf Method +7 TJclArrayList.LastIndexOf Method=id_1923 +6 Remove Method +7 TJclArrayList.Remove Method (Integer)=id_1924 +7 TJclArrayList.Remove Method (TObject)=id_12557 +6 TJclArrayList.RemoveAll Method +7 TJclArrayList.RemoveAll Method=id_1925 +6 TJclArrayList.RetainAll Method +7 TJclArrayList.RetainAll Method=id_1926 +6 TJclArrayList.SetObject Method +7 TJclArrayList.SetObject Method=id_1927 +6 TJclArrayList.Size Method +7 TJclArrayList.Size Method=id_1928 +6 TJclArrayList.SubList Method +7 TJclArrayList.SubList Method=id_1929 +2 Date and Time +3 Date and Time=id_11559 +3 DayOfTheYear Function=id_12561 +3 DecodeDate Function=id_12562 +3 FATDatesEqual Function=id_12563 +3 IsLeapYear Function=id_12564 +3 ISOWeekNumber Function=id_12565 +3 ISOWeekToDateTime Function=id_12566 +3 DayOfTheYearToDateTime Function=id_12567 +3 EasterSunday Function=id_12568 +3 CenturyOfDate Function=id_12569 +3 CenturyBaseYear Function=id_12570 +3 YearOfDate Function=id_12571 +3 MonthOfDate Function=id_12572 +3 DayOfDate Function=id_12573 +3 HourOfTime Function=id_12574 +3 MinuteOfTime Function=id_12575 +3 SecondOfTime Function=id_12576 +3 DaysInMonth Function=id_12577 +3 Make4DigitYear Function=id_12578 +3 MakeYear4Digit Function=id_12579 +3 EncodeDate Function=id_12580 +3 CreationDateTimeOfFile Function=id_12581 +3 LastAccessDateTimeOfFile Function=id_12582 +3 LastWriteDateTimeOfFile Function=id_12583 +3 FormatDateTime Function=id_12584 +3 Conversion +4 Conversion=id_12558 +4 DateTimeToSystemTime Function=id_12604 +4 DosDateTimeToFileTime Function=id_12605 +4 FileTimeToDosDateTime Function=id_12606 +4 FileTimeToSystemTime Function=id_12607 +4 SystemTimeToFileTime Function=id_12608 +4 FileTimeToDateTime Function=id_12609 +4 DosDateTimeToSystemTime Function=id_12610 +4 SystemTimeToDosDateTime Function=id_12611 +4 SystemTimeToStr Function=id_12612 +4 DosDateTimeToDateTime Function=id_12613 +4 DateTimeToDosDateTime Function=id_12614 +4 DateTimeToFileTime Function=id_12589 +4 LocalDateTimeToDateTime Function=id_12615 +4 LocalDateTimeToFileTime Function=id_12616 +4 DateTimeToLocalDateTime Function=id_12617 +4 FileTimeToStr Function=id_12618 +4 DosDateTimeToStr Function=id_12619 +4 TimeOfDateTimeToSeconds Function=id_12620 +4 TimeOfDateTimeToMSecs Function=id_12621 +4 HoursToMSecs Function=id_12622 +4 MinutesToMSecs Function=id_12623 +4 SecondsToMSecs Function=id_12624 +4 DateTimeToUnixTime Function=id_12625 +4 UnixTimeToDateTime Function=id_12627 +4 UnixTimeToFileTime Function=id_12628 +4 FileTimeToUnixTime Function=id_12629 +4 TJclUnixTime32 Type=id_12626 +3 Scheduling +4 Scheduling=id_12559 +4 CreateSchedule Function=id_12656 +4 Types +5 Types=id_12648 +5 TScheduleRecurringKind Enumeration=id_12663 +5 TScheduleEndKind Enumeration=id_12664 +5 TScheduleIndexKind Enumeration=id_12665 +5 ESchedule Class=id_12662 +4 IJclSchedule +5 IJclSchedule=id_12649 +5 IJclSchedule Interface=id_12660 +5 IJclSchedule.DayCount Method=id_12688 +5 IJclSchedule.EndCount Property=id_12678 +5 IJclSchedule.EndDate Property=id_12677 +5 IJclSchedule.EndType Property=id_12679 +5 IJclSchedule.GetEndCount Method=id_12689 +5 IJclSchedule.GetEndDate Method=id_12690 +5 IJclSchedule.GetEndType Method=id_12691 +5 IJclSchedule.GetRecurringType Method=id_12692 +5 IJclSchedule.GetStartDate Method=id_12693 +5 IJclSchedule.InitToSavedState Method=id_12695 +5 IJclSchedule.LastTriggered Method=id_12696 +5 IJclSchedule.NextEvent Method=id_12697 +5 IJclSchedule.NextEventFrom Method=id_12698 +5 IJclSchedule.NextEventFromNow Method=id_12699 +5 IJclSchedule.RecurringType Property=id_12675 +5 IJclSchedule.Reset Method=id_12700 +5 IJclSchedule.SetEndCount Method=id_12701 +5 IJclSchedule.SetEndDate Method=id_12702 +5 IJclSchedule.SetEndType Method=id_12703 +5 IJclSchedule.SetRecurringType Method=id_12704 +5 IJclSchedule.SetStartDate Method=id_12705 +5 IJclSchedule.StartDate Property=id_12694 +5 IJclSchedule.TriggerCount Method=id_12706 +4 IJclScheduleDayFrequency +5 IJclScheduleDayFrequency=id_12650 +5 IJclScheduleDayFrequency Interface +6 IJclScheduleDayFrequency Interface=id_12670 +6 IJclScheduleDayFrequency.GetEndTime Method=id_12735 +6 IJclScheduleDayFrequency.GetInterval Method=id_12736 +6 IJclScheduleDayFrequency.GetStartTime Method=id_12737 +6 IJclScheduleDayFrequency.SetEndTime Method=id_12738 +6 IJclScheduleDayFrequency.SetInterval Method=id_12739 +6 IJclScheduleDayFrequency.SetStartTime Method=id_12740 +5 IJclScheduleDayFrequency.StartTime Property +6 IJclScheduleDayFrequency.StartTime Property=id_12730 +5 IJclScheduleDayFrequency.EndTime Property +6 IJclScheduleDayFrequency.EndTime Property=id_12731 +5 IJclScheduleDayFrequency.Interval Property +6 IJclScheduleDayFrequency.Interval Property=id_12732 +4 IJclDailySchedule +5 IJclDailySchedule=id_12651 +5 IJclDailySchedule Interface +6 IJclDailySchedule Interface=id_12671 +6 IJclDailySchedule.GetEveryWeekDay Method=id_12752 +6 IJclDailySchedule.GetInterval Method=id_12753 +6 IJclDailySchedule.SetEveryWeekDay Method=id_12754 +6 IJclDailySchedule.SetInterval Method=id_12755 +5 IJclDailySchedule.EveryWeekDay Property +6 IJclDailySchedule.EveryWeekDay Property=id_12749 +5 IJclDailySchedule.Interval Property +6 IJclDailySchedule.Interval Property=id_12750 +4 IJclWeeklySchedule +5 IJclWeeklySchedule=id_12652 +5 IJclWeeklySchedule Interface +6 IJclWeeklySchedule Interface=id_12672 +6 IJclWeeklySchedule.GetDaysOfWeek Method=id_12766 +6 IJclWeeklySchedule.GetInterval Method=id_12767 +6 IJclWeeklySchedule.SetDaysOfWeek Method=id_12768 +6 IJclWeeklySchedule.SetInterval Method=id_12769 +5 IJclWeeklySchedule.DaysOfWeek Property +6 IJclWeeklySchedule.DaysOfWeek Property=id_12763 +5 IJclWeeklySchedule.Interval Property +6 IJclWeeklySchedule.Interval Property=id_12764 +4 IJclMonthlySchedule +5 IJclMonthlySchedule=id_12653 +5 IJclMonthlySchedule Interface +6 IJclMonthlySchedule Interface=id_12673 +6 IJclMonthlySchedule.GetDay Method=id_12781 +6 IJclMonthlySchedule.GetIndexKind Method=id_12782 +6 IJclMonthlySchedule.GetIndexValue Method=id_12783 +6 IJclMonthlySchedule.GetInterval Method=id_12784 +6 IJclMonthlySchedule.SetDay Method=id_12785 +6 IJclMonthlySchedule.SetIndexKind Method=id_12786 +6 IJclMonthlySchedule.SetIndexValue Method=id_12787 +6 IJclMonthlySchedule.SetInterval Method=id_12788 +5 IJclMonthlySchedule.Day Property +6 IJclMonthlySchedule.Day Property=id_12777 +5 IJclMonthlySchedule.IndexKind Property +6 IJclMonthlySchedule.IndexKind Property=id_12681 +5 IJclMonthlySchedule.IndexValue Property +6 IJclMonthlySchedule.IndexValue Property=id_12778 +5 IJclMonthlySchedule.Interval Property +6 IJclMonthlySchedule.Interval Property=id_12779 +4 IJclYearlySchedule +5 IJclYearlySchedule=id_12654 +5 IJclYearlySchedule Interface +6 IJclYearlySchedule Interface=id_12674 +6 IJclYearlySchedule.GetDay Method=id_12802 +6 IJclYearlySchedule.GetIndexKind Method=id_12803 +6 IJclYearlySchedule.GetIndexValue Method=id_12804 +6 IJclYearlySchedule.GetInterval Method=id_12805 +6 IJclYearlySchedule.GetMonth Method=id_12806 +6 IJclYearlySchedule.SetDay Method=id_12807 +6 IJclYearlySchedule.SetIndexKind Method=id_12808 +6 IJclYearlySchedule.SetIndexValue Method=id_12809 +6 IJclYearlySchedule.SetInterval Method=id_12810 +6 IJclYearlySchedule.SetMonth Method=id_12811 +5 IJclYearlySchedule.Day Property +6 IJclYearlySchedule.Day Property=id_12797 +5 IJclYearlySchedule.IndexKind Property +6 IJclYearlySchedule.IndexKind Property=id_12682 +5 IJclYearlySchedule.IndexValue Property +6 IJclYearlySchedule.IndexValue Property=id_12798 +5 IJclYearlySchedule.Interval Property +6 IJclYearlySchedule.Interval Property=id_12799 +5 IJclYearlySchedule.Month Property +6 IJclYearlySchedule.Month Property=id_12800 +4 Auxilary routines +5 Auxilary routines=id_12655 +5 NullStamp Function=id_12719 +5 CompareTimeStamps Function=id_12816 +5 EqualTimeStamps Function=id_12817 +5 IsNullTimeStamp Function=id_12818 +3 Timers and Counters +4 Timers and Counters=id_12560 +4 StartCount Function=id_12825 +4 StopCount Function=id_12826 +4 TJclCounter +5 TJclCounter=id_12823 +5 TJclCounter Class +6 TJclCounter Class=id_6359 +6 TJclCounter.Counting Property=id_12837 +6 TJclCounter.ElapsedTime Property=id_12838 +6 TJclCounter.Overhead Property=id_12839 +6 TJclCounter.RunElapsedTime Property=id_12840 +6 TJclCounter.Continue Method=id_12842 +6 TJclCounter.Create Constructor=id_12843 +6 TJclCounter.GetRunElapsedTime Method=id_12844 +6 TJclCounter.Start Method=id_12845 +6 TJclCounter.Stop Method=id_12846 +4 TJclMultimediaTimer +5 TJclMultimediaTimer=id_12824 +5 TJclMultimediaTimer Class +6 TJclMultimediaTimer Class=id_12853 +6 TJclMultimediaTimer.Event Property=id_12865 +6 TJclMultimediaTimer.Kind Property=id_12866 +6 TJclMultimediaTimer.MaxPeriod Property=id_12867 +6 TJclMultimediaTimer.MinPeriod Property=id_12868 +6 TJclMultimediaTimer.Notification Property=id_12869 +6 TJclMultimediaTimer.OnTimer Property=id_12870 +6 TJclMultimediaTimer.Period Property=id_12871 +6 TJclMultimediaTimer.BeginPeriod Method=id_12873 +6 TJclMultimediaTimer.BeginTimer Method=id_12874 +6 TJclMultimediaTimer.Create Constructor=id_12875 +6 TJclMultimediaTimer.Destroy Destructor=id_12876 +6 TJclMultimediaTimer.Elapsed Method=id_12877 +6 TJclMultimediaTimer.EndPeriod Method=id_12878 +6 TJclMultimediaTimer.EndTimer Method=id_12879 +6 TJclMultimediaTimer.GetTime Method=id_12880 +6 TJclMultimediaTimer.Timer Method=id_12854 +6 TJclMultimediaTimer.WaitFor Method=id_12881 +5 TMmTimerKind Enumeration +6 TMmTimerKind Enumeration=id_12855 +5 TMmNotificationKind Enumeration +6 TMmNotificationKind Enumeration=id_12856 +2 Debugging +3 Debugging=id_11560 +3 Diagnostics +4 Diagnostics=id_12887 +4 AssertKindOf Function=id_12896 +4 Trace Function=id_12897 +4 TraceFmt Function=id_12898 +4 TraceLoc Function=id_12899 +4 TraceLocFmt Function=id_12900 +3 Except frame info routines +4 Except frame info routines=id_12888 +4 TJmpInstruction Record=id_12913 +4 TExcDescEntry Record=id_12907 +4 TExcDesc Record=id_12914 +4 TExcFrame Record=id_12915 +4 TExceptFrameKind Enumeration=id_12910 +4 TJclExceptFrame Class +5 TJclExceptFrame Class=id_12908 +5 TJclExceptFrame.ExcFrame Property=id_12928 +5 TJclExceptFrame.FrameKind Property=id_12929 +5 TJclExceptFrame.CodeLocation Method=id_12931 +5 TJclExceptFrame.Create Constructor=id_12932 +5 TJclExceptFrame.DoDetermineFrameKind Method=id_12933 +5 TJclExceptFrame.HandlerInfo Method=id_12934 +5 TJclExceptFrame.Handles Method=id_12935 +4 TJclExceptFrameList Class +5 TJclExceptFrameList Class=id_12909 +5 TJclExceptFrameList.IgnoreLevels Property=id_12946 +5 TJclExceptFrameList.Items Property=id_12947 +5 TJclExceptFrameList.AddFrame Method=id_12950 +5 TJclExceptFrameList.Create Constructor=id_12951 +5 TJclExceptFrameList.TraceExceptionFrames Method=id_12952 +4 JclCreateExceptFrameList Function +5 JclCreateExceptFrameList Function=id_12911 +4 JclLastExceptFrameList Function +5 JclLastExceptFrameList Function=id_12912 +3 Exception hooking +4 Exception hooking=id_12889 +4 TJclExceptNotifyProc Type=id_6619 +4 TJclExceptNotifyMethod Type=id_6616 +4 JclHookExceptions Function=id_12961 +4 JclUnhookExceptions Function=id_12962 +4 JclExceptionsHooked Function=id_12963 +4 ExceptNotifyProc=id_12956 +4 ExceptNotifyMethod=id_12957 +4 StackTrackingEnable=id_12958 +4 RawStackTracking=id_12959 +4 ExceptionFrameTrackingEnable=id_12955 +4 TrackAllModules=id_12960 +3 Helpers +4 Helpers=id_12890 +4 InsertDebugDataIntoExecutableFile Function=id_12977 +3 Miscellanuous +4 Miscellanuous=id_12891 +4 IsHandleValid Function=id_12980 +4 IsDebuggerAttached Function=id_12981 +4 EnableCrashOnCtrlScroll Function=id_12982 +3 Source Locations +4 Source Locations=id_12892 +4 GetLocationInfo Function=id_12991 +4 TJclLocationInfo Record=id_4163 +4 TJclDebugInfoSource Class +5 TJclDebugInfoSource Class=id_4149 +5 TJclDebugInfoSource.FileName Property=id_4151 +5 TJclDebugInfoSource.Module Property=id_4152 +5 TJclDebugInfoSource.Create Constructor=id_4154 +5 TJclDebugInfoSource.GetLocationInfo Method=id_4155 +5 TJclDebugInfoSource.InitializeSource Method=id_4156 +5 TJclDebugInfoSource.VAFromAddr Method=id_4157 +4 TJclDebugInfoList Class +5 TJclDebugInfoList Class=id_12987 +5 TJclDebugInfoList.ItemFromModule Property=id_13037 +5 TJclDebugInfoList.Items Property=id_13035 +5 TJclDebugInfoList.CreateDebugInfo Method=id_13039 +5 TJclDebugInfoList.GetLocationInfo Method=id_13040 +4 DebugInfoAvailable Function +5 DebugInfoAvailable Function=id_12992 +4 TJclDebugInfoMap Class +5 TJclDebugInfoMap Class=id_12988 +5 TJclDebugInfoMap.Destroy Destructor=id_13049 +5 TJclDebugInfoMap.GetLocationInfo Method=id_13050 +5 TJclDebugInfoMap.InitializeSource Method=id_13051 +4 TJclDebugInfoBinary Class +5 TJclDebugInfoBinary Class=id_12989 +5 TJclDebugInfoBinary.Destroy Destructor=id_13060 +5 TJclDebugInfoBinary.GetLocationInfo Method=id_13061 +5 TJclDebugInfoBinary.InitializeSource Method=id_13062 +4 TJclDebugInfoExports Class +5 TJclDebugInfoExports Class=id_12990 +5 TJclDebugInfoExports.Destroy Destructor=id_13070 +5 TJclDebugInfoExports.GetLocationInfo Method=id_13071 +5 TJclDebugInfoExports.InitializeSource Method=id_13072 +4 ModuleFromAddr Function +5 ModuleFromAddr Function=id_12993 +4 IsSystemModule Function +5 IsSystemModule Function=id_12994 +4 Caller Function +5 Caller Function=id_12995 +4 GetLocationInfoStr Function +5 GetLocationInfoStr Function=id_12996 +4 ClearLocationData Function +5 ClearLocationData Function=id_12997 +4 __FILE__ Function +5 __FILE__ Function=id_12998 +4 __MODULE__ Function +5 __MODULE__ Function=id_12999 +4 __PROC__ Function +5 __PROC__ Function=id_13000 +4 __LINE__ Function +5 __LINE__ Function=id_13001 +4 __MAP__ Function +5 __MAP__ Function=id_13002 +4 __FILE_OF_ADDR__ Function +5 __FILE_OF_ADDR__ Function=id_13003 +4 __MODULE_OF_ADDR__ Function +5 __MODULE_OF_ADDR__ Function=id_13004 +4 __PROC_OF_ADDR__ Function +5 __PROC_OF_ADDR__ Function=id_13005 +4 __LINE_OF_ADDR__ Function +5 __LINE_OF_ADDR__ Function=id_13006 +4 __MAP_OF_ADDR__ Function +5 __MAP_OF_ADDR__ Function=id_13007 +4 FileByLevel Function +5 FileByLevel Function=id_13008 +4 ModuleByLevel Function +5 ModuleByLevel Function=id_13009 +4 ProcByLevel Function +5 ProcByLevel Function=id_13010 +4 LineByLevel Function +5 LineByLevel Function=id_13011 +4 MapByLevel Function +5 MapByLevel Function=id_13012 +4 FileOfAddr Function +5 FileOfAddr Function=id_13013 +4 ModuleOfAddr Function +5 ModuleOfAddr Function=id_13014 +4 ProcOfAddr Function +5 ProcOfAddr Function=id_13015 +4 LineOfAddr Function +5 LineOfAddr Function=id_13016 +4 MapOfAddr Function +5 MapOfAddr Function=id_13017 +4 ExtractClassName Function +5 ExtractClassName Function=id_13018 +4 ExtractMethodName Function +5 ExtractMethodName Function=id_13019 +4 Binary Debug Data +5 Binary Debug Data=id_12985 +5 ConvertMapFileToJdbgFile Function=id_13098 +5 JclDbgDataSignature Constant=id_13095 +5 JclDbgDataResName Constant=id_13096 +5 JclDbgFileExtension Constant=id_13097 +5 TJclBinDebugGenerator Class +6 TJclBinDebugGenerator Class=id_12979 +6 TJclBinDebugGenerator.DataStream Property=id_13114 +6 TJclBinDebugGenerator.CalculateCheckSum Method=id_13141 +6 TJclBinDebugGenerator.Create Constructor=id_13142 +6 TJclBinDebugGenerator.CreateData Method=id_13143 +6 TJclBinDebugGenerator.Destroy Destructor=id_13144 +5 TJclBinDebugScanner Class +6 TJclBinDebugScanner Class=id_13057 +6 TJclBinDebugScanner.ModuleName Property=id_13151 +6 TJclBinDebugScanner.ValidFormat Property=id_13152 +6 TJclBinDebugScanner.CacheLineNumbers Method=id_13154 +6 TJclBinDebugScanner.CacheProcNames Method=id_13155 +6 TJclBinDebugScanner.CheckFormat Method=id_13156 +6 TJclBinDebugScanner.Create Constructor=id_13157 +6 TJclBinDebugScanner.DataToStr Method=id_13158 +6 TJclBinDebugScanner.IsModuleNameValid Method=id_13159 +6 LineNumberFromAddr Method +7 TJclBinDebugScanner.LineNumberFromAddr Method (DWORD)=id_13160 +6 TJclBinDebugScanner.MakePtr Method +7 TJclBinDebugScanner.MakePtr Method=id_13161 +6 TJclBinDebugScanner.ModuleNameFromAddr Method +7 TJclBinDebugScanner.ModuleNameFromAddr Method=id_13162 +6 TJclBinDebugScanner.ModuleStartFromAddr Method +7 TJclBinDebugScanner.ModuleStartFromAddr Method=id_13163 +6 ProcNameFromAddr Method +7 TJclBinDebugScanner.ProcNameFromAddr Method (DWORD)=id_13164 +6 TJclBinDebugScanner.ReadValue Method +7 TJclBinDebugScanner.ReadValue Method=id_13165 +6 TJclBinDebugScanner.SourceNameFromAddr Method +7 TJclBinDebugScanner.SourceNameFromAddr Method=id_13166 +4 Map Parsers +5 Map Parsers=id_12986 +5 TJclMapAddress Record=id_7431 +5 PJclMapString Type=id_7142 +5 TJclAbstractMapParser Class +6 TJclAbstractMapParser Class=id_13118 +6 TJclAbstractMapParser.FLastUnitFileName Field=id_13105 +6 TJclAbstractMapParser.FLastUnitName Field=id_13106 +6 TJclAbstractMapParser.LinkerBug Property=id_13110 +6 TJclAbstractMapParser.LinkerBugUnitName Property=id_13111 +6 TJclAbstractMapParser.Stream Property=id_13112 +6 TJclAbstractMapParser.ClassTableItem Method=id_13116 +6 TJclAbstractMapParser.Create Constructor=id_13117 +6 TJclAbstractMapParser.Destroy Destructor=id_13119 +6 TJclAbstractMapParser.LineNumbersItem Method=id_13120 +6 TJclAbstractMapParser.LineNumberUnitItem Method=id_13121 +6 TJclAbstractMapParser.MapStringToFileName Method=id_13122 +6 TJclAbstractMapParser.MapStringToStr Method=id_13123 +6 TJclAbstractMapParser.Parse Method=id_13124 +6 TJclAbstractMapParser.PublicsByNameItem Method=id_13125 +6 TJclAbstractMapParser.PublicsByValueItem Method=id_13126 +6 TJclAbstractMapParser.SegmentItem Method=id_13127 +5 TJclMapParser Class +6 TJclMapParser Class=id_13175 +6 TJclMapParser.OnClassTable Event=id_13195 +6 TJclMapParser.OnLineNumbers Event=id_13196 +6 TJclMapParser.OnLineNumberUnit Event=id_13197 +6 TJclMapParser.OnPublicsByName Event=id_13198 +6 TJclMapParser.OnPublicsByValue Event=id_13199 +6 TJclMapParser.OnSegment Event=id_13200 +6 TJclMapParser.ClassTableItem Method=id_13205 +6 TJclMapParser.LineNumbersItem Method=id_13206 +6 TJclMapParser.LineNumberUnitItem Method=id_13207 +6 TJclMapParser.PublicsByNameItem Method=id_13208 +6 TJclMapParser.PublicsByValueItem Method=id_13209 +6 TJclMapParser.SegmentItem Method=id_13210 +5 TJclMapScanner Class +6 TJclMapScanner Class=id_13046 +6 TJclMapScanner.LineNumberErrors Property=id_13113 +6 TJclMapScanner.ClassTableItem Method=id_13128 +6 TJclMapScanner.Create Constructor=id_13129 +6 LineNumberFromAddr Method +7 TJclMapScanner.LineNumberFromAddr Method (DWORD)=id_13130 +6 TJclMapScanner.LineNumbersItem Method +7 TJclMapScanner.LineNumbersItem Method=id_13131 +6 TJclMapScanner.LineNumberUnitItem Method +7 TJclMapScanner.LineNumberUnitItem Method=id_13132 +6 TJclMapScanner.ModuleNameFromAddr Method +7 TJclMapScanner.ModuleNameFromAddr Method=id_13133 +6 TJclMapScanner.ModuleStartFromAddr Method +7 TJclMapScanner.ModuleStartFromAddr Method=id_13134 +6 ProcNameFromAddr Method +7 TJclMapScanner.ProcNameFromAddr Method (DWORD)=id_13135 +6 TJclMapScanner.PublicsByNameItem Method +7 TJclMapScanner.PublicsByNameItem Method=id_13136 +6 TJclMapScanner.PublicsByValueItem Method +7 TJclMapScanner.PublicsByValueItem Method=id_13137 +6 TJclMapScanner.Scan Method +7 TJclMapScanner.Scan Method=id_13138 +6 TJclMapScanner.SegmentItem Method +7 TJclMapScanner.SegmentItem Method=id_13139 +6 TJclMapScanner.SourceNameFromAddr Method +7 TJclMapScanner.SourceNameFromAddr Method=id_13140 +3 Stack info routines +4 Stack info routines=id_12893 +4 TStackFrame Record=id_13232 +4 TStackInfo Record=id_7509 +4 TJclStackInfoItem Class +5 TJclStackInfoItem Class=id_13228 +5 TJclStackInfoItem.CallerAdr Property=id_13241 +5 TJclStackInfoItem.LogicalAddress Property=id_13242 +5 TJclStackInfoItem.StackInfo Property=id_13243 +4 TJclStackInfoList Class +5 TJclStackInfoList Class=id_13229 +5 TJclStackInfoList.IgnoreLevels Property=id_13250 +5 TJclStackInfoList.Items Property=id_13251 +5 TJclStackInfoList.AddToStrings Method=id_13253 +5 TJclStackInfoList.Create Constructor=id_13254 +5 TJclStackInfoList.Destroy Destructor=id_13255 +4 JclCreateStackList Function +5 JclCreateStackList Function=id_13230 +4 JclLastExceptStackList Function +5 JclLastExceptStackList Function=id_13231 +3 Tracking routines +4 Tracking routines=id_12894 +4 TJclStackBaseList Class +5 TJclStackBaseList Class=id_12942 +5 TJclStackBaseList.ThreadID Property=id_12944 +5 TJclStackBaseList.TimeStamp Property=id_12945 +5 TJclStackBaseList.Create Constructor=id_12949 +2 Electronic Data Interchange (EDI) +3 Electronic Data Interchange (EDI)=id_11561 +2 Expression Evaluation +3 Expression Evaluation=id_11562 +3 cExprEvalHashSize Constant=id_13317 +3 EJclExprEvalError Class=id_13267 +3 ExprWhiteSpace Constant=id_13318 +3 TFloat Type=id_13282 +3 TFloat32 Type=id_13284 +3 TFloat64 Type=id_13286 +3 TFloat80 Type=id_13288 +3 TFloatFunc Type=id_13294 +3 TUnaryFunc Type=id_13299 +3 TBinaryFunc Type=id_13304 +3 TTernaryFunc Type=id_13309 +3 TExprContext Class +4 TExprContext Class=id_13268 +4 TExprContext.Find Method=id_13329 +3 TExprHashContext Class +4 TExprHashContext Class=id_13269 +4 TExprHashContext.Add Method=id_13335 +4 TExprHashContext.Create Constructor=id_13333 +4 TExprHashContext.Destroy Destructor=id_13336 +4 TExprHashContext.Find Method=id_13337 +4 TExprHashContext.Remove Method=id_13338 +3 TExprSetContext Class +4 TExprSetContext Class=id_13270 +4 TExprSetContext.Contexts Property=id_13354 +4 TExprSetContext.Count Property=id_13355 +4 TExprSetContext.InternalList Property=id_13356 +4 TExprSetContext.Add Method=id_13346 +4 TExprSetContext.Create Constructor=id_13347 +4 TExprSetContext.Delete Method=id_13348 +4 TExprSetContext.Destroy Destructor=id_13349 +4 TExprSetContext.Extract Method=id_13350 +4 TExprSetContext.Find Method=id_13351 +4 TExprSetContext.Remove Method=id_13352 +3 TExprSym Class +4 TExprSym Class=id_13271 +4 TExprSym.CompileParser Property=id_13366 +4 TExprSym.EvalParser Property=id_13365 +4 TExprSym.Ident Property=id_13369 +4 TExprSym.Lexer Property=id_13364 +4 TExprSym.NodeFactory Property=id_13367 +4 TExprSym.Compile Method=id_13363 +4 TExprSym.Create Constructor=id_13371 +4 TExprSym.Evaluate Method=id_13362 +3 TExprToken Enumeration +4 TExprToken Enumeration=id_13319 +3 TExprLexer Class +4 TExprLexer Class=id_13272 +4 TExprLexer.FCurrTok Field=id_13387 +4 TExprLexer.FTokenAsNumber Field=id_13388 +4 TExprLexer.FTokenAsString Field=id_13389 +4 TExprLexer.CurrTok Property=id_13383 +4 TExprLexer.TokenAsNumber Property=id_13385 +4 TExprLexer.TokenAsString Property=id_13384 +4 TExprLexer.Create Constructor=id_13394 +4 TExprLexer.NextTok Method=id_13386 +4 TExprLexer.Reset Method=id_13395 +3 TExprNode Class +4 TExprNode Class=id_13273 +4 TExprNode.DepCount Property=id_13405 +4 TExprNode.DepList Property=id_13406 +4 TExprNode.Deps Property=id_13407 +4 TExprNode.AddDep Method=id_13409 +4 TExprNode.Create Constructor=id_13410 +4 TExprNode.Destroy Destructor=id_13411 +3 TExprNodeFactory Class +4 TExprNodeFactory Class=id_13274 +4 TExprNodeFactory.Add Method=id_13415 +4 TExprNodeFactory.CallBinary32Func Method=id_13417 +4 TExprNodeFactory.CallBinary64Func Method=id_13418 +4 TExprNodeFactory.CallBinary80Func Method=id_13419 +4 TExprNodeFactory.CallBinaryFunc Method=id_13420 +4 TExprNodeFactory.CallFloat32Func Method=id_13421 +4 TExprNodeFactory.CallFloat64Func Method=id_13422 +4 TExprNodeFactory.CallFloat80Func Method=id_13423 +4 TExprNodeFactory.CallFloatFunc Method=id_13424 +4 TExprNodeFactory.CallTernary32Func Method=id_13425 +4 TExprNodeFactory.CallTernary64Func Method=id_13426 +4 TExprNodeFactory.CallTernary80Func Method=id_13427 +4 TExprNodeFactory.CallTernaryFunc Method=id_13428 +4 TExprNodeFactory.CallUnary32Func Method=id_13429 +4 TExprNodeFactory.CallUnary64Func Method=id_13430 +4 TExprNodeFactory.CallUnary80Func Method=id_13431 +4 TExprNodeFactory.CallUnaryFunc Method=id_13432 +4 TExprNodeFactory.Compare Method=id_13433 +4 TExprNodeFactory.Divide Method=id_13434 +4 LoadConst Method +4 TExprNodeFactory.LoadConst32 Method=id_13436 +4 TExprNodeFactory.LoadConst64 Method=id_13437 +4 TExprNodeFactory.LoadConst80 Method=id_13438 +4 LoadVar Method +5 TExprNodeFactory.LoadVar Method (PFloat32)=id_13435 +4 TExprNodeFactory.LoadVar32 Method +5 TExprNodeFactory.LoadVar32 Method=id_13439 +4 TExprNodeFactory.LoadVar64 Method +5 TExprNodeFactory.LoadVar64 Method=id_13440 +4 TExprNodeFactory.LoadVar80 Method +5 TExprNodeFactory.LoadVar80 Method=id_13441 +4 TExprNodeFactory.Multiply Method +5 TExprNodeFactory.Multiply Method=id_13442 +4 TExprNodeFactory.Negate Method +5 TExprNodeFactory.Negate Method=id_13443 +4 TExprNodeFactory.Subtract Method +5 TExprNodeFactory.Subtract Method=id_13416 +3 TExprCompileParser Class +4 TExprCompileParser Class=id_13275 +4 TExprCompileParser.Context Property=id_13452 +4 TExprCompileParser.Lexer Property=id_13453 +4 TExprCompileParser.NodeFactory Property=id_13454 +4 TExprCompileParser.Compile Method=id_13450 +4 TExprCompileParser.CompileExpr Method=id_13456 +4 TExprCompileParser.CompileFactor Method=id_13458 +4 TExprCompileParser.CompileIdentFactor Method=id_13459 +4 TExprCompileParser.CompileSignedFactor Method=id_13460 +4 TExprCompileParser.CompileSimpleExpr Method=id_13457 +4 TExprCompileParser.CompileTerm Method=id_13461 +4 TExprCompileParser.Create Constructor=id_13449 +3 TExprEvalParser Class +4 TExprEvalParser Class=id_13276 +4 TExprEvalParser.Context Property=id_13469 +4 TExprEvalParser.Lexer Property=id_13470 +4 TExprEvalParser.Create Constructor=id_13472 +4 TExprEvalParser.EvalExpr Method=id_13473 +4 TExprEvalParser.EvalFactor Method=id_13475 +4 TExprEvalParser.EvalIdentFactor Method=id_13476 +4 TExprEvalParser.EvalSignedFactor Method=id_13477 +4 TExprEvalParser.EvalSimpleExpr Method=id_13474 +4 TExprEvalParser.EvalTerm Method=id_13478 +4 TExprEvalParser.Evaluate Method=id_13479 +3 TExprSimpleLexer Class +4 TExprSimpleLexer Class=id_13277 +4 TExprSimpleLexer.FBuf Field=id_13485 +4 TExprSimpleLexer.FCurrPos Field=id_13486 +4 TExprSimpleLexer.Buf Property=id_13490 +4 TExprSimpleLexer.Create Constructor=id_13492 +4 TExprSimpleLexer.NextTok Method=id_13493 +4 TExprSimpleLexer.Reset Method=id_13494 +4 TExprSimpleLexer.SetBuf Method=id_13495 +3 TExprVirtMachOp Class +4 TExprVirtMachOp Class=id_13278 +4 TExprVirtMachOp.FOutput Field=id_13503 +4 TExprVirtMachOp.OutputLoc Property=id_13507 +4 TExprVirtMachOp.Execute Method=id_13502 +3 TExprVirtMach Class +4 TExprVirtMach Class=id_13279 +4 TExprVirtMach.Add Method=id_13516 +4 TExprVirtMach.AddConst Method=id_13517 +4 TExprVirtMach.Clear Method=id_13518 +4 TExprVirtMach.Create Constructor=id_13519 +4 TExprVirtMach.Destroy Destructor=id_13520 +4 TExprVirtMach.Execute Method=id_13521 +3 TExprVirtMachNodeFactory Class +4 TExprVirtMachNodeFactory Class=id_13280 +4 TExprVirtMachNodeFactory.Add Method=id_13528 +4 TExprVirtMachNodeFactory.CallFloatFunc Method=id_13529 +4 TExprVirtMachNodeFactory.Compare Method=id_13530 +4 TExprVirtMachNodeFactory.Create Constructor=id_13531 +4 TExprVirtMachNodeFactory.Destroy Destructor=id_13532 +4 TExprVirtMachNodeFactory.GenCode Method=id_13533 +4 TExprVirtMachNodeFactory.LoadConst32 Method=id_13534 +4 TExprVirtMachNodeFactory.LoadVar32 Method=id_13535 +3 TExprConstSym Class +4 TExprConstSym Class=id_13281 +4 TExprConstSym.Compile Method=id_13543 +4 TExprConstSym.Create Constructor=id_13544 +4 TExprConstSym.Evaluate Method=id_13545 +3 TExprConst32Sym Class +4 TExprConst32Sym Class=id_13283 +4 TExprConst32Sym.Compile Method=id_13555 +4 TExprConst32Sym.Create Constructor=id_13556 +4 TExprConst32Sym.Evaluate Method=id_13557 +3 TExprConst64Sym Class +4 TExprConst64Sym Class=id_13285 +4 TExprConst64Sym.Compile Method=id_13567 +4 TExprConst64Sym.Create Constructor=id_13568 +4 TExprConst64Sym.Evaluate Method=id_13569 +3 TExprConst80Sym Class +4 TExprConst80Sym Class=id_13287 +4 TExprConst80Sym.Compile Method=id_13579 +4 TExprConst80Sym.Create Constructor=id_13580 +4 TExprConst80Sym.Evaluate Method=id_13581 +3 TExprVar32Sym Class +4 TExprVar32Sym Class=id_13289 +4 TExprVar32Sym.Compile Method=id_13591 +4 TExprVar32Sym.Create Constructor=id_13592 +4 TExprVar32Sym.Evaluate Method=id_13593 +3 TExprVar64Sym Class +4 TExprVar64Sym Class=id_13290 +4 TExprVar64Sym.Compile Method=id_13603 +4 TExprVar64Sym.Create Constructor=id_13604 +4 TExprVar64Sym.Evaluate Method=id_13605 +3 TExprVar80Sym Class +4 TExprVar80Sym Class=id_13291 +4 TExprVar80Sym.Compile Method=id_13615 +4 TExprVar80Sym.Create Constructor=id_13616 +4 TExprVar80Sym.Evaluate Method=id_13617 +3 TExprAbstractFuncSym Class +4 TExprAbstractFuncSym Class=id_13292 +4 TExprAbstractFuncSym.CompileFirstArg Method=id_13627 +4 TExprAbstractFuncSym.CompileNextArg Method=id_13628 +4 TExprAbstractFuncSym.EndArgs Method=id_13629 +4 TExprAbstractFuncSym.EvalFirstArg Method=id_13630 +4 TExprAbstractFuncSym.EvalNextArg Method=id_13631 +3 TExprFuncSym Class +4 TExprFuncSym Class=id_13293 +4 TExprFuncSym.Compile Method=id_13639 +4 TExprFuncSym.Create Constructor=id_13640 +4 TExprFuncSym.Evaluate Method=id_13641 +3 TExprFloat32FuncSym Class +4 TExprFloat32FuncSym Class=id_13295 +4 TExprFloat32FuncSym.Compile Method=id_13651 +4 TExprFloat32FuncSym.Create Constructor=id_13652 +4 TExprFloat32FuncSym.Evaluate Method=id_13653 +3 TExprFloat64FuncSym Class +4 TExprFloat64FuncSym Class=id_13296 +4 TExprFloat64FuncSym.Compile Method=id_13663 +4 TExprFloat64FuncSym.Create Constructor=id_13664 +4 TExprFloat64FuncSym.Evaluate Method=id_13665 +3 TExprFloat80FuncSym Class +4 TExprFloat80FuncSym Class=id_13297 +4 TExprFloat80FuncSym.Compile Method=id_13675 +4 TExprFloat80FuncSym.Create Constructor=id_13676 +4 TExprFloat80FuncSym.Evaluate Method=id_13677 +3 TExprUnaryFuncSym Class +4 TExprUnaryFuncSym Class=id_13298 +4 TExprUnaryFuncSym.Compile Method=id_13687 +4 TExprUnaryFuncSym.Create Constructor=id_13688 +4 TExprUnaryFuncSym.Evaluate Method=id_13689 +3 TExprUnary32FuncSym Class +4 TExprUnary32FuncSym Class=id_13300 +4 TExprUnary32FuncSym.Compile Method=id_13699 +4 TExprUnary32FuncSym.Create Constructor=id_13700 +4 TExprUnary32FuncSym.Evaluate Method=id_13701 +3 TExprUnary64FuncSym Class +4 TExprUnary64FuncSym Class=id_13301 +4 TExprUnary64FuncSym.Compile Method=id_13711 +4 TExprUnary64FuncSym.Create Constructor=id_13712 +4 TExprUnary64FuncSym.Evaluate Method=id_13713 +3 TExprUnary80FuncSym Class +4 TExprUnary80FuncSym Class=id_13302 +4 TExprUnary80FuncSym.Compile Method=id_13723 +4 TExprUnary80FuncSym.Create Constructor=id_13724 +4 TExprUnary80FuncSym.Evaluate Method=id_13725 +3 TExprBinaryFuncSym Class +4 TExprBinaryFuncSym Class=id_13303 +4 TExprBinaryFuncSym.Compile Method=id_13735 +4 TExprBinaryFuncSym.Create Constructor=id_13736 +4 TExprBinaryFuncSym.Evaluate Method=id_13737 +3 TExprBinary32FuncSym Class +4 TExprBinary32FuncSym Class=id_13305 +4 TExprBinary32FuncSym.Compile Method=id_13747 +4 TExprBinary32FuncSym.Create Constructor=id_13748 +4 TExprBinary32FuncSym.Evaluate Method=id_13749 +3 TExprBinary64FuncSym Class +4 TExprBinary64FuncSym Class=id_13306 +4 TExprBinary64FuncSym.Compile Method=id_13759 +4 TExprBinary64FuncSym.Create Constructor=id_13760 +4 TExprBinary64FuncSym.Evaluate Method=id_13761 +3 TExprBinary80FuncSym Class +4 TExprBinary80FuncSym Class=id_13307 +4 TExprBinary80FuncSym.Compile Method=id_13771 +4 TExprBinary80FuncSym.Create Constructor=id_13772 +4 TExprBinary80FuncSym.Evaluate Method=id_13773 +3 TExprTernaryFuncSym Class +4 TExprTernaryFuncSym Class=id_13308 +4 TExprTernaryFuncSym.Compile Method=id_13783 +4 TExprTernaryFuncSym.Create Constructor=id_13784 +4 TExprTernaryFuncSym.Evaluate Method=id_13785 +3 TExprTernary32FuncSym Class +4 TExprTernary32FuncSym Class=id_13310 +4 TExprTernary32FuncSym.Compile Method=id_13795 +4 TExprTernary32FuncSym.Create Constructor=id_13796 +4 TExprTernary32FuncSym.Evaluate Method=id_13797 +3 TExprTernary64FuncSym Class +4 TExprTernary64FuncSym Class=id_13311 +4 TExprTernary64FuncSym.Compile Method=id_13807 +4 TExprTernary64FuncSym.Create Constructor=id_13808 +4 TExprTernary64FuncSym.Evaluate Method=id_13809 +3 TExprTernary80FuncSym Class +4 TExprTernary80FuncSym Class=id_13312 +4 TExprTernary80FuncSym.Compile Method=id_13819 +4 TExprTernary80FuncSym.Create Constructor=id_13820 +4 TExprTernary80FuncSym.Evaluate Method=id_13821 +3 TEasyEvaluator Class +4 TEasyEvaluator Class=id_13313 +4 TEasyEvaluator.ExtContextSet Property=id_13830 +4 TEasyEvaluator.InternalContextSet Property=id_13831 +4 AddConst Method +5 TEasyEvaluator.AddConst Method (string, TFloat32)=id_13833 +4 AddFunc Method +5 TEasyEvaluator.AddFunc Method (string, TFloat32Func)=id_13834 +4 AddVar Method +5 TEasyEvaluator.AddVar Method (string, TFloat32)=id_13835 +4 TEasyEvaluator.Clear Method +5 TEasyEvaluator.Clear Method=id_13836 +4 TEasyEvaluator.Create Constructor +5 TEasyEvaluator.Create Constructor=id_13837 +4 TEasyEvaluator.Destroy Destructor +5 TEasyEvaluator.Destroy Destructor=id_13838 +4 TEasyEvaluator.Remove Method +5 TEasyEvaluator.Remove Method=id_13839 +3 TEvaluator Class +4 TEvaluator Class=id_13314 +4 TEvaluator.Create Constructor=id_13848 +4 TEvaluator.Destroy Destructor=id_13849 +4 TEvaluator.Evaluate Method=id_13850 +3 TCompiledEvaluator Class +4 TCompiledEvaluator Class=id_13315 +4 TCompiledEvaluator.Compile Method=id_13856 +4 TCompiledEvaluator.Create Constructor=id_13860 +4 TCompiledEvaluator.Destroy Destructor=id_13861 +4 TCompiledEvaluator.Evaluate Method=id_13857 +3 TCompiledExpression Type +4 TCompiledExpression Type=id_13320 +3 TExpressionCompiler Class +4 TExpressionCompiler Class=id_13316 +4 TExpressionCompiler.Clear Method=id_13870 +4 TExpressionCompiler.Compile Method=id_13867 +4 TExpressionCompiler.Create Constructor=id_13871 +4 TExpressionCompiler.Delete Method=id_13872 +4 TExpressionCompiler.Destroy Destructor=id_13873 +4 TExpressionCompiler.Remove Method=id_13874 +2 Files and IO +3 Files and IO=id_11563 +3 Files and Directories +4 Files and Directories=id_13877 +4 GetFileCreation Function=id_11314 +4 GetFileInformation Function=id_11315 +4 GetFileLastAccess Function=id_11316 +4 GetFileLastWrite Function=id_11317 +4 GetSizeOfFile Function=id_11319 +4 FileGetTypeName Function=id_11303 +4 FindUnusedFileName Function=id_11307 +4 ForceDirectories Function=id_11308 +4 FileGetDisplayName Function=id_11298 +4 FileGetOwnerName Function=id_11300 +4 FileGetGroupName Function=id_11299 +4 GetModulePath Function=id_11318 +4 FileGetTempName Function=id_11302 +4 FileCreateTemp Function=id_11295 +4 FileBackup Function=id_11293 +4 FileCopy Function=id_11294 +4 FileDelete Function=id_11296 +4 FileExists Function=id_11297 +4 FileMove Function=id_11304 +4 FileRestore Function=id_11305 +4 ShredFile Function=id_11354 +4 FileGetSize Function=id_11301 +4 GetFileAttributeListEx Function=id_11313 +4 GetFileAttributeList Function=id_11312 +4 GetDirectorySize Function=id_11309 +4 GetDriveTypeStr Function=id_11310 +4 SetFileLastWrite Function=id_11353 +4 SetFileLastAccess Function=id_11352 +4 SetFileCreation Function=id_11351 +4 SetDirLastWrite Function=id_11350 +4 SetDirLastAccess Function=id_11349 +4 SetDirCreation Function=id_11348 +4 IsDirectory Function=id_11321 +4 LockVolume Function=id_11324 +4 OpenVolume Function=id_11325 +4 CloseVolume Function=id_11282 +4 CreateEmptyFile Function=id_11283 +4 GetStandardFileInfo Function=id_11320 +4 GetFileAgeCoherence Function=id_11311 +4 BuildFileList Function=id_11281 +4 AdvBuildFileList Function=id_11280 +4 TFileListOptions Type=id_11363 +4 TDelTreeProgress Type=id_11361 +4 DelTree Function=id_11286 +4 DelTreeEx Function=id_11287 +4 DirectoryExists Function=id_11288 +4 DiskInDrive Function=id_11289 +4 DeleteDirectory Function=id_11285 +4 UnlockVolume Function=id_11356 +4 CreateSymbolicLink Function=id_11284 +4 SymbolicLinkTarget Function=id_11355 +4 FileAttributesStr Function=id_11292 +4 File Search +5 File Search=id_13882 +5 TFileSearchOptions Type=id_11364 +5 TAttributeInterest Enumeration=id_11279 +5 VerifyFileAttributeMask Function=id_11357 +5 IsFileAttributeMatch Function=id_11322 +5 IsFileNameMatch Function=id_11323 +5 EnumFiles Function=id_11291 +5 EnumDirectories Function=id_11290 +5 TJclCustomFileAttrMask Class +6 TJclCustomFileAttrMask Class=id_11266 +6 TJclCustomFileAttrMask.Archive Property=id_13925 +6 TJclCustomFileAttrMask.Attribute Property=id_13926 +6 TJclCustomFileAttrMask.Compressed Property=id_13927 +6 TJclCustomFileAttrMask.Directory Property=id_13928 +6 TJclCustomFileAttrMask.Encrypted Property=id_13929 +6 TJclCustomFileAttrMask.Hidden Property=id_13930 +6 TJclCustomFileAttrMask.Normal Property=id_13931 +6 TJclCustomFileAttrMask.NotContentIndexed Property=id_13932 +6 TJclCustomFileAttrMask.OffLine Property=id_13933 +6 TJclCustomFileAttrMask.ReadOnly Property=id_13934 +6 TJclCustomFileAttrMask.Rejected Property=id_13935 +6 TJclCustomFileAttrMask.ReparsePoint Property=id_13936 +6 TJclCustomFileAttrMask.Required Property=id_13937 +6 TJclCustomFileAttrMask.SparseFile Property=id_13938 +6 TJclCustomFileAttrMask.SymLink Property=id_13939 +6 TJclCustomFileAttrMask.System Property=id_13940 +6 TJclCustomFileAttrMask.Temporary Property=id_13941 +6 TJclCustomFileAttrMask.VolumeID Property=id_13942 +6 TJclCustomFileAttrMask.Assign Method=id_13944 +6 TJclCustomFileAttrMask.Clear Method=id_13945 +6 TJclCustomFileAttrMask.Create Constructor=id_13946 +6 TJclCustomFileAttrMask.DefineProperties Method=id_13947 +6 Match Method +7 TJclCustomFileAttrMask.Match Method (Integer)=id_13948 +7 TJclCustomFileAttrMask.Match Method (TSearchRec)=id_13951 +5 TJclFileAttributeMask Class +6 TJclFileAttributeMask Class=id_11268 +6 TJclFileAttributeMask.Archive Property=id_13956 +6 TJclFileAttributeMask.Compressed Property=id_13957 +6 TJclFileAttributeMask.Directory Property=id_13958 +6 TJclFileAttributeMask.Encrypted Property=id_13959 +6 TJclFileAttributeMask.Hidden Property=id_13960 +6 TJclFileAttributeMask.Normal Property=id_13961 +6 TJclFileAttributeMask.NotContentIndexed Property=id_13962 +6 TJclFileAttributeMask.OffLine Property=id_13963 +6 TJclFileAttributeMask.ReadOnly Property=id_13964 +6 TJclFileAttributeMask.ReparsePoint Property=id_13965 +6 TJclFileAttributeMask.SparseFile Property=id_13966 +6 TJclFileAttributeMask.SymLink Property=id_13967 +6 TJclFileAttributeMask.System Property=id_13968 +6 TJclFileAttributeMask.Temporary Property=id_13969 +6 TJclFileAttributeMask.VolumeID Property=id_13970 +5 TJclFileEnumerator Class +6 TJclFileEnumerator Class=id_11269 +6 TJclFileEnumerator.FRefCount Field=id_13982 +6 TJclFileEnumerator.AttributeMask Property=id_13999 +6 TJclFileEnumerator.CaseSensitiveSearch Property=id_14000 +6 TJclFileEnumerator.FileMask Property=id_14001 +6 TJclFileEnumerator.FileMasks Property=id_14002 +6 TJclFileEnumerator.FileSizeMax Property=id_14003 +6 TJclFileEnumerator.FileSizeMin Property=id_14004 +6 TJclFileEnumerator.IncludeHiddenSubDirectories Property=id_14005 +6 TJclFileEnumerator.IncludeSubDirectories Property=id_14006 +6 TJclFileEnumerator.LastChangeAfter Property=id_14007 +6 TJclFileEnumerator.LastChangeAfterAsString Property=id_14008 +6 TJclFileEnumerator.LastChangeBefore Property=id_14009 +6 TJclFileEnumerator.LastChangeBeforeAsString Property=id_14010 +6 TJclFileEnumerator.NextTaskID Property=id_14011 +6 TJclFileEnumerator.OnEnterDirectory Event=id_13980 +6 TJclFileEnumerator.OnTerminateTask Event=id_13981 +6 TJclFileEnumerator.Options Property=id_14012 +6 TJclFileEnumerator.RootDirectory Property=id_14013 +6 TJclFileEnumerator.RunningTasks Property=id_14014 +6 TJclFileEnumerator.SearchOption Property=id_14015 +6 TJclFileEnumerator.SubDirectoryMask Property=id_14016 +6 TJclFileEnumerator.SynchronizationMode Property=id_14017 +6 TJclFileEnumerator._AddRef Method=id_14063 +6 TJclFileEnumerator._Release Method=id_14064 +6 TJclFileEnumerator.AfterConstruction Method=id_14065 +6 TJclFileEnumerator.Assign Method=id_14066 +6 TJclFileEnumerator.Create Constructor=id_14067 +6 TJclFileEnumerator.CreateTask Method=id_14068 +6 TJclFileEnumerator.Destroy Destructor=id_14069 +6 TJclFileEnumerator.FillList Method=id_14070 +6 ForEach Method +7 TJclFileEnumerator.ForEach Method (TFileHandler)=id_14071 +7 TJclFileEnumerator.ForEach Method (TFileHandlerEx)=id_14117 +6 TJclFileEnumerator.GetAttributeMask Method +7 TJclFileEnumerator.GetAttributeMask Method=id_14072 +6 TJclFileEnumerator.GetFileMask Method +7 TJclFileEnumerator.GetFileMask Method=id_14073 +6 TJclFileEnumerator.GetFileMasks Method +7 TJclFileEnumerator.GetFileMasks Method=id_14074 +6 TJclFileEnumerator.GetFileSizeMax Method +7 TJclFileEnumerator.GetFileSizeMax Method=id_14075 +6 TJclFileEnumerator.GetFileSizeMin Method +7 TJclFileEnumerator.GetFileSizeMin Method=id_14076 +6 TJclFileEnumerator.GetIncludeHiddenSubDirectories Method +7 TJclFileEnumerator.GetIncludeHiddenSubDirectories Method=id_14077 +6 TJclFileEnumerator.GetIncludeSubDirectories Method +7 TJclFileEnumerator.GetIncludeSubDirectories Method=id_14078 +6 TJclFileEnumerator.GetLastChangeAfter Method +7 TJclFileEnumerator.GetLastChangeAfter Method=id_14079 +6 TJclFileEnumerator.GetLastChangeAfterStr Method +7 TJclFileEnumerator.GetLastChangeAfterStr Method=id_14080 +6 TJclFileEnumerator.GetLastChangeBefore Method +7 TJclFileEnumerator.GetLastChangeBefore Method=id_14081 +6 TJclFileEnumerator.GetLastChangeBeforeStr Method +7 TJclFileEnumerator.GetLastChangeBeforeStr Method=id_14082 +6 TJclFileEnumerator.GetOnEnterDirectory Method +7 TJclFileEnumerator.GetOnEnterDirectory Method=id_14083 +6 TJclFileEnumerator.GetOnTerminateTask Method +7 TJclFileEnumerator.GetOnTerminateTask Method=id_14084 +6 TJclFileEnumerator.GetOption Method +7 TJclFileEnumerator.GetOption Method=id_14085 +6 TJclFileEnumerator.GetOptions Method +7 TJclFileEnumerator.GetOptions Method=id_14086 +6 TJclFileEnumerator.GetRootDirectory Method +7 TJclFileEnumerator.GetRootDirectory Method=id_14087 +6 TJclFileEnumerator.GetRunningTasks Method +7 TJclFileEnumerator.GetRunningTasks Method=id_14088 +6 TJclFileEnumerator.GetSubDirectoryMask Method +7 TJclFileEnumerator.GetSubDirectoryMask Method=id_14089 +6 TJclFileEnumerator.GetSynchronizationMode Method +7 TJclFileEnumerator.GetSynchronizationMode Method=id_14090 +6 TJclFileEnumerator.QueryInterface Method +7 TJclFileEnumerator.QueryInterface Method=id_14091 +6 TJclFileEnumerator.SetAttributeMask Method +7 TJclFileEnumerator.SetAttributeMask Method=id_14092 +6 TJclFileEnumerator.SetFileMask Method +7 TJclFileEnumerator.SetFileMask Method=id_14093 +6 TJclFileEnumerator.SetFileMasks Method +7 TJclFileEnumerator.SetFileMasks Method=id_14094 +6 TJclFileEnumerator.SetFileSizeMax Method +7 TJclFileEnumerator.SetFileSizeMax Method=id_14095 +6 TJclFileEnumerator.SetFileSizeMin Method +7 TJclFileEnumerator.SetFileSizeMin Method=id_14096 +6 TJclFileEnumerator.SetIncludeHiddenSubDirectories Method +7 TJclFileEnumerator.SetIncludeHiddenSubDirectories Method=id_14097 +6 TJclFileEnumerator.SetIncludeSubDirectories Method +7 TJclFileEnumerator.SetIncludeSubDirectories Method=id_14098 +6 TJclFileEnumerator.SetLastChangeAfter Method +7 TJclFileEnumerator.SetLastChangeAfter Method=id_14099 +6 TJclFileEnumerator.SetLastChangeAfterStr Method +7 TJclFileEnumerator.SetLastChangeAfterStr Method=id_14100 +6 TJclFileEnumerator.SetLastChangeBefore Method +7 TJclFileEnumerator.SetLastChangeBefore Method=id_14101 +6 TJclFileEnumerator.SetLastChangeBeforeStr Method +7 TJclFileEnumerator.SetLastChangeBeforeStr Method=id_14102 +6 TJclFileEnumerator.SetOnEnterDirectory Method +7 TJclFileEnumerator.SetOnEnterDirectory Method=id_14103 +6 TJclFileEnumerator.SetOnTerminateTask Method +7 TJclFileEnumerator.SetOnTerminateTask Method=id_14104 +6 TJclFileEnumerator.SetOption Method +7 TJclFileEnumerator.SetOption Method=id_14105 +6 TJclFileEnumerator.SetOptions Method +7 TJclFileEnumerator.SetOptions Method=id_14106 +6 TJclFileEnumerator.SetRootDirectory Method +7 TJclFileEnumerator.SetRootDirectory Method=id_14107 +6 TJclFileEnumerator.SetSubDirectoryMask Method +7 TJclFileEnumerator.SetSubDirectoryMask Method=id_14108 +6 TJclFileEnumerator.SetSynchronizationMode Method +7 TJclFileEnumerator.SetSynchronizationMode Method=id_14109 +6 TJclFileEnumerator.StopAllTasks Method +7 TJclFileEnumerator.StopAllTasks Method=id_14110 +6 TJclFileEnumerator.StopTask Method +7 TJclFileEnumerator.StopTask Method=id_14111 +6 TJclFileEnumerator.TaskTerminated Method +7 TJclFileEnumerator.TaskTerminated Method=id_14112 +5 IJclFileEnumerator Interface +6 IJclFileEnumerator Interface=id_11360 +6 IJclFileEnumerator.AttributeMask Property=id_13984 +6 IJclFileEnumerator.CaseSensitiveSearch Property=id_13985 +6 IJclFileEnumerator.FileMask Property=id_13986 +6 IJclFileEnumerator.FileSizeMax Property=id_13987 +6 IJclFileEnumerator.FileSizeMin Property=id_13988 +6 IJclFileEnumerator.IncludeHiddenSubDirectories Property=id_13989 +6 IJclFileEnumerator.IncludeSubDirectories Property=id_13990 +6 IJclFileEnumerator.LastChangeAfter Property=id_13991 +6 IJclFileEnumerator.LastChangeAfterAsString Property=id_13992 +6 IJclFileEnumerator.LastChangeBefore Property=id_13993 +6 IJclFileEnumerator.LastChangeBeforeAsString Property=id_13994 +6 IJclFileEnumerator.OnEnterDirectory Event=id_13978 +6 IJclFileEnumerator.OnTerminateTask Event=id_13979 +6 IJclFileEnumerator.RootDirectory Property=id_13995 +6 IJclFileEnumerator.RunningTasks Property=id_13996 +6 IJclFileEnumerator.SubDirectoryMask Property=id_13997 +6 IJclFileEnumerator.SynchronizationMode Property=id_13998 +6 IJclFileEnumerator.FillList Method=id_14020 +6 ForEach Method +7 IJclFileEnumerator.ForEach Method (TFileHandler)=id_14021 +7 IJclFileEnumerator.ForEach Method (TFileHandlerEx)=id_14125 +6 IJclFileEnumerator.GetAttributeMask Method +7 IJclFileEnumerator.GetAttributeMask Method=id_14022 +6 IJclFileEnumerator.GetCaseSensitiveSearch Method +7 IJclFileEnumerator.GetCaseSensitiveSearch Method=id_14023 +6 IJclFileEnumerator.GetFileMask Method +7 IJclFileEnumerator.GetFileMask Method=id_14024 +6 IJclFileEnumerator.GetFileMasks Method +7 IJclFileEnumerator.GetFileMasks Method=id_14025 +6 IJclFileEnumerator.GetFileSizeMax Method +7 IJclFileEnumerator.GetFileSizeMax Method=id_14026 +6 IJclFileEnumerator.GetFileSizeMin Method +7 IJclFileEnumerator.GetFileSizeMin Method=id_14027 +6 IJclFileEnumerator.GetIncludeHiddenSubDirectories Method +7 IJclFileEnumerator.GetIncludeHiddenSubDirectories Method=id_14028 +6 IJclFileEnumerator.GetIncludeSubDirectories Method +7 IJclFileEnumerator.GetIncludeSubDirectories Method=id_14029 +6 IJclFileEnumerator.GetLastChangeAfter Method +7 IJclFileEnumerator.GetLastChangeAfter Method=id_14030 +6 IJclFileEnumerator.GetLastChangeAfterStr Method +7 IJclFileEnumerator.GetLastChangeAfterStr Method=id_14031 +6 IJclFileEnumerator.GetLastChangeBefore Method +7 IJclFileEnumerator.GetLastChangeBefore Method=id_14032 +6 IJclFileEnumerator.GetLastChangeBeforeStr Method +7 IJclFileEnumerator.GetLastChangeBeforeStr Method=id_14033 +6 IJclFileEnumerator.GetOnEnterDirectory Method +7 IJclFileEnumerator.GetOnEnterDirectory Method=id_14034 +6 IJclFileEnumerator.GetOnTerminateTask Method +7 IJclFileEnumerator.GetOnTerminateTask Method=id_14035 +6 IJclFileEnumerator.GetOption Method +7 IJclFileEnumerator.GetOption Method=id_14036 +6 IJclFileEnumerator.GetOptions Method +7 IJclFileEnumerator.GetOptions Method=id_14037 +6 IJclFileEnumerator.GetRootDirectory Method +7 IJclFileEnumerator.GetRootDirectory Method=id_14038 +6 IJclFileEnumerator.GetRunningTasks Method +7 IJclFileEnumerator.GetRunningTasks Method=id_14039 +6 IJclFileEnumerator.GetSubDirectoryMask Method +7 IJclFileEnumerator.GetSubDirectoryMask Method=id_14040 +6 IJclFileEnumerator.GetSynchronizationMode Method +7 IJclFileEnumerator.GetSynchronizationMode Method=id_14041 +6 IJclFileEnumerator.SetAttributeMask Method +7 IJclFileEnumerator.SetAttributeMask Method=id_14042 +6 IJclFileEnumerator.SetCaseSensitiveSearch Method +7 IJclFileEnumerator.SetCaseSensitiveSearch Method=id_14043 +6 IJclFileEnumerator.SetFileMask Method +7 IJclFileEnumerator.SetFileMask Method=id_14044 +6 IJclFileEnumerator.SetFileMasks Method +7 IJclFileEnumerator.SetFileMasks Method=id_14045 +6 IJclFileEnumerator.SetFileSizeMax Method +7 IJclFileEnumerator.SetFileSizeMax Method=id_14046 +6 IJclFileEnumerator.SetFileSizeMin Method +7 IJclFileEnumerator.SetFileSizeMin Method=id_14047 +6 IJclFileEnumerator.SetIncludeHiddenSubDirectories Method +7 IJclFileEnumerator.SetIncludeHiddenSubDirectories Method=id_14048 +6 IJclFileEnumerator.SetIncludeSubDirectories Method +7 IJclFileEnumerator.SetIncludeSubDirectories Method=id_14049 +6 IJclFileEnumerator.SetLastChangeAfter Method +7 IJclFileEnumerator.SetLastChangeAfter Method=id_14050 +6 IJclFileEnumerator.SetLastChangeAfterStr Method +7 IJclFileEnumerator.SetLastChangeAfterStr Method=id_14051 +6 IJclFileEnumerator.SetLastChangeBefore Method +7 IJclFileEnumerator.SetLastChangeBefore Method=id_14052 +6 IJclFileEnumerator.SetLastChangeBeforeStr Method +7 IJclFileEnumerator.SetLastChangeBeforeStr Method=id_14053 +6 IJclFileEnumerator.SetOnEnterDirectory Method +7 IJclFileEnumerator.SetOnEnterDirectory Method=id_14054 +6 IJclFileEnumerator.SetOnTerminateTask Method +7 IJclFileEnumerator.SetOnTerminateTask Method=id_14055 +6 IJclFileEnumerator.SetOption Method +7 IJclFileEnumerator.SetOption Method=id_14056 +6 IJclFileEnumerator.SetOptions Method +7 IJclFileEnumerator.SetOptions Method=id_14057 +6 IJclFileEnumerator.SetRootDirectory Method +7 IJclFileEnumerator.SetRootDirectory Method=id_14058 +6 IJclFileEnumerator.SetSubDirectoryMask Method +7 IJclFileEnumerator.SetSubDirectoryMask Method=id_14059 +6 IJclFileEnumerator.SetSynchronizationMode Method +7 IJclFileEnumerator.SetSynchronizationMode Method=id_14060 +6 IJclFileEnumerator.StopAllTasks Method +7 IJclFileEnumerator.StopAllTasks Method=id_14061 +6 IJclFileEnumerator.StopTask Method +7 IJclFileEnumerator.StopTask Method=id_14062 +5 FileSearch Function +6 FileSearch Function=id_11306 +4 File Version Information +5 File Version Information=id_13883 +5 TFileFlags Type=id_11362 +5 VersionResourceAvailable Function=id_11359 +5 OSIdentToString Function=id_11327 +5 TJclFileVersionInfo Class +6 TJclFileVersionInfo Class=id_11272 +6 TJclFileVersionInfo.BinFileVersion Property=id_14138 +6 TJclFileVersionInfo.BinProductVersion Property=id_14139 +6 TJclFileVersionInfo.Comments Property=id_14140 +6 TJclFileVersionInfo.CompanyName Property=id_14141 +6 TJclFileVersionInfo.FileDescription Property=id_14142 +6 TJclFileVersionInfo.FileFlags Property=id_14143 +6 TJclFileVersionInfo.FileOS Property=id_14131 +6 TJclFileVersionInfo.FileSubType Property=id_14144 +6 TJclFileVersionInfo.FileType Property=id_14145 +6 TJclFileVersionInfo.FileVersion Property=id_14136 +6 TJclFileVersionInfo.FixedInfo Property=id_14146 +6 TJclFileVersionInfo.InternalName Property=id_14147 +6 TJclFileVersionInfo.Items Property=id_14148 +6 TJclFileVersionInfo.LanguageCount Property=id_14149 +6 TJclFileVersionInfo.LanguageIds Property=id_14150 +6 TJclFileVersionInfo.LanguageIndex Property=id_14151 +6 TJclFileVersionInfo.LanguageNames Property=id_14152 +6 TJclFileVersionInfo.Languages Property=id_14153 +6 TJclFileVersionInfo.LegalCopyright Property=id_14154 +6 TJclFileVersionInfo.LegalTradeMarks Property=id_14155 +6 TJclFileVersionInfo.OriginalFilename Property=id_14156 +6 TJclFileVersionInfo.PrivateBuild Property=id_14157 +6 TJclFileVersionInfo.ProductName Property=id_14135 +6 TJclFileVersionInfo.ProductVersion Property=id_14158 +6 TJclFileVersionInfo.SpecialBuild Property=id_14159 +6 TJclFileVersionInfo.TranslationCount Property=id_14160 +6 TJclFileVersionInfo.Translations Property=id_14161 +6 TJclFileVersionInfo.Attach Constructor=id_14163 +6 TJclFileVersionInfo.CheckLanguageIndex Method=id_14164 +6 TJclFileVersionInfo.Create Constructor=id_14165 +6 TJclFileVersionInfo.CreateItemsForLanguage Method=id_14166 +6 TJclFileVersionInfo.Destroy Destructor=id_14167 +6 TJclFileVersionInfo.ExtractData Method=id_14168 +6 TJclFileVersionInfo.ExtractFlags Method=id_14169 +6 TJclFileVersionInfo.GetBinFileVersion Method=id_14170 +6 TJclFileVersionInfo.GetBinProductVersion Method=id_14171 +6 TJclFileVersionInfo.GetFileOS Method=id_14172 +6 TJclFileVersionInfo.GetFileSubType Method=id_14173 +6 TJclFileVersionInfo.GetFileType Method=id_14174 +6 TJclFileVersionInfo.GetVersionKeyValue Method=id_14175 +6 TJclFileVersionInfo.TranslationMatchesLanguages Method=id_14176 +6 TJclFileVersionInfo.VersionLanguageId Method=id_14177 +6 TJclFileVersionInfo.VersionLanguageName Method=id_14178 +5 VersionFixedFileInfo Function +6 VersionFixedFileInfo Function=id_11358 +3 File Systems +4 File Systems=id_13878 +4 OSFileTypeToString Function=id_11326 +4 NTFS +5 NTFS=id_14189 +5 NtfsGetCompression Function=id_14194 +5 TStreamId Enumeration=id_7110 +5 TFindStreamData Record=id_14222 +5 NtfsFindFirstStream Function=id_14195 +5 NtfsFindNextStream Function=id_14196 +5 NtfsFindStreamClose Function=id_14197 +5 NtfsCreateJunctionPoint Function=id_14198 +5 NtfsDeleteJunctionPoint Function=id_14199 +5 NtfsGetJunctionPointDestination Function=id_14200 +5 NtfsZeroDataByName Function=id_14201 +5 NtfsZeroDataByHandle Function=id_14202 +5 NtfsSparseStreamsSupported Function=id_14203 +5 TNtfsAllocRanges Record=id_14223 +5 NtfsGetAllocRangeEntry Function=id_14204 +5 NtfsQueryAllocRanges Function=id_14205 +5 NtfsGetSparse Function=id_14206 +5 NtfsSetSparse Function=id_14207 +5 NtfsDeleteReparsePoint Function=id_14208 +5 NtfsSetReparsePoint Function=id_14209 +5 NtfsGetReparsePoint Function=id_14210 +5 NtfsGetReparseTag Function=id_14211 +5 NtfsReparsePointsSupported Function=id_14212 +5 NtfsFileHasReparsePoint Function=id_14213 +5 NtfsIsFolderMountPoint Function=id_14214 +5 NtfsMountDeviceAsDrive Function=id_14215 +5 NtfsMountVolume Function=id_14216 +5 NtfsSetCompression Function=id_14217 +5 NtfsSetFileCompression Function=id_14218 +5 NtfsSetDirectoryTreeCompression Function=id_14219 +5 NtfsSetPathCompression Function=id_14220 +5 NtfsSetDefaultFileCompression Function=id_14221 +5 TFileCompressionState Enumeration=id_14193 +5 _REPARSE_GUID_DATA_BUFFER Record=id_7532 +3 Path manipulation +4 Path manipulation=id_13879 +4 DriveLetters Constant=id_11275 +4 PathDevicePrefix Constant=id_11276 +4 PathSeparator Constant=id_11277 +4 PathUncPrefix Constant=id_11278 +4 PathGetLongName Function=id_11337 +4 PathGetLongName2 Function=id_11338 +4 PathGetShortName Function=id_11340 +4 PathGetRelativePath Function=id_11339 +4 PathGetTempPath Function=id_11341 +4 PathIsChild Function=id_11343 +4 PathIsAbsolute Function=id_11342 +4 PathIsDiskDevice Function=id_11344 +4 PathIsUNC Function=id_11345 +4 PathExtractElements Function=id_11334 +4 PathAddSeparator Function=id_11329 +4 PathAddExtension Function=id_11328 +4 PathAppend Function=id_11330 +4 PathBuildRoot Function=id_11331 +4 PathCommonPrefix Function=id_11332 +4 PathCompactPath Function=id_11333 +4 PathExtractFileDirFixed Function=id_11335 +4 PathExtractFileNameNoExt Function=id_11336 +4 PathRemoveExtension Function=id_11346 +4 PathRemoveSeparator Function=id_11347 +3 Streams +4 Streams=id_13880 +4 TJclTempFileStream Class +5 TJclTempFileStream Class=id_11274 +5 TJclTempFileStream.FileName Property=id_14281 +5 TJclTempFileStream.Create Constructor=id_14283 +5 TJclTempFileStream.Destroy Destructor=id_14284 +4 File Mapping +5 File Mapping=id_14274 +5 TJclFileMappingView Class +6 TJclFileMappingView Class=id_11271 +6 TJclFileMappingView.FileMapping Property=id_14295 +6 TJclFileMappingView.Index Property=id_14296 +6 TJclFileMappingView.Offset Property=id_14297 +6 TJclFileMappingView.Create Constructor=id_14293 +6 TJclFileMappingView.CreateAt Constructor=id_14299 +6 TJclFileMappingView.Destroy Destructor=id_14300 +6 TJclFileMappingView.Flush Method=id_14301 +6 TJclFileMappingView.LoadFromFile Method=id_14302 +6 TJclFileMappingView.LoadFromStream Method=id_14303 +6 TJclFileMappingView.Write Method=id_14292 +5 TJclCustomFileMapping Class +6 TJclCustomFileMapping Class=id_11267 +6 TJclCustomFileMapping.Count Property=id_14312 +6 TJclCustomFileMapping.Existed Property=id_14314 +6 TJclCustomFileMapping.Handle Property=id_14315 +6 TJclCustomFileMapping.Name Property=id_14316 +6 TJclCustomFileMapping.RoundViewOffset Property=id_14317 +6 TJclCustomFileMapping.Views Property=id_14313 +6 TJclCustomFileMapping.Add Method=id_14291 +6 TJclCustomFileMapping.AddAt Method=id_14319 +6 TJclCustomFileMapping.ClearViews Method=id_14320 +6 TJclCustomFileMapping.Create Constructor=id_14309 +6 TJclCustomFileMapping.Delete Method=id_14321 +6 TJclCustomFileMapping.Destroy Destructor=id_14322 +6 TJclCustomFileMapping.IndexOf Method=id_14323 +6 TJclCustomFileMapping.InternalCreate Method=id_14324 +6 TJclCustomFileMapping.InternalOpen Method=id_14325 +6 TJclCustomFileMapping.Open Constructor=id_14310 +5 TJclFileMapping Class +6 TJclFileMapping Class=id_11270 +6 TJclFileMapping.FileHandle Property=id_14334 +6 Create Constructor +7 TJclFileMapping.Create Constructor (THandle, string, Cardinal, Int64, PSecurityAttributes)=id_14336 +6 TJclFileMapping.Destroy Destructor +7 TJclFileMapping.Destroy Destructor=id_14337 +5 TJclSwapFileMapping Class +6 TJclSwapFileMapping Class=id_11273 +6 TJclSwapFileMapping.Create Constructor=id_14343 +2 Graphics +3 Graphics=id_11564 +3 FillGradient Function=id_11385 +3 Bitmaps +4 Bitmaps=id_14348 +4 TJclThreadPersistent Class +5 TJclThreadPersistent Class=id_14369 +5 TJclThreadPersistent.LockCount Property=id_2410 +5 TJclThreadPersistent.OnChange Property=id_2412 +5 TJclThreadPersistent.OnChanging Property=id_2414 +5 TJclThreadPersistent.UpdateCount Property=id_2415 +5 TJclThreadPersistent.BeginUpdate Method=id_2422 +5 TJclThreadPersistent.Changed Method=id_2413 +5 TJclThreadPersistent.Changing Method=id_2423 +5 TJclThreadPersistent.Create Constructor=id_2424 +5 TJclThreadPersistent.Destroy Destructor=id_2425 +5 TJclThreadPersistent.EndUpdate Method=id_2426 +5 TJclThreadPersistent.Lock Method=id_2411 +5 TJclThreadPersistent.Unlock Method=id_2427 +4 IdentityMatrix Variable +5 IdentityMatrix Variable=id_11399 +4 TJclCustomMap Class +5 TJclCustomMap Class=id_2407 +5 TJclCustomMap.Height Property=id_2416 +5 TJclCustomMap.Width Property=id_2417 +5 TJclCustomMap.Delete Method=id_2428 +5 TJclCustomMap.Empty Method=id_2429 +5 SetSize Method +6 TJclCustomMap.SetSize Method (Integer, Integer)=id_2430 +6 TJclCustomMap.SetSize Method (TPersistent)=id_14413 +4 TJclBitmap32 Class +5 TJclBitmap32 Class=id_2408 +5 TJclBitmap32.FontHandle Field=id_14420 +5 TJclBitmap32.RasterX Field=id_14421 +5 TJclBitmap32.RasterXF Field=id_14422 +5 TJclBitmap32.RasterY Field=id_14423 +5 TJclBitmap32.RasterYF Field=id_14424 +5 TJclBitmap32.BitmapHandle Property=id_14426 +5 TJclBitmap32.BitmapInfo Property=id_14427 +5 TJclBitmap32.Bits Property=id_14428 +5 TJclBitmap32.DrawMode Property=id_14429 +5 TJclBitmap32.Font Property=id_14430 +5 TJclBitmap32.Handle Property=id_14431 +5 TJclBitmap32.MasterAlpha Property=id_14432 +5 TJclBitmap32.OnChange Property=id_14433 +5 TJclBitmap32.OnChanging Property=id_14434 +5 TJclBitmap32.OuterColor Property=id_14435 +5 TJclBitmap32.PenColor Property=id_14436 +5 TJclBitmap32.Pixel Property=id_14438 +5 TJclBitmap32.PixelPtr Property=id_14439 +5 TJclBitmap32.ScanLine Property=id_14440 +5 TJclBitmap32.StippleCounter Property=id_14441 +5 TJclBitmap32.StippleStep Property=id_14442 +5 TJclBitmap32.StretchFilter Property=id_14443 +5 TJclBitmap32.Assign Method=id_14418 +5 TJclBitmap32.AssignTo Method=id_14419 +5 Clear Method +6 TJclBitmap32.Clear Method ()=id_14445 +6 TJclBitmap32.Clear Method (TColor32)=id_14506 +5 TJclBitmap32.ClipLine Method +6 TJclBitmap32.ClipLine Method=id_14446 +5 TJclBitmap32.ClipLineF Method +6 TJclBitmap32.ClipLineF Method=id_14447 +5 TJclBitmap32.Create Constructor +6 TJclBitmap32.Create Constructor=id_14448 +5 TJclBitmap32.DefineProperties Method +6 TJclBitmap32.DefineProperties Method=id_14449 +5 TJclBitmap32.Delete Method +6 TJclBitmap32.Delete Method=id_14450 +5 TJclBitmap32.Destroy Destructor +6 TJclBitmap32.Destroy Destructor=id_14451 +5 Draw Method +6 TJclBitmap32.Draw Method (Integer, Integer, TJclBitmap32)=id_14437 +5 TJclBitmap32.DrawHorzLine Method +6 TJclBitmap32.DrawHorzLine Method=id_14452 +5 TJclBitmap32.DrawLine Method +6 TJclBitmap32.DrawLine Method=id_14453 +5 DrawTo Method +6 TJclBitmap32.DrawTo Method (HDC, Integer, Integer)=id_14454 +5 TJclBitmap32.DrawVertLine Method +6 TJclBitmap32.DrawVertLine Method=id_14455 +5 TJclBitmap32.Empty Method +6 TJclBitmap32.Empty Method=id_14456 +5 TJclBitmap32.FillRect Method +6 TJclBitmap32.FillRect Method=id_14457 +5 TJclBitmap32.FontChanged Method +6 TJclBitmap32.FontChanged Method=id_14458 +5 TJclBitmap32.FrameRectS Method +6 TJclBitmap32.FrameRectS Method=id_14459 +5 TJclBitmap32.FrameRectTS Method +6 TJclBitmap32.FrameRectTS Method=id_14460 +5 TJclBitmap32.FrameRectTSP Method +6 TJclBitmap32.FrameRectTSP Method=id_14461 +5 TJclBitmap32.GetPixelB Method +6 TJclBitmap32.GetPixelB Method=id_14462 +5 TJclBitmap32.GetStippleColor Method +6 TJclBitmap32.GetStippleColor Method=id_14463 +5 TJclBitmap32.LineToS Method +6 TJclBitmap32.LineToS Method=id_14464 +5 TJclBitmap32.LoadFromFile Method +6 TJclBitmap32.LoadFromFile Method=id_14465 +5 TJclBitmap32.LoadFromStream Method +6 TJclBitmap32.LoadFromStream Method=id_14466 +5 TJclBitmap32.MoveTo Method +6 TJclBitmap32.MoveTo Method=id_14467 +5 TJclBitmap32.RaiseRectTS Method +6 TJclBitmap32.RaiseRectTS Method=id_14468 +5 TJclBitmap32.ReadData Method +6 TJclBitmap32.ReadData Method=id_14469 +5 TJclBitmap32.RenderText Method +6 TJclBitmap32.RenderText Method=id_14470 +5 TJclBitmap32.ResetAlpha Method +6 TJclBitmap32.ResetAlpha Method=id_14471 +5 TJclBitmap32.ResetStippleCounter Method +6 TJclBitmap32.ResetStippleCounter Method=id_14472 +5 TJclBitmap32.SaveToFile Method +6 TJclBitmap32.SaveToFile Method=id_14473 +5 TJclBitmap32.SaveToStream Method +6 TJclBitmap32.SaveToStream Method=id_14474 +5 TJclBitmap32.SET_T256 Method +6 TJclBitmap32.SET_T256 Method=id_14475 +5 TJclBitmap32.SET_TS256 Method +6 TJclBitmap32.SET_TS256 Method=id_14476 +5 SetPixelT Method +6 TJclBitmap32.SetPixelT Method (Integer, Integer, TColor32)=id_14477 +5 TJclBitmap32.SetSize Method +6 TJclBitmap32.SetSize Method=id_14478 +5 SetStipple Method +6 TJclBitmap32.SetStipple Method (TArrayOfColor32)=id_14479 +5 TJclBitmap32.TextExtent Method +6 TJclBitmap32.TextExtent Method=id_14480 +5 TJclBitmap32.TextHeight Method +6 TJclBitmap32.TextHeight Method=id_14481 +5 TextOut Method +6 TJclBitmap32.TextOut Method (Integer, Integer, TRect, string)=id_14482 +5 TJclBitmap32.TextWidth Method +6 TJclBitmap32.TextWidth Method=id_14483 +5 TJclBitmap32.UpdateFont Method +6 TJclBitmap32.UpdateFont Method=id_14484 +5 TJclBitmap32.WriteData Method +6 TJclBitmap32.WriteData Method=id_14485 +4 DrawBitmap Function +5 DrawBitmap Function=id_11383 +4 Stretch Function +5 Stretch Function=id_11387 +4 TJclBitmap32.SetPixel Method +5 TJclBitmap32.SetPixel Method=id_14384 +4 TResamplingFilter Enumeration +5 TResamplingFilter Enumeration=id_11381 +4 Function naming conventions +5 Function naming conventions=id_14363 +4 Line Patterns +5 Line Patterns=id_14364 +4 TDrawMode Enumeration +5 TDrawMode Enumeration=id_11378 +4 TMatrix3d Record +5 TMatrix3d Record=id_11388 +4 TStretchFilter Enumeration +5 TStretchFilter Enumeration=id_11382 +4 ScreenShot@TBitmap@Integer@Integer@Integer@Integer@HWND +5 ScreenShot@TBitmap@Integer@Integer@Integer@Integer@HWND=id_14365 +4 TConversionKind Enumeration +5 TConversionKind Enumeration=id_2447 +4 TJclTransformation Class +5 TJclTransformation Class=id_11377 +5 TJclTransformation.GetTransformedBounds Method=id_14543 +5 TJclTransformation.PrepareTransform Method=id_14544 +5 TJclTransformation.Transform Method=id_14542 +5 TJclTransformation.Transform256 Method=id_14545 +4 TJclLinearTransformation Class +5 TJclLinearTransformation Class=id_11376 +5 TJclLinearTransformation.A Field=id_14551 +5 TJclLinearTransformation.B Field=id_14552 +5 TJclLinearTransformation.C Field=id_14553 +5 TJclLinearTransformation.D Field=id_14554 +5 TJclLinearTransformation.E Field=id_14555 +5 TJclLinearTransformation.F Field=id_14556 +5 TJclLinearTransformation.Matrix Property=id_14570 +5 TJclLinearTransformation.Clear Method=id_14558 +5 TJclLinearTransformation.Create Constructor=id_14559 +5 TJclLinearTransformation.GetTransformedBounds Method=id_14560 +5 TJclLinearTransformation.PrepareTransform Method=id_14561 +5 TJclLinearTransformation.Rotate Method=id_14562 +5 TJclLinearTransformation.Scale Method=id_14563 +5 TJclLinearTransformation.Skew Method=id_14564 +5 TJclLinearTransformation.Transform Method=id_14565 +5 TJclLinearTransformation.Transform256 Method=id_14566 +5 TJclLinearTransformation.Translate Method=id_14567 +4 AlphaToGrayscale Function +5 AlphaToGrayscale Function=id_14370 +4 ApplyLUT Function +5 ApplyLUT Function=id_14371 +4 BlockTransfer Function +5 BlockTransfer Function=id_14372 +4 ColorToGrayscale Function +5 ColorToGrayscale Function=id_14373 +4 IntensityToAlpha Function +5 IntensityToAlpha Function=id_14374 +4 Invert Function +5 Invert Function=id_14375 +4 InvertRGB Function +5 InvertRGB Function=id_14376 +4 Polygon +5 Polygon=id_14366 +4 PolyPolygon +5 PolyPolygon=id_14367 +4 PolyLine +5 PolyLine=id_14368 +4 SetBorderTransparent Function +5 SetBorderTransparent Function=id_14377 +4 SetGamma Function +5 SetGamma Function=id_14378 +4 StretchTransfer Function +5 StretchTransfer Function=id_14379 +4 Transform Function +5 Transform Function=id_14380 +3 Clipping +4 Clipping=id_14349 +4 ClipLine Function=id_14591 +4 DrawPolyLine Function=id_14592 +3 Colors +4 Colors=id_14350 +4 BrightColorChannel Function=id_14601 +4 DarkColorChannel Function=id_14602 +4 DarkColor Function=id_14603 +4 BrightColor Function=id_14604 +4 GetRGBValue Function=id_14605 +4 SetRGBValue Function=id_14606 +4 SetColorRed Function=id_14607 +4 SetColorGreen Function=id_14608 +4 SetColorBlue Function=id_14609 +4 SetColorFlag Function=id_14610 +4 GetColorRed Function=id_14611 +4 GetColorBlue Function=id_14612 +4 GetColorGreen Function=id_14613 +4 GetColorFlag Function=id_14614 +4 CIED65ToCIED50 Function=id_14615 +4 Gray16=id_14594 +4 CMYK2BGR=id_14595 +4 CIELAB2BGR=id_14596 +4 RGB2BGR=id_14597 +4 RGBA2BGRA=id_14598 +4 WinColor2OpenGLColor=id_14599 +4 OpenGLColor2WinColor=id_14600 +3 Conversion +4 Conversion=id_14351 +4 BitmapToJPeg Function=id_14632 +4 JPegToBitmap Function=id_14633 +4 BitmapToIcon Function=id_6515 +4 IconToBitmap Function=id_11386 +3 Desktop +4 Desktop=id_14352 +4 TJclDesktopCanvas Class=id_14637 +3 Icons +4 Icons=id_14353 +4 ExtractIconCount Function=id_11384 +4 WriteIcon Function=id_6990 +4 SaveIconToFile Function=id_14639 +3 Points +4 Points=id_14354 +4 PointAssign Function=id_14643 +4 PointCopy Function=id_14644 +4 PointEqual Function=id_14645 +4 PointMove Function=id_14646 +4 NullPoint Function=id_14647 +4 PointIsNull Function=id_14648 +3 Rectangles +4 Rectangles=id_14355 +4 RectIsEmpty Function=id_14650 +4 RectNormalize Function=id_14651 +4 RectUnion Function=id_14652 +4 RectIsSquare Function=id_14653 +4 RectCenter Function=id_14654 +4 RectEqual Function=id_14655 +4 RectIsNull Function=id_14656 +4 NullRect Function=id_14657 +4 RectIsValid Function=id_14658 +4 RectsAreValid Function=id_14659 +4 RectIntersectRect Function=id_14660 +4 RectIntersection Function=id_14661 +4 RectIncludesPoint Function=id_14662 +4 RectIncludesRect Function=id_14663 +4 RectBounds Function=id_14664 +4 RectAssign Function=id_14665 +4 RectAssignPoints Function=id_14666 +4 RectCopy Function=id_14667 +4 RectMove Function=id_14668 +4 RectMoveTo Function=id_14669 +4 RectGrow Function=id_14670 +4 RectGrowX Function=id_14671 +4 RectGrowY Function=id_14672 +4 RectHeight Function=id_14673 +4 RectWidth Function=id_14674 +3 Regions +4 Regions=id_14356 +4 TJclRegion Class +5 TJclRegion Class=id_14693 +5 TJclRegion.Box Property=id_14701 +5 TJclRegion.Handle Property=id_14702 +5 TJclRegion.RegionType Property=id_14703 +5 TJclRegion.Clip Method=id_14705 +5 Combine Method +6 TJclRegion.Combine Method (TJclRegion, TJclRegion, TJclRegionCombineOperator)=id_7147 +5 TJclRegion.Copy Method +6 TJclRegion.Copy Method=id_14706 +5 TJclRegion.Create Constructor +6 TJclRegion.Create Constructor=id_14699 +5 TJclRegion.CreateBitmap Constructor +6 TJclRegion.CreateBitmap Constructor=id_6380 +5 CreateElliptic Constructor +6 TJclRegion.CreateElliptic Constructor (Integer, Integer, Integer, Integer)=id_14707 +5 CreateMapWindow Constructor +6 TJclRegion.CreateMapWindow Constructor (TJclRegion, THandle, THandle)=id_14708 +6 TJclRegion.CreateMapWindow Constructor (TJclRegion, TWinControl, TWinControl)=id_14736 +5 TJclRegion.CreatePath Constructor +6 TJclRegion.CreatePath Constructor=id_14709 +5 TJclRegion.CreatePoly Constructor +6 TJclRegion.CreatePoly Constructor=id_14710 +5 TJclRegion.CreatePolyPolygon Constructor +6 TJclRegion.CreatePolyPolygon Constructor=id_14711 +5 CreateRect Constructor +6 TJclRegion.CreateRect Constructor (Integer, Integer, Integer, Integer, Byte)=id_14712 +5 TJclRegion.CreateRegionInfo Constructor +6 TJclRegion.CreateRegionInfo Constructor=id_14713 +5 CreateRoundRect Constructor +6 TJclRegion.CreateRoundRect Constructor (Integer, Integer, Integer, Integer, Integer, Integer)=id_14714 +5 TJclRegion.Destroy Destructor +6 TJclRegion.Destroy Destructor=id_14715 +5 TJclRegion.Equals Method +6 TJclRegion.Equals Method=id_14716 +5 TJclRegion.Fill Method +6 TJclRegion.Fill Method=id_14717 +5 TJclRegion.FillGradient Method +6 TJclRegion.FillGradient Method=id_14718 +5 TJclRegion.Frame Method +6 TJclRegion.Frame Method=id_14719 +5 TJclRegion.GetBox Method +6 TJclRegion.GetBox Method=id_14720 +5 TJclRegion.GetHandle Method +6 TJclRegion.GetHandle Method=id_14721 +5 TJclRegion.GetRegionInfo Method +6 TJclRegion.GetRegionInfo Method=id_14722 +5 TJclRegion.GetRegionType Method +6 TJclRegion.GetRegionType Method=id_14723 +5 TJclRegion.Invert Method +6 TJclRegion.Invert Method=id_14724 +5 TJclRegion.Offset Method +6 TJclRegion.Offset Method=id_14725 +5 TJclRegion.Paint Method +6 TJclRegion.Paint Method=id_14726 +5 PointIn Method +6 TJclRegion.PointIn Method (Integer, Integer)=id_14727 +5 RectIn Method +6 TJclRegion.RectIn Method (Integer, Integer, Integer, Integer)=id_14728 +5 TJclRegion.SetWindow Method +6 TJclRegion.SetWindow Method=id_14729 +4 TJclRegionInfo Class +5 TJclRegionInfo Class=id_14694 +5 TJclRegionInfo.Box Property=id_14748 +5 TJclRegionInfo.Count Property=id_14749 +5 TJclRegionInfo.Rectangles Property=id_14750 +5 TJclRegionInfo.Create Constructor=id_14752 +5 TJclRegionInfo.Destroy Destructor=id_14753 +5 TJclRegionInfo.GetCount Method=id_14754 +5 TJclRegionInfo.GetRect Method=id_14755 +3 Types +4 Types=id_14357 +4 TGradientDirection Enumeration=id_11379 +4 TPolyFillMode Enumeration=id_11380 +4 TJclRegionType=id_14733 +4 TColor32 Type=id_6295 +4 TColor32Array Type=id_7315 +4 TPalette32 Type=id_2450 +4 TPointF Record=id_11389 +4 TDynPointArrayF Type=id_11394 +4 TDynDynPointArrayArrayF Type=id_11392 +4 TDynPointArray Type=id_11393 +4 TDynDynPointArrayArray Type=id_11391 +4 TDynDynIntegerArrayArray Type=id_11390 +4 TGamma Type=id_11395 +4 TLUT8 Type=id_11396 +4 TScanLine Type=id_11397 +4 TScanLines Type=id_11398 +2 Internationalisation +3 Internationalisation=id_11565 +3 Keyboard Input +4 Keyboard Input=id_14778 +4 TJclKeyboardLayoutList Class +5 TJclKeyboardLayoutList Class=id_14782 +5 TJclKeyboardLayoutList.ActiveLayout Property=id_14794 +5 TJclKeyboardLayoutList.AvailableLayoutCount Property=id_14795 +5 TJclKeyboardLayoutList.AvailableLayouts Property=id_14796 +5 TJclKeyboardLayoutList.Count Property=id_14797 +5 TJclKeyboardLayoutList.ItemFromHKL Property=id_14798 +5 TJclKeyboardLayoutList.Items Property=id_14799 +5 TJclKeyboardLayoutList.LayoutFromLocaleID Property=id_14800 +5 TJclKeyboardLayoutList.OnRefresh Property=id_14801 +5 TJclKeyboardLayoutList.ActivateNextLayout Method=id_14803 +5 TJclKeyboardLayoutList.ActivatePrevLayout Method=id_14804 +5 TJclKeyboardLayoutList.Create Constructor=id_14805 +5 TJclKeyboardLayoutList.CreateAvailableLayouts Method=id_14806 +5 TJclKeyboardLayoutList.Destroy Destructor=id_14807 +5 TJclKeyboardLayoutList.DoRefresh Method=id_14808 +5 TJclKeyboardLayoutList.LoadLayout Method=id_14809 +5 TJclKeyboardLayoutList.Refresh Method=id_14810 +4 TJclKeyboardLayout Class +5 TJclKeyboardLayout Class=id_14783 +5 TJclKeyboardLayout.DeviceHandle Property=id_14820 +5 TJclKeyboardLayout.DisplayName Property=id_14821 +5 TJclKeyboardLayout.Layout Property=id_14822 +5 TJclKeyboardLayout.LocaleID Property=id_14823 +5 TJclKeyboardLayout.LocaleInfo Property=id_14824 +5 TJclKeyboardLayout.VariationName Property=id_14825 +5 TJclKeyboardLayout.Activate Method=id_14817 +5 TJclKeyboardLayout.Create Constructor=id_14818 +5 TJclKeyboardLayout.Destroy Destructor=id_14827 +5 TJclKeyboardLayout.Unload Method=id_14816 +4 TJclKeybLayoutFlag Enumeration +5 TJclKeybLayoutFlag Enumeration=id_14785 +4 TJclAvailableKeybLayout Class +5 TJclAvailableKeybLayout Class=id_14784 +5 TJclAvailableKeybLayout.Identifier Property=id_14835 +5 TJclAvailableKeybLayout.IdentifierName Property=id_14836 +5 TJclAvailableKeybLayout.LayoutFile Property=id_14837 +5 TJclAvailableKeybLayout.LayoutFileExists Property=id_14838 +5 TJclAvailableKeybLayout.LayoutID Property=id_14839 +5 TJclAvailableKeybLayout.Name Property=id_14840 +5 TJclAvailableKeybLayout.Load Method=id_14841 +3 National Language Support +4 National Language Support=id_14779 +4 TJclLocaleInfo Class +5 TJclLocaleInfo Class=id_14830 +5 TJclLocaleInfo.AbbreviatedCountryName Property=id_14854 +5 TJclLocaleInfo.AbbreviatedDayNames Property=id_14855 +5 TJclLocaleInfo.AbbreviatedLangName Property=id_14856 +5 TJclLocaleInfo.AbbreviatedMonthNames Property=id_14857 +5 TJclLocaleInfo.AdditionalCaledarTypes Property=id_14858 +5 TJclLocaleInfo.AMDesignator Property=id_14859 +5 TJclLocaleInfo.CalendarIntegerInfo Property=id_14860 +5 TJclLocaleInfo.Calendars Property=id_14861 +5 TJclLocaleInfo.CalendarStringInfo Property=id_14862 +5 TJclLocaleInfo.CalendarType Property=id_14863 +5 TJclLocaleInfo.CalTwoDigitYearMax Property=id_14864 +5 TJclLocaleInfo.CenturyFormatSpecifier Property=id_14865 +5 TJclLocaleInfo.CharInfo Property=id_14866 +5 TJclLocaleInfo.CodePageANSI Property=id_14867 +5 TJclLocaleInfo.CodePageMAC Property=id_14868 +5 TJclLocaleInfo.CodePageOEM Property=id_14869 +5 TJclLocaleInfo.CountryCode Property=id_14870 +5 TJclLocaleInfo.DateFormats Property=id_14871 +5 TJclLocaleInfo.DateSeparator Property=id_14872 +5 TJclLocaleInfo.DecimalSeparator Property=id_14873 +5 TJclLocaleInfo.DefaultCodePageEBCDIC Property=id_14874 +5 TJclLocaleInfo.DefaultCountryCode Property=id_14875 +5 TJclLocaleInfo.DefaultLanguageId Property=id_14876 +5 TJclLocaleInfo.DefaultPaperSize Property=id_14877 +5 TJclLocaleInfo.DigitGrouping Property=id_14878 +5 TJclLocaleInfo.DigitSubstitution Property=id_14879 +5 TJclLocaleInfo.EnglishCountryName Property=id_14880 +5 TJclLocaleInfo.EnglishCurrencyName Property=id_14881 +5 TJclLocaleInfo.EnglishLangName Property=id_14882 +5 TJclLocaleInfo.FirstDayOfWeek Property=id_14883 +5 TJclLocaleInfo.FirstWeekOfYear Property=id_14884 +5 TJclLocaleInfo.FontCharset Property=id_14885 +5 TJclLocaleInfo.FontSignature Property=id_14886 +5 TJclLocaleInfo.IntegerInfo Property=id_14887 +5 TJclLocaleInfo.ISOAbbreviatedCountryName Property=id_14888 +5 TJclLocaleInfo.ISOAbbreviatedLangName Property=id_14889 +5 TJclLocaleInfo.LangID Property=id_14890 +5 TJclLocaleInfo.LangIDPrimary Property=id_14891 +5 TJclLocaleInfo.LangIDSub Property=id_14892 +5 TJclLocaleInfo.LanguageIndentifier Property=id_14893 +5 TJclLocaleInfo.LeadingZeros Property=id_14894 +5 TJclLocaleInfo.LeadZerosInDay Property=id_14895 +5 TJclLocaleInfo.LeadZerosInMonth Property=id_14896 +5 TJclLocaleInfo.LeadZerosInTime Property=id_14897 +5 TJclLocaleInfo.ListItemSeparator Property=id_14898 +5 TJclLocaleInfo.LocaleID Property=id_14899 +5 TJclLocaleInfo.LocalizedCountryName Property=id_14900 +5 TJclLocaleInfo.LocalizedLangName Property=id_14901 +5 TJclLocaleInfo.LocalizedSortName Property=id_14902 +5 TJclLocaleInfo.LongDateFormat Property=id_14903 +5 TJclLocaleInfo.LongDateOrdering Property=id_14904 +5 TJclLocaleInfo.LongDayNames Property=id_14905 +5 TJclLocaleInfo.LongMonthNames Property=id_14906 +5 TJclLocaleInfo.Measure Property=id_14907 +5 TJclLocaleInfo.MonetaryDecimalSeparator Property=id_14908 +5 TJclLocaleInfo.MonetaryGrouping Property=id_14909 +5 TJclLocaleInfo.MonetarySymbolIntl Property=id_14910 +5 TJclLocaleInfo.MonetarySymbolLocal Property=id_14911 +5 TJclLocaleInfo.MonetaryThousandsSeparator Property=id_14912 +5 TJclLocaleInfo.NativeCountryName Property=id_14913 +5 TJclLocaleInfo.NativeCurrencyName Property=id_14914 +5 TJclLocaleInfo.NativeDigits Property=id_14915 +5 TJclLocaleInfo.NativeLangName Property=id_14916 +5 TJclLocaleInfo.NegativeCurrencyMode Property=id_14917 +5 TJclLocaleInfo.NegativeNumberMode Property=id_14918 +5 TJclLocaleInfo.NegativeSign Property=id_14919 +5 TJclLocaleInfo.NegativeSignPos Property=id_14920 +5 TJclLocaleInfo.NumberOfFractionalDigits Property=id_14921 +5 TJclLocaleInfo.NumberOfIntlMonetaryDigits Property=id_14922 +5 TJclLocaleInfo.NumberOfLocalMonetaryDigits Property=id_14923 +5 TJclLocaleInfo.PMDesignator Property=id_14924 +5 TJclLocaleInfo.PositiveCurrencyMode Property=id_14925 +5 TJclLocaleInfo.PositiveSign Property=id_14926 +5 TJclLocaleInfo.PositiveSignPos Property=id_14927 +5 TJclLocaleInfo.PosOfNegativeMonetarySymbol Property=id_14928 +5 TJclLocaleInfo.PosOfPositiveMonetarySymbol Property=id_14929 +5 TJclLocaleInfo.SepOfNegativeMonetarySymbol Property=id_14930 +5 TJclLocaleInfo.SepOfPositiveMonetarySymbol Property=id_14931 +5 TJclLocaleInfo.ShortDateFormat Property=id_14932 +5 TJclLocaleInfo.ShortDateOrdering Property=id_14933 +5 TJclLocaleInfo.SortID Property=id_14934 +5 TJclLocaleInfo.StringInfo Property=id_14935 +5 TJclLocaleInfo.ThousandSeparator Property=id_14936 +5 TJclLocaleInfo.TimeFormats Property=id_14937 +5 TJclLocaleInfo.TimeFormatSpecifier Property=id_14938 +5 TJclLocaleInfo.TimeFormatString Property=id_14939 +5 TJclLocaleInfo.TimeMarkerPosition Property=id_14940 +5 TJclLocaleInfo.TimeSeparator Property=id_14941 +5 TJclLocaleInfo.UseSystemACP Property=id_14942 +5 TJclLocaleInfo.YearMonthFormat Property=id_14943 +5 TJclLocaleInfo.Create Constructor=id_14945 +5 TJclLocaleInfo.Destroy Destructor=id_14946 +4 TJclLocalesKind Enumeration +5 TJclLocalesKind Enumeration=id_14846 +4 TJclLocalesList Class +5 TJclLocalesList Class=id_14845 +5 TJclLocalesList.CodePages Property=id_14953 +5 TJclLocalesList.ItemFromLangID Property=id_14954 +5 TJclLocalesList.ItemFromLangIDPrimary Property=id_14955 +5 TJclLocalesList.ItemFromLocaleID Property=id_14956 +5 TJclLocalesList.Items Property=id_14957 +5 TJclLocalesList.Kind Property=id_14958 +5 TJclLocalesList.Create Constructor=id_14960 +5 TJclLocalesList.CreateList Method=id_14961 +5 TJclLocalesList.Destroy Destructor=id_14962 +5 TJclLocalesList.FillStrings Method=id_14963 +2 Internet and E-mail +3 Internet and E-mail=id_11566 +3 MAPI +4 MAPI=id_14966 +4 TJclMapiClient Record=id_14983 +4 TJclMapiClientConnect Enumeration=id_14974 +4 TJclEmailRecipKind Enumeration=id_14975 +4 TJclEmailFindOption Enumeration=id_14976 +4 TJclEmailLogonOption Enumeration=id_14977 +4 TJclEmailReadOption Enumeration=id_14978 +4 TJclEmailReadMsg Record=id_14984 +4 JclSimpleSendMail Function=id_14979 +4 JclSimpleBringUpSendMailDialog Function=id_14980 +4 MapiCheck Function=id_14981 +4 MapiErrorMessage Function=id_14982 +4 EJclMapiError +5 EJclMapiError=id_14969 +5 EJclMapiError Class +6 EJclMapiError Class=id_14992 +6 EJclMapiError.ErrorCode Property=id_14997 +4 TJclEmail +5 TJclEmail=id_14970 +5 TJclEmail Class +6 TJclEmail Class=id_15000 +6 TJclEmail.Attachments Property=id_15033 +6 TJclEmail.Body Property=id_15034 +6 TJclEmail.FindOptions Property=id_15035 +6 TJclEmail.HtmlBody Property=id_15036 +6 TJclEmail.LogonOptions Property=id_15037 +6 TJclEmail.ParentWnd Property=id_15038 +6 TJclEmail.ReadMsg Property=id_15039 +6 TJclEmail.Recipients Property=id_15041 +6 TJclEmail.SeedMessageID Property=id_15042 +6 TJclEmail.SessionHandle Property=id_15043 +6 TJclEmail.Subject Property=id_15044 +6 TJclEmail.UserLogged Property=id_15045 +6 TJclEmail.Address Method=id_15057 +6 TJclEmail.BeforeUnloadClientLib Method=id_15058 +6 TJclEmail.Clear Method=id_15059 +6 TJclEmail.Create Constructor=id_15060 +6 TJclEmail.DecodeRecips Method=id_15061 +6 TJclEmail.Delete Method=id_15062 +6 TJclEmail.Destroy Destructor=id_15063 +6 TJclEmail.FindFirstMessage Method=id_15064 +6 TJclEmail.FindNextMessage Method=id_15065 +6 TJclEmail.InternalSendOrSave Method=id_15066 +6 TJclEmail.LogOff Method=id_15067 +6 TJclEmail.LogOn Method=id_15068 +6 TJclEmail.LogonOptionsToFlags Method=id_15069 +6 TJclEmail.MessageReport Method=id_15070 +6 TJclEmail.Read Method=id_15040 +6 TJclEmail.ResolveName Method=id_15071 +6 TJclEmail.RestoreTaskWindows Method=id_15072 +6 TJclEmail.Save Method=id_15073 +6 TJclEmail.SaveTaskWindows Method=id_15074 +6 TJclEmail.Send Method=id_15075 +6 TJclEmail.SortAttachments Method=id_15076 +4 TJclEmailRecip +5 TJclEmailRecip=id_14971 +5 TJclEmailRecip Class +6 TJclEmailRecip Class=id_15080 +6 TJclEmailRecip.Address Property=id_15085 +6 TJclEmailRecip.AddressType Property=id_15086 +6 TJclEmailRecip.Kind Property=id_15087 +6 TJclEmailRecip.Name Property=id_15088 +6 TJclEmailRecip.AddressAndName Method=id_15090 +6 TJclEmailRecip.RecipKindToString Method=id_15091 +6 TJclEmailRecip.SortingName Method=id_15092 +4 TJclEmailRecips +5 TJclEmailRecips=id_14972 +5 TJclEmailRecips Class +6 TJclEmailRecips Class=id_15079 +6 TJclEmailRecips.AddressesType Property=id_15100 +6 TJclEmailRecips.Items Property=id_15101 +6 TJclEmailRecips.Originator Property=id_15102 +6 TJclEmailRecips.Add Method=id_15103 +6 TJclEmailRecips.SortRecips Method=id_15104 +4 TJclSimpleMapi +5 TJclSimpleMapi=id_14973 +5 TJclSimpleMapi Class +6 TJclSimpleMapi Class=id_15005 +6 TJclSimpleMapi.AnyClientInstalled Property=id_15007 +6 TJclSimpleMapi.BeforeUnloadClient Property=id_15008 +6 TJclSimpleMapi.ClientConnectKind Property=id_15009 +6 TJclSimpleMapi.ClientCount Property=id_15010 +6 TJclSimpleMapi.Clients Property=id_15011 +6 TJclSimpleMapi.CurrentClientName Property=id_15012 +6 TJclSimpleMapi.DefaultClientIndex Property=id_15013 +6 TJclSimpleMapi.DefaultProfileName Property=id_15014 +6 TJclSimpleMapi.MapiAddress Property=id_15015 +6 TJclSimpleMapi.MapiDeleteMail Property=id_15016 +6 TJclSimpleMapi.MapiDetails Property=id_15017 +6 TJclSimpleMapi.MapiFindNext Property=id_15018 +6 TJclSimpleMapi.MapiFreeBuffer Property=id_15019 +6 TJclSimpleMapi.MapiInstalled Property=id_15020 +6 TJclSimpleMapi.MapiLogOff Property=id_15021 +6 TJclSimpleMapi.MapiLogOn Property=id_15022 +6 TJclSimpleMapi.MapiReadMail Property=id_15023 +6 TJclSimpleMapi.MapiResolveName Property=id_15024 +6 TJclSimpleMapi.MapiSaveMail Property=id_15025 +6 TJclSimpleMapi.MapiSendDocuments Property=id_15026 +6 TJclSimpleMapi.MapiSendMail Property=id_15027 +6 TJclSimpleMapi.MapiVersion Property=id_15028 +6 TJclSimpleMapi.ProfileCount Property=id_15029 +6 TJclSimpleMapi.Profiles Property=id_15030 +6 TJclSimpleMapi.SelectedClientIndex Property=id_15031 +6 TJclSimpleMapi.SimpleMapiInstalled Property=id_15032 +6 TJclSimpleMapi.BeforeUnloadClientLib Method=id_15047 +6 TJclSimpleMapi.CheckListIndex Method=id_15048 +6 TJclSimpleMapi.ClientLibLoaded Method=id_15049 +6 TJclSimpleMapi.Create Constructor=id_15050 +6 TJclSimpleMapi.Destroy Destructor=id_15051 +6 TJclSimpleMapi.GetClientLibName Method=id_15052 +6 TJclSimpleMapi.LoadClientLib Method=id_15053 +6 TJclSimpleMapi.ProfilesRegKey Method=id_15054 +6 TJclSimpleMapi.ReadMapiSettings Method=id_15055 +6 TJclSimpleMapi.UnloadClientLib Method=id_15056 +2 Libraries, Processes and Threads +3 Libraries, Processes and Threads=id_11567 +3 Portable Executable File Format +4 Portable Executable File Format=id_15115 +4 EJclPeImageError Class=id_15137 +4 TJclRebaseImageInfo Record=id_15138 +4 API Hooking +5 API Hooking=id_15120 +5 TJclPeMapImgHookItem +6 TJclPeMapImgHookItem=id_15145 +6 TJclPeMapImgHookItem Class +7 TJclPeMapImgHookItem Class=id_15148 +7 TJclPeMapImgHookItem.BaseAddress Property=id_15156 +7 TJclPeMapImgHookItem.FunctionName Property=id_15157 +7 TJclPeMapImgHookItem.ModuleName Property=id_15158 +7 TJclPeMapImgHookItem.NewAddress Property=id_15159 +7 TJclPeMapImgHookItem.OriginalAddress Property=id_15160 +7 TJclPeMapImgHookItem.Destroy Destructor=id_15162 +7 TJclPeMapImgHookItem.InternalUnhook Method=id_15163 +7 TJclPeMapImgHookItem.Unhook Method=id_15153 +5 TJclPeMapImgHooks +6 TJclPeMapImgHooks=id_15146 +6 TJclPeMapImgHooks Class +7 TJclPeMapImgHooks Class=id_15154 +7 TJclPeMapImgHooks.ItemFromNewAddress Property=id_15171 +7 TJclPeMapImgHooks.ItemFromOriginalAddress Property=id_15172 +7 TJclPeMapImgHooks.Items Property=id_15173 +7 TJclPeMapImgHooks.HookImport Method=id_15174 +7 TJclPeMapImgHooks.IsWin9xDebugThunk Method=id_15175 +7 TJclPeMapImgHooks.ReplaceImport Method=id_15176 +7 TJclPeMapImgHooks.SystemBase Method=id_15177 +7 TJclPeMapImgHooks.UnhookAll Method=id_15178 +7 TJclPeMapImgHooks.UnhookByNewAddress Method=id_15179 +4 Borland Delphi Specific +5 Borland Delphi Specific=id_15121 +5 TJclPeBorImage +6 TJclPeBorImage=id_15182 +6 TJclPeBorImage Class +7 TJclPeBorImage Class=id_4937 +7 TJclPeBorImage.FormCount Property=id_4972 +7 TJclPeBorImage.FormFromName Property=id_4973 +7 TJclPeBorImage.Forms Property=id_4974 +7 TJclPeBorImage.IsBorlandImage Property=id_4975 +7 TJclPeBorImage.IsPackage Property=id_4976 +7 TJclPeBorImage.LibHandle Property=id_4977 +7 TJclPeBorImage.PackageCompilerVersion Property=id_4978 +7 TJclPeBorImage.PackageInfo Property=id_4979 +7 TJclPeBorImage.AfterOpen Method=id_5015 +7 TJclPeBorImage.Clear Method=id_5016 +7 TJclPeBorImage.Create Constructor=id_5017 +7 TJclPeBorImage.CreateFormsList Method=id_5018 +7 TJclPeBorImage.DependedPackages Method=id_5019 +7 TJclPeBorImage.Destroy Destructor=id_5020 +7 TJclPeBorImage.FreeLibHandle Method=id_5021 +5 TJclPePackageInfo +6 TJclPePackageInfo=id_15183 +6 TJclPePackageInfo Class +7 TJclPePackageInfo Class=id_15193 +7 TJclPePackageInfo.Available Property=id_15199 +7 TJclPePackageInfo.Contains Property=id_15200 +7 TJclPePackageInfo.ContainsCount Property=id_15201 +7 TJclPePackageInfo.ContainsFlags Property=id_15203 +7 TJclPePackageInfo.ContainsNames Property=id_15202 +7 TJclPePackageInfo.DcpName Property=id_15205 +7 TJclPePackageInfo.Description Property=id_15206 +7 TJclPePackageInfo.EnsureExtension Property=id_15207 +7 TJclPePackageInfo.Flags Property=id_15204 +7 TJclPePackageInfo.Requires Property=id_15208 +7 TJclPePackageInfo.RequiresCount Property=id_15209 +7 TJclPePackageInfo.RequiresNames Property=id_15210 +7 TJclPePackageInfo.Create Constructor=id_15212 +7 TJclPePackageInfo.Destroy Destructor=id_15213 +7 TJclPePackageInfo.PackageModuleTypeToString Method=id_15214 +7 TJclPePackageInfo.PackageOptionsToString Method=id_15215 +7 TJclPePackageInfo.ProducerToString Method=id_15216 +7 TJclPePackageInfo.ReadPackageInfo Method=id_15217 +7 TJclPePackageInfo.UnitInfoFlagsToString Method=id_15218 +4 Debug Section +5 Debug Section=id_15122 +5 TJclPeDebugList +6 TJclPeDebugList=id_15221 +6 TJclPeDebugList Class +7 TJclPeDebugList Class=id_15223 +7 TJclPeDebugList.Items Property=id_15229 +7 TJclPeDebugList.Create Constructor=id_15231 +7 TJclPeDebugList.CreateList Method=id_15232 +4 Export Section +5 Export Section=id_15123 +5 TJclPeExportSort Enumeration=id_15239 +5 TJclPeExportFuncItem +6 TJclPeExportFuncItem=id_15237 +6 TJclPeExportFuncItem Class +7 TJclPeExportFuncItem Class=id_15243 +7 TJclPeExportFuncItem.Address Property=id_15249 +7 TJclPeExportFuncItem.AddressOrForwardStr Property=id_15250 +7 TJclPeExportFuncItem.ForwardedFuncName Property=id_15251 +7 TJclPeExportFuncItem.ForwardedFuncOrdinal Property=id_15252 +7 TJclPeExportFuncItem.ForwardedLibName Property=id_15253 +7 TJclPeExportFuncItem.ForwardedName Property=id_15254 +7 TJclPeExportFuncItem.Hint Property=id_15256 +7 TJclPeExportFuncItem.IsExportedVariable Property=id_15258 +7 TJclPeExportFuncItem.IsForwarded Property=id_15259 +7 TJclPeExportFuncItem.MappedAddress Property=id_15260 +7 TJclPeExportFuncItem.Name Property=id_15255 +7 TJclPeExportFuncItem.Ordinal Property=id_15261 +7 TJclPeExportFuncItem.ResolveCheck Property=id_15262 +7 TJclPeExportFuncItem.SectionName Property=id_15263 +7 TJclPeExportFuncItem.FindForwardedDotPos Method=id_15265 +5 TJclPeExportFuncList +6 TJclPeExportFuncList=id_15238 +6 TJclPeExportFuncList Class +7 TJclPeExportFuncList Class=id_15268 +7 TJclPeExportFuncList.AnyForwards Property=id_15275 +7 TJclPeExportFuncList.Base Property=id_15276 +7 TJclPeExportFuncList.ExportDir Property=id_15277 +7 TJclPeExportFuncList.ForwardedLibsList Property=id_15278 +7 TJclPeExportFuncList.FunctionCount Property=id_15279 +7 TJclPeExportFuncList.ItemFromAddress Property=id_15280 +7 TJclPeExportFuncList.ItemFromName Property=id_15281 +7 TJclPeExportFuncList.ItemFromOrdinal Property=id_15282 +7 TJclPeExportFuncList.Items Property=id_15257 +7 TJclPeExportFuncList.LastSortDescending Property=id_15283 +7 TJclPeExportFuncList.LastSortType Property=id_15284 +7 TJclPeExportFuncList.Name Property=id_15285 +7 TJclPeExportFuncList.Sorted Property=id_15286 +7 TJclPeExportFuncList.TotalResolveCheck Property=id_15287 +7 TJclPeExportFuncList.CanPerformFastNameSearch Method=id_15289 +7 TJclPeExportFuncList.CheckForwards Method=id_15290 +7 TJclPeExportFuncList.Create Constructor=id_15291 +7 TJclPeExportFuncList.CreateList Method=id_15292 +7 TJclPeExportFuncList.Destroy Destructor=id_15293 +7 TJclPeExportFuncList.ItemName Method=id_15294 +7 TJclPeExportFuncList.OrdinalValid Method=id_15295 +7 TJclPeExportFuncList.PrepareForFastNameSearch Method=id_15296 +7 TJclPeExportFuncList.SmartFindName Method=id_15297 +7 TJclPeExportFuncList.SortList Method=id_15298 +4 Image access under debugger +5 Image access under debugger=id_15124 +5 PeDbgImgNtHeaders Function=id_15302 +5 PeDbgImgLibraryName Function=id_15303 +4 Import Section +5 Import Section=id_15125 +5 TJclPeImportSort Enumeration=id_15309 +5 TJclPeImportLibSort Enumeration=id_15310 +5 TJclPeImportKind Enumeration=id_15312 +5 TJclPeResolveCheck Enumeration=id_15269 +5 TJclPeLinkerProducer Enumeration=id_15313 +5 TJclPeImportFuncItem +6 TJclPeImportFuncItem=id_15306 +6 TJclPeImportFuncItem Class +7 TJclPeImportFuncItem Class=id_15319 +7 TJclPeImportFuncItem.Hint Property=id_15326 +7 TJclPeImportFuncItem.ImportLib Property=id_15327 +7 TJclPeImportFuncItem.IndirectImportName Property=id_15328 +7 TJclPeImportFuncItem.IsByOrdinal Property=id_15329 +7 TJclPeImportFuncItem.Name Property=id_15330 +7 TJclPeImportFuncItem.Ordinal Property=id_15331 +7 TJclPeImportFuncItem.ResolveCheck Property=id_15332 +7 TJclPeImportFuncItem.Destroy Destructor=id_15334 +7 TJclPeImportFuncItem.SetIndirectImportName Method=id_15335 +5 TJclPeImportLibItem +6 TJclPeImportLibItem=id_15307 +6 TJclPeImportLibItem Class +7 TJclPeImportLibItem Class=id_15324 +7 TJclPeImportLibItem.Count Property=id_15345 +7 TJclPeImportLibItem.FileName Property=id_15346 +7 TJclPeImportLibItem.ImportDescriptor Property=id_15347 +7 TJclPeImportLibItem.ImportDirectoryIndex Property=id_15318 +7 TJclPeImportLibItem.ImportKind Property=id_15348 +7 TJclPeImportLibItem.Items Property=id_15343 +7 TJclPeImportLibItem.Name Property=id_15317 +7 TJclPeImportLibItem.OriginalName Property=id_15349 +7 TJclPeImportLibItem.ThunkData Property=id_15350 +7 TJclPeImportLibItem.TotalResolveCheck Property=id_15351 +7 TJclPeImportLibItem.CheckImports Method=id_15353 +7 TJclPeImportLibItem.Create Constructor=id_15342 +7 TJclPeImportLibItem.CreateList Method=id_15354 +7 TJclPeImportLibItem.SortList Method=id_15355 +5 TJclPeImportList +6 TJclPeImportList=id_15308 +6 TJclPeImportList Class +7 TJclPeImportList Class=id_15311 +7 TJclPeImportList.AllItemCount Property=id_15364 +7 TJclPeImportList.AllItems Property=id_15365 +7 TJclPeImportList.FilterModuleName Property=id_15366 +7 TJclPeImportList.Items Property=id_15367 +7 TJclPeImportList.LinkerProducer Property=id_15368 +7 TJclPeImportList.UniqueLibItemCount Property=id_15369 +7 TJclPeImportList.UniqueLibItemFromName Property=id_15371 +7 TJclPeImportList.UniqueLibItems Property=id_15370 +7 TJclPeImportList.UniqueLibNames Property=id_15372 +7 TJclPeImportList.CheckImports Method=id_15374 +7 TJclPeImportList.Create Constructor=id_15375 +7 TJclPeImportList.CreateList Method=id_15376 +7 TJclPeImportList.Destroy Destructor=id_15377 +7 TJclPeImportList.MakeBorlandImportTableForMappedImage Method=id_15378 +7 TJclPeImportList.RefreshAllItems Method=id_15379 +7 TJclPeImportList.SmartFindName Method=id_15380 +7 TJclPeImportList.SortAllItemsList Method=id_15381 +7 TJclPeImportList.SortList Method=id_15382 +7 TJclPeImportList.TryGetNamesForOrdinalImports Method=id_15383 +4 Mapped Image Routines +5 Mapped Image Routines=id_15126 +5 PeMapImgNtHeaders Function=id_15388 +5 PeMapImgLibraryName Function=id_15389 +5 PeMapImgSections Function=id_15390 +5 PeMapImgFindSection Function=id_15391 +5 TJclPeSectionStream +6 TJclPeSectionStream=id_15387 +6 TJclPeSectionStream Class +7 TJclPeSectionStream Class=id_15394 +7 TJclPeSectionStream.Instance Property=id_15400 +7 TJclPeSectionStream.SectionHeader Property=id_15401 +7 TJclPeSectionStream.Create Constructor=id_15403 +7 TJclPeSectionStream.Write Method=id_15404 +4 Miscellaneous +5 Miscellaneous=id_15127 +5 IsValidPeFile Function=id_15407 +5 PeCreateNameHintTable Function=id_15408 +5 PeRebaseImage Function=id_15139 +5 PeUpdateCheckSum Function=id_15409 +4 Name unmangling +5 Name unmangling=id_15128 +5 PeBorUnmangleName Function=id_15416 +5 TJclBorUmDescription Record=id_15419 +5 TJclBorUmSymbolKind Enumeration=id_15413 +5 TJclBorUmSymbolModifier Enumeration=id_7619 +5 TJclBorUmResult Enumeration=id_15414 +5 TJclPeUmResult Enumeration=id_15415 +5 PeIsNameMangled Function=id_15417 +5 PeUnmangleName Function=id_15418 +4 Relocation Section +5 Relocation Section=id_15129 +5 TJclPeRelocation Record=id_15428 +5 TJclPeRelocEntry +6 TJclPeRelocEntry=id_15426 +6 TJclPeRelocEntry Class +7 TJclPeRelocEntry Class=id_15433 +7 TJclPeRelocEntry.Count Property=id_15438 +7 TJclPeRelocEntry.Relocations Property=id_15439 +7 TJclPeRelocEntry.Size Property=id_15440 +7 TJclPeRelocEntry.VirtualAddress Property=id_15432 +5 TJclPeRelocList +6 TJclPeRelocList=id_15427 +6 TJclPeRelocList Class +7 TJclPeRelocList Class=id_15443 +7 TJclPeRelocList.AllItemCount Property=id_15450 +7 TJclPeRelocList.AllItems Property=id_15451 +7 TJclPeRelocList.Items Property=id_15448 +7 TJclPeRelocList.Create Constructor=id_15453 +7 TJclPeRelocList.CreateList Method=id_15454 +4 Resource Section +5 Resource Section=id_15130 +5 TJclPeResourceKind Enumeration=id_6774 +5 TJclPeResourceItem +6 TJclPeResourceItem=id_15459 +6 TJclPeResourceItem Class +7 TJclPeResourceItem Class=id_4918 +7 TJclPeResourceItem.DataEntry Property=id_15471 +7 TJclPeResourceItem.Entry Property=id_15472 +7 TJclPeResourceItem.Image Property=id_15473 +7 TJclPeResourceItem.IsDirectory Property=id_15474 +7 TJclPeResourceItem.IsName Property=id_15475 +7 TJclPeResourceItem.LangID Property=id_15476 +7 TJclPeResourceItem.Level Property=id_15477 +7 TJclPeResourceItem.List Property=id_15478 +7 TJclPeResourceItem.Name Property=id_15479 +7 TJclPeResourceItem.ParameterName Property=id_15480 +7 TJclPeResourceItem.ParentItem Property=id_15481 +7 TJclPeResourceItem.RawEntryData Property=id_15482 +7 TJclPeResourceItem.RawEntryDataSize Property=id_15483 +7 TJclPeResourceItem.ResourceType Property=id_15484 +7 TJclPeResourceItem.ResourceTypeStr Property=id_15485 +7 TJclPeResourceItem.CompareName Method=id_15487 +7 TJclPeResourceItem.Create Constructor=id_15488 +7 TJclPeResourceItem.Destroy Destructor=id_15489 +7 TJclPeResourceItem.Level1Item Method=id_15490 +7 TJclPeResourceItem.OffsetToRawData Method=id_15491 +7 TJclPeResourceItem.SubDirData Method=id_15492 +5 TJclPeResourceList +6 TJclPeResourceList=id_15460 +6 TJclPeResourceList Class +7 TJclPeResourceList Class=id_15495 +7 TJclPeResourceList.Directory Property=id_15501 +7 TJclPeResourceList.Items Property=id_15502 +7 TJclPeResourceList.ParentItem Property=id_15503 +7 TJclPeResourceList.Create Constructor=id_15505 +7 TJclPeResourceList.CreateList Method=id_15506 +7 TJclPeResourceList.FindName Method=id_15507 +5 TJclPeResourceRawStream +6 TJclPeResourceRawStream=id_15461 +6 TJclPeResourceRawStream Class +7 TJclPeResourceRawStream Class=id_15510 +7 TJclPeResourceRawStream.Create Constructor=id_15515 +7 TJclPeResourceRawStream.Write Method=id_15516 +5 TJclPeRootResourceList +6 TJclPeRootResourceList=id_15462 +6 TJclPeRootResourceList Class +7 TJclPeRootResourceList Class=id_15519 +7 TJclPeRootResourceList.ManifestContent Property=id_15525 +7 TJclPeRootResourceList.Destroy Destructor=id_15527 +7 FindResource Method +8 TJclPeRootResourceList.FindResource Method (PChar, PChar)=id_15528 +7 TJclPeRootResourceList.ListResourceNames Method +8 TJclPeRootResourceList.ListResourceNames Method=id_15529 +4 Simple PE Helpers +5 Simple PE Helpers=id_15131 +5 PeDoesExportFunction Function=id_15535 +5 PeIsExportFunctionForwardedEx Function=id_15536 +5 PeIsExportFunctionForwarded Function=id_15537 +5 PeDoesImportFunction Function=id_15538 +5 PeDoesImportLibrary Function=id_15539 +5 PeImportedLibraries Function=id_15540 +5 PeImportedLibrariesArray=id_15532 +5 PeImportedFunctions Function=id_15541 +5 PeImportedFunctionsArray=id_15533 +5 PeExportedFunctions Function=id_15542 +5 PeExportedFunctionsArray=id_15534 +5 PeGetNtHeaders Function=id_15543 +5 PeVerifyCheckSum Function=id_15544 +4 Smart Name Comparison +5 Smart Name Comparison=id_15132 +5 PeStripFunctionAW Function=id_15549 +5 PeSmartFunctionNameSame Function=id_15550 +4 Threaded Search +5 Threaded Search=id_15133 +5 TJclPeNameSearchOption Enumeration=id_15558 +5 TJclPeNameSearchNotifyEvent Type=id_15559 +5 TJclPeNameSearchFoundEvent Type=id_15560 +5 TJclPeNameSearch +6 TJclPeNameSearch=id_15557 +6 TJclPeNameSearch Class +7 TJclPeNameSearch Class=id_15565 +7 TJclPeNameSearch.OnFound Event=id_15570 +7 TJclPeNameSearch.OnProcessFile Event=id_15571 +7 TJclPeNameSearch.CompareName Method=id_15573 +7 TJclPeNameSearch.Create Constructor=id_15574 +7 TJclPeNameSearch.DoFound Method=id_15575 +7 TJclPeNameSearch.DoProcessFile Method=id_15576 +7 TJclPeNameSearch.Execute Method=id_15577 +7 TJclPeNameSearch.Start Method=id_15578 +4 TJclPeImage +5 TJclPeImage=id_15134 +5 TJclPeHeader Enumeration=id_15582 +5 TJclLoadConfig Enumeration=id_15583 +5 TJclPeFileProperties Record=id_15585 +5 TJclPeImageStatus Enumeration=id_15584 +5 TJclPeImage Class +6 TJclPeImage Class=id_2645 +6 TJclPeImage.AttachedImage Property=id_4944 +6 TJclPeImage.CertificateList Property=id_4945 +6 TJclPeImage.CLRHeader Property=id_4946 +6 TJclPeImage.DebugList Property=id_4947 +6 TJclPeImage.Description Property=id_4948 +6 TJclPeImage.Directories Property=id_4949 +6 TJclPeImage.DirectoryExists Property=id_4950 +6 TJclPeImage.ExportList Property=id_4951 +6 TJclPeImage.FileName Property=id_4952 +6 TJclPeImage.FileProperties Property=id_4953 +6 TJclPeImage.HeaderValues Property=id_4954 +6 TJclPeImage.ImageSectionCount Property=id_4955 +6 TJclPeImage.ImageSectionHeaders Property=id_4956 +6 TJclPeImage.ImageSectionNameFromRva Property=id_4957 +6 TJclPeImage.ImageSectionNames Property=id_4958 +6 TJclPeImage.ImportList Property=id_4959 +6 TJclPeImage.LoadConfigValues Property=id_4960 +6 TJclPeImage.LoadedImage Property=id_4961 +6 TJclPeImage.MappedAddress Property=id_4962 +6 TJclPeImage.NoExceptions Property=id_4963 +6 TJclPeImage.OptionalHeader Property=id_4964 +6 TJclPeImage.ReadOnlyAccess Property=id_4965 +6 TJclPeImage.RelocationList Property=id_4966 +6 TJclPeImage.ResourceList Property=id_4967 +6 TJclPeImage.Status Property=id_4968 +6 TJclPeImage.UnusedHeaderBytes Property=id_4969 +6 TJclPeImage.VersionInfo Property=id_4970 +6 TJclPeImage.VersionInfoAvailable Property=id_4971 +6 TJclPeImage.AfterOpen Method=id_4984 +6 TJclPeImage.AttachLoadedModule Method=id_4985 +6 TJclPeImage.CalculateCheckSum Method=id_4986 +6 TJclPeImage.CheckNotAttached Method=id_4987 +6 TJclPeImage.Clear Method=id_4988 +6 TJclPeImage.Create Constructor=id_4989 +6 TJclPeImage.DebugTypeNames Method=id_4990 +6 TJclPeImage.Destroy Destructor=id_4991 +6 TJclPeImage.DirectoryEntryToData Method=id_4992 +6 TJclPeImage.DirectoryNames Method=id_4993 +6 TJclPeImage.ExpandBySearchPath Method=id_4994 +6 TJclPeImage.ExpandModuleName Method=id_4995 +6 TJclPeImage.GetSectionHeader Method=id_4996 +6 TJclPeImage.GetSectionName Method=id_4997 +6 TJclPeImage.HeaderNames Method=id_4998 +6 TJclPeImage.IsBrokenFormat Method=id_4999 +6 TJclPeImage.IsCLR Method=id_5000 +6 TJclPeImage.IsSystemImage Method=id_5001 +6 TJclPeImage.LoadConfigNames Method=id_5002 +6 TJclPeImage.RaiseStatusException Method=id_5003 +6 TJclPeImage.RawToVa Method=id_5004 +6 TJclPeImage.ResourceItemCreate Method=id_5005 +6 TJclPeImage.ResourceListCreate Method=id_5006 +6 TJclPeImage.RvaToSection Method=id_5007 +6 TJclPeImage.RvaToVa Method=id_5008 +6 TJclPeImage.RvaToVaEx Method=id_5009 +6 TJclPeImage.ShortSectionInfo Method=id_5010 +6 TJclPeImage.StampToDateTime Method=id_5011 +6 TJclPeImage.StatusOK Method=id_5012 +6 TJclPeImage.TryGetNamesForOrdinalImports Method=id_5013 +6 TJclPeImage.VerifyCheckSum Method=id_5014 +4 TJclPeImageBaseList +5 TJclPeImageBaseList=id_15135 +5 TJclPeImageBaseList Class +6 TJclPeImageBaseList Class=id_5043 +6 TJclPeImageBaseList.Image Property=id_5045 +6 TJclPeImageBaseList.Create Constructor=id_5048 +4 TJclPeImagesCache +5 TJclPeImagesCache=id_15136 +5 TJclPeImagesCache Class +6 TJclPeImagesCache Class=id_4924 +6 TJclPeImagesCache.Count Property=id_4926 +6 TJclPeImagesCache.Images Property=id_4927 +6 TJclPeImagesCache.Clear Method=id_4930 +6 TJclPeImagesCache.Create Constructor=id_4931 +6 TJclPeImagesCache.Destroy Destructor=id_4932 +6 TJclPeImagesCache.GetPeImageClass Method=id_4933 +3 Synchronization +4 Synchronization=id_15116 +4 Debugging +5 Debugging=id_15621 +5 QueryCriticalSection Function=id_15634 +5 QueryEvent Function=id_15635 +5 QueryTimer Function=id_15636 +5 QuerySemaphore Function=id_15637 +5 QueryMutex Function=id_15638 +4 Locked integer manipulation +5 Locked integer manipulation=id_15622 +5 LockedCompareExchange Function=id_15640 +5 LockedExchangeAdd Function=id_15641 +5 LockedAdd Function=id_15642 +5 LockedExchangeSub Function=id_15643 +5 LockedSub Function=id_15644 +5 LockedExchange Function=id_15645 +5 LockedExchangeInc Function=id_15646 +5 LockedInc Function=id_15647 +5 LockedExchangeDec Function=id_15648 +5 LockedDec Function=id_15649 +4 TJclCriticalSection +5 TJclCriticalSection=id_15623 +5 TJclCriticalSection Class +6 TJclCriticalSection Class=id_4207 +6 TJclCriticalSection.Create Constructor=id_15666 +6 TJclCriticalSection.CreateAndEnter Method=id_15667 +6 TJclCriticalSection.Destroy Destructor=id_15668 +6 TJclCriticalSection.Enter Method=id_15669 +6 TJclCriticalSection.Leave Method=id_15670 +4 TJclCriticalSectionEx +5 TJclCriticalSectionEx=id_15624 +5 TJclCriticalSectionEx Class +6 TJclCriticalSectionEx Class=id_15664 +6 TJclCriticalSectionEx.SpinCount Property=id_15685 +6 TJclCriticalSectionEx.Create Constructor=id_15681 +6 TJclCriticalSectionEx.CreateEx Constructor=id_15682 +6 TJclCriticalSectionEx.GetSpinTimeOut Method=id_15683 +6 TJclCriticalSectionEx.SetSpinTimeOut Method=id_15684 +6 TJclCriticalSectionEx.TryEnter Method=id_15679 +4 TJclDispatcherObject +5 TJclDispatcherObject=id_15625 +5 TJclDispatcherObject Class +6 TJclDispatcherObject Class=id_6970 +6 TJclDispatcherObject.Existed Property=id_15699 +6 TJclDispatcherObject.Handle Property=id_15700 +6 TJclDispatcherObject.Name Property=id_15701 +6 TJclDispatcherObject.Attach Constructor=id_15703 +6 TJclDispatcherObject.Destroy Destructor=id_15704 +6 TJclDispatcherObject.SignalAndWait Method=id_15705 +6 TJclDispatcherObject.WaitAlertable Method=id_15706 +6 TJclDispatcherObject.WaitFor Method=id_15707 +6 TJclDispatcherObject.WaitForever Method=id_15708 +5 TJclWaitResult Enumeration +6 TJclWaitResult Enumeration=id_12886 +4 TJclEvent +5 TJclEvent=id_15626 +5 TJclEvent Class +6 TJclEvent Class=id_12885 +6 TJclEvent.Create Constructor=id_15721 +6 TJclEvent.Open Constructor=id_15722 +6 TJclEvent.Pulse Method=id_15723 +6 TJclEvent.ResetEvent Method=id_15724 +6 TJclEvent.SetEvent Method=id_15725 +4 TJclMeteredSection +5 TJclMeteredSection=id_15627 +5 TJclMeteredSection Class +6 TJclMeteredSection Class=id_15733 +6 TJclMeteredSection.AcquireLock Method=id_15739 +6 TJclMeteredSection.Create Constructor=id_15740 +6 TJclMeteredSection.Destroy Destructor=id_15741 +6 TJclMeteredSection.Enter Method=id_15737 +6 Leave Method +7 TJclMeteredSection.Leave Method (Longint)=id_15742 +6 TJclMeteredSection.Open Constructor +7 TJclMeteredSection.Open Constructor=id_15743 +6 TJclMeteredSection.ReleaseLock Method +7 TJclMeteredSection.ReleaseLock Method=id_15744 +4 TJclMultiReadExclusiveWrite +5 TJclMultiReadExclusiveWrite=id_15628 +5 TJclMultiReadExclusiveWrite Class +6 TJclMultiReadExclusiveWrite Class=id_15747 +6 TJclMultiReadExclusiveWrite.BeginRead Method=id_15751 +6 TJclMultiReadExclusiveWrite.BeginWrite Method=id_15753 +6 TJclMultiReadExclusiveWrite.Create Constructor=id_15756 +6 TJclMultiReadExclusiveWrite.Destroy Destructor=id_15757 +6 TJclMultiReadExclusiveWrite.EndRead Method=id_15752 +6 TJclMultiReadExclusiveWrite.EndWrite Method=id_15754 +6 TJclMultiReadExclusiveWrite.Release Method=id_15758 +4 TJclMutex +5 TJclMutex=id_15629 +5 TJclMutex Class +6 TJclMutex Class=id_15763 +6 TJclMutex.Create Constructor=id_15770 +6 TJclMutex.Open Constructor=id_15771 +6 TJclMutex.Release Method=id_15772 +4 TJclOptex +5 TJclOptex=id_15630 +5 TJclOptex Class +6 TJclOptex Class=id_15697 +6 TJclOptex.Existed Property=id_15780 +6 TJclOptex.Name Property=id_15781 +6 TJclOptex.SpinCount Property=id_15782 +6 TJclOptex.UniProcess Property=id_15783 +6 TJclOptex.Create Constructor=id_15785 +6 TJclOptex.Destroy Destructor=id_15786 +6 TJclOptex.Enter Method=id_15787 +6 TJclOptex.Leave Method=id_15788 +6 TJclOptex.TryEnter Method=id_15789 +4 TJclSemaphore +5 TJclSemaphore=id_15631 +5 TJclSemaphore Class +6 TJclSemaphore Class=id_15792 +6 TJclSemaphore.Create Constructor=id_15799 +6 TJclSemaphore.Open Constructor=id_15800 +6 TJclSemaphore.Release Method=id_15801 +6 TJclSemaphore.ReleasePrev Method=id_15802 +4 TJclWaitableTimer +5 TJclWaitableTimer=id_15632 +5 TJclWaitableTimer Class +6 TJclWaitableTimer Class=id_12884 +6 TJclWaitableTimer.Cancel Method=id_15814 +6 TJclWaitableTimer.Create Constructor=id_15815 +6 TJclWaitableTimer.Open Constructor=id_15816 +6 TJclWaitableTimer.SetTimer Method=id_15817 +6 TJclWaitableTimer.SetTimerApc Method=id_15818 +5 TFNTimerAPCRoutine +6 TFNTimerAPCRoutine=id_6893 +3 Application Instance Management +4 Application Instance Management=id_15117 +4 AI_INSTANCECREATED Constant=id_11253 +4 AI_INSTANCEDESTROYED Constant=id_11254 +4 AI_USERMSG Constant=id_11255 +4 TJclAppInstances Class +5 TJclAppInstances Class=id_11252 +5 TJclAppInstances.AppWnds Property=id_15835 +5 TJclAppInstances.InstanceCount Property=id_15836 +5 TJclAppInstances.InstanceIndex Property=id_15837 +5 TJclAppInstances.MessageID Property=id_15839 +5 TJclAppInstances.ProcessIDs Property=id_15838 +5 TJclAppInstances.BringAppWindowToFront Method=id_15841 +5 TJclAppInstances.CheckInstance Method=id_15831 +5 TJclAppInstances.CheckMultipleInstances Method=id_15842 +5 TJclAppInstances.CheckSingleInstance Method=id_15832 +5 TJclAppInstances.Create Constructor=id_15843 +5 TJclAppInstances.Destroy Destructor=id_15844 +5 TJclAppInstances.GetApplicationWnd Method=id_15845 +5 TJclAppInstances.InitData Method=id_15846 +5 TJclAppInstances.KillInstance Method=id_15847 +5 TJclAppInstances.NotifyInstances Method=id_15848 +5 TJclAppInstances.RemoveInstance Method=id_15849 +5 TJclAppInstances.SendCmdLineParams Method=id_15850 +5 TJclAppInstances.SendData Method=id_15851 +5 TJclAppInstances.SendString Method=id_15852 +5 TJclAppInstances.SendStrings Method=id_15853 +5 TJclAppInstances.SetForegroundWindow98 Method=id_15854 +5 TJclAppInstances.SwitchTo Method=id_15855 +5 TJclAppInstances.UserNotify Method=id_15833 +4 JclAppInstances Function +5 JclAppInstances Function=id_11256 +4 ReadMessageCheck Function +5 ReadMessageCheck Function=id_11257 +4 ReadMessageData Function +5 ReadMessageData Function=id_11258 +4 ReadMessageString Function +5 ReadMessageString Function=id_11259 +4 ReadMessageStrings Function +5 ReadMessageStrings Function=id_11260 +2 Math Routines +3 Math Routines=id_11568 +3 Constants used in JclMath=id_7694 +3 Complex numbers +4 Complex numbers=id_15874 +4 TComplexKind Enumeration=id_15888 +4 TJclComplex +5 TJclComplex=id_15887 +5 TJclComplex Class +6 TJclComplex Class=id_15892 +6 TJclComplex.Angle Property=id_15902 +6 TJclComplex.AsPolarString Property=id_15903 +6 TJclComplex.AsString Property=id_15899 +6 TJclComplex.FracLength Property=id_15904 +6 TJclComplex.ImaginaryPart Property=id_15905 +6 TJclComplex.Radius Property=id_15906 +6 TJclComplex.RealPart Property=id_15907 +6 AbsoluteValue Method +7 TJclComplex.AbsoluteValue Method ()=id_15909 +7 TJclComplex.AbsoluteValue Method (TRectCoord)=id_16009 +6 AbsoluteValueSqr Method +7 TJclComplex.AbsoluteValueSqr Method ()=id_15910 +7 TJclComplex.AbsoluteValueSqr Method (TRectCoord)=id_16010 +6 Assign Method +7 TJclComplex.Assign Method (Float, Float, TComplexKind)=id_15911 +6 TJclComplex.AssignOne Method +7 TJclComplex.AssignOne Method=id_15912 +6 TJclComplex.AssignZero Method +7 TJclComplex.AssignZero Method=id_15913 +6 CAdd Method +7 TJclComplex.CAdd Method (Float, Float, TComplexKind)=id_15897 +6 TJclComplex.CApproxLnGamma Method +7 TJclComplex.CApproxLnGamma Method=id_15914 +6 TJclComplex.CConjugate Method +7 TJclComplex.CConjugate Method=id_15915 +6 TJclComplex.CCos Method +7 TJclComplex.CCos Method=id_15916 +6 TJclComplex.CCosH Method +7 TJclComplex.CCosH Method=id_15917 +6 TJclComplex.CCot Method +7 TJclComplex.CCot Method=id_15918 +6 TJclComplex.CCotH Method +7 TJclComplex.CCotH Method=id_15919 +6 TJclComplex.CCsc Method +7 TJclComplex.CCsc Method=id_15920 +6 TJclComplex.CCscH Method +7 TJclComplex.CCscH Method=id_15921 +6 CDiv Method +7 TJclComplex.CDiv Method (Float, Float, TComplexKind)=id_15922 +6 TJclComplex.CExp Method +7 TJclComplex.CExp Method=id_15923 +6 TJclComplex.CGamma Method +7 TJclComplex.CGamma Method=id_15924 +6 TJclComplex.CI0 Method +7 TJclComplex.CI0 Method=id_15925 +6 TJclComplex.CIntPwr Method +7 TJclComplex.CIntPwr Method=id_15926 +6 TJclComplex.CJ0 Method +7 TJclComplex.CJ0 Method=id_15927 +6 TJclComplex.CLn Method +7 TJclComplex.CLn Method=id_15898 +6 TJclComplex.CLnGamma Method +7 TJclComplex.CLnGamma Method=id_15928 +6 CMul Method +7 TJclComplex.CMul Method (Float, Float, TComplexKind)=id_15929 +6 TJclComplex.CNeg Method +7 TJclComplex.CNeg Method=id_15930 +6 CNewAdd Method +7 TJclComplex.CNewAdd Method (Float, Float, TComplexKind)=id_15931 +6 TJclComplex.CNewApproxLnGamma Method +7 TJclComplex.CNewApproxLnGamma Method=id_15932 +6 TJclComplex.CNewConjugate Method +7 TJclComplex.CNewConjugate Method=id_15933 +6 TJclComplex.CNewCos Method +7 TJclComplex.CNewCos Method=id_15934 +6 TJclComplex.CNewCosH Method +7 TJclComplex.CNewCosH Method=id_15935 +6 TJclComplex.CNewCot Method +7 TJclComplex.CNewCot Method=id_15936 +6 TJclComplex.CNewCotH Method +7 TJclComplex.CNewCotH Method=id_15937 +6 TJclComplex.CNewCsc Method +7 TJclComplex.CNewCsc Method=id_15938 +6 TJclComplex.CNewCscH Method +7 TJclComplex.CNewCscH Method=id_15939 +6 CNewDiv Method +7 TJclComplex.CNewDiv Method (Float, Float, TComplexKind)=id_15940 +6 TJclComplex.CNewExp Method +7 TJclComplex.CNewExp Method=id_15941 +6 TJclComplex.CNewGamma Method +7 TJclComplex.CNewGamma Method=id_15942 +6 TJclComplex.CNewI0 Method +7 TJclComplex.CNewI0 Method=id_15943 +6 TJclComplex.CNewIntPwr Method +7 TJclComplex.CNewIntPwr Method=id_15944 +6 TJclComplex.CNewJ0 Method +7 TJclComplex.CNewJ0 Method=id_15945 +6 TJclComplex.CNewLn Method +7 TJclComplex.CNewLn Method=id_15946 +6 TJclComplex.CNewLnGamma Method +7 TJclComplex.CNewLnGamma Method=id_15947 +6 CNewMul Method +7 TJclComplex.CNewMul Method (Float, Float, TComplexKind)=id_15948 +6 TJclComplex.CNewNeg Method +7 TJclComplex.CNewNeg Method=id_15949 +6 CNewPwr Method +7 TJclComplex.CNewPwr Method (Float, Float, TComplexKind)=id_15950 +6 TJclComplex.CNewRealPwr Method +7 TJclComplex.CNewRealPwr Method=id_15951 +6 TJclComplex.CNewRoot Method +7 TJclComplex.CNewRoot Method=id_15952 +6 TJclComplex.CNewSec Method +7 TJclComplex.CNewSec Method=id_15953 +6 TJclComplex.CNewSecH Method +7 TJclComplex.CNewSecH Method=id_15954 +6 TJclComplex.CNewSin Method +7 TJclComplex.CNewSin Method=id_15955 +6 TJclComplex.CNewSinH Method +7 TJclComplex.CNewSinH Method=id_15956 +6 TJclComplex.CNewSqrt Method +7 TJclComplex.CNewSqrt Method=id_15957 +6 CNewSub Method +7 TJclComplex.CNewSub Method (Float, Float, TComplexKind)=id_15958 +6 TJclComplex.CNewTan Method +7 TJclComplex.CNewTan Method=id_15959 +6 TJclComplex.CNewTanH Method +7 TJclComplex.CNewTanH Method=id_15960 +6 TJclComplex.CoreAdd Method +7 TJclComplex.CoreAdd Method=id_15961 +6 TJclComplex.CoreApproxLnGamma Method +7 TJclComplex.CoreApproxLnGamma Method=id_15962 +6 TJclComplex.CoreCos Method +7 TJclComplex.CoreCos Method=id_15963 +6 TJclComplex.CoreCosH Method +7 TJclComplex.CoreCosH Method=id_15964 +6 TJclComplex.CoreCot Method +7 TJclComplex.CoreCot Method=id_15965 +6 TJclComplex.CoreCotH Method +7 TJclComplex.CoreCotH Method=id_15966 +6 TJclComplex.CoreCsc Method +7 TJclComplex.CoreCsc Method=id_15967 +6 TJclComplex.CoreCscH Method +7 TJclComplex.CoreCscH Method=id_15968 +6 TJclComplex.CoreDiv Method +7 TJclComplex.CoreDiv Method=id_15969 +6 TJclComplex.CoreExp Method +7 TJclComplex.CoreExp Method=id_15970 +6 TJclComplex.CoreGamma Method +7 TJclComplex.CoreGamma Method=id_15971 +6 TJclComplex.CoreI0 Method +7 TJclComplex.CoreI0 Method=id_15972 +6 TJclComplex.CoreIntPwr Method +7 TJclComplex.CoreIntPwr Method=id_15973 +6 TJclComplex.CoreJ0 Method +7 TJclComplex.CoreJ0 Method=id_15974 +6 TJclComplex.CoreLn Method +7 TJclComplex.CoreLn Method=id_15975 +6 TJclComplex.CoreLnGamma Method +7 TJclComplex.CoreLnGamma Method=id_15976 +6 TJclComplex.CoreMul Method +7 TJclComplex.CoreMul Method=id_15977 +6 TJclComplex.CorePwr Method +7 TJclComplex.CorePwr Method=id_15978 +6 TJclComplex.CoreRealPwr Method +7 TJclComplex.CoreRealPwr Method=id_15979 +6 TJclComplex.CoreRoot Method +7 TJclComplex.CoreRoot Method=id_15980 +6 TJclComplex.CoreSec Method +7 TJclComplex.CoreSec Method=id_15981 +6 TJclComplex.CoreSecH Method +7 TJclComplex.CoreSecH Method=id_15982 +6 TJclComplex.CoreSin Method +7 TJclComplex.CoreSin Method=id_15983 +6 TJclComplex.CoreSinH Method +7 TJclComplex.CoreSinH Method=id_15984 +6 TJclComplex.CoreSub Method +7 TJclComplex.CoreSub Method=id_15985 +6 TJclComplex.CoreTan Method +7 TJclComplex.CoreTan Method=id_15986 +6 TJclComplex.CoreTanH Method +7 TJclComplex.CoreTanH Method=id_15987 +6 CPwr Method +7 TJclComplex.CPwr Method (Float, Float, TComplexKind)=id_15988 +6 TJclComplex.CRealPwr Method +7 TJclComplex.CRealPwr Method=id_15989 +6 Create Constructor +7 TJclComplex.Create Constructor ()=id_15900 +6 TJclComplex.CRoot Method +7 TJclComplex.CRoot Method=id_15990 +6 TJclComplex.CSec Method +7 TJclComplex.CSec Method=id_15991 +6 TJclComplex.CSecH Method +7 TJclComplex.CSecH Method=id_15992 +6 TJclComplex.CSin Method +7 TJclComplex.CSin Method=id_15993 +6 TJclComplex.CSinH Method +7 TJclComplex.CSinH Method=id_15994 +6 TJclComplex.CSqrt Method +7 TJclComplex.CSqrt Method=id_15995 +6 CSub Method +7 TJclComplex.CSub Method (Float, Float, TComplexKind)=id_15996 +6 TJclComplex.CTan Method +7 TJclComplex.CTan Method=id_15997 +6 TJclComplex.CTanH Method +7 TJclComplex.CTanH Method=id_15998 +6 TJclComplex.Duplicate Method +7 TJclComplex.Duplicate Method=id_15999 +6 TJclComplex.FormatExtended Method +7 TJclComplex.FormatExtended Method=id_16000 +3 Conversion +4 Conversion=id_15875 +4 DegMinSecToFloat Function=id_16068 +4 FloatToDegMinSec Function=id_16069 +3 CRC +4 CRC=id_15876 +4 CheckCrc32 Function=id_16077 +4 Crc32 Function=id_16078 +4 InitCrc32 Function=id_16079 +4 CheckCrc16 Function=id_16080 +4 Crc16 Function=id_16081 +4 InitCrc16 Function=id_16082 +3 Exponential +4 Exponential=id_15877 +4 Exp Function=id_16024 +4 Power Function=id_16090 +4 PowerInt Function=id_16091 +4 TenToY Function=id_16092 +4 TwoToY Function=id_16093 +3 Float support +4 Float support=id_15878 +4 FloatingPointClass Function=id_16101 +4 GetNaNTag Function=id_16102 +4 IsInfinite Function=id_16103 +4 IsNaN Function=id_16104 +4 MakeQuietNaN Function=id_16105 +4 MakeSignalingNaN Function=id_16106 +4 ModFloat Function=id_16107 +4 RemainderFloat Function=id_16108 +4 FloatsEqual Function=id_16109 +4 SwapFloats Function=id_16110 +4 MinFloat Function=id_16111 +4 MaxFloat Function=id_16112 +4 TFloatingPointClass Enumeration=id_16100 +4 TNaNTag Type=id_104 +4 MineSingleBuffer Function=id_16113 +4 MineDoubleBuffer Function=id_16114 +4 CalcMachineEps Function=id_16115 +4 CalcMachineEpsSingle Function=id_16117 +4 CalcMachineEpsDouble Function=id_16118 +4 CalcMachineEpsExtended Function=id_16119 +4 IsFloatZero Function=id_16120 +4 IsSpecialValue Function=id_16121 +4 SetPrecisionTolerance Function=id_16122 +4 SetPrecisionToleranceToEpsilon Function=id_16123 +4 Epsilon Variable=id_16116 +4 PrecisionTolerance Variable=id_16124 +3 Hardware +4 Hardware=id_15879 +4 T8087Exception Enumeration=id_11228 +4 All8087Exceptions Constant=id_11227 +4 ClearPending8087Exceptions Function=id_11232 +4 GetPending8087Exceptions Function=id_11239 +4 GetMasked8087Exceptions Function=id_11238 +4 SetMasked8087Exceptions Function=id_11245 +4 Mask8087Exceptions Function=id_11240 +4 Unmask8087Exceptions Function=id_11246 +4 T8087Precision Enumeration=id_11230 +4 T8087Rounding Enumeration=id_11231 +4 T8087Infinity Enumeration=id_11229 +4 Set8087Infinity Function=id_11242 +4 Set8087Precision Function=id_11243 +4 Set8087Rounding Function=id_11244 +4 Get8087Infinity Function=id_11234 +4 Get8087Precision Function=id_11235 +4 Get8087Rounding Function=id_11236 +4 Set8087ControlWord Function=id_11241 +4 Get8087ControlWord Function=id_11233 +4 Get8087StatusWord Function=id_11237 +3 Hyperbolic +4 Hyperbolic=id_15880 +4 CosH Function=id_16174 +4 CotH Function=id_16175 +4 CscH Function=id_16176 +4 SecH Function=id_16177 +4 SinH Function=id_16178 +4 TanH Function=id_16179 +4 ArcCosH Function=id_16180 +4 ArcCotH Function=id_16181 +4 ArcCscH Function=id_16182 +4 ArcSecH Function=id_16183 +4 ArcSinH Function=id_16184 +4 ArcTanH Function=id_16185 +3 Logarithmic +4 Logarithmic=id_15881 +4 LogBaseN Function=id_16188 +4 LogBase2 Function=id_16189 +4 LogBase10 Function=id_16190 +3 Miscellaneous +4 Miscellaneous=id_15882 +4 ISqrt Function=id_16195 +4 Pythagoras Function=id_16196 +4 NormalizeAngle Function=id_16197 +4 IsRelativePrime Function=id_16198 +4 LCM Function=id_16199 +4 GCD Function=id_16200 +4 Ceiling Function=id_16201 +4 CommercialRound Function=id_16202 +4 Floor Function=id_16137 +4 Factorial Function=id_16203 +4 Sgn Function=id_16187 +4 Signe Function=id_16204 +4 IsPrimeFactor Function=id_16205 +4 IsPrimeRM Function=id_16206 +4 IsPrimeTD Function=id_16207 +4 PrimeFactors Function=id_16208 +4 SetPrimalityTest Function=id_16209 +4 IsPrime Variable=id_16210 +3 Statistics +4 Statistics=id_15883 +4 ArithmeticMean Function=id_16220 +4 BinomialCoeff Function=id_16221 +4 GeometricMean Function=id_16222 +4 HarmonicMean Function=id_16223 +4 IsPositiveFloatArray Function=id_16224 +4 MaxFloatArray Function=id_16225 +4 MaxFloatArrayIndex Function=id_16226 +4 Median Function=id_16227 +4 MedianUnsorted Function=id_16228 +4 MinFloatArray Function=id_16229 +4 MinFloatArrayIndex Function=id_16230 +4 Permutation Function=id_16231 +4 PopulationVariance Function=id_16232 +4 PopulationVarianceAndMean Function=id_16233 +4 SampleVariance Function=id_16234 +4 SampleVarianceAndMean Function=id_16235 +4 SumFloatArray Function=id_16236 +4 SumSquareDiffFloatArray Function=id_16237 +4 SumSquareFloatArray Function=id_16238 +4 SumPairProductFloatArray Function=id_16239 +3 Transcendental +4 Transcendental=id_15884 +4 Cos Function=id_16025 +4 Cot Function=id_16241 +4 Csc Function=id_16242 +4 Sec Function=id_16243 +4 Sin Function=id_16026 +4 Tan Function=id_16244 +4 ArcCos Function=id_16245 +4 ArcCot Function=id_16246 +4 ArcCsc Function=id_16247 +4 ArcSec Function=id_16248 +4 ArcSin Function=id_16249 +4 ArcTan Function=id_16250 +4 ArcTan2 Function=id_16251 +4 Haversine Function=id_16252 +4 Coversine Function=id_16253 +4 Versine Function=id_16254 +4 SinCos Function=id_16255 +2 Memory, Classes and Objects +3 Memory, Classes and Objects=id_11569 +3 Class Manipulation +4 Class Manipulation=id_16257 +4 DMT +5 DMT=id_16262 +5 GetDynamicMethodCount Function=id_16267 +5 GetDynamicIndexList Function=id_16268 +5 TDynamicIndexList Type=id_16281 +5 GetDynamicAddressList Function=id_16269 +5 TDynamicAddressList Type=id_16282 +5 HasDynamicMethod Function=id_16270 +5 GetDynamicMethod Function=id_16271 +5 GetInitTable Function=id_16272 +5 GetFieldTable Function=id_16273 +5 TFieldTable Record=id_16276 +5 TFieldClassTable Record=id_16277 +5 TFieldEntry Record=id_16278 +5 GetMethodTable Function=id_16274 +5 TMethodTable Record=id_16279 +5 GetMethodEntry Function=id_16275 +5 TMethodEntry Record=id_16280 +4 Miscellanuous +5 Miscellanuous=id_16263 +5 SetClassParent Function=id_16294 +5 GetClassParent Function=id_16295 +5 IsClass Function=id_16296 +5 IsObject Function=id_16297 +4 VMT +5 VMT=id_16264 +5 GetVirtualMethodCount Function=id_16303 +5 GetVirtualMethod Function=id_16304 +5 SetVirtualMethod Function=id_16305 +3 Guards +4 Guards=id_16258 +4 Guard Function=id_16312 +4 GuardGetMem Function=id_16313 +4 GuardAllocMem Function=id_16314 +4 IMultiSafeGuard +5 IMultiSafeGuard=id_16310 +5 IMultiSafeGuard Interface +6 IMultiSafeGuard Interface=id_16319 +6 IMultiSafeGuard.Count Property=id_16330 +6 IMultiSafeGuard.Items Property=id_16331 +6 IMultiSafeGuard.AddItem Method=id_16332 +6 IMultiSafeGuard.FreeItem Method=id_16333 +6 IMultiSafeGuard.GetCount Method=id_16334 +6 IMultiSafeGuard.GetItem Method=id_16335 +6 IMultiSafeGuard.ReleaseItem Method=id_16336 +4 ISafeGuard +5 ISafeGuard=id_16311 +5 ISafeGuard Interface +6 ISafeGuard Interface=id_16318 +6 ISafeGuard.Item Property=id_16347 +6 ISafeGuard.FreeItem Method=id_16348 +6 ISafeGuard.GetItem Method=id_16349 +6 ISafeGuard.ReleaseItem Method=id_16350 +3 Miscellanuous +4 Miscellanuous=id_16259 +4 ClearObjectList Function=id_16353 +4 FreeObjectList Function=id_16354 +3 Pointer manipulation +4 Pointer manipulation=id_16260 +4 SizeOfMem Function=id_16359 +4 FreeAndNil=id_16358 +4 FreeMemAndNil Function=id_16360 +4 GetAndFillMem Function=id_16361 +2 MIME +3 MIME=id_11570 +3 EJclMimeError=id_16366 +3 MimeDecode Function=id_16367 +3 MimeDecodePartial Function=id_16368 +3 MimeDecodePartialEnd Function=id_16369 +3 MimeEncode Function=id_16370 +3 MimeEncodeString Function=id_16371 +3 MimeDecodeString Function=id_16372 +3 MimeEncodeStream Function=id_16373 +3 MimeDecodeStream Function=id_16374 +3 MimeEncodedSize Function=id_16375 +3 MimeDecodedSize Function=id_16376 +2 Miscellaneous +3 Miscellaneous=id_11571 +3 SetDisplayResolution Function=id_16392 +3 CreateProcAsUserEx Function=id_16391 +3 CreateProcAsUser Function=id_16390 +3 EJclCreateProcessError Class=id_16389 +3 LogOffOS Function=id_16393 +3 ExitWindows Function=id_16394 +3 ShutDownOS Function=id_16395 +3 PowerOffOS Function=id_16396 +3 RebootOS Function=id_16397 +2 MultiMedia +3 MultiMedia=id_11572 +3 Audio Mixers=id_16415 +3 MCI +4 MCI=id_16416 +4 GetMciErrorMessage Function=id_16421 +3 MIDI +4 MIDI=id_16417 +4 IJclMIDIOut Interface +5 IJclMIDIOut Interface=id_4618 +5 IJclMIDIOut.ActiveNotes Property=id_4620 +5 IJclMIDIOut.LocalControl Property=id_4621 +5 IJclMIDIOut.MIDIStatus Property=id_4622 +5 IJclMIDIOut.Name Property=id_4623 +5 IJclMIDIOut.RunningStatusEnabled Property=id_4624 +5 IJclMIDIOut.GetMIDIStatus Method=id_4629 +5 IJclMIDIOut.NoteIsOn Method=id_4630 +5 IJclMIDIOut.ResetAllControllers Method=id_4631 +5 IJclMIDIOut.SelectProgram Method=id_4632 +5 IJclMIDIOut.SendBalanceChange Method=id_4633 +5 IJclMIDIOut.SendBalanceChangeHR Method=id_4634 +5 IJclMIDIOut.SendBreathControlChange Method=id_4635 +5 IJclMIDIOut.SendBreathControlChangeHR Method=id_4636 +5 IJclMIDIOut.SendChannelPressure Method=id_4637 +5 IJclMIDIOut.SendChannelVolumeChange Method=id_4638 +5 IJclMIDIOut.SendChannelVolumeChangeHR Method=id_4639 +5 IJclMIDIOut.SendControlChange Method=id_4640 +5 IJclMIDIOut.SendControlChangeHR Method=id_4641 +5 IJclMIDIOut.SendDataEntry Method=id_4642 +5 IJclMIDIOut.SendDataEntryHR Method=id_4643 +5 IJclMIDIOut.SendExpressionChange Method=id_4644 +5 IJclMIDIOut.SendExpressionChangeHR Method=id_4645 +5 IJclMIDIOut.SendFootControllerChange Method=id_4646 +5 IJclMIDIOut.SendFootControllerChangeHR Method=id_4647 +5 IJclMIDIOut.SendMessage Method=id_4648 +5 IJclMIDIOut.SendModulationWheelChange Method=id_4649 +5 IJclMIDIOut.SendModulationWheelChangeHR Method=id_4650 +5 IJclMIDIOut.SendNoteOff Method=id_4651 +5 IJclMIDIOut.SendNoteOn Method=id_4652 +5 IJclMIDIOut.SendPanChange Method=id_4653 +5 IJclMIDIOut.SendPanChangeHR Method=id_4654 +5 IJclMIDIOut.SendPitchWheelChange Method=id_4655 +5 IJclMIDIOut.SendPitchWheelPos Method=id_4656 +5 IJclMIDIOut.SendPolyphonicKeyPressure Method=id_4657 +5 IJclMIDIOut.SendPortamentoTimeChange Method=id_4658 +5 IJclMIDIOut.SendPortamentoTimeChangeHR Method=id_4659 +5 IJclMIDIOut.SendProgramChange Method=id_4660 +5 IJclMIDIOut.SendSingleNoteTuningChange Method=id_4661 +5 IJclMIDIOut.SendSwitchChange Method=id_4662 +5 SwitchActiveNotesOff Method +6 IJclMIDIOut.SwitchActiveNotesOff Method ()=id_4663 +6 IJclMIDIOut.SwitchActiveNotesOff Method (TMIDIChannel)=id_16432 +5 IJclMIDIOut.SwitchAllNotesOff Method +6 IJclMIDIOut.SwitchAllNotesOff Method=id_4664 +5 IJclMIDIOut.SwitchAllSoundOff Method +6 IJclMIDIOut.SwitchAllSoundOff Method=id_4665 +5 IJclMIDIOut.SwitchHold2 Method +6 IJclMIDIOut.SwitchHold2 Method=id_4666 +5 IJclMIDIOut.SwitchLegato Method +6 IJclMIDIOut.SwitchLegato Method=id_4667 +5 IJclMIDIOut.SwitchLocalControl Method +6 IJclMIDIOut.SwitchLocalControl Method=id_4668 +5 IJclMIDIOut.SwitchMonoModeOn Method +6 IJclMIDIOut.SwitchMonoModeOn Method=id_4669 +5 IJclMIDIOut.SwitchOmniModeOff Method +6 IJclMIDIOut.SwitchOmniModeOff Method=id_4670 +5 IJclMIDIOut.SwitchOmniModeOn Method +6 IJclMIDIOut.SwitchOmniModeOn Method=id_4671 +5 IJclMIDIOut.SwitchPolyModeOn Method +6 IJclMIDIOut.SwitchPolyModeOn Method=id_4672 +5 IJclMIDIOut.SwitchPortamento Method +6 IJclMIDIOut.SwitchPortamento Method=id_4673 +5 IJclMIDIOut.SwitchSoftPedal Method +6 IJclMIDIOut.SwitchSoftPedal Method=id_4674 +5 IJclMIDIOut.SwitchSostenuto Method +6 IJclMIDIOut.SwitchSostenuto Method=id_4675 +5 IJclMIDIOut.SwitchSustain Method +6 IJclMIDIOut.SwitchSustain Method=id_4676 +3 Waveform Audio +4 Waveform Audio=id_16418 +3 CD-Drive Functions +4 CD-Drive Functions=id_16419 +4 OpenCloseCdDrive Function=id_16433 +2 Ordinal Math and Logic +3 Ordinal Math and Logic=id_11573 +3 Arithmetic +4 Arithmetic=id_16435 +4 DecLimit Function=id_16439 +4 DecLimitClamp Function=id_16440 +4 IncLimit Function=id_16441 +4 IncLimitClamp Function=id_16442 +4 Max Function=id_16443 +4 Min Function=id_16444 +4 SwapOrd Function=id_16445 +3 Bit Manipulation +4 Bit Manipulation=id_16436 +4 BitsHighest Function=id_16453 +4 BitsLowest Function=id_16454 +4 BitsNeeded Function=id_16455 +4 BitsToBooleans Function=id_16456 +4 BooleansToBits Function=id_16457 +4 ClearBit Function=id_16458 +4 CountBitsCleared Function=id_16459 +4 CountBitsSet Function=id_16460 +4 LRot Function=id_16461 +4 ReverseBits Function=id_16462 +4 ReverseBytes Function=id_16463 +4 RRot Function=id_16464 +4 Sar Function=id_16465 +4 SetBit Function=id_16466 +4 TestBit Function=id_16467 +4 TestBits Function=id_16468 +4 ToggleBit Function=id_16469 +4 Digits Function=id_16470 +3 Conversion +4 Conversion=id_16437 +4 OrdToBinary Function=id_16487 +2 Registry and Ini files +3 Registry and Ini files=id_11574 +3 Ini files +4 Ini files=id_16489 +4 IniWriteBool Function=id_16492 +4 IniWriteInteger Function=id_16493 +4 IniWriteString Function=id_16494 +4 IniReadBool Function=id_16495 +4 IniReadInteger Function=id_16496 +4 IniReadString Function=id_16497 +3 Registry +4 Registry=id_16490 +4 RegCreateKey Function=id_16515 +4 RegWriteBool Function=id_16517 +4 RegWriteCardinal Function=id_16518 +4 RegWriteDWORD Function=id_16519 +4 RegWriteInt64 Function=id_16520 +4 RegWriteInteger Function=id_16521 +4 RegWriteString Function=id_16516 +4 RegWriteUInt64 Function=id_16522 +4 RegWriteWideString Function=id_16523 +4 RegDeleteKeyTree Function=id_16524 +4 RegReadBoolDef Function=id_16525 +4 RegReadIntegerDef Function=id_16526 +4 RegReadStringDef Function=id_16527 +4 RegDeleteEntry Function=id_16528 +4 RegWriteMultiString=id_16506 +4 RegWriteBinary Function=id_16529 +4 RegReadBool Function=id_16530 +4 RegReadInteger Function=id_16531 +4 RegReadString Function=id_16532 +4 RegReadBinary Function=id_16533 +4 RegReadBinaryAsAnsiString=id_16507 +4 RegReadBinaryAsWideString=id_16508 +4 UnregisterAutoExec Function=id_16534 +4 RegisterAutoExec Function=id_16514 +4 TExecKind Enumeration=id_16513 +4 RegGetValueNames Function=id_16535 +4 RegGetKeyNames Function=id_16536 +4 RegHasSubKeys Function=id_16537 +4 RegSaveList Function=id_16538 +4 RegLoadList Function=id_16539 +4 RegDelList Function=id_16540 +4 RegKeyExists Function=id_16541 +4 EJclRegistryError Class=id_16512 +4 RegGetDataSize Function=id_16542 +4 RegGetDataType Function=id_16543 +4 RegReadCardinal Function=id_16544 +4 RegReadInt64 Function=id_16545 +4 RegReadUInt64 Function=id_16546 +4 RegReadAnsiString Function=id_16547 +4 RegReadWideString Function=id_16548 +4 RegReadMultiString=id_16509 +4 RegReadMultiAnsiString=id_16510 +4 RegReadMultiWideString=id_16511 +4 RegReadDWORD Function=id_16549 +2 Runtime Type Information +3 Runtime Type Information=id_11575 +3 Class operator hooking +4 Class operator hooking=id_16579 +4 JclIsClass Function=id_16584 +4 JclIsClassByName Function=id_16585 +3 Conversions +4 Conversions=id_16580 +4 JclSetToList Function=id_16587 +4 JclSetToStr Function=id_16588 +4 JclStrToSet Function=id_16589 +4 JclIntToSet Function=id_16590 +4 JclSetToInt Function=id_16591 +4 JclGUIDToString Function=id_16592 +4 JclStringToGUID Function=id_16593 +4 JclEnumValueToIdent Function=id_16594 +4 JclStrToTypedInt Function=id_16595 +4 JclTypedIntToStr Function=id_16596 +3 RTTI generation +4 RTTI generation=id_16581 +4 JclGenerateSetType Function=id_16599 +4 JclGenerateEnumType Function=id_16600 +4 JclGenerateEnumTypeBasedOn Function=id_8818 +4 JclGenerateSubRange Function=id_16598 +4 RemoveTypeInfo Function=id_16601 +3 RTTI retrieval +4 RTTI retrieval=id_16582 +4 JclTypeInfo Function=id_16617 +4 IJclInfoWriter Interface +5 IJclInfoWriter Interface=id_4361 +5 IJclInfoWriter.Wrap Property=id_4331 +5 IJclInfoWriter.GetWrap Method=id_4337 +5 IJclInfoWriter.Indent Method=id_4338 +5 IJclInfoWriter.Outdent Method=id_4339 +5 IJclInfoWriter.SetWrap Method=id_4340 +5 IJclInfoWriter.Write Method=id_4341 +5 IJclInfoWriter.Writeln Method=id_4342 +4 IJclBaseInfo +5 IJclBaseInfo=id_16604 +5 IJclBaseInfo Interface +6 IJclBaseInfo Interface=id_16629 +6 IJclBaseInfo.DeclarationTo Method=id_16633 +6 IJclBaseInfo.WriteTo Method=id_16634 +4 IJclClassTypeInfo +5 IJclClassTypeInfo=id_16605 +5 TJclPropSpecKind Enumeration=id_16638 +5 IJclClassTypeInfo Interface +6 IJclClassTypeInfo Interface=id_16639 +6 IJclClassTypeInfo.ClassRef Property=id_16664 +6 IJclClassTypeInfo.Parent Property=id_16665 +6 IJclClassTypeInfo.Properties Property=id_16666 +6 IJclClassTypeInfo.PropertyCount Property=id_16667 +6 IJclClassTypeInfo.PropNames Property=id_16668 +6 IJclClassTypeInfo.TotalPropertyCount Property=id_16669 +6 IJclClassTypeInfo.UnitName Property=id_16670 +6 IJclClassTypeInfo.GetClassRef Method=id_16652 +6 IJclClassTypeInfo.GetParent Method=id_16653 +6 IJclClassTypeInfo.GetProperties Method=id_16654 +6 IJclClassTypeInfo.GetPropertyCount Method=id_16655 +6 IJclClassTypeInfo.GetPropNames Method=id_16656 +6 IJclClassTypeInfo.GetTotalPropertyCount Method=id_16657 +6 IJclClassTypeInfo.GetUnitName Method=id_16658 +5 IJclPropInfo +6 IJclPropInfo=id_16637 +6 IJclPropInfo Interface +7 IJclPropInfo Interface=id_16673 +7 IJclPropInfo.Default Property=id_16681 +7 IJclPropInfo.Index Property=id_16682 +7 IJclPropInfo.Name Property=id_16683 +7 IJclPropInfo.NameIndex Property=id_16684 +7 IJclPropInfo.PropType Property=id_16685 +7 IJclPropInfo.Reader Property=id_16686 +7 IJclPropInfo.ReaderType Property=id_16687 +7 IJclPropInfo.ReaderValue Property=id_16688 +7 IJclPropInfo.StoredProc Property=id_16689 +7 IJclPropInfo.StoredType Property=id_16690 +7 IJclPropInfo.StoredValue Property=id_16691 +7 IJclPropInfo.Writer Property=id_16692 +7 IJclPropInfo.WriterType Property=id_16693 +7 IJclPropInfo.WriterValue Property=id_16694 +7 IJclPropInfo.GetDefault Method=id_16695 +7 IJclPropInfo.GetIndex Method=id_16696 +7 IJclPropInfo.GetName Method=id_16697 +7 IJclPropInfo.GetNameIndex Method=id_16698 +7 IJclPropInfo.GetPropType Method=id_16699 +7 IJclPropInfo.GetReader Method=id_16700 +7 IJclPropInfo.GetReaderType Method=id_16701 +7 IJclPropInfo.GetReaderValue Method=id_16702 +7 IJclPropInfo.GetStoredProc Method=id_16703 +7 IJclPropInfo.GetStoredType Method=id_16704 +7 IJclPropInfo.GetStoredValue Method=id_16705 +7 IJclPropInfo.GetWriter Method=id_16706 +7 IJclPropInfo.GetWriterType Method=id_16707 +7 IJclPropInfo.GetWriterValue Method=id_16708 +7 IJclPropInfo.HasDefault Method=id_16709 +7 IJclPropInfo.HasIndex Method=id_16710 +7 IJclPropInfo.IsStored Method=id_16711 +4 IJclDynArrayTypeInfo +5 IJclDynArrayTypeInfo=id_16606 +5 IJclDynArrayTypeInfo Interface +6 IJclDynArrayTypeInfo Interface=id_16719 +6 IJclDynArrayTypeInfo.ElementSize Property=id_16731 +6 IJclDynArrayTypeInfo.ElementsNeedCleanup Property=id_16732 +6 IJclDynArrayTypeInfo.ElementType Property=id_16733 +6 IJclDynArrayTypeInfo.UnitName Property=id_16734 +6 IJclDynArrayTypeInfo.VarType Property=id_16735 +6 IJclDynArrayTypeInfo.GetElementSize Method=id_16725 +6 IJclDynArrayTypeInfo.GetElementsNeedCleanup Method=id_16726 +6 IJclDynArrayTypeInfo.GetElementType Method=id_16727 +6 IJclDynArrayTypeInfo.GetUnitName Method=id_16728 +6 IJclDynArrayTypeInfo.GetVarType Method=id_16729 +4 IJclEnumerationTypeInfo +5 IJclEnumerationTypeInfo=id_16607 +5 IJclEnumerationTypeInfo Interface +6 IJclEnumerationTypeInfo Interface=id_16739 +6 IJclEnumerationTypeInfo.BaseType Property=id_16757 +6 IJclEnumerationTypeInfo.Names Property=id_16758 +6 IJclEnumerationTypeInfo.UnitName Property=id_16759 +6 IJclEnumerationTypeInfo.GetBaseType Method=id_16749 +6 IJclEnumerationTypeInfo.GetNames Method=id_16750 +6 IJclEnumerationTypeInfo.GetUnitName Method=id_16751 +6 IJclEnumerationTypeInfo.IndexOfName Method=id_16752 +4 IJclEventTypeInfo +5 IJclEventTypeInfo=id_16608 +5 IJclEventTypeInfo Interface +6 IJclEventTypeInfo Interface=id_16764 +6 IJclEventTypeInfo.MethodKind Property=id_16776 +6 IJclEventTypeInfo.ParameterCount Property=id_16777 +6 IJclEventTypeInfo.Parameters Property=id_16778 +6 IJclEventTypeInfo.ResultTypeName Property=id_16779 +6 IJclEventTypeInfo.GetMethodKind Method=id_16771 +6 IJclEventTypeInfo.GetParameterCount Method=id_16772 +6 IJclEventTypeInfo.GetParameters Method=id_16773 +6 IJclEventTypeInfo.GetResultTypeName Method=id_16774 +5 IJclEventParamInfo +6 IJclEventParamInfo=id_16763 +6 IJclEventParamInfo Interface +7 IJclEventParamInfo Interface=id_16782 +7 IJclEventParamInfo.Flags Property=id_16790 +7 IJclEventParamInfo.Name Property=id_16791 +7 IJclEventParamInfo.Param Property=id_16792 +7 IJclEventParamInfo.RecSize Property=id_16793 +7 IJclEventParamInfo.TypeName Property=id_16794 +7 IJclEventParamInfo.GetFlags Method=id_16795 +7 IJclEventParamInfo.GetName Method=id_16796 +7 IJclEventParamInfo.GetParam Method=id_16797 +7 IJclEventParamInfo.GetRecSize Method=id_16798 +7 IJclEventParamInfo.GetTypeName Method=id_16799 +4 IJclFloatTypeInfo +5 IJclFloatTypeInfo=id_16609 +5 IJclFloatTypeInfo Interface +6 IJclFloatTypeInfo Interface=id_16803 +6 IJclFloatTypeInfo.FloatType Property=id_16811 +6 IJclFloatTypeInfo.GetFloatType Method=id_16809 +4 IJclInt64TypeInfo +5 IJclInt64TypeInfo=id_16610 +5 IJclInt64TypeInfo Interface +6 IJclInt64TypeInfo Interface=id_16815 +6 IJclInt64TypeInfo.MaxValue Property=id_16824 +6 IJclInt64TypeInfo.MinValue Property=id_16825 +6 IJclInt64TypeInfo.GetMaxValue Method=id_16821 +6 IJclInt64TypeInfo.GetMinValue Method=id_16822 +4 IJclInterfaceTypeInfo +5 IJclInterfaceTypeInfo=id_16611 +5 IJclInterfaceTypeInfo Interface +6 IJclInterfaceTypeInfo Interface=id_16829 +6 IJclInterfaceTypeInfo.Flags Property=id_16842 +6 IJclInterfaceTypeInfo.GUID Property=id_16835 +6 IJclInterfaceTypeInfo.Parent Property=id_16843 +6 IJclInterfaceTypeInfo.PropertyCount Property=id_16844 +6 IJclInterfaceTypeInfo.UnitName Property=id_16845 +6 IJclInterfaceTypeInfo.GetFlags Method=id_16836 +6 IJclInterfaceTypeInfo.GetGUID Method=id_16837 +6 IJclInterfaceTypeInfo.GetParent Method=id_16838 +6 IJclInterfaceTypeInfo.GetPropertyCount Method=id_16839 +6 IJclInterfaceTypeInfo.GetUnitName Method=id_16840 +4 IJclOrdinalRangeTypeInfo +5 IJclOrdinalRangeTypeInfo=id_16612 +5 IJclOrdinalRangeTypeInfo Interface +6 IJclOrdinalRangeTypeInfo Interface=id_16745 +6 IJclOrdinalRangeTypeInfo.MaxValue Property=id_16755 +6 IJclOrdinalRangeTypeInfo.MinValue Property=id_16756 +6 IJclOrdinalRangeTypeInfo.GetMaxValue Method=id_16747 +6 IJclOrdinalRangeTypeInfo.GetMinValue Method=id_16748 +4 IJclOrdinalTypeInfo +5 IJclOrdinalTypeInfo=id_16613 +5 IJclOrdinalTypeInfo Interface +6 IJclOrdinalTypeInfo Interface=id_16854 +6 IJclOrdinalTypeInfo.OrdinalType Property=id_16754 +6 IJclOrdinalTypeInfo.GetOrdinalType Method=id_16746 +4 IJclSetTypeInfo +5 IJclSetTypeInfo=id_16614 +5 IJclSetTypeInfo Interface +6 IJclSetTypeInfo Interface=id_16868 +6 IJclSetTypeInfo.BaseType Property=id_16878 +6 IJclSetTypeInfo.GetAsList Method=id_16874 +6 IJclSetTypeInfo.GetBaseType Method=id_16875 +6 IJclSetTypeInfo.SetAsList Method=id_16876 +4 IJclStringTypeInfo +5 IJclStringTypeInfo=id_16615 +5 IJclStringTypeInfo Interface +6 IJclStringTypeInfo Interface=id_16882 +6 IJclStringTypeInfo.MaxLength Property=id_16890 +6 IJclStringTypeInfo.GetMaxLength Method=id_16888 +4 IJclTypeInfo +5 IJclTypeInfo=id_16616 +5 IJclTypeInfo Interface +6 IJclTypeInfo Interface=id_16622 +6 IJclTypeInfo.Name Property=id_16660 +6 IJclTypeInfo.TypeData Property=id_16661 +6 IJclTypeInfo.TypeInfo Property=id_16662 +6 IJclTypeInfo.TypeKind Property=id_16663 +6 IJclTypeInfo.GetName Method=id_16648 +6 IJclTypeInfo.GetTypeData Method=id_16649 +6 IJclTypeInfo.GetTypeInfo Method=id_16650 +6 IJclTypeInfo.GetTypeKind Method=id_16651 +2 String manipulation +3 String manipulation=id_11576 +3 Character Search and Replace +4 Character Search and Replace=id_16902 +4 CharPos Function=id_6918 +4 CharIPos Function=id_11436 +4 CharReplace Function=id_11452 +3 Character Test Routines +4 Character Test Routines=id_16903 +4 CharEqualNoCase Function=id_11434 +4 CharIsAlpha Function=id_11437 +4 CharIsAlphaNum Function=id_11438 +4 CharIsBlank Function=id_11439 +4 CharIsControl Function=id_11440 +4 CharIsDelete Function=id_11441 +4 CharIsDigit Function=id_11442 +4 CharIsLower Function=id_11443 +4 CharIsNumberChar Function=id_11444 +4 CharIsPrintable Function=id_11445 +4 CharIsPunctuation Function=id_11446 +4 CharIsReturn Function=id_11447 +4 CharIsSpace Function=id_11448 +4 CharIsUpper Function=id_11449 +4 CharIsWhiteSpace Function=id_11450 +4 CharType Function=id_11454 +3 Character Transformation Routines +4 Character Transformation Routines=id_16904 +4 CharHex Function=id_11435 +4 CharLower Function=id_11451 +4 CharUpper Function=id_11455 +4 CharToggleCase Function=id_11453 +3 Miscellaneous +4 Miscellaneous=id_16905 +4 StrWord Function=id_11548 +4 BooleanToStr Function=id_11433 +4 StrTokenToStrings Function=id_11539 +4 StrToken Function=id_11537 +4 StrTokens Function=id_11538 +4 FileToString Function=id_11456 +4 StringToFile Function=id_11487 +4 AnsiSameText=id_16926 +4 StrNormIndex Function=id_11508 +3 MultiSz +4 MultiSz=id_16906 +4 StringsToMultiSz Function=id_11485 +4 MultiSzToStrings Function=id_11458 +4 FreeMultiSz Function=id_11457 +4 StringsToMultiString=id_16933 +4 StringsToMultiWideString=id_16934 +4 MultiStringToStrings=id_16935 +4 MultiWideStringToStrings=id_16936 +3 PCharVector +4 PCharVector=id_16907 +4 StringsToPCharVector Function=id_7308 +4 PCharVectorCount Function=id_7309 +4 PCharVectorToStrings Function=id_7310 +4 FreePCharVector Function=id_7311 +3 String Extraction +4 String Extraction=id_16908 +4 StrAfter Function=id_11460 +4 StrBefore Function=id_11463 +4 StrBetween Function=id_11464 +4 StrChopRight Function=id_11468 +4 StrLeft Function=id_11497 +4 StrMid Function=id_11505 +4 StrRestOf Function=id_11525 +4 StrRight Function=id_11528 +3 String Management +4 String Management=id_16909 +4 StrResetLength Function=id_11524 +4 StrAddRef Function=id_11459 +4 StrAllocSize Function=id_11461 +4 StrDecRef Function=id_11473 +4 StrLen Function=id_11498 +4 StrLength Function=id_11499 +4 StrRefCount Function=id_11517 +3 String Search and Replace Routines +4 String Search and Replace Routines=id_16910 +4 StrCharCount Function=id_11466 +4 StrCompareRange Function=id_11470 +4 StrFillChar Function=id_11480 +4 StrFind Function=id_11481 +4 StrHasPrefix Function=id_11482 +4 StrIndex Function=id_11484 +4 StrILastPos Function=id_11483 +4 StrLastPos Function=id_11496 +4 StrIPos Function=id_11488 +4 StrIsOneOf Function=id_11493 +4 StrNPos Function=id_11509 +4 StrNIPos Function=id_11507 +4 StrMatch Function=id_11503 +4 StrPrefixIndex Function=id_11513 +4 StrSearch Function=id_11530 +4 StrKeepChars Function=id_11495 +4 StrReplace Function=id_11520 +4 StrReplaceChar Function=id_11522 +4 StrReplaceChars Function=id_11523 +4 StrReplaceButChars Function=id_11521 +4 StrStrCount Function=id_11533 +3 String Test Routines +4 String Test Routines=id_16911 +4 StrIsAlpha Function=id_11489 +4 StrIsAlphaNum Function=id_11490 +4 StrIsAlphaNumUnderscore Function=id_11491 +4 StrContainsChars Function=id_11472 +4 StrIsDigit Function=id_11492 +4 StrConsistsOfNumberChars Function=id_11471 +4 StrIsSubset Function=id_11494 +4 StrSame Function=id_11529 +4 StrCompare Function=id_11469 +4 StrMatches Function=id_11504 +3 String Transformation Routines +4 String Transformation Routines=id_16912 +4 StrCenter Function=id_11465 +4 StrDoubleQuote Function=id_11474 +4 StrEnsurePrefix Function=id_11477 +4 StrEnsureNoPrefix Function=id_11475 +4 StrEnsureSuffix Function=id_11478 +4 StrEnsureNoSuffix Function=id_11476 +4 StrEscapedToString Function=id_11479 +4 StrLower Function=id_11500 +4 StrLowerInPlace Function=id_11502 +4 StrLowerBuff Function=id_11501 +4 StrMove Function=id_11506 +4 StrPadLeft Function=id_11511 +4 StrPadRight Function=id_11512 +4 StrProper Function=id_11514 +4 StrProperBuff Function=id_11515 +4 StrQuote Function=id_11516 +4 StrRemoveChars Function=id_11518 +4 StrRepeat Function=id_11519 +4 StrReverse Function=id_11526 +4 StrReverseInPlace Function=id_11527 +4 StrSingleQuote Function=id_11531 +4 StrSmartCase Function=id_11532 +4 StrStringToEscaped Function=id_11534 +4 StrStripNonNumberChars Function=id_11535 +4 StrTrimQuotes Function=id_11544 +4 StrToHex Function=id_11536 +4 StrTrimCharLeft Function=id_11540 +4 StrTrimCharRight Function=id_11541 +4 StrUpper Function=id_11545 +4 StrUpperInPlace Function=id_11547 +4 StrUpperBuff Function=id_11546 +4 StrRepeatLength@AnsiString@Integer=id_16980 +4 StrCharPosLower@AnsiString@Integer=id_16981 +4 StrCharPosUpper@AnsiString@Integer=id_16982 +4 StrTrimCharsLeft Function=id_11542 +4 StrTrimCharsRight Function=id_11543 +4 StrAnsiToOem Function=id_11462 +4 StrOemToAnsi Function=id_11510 +4 StrCharsCount Function=id_11467 +3 TStrings Manipulation +4 TStrings Manipulation=id_16913 +4 StrToStrings Function=id_6928 +4 StringsToStr Function=id_11486 +4 TrimStrings Function=id_11549 +4 TrimStringsRight Function=id_11551 +4 TrimStringsLeft Function=id_11550 +2 System Information Routines +3 System Information Routines=id_11577 +3 RoundToAllocGranularityPtr Function=id_17021 +3 Common Folders +4 Common Folders=id_17012 +4 GetCommonAppdataFolder Function=id_17024 +4 GetCurrentFolder Function=id_17025 +4 GetCommonFilesFolder Function=id_17026 +4 GetProgramFilesFolder Function=id_17027 +4 GetWindowsFolder Function=id_17028 +4 GetWindowsSystemFolder Function=id_17029 +4 GetWindowsTempFolder Function=id_17030 +4 GetDesktopFolder Function=id_17031 +4 GetProgramsFolder Function=id_17032 +4 GetPersonalFolder Function=id_17033 +4 GetFavoritesFolder Function=id_17034 +4 GetStartupFolder Function=id_17035 +4 GetRecentFolder Function=id_17036 +4 GetSendToFolder Function=id_17037 +4 GetStartmenuFolder Function=id_17038 +4 GetDesktopDirectoryFolder Function=id_17039 +4 GetNethoodFolder Function=id_17040 +4 GetFontsFolder Function=id_17041 +4 GetCommonStartmenuFolder Function=id_17042 +4 GetCommonProgramsFolder Function=id_17043 +4 GetCommonStartupFolder Function=id_17044 +4 GetCommonDesktopdirectoryFolder Function=id_17045 +4 GetAppdataFolder Function=id_17046 +4 GetPrinthoodFolder Function=id_17047 +4 GetCommonFavoritesFolder Function=id_17048 +4 GetTemplatesFolder Function=id_17049 +4 GetInternetCacheFolder Function=id_17050 +4 GetCookiesFolder Function=id_17051 +4 GetHistoryFolder Function=id_17052 +3 Environment +4 Environment=id_17013 +4 GetEnvironmentVar Function=id_17083 +4 GetEnvironmentVars Function=id_17084 +4 DelEnvironmentVar Function=id_17085 +4 ExpandEnvironmentVar Function=id_17086 +4 SetEnvironmentVar Function=id_17087 +4 CreateEnvironmentBlock Function=id_16401 +4 TEnvironmentOption Enumeration=id_17082 +3 Hardware +4 Hardware=id_17014 +4 ProcessorCount Variable=id_17112 +4 TestFDIVInstruction Function=id_17101 +4 CPUID Function=id_17102 +4 GetCpuSpeed=id_17100 +4 RoundFrequency Function=id_17103 +4 GetMacAddresses Function=id_17104 +4 ReadTimeStampCounter Function=id_17105 +4 TIntelSpecific Record=id_17108 +4 TCyrixSpecific Record=id_17109 +4 TAMDSpecific Record=id_17110 +4 TCacheInfo Record=id_8703 +4 TFreqInfo Record=id_6492 +4 TCpuInfo Record=id_17111 +4 GetCpuInfo Function=id_17106 +4 GetIntelCacheDescription Function=id_17107 +3 Identification +4 Identification=id_17015 +4 GetVolumeSerialNumber Function=id_17122 +4 GetVolumeFileSystem Function=id_17123 +4 GetVolumeName Function=id_17124 +4 GetIPAddress Function=id_17125 +4 GetLocalComputerName Function=id_17126 +4 GetLocalUserName Function=id_17127 +4 GetRegisteredCompany Function=id_17128 +4 GetRegisteredOwner Function=id_17129 +4 GetBIOSDate Function=id_17130 +4 GetBIOSName Function=id_17131 +4 GetBIOSCopyright Function=id_17132 +4 GetBIOSExtendedInfo Function=id_17133 +4 GetUserDomainName Function=id_17134 +4 GetDomainName Function=id_17135 +3 Keyboard +4 Keyboard=id_17016 +4 GetKeyState Function=id_17147 +4 GetNumLockKeyState Function=id_17148 +4 GetScrollLockKeyState Function=id_17149 +4 GetCapsLockKeyState Function=id_17150 +3 Memory +4 Memory=id_17017 +4 AllocGranularity Variable=id_17167 +4 PageSize Variable=id_17168 +4 GetMaxAppAddress Function=id_17156 +4 GetMinAppAddress Function=id_17157 +4 GetMemoryLoad Function=id_17158 +4 GetSwapFileSize Function=id_17159 +4 GetSwapFileUsage Function=id_17160 +4 GetTotalPhysicalMemory Function=id_17161 +4 GetFreePhysicalMemory Function=id_17162 +4 GetTotalPageFileMemory Function=id_17163 +4 GetFreePageFileMemory Function=id_17164 +4 GetTotalVirtualMemory Function=id_17165 +4 GetFreeVirtualMemory Function=id_17166 +3 Power Management +4 Power Management=id_17018 +4 GetAPMLineStatus Function=id_17184 +4 TAPMLineStatus Enumeration=id_17183 +4 TAPMBatteryFlag Enumeration=id_7539 +4 GetAPMBatteryFlag Function=id_17185 +4 GetAPMBatteryLifePercent Function=id_17186 +4 GetAPMBatteryLifeTime Function=id_17187 +4 GetAPMBatteryFullLifeTime Function=id_17188 +3 Processes, Tasks and Modules +4 Processes, Tasks and Modules=id_17019 +4 RunningProcessesList Function=id_17196 +4 LoadedModulesList Function=id_17197 +4 GetTasksList Function=id_17198 +4 IsWindowResponding Function=id_17199 +4 GetWindowIcon Function=id_17200 +4 TerminateTask Function=id_17201 +4 TerminateApp Function=id_17202 +4 GetProcessNameFromWnd Function=id_17203 +4 GetProcessNameFromPid Function=id_17204 +4 GetShellProcessName Function=id_17205 +4 GetShellProcessHandle Function=id_17206 +4 GetPidFromProcessName Function=id_17207 +3 Version Information +4 Version Information=id_17020 +4 TWindowsVersion Enumeration=id_17216 +4 GetWindowsVersion Function=id_17217 +4 GetOSVersionString Function=id_17218 +4 GetWindowsVersionString Function=id_6547 +4 GetWindowsServicePackVersion Function=id_6546 +4 IsWinXP Variable=id_17222 +4 IsWin95 Variable=id_17223 +4 IsWin95OSR2 Variable=id_17224 +4 IsWin98 Variable=id_17225 +4 IsWin98SE Variable=id_17226 +4 IsWinME Variable=id_17227 +4 IsWinNT Variable=id_17228 +4 IsWinNT3 Variable=id_17229 +4 IsWinNT31 Variable=id_17230 +4 IsWinNT35 Variable=id_17231 +4 IsWinNT351 Variable=id_17232 +4 IsWinNT4 Variable=id_17233 +4 IsWin2K Variable=id_17234 +4 IsWin2003 Variable=id_17235 +4 NtProductType Function=id_17219 +4 NtProductTypeString Function=id_17220 +4 GetOpenGLVersion Function=id_17221 +4 GetOpenGLVersionBitmapRendering=id_17215 +2 Unicode +3 Unicode=id_11578 +3 TCharacterCategory Enumeration=id_7211 +3 UTF7 Type=id_17277 +3 UTF8 Type=id_17278 +3 UTF16 Type=id_17279 +3 UTF32 Type=id_17280 +3 UCS4 Type=id_6959 +3 PUCS2 Type=id_17281 +3 TUcNumber Record=id_17276 +3 TNormalizationForm Enumeration=id_17275 +3 TUnicodeBlock Enumeration=id_6341 +3 Character test routines +4 Character test routines=id_17263 +4 UnicodeIsAlpha Function=id_17293 +4 UnicodeIsDigit Function=id_17294 +4 UnicodeIsAlphaNum Function=id_17295 +4 UnicodeIsControl Function=id_17296 +4 UnicodeIsSpace Function=id_17297 +4 UnicodeIsWhiteSpace Function=id_17298 +4 UnicodeIsBlank Function=id_17299 +4 UnicodeIsPunctuation Function=id_17300 +4 UnicodeIsGraph Function=id_17301 +4 UnicodeIsPrintable Function=id_17302 +4 UnicodeIsUpper Function=id_17303 +4 UnicodeIsLower Function=id_17304 +4 UnicodeIsTitle Function=id_17305 +4 UnicodeIsHexDigit Function=id_17306 +4 UnicodeIsIsoControl Function=id_17307 +4 UnicodeIsFormatControl Function=id_17308 +4 UnicodeIsSymbol Function=id_17309 +4 UnicodeIsNumber Function=id_17310 +4 UnicodeIsNonSpacing Function=id_17311 +4 UnicodeIsOpenPunctuation Function=id_17312 +4 UnicodeIsClosePunctuation Function=id_17313 +4 UnicodeIsInitialPunctuation Function=id_17314 +4 UnicodeIsFinalPunctuation Function=id_17315 +4 UnicodeIsCased Function=id_17316 +4 UnicodeIsComposed Function=id_17317 +4 UnicodeIsQuotationMark Function=id_17318 +4 UnicodeIsSymmetric Function=id_17319 +4 UnicodeIsMirroring Function=id_17320 +4 UnicodeIsNonBreaking Function=id_17321 +4 UnicodeIsMark Function=id_17322 +4 UnicodeIsModifier Function=id_17323 +4 UnicodeIsLetterNumber Function=id_17324 +4 UnicodeIsConnectionPunctuation Function=id_17325 +4 UnicodeIsMath Function=id_17326 +4 UnicodeIsDash Function=id_17327 +4 UnicodeIsCurrency Function=id_17328 +4 UnicodeIsModifierSymbol Function=id_17329 +4 UnicodeIsNonSpacingMark Function=id_17330 +4 UnicodeIsSpacingMark Function=id_17331 +4 UnicodeIsEnclosing Function=id_17332 +4 UnicodeIsPrivate Function=id_17333 +4 UnicodeIsSurrogate Function=id_17334 +4 UnicodeIsLineSeparator Function=id_17335 +4 UnicodeIsParagraphSeparator Function=id_17336 +4 UnicodeIsIdentifierStart Function=id_17337 +4 UnicodeIsIdentifierPart Function=id_17338 +4 UnicodeIsDefined Function=id_17339 +4 UnicodeIsUndefined Function=id_17340 +4 UnicodeIsHan Function=id_17341 +4 UnicodeIsHangul Function=id_17342 +3 Directionality +4 Directionality=id_17264 +4 UnicodeIsRightToLeft Function=id_17344 +4 UnicodeIsLeftToRight Function=id_17345 +4 UnicodeIsStrong Function=id_17346 +4 UnicodeIsWeak Function=id_17347 +4 UnicodeIsNeutral Function=id_17348 +4 UnicodeIsSeparator Function=id_17349 +3 Low level character routines +4 Low level character routines=id_17265 +4 UnicodeNumberLookup Function=id_17290 +4 UnicodeToUpper Function=id_17357 +4 UnicodeToLower Function=id_17358 +4 UnicodeToTitle Function=id_17359 +4 UnicodeComposePair Function=id_17360 +3 Null terminated strings +4 Null terminated strings=id_17266 +4 StrICompW Function=id_17366 +4 StrNewW Function=id_17367 +4 StrScanW Function=id_17368 +4 StrRNScanW Function=id_17369 +4 StrNScanW Function=id_17370 +4 StrSwapByteOrder Function=id_17371 +4 StrDisposeW Function=id_17372 +4 StrAllocW Function=id_17373 +4 StrBufSizeW Function=id_17374 +4 StrPosW Function=id_17375 +4 StrRScanW Function=id_17376 +4 StrLICompW Function=id_17377 +4 StrLCompW Function=id_17378 +4 StrCompW Function=id_17379 +4 StrLCatW Function=id_17380 +4 StrCatW Function=id_17381 +4 StrPLCopyW Function=id_17382 +4 StrPCopyW Function=id_17383 +4 StrLCopyW Function=id_17384 +4 StrECopyW Function=id_17385 +4 StrCopyW Function=id_17386 +4 StrMoveW Function=id_17387 +4 StrEndW Function=id_17388 +4 StrLenW Function=id_17389 +3 TSearchEngine +4 TSearchEngine=id_17267 +4 TSearchFlag Enumeration=id_17405 +4 TSearchEngine Class +5 TSearchEngine Class=id_17404 +5 TSearchEngine.Count Property=id_17415 +5 TSearchEngine.AddResult Method=id_17417 +5 TSearchEngine.Clear Method=id_17418 +5 TSearchEngine.ClearResults Method=id_17419 +5 TSearchEngine.Create Constructor=id_17420 +5 TSearchEngine.DeleteResult Method=id_17421 +5 TSearchEngine.Destroy Destructor=id_17422 +5 FindAll Method +6 TSearchEngine.FindAll Method (PWideChar, Cardinal)=id_17423 +5 FindFirst Method +6 TSearchEngine.FindFirst Method (PWideChar, Cardinal, Cardinal, Cardinal)=id_17424 +5 FindPrepare Method +6 TSearchEngine.FindPrepare Method (PWideChar, Cardinal, TSearchFlags)=id_17425 +5 TSearchEngine.GetCount Method +6 TSearchEngine.GetCount Method=id_17426 +5 TSearchEngine.GetResult Method +6 TSearchEngine.GetResult Method=id_17427 +3 TURESearch +4 TURESearch=id_17268 +4 TURESearch Class +5 TURESearch Class=id_17288 +5 TURESearch.AddEquivalentPair Method=id_17440 +5 TURESearch.AddRange Method=id_17441 +5 TURESearch.AddState Method=id_17442 +5 TURESearch.AddSymbolState Method=id_17443 +5 TURESearch.BuildCharacterClass Method=id_17444 +5 TURESearch.Clear Method=id_17445 +5 TURESearch.ClearDFA Method=id_17446 +5 TURESearch.ClearUREBuffer Method=id_17447 +5 TURESearch.CollectPendingOperations Method=id_17448 +5 TURESearch.CompileSymbol Method=id_17449 +5 TURESearch.CompileURE Method=id_17450 +5 TURESearch.ConvertRegExpToNFA Method=id_17451 +5 TURESearch.ExecuteURE Method=id_17452 +5 FindAll Method +6 TURESearch.FindAll Method (PWideChar, Cardinal)=id_17453 +5 FindFirst Method +6 TURESearch.FindFirst Method (PWideChar, Cardinal, Cardinal, Cardinal)=id_17454 +5 FindPrepare Method +6 TURESearch.FindPrepare Method (PWideChar, Cardinal, TSearchFlags)=id_17455 +5 TURESearch.HexDigitSetup Method +6 TURESearch.HexDigitSetup Method=id_17456 +5 TURESearch.MakeExpression Method +6 TURESearch.MakeExpression Method=id_17457 +5 TURESearch.MakeHexNumber Method +6 TURESearch.MakeHexNumber Method=id_17458 +5 TURESearch.MakeSymbol Method +6 TURESearch.MakeSymbol Method=id_17459 +5 TURESearch.MergeEquivalents Method +6 TURESearch.MergeEquivalents Method=id_17460 +5 TURESearch.ParsePropertyList Method +6 TURESearch.ParsePropertyList Method=id_17461 +5 TURESearch.Peek Method +6 TURESearch.Peek Method=id_17462 +5 TURESearch.Pop Method +6 TURESearch.Pop Method=id_17463 +5 TURESearch.PosixCCL Method +6 TURESearch.PosixCCL Method=id_17464 +5 TURESearch.ProbeLowSurrogate Method +6 TURESearch.ProbeLowSurrogate Method=id_17465 +5 TURESearch.Push Method +6 TURESearch.Push Method=id_17466 +5 TURESearch.Reduce Method +6 TURESearch.Reduce Method=id_17467 +5 TURESearch.SpaceSetup Method +6 TURESearch.SpaceSetup Method=id_17468 +5 TURESearch.SymbolsAreDifferent Method +6 TURESearch.SymbolsAreDifferent Method=id_17469 +3 TUTBMSearch +4 TUTBMSearch=id_17269 +4 TUTBMSearch Class +5 TUTBMSearch Class=id_17430 +5 TUTBMSearch.Clear Method=id_17480 +5 TUTBMSearch.ClearPattern Method=id_17481 +5 TUTBMSearch.Compile Method=id_17482 +5 TUTBMSearch.Find Method=id_17483 +5 FindAll Method +6 TUTBMSearch.FindAll Method (PWideChar, Cardinal)=id_17484 +5 FindFirst Method +6 TUTBMSearch.FindFirst Method (PWideChar, Cardinal, Cardinal, Cardinal)=id_17485 +5 FindPrepare Method +6 TUTBMSearch.FindPrepare Method (PWideChar, Cardinal, TSearchFlags)=id_17486 +5 TUTBMSearch.GetSkipValue Method +6 TUTBMSearch.GetSkipValue Method=id_17487 +5 TUTBMSearch.Match Method +6 TUTBMSearch.Match Method=id_17488 +3 TWideStringList +4 TWideStringList=id_17270 +4 TWideStringList Class +5 TWideStringList Class=id_17495 +5 TWideStringList.Duplicates Property=id_17518 +5 TWideStringList.OnChange Property=id_17519 +5 TWideStringList.OnChanging Property=id_17520 +5 TWideStringList.Sorted Property=id_17521 +5 TWideStringList.Add Method=id_17562 +5 TWideStringList.Changed Method=id_17563 +5 TWideStringList.Changing Method=id_17564 +5 TWideStringList.Clear Method=id_17565 +5 TWideStringList.Delete Method=id_17566 +5 TWideStringList.Destroy Destructor=id_17567 +5 TWideStringList.Exchange Method=id_17568 +5 TWideStringList.Find Method=id_17569 +5 TWideStringList.Get Method=id_17570 +5 TWideStringList.GetCapacity Method=id_17571 +5 TWideStringList.GetCount Method=id_17572 +5 TWideStringList.GetObject Method=id_17573 +5 TWideStringList.IndexOf Method=id_17574 +5 TWideStringList.Insert Method=id_17575 +5 TWideStringList.Put Method=id_17576 +5 TWideStringList.PutObject Method=id_17577 +5 TWideStringList.SetCapacity Method=id_17578 +5 TWideStringList.SetLanguage Method=id_17579 +5 TWideStringList.SetUpdateState Method=id_17580 +5 TWideStringList.Sort Method=id_17502 +4 OnChange +5 OnChange=id_17493 +4 OnChanging +5 OnChanging=id_17494 +3 TWideStrings +4 TWideStrings=id_17271 +4 TWideStrings Class +5 TWideStrings Class=id_6834 +5 TWideStrings.Capacity Property=id_17505 +5 TWideStrings.CommaText Property=id_17506 +5 TWideStrings.Count Property=id_17507 +5 TWideStrings.Language Property=id_17508 +5 TWideStrings.Names Property=id_17509 +5 TWideStrings.NormalizationForm Property=id_17510 +5 TWideStrings.Objects Property=id_17511 +5 TWideStrings.OnConfirmConversion Event=id_17503 +5 TWideStrings.Saved Property=id_17512 +5 TWideStrings.SaveFormat Property=id_17513 +5 TWideStrings.SaveUnicode Property=id_17514 +5 TWideStrings.Strings Property=id_17515 +5 TWideStrings.Text Property=id_17516 +5 TWideStrings.Values Property=id_17517 +5 TWideStrings.Add Method=id_17523 +5 TWideStrings.AddObject Method=id_17524 +5 AddStrings Method +6 TWideStrings.AddStrings Method (TStrings)=id_17525 +5 TWideStrings.Append Method +6 TWideStrings.Append Method=id_17526 +5 TWideStrings.Assign Method +6 TWideStrings.Assign Method=id_17527 +5 TWideStrings.AssignTo Method +6 TWideStrings.AssignTo Method=id_17528 +5 TWideStrings.BeginUpdate Method +6 TWideStrings.BeginUpdate Method=id_17529 +5 TWideStrings.Clear Method +6 TWideStrings.Clear Method=id_17530 +5 TWideStrings.Create Constructor +6 TWideStrings.Create Constructor=id_17531 +5 TWideStrings.DefineProperties Method +6 TWideStrings.DefineProperties Method=id_17532 +5 TWideStrings.Delete Method +6 TWideStrings.Delete Method=id_17533 +5 TWideStrings.DoConfirmConversion Method +6 TWideStrings.DoConfirmConversion Method=id_17534 +5 TWideStrings.EndUpdate Method +6 TWideStrings.EndUpdate Method=id_17535 +5 TWideStrings.Equals Method +6 TWideStrings.Equals Method=id_17536 +5 TWideStrings.Error Method +6 TWideStrings.Error Method=id_17537 +5 TWideStrings.Exchange Method +6 TWideStrings.Exchange Method=id_17538 +5 TWideStrings.Get Method +6 TWideStrings.Get Method=id_17539 +5 TWideStrings.GetCapacity Method +6 TWideStrings.GetCapacity Method=id_17540 +5 TWideStrings.GetCount Method +6 TWideStrings.GetCount Method=id_17541 +5 TWideStrings.GetObject Method +6 TWideStrings.GetObject Method=id_17542 +5 TWideStrings.GetSeparatedText Method +6 TWideStrings.GetSeparatedText Method=id_17543 +5 TWideStrings.GetText Method +6 TWideStrings.GetText Method=id_17544 +5 TWideStrings.GetTextStr Method +6 TWideStrings.GetTextStr Method=id_17545 +5 TWideStrings.IndexOf Method +6 TWideStrings.IndexOf Method=id_17546 +5 TWideStrings.IndexOfName Method +6 TWideStrings.IndexOfName Method=id_17547 +5 TWideStrings.IndexOfObject Method +6 TWideStrings.IndexOfObject Method=id_17548 +5 TWideStrings.Insert Method +6 TWideStrings.Insert Method=id_17549 +5 TWideStrings.InsertObject Method +6 TWideStrings.InsertObject Method=id_17550 +5 TWideStrings.LoadFromFile Method +6 TWideStrings.LoadFromFile Method=id_17551 +5 TWideStrings.LoadFromStream Method +6 TWideStrings.LoadFromStream Method=id_17552 +5 TWideStrings.Move Method +6 TWideStrings.Move Method=id_17553 +5 TWideStrings.Put Method +6 TWideStrings.Put Method=id_17554 +5 TWideStrings.PutObject Method +6 TWideStrings.PutObject Method=id_17555 +5 TWideStrings.SaveToFile Method +6 TWideStrings.SaveToFile Method=id_17556 +5 TWideStrings.SaveToStream Method +6 TWideStrings.SaveToStream Method=id_17557 +5 TWideStrings.SetCapacity Method +6 TWideStrings.SetCapacity Method=id_17558 +5 TWideStrings.SetLanguage Method +6 TWideStrings.SetLanguage Method=id_17559 +5 TWideStrings.SetText Method +6 TWideStrings.SetText Method=id_17560 +5 TWideStrings.SetUpdateState Method +6 TWideStrings.SetUpdateState Method=id_17561 +4 OnConfirmConversion +5 OnConfirmConversion=id_17587 +3 Utility functions +4 Utility functions=id_17272 +4 CharSetFromLocale Function=id_17615 +4 CodePageFromLocale Function=id_17616 +4 CodeBlockFromChar Function=id_17617 +4 KeyboardCodePage Function=id_17618 +4 KeyUnicode Function=id_17619 +4 StringToWideStringEx Function=id_17620 +4 TranslateString Function=id_17621 +4 WideStringToStringEx Function=id_17622 +3 WideString conversion routines +4 WideString conversion routines=id_17273 +4 WideStringToUTF8 Function=id_17629 +4 UTF8ToWideString Function=id_17630 +3 WideString routines +4 WideString routines=id_17274 +4 WideLowerCase Function=id_17635 +4 WideSameText Function=id_17636 +4 WideUpperCase Function=id_17637 +4 WideStringOfChar Function=id_17638 +4 WideQuotedStr Function=id_17639 +4 WideExtractQuotedStr Function=id_17640 +4 WideTrim Function=id_17641 +4 WideTrimRight Function=id_17642 +4 WideTrimLeft Function=id_17643 +4 WideTitleCaseString=id_17634 +4 WideDecompose Function=id_17644 +4 WideCompose Function=id_17645 +4 WideCharPos Function=id_17646 +4 WideAdjustLineBreaks Function=id_17647 +4 WideNormalize Function=id_17292 +4 ExpandANSIString Function=id_17648 +2 Unit Conversions +3 Unit Conversions=id_11579 +3 Angle Conversion +4 Angle Conversion=id_17654 +4 DegToGrad Function=id_17665 +4 DegToRad Function=id_17666 +4 GradToDeg Function=id_17667 +4 GradToRad Function=id_17668 +4 RadToDeg Function=id_17669 +4 RadToGrad Function=id_17670 +4 CycleToDeg Function=id_17671 +4 CycleToGrad Function=id_17672 +4 CycleToRad Function=id_17673 +4 DegToCycle Function=id_17674 +4 GradToCycle Function=id_17675 +4 RadToCycle Function=id_17676 +4 DmsToDeg Function=id_16072 +4 DmsToRad Function=id_16073 +4 DegToDms Function=id_16074 +4 DegToDmsStr Function=id_16075 +3 Coordinate Conversion +4 Coordinate Conversion=id_17655 +4 CartesianToPolar Function=id_17680 +4 PolarToCartesian Function=id_17681 +4 CartesianToCylinder Function=id_17682 +4 CartesianToSpheric Function=id_17683 +4 CylinderToCartesian Function=id_17684 +4 SphericToCartesian Function=id_17685 +3 Length Conversion +4 Length Conversion=id_17656 +4 CmToInch Function=id_17689 +4 InchToCm Function=id_17690 +4 FeetToMetre Function=id_17691 +4 MetreToFeet Function=id_17692 +4 YardToMetre Function=id_17693 +4 MetreToYard Function=id_17694 +4 NmToKm Function=id_17695 +4 KmToNm Function=id_17696 +4 KmToSm Function=id_17697 +4 SmToKm Function=id_17698 +3 Mass Conversion +4 Mass Conversion=id_17657 +4 KgToLb Function=id_17700 +4 KgToKarat Function=id_17701 +4 LbToKg Function=id_17702 +4 KgToOz Function=id_17703 +4 OzToKg Function=id_17704 +4 QrUsToKg Function=id_17705 +4 QrUkToKg Function=id_17706 +4 KaratToKg Function=id_17707 +4 CwtUsToKg Function=id_17708 +4 CwtUkToKg Function=id_17709 +4 StonToKg Function=id_17710 +4 LtonToKg Function=id_17711 +4 KgToCwtUs Function=id_17712 +4 KgToCwtUk Function=id_17713 +4 KgToQrUs Function=id_17714 +4 KgToQrUk Function=id_17715 +4 KgToSton Function=id_17716 +4 KgToLton Function=id_17717 +3 Power +4 Power=id_17658 +4 HpElectricToWatt Function=id_17719 +4 HpMetricToWatt Function=id_17720 +4 WattToHpElectric Function=id_17721 +4 WattToHpMetric Function=id_17722 +3 Pressure Conversion +4 Pressure Conversion=id_17659 +4 PascalToBar Function=id_17724 +4 PascalToAt Function=id_17725 +4 PascalToTorr Function=id_17726 +4 BarToPascal Function=id_17727 +4 AtToPascal Function=id_17728 +4 TorrToPascal Function=id_17729 +3 Temperature Conversion +4 Temperature Conversion=id_17660 +4 CelsiusToKelvin Function=id_17731 +4 CelsiusToFahrenheit Function=id_17732 +4 KelvinToCelsius Function=id_17733 +4 KelvinToFahrenheit Function=id_17734 +4 FahrenheitToCelsius Function=id_17735 +4 FahrenheitToKelvin Function=id_17736 +3 Velocity +4 Velocity=id_17661 +4 KnotToMs Function=id_17738 +4 MsToKnot Function=id_17739 +3 Volume Conversion +4 Volume Conversion=id_17662 +4 LitreToGalUs Function=id_17741 +4 GalUsToLitre Function=id_17742 +4 GalUsToGalCan Function=id_17743 +4 GalCanToGalUs Function=id_17744 +4 GalUsToGalUk Function=id_17745 +4 GalUkToGalUs Function=id_17746 +4 LitreToGalCan Function=id_17747 +4 GalCanToLitre Function=id_17748 +4 LitreToGalUk Function=id_17749 +4 GalUkToLitre Function=id_17750 +3 Volume Conversion +4 Volume Conversion=id_17663 +4 MakePercentage Function=id_17752 +2 Windows +3 Windows=id_5328 +3 Win32 API +4 Win32 API=id_17754 +4 _FILE_ALLOCATED_RANGE_BUFFER Record=id_7230 +4 _DLLVERSIONINFO Record=id_7324 +3 Component Object Model +4 Component Object Model=id_17755 +4 Version Utilities +5 Version Utilities=id_17766 +5 IsDCOMInstalled Function=id_17768 +5 IsDCOMEnabled Function=id_17769 +5 GetDCOMVersion Function=id_17770 +5 GetMDACVersion Function=id_17771 +3 LAN Manager +4 LAN Manager=id_17756 +4 Auxilliary functions +5 Auxilliary functions=id_17776 +5 ParseAccountName Function=id_17780 +5 IsLocalAccount Function=id_17781 +4 Group Management +5 Group Management=id_17777 +5 CreateLocalGroup Function=id_17785 +5 CreateGlobalGroup Function=id_17786 +5 DeleteLocalGroup Function=id_17787 +5 GetLocalGroups Function=id_17788 +5 GetGlobalGroups Function=id_17789 +5 LocalGroupExists Function=id_17790 +5 GlobalGroupExists Function=id_17791 +5 AddAccountToLocalGroup Function=id_17792 +5 LookupGroupName Function=id_17793 +5 TNetWellKnownRID Enumeration=id_17784 +4 User Management +5 User Management=id_17778 +5 CreateAccount Function=id_17805 +5 CreateLocalAccount Function=id_17806 +5 DeleteAccount Function=id_17807 +5 DeleteLocalAccount Function=id_17808 +3 Security +4 Security=id_17757 +4 Access Control +5 Access Control=id_17814 +5 AllowRegKeyForEveryone Function=id_17818 +5 CreateNullDacl Function=id_17819 +5 CreateInheritable Function=id_17820 +4 Account Information +5 Account Information=id_17815 +5 LookupAccountBySid Function=id_17824 +5 QueryTokenInformation Function=id_17825 +5 GetInteractiveUserName Function=id_17826 +4 Privileges +5 Privileges=id_17816 +5 IsPrivilegeEnabled Function=id_17828 +5 EnableProcessPrivilege Function=id_17829 +5 EnableThreadPrivilege Function=id_17830 +5 IsAdministrator Function=id_17831 +5 GetPrivilegeDisplayName Function=id_17832 +5 GetUserObjectName Function=id_17833 +5 SetUserObjectFullAccess Function=id_17834 +3 Shell +4 Shell=id_17758 +4 Files and Folders +5 Files and Folders=id_17839 +5 DisplayPropDialog Function=id_17852 +5 OpenFolder Function=id_17853 +5 OpenSpecialFolder Function=id_17854 +5 SHDeleteFolder Function=id_17850 +5 SHDeleteFiles Function=id_17849 +5 SHRenameFile Function=id_17847 +5 TSHRenameOption Enumeration=id_17846 +5 TSHDeleteOption Enumeration=id_17848 +5 TEnumFolderRec Record=id_6900 +5 TEnumFolderFlag Enumeration=id_6899 +5 SHEnumFolderFirst Function=id_17851 +5 SHEnumFolderClose Function=id_17855 +5 SHEnumFolderNext Function=id_17856 +5 DisplayContextMenuPidl Function=id_17857 +5 DisplayContextMenu Function=id_17858 +4 Memory Management +5 Memory Management=id_17840 +5 SHReallocMem Function=id_17879 +5 SHGetMem Function=id_17880 +5 SHAllocMem Function=id_17881 +5 SHFreeMem Function=id_17882 +4 Miscellaneous +5 Miscellaneous=id_17841 +5 OverlayIcon Function=id_17891 +5 OverlayIconShortCut Function=id_17892 +5 OverlayIconShared Function=id_17872 +5 GetSystemIcon Function=id_17893 +5 SHDllGetVersion Function=id_17765 +5 ShellExec Function=id_17894 +5 ShellExecAndWait Function=id_17895 +5 ShellOpenAs Function=id_17896 +5 ShellRasDial Function=id_17897 +5 ShellRunControlPanel Function=id_17898 +5 TJclFileExeType Enumeration=id_17889 +5 GetFileExeType Function=id_17890 +5 ShellFindExecutable Function=id_17899 +5 SHGetItemInfoTip Function=id_17900 +4 Paths and PIDLs +5 Paths and PIDLs=id_17842 +5 StrRetFreeMem Function=id_17910 +5 StrRetToString Function=id_17911 +5 PidlToPath Function=id_17912 +5 PathToPidl Function=id_17913 +5 PathToPidlBind Function=id_17914 +5 DriveToPidlBind Function=id_17915 +5 PidlBindToParent Function=id_17916 +5 PidlCompare Function=id_17917 +5 PidlCopy Function=id_17918 +5 PidlFree Function=id_17919 +5 PidlGetDepth Function=id_17920 +5 PidlGetLength Function=id_17921 +5 PidlGetNext Function=id_17922 +4 Shortcuts +5 Shortcuts=id_17843 +5 TShellLink Record=id_6896 +5 ShellLinkFree Function=id_17936 +5 ShellLinkResolve Function=id_17937 +5 ShellLinkCreate Function=id_17938 +5 ShellLinkCreateSystem Function=id_17939 +5 ShellLinkGetIcon=id_17935 +3 Windows NT Service control +4 Windows NT Service control=id_17759 +4 TJclServiceType Enumeration=id_7636 +4 TJclServiceState Enumeration=id_6534 +4 TJclServiceStartType Enumeration=id_17954 +4 TJclNtService Class +5 TJclNtService Class=id_17951 +5 TJclNtService.Active Property=id_17970 +5 TJclNtService.ControlsAccepted Property=id_17971 +5 TJclNtService.DependentByServiceCount Property=id_17972 +5 TJclNtService.DependentByServices Property=id_17973 +5 TJclNtService.DependentGroupCount Property=id_17974 +5 TJclNtService.DependentGroups Property=id_17975 +5 TJclNtService.DependentServiceCount Property=id_17976 +5 TJclNtService.DependentServices Property=id_17977 +5 TJclNtService.Description Property=id_17978 +5 TJclNtService.DesiredAccess Property=id_17979 +5 TJclNtService.DisplayName Property=id_17980 +5 TJclNtService.ErrorControlType Property=id_17981 +5 TJclNtService.FileName Property=id_17982 +5 TJclNtService.Group Property=id_17983 +5 TJclNtService.Handle Property=id_17984 +5 TJclNtService.SCManager Property=id_17985 +5 TJclNtService.ServiceName Property=id_17986 +5 TJclNtService.ServiceState Property=id_17987 +5 TJclNtService.ServiceTypes Property=id_17988 +5 TJclNtService.StartType Property=id_17989 +5 TJclNtService.Win32ExitCode Property=id_17990 +5 TJclNtService.Close Method=id_17992 +5 TJclNtService.Commit Method=id_17993 +5 TJclNtService.CommitConfig Method=id_17994 +5 TJclNtService.Continue Method=id_17995 +5 TJclNtService.Controls Method=id_17996 +5 TJclNtService.Create Constructor=id_17997 +5 TJclNtService.Delete Method=id_17998 +5 TJclNtService.Destroy Destructor=id_17999 +5 TJclNtService.GetServiceStatus Method=id_18000 +5 TJclNtService.Open Method=id_18001 +5 TJclNtService.Pause Method=id_18002 +5 TJclNtService.Refresh Method=id_18003 +5 TJclNtService.SetStartType Method=id_18004 +5 Start Method +6 TJclNtService.Start Method (Boolean)=id_18005 +6 TJclNtService.Start Method (array of string, Boolean)=id_18014 +5 TJclNtService.Stop Method +6 TJclNtService.Stop Method=id_18006 +5 TJclNtService.UpdateConfig Method +6 TJclNtService.UpdateConfig Method=id_18007 +5 TJclNtService.UpdateDependents Method +6 TJclNtService.UpdateDependents Method=id_18008 +5 TJclNtService.UpdateDescription Method +6 TJclNtService.UpdateDescription Method=id_18009 +5 TJclNtService.UpdateStatus Method +6 TJclNtService.UpdateStatus Method=id_18010 +5 TJclNtService.WaitFor Method +6 TJclNtService.WaitFor Method=id_18011 +4 TJclServiceGroup Class +5 TJclServiceGroup Class=id_17952 +5 TJclServiceGroup.Name Property=id_18019 +5 TJclServiceGroup.Order Property=id_18020 +5 TJclServiceGroup.SCManager Property=id_18021 +5 TJclServiceGroup.ServiceCount Property=id_18022 +5 TJclServiceGroup.Services Property=id_18023 +5 TJclServiceGroup.Add Method=id_18025 +5 TJclServiceGroup.Create Constructor=id_18026 +5 TJclServiceGroup.Destroy Destructor=id_18027 +5 TJclServiceGroup.Remove Method=id_18028 +4 TJclSCManager Class +5 TJclSCManager Class=id_17953 +5 TJclSCManager.FOrderAsc Field=id_18034 +5 TJclSCManager.FOrderType Field=id_18035 +5 TJclSCManager.Active Property=id_18039 +5 TJclSCManager.AdvApi32Handle Property=id_18040 +5 TJclSCManager.DatabaseName Property=id_18041 +5 TJclSCManager.DesiredAccess Property=id_18042 +5 TJclSCManager.GroupCount Property=id_18043 +5 TJclSCManager.Groups Property=id_18044 +5 TJclSCManager.Handle Property=id_18045 +5 TJclSCManager.MachineName Property=id_18046 +5 TJclSCManager.OrderAsc Property=id_18047 +5 TJclSCManager.OrderType Property=id_18048 +5 TJclSCManager.QueryServiceConfig2A Property=id_18049 +5 TJclSCManager.ServiceCount Property=id_18050 +5 TJclSCManager.Services Property=id_18051 +5 TJclSCManager.AddGroup Method=id_18053 +5 TJclSCManager.AddService Method=id_18054 +5 TJclSCManager.Clear Method=id_18055 +5 TJclSCManager.Close Method=id_18056 +5 ControlAccepted Method +6 TJclSCManager.ControlAccepted Method (DWORD)=id_18057 +6 TJclSCManager.ControlAccepted Method (TJclServiceControlAccepteds)=id_18075 +5 TJclSCManager.Create Constructor +6 TJclSCManager.Create Constructor=id_18058 +5 TJclSCManager.Destroy Destructor +6 TJclSCManager.Destroy Destructor=id_18059 +5 TJclSCManager.FindGroup Method +6 TJclSCManager.FindGroup Method=id_18060 +5 TJclSCManager.FindService Method +6 TJclSCManager.FindService Method=id_18061 +5 TJclSCManager.GetServiceLockStatus Method +6 TJclSCManager.GetServiceLockStatus Method=id_18062 +5 TJclSCManager.Install Method +6 TJclSCManager.Install Method=id_18063 +5 TJclSCManager.IsLocked Method +6 TJclSCManager.IsLocked Method=id_18064 +5 TJclSCManager.Lock Method +6 TJclSCManager.Lock Method=id_18065 +5 TJclSCManager.LockDuration Method +6 TJclSCManager.LockDuration Method=id_18066 +5 TJclSCManager.LockOwner Method +6 TJclSCManager.LockOwner Method=id_18067 +5 TJclSCManager.Open Method +6 TJclSCManager.Open Method=id_18068 +5 TJclSCManager.Refresh Method +6 TJclSCManager.Refresh Method=id_18069 +5 ServiceType Method +6 TJclSCManager.ServiceType Method (DWORD)=id_18070 +6 TJclSCManager.ServiceType Method (TJclServiceTypes)=id_18076 +5 TJclSCManager.Sort Method +6 TJclSCManager.Sort Method=id_18071 +5 TJclSCManager.Unlock Method +6 TJclSCManager.Unlock Method=id_18072 +4 GetServiceStatus Function +5 GetServiceStatus Function=id_17958 +4 GetServiceStatusWaitingIfPending Function +5 GetServiceStatusWaitingIfPending Function=id_17959 +4 TJclServiceSortOrderType Enumeration +5 TJclServiceSortOrderType Enumeration=id_17955 +4 TJclServiceErrorControlType Enumeration +5 TJclServiceErrorControlType Enumeration=id_17956 +4 TJclServiceControlAccepted Enumeration +5 TJclServiceControlAccepted Enumeration=id_17957 +4 TJclServiceControlAccepteds Type +5 TJclServiceControlAccepteds Type=id_17960 +:INCLUDE d7.ohc +:INCLUDE d7.ohi +:INCLUDE d7.ohl diff --git a/official/1.96/include/zconf.h b/official/1.96/include/zconf.h new file mode 100644 index 0000000..940c032 --- /dev/null +++ b/official/1.96/include/zconf.h @@ -0,0 +1,323 @@ +/* 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 + */ + +/* @(#) $Id: zconf.h,v 1.1 2004/05/31 03:53:09 rrossmair Exp $ */ + +#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. + */ +#ifdef Z_PREFIX +# define deflateInit_ z_deflateInit_ +# define deflate z_deflate +# define deflateEnd z_deflateEnd +# define inflateInit_ z_inflateInit_ +# define inflate z_inflate +# define inflateEnd z_inflateEnd +# define deflateInit2_ z_deflateInit2_ +# define deflateSetDictionary z_deflateSetDictionary +# define deflateCopy z_deflateCopy +# define deflateReset z_deflateReset +# define deflatePrime z_deflatePrime +# define deflateParams z_deflateParams +# define deflateBound z_deflateBound +# define inflateInit2_ z_inflateInit2_ +# define inflateSetDictionary z_inflateSetDictionary +# define inflateSync z_inflateSync +# define inflateSyncPoint z_inflateSyncPoint +# define inflateCopy z_inflateCopy +# define inflateReset z_inflateReset +# define compress z_compress +# define compress2 z_compress2 +# define compressBound z_compressBound +# define uncompress z_uncompress +# define adler32 z_adler32 +# define crc32 z_crc32 +# define get_crc_table z_get_crc_table + +# define Byte z_Byte +# define uInt z_uInt +# define uLong z_uLong +# define Bytef z_Bytef +# define charf z_charf +# define intf z_intf +# define uIntf z_uIntf +# define uLongf z_uLongf +# define voidpf z_voidpf +# define voidp z_voidp +#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__)) && !defined(WIN32) +# define WIN32 +#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 + +#if 0 /* HAVE_UNISTD_H -- this line is updated by ./configure */ +# include /* for off_t */ +# include /* for SEEK_* and off_t */ +# ifdef VMS +# include /* for off_t */ +# endif +# define z_off_t off_t +#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(__OS400__) +#define NO_vsnprintf +#endif + +#if defined(__MVS__) +# define NO_vsnprintf +# ifdef FAR +# undef FAR +# endif +#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/official/1.96/include/zlib.h b/official/1.96/include/zlib.h new file mode 100644 index 0000000..d54ac94 --- /dev/null +++ b/official/1.96/include/zlib.h @@ -0,0 +1,1200 @@ +/* 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). +*/ + +#ifndef ZLIB_H +#define ZLIB_H + +#include "zconf.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#define ZLIB_VERSION "1.2.1" +#define ZLIB_VERNUM 0x1210 + +/* + 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. +*/ + +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: ascii or binary */ + uLong adler; /* adler32 value of the uncompressed data */ + uLong reserved; /* reserved for future use */ +} z_stream; + +typedef z_stream FAR *z_streamp; + +/* + 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 /* will be removed, use Z_SYNC_FLUSH instead */ +#define Z_SYNC_FLUSH 2 +#define Z_FULL_FLUSH 3 +#define Z_FINISH 4 +#define Z_BLOCK 5 +/* 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_DEFAULT_STRATEGY 0 +/* compression strategy; see deflateInit2() below for details */ + +#define Z_BINARY 0 +#define Z_ASCII 1 +#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, + 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. + + 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. +*/ + + +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. 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.) +*/ + + +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, 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. +*/ + + +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). + + 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(). +*/ + +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 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(). +*/ + +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 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 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 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(). 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 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 -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.) +*/ + +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 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(). +*/ + +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 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 NULL). +*/ + +/* +ZEXTERN int ZEXPORT inflateBackInit OF((z_stream FAR *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_stream FAR *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 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_stream FAR *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 easily 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. + 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. +*/ + +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 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. +*/ + + +typedef voidp gzFile; + +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", 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). */ + +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 (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. +*/ + +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. + gzread returns the number of uncompressed bytes actually read (0 for + end of file, -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 actually written + (0 in case of error). +*/ + +ZEXTERN int ZEXPORTVA gzprintf OF((gzFile file, const char *format, ...)); +/* + 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. +*/ + +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. The string is then terminated with a null + character. + gzgets returns buf, or Z_NULL in case of error. +*/ + +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 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(). +*/ + +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 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. +*/ + +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. + + gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR) +*/ + +ZEXTERN int ZEXPORT gzeof OF((gzFile file)); +/* + Returns 1 when EOF has previously been detected reading the given + input stream, otherwise zero. +*/ + +ZEXTERN int ZEXPORT gzclose OF((gzFile file)); +/* + 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). +*/ + +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. +*/ + +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 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 crc32 OF((uLong crc, const Bytef *buf, uInt len)); +/* + 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: + */ +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_stream FAR *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)) + + +#if !defined(ZUTIL_H) && !defined(NO_DUMMY_DECL) + struct internal_state {int dummy;}; /* hack for buggy compilers */ +#endif + +ZEXTERN const char * ZEXPORT zError OF((int err)); +ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp z)); +ZEXTERN const uLongf * ZEXPORT get_crc_table OF((void)); + +#ifdef __cplusplus +} +#endif + +#endif /* ZLIB_H */ diff --git a/official/1.96/include/zutil.h b/official/1.96/include/zutil.h new file mode 100644 index 0000000..2c249e6 --- /dev/null +++ b/official/1.96/include/zutil.h @@ -0,0 +1,258 @@ +/* zutil.h -- internal interface and configuration of the compression library + * Copyright (C) 1995-2003 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* WARNING: this file should *not* be used by applications. It is + part of the implementation of the compression library and is + subject to change. Applications should only use zlib.h. + */ + +/* @(#) $Id: zutil.h,v 1.1 2004/05/31 03:53:09 rrossmair Exp $ */ + +#ifndef ZUTIL_H +#define ZUTIL_H + +#define ZLIB_INTERNAL +#include "zlib.h" + +#ifdef STDC +# include +# include +# include +#endif +#ifdef NO_ERRNO_H + extern int errno; +#else +# include +#endif + +#ifndef local +# define local static +#endif +/* compile with -Dlocal if your debugger can't find static symbols */ + +typedef unsigned char uch; +typedef uch FAR uchf; +typedef unsigned short ush; +typedef ush FAR ushf; +typedef unsigned long ulg; + +extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ +/* (size given to avoid silly warnings with Visual C++) */ + +#define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)] + +#define ERR_RETURN(strm,err) \ + return (strm->msg = (char*)ERR_MSG(err), (err)) +/* To be used only when the state is known to be valid */ + + /* common constants */ + +#ifndef DEF_WBITS +# define DEF_WBITS MAX_WBITS +#endif +/* default windowBits for decompression. MAX_WBITS is for compression only */ + +#if MAX_MEM_LEVEL >= 8 +# define DEF_MEM_LEVEL 8 +#else +# define DEF_MEM_LEVEL MAX_MEM_LEVEL +#endif +/* default memLevel */ + +#define STORED_BLOCK 0 +#define STATIC_TREES 1 +#define DYN_TREES 2 +/* The three kinds of block type */ + +#define MIN_MATCH 3 +#define MAX_MATCH 258 +/* The minimum and maximum match lengths */ + +#define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */ + + /* target dependencies */ + +#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32)) +# define OS_CODE 0x00 +# if defined(__TURBOC__) || defined(__BORLANDC__) +# if(__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__)) + /* Allow compilation with ANSI keywords only enabled */ + void _Cdecl farfree( void *block ); + void *_Cdecl farmalloc( unsigned long nbytes ); +# else +# include +# endif +# else /* MSC or DJGPP */ +# include +# endif +#endif + +#ifdef AMIGA +# define OS_CODE 0x01 +#endif + +#if defined(VAXC) || defined(VMS) +# define OS_CODE 0x02 +# define F_OPEN(name, mode) \ + fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512") +#endif + +#if defined(ATARI) || defined(atarist) +# define OS_CODE 0x05 +#endif + +#ifdef OS2 +# define OS_CODE 0x06 +#endif + +#if defined(MACOS) || defined(TARGET_OS_MAC) +# define OS_CODE 0x07 +# if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os +# include /* for fdopen */ +# else +# ifndef fdopen +# define fdopen(fd,mode) NULL /* No fdopen() */ +# endif +# endif +#endif + +#ifdef TOPS20 +# define OS_CODE 0x0a +#endif + +#ifdef WIN32 +# ifndef __CYGWIN__ /* Cygwin is Unix, not Win32 */ +# define OS_CODE 0x0b +# endif +#endif + +#ifdef __50SERIES /* Prime/PRIMOS */ +# define OS_CODE 0x0f +#endif + +#if defined(_BEOS_) || defined(RISCOS) +# define fdopen(fd,mode) NULL /* No fdopen() */ +#endif + +#if (defined(_MSC_VER) && (_MSC_VER > 600)) +# if defined(_WIN32_WCE) +# define fdopen(fd,mode) NULL /* No fdopen() */ +# ifndef _PTRDIFF_T_DEFINED + typedef int ptrdiff_t; +# define _PTRDIFF_T_DEFINED +# endif +# else +# define fdopen(fd,type) _fdopen(fd,type) +# endif +#endif + + /* common defaults */ + +#ifndef OS_CODE +# define OS_CODE 0x03 /* assume Unix */ +#endif + +#ifndef F_OPEN +# define F_OPEN(name, mode) fopen((name), (mode)) +#endif + + /* functions */ + +#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550) +# ifndef HAVE_VSNPRINTF +# define HAVE_VSNPRINTF +# endif +#endif +#if defined(__CYGWIN__) +# ifndef HAVE_VSNPRINTF +# define HAVE_VSNPRINTF +# endif +#endif +#ifndef HAVE_VSNPRINTF +# ifdef MSDOS + /* vsnprintf may exist on some MS-DOS compilers (DJGPP?), + but for now we just assume it doesn't. */ +# define NO_vsnprintf +# endif +# ifdef __TURBOC__ +# define NO_vsnprintf +# endif +# ifdef WIN32 + /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */ +# if !defined(vsnprintf) && !defined(NO_vsnprintf) +# define vsnprintf _vsnprintf +# endif +# endif +# ifdef __SASC +# define NO_vsnprintf +# endif +#endif + +#ifdef HAVE_STRERROR + extern char *strerror OF((int)); +# define zstrerror(errnum) strerror(errnum) +#else +# define zstrerror(errnum) "" +#endif + +#if defined(pyr) +# define NO_MEMCPY +#endif +#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__) + /* Use our own functions for small and medium model with MSC <= 5.0. + * You may have to use the same strategy for Borland C (untested). + * The __SC__ check is for Symantec. + */ +# define NO_MEMCPY +#endif +#if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY) +# define HAVE_MEMCPY +#endif +#ifdef HAVE_MEMCPY +# ifdef SMALL_MEDIUM /* MSDOS small or medium model */ +# define zmemcpy _fmemcpy +# define zmemcmp _fmemcmp +# define zmemzero(dest, len) _fmemset(dest, 0, len) +# else +# define zmemcpy memcpy +# define zmemcmp memcmp +# define zmemzero(dest, len) memset(dest, 0, len) +# endif +#else + extern void zmemcpy OF((Bytef* dest, const Bytef* source, uInt len)); + extern int zmemcmp OF((const Bytef* s1, const Bytef* s2, uInt len)); + extern void zmemzero OF((Bytef* dest, uInt len)); +#endif + +/* Diagnostic functions */ +#ifdef DEBUG +# include + extern int z_verbose; + extern void z_error OF((char *m)); +# define Assert(cond,msg) {if(!(cond)) z_error(msg);} +# define Trace(x) {if (z_verbose>=0) fprintf x ;} +# define Tracev(x) {if (z_verbose>0) fprintf x ;} +# define Tracevv(x) {if (z_verbose>1) fprintf x ;} +# define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;} +# define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;} +#else +# define Assert(cond,msg) +# define Trace(x) +# define Tracev(x) +# define Tracevv(x) +# define Tracec(c,x) +# define Tracecv(c,x) +#endif + + +voidpf zcalloc OF((voidpf opaque, unsigned items, unsigned size)); +void zcfree OF((voidpf opaque, voidpf ptr)); + +#define ZALLOC(strm, items, size) \ + (*((strm)->zalloc))((strm)->opaque, (items), (size)) +#define ZFREE(strm, addr) (*((strm)->zfree))((strm)->opaque, (voidpf)(addr)) +#define TRY_FREE(s, p) {if (p) ZFREE(s, p);} + +#endif /* ZUTIL_H */ diff --git a/official/1.96/install.sh b/official/1.96/install.sh new file mode 100644 index 0000000..d38f24c --- /dev/null +++ b/official/1.96/install.sh @@ -0,0 +1,19 @@ +#!/bin/sh +# +# shell script to build and execute QJediInstaller +# +# Robert Rossmair, 2004-06-12 +# + +eval `grep 'DelphiRoot=' ~/.borland/delphi69rc` +DCC=$DelphiRoot/bin/dcc\ -E../bin\ -I../source\ -R$DelphiRoot/lib\ -U../source/common +source "$DelphiRoot/bin/kylixpath" +cd install +if [ -f ../devtools/jpp ]; then + cd prototypes + ./jpp.sh + cd .. +fi +$DCC QJediInstaller.dpr # build... +../bin/QJediInstaller # ...and run installer +rm *.dcu # clean up source directories diff --git a/official/1.96/install/BCB5-dcc32.cfg.mak b/official/1.96/install/BCB5-dcc32.cfg.mak new file mode 100644 index 0000000..880c971 --- /dev/null +++ b/official/1.96/install/BCB5-dcc32.cfg.mak @@ -0,0 +1,26 @@ +#--------------------------------------------------------------------------------------------------# +# # +# JCL Install Helper for BCB 5 # +# # +# Fixes problem with missing AccCtrl.dcu: # +# if Bin\dcc32.cfg does not exist, creates it & adds library paths. # +# if Bin\dcc32.cfg doesn't contain -LU"$(ROOT)\Lib\Obj\vcl50.dcp", inserts it. # +# # +# Robert Rossmair, 2004-06-10 # +# # +#--------------------------------------------------------------------------------------------------# + +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#--------------------------------------------------------------------------------------------------- +DccCfg = $(MAKEDIR)\dcc32.cfg + +$(ROOT)\Lib\Obj\AccCtrl.dcu: + @if exist $(DccCfg) (if not exist $(DccCfg).bak copy $(DccCfg) $(DccCfg).bak) else echo -u"$(ROOT)\Lib";"$(ROOT)\Lib\Obj" > $(DccCfg) + @if not exist "$(ROOT)\Lib\Obj\vcl50.dcp" goto Finis + -@$(MAKEDIR)\grep -i+ vcl50 $(DccCfg) + @if errorlevel 1 echo -LUvcl50 >> $(DccCfg) + @:Finis + +.precious: $(ROOT)\Lib\Obj\AccCtrl.dcu \ No newline at end of file diff --git a/official/1.96/install/FrmCompile.dfm b/official/1.96/install/FrmCompile.dfm new file mode 100644 index 0000000..b3421a1 --- /dev/null +++ b/official/1.96/install/FrmCompile.dfm @@ -0,0 +1,211 @@ +object FormCompile: TFormCompile + Left = 348 + Top = 311 + BorderIcons = [] + BorderStyle = bsDialog + Caption = 'Compiling' + ClientHeight = 165 + ClientWidth = 361 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + OnCloseQuery = FormCloseQuery + PixelsPerInch = 96 + TextHeight = 13 + object PanelClient: TPanel + Left = 8 + Top = 5 + Width = 345 + Height = 124 + TabOrder = 1 + object BevelProject: TBevel + Left = 10 + Top = 6 + Width = 324 + Height = 19 + end + object BevelStatus: TBevel + Left = 10 + Top = 30 + Width = 324 + Height = 19 + end + object BevelCurrentLine: TBevel + Left = 10 + Top = 54 + Width = 160 + Height = 19 + end + object BevelHints: TBevel + Left = 10 + Top = 78 + Width = 105 + Height = 19 + end + object LblProject: TLabel + Left = 64 + Top = 9 + Width = 265 + Height = 13 + AutoSize = False + Caption = 'Project filename' + Transparent = True + end + object LblStatusCaption: TLabel + Left = 14 + Top = 33 + Width = 29 + Height = 13 + Caption = 'Done:' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + end + object BevelTotalLines: TBevel + Left = 174 + Top = 54 + Width = 160 + Height = 19 + end + object LblCurrentLineCaption: TLabel + Left = 14 + Top = 57 + Width = 56 + Height = 13 + Caption = 'Current line:' + end + object LblCurrentLine: TLabel + Left = 158 + Top = 57 + Width = 6 + Height = 13 + Alignment = taRightJustify + Caption = '0' + end + object LblTotalLinesCaption: TLabel + Left = 178 + Top = 57 + Width = 51 + Height = 13 + Caption = 'Total lines:' + end + object LblTotalLines: TLabel + Left = 322 + Top = 57 + Width = 6 + Height = 13 + Alignment = taRightJustify + Caption = '0' + end + object BevelWarnings: TBevel + Left = 120 + Top = 78 + Width = 105 + Height = 19 + end + object BevelErrors: TBevel + Left = 230 + Top = 78 + Width = 104 + Height = 19 + end + object LblHintsCaption: TLabel + Left = 14 + Top = 81 + Width = 27 + Height = 13 + Caption = 'Hints:' + end + object LblHints: TLabel + Left = 104 + Top = 81 + Width = 6 + Height = 13 + Alignment = taRightJustify + Caption = '0' + end + object LblWarningsCaption: TLabel + Left = 124 + Top = 81 + Width = 48 + Height = 13 + Caption = 'Warnings:' + end + object LblWarnings: TLabel + Left = 213 + Top = 81 + Width = 6 + Height = 13 + Alignment = taRightJustify + Caption = '0' + end + object LblErrorsCaption: TLabel + Left = 234 + Top = 81 + Width = 30 + Height = 13 + Caption = 'Errors:' + end + object LblErrors: TLabel + Left = 322 + Top = 81 + Width = 6 + Height = 13 + Alignment = taRightJustify + Caption = '0' + end + object LblProjectCaption: TLabel + Left = 14 + Top = 9 + Width = 36 + Height = 13 + Caption = 'Project:' + end + object LblStatus: TLabel + Left = 110 + Top = 33 + Width = 78 + Height = 13 + Caption = 'There are errors.' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + end + object LblErrorReason: TLabel + Left = 8 + Top = 104 + Width = 73 + Height = 13 + Caption = 'LblErrorReason' + Font.Charset = DEFAULT_CHARSET + Font.Color = clRed + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + ParentFont = False + Visible = False + end + end + object BtnOk: TButton + Left = 144 + Top = 134 + Width = 75 + Height = 25 + Caption = 'OK' + Default = True + Enabled = False + TabOrder = 0 + OnClick = BtnOkClick + end +end diff --git a/official/1.96/install/FrmCompile.pas b/official/1.96/install/FrmCompile.pas new file mode 100644 index 0000000..a56c5fd --- /dev/null +++ b/official/1.96/install/FrmCompile.pas @@ -0,0 +1,354 @@ +{----------------------------------------------------------------------------- +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/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: FrmCompile.pas, released on 2004-12-13. + +The Initial Developer of the Original Code is Andreas Hausladen +(Andreas dott Hausladen att gmx dott de) +Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen. +All Rights Reserved. + +Contributor(s): - + +You may retrieve the latest version of this file at the Project JEDI's JVCL +home page, located at http://jvcl.sourceforge.net + +Known Issues: +-----------------------------------------------------------------------------} +// $Id: FrmCompile.pas,v 1.1 2004/12/16 00:12:52 ahuser Exp $ + +unit FrmCompile; + +{$I jedi.inc} + +interface + +uses + Windows, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls; + +type + TCompileLineType = (clText, clFileProgress, clHint, clWarning, clError, clFatal); + + ICompileMessages = interface + ['{C932390B-8DB6-4CAE-89D0-7BAB8A2E640B}'] + procedure Clear; + + procedure AddHint(const Text: string); + procedure AddWarning(const Text: string); + procedure AddError(const Text: string); + procedure AddFatal(const Text: string); + procedure AddText(const Msg: string); + + { Text is the line that the compiler outputs. The ICompileMessages + implementor must parse the line itself. } + end; + + TFormCompile = class(TForm) + PanelClient: TPanel; + BtnOk: TButton; + BevelProject: TBevel; + BevelStatus: TBevel; + BevelCurrentLine: TBevel; + BevelHints: TBevel; + LblProject: TLabel; + LblStatusCaption: TLabel; + BevelTotalLines: TBevel; + LblCurrentLineCaption: TLabel; + LblCurrentLine: TLabel; + LblTotalLinesCaption: TLabel; + LblTotalLines: TLabel; + BevelWarnings: TBevel; + BevelErrors: TBevel; + LblHintsCaption: TLabel; + LblHints: TLabel; + LblWarningsCaption: TLabel; + LblWarnings: TLabel; + LblErrorsCaption: TLabel; + LblErrors: TLabel; + LblProjectCaption: TLabel; + LblStatus: TLabel; + LblErrorReason: TLabel; + procedure BtnOkClick(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + private + FHints: Cardinal; + FWarnings: Cardinal; + FErrors: Cardinal; + FCurrentLine: Cardinal; + FTotalLines: Cardinal; + FCurFilename: string; + FCompileMessages: ICompileMessages; + FAutoClearCompileMessages: Boolean; + procedure SetCurrentLine(Line: Cardinal); + function IsCompileFileLine(const Line: string): Boolean; + public + procedure Init(const ProjectName: string; Clear: Boolean = True); + procedure Compiling(const Filename: string); + procedure Linking(const Filename: string); + procedure Done(const ErrorReason: string = ''); + + function HandleLine(const Line: string): TCompileLineType; + + procedure IncHint; + procedure IncWarning; + procedure IncError; + + property Hints: Cardinal read FHints; + property Warnings: Cardinal read FWarnings; + property Errors: Cardinal read FErrors; + property CurrentLine: Cardinal read FCurrentLine write SetCurrentLine; + + property AutoClearCompileMessages: Boolean read FAutoClearCompileMessages write FAutoClearCompileMessages default False; + property CompileMessages: ICompileMessages read FCompileMessages write FCompileMessages; + end; + +var + FormCompile: TFormCompile; + +implementation + +{$IFDEF MSWINDOWS} +{$I windowsonly.inc} +uses + FileCtrl; +{$ENDIF MSWINDOWS} + +{$R *.dfm} + +resourcestring + RsPreparing = 'Preparing...'; + RsCompiling = 'Compiling'; + RsLinking = 'Linking'; + RsDone = 'Done'; + RsThereAreErrors = 'There are errors.'; + RsThereAreWarnings = 'There are warnings.'; + RsThereAreHints = 'There are hints.'; + RsCompiled = 'compiled.'; + +{ TFormCompile } + +procedure TFormCompile.BtnOkClick(Sender: TObject); +begin + Tag := 1; + Close; +end; + +function TFormCompile.HandleLine(const Line: string): TCompileLineType; + + function HasText(Text: string; const Values: array of string): Boolean; + var + i: Integer; + begin + Result := True; + Text := AnsiLowerCase(Text); + for i := 0 to High(Values) do + if Pos(Values[i], Text) > 0 then + Exit; + Result := False; + end; + +begin + Result := clText; + if Line = '' then + Exit; + + if IsCompileFileLine(Line) then + Result := clFileProgress + else + if HasText(Line, ['hint: ', 'hinweis: ', 'suggestion: ']) then // do not localize + begin + Result := clHint; + IncHint; + if Assigned(FCompileMessages) then + FCompileMessages.AddHint(Line); + end + else if HasText(Line, ['warning: ', 'warnung: ', 'avertissement: ']) then // do not localize + begin + Result := clWarning; + IncWarning; + if Assigned(FCompileMessages) then + FCompileMessages.AddWarning(Line); + end + else if HasText(Line, ['error: ', 'fehler: ', 'erreur: ']) then // do not localize + begin + Result := clError; + IncError; + if Assigned(FCompileMessages) then + FCompileMessages.AddError(Line); + end + else if HasText(Line, ['fatal: ']) then // do not localize + begin + Result := clFatal; + IncError; + if Assigned(FCompileMessages) then + FCompileMessages.AddFatal(Line); + end; +end; + +function TFormCompile.IsCompileFileLine(const Line: string): Boolean; + + function PosLast(Ch: Char; const S: string): Integer; + begin + for Result := Length(S) downto 1 do + if S[Result] = Ch then + Exit; + Result := 0; + end; + +var + ps, psEnd, LineNum, Err: Integer; + Filename: string; +begin + Result := False; + ps := PosLast('(', Line); + if (ps > 0) and (Pos(': ', Line) = 0) and (Pos('.', Line) > 0) then + begin + psEnd := PosLast(')', Line); + if psEnd < ps then + Exit; + + Filename := Copy(Line, 1, ps - 1); + if (Filename <> '') and (Filename[Length(Filename)] > #32) then + begin + Val(Copy(Line, ps + 1, psEnd - ps - 1), LineNum, Err); + if Err = 0 then + begin + Compiling(Filename); + CurrentLine := LineNum; + Result := True; + end; + end; + end; +end; + + +procedure TFormCompile.Init(const ProjectName: string; Clear: Boolean); +begin + Tag := 0; + LblProject.Caption := MinimizeName(ProjectName, LblProject.Canvas, LblProject.ClientWidth); + + LblStatusCaption.Font.Style := []; + LblStatus.Font.Style := []; + + if Clear then + begin + if Assigned(FCompileMessages) and AutoClearCompileMessages then + FCompileMessages.Clear; + FHints := 0; + FErrors := 0; + FWarnings := 0; + FTotalLines := 0; + end; + FCurrentLine := 0; + FCurFilename := ''; + + LblHints.Caption := IntToStr(FHints); + LblWarnings.Caption := IntToStr(FWarnings); + LblErrors.Caption := IntToStr(FErrors); + LblCurrentLine.Caption := IntToStr(FCurrentLine); + LblTotalLines.Caption := IntToStr(FTotalLines); + LblStatusCaption.Caption := RsPreparing; + LblStatus.Caption := ''; + + BtnOk.Enabled := False; + Show; +end; + +procedure TFormCompile.Compiling(const Filename: string); +begin + if Filename <> FCurFilename then + begin + FCurFilename := Filename; + FTotalLines := FTotalLines + FCurrentLine; + CurrentLine := 0; // updates total lines and current lines + LblStatusCaption.Font.Style := []; + LblStatus.Font.Style := []; + LblStatusCaption.Caption := RsCompiling + ':'; + LblStatus.Caption := ExtractFileName(Filename); + Application.ProcessMessages; + end; +end; + +procedure TFormCompile.Linking(const Filename: string); +begin + FTotalLines := FTotalLines + FCurrentLine; + CurrentLine := 0; + + LblStatusCaption.Font.Style := []; + LblStatus.Font.Style := []; + LblStatusCaption.Caption := RsLinking + ':'; + LblStatus.Caption := ExtractFileName(Filename); + Application.ProcessMessages; +end; + +procedure TFormCompile.Done(const ErrorReason: string); +begin + FCurFilename := ''; + FTotalLines := FTotalLines + FCurrentLine; + CurrentLine := 0; + + LblErrorReason.Caption := ErrorReason; + LblErrorReason.Visible := ErrorReason <> ''; + LblStatusCaption.Font.Style := [fsBold]; + LblStatus.Font.Style := [fsBold]; + LblStatusCaption.Caption := RsDone + ':'; + + if FErrors > 0 then + LblStatus.Caption := RsThereAreErrors + else if FWarnings > 0 then + LblStatus.Caption := RsThereAreWarnings + else if FHints > 0 then + LblStatus.Caption := RsThereAreHints + else + LblStatus.Caption := RsCompiled; + BtnOk.Enabled := ErrorReason <> ''; + if ErrorReason <> '' then + begin + Hide; + ShowModal; + end; +end; + +procedure TFormCompile.IncError; +begin + Inc(FErrors); + LblErrors.Caption := IntToStr(FErrors); + Application.ProcessMessages; +end; + +procedure TFormCompile.IncHint; +begin + Inc(FHints); + LblHints.Caption := IntToStr(FHints); + Application.ProcessMessages; +end; + +procedure TFormCompile.IncWarning; +begin + Inc(FWarnings); + LblWarnings.Caption := IntToStr(FWarnings); + Application.ProcessMessages; +end; + +procedure TFormCompile.SetCurrentLine(Line: Cardinal); +begin + FCurrentLine := Line; + LblCurrentLine.Caption := IntToStr(Line); + LblTotalLines.Caption := IntToStr(FTotalLines + FCurrentLine); + Application.ProcessMessages; +end; + +procedure TFormCompile.FormCloseQuery(Sender: TObject; + var CanClose: Boolean); +begin + CanClose := Tag = 1; +end; + +end. diff --git a/official/1.96/install/JclInstall.pas b/official/1.96/install/JclInstall.pas new file mode 100644 index 0000000..2fa47b0 --- /dev/null +++ b/official/1.96/install/JclInstall.pas @@ -0,0 +1,2523 @@ + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ 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 JclInstall.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): Robert Rossmair (crossplatform & BCB support, refactoring) } +{ } +{ Last modified: $Date: 2006/02/09 13:57:33 $ } +{ } +{**************************************************************************************************} + +unit JclInstall; + +interface + +{$I jcl.inc} +{$I crossplatform.inc} + +uses + SysUtils, Classes, IniFiles, Contnrs, + JclSysUtils, JclBorlandTools, JediInstall; + +type + TJclDistribution = class; + + TJclInstallation = class + private + FDistribution: TJclDistribution; + FTarget: TJclBorRADToolInstallation; + FDebugDcuDir: string; + FLibDir: string; + FLibObjDir: string; + FDefines: TStringList; + FUnits: TStringList; + FDemos: TStringList; + FDemoExclusionList: TStringList; + FOnWriteLog: TTextHandler; + FRelativeDemoPath: string; + FDemoSectionName: string; + procedure AddDemo(const Directory: string; const FileInfo: TSearchRec); + procedure AddDemos(const Directory: string); + procedure AddDialogToRepository(const DialogName: string; const DialogFileName: string; + const DialogIconFileName: string; const Designer: string; const Ancestor: string = ''); + function GetDemoList: TStringList; + procedure BuildUnitList(const SubDir: string; Units: TStrings); + function GetDemoExclusionList: TStrings; + function GetProgressTotal: Integer; + function GetTool: IJediInstallTool; + function GetUnits(const SourceDir: string): TStrings; + function InitOptions: Boolean; + procedure InstallationStarted; + procedure InstallationFinished; + procedure InstallFailedOn(const InstallObj: string); + procedure ConfigureBpr2Mak(const PackageFileName: string); + {$IFDEF MSWINDOWS} + function CompileExpert(const Name: string; InstallExpert: Boolean): Boolean; + {$ENDIF MSWINDOWS} + function CompilePackage(const Name: string; InstallPackage: Boolean): Boolean; + function CompilePackages: Boolean; + function InstallOption(Option: TJediInstallOption): Boolean; + procedure RemoveDialogFromRepository(const DialogName, DialogFileName: string); + function UninstallPackage(const Name: string): Boolean; + function UninstallPackages: Boolean; + function UninstallOption(Option: TJediInstallOption): Boolean; + function LogFileName: string; + procedure MakeDemo(Index: Integer); + function MakeDemos: Boolean; overload; + function MakeUnits(Debug: Boolean): Boolean; + function MakePath(const FormatStr: string): string; + function Description(Option: TJediInstallOption): string; + procedure SaveDemoOption(Index: Integer); + procedure SaveOption(Option: TJediInstallOption); + procedure SaveOptions; + procedure Progress(Steps: Integer); + function StoredOption(Option: TJediInstallOption; Default: Boolean = True): Boolean; + function TotalUnitCount: Integer; + procedure WriteLog(const Msg: string); + function GetJclDcpPath: string; + {$IFDEF MSWINDOWS} + function InstallExpert(const Option: TJediInstallOption): Boolean; + function UninstallExpert(const Option: TJediInstallOption): Boolean; + {$ENDIF MSWINDOWS} + protected + constructor Create(JclDistribution: TJclDistribution; InstallTarget: TJclBorRADToolInstallation); + function CompileLibraryUnits(const SubDir: string; Debug: Boolean): Boolean; + {$IFDEF MSWINDOWS} + procedure AddHelpToIdeTools; + procedure AddHelpToOpenHelp; + procedure RemoveHelpFromIdeTools; + procedure RemoveHelpFromOpenHelp; + procedure CopyFakeXmlRtlPackage; + {$ENDIF MSWINDOWS} + function BplPath: string; + function DcpPath: string; + function CheckDirectories: Boolean; + procedure CleanupRepository; + function DemoOption(DemoIndex: Integer): TJediInstallOption; + function DemoOptionSelected(Index: Integer): Boolean; + function ExcludeEdition(ExcludeList: TStrings; Index: Integer; out Name: string): Boolean; + function InstallSelectedOptions: Boolean; + function UninstallSelectedOptions: Boolean; + function OptionSelected(Option: TJediInstallOption): Boolean; + function ProgressWeight(Option: TJediInstallOption): Integer; + function Run: Boolean; + function Undo: Boolean; + function StoredBplPath: string; + function StoredDcpPath: string; + property Defines: TStringList read FDefines; + property Demos: TStringList read GetDemoList; + property DemoSectionName: string read FDemoSectionName; + property DemoExclusionList: TStrings read GetDemoExclusionList; + property Tool: IJediInstallTool read GetTool; + property DebugDcuDir: string read FDebugDcuDir; + property LibDir: string read FLibDir; + property LibObjDir: string read FLibObjDir; + property ProgressTotal: Integer read GetProgressTotal; + property RelativeDemoPath: string read FRelativeDemoPath; + property Target: TJclBorRADToolInstallation read FTarget; + property Units[const SourceDir: string]: TStrings read GetUnits; + property JclDcpPath: string read GetJclDcpPath; + public + destructor Destroy; override; + property OnWriteLog: TTextHandler read FOnWriteLog write FOnWriteLog; + property Distribution: TJclDistribution read FDistribution; + end; + + TJclDistribution = class (TInterfacedObject, IJediInstall) + private + FJclPath: string; + FJclBinDir: string; + FLibDirMask: string; + FLibDebugDirMask: string; + FLibObjDirMask: string; + FJclSourceDir: string; + FJclSourcePath: string; + FClxDialogFileName: string; + FClxDialogIconFileName: string; + {$IFDEF MSWINDOWS} + FVclDialogFileName: string; + FVclDialogSendFileName: string; + FVclDialogIconFileName: string; + FVclDialogSendIconFileName: string; + {$ENDIF MSWINDOWS} + FJclChmHelpFileName: string; + FJclHlpHelpFileName: string; + FJclReadmeFileName: string; + FTool: IJediInstallTool; + FTargetInstalls: TObjectList; + FIniFile: TMemIniFile; + FProgress: Integer; + FProgressTotal: Integer; + FProgressPercent: Integer; + FOnStarting: TInstallationEvent; + FOnEnding: TInstallationEvent; + FOnProgress: TInstallationProgressEvent; + FInstalling: Boolean; + function CreateInstall(Target: TJclBorRADToolInstallation): Boolean; + function GetTargetInstall(Installation: TJclBorRADToolInstallation): TJclInstallation; + procedure InitInstallationTargets; + procedure InitProgress; + function GetExamplesDir: string; + function GetDemosPath: string; + protected + constructor Create; + function DocFileName(const BaseFileName: string): string; + procedure InstallProgress(Steps: Integer); + procedure SetTool(const Value: IJediInstallTool); + procedure ShowProgress; + property TargetInstall[Target: TJclBorRADToolInstallation]: TJclInstallation read GetTargetInstall; + public + destructor Destroy; override; + function FeatureInfoFileName(FeatureID: Cardinal): string; + function GetHint(Option: TJediInstallOption): string; + function InitInformation(const ApplicationFileName: string): Boolean; + function Install: Boolean; + function Uninstall: Boolean; + function ReadmeFileName: string; + procedure SetOnWriteLog(Installation: TJclBorRADToolInstallation; Value: TTextHandler); + procedure SetOnEnding(Value: TInstallationEvent); + procedure SetOnProgress(Value: TInstallationProgressEvent); + procedure SetOnStarting(Value: TInstallationEvent); + function Supports(Target: TJclBorRADToolInstallation): Boolean; + property BinDir: string read FJclBinDir; + property ExamplesDir: string read GetExamplesDir; + property DemosPath: string read GetDemosPath; + property ChmHelpFileName: string read FJclChmHelpFileName; + property HlpHelpFileName: string read FJclHlpHelpFileName; + property Installing: Boolean read FInstalling; + property Path: string read FJclPath; + property SourceDir: string read FJclSourceDir; + property SourcePath: string read FJclSourcePath; + property Tool: IJediInstallTool read FTool write SetTool; + end; + +function CreateJclInstall: IJediInstall; +function LogFileName(Target: TJclBorRADToolInstallation): string; + +implementation + +uses + {$IFDEF VCL} + Dialogs, Controls, + {$ELSE VCL} + QDialogs, QControls, + {$ENDIF VCL} + JclBase, JclResources, JclSysInfo, + {$IFDEF MSWINDOWS} + JclPeImage, + {$ENDIF MSWINDOWS} + JclFileUtils, JclStrings; + +{ Install option data } + +resourcestring +// Captions + + // Products + RsJCL = 'JEDI Code Library'; + + // Common features + RsDefThreadSafe = 'Thread safe container classes'; + RsDefDropObsoleteCode = 'Drop obsolete code'; + RsDefMathPrecSingle = 'Single float precision'; + RsDefMathPrecDouble = 'Double float precision'; + RsDefMathPrecExtended = 'Extended float precision'; + + RsMapCreate = 'Create MAP files'; + RsMapLink = 'Link MAP files'; + RsMapDelete = 'Delete MAP files after the link'; + + RsEnvironment = 'Environment'; + RsEnvLibPath = 'Add JCL to IDE Library Path'; + RsEnvBrowsingPath = 'Add JCL to IDE Browsing Path'; + RsEnvDebugDCUPath = 'Add JCL to Debug DCU Path'; + RsMake = 'Make library units'; + RsMakeRelease = 'Release'; + RsMakeDebug = 'Debug'; + RsMakeVClx = 'Visual CLX'; + RsMakeDemos = 'Make demos'; + + RsHelpFiles = 'Help files'; + RsIdeExperts = 'IDE experts'; + RsJCLPackages = 'Packages'; + RsIdeHelpHlp = 'Add help file to IDE help system'; + RsIdeHelpChm = 'Add HTML help to the Tools menu'; + RsCopyHppFiles = 'Copy HPP files to %s'; + RsDualPackages = 'Dual packages'; + RsCopyPackagesHppFiles = 'Output HPP files to %s'; + + // Product specific features + RsJCLExceptDlg = 'Sample Exception Dialogs in the Object Reporitory'; + RsJCLDialogVCL = 'VCL Exception Dialog'; + RsJCLDialogVCLSnd = 'VCL Exception Dialog with Send button'; + RsJCLDialogCLX = 'CLX Exception Dialog'; + RsExpertsDsgnPackages = 'Design packages'; + RsExpertsDLL = 'DLL experts'; + RsJCLIdeDebug = 'Debug Extension'; + RsJCLIdeAnalyzer = 'Project Analyzer'; + RsJCLIdeFavorite = 'Favorite combobox in Open/Save dialogs'; + RsJCLIdeThreadNames = 'Displaying thread names in Thread Status window'; + RsJCLIdeUses = 'Uses Wizard'; + RsJCLSimdView = 'Debug window for XMM registers'; + RsJCLVersionControl = 'Version control'; + +// Hints + RsHintTarget = 'Installation target'; + RsHintJCL = 'Select to install JCL for this target.'; + RsHintJclDefThreadSafe = 'Conditionally compile container classes to be thread safe'; + RsHintJclDefDropObsoleteCode = 'Do not compile deprecated code'; + RsHintJclDefMathPrecSingle = 'type Float = Single'; + RsHintJclDefMathPrecDouble = 'type Float = Double'; + RsHintJclDefMathPrecExtended = 'type Float = Extended'; + RsHintJclMapCreate = 'Create detailled MAP files for each libraries'; + RsHintJclMapLink = 'Link MAP files as a resource in the output library or executable, the stack can be traced on exceptions'; + RsHintJclMapDelete = 'Once linked in the binary, delete the original MAP file'; + RsHintJclEnv = 'Set selected environment items'; + RsHintJclEnvLibPath = 'Add JCL precompiled unit directories to library path'; + RsHintJclEnvBrowsingPath = 'Add JCL source directories to browsing path'; + RsHintJclEnvDebugDCUPath = 'This is a prerequisite for using the precompiled JCL debug units ' + + 'by means of the respective'#13#10'Project Options|Compiler switch. See "Make library ' + + 'units/Debug" option below.'; + RsHintJclMake = 'Generate .dcu and .dpu (Kylix only) files.'#13#10'Recommended.'; + RsHintJclMakeRelease = 'Make precompiled units for release, i.e. optimized, w/o debug information.'; + RsHintJclMakeReleaseVcl = 'Make precompiled VCL units for release'; + RsHintJclMakeReleaseVClx = 'Make precompiled Visual CLX units for release'; + RsHintJclMakeDebug = 'Make precompiled units for debugging, i.e.optimization off, debug ' + + 'information included.'#13#10'When installed, available through Project Options|Compiler|Use ' + + 'Debug DCUs.'; + RsHintJclMakeDebugVcl = 'Make precompiled VCL units for debugging'; + RsHintJclMakeDebugVClx = 'Make precompiled Visual CLX units for debugging'; + RsHintJclCopyHppFiles = 'Copy .hhp files into C++Builder''s include path.'; + RsHintJclDualPackages = 'The same package introduce component for Delphi Win32 and C++Builder Win32'; + RsHintJclPackages = 'Build and eventually install JCL runtime packages (RTL, VCL and Visual ' + + 'CLX) and optional IDE experts.'; + RsHintJclExperts = 'Build and install selected IDE experts.'; + RsHintJclExpertsDsgnPackages = 'Design packages containing JCL experts'; + RsHintJclExpertsDLL = 'DLLs containing JCL experts'; + RsHintJclExpertDebug = 'Install IDE expert which assists to insert JCL Debug information into ' + + 'executable files.'; + RsHintJclExpertAnalyzer = 'Install IDE Project Analyzer.'; + RsHintJclExpertFavorite = 'Install "Favorites" combobox in IDE Open/Save dialogs.'; + RsHintJclExpertsThreadNames = 'Display thread names in Thread Status window IDE extension.'; + RsHintJclExpertUses = 'Install IDE Uses Wizard.'; + RsHintJclExpertSimdView = 'Install a debug window of XMM registers (used by SSE instructions)'; + RsHintJclExpertVersionControl = 'Integration of TortoiseCVS and TortoiseSVN in the IDE'; + RsHintJclCopyPackagesHppFiles = 'Output .hhp files into C++Builder''s include path instead of ' + + 'the source paths.'; + RsHintJclExcDialog = 'Add selected Exception dialogs to the Object Repository.'; + RsHintJclExcDialogVCL = 'Add VCL exception dialog to the Object Repository.'; + RsHintJclExcDialogVCLSnd = 'Add VCL exception dialog with "Send Button" to the Object Repository.'; + RsHintJclExcDialogCLX = 'Add CLX exception dialog (Windows only) to the Object Repository.'; + RsHintJclHelp = 'Install JCL help files.'; + RsHintJclHelpHlp = 'Customize Borland Open Help to include JCL help files.'; + RsHintJclHelpChm = ''; + RsHintJclMakeDemos = 'Make JCL demo applications'; + +// warning messages + RsPackageNodeNotSelected = 'The "Packages" node is not selected.' + sLineBreak + + 'Various libraries (including the JVCL) require JCL packages to be compiled' + sLineBreak + + 'Do you want to continue without compiling JCL packages?'; + + +const + Invalid = -1; + LineBreak = AnsiLineBreak; + ioUndef = TJediInstallOption(Invalid); + + InitData: array[TJediInstallOption] of TInstallOptionData = + ( + (Parent: ioUndef; // ioTarget + Caption: ''; + Hint: RsHintTarget), + (Parent: ioTarget; // ioJCL + Caption: RsJCL; + Hint: RsHintJcl), + (Parent: ioJCL; // ioJclDefThreadSafe + Caption: RsDefThreadSafe; + Hint: RsHintJclDefThreadSafe), + (Parent: ioJCL; // ioJclDefDropObsoleteCode + Caption: RsDefDropObsoleteCode; + Hint: RsHintJclDefDropObsoleteCode), + (Parent: ioJCL; // ioJclDefMathPrecSingle + Caption: RsDefMathPrecSingle; + Hint: RsHintJclDefMathPrecSingle), + (Parent: ioJCL; // ioJclDefMathPrecDouble + Caption: RsDefMathPrecDouble; + Hint: RsHintJclDefMathPrecDouble), + (Parent: ioJCL; // ioJclDefMathPrecExtended + Caption: RsDefMathPrecExtended; + Hint: RsHintJclDefMathPrecExtended), + (Parent: ioJCL; // ioJclMapCreate + Caption: RsMapCreate; + Hint: RsHintJclMapCreate), + (Parent: ioJclMapCreate; // ioJclMapLink + Caption: RsMapLink; + Hint: RsHintJclMapLink), + (Parent: ioJclMapLink; // ioJclMapDelete + Caption: RsMapDelete; + Hint: RsHintJclMapDelete), + (Parent: ioJCL; // ioJclEnv + Caption: RsEnvironment; + Hint: RsHintJclEnv), + (Parent: ioJclEnv; // ioJclEnvLibPath + Caption: RsEnvLibPath; + Hint: RsHintJclEnvLibPath), + (Parent: ioJclEnv; // ioJclEnvBrowsingPath + Caption: RsEnvBrowsingPath; + Hint: RsHintJclEnvBrowsingPath), + (Parent: ioJclEnv; // ioJclEnvDebugDCUPath + Caption: RsEnvDebugDCUPath; + Hint: RsHintJclEnvDebugDCUPath), + (Parent: ioJCL; // ioJclMake + Caption: RsMake; + Hint: RsHintJclMake), + (Parent: ioJclMake; // ioJclMakeRelease + Caption: RsMakeRelease; + Hint: RsHintJclMakeRelease), + (Parent: ioJclMake; // ioJclMakeReleaseVClx + Caption: RsMakeVClx; + Hint: RsHintJclMakeReleaseVClx), + (Parent: ioJclMake; // ioJclMakeDebug + Caption: RsMakeDebug; + Hint: RsHintJclMakeDebug), + (Parent: ioJclMake; // ioJclMakeDebugVClx + Caption: RsMakeVClx; + Hint: RsHintJclMakeDebugVClx), + (Parent: ioJclMake; // ioJclCopyHppFiles + Caption: RsCopyHppFiles; + Hint: RsHintJclCopyHppFiles), + (Parent: ioJclPackages; // ioJclDualPackages + Caption: RsDualPackages; + Hint: RsHintJclDualPackages), + (Parent: ioJCL; // ioJclPackages + Caption: RsJCLPackages; + Hint: RsHintJclPackages), + (Parent: ioJclExperts; // ioJclExpertsDesignPackages + Caption: RsExpertsDsgnPackages; + Hint: RsHintJclExpertsDsgnPackages), + (Parent: ioJclExperts; // ioJclExpertsDLL + Caption: RsExpertsDLL; + Hint: RsHintJclExpertsDLL), + (Parent: ioJclPackages; // ioJclExperts + Caption: RsIdeExperts; + Hint: RsHintJclExperts), + (Parent: ioJclExperts; // ioJclExpertDebug + Caption: RsJCLIdeDebug; + Hint: RsHintJclExpertDebug), + (Parent: ioJclExperts; // ioJclExpertAnalyzer + Caption: RsJCLIdeAnalyzer; + Hint: RsHintJclExpertAnalyzer), + (Parent: ioJclExperts; // ioJclExpertFavorite + Caption: RsJCLIdeFavorite; + Hint: RsHintJclExpertFavorite), + (Parent: ioJclExperts; // ioJclExpertThreadNames + Caption: RsJCLIdeThreadNames; + Hint: RsHintJclExpertsThreadNames), + (Parent: ioJclExperts; // ioJclExpertUses + Caption: RsJCLIdeUses; + Hint: RsHintJclExpertUses), + (Parent: ioJclExperts; // ioJclExpertSimdView + Caption: RsJCLSimdView; + Hint: RsHintJclExpertSimdView), + (Parent: ioJclExperts; // ioJclExpertVersionControl + Caption: RsJclVersionControl; + Hint: RsHintJclExpertVersionControl), + (Parent: ioJclPackages; // ioJclCopyPackagesHppFiles + Caption: RsCopyPackagesHppFiles; + Hint: RsHintJclCopyPackagesHppFiles), + (Parent: ioJCL; // ioJclExcDialog + Caption: RsJCLExceptDlg; + Hint: RsHintJclExcDialog), + (Parent: ioJclExcDialog; // ioJclExcDialogVCL + Caption: RsJCLDialogVCL; + Hint: RsHintJclExcDialogVCL), + (Parent: ioJclExcDialog; // ioJclExcDialogVCLSnd + Caption: RsJCLDialogVCLSnd; + Hint: RsHintJclExcDialogVCLSnd), + (Parent: ioJclExcDialog; // ioJclExcDialogCLX + Caption: RsJCLDialogCLX; + Hint: RsHintJclExcDialogCLX), + (Parent: ioJCL; // ioJclHelp + Caption: RsHelpFiles; + Hint: RsHintJclHelp), + (Parent: ioJclHelp; // ioJclHelpHlp + Caption: RsIdeHelpHlp; + Hint: RsHintJclHelpHlp), + (Parent: ioJclHelp; // ioJclHelpChm + Caption: RsIdeHelpChm; + Hint: RsHintJclHelpChm), + (Parent: ioJCL; // ioJclMakeDemos + Caption: RsMakeDemos; + Hint: RsHintJclMakeDemos) + ); + +const + {$IFDEF KYLIX} + VersionDir = '/k%d'; + VersionDirExp = '/k%%d'; + {$ELSE} + VersionDir = '\%s'; + VersionDirExp = '\%%s'; + {$ENDIF} + + JclSrcDirCommon = 'common'; + JclSrcDirVisClx = 'visclx'; + + {$IFDEF MSWINDOWS} + {$IFNDEF RTL140_UP} + PathSep = ';'; + {$ENDIF RTL140_UP} + VclDialogFileName = 'ExceptDlg.pas'; + VclDlgSndFileName = 'ExceptDlgMail.pas'; + VclDialogName = 'Exception Dialog'; + VclDialogNameSend = 'Exception Dialog with Send'; + + JclDpk = 'Jcl'; + JclVclDpk = 'JclVcl'; + JclVClxDpk = 'JclVClx'; + + JclIdeBaseDpk = 'JclBaseExpert'; + JclIdeDebugDpk = 'JclDebugExpert'; + JclIdeAnalyzerDpk = 'JclProjectAnalysisExpert'; + JclIdeFavoriteDpk = 'JclFavoriteFoldersExpert'; + JclIdeThrNamesDpk = 'JclThreadNameExpert'; + JclIdeUsesDpk = 'JclUsesExpert'; + JclIdeSimdViewDpk = 'JclSIMDViewExpert'; + JclIdeVersionControlDpk = 'JclVersionControlExpert'; + JclBdsExpertDpr = 'JclBdsExpert'; + + ExpertPaths: array[ioJclExperts..ioJclExpertVersionControl] of string = + ( + JclIdeBaseDpk, + JclIdeDebugDpk, + JclIdeAnalyzerDpk, + JclIdeFavoriteDpk, + JclIdeThrNamesDpk, + JclIdeUsesDpk, + JclIdeSimdViewDpk, + JclIdeVersionControlDpk + ); + + JclSrcDirOS = 'windows'; + JclSrcDirVcl = 'vcl'; + JclSourceDirs: array[0..3] of string = (JclSrcDirCommon, JclSrcDirOS, JclSrcDirVcl, JclSrcDirVisClx); + JclSourcePath = '%0:s\' + JclSrcDirOS + + ';%0:s\' + JclSrcDirCommon + + ';%0:s\' + JclSrcDirVcl + + ';%0:s\' + JclSrcDirVisClx; + BCBIncludePath = '%s;%s;$(BCB)\include;$(BCB)\include\vcl'; + BCBObjectPath = '%s;%s;$(BCB)\Lib\Obj'; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + JclSrcDirOS = 'unix'; + JclSourceDirs: array[0..2] of string = (JclSrcDirCommon, JclSrcDirOS, JclSrcDirVisClx); + JclSourcePath = '%0:s\' + JclSrcDirOS + + ':%0:s\' + JclSrcDirCommon + + ':%0:s\' + JclSrcDirVisClx; + BCBIncludePath = '%s:%s:$(BCB)/include:$(BCB)/include/vcl'; + BCBObjectPath = BCBIncludePath; + {$ENDIF UNIX} + + DialogsPath = 'experts' + PathSeparator + 'debug' + PathSeparator + 'dialog' + PathSeparator; + ClxDialogFileName = 'ClxExceptDlg.pas'; + ClxDialogName = 'CLX Exception Dialog'; + DialogDescription = 'JCL Application exception dialog'; + DialogAuthor = 'Project JEDI'; + DialogPage = 'Dialogs'; + + JclChmHelpFile = 'help' + PathSeparator + 'JCLHelp.chm'; + JclHlpHelpFile = 'help' + PathSeparator + 'JCLHelp.hlp'; + JclHelpTitle = 'JCL %d.%d Help'; + JclHelpIndexName = 'Jedi Code Library Reference'; + HHFileName = 'HH.EXE'; + + {$IFDEF MSWINDOWS} + Bcb2MakTemplate = 'packages\BCB.bmk'; + {$ENDIF MSWINDOWS} + {$IFDEF KYLIX} + Bcb2MakTemplate = 'packages/bcb.gmk'; + {$ENDIF KYLIX} + +resourcestring + RsStatusMessage = 'Installing %s...'; + RsStatusDetailMessage = 'Installing %s for %s...'; + RsUninstallMessage = 'Removing %s...'; + RsBuildingMessage = 'Building %s...'; + RsBuildingDemosMessage = 'Building demo projects...'; + RsBuildingDemosByTargetMessage = 'Building demo projects by %s...'; + RsCompilingMessage = 'Compiling %s...'; + RsInstallFailed = 'Installation of %s failed, see %s for details.'; + RsInvalidBplPath = LineBreak + 'Invalid BPL path "%s"'; + RsInvalidDcpPath = LineBreak + 'Invalid DCP path "%s"'; + RsLibDescriptor = '%s library %sunits for %s'; + {$IFDEF VisualCLX} + RsReadmeFileName = 'Readme.html'; + {$ELSE} + RsReadmeFileName = 'Readme.txt'; + {$ENDIF} + RsIniFileName = 'JCL-install.ini'; + +function CreateJclInstall: IJediInstall; +begin + Result := TJclDistribution.Create as IJediInstall; +end; + +function CopyFiles(Files: TStrings; const TargetDir: string; Overwrite: Boolean = True): Boolean; +var + I: Integer; + FileName: string; +begin + Result := True; + for I := 0 to Files.Count - 1 do + begin + FileName := Files[I]; + Result := Result and FileCopy(FileName, PathAddSeparator(TargetDir) + ExtractFileName(FileName), Overwrite); + end; +end; + +procedure CopyResFiles(TargetDir: string); +var + FileList: TStringList; +begin + FileList := TStringList.Create; + try + if BuildFileList('*.res', faAnyFile, FileList) then + CopyFiles(FileList, TargetDir); + finally + FileList.Free; + end; +end; + +function CopyHppFiles(Units: TStrings; const TargetDir: string): Boolean; +var + I: Integer; + FileName: string; +begin + Result := True; + for I := 0 to Units.Count - 1 do + begin + FileName := Units[I] + '.hpp'; + if FileExists(FileName) then + Result := Result and FileCopy(FileName, TargetDir + FileName, True); + end; +end; + +function FullPackageFileName(Target: TJclBorRADToolInstallation; const BaseName: string): string; +const + S = 'packages' + VersionDir + PathSeparator + '%s'; +begin + with Target do + begin + {$IFDEF KYLIX} + Result := Format(S + '%s', [VersionNumber, BaseName, PackageSourceFileExtension]); + {$ELSE KYLIX} + if SupportsLibSuffix then + Result := Format(S + '%s', [VersionNumberStr, BaseName, PackageSourceFileExtension]) + else + Result := Format(S + '%s0%3:s', [VersionNumberStr, BaseName, VersionNumberStr, PackageSourceFileExtension]); + {$ENDIF KYLIX} + end; +end; + +{$IFDEF MSWINDOWS} +function FullLibraryFileName(Target: TJclBorRADToolInstallation; const BaseName: string): string; +const + S = 'packages' + VersionDir + PathSeparator + '%s'; +begin + with Target do + if SupportsLibSuffix then + Result := Format(S + 'DLL%s', [VersionNumberStr, BaseName, ProjectSourceFileExtension]) + else + Result := Format(S + 'DLL%s0%3:s', [VersionNumberStr, BaseName, VersionNumberStr, ProjectSourceFileExtension]); +end; +{$ENDIF MSWINDOWS} + +function LogFileName(Target: TJclBorRADToolInstallation): string; +begin + with Target do + Result := Format('%s%s.log', [PathAddSeparator(ExtractFileDir(ParamStr(0))), Target.Name]); +end; + +{ TJclInstallation } + +constructor TJclInstallation.Create(JclDistribution: TJclDistribution; + InstallTarget: TJclBorRADToolInstallation); +begin + inherited Create; + FDistribution := JclDistribution; + FTarget := InstallTarget; + InstallTarget.OutputCallback := WriteLog; + FDebugDcuDir := MakePath(Distribution.FLibDebugDirMask); + FLibDir := MakePath(Distribution.FLibDirMask); + if InstallTarget is TJclBCBInstallation then + FLibObjDir := MakePath(Distribution.FLibObjDirMask); + FDefines := TStringList.Create; + FUnits := TStringList.Create; + FDemoSectionName := Target.Name + ' demos'; +end; + +destructor TJclInstallation.Destroy; +var + I: Integer; +begin + FDemoExclusionList.Free; + FDemos.Free; + if Assigned(FUnits) then + for I := 0 to FUnits.Count - 1 do + FUnits.Objects[I].Free; + FUnits.Free; + FDefines.Free; + inherited Destroy; +end; + +procedure TJclInstallation.AddDemo(const Directory: string; const FileInfo: TSearchRec); +var + FileName: string; +begin + FileName := FRelativeDemoPath + FileInfo.Name; + if not DemoExclusionList.IndexOf(FileName) >= 0 then + Demos.Append(FileName); +end; + +procedure TJclInstallation.AddDemos(const Directory: string); +begin + FRelativeDemoPath := PathAddSeparator(PathGetRelativePath(Distribution.DemosPath, Directory)); + EnumFiles(Directory + '*.dpr', AddDemo); +end; + +procedure TJclInstallation.AddDialogToRepository(const DialogName: string; + const DialogFileName: string; const DialogIconFileName: string; const Designer: string; + const Ancestor: string = ''); +begin + WriteLog(Format(LineBreak + 'Installing %s...', [DialogName])); + with Target.Repository do + AddObject( + DialogFileName, + BorRADToolRepositoryFormTemplate, + FindPage(DialogPage, 1), + DialogName, + DialogIconFileName, + DialogDescription, + DialogAuthor, + BorRADToolRepositoryDesignerDfm); + WriteLog(Format('-> %s' + LineBreak + '-> %s' + LineBreak + + '...done.', [DialogFileName, DialogIconFileName])); +end; + +{$IFDEF MSWINDOWS} +procedure TJclInstallation.AddHelpToIdeTools; +var + ToolsIndex: Integer; + HelpTitle: string; +begin + HelpTitle := Format(JclHelpTitle, [JclVersionMajor, JclVersionMinor]); + with Target.IdeTools do + if IndexOfTitle(HelpTitle) = Invalid then + begin + ToolsIndex := Count; + Count := ToolsIndex + 1; + Title[ToolsIndex] := HelpTitle; + Path[ToolsIndex] := HHFileName; + Parameters[ToolsIndex] := StrDoubleQuote(FDistribution.FJclChmHelpFileName); + WorkingDir[ToolsIndex] := Distribution.Path; + end; +end; + +procedure TJclInstallation.AddHelpToOpenHelp; +begin + if Target.OpenHelp.AddHelpFile(Distribution.FJclHlpHelpFileName, JclHelpIndexName) then + WriteLog(Format(LineBreak + 'Added %s to %s Online Help', [Distribution.FJclHlpHelpFileName, Target.RADToolName])); +end; +{$ENDIF MSWINDOWS} + +function TJclInstallation.BplPath: string; +begin + Result := Tool.BPLPath[Target]; + {$IFDEF MSWINDOWS} + Result := PathGetShortName(Result); + {$ENDIF MSWINDOWS} +end; + +function TJclInstallation.DcpPath: string; +begin + Result := Tool.DCPPath[Target]; + {$IFDEF MSWINDOWS} + Result := PathGetShortName(Result); + {$ENDIF MSWINDOWS} +end; + +function TJclInstallation.CheckDirectories: Boolean; +begin + Result := not OptionSelected(ioJclPackages); + if not Result then + begin + Result := True; + if not DirectoryExists(BplPath) then + begin + WriteLog(Format(RsInvalidBplPath, [BplPath])); + Result := False; + end; + if not DirectoryExists(DcpPath) then + begin + WriteLog(Format(RsInvalidDcpPath, [DcpPath])); + Result := False; + end; + end; +end; + +procedure TJclInstallation.CleanupRepository; +begin + if OptionSelected(ioJCL) then + with Target.Repository do + begin + RemoveObjects(DialogsPath, ClxDialogFileName, BorRADToolRepositoryFormTemplate); + {$IFDEF MSWINDOWS} + RemoveObjects(DialogsPath, VclDialogFileName, BorRADToolRepositoryFormTemplate); + RemoveObjects(DialogsPath, VclDlgSndFileName, BorRADToolRepositoryFormTemplate); + {$ENDIF MSWINDOWS} + end; +end; + +function TJclInstallation.CompileLibraryUnits(const SubDir: string; Debug: Boolean): Boolean; +var + UnitList: TStrings; + UnitType: string; + LibDescriptor: string; + SaveDir, UnitOutputDir: string; + Path: string; + + function CompilationOptions: string; + begin + if FTarget.RADToolKind = brCppBuilder then + begin + Result := StringsToStr(Target.DCC32.Options, ' ') + ' '; + Result := StringReplace(Result, '$(BCB)', Target.RootDir, [rfReplaceAll]); + end + else + Result := ''; + end; + + function CompileUnits: Boolean; + {$IFDEF COMPILE_UNITS_SEPARATELY // gives better progress resolution } + var + I: Integer; + begin + Result := True; + for I := 0 to UnitList.Count - 1 do + begin + Result := Target.DCC32.Execute({$IFNDEF KYLIX}CompilationOptions + {$ENDIF}UnitList[I]); + Progress(1); + if not Result then + Break; + end; + end; + {$ELSE} + begin + Result := Target.DCC32.Execute({$IFNDEF KYLIX}CompilationOptions + {$ENDIF}StringsToStr(UnitList, ' ')); + Progress(UnitList.Count); + end; + {$ENDIF} + +begin + if Debug then + UnitType := 'debug '; + LibDescriptor := Format(RsLibDescriptor, [SubDir, UnitType, Target.Name]); + WriteLog(Format(LineBreak + 'Making %s', [LibDescriptor])); + Tool.UpdateStatus(Format(RsCompilingMessage, [LibDescriptor])); + Path := Format('%s' + PathSeparator + '%s', [Distribution.SourceDir, SubDir]); + UnitList := Units[SubDir]; + with Target.DCC32 do + begin + SetDefaultOptions; + Options.Add('-D' + StringsToStr(Defines, ';')); + Options.Add('-M'); + if Target.RADToolKind = brCppBuilder then + begin + Options.Add('-D_RTLDLL;NO_STRICT;USEPACKAGES'); // $(SYSDEFINES) + if Debug then + begin + Options.Add('-$Y+'); + Options.Add('-$W'); + Options.Add('-$O-'); + Options.Add('-v'); + UnitOutputDir := MakePath(Distribution.FLibDebugDirMask); + AddPathOption('N2', MakePath(Distribution.FLibDirMask + PathSeparator + 'obj')); // .obj files + end + else + begin + Options.Add('-$YD'); + Options.Add('-$W+'); + Options.Add('-$O+'); + UnitOutputDir := MakePath(Distribution.FLibDirMask); + AddPathOption('N2', UnitOutputDir + PathSeparator + 'obj'); // .obj files + end; + Options.Add('-v'); + Options.Add('-JPHNE'); + Options.Add('--BCB'); + AddPathOption('N0', UnitOutputDir); // .dcu files + AddPathOption('O', Format(BCBIncludePath, [Distribution.SourceDir, Distribution.SourcePath])); + AddPathOption('U', Format(BCBObjectPath, [Distribution.SourceDir, Distribution.SourcePath])); + end + else // Delphi + begin + if Debug then + begin + Options.Add('-$O-'); + Options.Add('-$W+'); + Options.Add('-$R+'); + Options.Add('-$Q+'); + Options.Add('-$D+'); + Options.Add('-$L+'); + Options.Add('-$Y+'); + UnitOutputDir := MakePath(Distribution.FLibDebugDirMask); + end + else + begin + Options.Add('-$O+'); + Options.Add('-$R-'); + Options.Add('-$Q-'); + Options.Add('-$C-'); + Options.Add('-$D-'); + UnitOutputDir := MakePath(Distribution.FLibDirMask); + end; + AddPathOption('N', UnitOutputDir); + AddPathOption('U', Distribution.SourcePath); + AddPathOption('R', Distribution.SourcePath); + end; + AddPathOption('I', Distribution.SourceDir); + SaveDir := GetCurrentDir; + Result := SetCurrentDir(Path); + {$IFDEF WIN32} + Win32Check(Result); + {$ELSE} + if Result then + {$ENDIF} + try + WriteLog(''); + WriteLog('Compiling .dcu files...'); + Result := Result and CompileUnits; + CopyResFiles(UnitOutputDir); + if OptionSelected(ioJclCopyHppFiles) then + begin + Result := Result and CopyHppFiles(UnitList, Target.VclIncludeDir); + WriteLog('Copying .hpp files...'); + end; + {$IFDEF KYLIX} + Options.Add('-P'); // generate position independent code (PIC) + WriteLog(''); + WriteLog('Compiling dpu files...'); + Result := Result and CompileUnits; + {$ENDIF KYLIX} + finally + SetCurrentDir(SaveDir); + end; + end; + if not Result then + InstallFailedOn(LibDescriptor); +end; + +procedure TJclInstallation.ConfigureBpr2Mak(const PackageFileName: string); +var + PackageDirectory: string; +begin + PackageDirectory := PathAddSeparator(ExtractFileDir(PackageFileName)); + if clProj2Mak in Target.CommandLineTools then + begin + Target.Bpr2Mak.Options.Clear; + Target.Bpr2Mak.Options.Add('-t' + ExtractRelativePath(PackageDirectory,Distribution.Path + Bcb2MakTemplate)); + end; + {$IFDEF KYLIX} + SetEnvironmentVar('OBJDIR', LibObjDir); + SetEnvironmentVar('BPILIBDIR', DcpPath); + SetEnvironmentVar('BPLDIR', BplPath); + {$ELSE KYLIX} + if clMake in Target.CommandLineTools then + begin + Target.Make.Options.Clear; + Target.Make.AddPathOption('DBPILIBDIR=', DcpPath); + Target.Make.AddPathOption('DBPLDIR=', BplPath); + if OptionSelected(ioJclCopyPackagesHppFiles) then + Target.Make.AddPathOption('DHPPDIR=', Target.VclIncludeDir); + end; + {$ENDIF KYLIX} +end; + +function TJclInstallation.Description(Option: TJediInstallOption): string; +begin + Result := InitData[Option].Caption; + + case Option of + ioTarget: + Result := Target.Description; + ioJclCopyHppFiles: + Result := Format(Result, [Target.VclIncludeDir]); + ioJclCopyPackagesHppFiles: + Result := Format(Result, [Target.VclIncludeDir]); + end; +end; + +{$IFDEF MSWINDOWS} +procedure TJclInstallation.CopyFakeXmlRtlPackage; +// replace missing xmlrtl.dcp in Delphi 2005 Personal by dummy package to allow expert installation +begin + { TODO : implement copying of fake xmlrtl.dcp to $(BDS)\Lib } +end; +{$ENDIF MSWINDOWS} + +function TJclInstallation.ExcludeEdition(ExcludeList: TStrings; Index: Integer; out Name: string): Boolean; +var + Editions: string; +begin + Name := ExcludeList[Index]; + if Pos('=', Name) > 0 then + Name := ExcludeList.Names[Index]; + Editions := ExcludeList.Values[Name]; + Result := (Editions = '') or (StrIPos(BorRADToolEditionIDs[Target.Edition], Editions) > 0); +end; + +function TJclDistribution.GetExamplesDir: string; +begin + Result := Path + 'examples'; +end; + +function DemoNameCompare(List: TStringList; Index1, Index2: Integer): Integer; +var + Name1, Name2: string; +begin + Name1 := ExtractFileName(List[Index1]); + Name2 := ExtractFileName(List[Index2]); + Result := CompareText(Name1, Name2); +end; + +function TJclInstallation.GetDemoList: TStringList; +begin + if not Assigned(FDemos) then + begin + FDemos := TStringList.Create; + EnumDirectories(Distribution.ExamplesDir, AddDemos); + Demos.CustomSort(DemoNameCompare); + end; + Result := FDemos; +end; + +function TJclDistribution.GetDemosPath: string; +begin + Result := PathAddSeparator(Path + 'examples'); +end; + +function TJclDistribution.GetHint(Option: TJediInstallOption): string; +begin + if Ord(Option) < Ord(ioJclLast) then + Result := InitData[Option].Hint; +end; + +function TJclInstallation.GetProgressTotal: Integer; +var + Option: TJediInstallOption; +begin + Result := 0; + if OptionSelected(ioJCL) then + for Option := Succ(ioJCL) to ioJclLast do + if OptionSelected(Option) then + Inc(Result, ProgressWeight(Option)); +end; + +function TJclInstallation.GetTool: IJediInstallTool; +begin + Result := Distribution.Tool; +end; + +procedure TJclInstallation.BuildUnitList(const SubDir: string; Units: TStrings); +var + I, J: Integer; + ExcludeList: TStringList; + ExcludeListFileName: string; + UnitName: string; + FileMask: string; +begin + FileMask := Format('%s' + PathSeparator + '%s' + PathSeparator + '*.pas', [Distribution.SourceDir, SubDir]); + BuildFileList(FileMask, faAnyFile, Units); + // check for units not to compile + ExcludeListFileName := MakePath(Format('%s' + PathSeparator + '%s.exc', [Distribution.FLibDirMask, SubDir])); + if FileExists(ExcludeListFileName) then + begin + ExcludeList := TStringList.Create; + try + ExcludeList.LoadFromFile(ExcludeListFileName); + for I := 0 to ExcludeList.Count - 1 do + if ExcludeEdition(ExcludeList, I, UnitName) then + begin + J := Units.IndexOf(UnitName); + if J <> Invalid then + Units.Delete(J); + end; + finally + ExcludeList.Free; + end; + end; + for I := 0 to Units.Count -1 do + Units[I] := Copy(Units[I], 1, Length(Units[I]) - Length('.pas')); +end; + +function TJclInstallation.DemoOption(DemoIndex: Integer): TJediInstallOption; +begin + Result := TJediInstallOption(Ord(ioJclLast) + 1 + DemoIndex); +end; + +function TJclInstallation.DemoOptionSelected(Index: Integer): Boolean; +begin + Result := OptionSelected(DemoOption(Index)); +end; + +function TJclInstallation.GetDemoExclusionList: TStrings; +var + I: Integer; + Strings: TStrings; + FileName: string; +begin + if not Assigned(FDemoExclusionList) then + begin + FDemoExclusionList := TStringList.Create; + {$IFDEF KYLIX} + FileName := MakePath(Distribution.DemosPath + 'k%d.exc'); + {$ELSE} + FileName := MakePath(Distribution.DemosPath + '%s.exc'); + {$ENDIF KYLIX} + if FileExists(FileName) then + begin + FDemoExclusionList.LoadFromFile(FileName); + Strings := TStringList.Create; + try + I := 0; + while I < FDemoExclusionList.Count do + begin + if ExcludeEdition(FDemoExclusionList, I, FileName) then + if ExtractFileExt(FileName) = '.exc' then + begin + Strings.LoadFromFile(Distribution.DemosPath + FileName); + FDemoExclusionList.AddStrings(Strings); + FDemoExclusionList.Delete(I); + end + else + begin + FDemoExclusionList[I] := FileName; + Inc(I); + end + else + FDemoExclusionList.Delete(I); + end; + finally + Strings.Free; + end; + end; + end; + Result := FDemoExclusionList; +end; + +function TJclInstallation.GetJclDcpPath: string; +begin + Result := Format('%slib\%s', [Distribution.Path, Target.VersionNumberStr]); +end; + +function TJclInstallation.GetUnits(const SourceDir: string): TStrings; +var + I: Integer; +begin + I := FUnits.IndexOf(SourceDir); + if I = Invalid then + begin + Result := TStringList.Create; + try + BuildUnitList(SourceDir, Result); + except + Result.Free; + end; + FUnits.AddObject(SourceDir, Result); + end + else + Result := FUnits.Objects[I] as TStrings; +end; + +function TJclInstallation.InitOptions: Boolean; +var + GUI: TObject; + {$IFDEF MSWINDOWS} + ExpertOptions: TJediInstallGUIOptions; + {$ENDIF MSWINDOWS} + InstallationNode, ProductNode, PackagesNode, ExpertsNode, DemosNode, + MakeNode, EnvNode, HelpNode, RepositoryNode, MapCreateNode, + MapLinkNode, BCBNode: TObject; + RunTimeInstallation: Boolean; + + function AddNode(Parent: TObject; Option: TJediInstallOption; + GUIOptions: TJediInstallGUIOptions = [goChecked]): TObject; + begin + if StoredOption(Option, goChecked in GUIOptions) then + Include(GUIOptions, goChecked) + else + Exclude(GUIOptions, goChecked); + Result := Tool.GUIAddOption(GUI, Parent, Option, Description(Option), GUIOptions); + end; + + function AddDemoNode(Parent: TObject; Index: Integer; + GUIOptions: TJediInstallGUIOptions = []): TObject; + var + Checked: Boolean; + begin + Checked := Distribution.FIniFile.ReadInteger(DemoSectionName, Demos[Index], 0) > 0; + if Checked then + Include(GUIOptions, goChecked) + else + Exclude(GUIOptions, goChecked); + Result := Tool.GUIAddOption(GUI, Parent, DemoOption(Index), + ExtractFileName(Demos[Index]), GUIOptions); + end; + + procedure AddDemoNodes; + var + I: Integer; + begin + DemosNode := AddNode(ProductNode, ioJclMakeDemos, [goExpandable, goNoAutoCheck]); + for I := 0 to Demos.Count - 1 do + AddDemoNode(DemosNode, I); + end; + + procedure AddMakeNodes(Parent: TObject; DebugSettings: Boolean); + const + Option: array[Boolean, Boolean] of TJediInstallOption = ( + (ioJclMakeRelease, ioJclMakeReleaseVClx), + (ioJclMakeDebug, ioJclMakeDebugVClx)); + var + Node: TObject; + begin + Node := AddNode(Parent, Option[DebugSettings, False], [goStandAloneParent, goChecked]); + if Target.SupportsVisualCLX then + AddNode(Node, Option[DebugSettings, True]); + end; + +begin + Result := Assigned(Target) and Target.Valid; + if not Result then + Exit; + + RunTimeInstallation := (Target.RadToolKind <> brBorlandDevStudio) + or ((Target.VersionNumber >= 3) and (bpDelphi32 in Target.Personalities)); + + GUI := Tool.OptionGUI(Target); + InstallationNode := AddNode(nil, ioTarget); + //InstallationNode.StateIndex := 0; + ProductNode := AddNode(InstallationNode, ioJCL); + + if RunTimeInstallation then + begin + AddNode(ProductNode, ioJclDefThreadSafe); + AddNode(ProductNode, ioJclDefDropObsoleteCode); + AddNode(ProductNode, ioJclDefMathPrecSingle, [goRadioButton]); + AddNode(ProductNode, ioJclDefMathPrecDouble, [goRadioButton]); + AddNode(ProductNode, ioJclDefMathPrecExtended, [goRadioButton, goChecked]); + + EnvNode := AddNode(ProductNode, ioJclEnv); + AddNode(EnvNode, ioJclEnvLibPath); + AddNode(EnvNode, ioJclEnvBrowsingPath); + AddNode(EnvNode, ioJclEnvDebugDCUPath); + end; + + if RunTimeInstallation then + begin + MakeNode := AddNode(ProductNode, ioJclMake, [goExpandable, goChecked]); + AddMakeNodes(MakeNode, False); + AddMakeNodes(MakeNode, True); + + if bpBCBuilder32 in Target.Personalities then + AddNode(MakeNode, ioJclCopyHppFiles); + {$IFDEF MSWINDOWS} + { TODO : Help integration for BDS } + if Target.RadToolKind <> brBorlandDevStudio then + with Distribution do + if (HlpHelpFileName <> '') or (ChmHelpFileName <> '') then + begin + HelpNode := AddNode(ProductNode, ioJclHelp); + if HlpHelpFileName <> '' then + AddNode(HelpNode, ioJclHelpHlp); + if ChmHelpFileName <> '' then + AddNode(HelpNode, ioJclHelpChm); + end; + { TODO : Object Repository access for BDS } + if Target.RadToolKind <> brBorlandDevStudio then + {$ENDIF MSWINDOWS} + begin + RepositoryNode := AddNode(ProductNode, ioJclExcDialog); + {$IFDEF MSWINDOWS} + AddNode(RepositoryNode, ioJclExcDialogVCL); + AddNode(RepositoryNode, ioJclExcDialogVCLSnd); + if Target.SupportsVisualCLX then + {$ENDIF MSWINDOWS} + AddNode(RepositoryNode, ioJclExcDialogCLX); + end; + end; + + PackagesNode := AddNode(ProductNode, ioJclPackages, [goStandAloneParent, goChecked]); + + if (bpBCBuilder32 in Target.Personalities) and RunTimeInstallation then + begin + if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 4) then + begin + BCBNode := AddNode(PackagesNode, ioJclDualPackages, [goStandAloneParent, goChecked]); + AddNode(BCBNode, ioJclCopyPackagesHppFiles); + end + else + AddNode(PackagesNode, ioJclCopyPackagesHppFiles); + end; + + MapCreateNode := AddNode(PackagesNode, ioJclMapCreate, [goExpandable, goStandaloneParent, goNoAutoCheck]); + + {$IFDEF MSWINDOWS} + MapLinkNode := AddNode(MapCreateNode, ioJclMapLink, [goExpandable, goStandaloneParent, goNoAutoCheck]); + AddNode(MapLinkNode,ioJclMapDelete, [goNoAutoCheck]); + + if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber = 3) + and (Target.Edition = deStd) then + CopyFakeXmlRtlPackage; + { TODO : + It has been reported that IDE experts don't work under Win98. + Leave these options unchecked for Win9x/WinME until that has been examined. } + if IsWinNT then + ExpertOptions := [goChecked] + else + ExpertOptions := []; + ExpertsNode := AddNode(PackagesNode, ioJclExperts, [goExpandable, goChecked]); + + if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber <= 2) then + // design packages are not loaded by C#Builder 1 and Delphi 8 + AddNode(ExpertsNode, ioJclExpertsDLL, [goRadioButton, goChecked]) + else if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 3) then + // expert DLLs are unstable on Delphi 2005 and BDS 2006 + // (problems while adding menu items in menu not yet loaded) + AddNode(ExpertsNode, ioJclExpertsDesignPackages, [goRadioButton, goChecked]) + else + begin + AddNode(ExpertsNode, ioJclExpertsDesignPackages, [goRadioButton, goChecked]); + AddNode(ExpertsNode, ioJclExpertsDLL, [goRadioButton]); + end; + + if RunTimeInstallation then + begin + AddNode(ExpertsNode, ioJclExpertDebug, ExpertOptions); + AddNode(ExpertsNode, ioJclExpertAnalyzer, ExpertOptions); + AddNode(ExpertsNode, ioJclExpertUses, ExpertOptions); + AddNode(ExpertsNode, ioJclExpertSimdView, ExpertOptions); + end; + AddNode(ExpertsNode, ioJclExpertFavorite, ExpertOptions); + AddNode(ExpertsNode, ioJclExpertVersionControl, [goNoAutoCheck]); + if (Target.RadToolKind <> brBorlandDevStudio) and (Target.VersionNumber <= 6) then + AddNode(ExpertsNode, ioJclExpertThreadNames, ExpertOptions); + {$ENDIF MSWINDOWS} + if RunTimeInstallation then + AddDemoNodes; + Tool.BPLPath[Target] := StoredBplPath; + Tool.DCPPath[Target] := StoredDcpPath; +end; + +function TJclInstallation.InstallSelectedOptions: Boolean; + + function BorRADToolVersionStr: string; + begin + Result := Format('%s Build %s ', [Target.Name, Target.IdeExeBuildNumber]); + end; + +var + Option: TJediInstallOption; +begin + Tool.UpdateStatus(Format(RsStatusMessage, [Target.Name])); + WriteLog(StrPadRight(BorRADToolVersionStr, 44, '=')); + Result := CheckDirectories; + if Result then + begin + CleanupRepository; + Defines.Clear; + Target.MapCreate := False; + Target.MapLink := False; + Target.MapDelete := False; + {$IFDEF MSWINDOWS} + if Target is TJclBDSInstallation then + TJclBDSInstallation(Target).DualPackageInstallation := False; + {$ENDIF MSWINDOWS} + for Option := ioJCL to ioJclLast do + if OptionSelected(Option) then + Result := Result and InstallOption(Option); + end; + WriteLog(''); +end; + +function TJclInstallation.InstallOption(Option: TJediInstallOption): Boolean; +begin + Result := True; + case Option of + ioJclDefThreadSafe: + Defines.Add('THREAD_SAFE'); + ioJclDefDropObsoleteCode: + Defines.Add('DROP_OBSOLETE_CODE'); + ioJclDefMathPrecSingle: + Defines.Add('MATH_SINGLE_PRECISION'); + ioJclDefMathPrecDouble: + Defines.Add('MATH_DOUBLE_PRECISION'); + ioJclDefMathPrecExtended: + Defines.Add('MATH_EXTENDED_PRECISION'); + ioJclMapCreate: + Target.MapCreate := True; + ioJclMapLink: + Target.MapLink := True; + ioJclMapDelete: + Target.MapDelete := True; + ioJclEnvLibPath: + if Target.AddToLibrarySearchPath(LibDir) and Target.AddToLibrarySearchPath(Distribution.SourceDir) then + WriteLog(Format(LineBreak + 'Added "%s;%s" to library path.', [LibDir, Distribution.SourceDir])); + ioJclEnvBrowsingPath: + if Target.AddToLibraryBrowsingPath(Distribution.SourcePath) then + WriteLog(Format(LineBreak + 'Added "%s" to library browsing path.', [Distribution.SourcePath])); + ioJclEnvDebugDCUPath: + if Target.AddToDebugDCUPath(DebugDcuDir) then + WriteLog(Format(LineBreak + 'Added "%s" to Debug DCU Path.', [DebugDcuDir])); + // ioJclMake: + ioJclMakeRelease: + Result := MakeUnits(False); + // ioJclMakeReleaseVClx: handled with ioJclMakeRelease + ioJclMakeDebug: + Result := MakeUnits(True); + // ioJclMakeDebugVClx: handled with ioJclMakeDebug + // ioJclCopyHppFiles: handled by CompileLibraryUnits + //{$IFDEF MSWINDOWS} + //ioJclDualPackages: handled by CompilePackages and InstallExpert + //{$ENDIF MSWINDOWS} + ioJclPackages: + Result := CompilePackages; + {$IFDEF MSWINDOWS} + // ioJclExperts: + ioJclExperts..ioJclExpertVersionControl: + Result := InstallExpert(Option); + // ioJclCopyPackagesHppFiles: handled by InstallPackageSourceFile + // ioJclExcDialog: + ioJclExcDialogVCL: + with Distribution do + AddDialogToRepository(VclDialogName, FVclDialogFileName, FVclDialogIconFileName, + BorRADToolRepositoryDesignerDfm); + ioJclExcDialogVCLSnd: + with Distribution do + AddDialogToRepository(VclDialogNameSend, FVclDialogSendFileName, + FVclDialogSendIconFileName, BorRADToolRepositoryDesignerDfm, FVclDialogFileName); + {$ENDIF MSWINDOWS} + ioJclExcDialogCLX: + with Distribution do + AddDialogToRepository(ClxDialogName, FClxDialogFileName, FClxDialogIconFileName, + BorRADToolRepositoryDesignerXfm); + {$IFDEF MSWINDOWS} + // ioJclHelp: + ioJclHelpHlp: + AddHelpToOpenHelp; + ioJclHelpChm: + AddHelpToIdeTools; + {$ENDIF MSWINDOWS} + ioJclMakeDemos: + MakeDemos; + end; + if not (Option in [ioJclMakeRelease, ioJclMakeDebug]) then + Progress(ProgressWeight(Option)); +end; + +function TJclInstallation.UninstallOption(Option: TJediInstallOption): Boolean; +begin + Result := True; + case Option of + ioJclEnvLibPath: + if Target.RemoveFromLibrarySearchPath(LibDir) and Target.RemoveFromLibrarySearchPath(Distribution.SourceDir) then + WriteLog(Format(LineBreak + 'Removed "%s;%s" from library path.', [LibDir, Distribution.SourceDir])); + ioJclEnvBrowsingPath: + if Target.RemoveFromLibraryBrowsingPath(Distribution.SourcePath) then + WriteLog(Format(LineBreak + 'Removed "%s" from library browsing path.', [Distribution.SourcePath])); + ioJclEnvDebugDCUPath: + if Target.RemoveFromDebugDCUPath(DebugDcuDir) then + WriteLog(Format(LineBreak + 'Removed "%s" from Debug DCU Path.', [DebugDcuDir])); + // ioJclMake: + ioJclMakeRelease: { TODO : Delete generated files }; + ioJclMakeDebug: { TODO : Delete generated files }; + ioJclCopyHppFiles: { TODO : Delete copied files }; + ioJclPackages: + Result := UninstallPackages; + {$IFDEF MSWINDOWS} + ioJclExperts..ioJclExpertVersionControl: + Result := UninstallExpert(Option); + // ioJclCopyPackagesHppFiles: + // ioJclExcDialog: + ioJclExcDialogVCL: + with Distribution do + RemoveDialogFromRepository(VclDialogName, VclDialogFileName); + ioJclExcDialogVCLSnd: + with Distribution do + RemoveDialogFromRepository(VclDialogNameSend, VclDlgSndFileName); + {$ENDIF MSWINDOWS} + ioJclExcDialogCLX: + with Distribution do + RemoveDialogFromRepository(ClxDialogName, ClxDialogFileName); + {$IFDEF MSWINDOWS} + // ioJclHelp: + ioJclHelpHlp: + RemoveHelpFromOpenHelp; + ioJclHelpChm: + RemoveHelpFromIdeTools; + ioJclMakeDemos: + ; + {$ENDIF MSWINDOWS} + end; + if not Distribution.Installing then + if not (Option in [ioJclMakeRelease, ioJclMakeDebug]) then + Progress(ProgressWeight(Option)); +end; + +procedure TJclInstallation.InstallationStarted; +begin + with FDistribution do + if Assigned(FOnStarting) then + FOnStarting(Target); +end; + +function TJclInstallation.InstallExpert( + const Option: TJediInstallOption): Boolean; +begin + if Option in [Low(ExpertPaths)..High(ExpertPaths)] then + begin + if (Option = ioJclExperts) or OptionSelected(ioJclExpertsDesignPackages) then + begin + // dual packages installation is useless for design time packages + {$IFDEF MSWINDOWS} + if Target.RadToolKind = brBorlandDevStudio then + TJclBDSInstallation(Target).DualPackageInstallation := False; + {$ENDIF MSWINDOWS} + Result := CompilePackage(FullPackageFileName(Target,ExpertPaths[Option]), True); + end + else + Result := CompileExpert(FullLibraryFileName(Target, ExpertPaths[Option]), True); + end + else + Result := False; +end; + +procedure TJclInstallation.InstallationFinished; +begin + with FDistribution do + if Assigned(FOnEnding) then + FOnEnding(Target); +end; + +procedure TJclInstallation.InstallFailedOn(const InstallObj: string); +begin + Tool.Dialog(Format(RsInstallFailed, [InstallObj, LogFileName]), dtError); +end; + +{$IFDEF MSWINDOWS} +function TJclInstallation.CompileExpert(const Name: string; InstallExpert: Boolean): Boolean; +var + ProjectFileName, ProjectBinaryFileName, ProjectDEFFileName, + ProjectDescription: string; + LibraryPeImage: TJclPeImage; + ExportFuncList: TJclPeExportFuncList; + Index: Integer; + DEFFile: TStrings; + FirstCompilationOk: Boolean; +const + WizardEntryPoint = 'INITWIZARD0001'; + // note (outchy) : I don't know if the parameter signature is constant + // if constant, the complete signature would be + // @*@JCLWizardInit$qqsx56System@%DelphiInterface$t28Toolsapi@IBorlandIDEServices%pqqrx47System@%DelphiInterface$t19Toolsapi@IOTAWizard%$orpqqrv$v + InternalEntryPoint = '@JCLWizardInit$'; +begin + ProjectFileName := PathAddSeparator(Distribution.Path) + Name; + + if InstallExpert then + WriteLog(Format(LineBreak + 'Installing expert %s...', [ProjectFileName])) + else + WriteLog(Format(LineBreak + 'Compiling expert %s...', [ProjectFileName])); + Tool.UpdateStatus(Format(RsStatusDetailMessage, [ExtractFileName(ProjectFileName), Target.Name])); + + if IsDelphiProject(ProjectFileName) and (bpDelphi32 in Target.Personalities) then + begin + if InstallExpert then + Result := Target.InstallExpert(ProjectFileName, BplPath, JclDcpPath) + else + Result := Target.CompileProject(ProjectFileName, BplPath, JclDcpPath); + end + else if IsBCBProject(ProjectFileName) and (bpBCBuilder32 in Target.Personalities) then + begin + ConfigureBpr2Mak(ProjectFileName); + // the compilation is done in 2 steps: + // - first compilation without changes, we try to find the internal export name + // for the wizard entry point function + // - second compilation with creation of an alias between the internal export name + // and the excepted export name + + ProjectDEFFileName := ChangeFileExt(ProjectFileName, CompilerExtensionDEF); + // first compilation + DEFFile := TStringList.Create; + try + // the linker doesn't like empty def files + DEFFile.Add('EXPORTS'); + DEFFile.SaveToFile(ProjectDEFFileName); + finally + DEFFile.Free; + end; + + Result := Target.CompileProject(ProjectFileName, BplPath, JclDcpPath); + + if Result then + begin + WriteLog(LineBreak + 'First compilation ok'); + LibraryPeImage := TJclPeImage.Create; + try + GetBPRFileInfo(ProjectFileName, ProjectBinaryFileName, @ProjectDescription); + ProjectBinaryFileName := PathAddSeparator(BplPath) + ProjectBinaryFileName; + + WriteLog(Format(LineBreak + 'Analysing expert %s for entry point %s...', [ProjectBinaryFileName, WizardEntryPoint])); + LibraryPeImage.FileName := ProjectBinaryFileName; + ExportFuncList := LibraryPeImage.ExportList; + + FirstCompilationOk := Assigned(ExportFuncList.ItemFromName[WizardEntryPoint]); + // the expected export name doesn't exist + if not FirstCompilationOk then + begin + Result := False; + WriteLog(LineBreak + 'Entry point not found'); + + // try to find the decorated entry point + // export names for pascal functions are: + // @UnitName@FunctionName$ParameterSignature + + for Index := 0 to ExportFuncList.Count - 1 do + if Pos(StrUpper(InternalEntryPoint), StrUpper(ExportFuncList.Items[Index].Name)) > 0 then + begin + WriteLog(Format(LineBreak + 'Internal entry point found %s', [ExportFuncList.Items[Index].Name])); + DEFFile := TStringList.Create; + try + DEFFile.Add('EXPORTS'); + DEFFile.Add(Format('%s=%s', [WizardEntryPoint, ExportFuncList.Items[Index].Name])); + DEFFile.SaveToFile(ProjectDEFFileName); + finally + DEFFile.Free; + end; + Result := True; + Break; + end; + end + else + begin + WriteLog(LineBreak + 'Entry point found, registering expert...'); + Target.RegisterExpert(ProjectBinaryFileName, ProjectDescription); + end; + finally + LibraryPeImage.Free; + end; + + if Result and (not FirstCompilationOk) then + begin + // second compilation + if InstallExpert then + Result := Target.InstallExpert(ProjectFileName, BplPath, JclDcpPath) + else + Result := Target.CompileProject(ProjectFileName, BplPath, JclDcpPath); + end + else if not Result then + WriteLog(LineBreak + 'Internal entry point not found'); + end + else + WriteLog(LineBreak + 'First compilation failed'); + end + else + Result := False; + + if Result then + WriteLog('...done.') + else + InstallFailedOn(ProjectFileName); +end; +{$ENDIF MSWINDOWS} + +function TJclInstallation.CompilePackage(const Name: string; InstallPackage: Boolean): Boolean; +var + PackageFileName: string; +{$IFNDEF KYLIX} + DpkPackageFileName: string; +{$ENDIF} +begin + PackageFileName := PathAddSeparator(Distribution.Path) + Name; + if InstallPackage then + WriteLog(Format(LineBreak + 'Installing package %s...', [PackageFileName])) + else + WriteLog(Format(LineBreak + 'Compiling package %s...', [PackageFileName])); + Tool.UpdateStatus(Format(RsStatusDetailMessage, [ExtractFileName(PackageFileName), Target.Name])); + + if IsDelphiPackage(PackageFileName) and (bpDelphi32 in Target.Personalities) then + begin + if InstallPackage then + Result := Target.InstallPackage(PackageFileName, BplPath, DcpPath) + else + begin + {$IFNDEF KYLIX} + if Target.RadToolKind = brBorlandDevStudio then + (Target as TJclBDSInstallation).CleanPackageCache(BinaryFileName(BplPath, PackageFileName)); + {$ENDIF KYLIX} + Result := Target.CompilePackage(PackageFileName, BplPath, DcpPath); + end; + end + else if IsBCBPackage(PackageFileName) and (bpBCBuilder32 in Target.Personalities) then + begin + ConfigureBpr2Mak(PackageFileName); + {$IFDEF KYLIX} + if InstallPackage then + Result := Target.InstallPackage(PackageFileName, BplPath, DcpPath) + else + Result := Target.CompilePackage(PackageFileName, BplPath, DcpPath); + {$ELSE} + + if Target.RadToolKind = brBorlandDevStudio then + (Target as TJclBDSInstallation).CleanPackageCache(BinaryFileName(BplPath, PackageFileName)); + + // to satisfy JVCL (and eventually other libraries), create a .dcp file; + // Note: it is put out to .bpl path to make life easier for JVCL + DpkPackageFileName := ChangeFileExt(PackageFileName, SourceExtensionDelphiPackage); + if InstallPackage then + Result := ((not FileExists(DpkPackageFileName)) + or Target.InstallPackage(DpkPackageFileName, BplPath, DcpPath)) + and Target.InstallPackage(PackageFileName, BplPath, DcpPath) + else + Result := ((not FileExists(DpkPackageFileName)) + or Target.CompilePackage(DpkPackageFileName, BplPath, DcpPath)) + and Target.CompilePackage(PackageFileName, BplPath, DcpPath); + {$ENDIF} + end + else + begin + Result := False; + WriteLog(Format(LineBreak + 'No personality supports the extension %s', [ExtractFileExt(PackageFileName)])); + end; + + if Result then + WriteLog('...done.') + else + InstallFailedOn(PackageFileName); +end; + +function TJclInstallation.CompilePackages: Boolean; +begin + {$IFDEF MSWINDOWS} + if Target.RadToolKind = brBorlandDevStudio then + TJclBDSInstallation(Target).DualPackageInstallation := OptionSelected(ioJclDualPackages); + {$ENDIF MSWINDOWS} + Result := CompilePackage(FullPackageFileName(Target, JclDpk), False); + if Target.SupportsVisualCLX then + Result := Result and CompilePackage(FullPackageFileName(Target, JclVClxDpk), False); + if (Target.VersionNumber >= 6) + or ((Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 3)) then + Result := Result and CompilePackage(FullPackageFileName(Target, JclVclDpk), False); +end; + +function TJclInstallation.LogFileName: string; +begin + Result := JclInstall.LogFileName(Target); +end; + +function TJclInstallation.MakePath(const FormatStr: string): string; +begin + {$IFDEF KYLIX} + Result := Format(FormatStr, [Target.VersionNumber]); + {$ELSE ~KYLIX} + Result := PathGetShortName(Format(FormatStr, [Target.VersionNumberStr])); + {$ENDIF ~KYLIX} +end; + +procedure TJclInstallation.MakeDemo(Index: Integer); +var + FileName: string; + CfgFileName: string; + Directory: string; +begin + FileName := Demos[Index]; + Directory := Distribution.DemosPath + ExtractFileDir(FileName); + FileName := ExtractFileName(FileName); + WriteLog(Format(LineBreak + RsBuildingMessage, [FileName])); + SetCurrentDir(Directory); + CfgFileName := ChangeFileExt(FileName, '.cfg'); + StringToFile(CfgFileName, Format( + '-e%s' + AnsiLineBreak + // Exe output dir + '-u%s' + AnsiLineBreak + // Unit directories + '-i%s', // Include path + [Distribution.BinDir, LibDir, Distribution.SourceDir])); + Target.DCC32.Execute(FileName); + FileDelete(CfgFileName); +end; + +function TJclInstallation.MakeDemos: Boolean; +var + I: Integer; + SaveDir: string; +begin + Tool.UpdateStatus(Format(RsBuildingDemosByTargetMessage, [Target.Name])); + WriteLog(LineBreak + RsBuildingDemosMessage + LineBreak); + Result := True; + SaveDir := GetCurrentDir; + for I := 0 to Demos.Count - 1 do + if DemoOptionSelected(I) then + MakeDemo(I); + SetCurrentDir(SaveDir); +end; + +function TJclInstallation.MakeUnits(Debug: Boolean): Boolean; +var + I: Integer; +begin + Result := True; + for I := Low(JclSourceDirs) to High(JclSourceDirs) do + begin + {$IFDEF MSWINDOWS} + if (JclSourceDirs[I] = 'visclx') and + not (OptionSelected(ioJclMakeReleaseVClx) or OptionSelected(ioJclMakeDebugVClx)) then + Continue; + {$ENDIF MSWINDOWS} + Result := Result and CompileLibraryUnits(JclSourceDirs[I], Debug); + end; +end; + +function TJclInstallation.OptionSelected(Option: TJediInstallOption): Boolean; +begin + Result := Tool.FeatureChecked(Ord(Option), Target); +end; + +procedure TJclInstallation.Progress(Steps: Integer); +begin + Distribution.InstallProgress(Steps); +end; + +function TJclInstallation.ProgressWeight(Option: TJediInstallOption): Integer; +begin + case Option of + ioJclEnvLibPath, + ioJclEnvBrowsingPath, + ioJclEnvDebugDCUPath: + Result := 1; + ioJclMakeRelease, + ioJclMakeDebug: + begin + Result := TotalUnitCount; + {$IFDEF KYLIX} + Result := Result * 2; // .dcu + .dpu + {$ENDIF KYLIX} + end; + ioJclMakeReleaseVClx, + ioJclMakeDebugVClx: + Result := 0; + ioJclCopyHppFiles: + Result := 2; + ioJclPackages: + Result := 10; + ioJclExpertDebug, + ioJclExpertAnalyzer, + ioJclExpertFavorite, + ioJclExpertThreadNames, + ioJclExpertUses, + ioJclExpertSimdView, + ioJclExpertVersionControl: + Result := 5; + ioJclCopyPackagesHppFiles: + Result := 2; + ioJclExcDialog, + ioJclExcDialogVCL, + ioJclExcDialogVCLSnd, + ioJclExcDialogCLX, + ioJclHelpHlp, + ioJclHelpChm: + Result := 1; + ioJclMakeDemos: + Result := 50; + else + Result := 0; + end; +end; + +procedure TJclInstallation.RemoveDialogFromRepository(const DialogName, DialogFileName: string); +begin + Target.Repository.RemoveObjects(DialogsPath, DialogFileName, BorRADToolRepositoryFormTemplate); + WriteLog(Format(LineBreak + 'Removed %s.', [DialogName])); +end; + +{$IFDEF MSWINDOWS} +procedure TJclInstallation.RemoveHelpFromIdeTools; +begin + { TODO : Implement } +end; + +procedure TJclInstallation.RemoveHelpFromOpenHelp; +begin + if Target.OpenHelp.RemoveHelpFile(Distribution.FJclHlpHelpFileName, JclHelpIndexName) then + WriteLog(Format(LineBreak + 'Removed %s from %s Online Help', [Distribution.FJclHlpHelpFileName, Target.RADToolName])); +end; +{$ENDIF MSWINDOWS} + +function TJclInstallation.Run: Boolean; +begin + Result := True; + if OptionSelected(ioJCL) then + begin + InstallationStarted; + try + Result := InstallSelectedOptions; + finally + InstallationFinished; + end; + end; + SaveOptions; +end; + +function TJclInstallation.Undo: Boolean; +begin + Result := True; + if OptionSelected(ioJCL) then + Result := UninstallSelectedOptions; + SaveOptions; +end; + +function TJclInstallation.UninstallPackage(const Name: string): Boolean; +var + PackageFileName: string; +begin + PackageFileName := Distribution.Path + Format(Name, [Target.VersionNumberStr]); + + {$IFNDEF KYLIX} + if Target.RadToolKind = brBorlandDevStudio then + (Target as TJclBDSInstallation).CleanPackageCache(BinaryFileName(StoredBPLPath, PackageFileName)); + {$ENDIF KYLIX} + + Result := Target.UninstallPackage(PackageFileName, StoredBPLPath, StoredDCPPath); + + // delete DCP files that were created to bpl path (old behavior) + FileDelete(PathAddSeparator(StoredBPLPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionDCP); + // delete DCP files that were created to target dcp path (old behavior) + FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionDCP); + // delete BPI files that were created to target dcp path (old behavior) + FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionBPI); + // delete LIB files that were created to target dcp path (old behaviour) + FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionLIB); + + { TODO : evtl. remove .HPP Files } + if Result then + WriteLog(Format(LineBreak + 'Removed package %s.', [Name])); +end; + +function TJclInstallation.UninstallPackages: Boolean; +begin + Result := UninstallPackage(FullPackageFileName(Target, JclDpk)); + if Target.SupportsVisualCLX then + Result := Result and UninstallPackage(FullPackageFileName(Target, JclVClxDpk)); + if Target.VersionNumber >= 6 then + Result := Result and UninstallPackage(FullPackageFileName(Target, JclVclDpk)); +end; + +{$IFDEF MSWINDOWS} +function TJclInstallation.UninstallExpert(const Option: TJediInstallOption): Boolean; + + function OldExpertBPLFileName(const BaseName: string): string; + const + OldExperts: array[ioJclExpertDebug..ioJclExpertVersionControl] of string = ( + 'JclDebugIde%s0.bpl', + 'ProjectAnalyzer%s0.bpl', + 'IdeOpenDlgFavorite%s0.bpl', + 'ThreadNameExpert%s0.bpl', + 'JediUses%s0.bpl', + 'JclSIMDView%s.bpl', + 'JclVersionControl'); + + var + I: TJediInstallOption; + begin + with Target do + for I := Low(OldExperts) to High(OldExperts) do + if BaseName = ExpertPaths[I] then + begin + Result := PathAddSeparator(StoredBPLPath) + Format(OldExperts[I], [VersionNumberStr]); + Break; + end; + end; + +var + BaseName: string; + BPLFileName: string; + PackageFileName: string; + LibraryFileName: string; +begin + Result := False; + + BaseName := ExpertPaths[Option]; + // uninstall package if it exists + PackageFileName := FullPackageFileName(Target, BaseName); + LibraryFileName := FullLibraryFileName(Target, BaseName); + + if FileExists(Distribution.Path + PackageFileName) then + begin + Result := UninstallPackage(PackageFileName); + // eventually remove old expert packages to avoid annoying package conflicts during IDE startup; + // for simplicity, .dcp files are not handled + BaseName := ExtractFileName(BaseName); + BPLFileName := OldExpertBPLFileName(BaseName); + FileDelete(BPLFileName); + Target.IdePackages.RemovePackage(BPLFileName); + end; + + if FileExists(Distribution.Path + LibraryFileName) then + begin + // delete DLL experts + Result := Target.UninstallExpert(Distribution.Path + LibraryFileName, StoredBPLPath); + end; +end; + +{$ENDIF MSWINDOWS} + +function TJclInstallation.UninstallSelectedOptions: Boolean; + + function BorRADToolVersionStr: string; + begin + Result := Format('%s Build %s ', [Target.Name, Target.IdeExeBuildNumber]); + end; + +var + Option: TJediInstallOption; + Success: Boolean; +begin + Result := True; + Tool.UpdateStatus(Format(RsUninstallMessage, [Target.Name])); + WriteLog(StrPadRight('Starting Uninstall process', 44, '.')); + for Option := ioJCL to ioJclLast do + if OptionSelected(Option) then + begin + // Don't stop uninstall process when one step fails + Success := UninstallOption(Option); + Result := Result and Success; + end; + WriteLog(''); +end; + +procedure TJclInstallation.SaveDemoOption(Index: Integer); +var + Value: Integer; +begin + Value := Invalid; + if OptionSelected(DemoOption(Index)) then + Value := JclBase.JclVersionBuild; + Distribution.FIniFile.WriteInteger(DemoSectionName, Demos[Index], Value); +end; + +procedure TJclInstallation.SaveOption(Option: TJediInstallOption); +var + Value: Integer; +begin + Value := Invalid; + if OptionSelected(Option) then + Value := JclBase.JclVersionBuild; + Distribution.FIniFile.WriteInteger(Target.Name, OptionToStr(Option), Value); +end; + +procedure TJclInstallation.SaveOptions; +var + I: Integer; + Option: TJediInstallOption; +begin + SaveOption(ioTarget); + for Option := ioJCL to ioJclLast do + SaveOption(Option); + for I := 0 to Demos.Count - 1 do + SaveDemoOption(I); + Distribution.FIniFile.WriteString(Target.Name, 'BPL-Path', Tool.BPLPath[Target]); + Distribution.FIniFile.WriteString(Target.Name, 'DCP-Path', Tool.DCPPath[Target]); +end; + +function TJclInstallation.StoredBplPath: string; +begin + Result := Distribution.FIniFile.ReadString(Target.Name, 'BPL-Path', Target.BPLOutputPath); +end; + +function TJclInstallation.StoredDcpPath: string; +begin + Result := Distribution.FIniFile.ReadString(Target.Name, 'DCP-Path', JclDcpPath); +end; + +function TJclInstallation.StoredOption(Option: TJediInstallOption; Default: Boolean = True): Boolean; +begin + case Distribution.FIniFile.ReadInteger(Target.Name, OptionToStr(Option), 0) of + Invalid: + Result := False; + 0: + Result := Default; + else + Result := True; + end; +end; + +function TJclInstallation.TotalUnitCount: Integer; +var + I: Integer; +begin + Result := 0; + for I := Low(JclSourceDirs) to High(JclSourceDirs) do + begin + {$IFDEF MSWINDOWS} + if (JclSourceDirs[I] = 'visclx') and + not (OptionSelected(ioJclMakeReleaseVClx) or OptionSelected(ioJclMakeDebugVClx)) then + Continue; + {$ENDIF MSWINDOWS} + with Units[JclSourceDirs[I]] do + Inc(Result, Count); + end; +end; + +procedure TJclInstallation.WriteLog(const Msg: string); +begin + if Assigned(FOnWriteLog) then + FOnWriteLog(Msg); +end; + +{ TJclDistribution } + +constructor TJclDistribution.Create; +begin + inherited; + FTargetInstalls := TObjectList.Create; + FTargetInstalls.OwnsObjects := True; + FIniFile := TMemIniFile.Create(ExtractFilePath(ParamStr(0)) + RsIniFileName); +end; + +destructor TJclDistribution.Destroy; +begin + FTargetInstalls.Free; + if Assigned(FIniFile) then + begin + FIniFile.UpdateFile; + FreeAndNil(FIniFile); + end; + inherited; +end; + +function TJclDistribution.CreateInstall(Target: TJclBorRADToolInstallation): Boolean; +var + Inst: TJclInstallation; +begin + if Supports(Target) then + try + Inst := TJclInstallation.Create(Self, Target); + FTargetInstalls.Add(Inst); + Inst.InitOptions; + except + end; + Result := True; +end; + +function TJclDistribution.DocFileName(const BaseFileName: string): string; +const + SDocFileMask = '%sdocs' + PathSeparator + '%s'; +begin + Result := Format(SDocFileMask, [FJclPath, BaseFileName]); +end; + +function TJclDistribution.FeatureInfoFileName(FeatureID: Cardinal): string; +begin + Result := DocFileName(Format('%.7x.info', [FeatureID])); +end; + +function TJclDistribution.GetTargetInstall(Installation: TJclBorRADToolInstallation): TJclInstallation; +var + I: Integer; +begin + for I := 0 to FTargetInstalls.Count - 1 do + begin + Result := TJclInstallation(FTargetInstalls[I]); + if Result.Target = Installation then + Exit; + end; + Result := nil; +end; + +procedure TJclDistribution.InitInstallationTargets; +begin + if not Tool.GetBorRADToolInstallations.Iterate(CreateInstall) then + raise EJediInstallInitFailure.CreateRes(@RsNoInstall); +end; + +function TJclDistribution.InitInformation(const ApplicationFileName: string): Boolean; +var + I: Integer; + ExceptDialogsPath: string; +begin + FJclPath := PathAddSeparator(ExpandFileName(PathExtractFileDirFixed(ApplicationFileName) + '..')); + {$IFDEF MSWINDOWS} + FJclPath := PathGetShortName(FJclPath); + {$ENDIF MSWINDOWS} + FLibDirMask := Format('%slib' + VersionDirExp, [FJclPath]); + FLibDebugDirMask := FLibDirMask + PathSeparator + 'debug'; + FLibObjDirMask := FLibDirMask + PathSeparator + 'obj'; + FJclBinDir := FJclPath + 'bin'; + FJclSourceDir := FJclPath + 'source'; + + FJclSourcePath := ''; + for I := Low(JclSourceDirs) to High(JclSourceDirs) do + FJclSourcePath := FJclSourcePath + + Format('%s' + PathSeparator + '%s' + PathSep, [FJclSourceDir, JclSourceDirs[I]]); + + {$IFDEF MSWINDOWS} + ExceptDialogsPath := PathGetShortName(FJclPath + DialogsPath); + FClxDialogFileName := AnsiUpperCase(ExceptDialogsPath + ClxDialogFileName); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + ExceptDialogsPath := FJclPath + DialogsPath; + FClxDialogFileName := ExceptDialogsPath + ClxDialogFileName; + {$ENDIF UNIX} + FClxDialogIconFileName := ChangeFileExt(FClxDialogFileName, '.ico'); + {$IFDEF MSWINDOWS} + FVclDialogFileName := AnsiUpperCase(ExceptDialogsPath + VclDialogFileName); + FVclDialogSendFileName := AnsiUpperCase(ExceptDialogsPath + VclDlgSndFileName); + FVclDialogIconFileName := ChangeFileExt(FVclDialogFileName, '.ico'); + FVclDialogSendIconFileName := ChangeFileExt(FVclDialogSendFileName, '.ico'); + {$ENDIF MSWINDOWS} + FJclChmHelpFileName := FJclPath + JclChmHelpFile; + FJclHlpHelpFileName := FJclPath + JclHlpHelpFile; + if not FileExists(FJclChmHelpFileName) then + FJclChmHelpFileName := ''; + if not FileExists(FJclHlpHelpFileName) then + FJclHlpHelpFileName := ''; + {$IFDEF MSWINDOWS} + // Reset ReadOnly flag for dialog forms + FileSetAttr(FClxDialogFileName, faArchive); + FileSetAttr(ChangeFileExt(FClxDialogFileName, '.xfm'), faArchive); + FileSetAttr(FVclDialogFileName, faArchive); + FileSetAttr(ChangeFileExt(FVclDialogFileName, '.dfm'), faArchive); + FileSetAttr(FVclDialogSendFileName, faArchive); + FileSetAttr(ChangeFileExt(FVclDialogSendFileName, '.dfm'), faArchive); + Result := FileExists(FClxDialogFileName) and FileExists(FClxDialogIconFileName) + and FileExists(FVclDialogFileName) and FileExists(FVclDialogIconFileName) + {$ELSE ~MSWINDOWS} + Result := True; + {$ENDIF ~MSWINDOWS}; + FJclReadmeFileName := DocFileName(RsReadmeFileName); + if FileExists(FJclReadmeFileName) then + Tool.Readme := FJclReadmeFileName; + if not Result then + raise EJediInstallInitFailure.CreateRes(@RsCantFindFiles); +end; + +procedure TJclDistribution.InitProgress; +var + I: Integer; +begin + FProgress := 0; + FProgressTotal := 0; + for I := 0 to FTargetInstalls.Count - 1 do + Inc(FProgressTotal, TJclInstallation(FTargetInstalls[I]).ProgressTotal); +end; + +function TJclDistribution.Install: Boolean; +var + I: Integer; +begin + // installation validation + Result := False; + for I := 0 to FTargetInstalls.Count - 1 do + if TJclInstallation(FTargetInstalls[I]).OptionSelected(ioJCL) + and not TJclInstallation(FTargetInstalls[I]).OptionSelected(ioJclPackages) + and (MessageDlg(RsPackageNodeNotSelected, mtWarning, [mbYes, mbNo], 0) <> mrYes) then + Exit; + + FInstalling := True; // tell UninstallOption not to call Progress() + Result := True; + try + InitProgress; + for I := 0 to FTargetInstalls.Count - 1 do + begin + TJclInstallation(FTargetInstalls[I]).Undo; + Result := Result and TJclInstallation(FTargetInstalls[I]).Run; + end; + finally + Tool.UpdateStatus(''); + FInstalling := False; + end; +end; + +function TJclDistribution.Uninstall: Boolean; +var + I: Integer; + Success: Boolean; +begin + Result := True; + try + InitProgress; + for I := 0 to FTargetInstalls.Count - 1 do + begin + Success := TJclInstallation(FTargetInstalls[I]).Undo; + Result := Result and Success; + end; + finally + Tool.UpdateStatus(''); + end; +end; + +procedure TJclDistribution.InstallProgress(Steps: Integer); +begin + if Steps > 0 then + begin + Inc(FProgress, Steps); + ShowProgress; + end; +end; + +function TJclDistribution.ReadmeFileName: string; +begin + Result := FJclReadmeFileName; +end; + +procedure TJclDistribution.SetOnWriteLog(Installation: TJclBorRADToolInstallation; Value: TTextHandler); +begin + TargetInstall[Installation].OnWriteLog := Value; +end; + +procedure TJclDistribution.SetOnEnding(Value: TInstallationEvent); +begin + FOnEnding := Value; +end; + +procedure TJclDistribution.SetOnProgress(Value: TInstallationProgressEvent); +begin + FOnProgress := Value; +end; + +procedure TJclDistribution.SetOnStarting(Value: TInstallationEvent); +begin + FOnStarting := Value; +end; + +procedure TJclDistribution.SetTool(const Value: IJediInstallTool); +begin + FTool := Value; + InitInformation(ParamStr(0)); + InitInstallationTargets; +end; + +procedure TJclDistribution.ShowProgress; +var + Percent: Integer; +begin + if (FProgressTotal > 0) and Assigned(FOnProgress) then + begin + Percent := (FProgress * 100) div FProgressTotal; + if Percent <> FProgressPercent then + begin + FProgressPercent := Percent; + FOnProgress(Percent); + end; + end; +end; + +function TJclDistribution.Supports(Target: TJclBorRADToolInstallation): Boolean; +begin + {$IFDEF KYLIX} + Result := Target.VersionNumber = 3; + {$ELSE ~KYLIX} + case Target.RadToolKind of + brDelphi : + Result := Target.VersionNumber in [5, 6, 7]; + brCppBuilder : + Result := Target.VersionNumber in [5, 6]; + brBorlandDevStudio : + Result := Target.VersionNumber in [1, 2, 3, 4]; + else + Result := False; + end; + {$ENDIF ~KYLIX} +end; + +// History: + +// $Log: JclInstall.pas,v $ +// Revision 1.90 2006/02/09 13:57:33 outchy +// Delete old compiler files +// +// Revision 1.89 2006/02/05 13:26:14 outchy +// dcp, bpi and lib files are created in \lib\ver +// +// Revision 1.88 2006/02/02 20:33:39 outchy +// Package cache cleaned +// +// Revision 1.87 2006/01/15 00:51:22 outchy +// cvs support in version control expert +// version control expert integration in the installer +// +// Revision 1.86 2006/01/13 16:52:00 outchy +// Warning of packages are not installed. +// +// Revision 1.85 2006/01/06 18:15:15 outchy +// hpp node moved as a child of the dual package node when supported +// +// Revision 1.84 2005/12/26 18:03:41 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.83 2005/12/04 10:10:57 obones +// Borland Developer Studio 2006 support +// +// Revision 1.82 2005/11/13 17:05:01 uschuster +// some fixes for Kylix +// +// Revision 1.81 2005/11/12 19:00:32 outchy +// map-files node moved inside the packages node. +// +// Revision 1.80 2005/11/10 23:59:50 outchy +// Map-file operations not added when not runned on Windows. +// +// Revision 1.79 2005/11/10 22:16:31 outchy +// Added creation/link/deletion of MAP files for packages. +// +// Revision 1.78 2005/11/08 00:18:32 outchy +// Fixed AV when DCC32.exe is missing. +// +// Revision 1.77 2005/10/28 04:38:53 rrossmair +// - fixes related to package uninstallation, and more +// +// Revision 1.76 2005/10/27 01:50:28 rrossmair +// - sort demo list alphabethically +// +// Revision 1.75 2005/10/26 06:30:38 rrossmair +// - TJclInstallation.UninstallExpert now also handles old expert package names +// +// Revision 1.74 2005/10/22 00:39:34 outchy +// JclBaseExpert is now correctly uninstalled. +// +// Revision 1.73 2005/10/20 23:13:32 outchy +// Experts are now generated by the package generator. +// No WEAKPACKAGEUNIT in design-time packages. +// +// Revision 1.72 2005/10/18 23:09:56 rrossmair +// - updated Installer for new package naming rules +// +// Revision 1.70 2005/09/23 22:46:31 rrossmair +// - changed to ensure that TInstallation.Demos is assigned when needed; likewise DemoExclusionList +// - some refactoring +// +// Revision 1.69 2005/09/18 20:13:10 rrossmair +// - several additions/minor fixes +// +// Revision 1.68 2005/08/22 19:30:58 rrossmair +// - TJclInstallation.BuildUnitList fault tolerance improved +// +// Revision 1.67 2005/08/22 02:08:40 rrossmair +// - implemented ability to specify which demos are to be built +// +// Revision 1.66 2005/08/06 11:19:34 rrossmair +// - demo building improved: handles exclusion files etc. +// +// Revision 1.65 2005/08/01 04:52:02 rrossmair +// - (basic) support for compilation of examples +// +// Revision 1.64 2005/07/28 21:57:49 outchy +// JEDI Installer can now install design-time packages for C++Builder 5 and 6 +// +// Revision 1.63 2005/03/24 20:41:32 rrossmair +// - fixed installation progress computation. +// +// Revision 1.62 2005/03/23 04:28:49 rrossmair +// - removed make -fBCB5-dcc32.cfg.mak (handled by build.exe now) +// +// Revision 1.61 2005/03/22 03:23:18 rrossmair +// - fixed recent changes +// +// Revision 1.60 2005/03/21 11:09:49 obones +// Now calls BCB5-dcc32.cfg.mak if required +// +// Revision 1.59 2005/03/21 04:03:58 rrossmair +// - workarounds for DCC32 126 character path limit +// +// Revision 1.57 2005/03/16 18:11:33 rrossmair +// - "Copy HPP files to ..." options now checked by default. +// +// Revision 1.56 2005/03/14 16:10:43 rrossmair +// - compiler hints resolved +// +// Revision 1.55 2005/03/14 08:46:47 rrossmair +// - check-in in preparation for release 1.95 +// +// Revision 1.54 2005/03/14 02:21:34 rrossmair +// - changed Expert naming convention to include Delphi/BCB infix (D|C) +// +// Revision 1.53 2005/03/05 06:33:17 rrossmair +// - support for some conditional defines added. +// +// Revision 1.52 2005/02/28 20:19:05 uschuster +// changes for Uses wizard +// +// Revision 1.51 2005/02/23 08:32:30 rrossmair +// - TJclInstallation: replaced Target.DCC.Options.Clear by Target.DCC.SetDefaultOptions. +// Some cleanup. +// +// Revision 1.50 2005/02/05 05:16:18 rrossmair +// - check-in for release 1.94.1.1802 +// +// Revision 1.49 2005/02/04 05:19:41 rrossmair +// - some uninstall support finally functional +// +// Revision 1.48 2005/02/03 06:15:41 rrossmair +// - fixed for Kylix +// +// Revision 1.47 2005/02/03 05:22:17 rrossmair +// - more uninstall support (still unfinished) +// +// Revision 1.46 2004/12/23 05:32:28 rrossmair +// - fixed for Kylix +// +// Revision 1.45 2004/12/23 05:09:26 rrossmair +// - except dialog and help integration disabled for D 2005 +// +// Revision 1.44 2004/12/15 21:49:35 rrossmair +// - denotes D2005 as supported now +// +// Revision 1.43 2004/12/08 18:25:07 rrossmair +// - fixed TJclInstallation.StoredOption so that Default parameter gets evaluated +// +// Revision 1.42 2004/12/08 18:14:49 rrossmair +// - all install options now selected by default +// - minor fixes +// +// Revision 1.41 2004/11/18 10:14:54 rrossmair +// - changes for release 1.93 +// +// Revision 1.40 2004/11/17 06:34:01 marquardt +// suppress warning about unused UninstallOption +// +// Revision 1.39 2004/11/14 12:08:05 rrossmair +// - some precautions & minor fixes +// +// Revision 1.38 2004/11/14 05:55:55 rrossmair +// - installer refactoring (continued) +// +// Revision 1.37 2004/11/10 05:18:11 rrossmair +// - fixed for Kylix +// +// Revision 1.36 2004/11/09 07:51:37 rrossmair +// - installer refactoring (incomplete) +// + +end. diff --git a/official/1.96/install/JediInstall.pas b/official/1.96/install/JediInstall.pas new file mode 100644 index 0000000..8f60215 --- /dev/null +++ b/official/1.96/install/JediInstall.pas @@ -0,0 +1,215 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ 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 JediInstallIntf.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): Robert Rossmair (crossplatform & BCB support) } +{ } +{ Last modified: $Date: 2006/01/15 00:51:22 $ } +{ } +{**************************************************************************************************} + +unit JediInstall; + +interface + +uses + SysUtils, Classes, + JclSysUtils, JclBorlandTools; + +type + TJediInstallOption = + ( + ioTarget, + ioJCL, + ioJclDefThreadSafe, + ioJclDefDropObsoleteCode, + ioJclDefMathPrecSingle, + ioJclDefMathPrecDouble, + ioJclDefMathPrecExtended, + ioJclMapCreate, + ioJclMapLink, + ioJclMapDelete, + ioJclEnv, + ioJclEnvLibPath, + ioJclEnvBrowsingPath, + ioJclEnvDebugDCUPath, + ioJclMake, + ioJclMakeRelease, + ioJclMakeReleaseVClx, + ioJclMakeDebug, + ioJclMakeDebugVClx, + ioJclCopyHppFiles, + ioJclDualPackages, // must be before ioJclPackages + ioJclPackages, + ioJclExpertsDesignPackages, + ioJclExpertsDLL, + ioJclExperts, + ioJclExpertDebug, + ioJclExpertAnalyzer, + ioJclExpertFavorite, + ioJclExpertThreadNames, + ioJclExpertUses, + ioJclExpertSimdView, + ioJclExpertVersionControl, + ioJclCopyPackagesHppFiles, + ioJclExcDialog, + ioJclExcDialogVCL, + ioJclExcDialogVCLSnd, + ioJclExcDialogCLX, + ioJclHelp, + ioJclHelpHlp, + ioJclHelpChm, + ioJclMakeDemos // = ioJclLast, see below. + ); + + TJediInstallGUIOption = + ( + goExpandable, + goRadioButton, + goNoAutoCheck, // do not auto-check when the parent node gets checked + goStandaloneParent, // do not auto-uncheck when all child nodes are unchecked + goChecked + ); + TJediInstallGUIOptions = set of TJediInstallGUIOption; + + TInstallOptionData = record + Parent: TJediInstallOption; + Caption: string; + Hint: string; + end; + +const + ioJclLast = ioJclMakeDemos; +// Significand: array[TJclBorRadToolKind] of Char = ('D', 'C', 'D'); + {$IFDEF KEEP_DEPRECATED} + Prefixes: array[brDelphi..brCppBuilder] of Char = ('D', 'C'); + {$ENDIF KEEP_DEPRECATED} + +type + TDialogType = (dtWarning, dtError, dtInformation, dtConfirmation); + TDialogResponse = (drYes, drNo, drOK, drCancel); + TDialogResponses = set of TDialogResponse; + + TInstallationEvent = procedure (Installation: TJclBorRADToolInstallation) of object; + TInstallationProgressEvent = procedure (Percent: Cardinal) of object; + + EJediInstallInitFailure = class(Exception); + + IJediInstallTool = interface + ['{85408C67-92B5-42D0-84E0-D30201C0400D}'] + function Dialog(const Text: string; DialogType: TDialogType = dtInformation; + Options: TDialogResponses = [drOK]): TDialogResponse; + function GetBPLPath(Installation: TJclBorRADToolInstallation): string; + function GetDCPPath(Installation: TJclBorRADToolInstallation): string; + function FeatureChecked(FeatureID: Cardinal; Installation: TJclBorRADToolInstallation): Boolean; + function GetBorRADToolInstallations: TJclBorRADToolInstallations; + function OptionGUI(Installation: TJclBorRADToolInstallation): TObject; + function GUIAddOption(GUI, Parent: TObject; Option: TJediInstallOption; const Text: string; + GUIOptions: TJediInstallGUIOptions): TObject; + procedure SetBPLPath(Installation: TJclBorRADToolInstallation; const Value: string); + procedure SetDCPPath(Installation: TJclBorRADToolInstallation; const Value: string); + procedure SetReadme(const FileName: string); + procedure UpdateInfo(Installation: TJclBorRADToolInstallation; const InfoText: string); + procedure UpdateStatus(const Text: string); + procedure WriteInstallLog(Installation: TJclBorRADToolInstallation; const Text: string); + property BorRADToolInstallations: TJclBorRADToolInstallations read GetBorRADToolInstallations; + property BPLPath[Installation: TJclBorRADToolInstallation]: string read GetBPLPath write SetBPLPath; + property DCPPath[Installation: TJclBorRADToolInstallation]: string read GetDCPPath write SetDCPPath; + property Readme: string write SetReadme; + end; + + IJediInstall = interface + ['{2C4A8C85-18BB-4A67-B37F-806C60632569}'] + function FeatureInfoFileName(FeatureID: Cardinal): string; + function GetHint(Option: TJediInstallOption): string; + function InitInformation(const ApplicationFileName: string): Boolean; + function Install: Boolean; + function Uninstall: Boolean; + function ReadmeFileName: string; + procedure SetTool(const Value: IJediInstallTool); + procedure SetOnProgress(Value: TInstallationProgressEvent); + function Supports(Installation: TJclBorRADToolInstallation): Boolean; + procedure SetOnWriteLog(Installation: TJclBorRADToolInstallation; Value: TTextHandler); + procedure SetOnStarting(Value: TInstallationEvent); + procedure SetOnEnding(Value: TInstallationEvent); // OnEnding called on success only + end; + +function OptionToStr(const Option: TJediInstallOption): string; + +resourcestring + RsCantFindFiles = 'Can not find installation files, check your installation.'; + RsCloseRADTool = 'Please close all running instances of Delphi/C++Builder IDE before the installation.'; + RsConfirmInstall = 'Are you sure to install all selected features?'; + RsInstallSuccess = 'Installation finished'; + RsInstallFailure = 'Installation failed.'#10'Check compiler output for details.'; + RsNoInstall = 'There is no Delphi/C++Builder installation on this machine. Installer will close.'; + RsUpdateNeeded = 'You should install latest Update Pack #%d for %s.'#13#10 + + 'Would you like to open Borland support web page?'; + +implementation + +uses + TypInfo; + +function OptionToStr(const Option: TJediInstallOption): string; +begin + Result := GetEnumName(TypeInfo(TJediInstallOption), Ord(Option)); +end; + +// History: + +// $Log: JediInstall.pas,v $ +// Revision 1.19 2006/01/15 00:51:22 outchy +// cvs support in version control expert +// version control expert integration in the installer +// +// Revision 1.18 2005/12/26 18:03:41 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.17 2005/12/04 10:10:57 obones +// Borland Developer Studio 2006 support +// +// Revision 1.16 2005/11/10 22:16:31 outchy +// Added creation/link/deletion of MAP files for packages. +// +// Revision 1.15 2005/10/28 04:38:53 rrossmair +// - fixes related to package uninstallation, and more +// +// Revision 1.14 2005/08/01 04:52:03 rrossmair +// - (basic) support for compilation of examples +// +// Revision 1.13 2005/07/28 21:57:49 outchy +// JEDI Installer can now install design-time packages for C++Builder 5 and 6 +// +// Revision 1.12 2005/03/05 06:33:17 rrossmair +// - support for some conditional defines added. +// +// Revision 1.11 2005/02/28 20:19:07 uschuster +// changes for Uses wizard +// +// Revision 1.10 2005/02/03 05:22:17 rrossmair +// - more uninstall support (still unfinished) +// +// Revision 1.9 2004/11/14 05:55:55 rrossmair +// - installer refactoring (continued) +// +// Revision 1.8 2004/11/09 07:51:37 rrossmair +// - installer refactoring (incomplete) +// + +end. diff --git a/official/1.96/install/JediInstaller.bdsproj b/official/1.96/install/JediInstaller.bdsproj new file mode 100644 index 0000000..970e710 --- /dev/null +++ b/official/1.96/install/JediInstaller.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JediInstaller.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + True + True + + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + 4194304 + + False + + + ..\bin + ..\lib\d10 + + + $(BDS)\lib\Debug;..\source;..\source\common;..\source\windows + + JCLINSTALL + + False + + + + + + False + + + True + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + Project JEDI + Jedi installer + 1.0.0.0 + JediInstaller + Copyright (C) 1999, 2005 Project JEDI + + JediInstaller.dpr + Jedi Installer + 2.1 + + + + $00000000 + + + + diff --git a/official/1.96/install/JediInstaller.cfg b/official/1.96/install/JediInstaller.cfg new file mode 100644 index 0000000..9033a01 --- /dev/null +++ b/official/1.96/install/JediInstaller.cfg @@ -0,0 +1,3 @@ +-E"..\bin" +-N"." +-DJCLINSTALL diff --git a/official/1.96/install/JediInstaller.dof b/official/1.96/install/JediInstaller.dof new file mode 100644 index 0000000..c0b0cb9 --- /dev/null +++ b/official/1.96/install/JediInstaller.dof @@ -0,0 +1,15 @@ +[Directories] +OutputDir=..\bin +UnitOutputDir=. +SearchPath=..\source;..\source\common;..\source\windows +Conditionals=JCLINSTALL +[Version Info Keys] +CompanyName=Project JEDI +FileDescription=Jedi installer +FileVersion=2.1.0.2057 +InternalName=JediInstaller +LegalCopyright=Copyright (C) 1999, 2005 Project JEDI +LegalTrademarks= +OriginalFilename=JediInstaller.dpr +ProductName=Jedi Installer +ProductVersion=2.0 diff --git a/official/1.96/install/JediInstaller.dpr b/official/1.96/install/JediInstaller.dpr new file mode 100644 index 0000000..b82d130 --- /dev/null +++ b/official/1.96/install/JediInstaller.dpr @@ -0,0 +1,19 @@ +program JediInstaller; + +uses + Forms, + JclInstall in 'JclInstall.pas', + JediInstall in 'JediInstall.pas', + JediInstallerMain in 'JediInstallerMain.pas' {MainForm}, + ProductFrames in 'ProductFrames.pas' {ProductFrame: TFrame}, + JclBorlandTools in '..\source\common\JclBorlandTools.pas', + JclResources in '..\source\common\JclResources.pas'; + +{$R *.res} + +begin + Application.Initialize; + Application.Title := 'JEDI Installer'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/install/JediInstaller.res b/official/1.96/install/JediInstaller.res new file mode 100644 index 0000000..472f2e4 Binary files /dev/null and b/official/1.96/install/JediInstaller.res differ diff --git a/official/1.96/install/JediInstallerMain.dfm b/official/1.96/install/JediInstallerMain.dfm new file mode 100644 index 0000000..5fc1a68 --- /dev/null +++ b/official/1.96/install/JediInstallerMain.dfm @@ -0,0 +1,783 @@ +object MainForm: TMainForm + Left = 347 + Top = 123 + Width = 800 + Height = 608 + ActiveControl = QuitBtn + Caption = 'JEDI Installer' + Color = clBtnFace + Constraints.MinHeight = 300 + Constraints.MinWidth = 500 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'helvetica' + Font.Pitch = fpVariable + Font.Style = [] + OldCreateOrder = True + Position = poScreenCenter + Scaled = False + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + TextHeight = 14 + object StatusBevel: TBevel + Left = 8 + Top = 549 + Width = 369 + Height = 19 + Anchors = [akLeft, akRight, akBottom] + end + object Bevel1: TBevel + Left = 8 + Top = 534 + Width = 775 + Height = 9 + Anchors = [akLeft, akRight, akBottom] + Shape = bsTopLine + end + object StatusLabel: TLabel + Left = 16 + Top = 551 + Width = 353 + Height = 14 + Anchors = [akLeft, akRight, akBottom] + AutoSize = False + Caption = 'StatusLabel' + end + object TitlePanel: TPanel + Left = 0 + Top = 0 + Width = 792 + Height = 49 + Align = alTop + BevelWidth = 2 + BorderStyle = bsSingle + Color = 9981440 + TabOrder = 3 + object JediImage: TImage + Left = 662 + Top = 8 + Width = 116 + Height = 31 + Cursor = crHandPoint + Anchors = [akTop, akRight] + AutoSize = True + Picture.Data = { + 07544269746D617042120000424D421200000000000036040000280000007400 + 00001F00000001000800000000000C0E00000000000000000000000100000001 + 0000FFFFFF000808080010101000181818002121210029292900313131003939 + 3900424242004A4A4A00525252005A5A5A00636363006B6B6B00737373007B7B + 7B00848484008C8C8C00949494009C9C9C00A5A5A500ADADAD00B5B5B500BDBD + BD00C6C6C600CECECE00D6D6D600DEDEDE00E7E7E700EFEFEF00F7F7F700E7E7 + EF00EFEFF700CECED600D6D6DE00DEDEE700A5A5AD00ADADB50094949C009C9C + A50084848C00E7E7F7006B6B73007B7B840063636B0052525A00292931002121 + 290042425200181821001818290008081000101021000808180039425A00D6DE + EF00CED6E700B5BDCE00ADB5C600525A6B0029314200C6CEDE00A5ADBD00DEE7 + F700D6DEE700949CA500CEDEEF00C6D6E700A5B5C600525A63008C9CAD00A5BD + D6003139420010182100E7EFF700CED6DE00C6CED600ADB5BD00A5ADB5008C94 + 9C00BDCEDE00B5C6D6009CADBD004A525A00BDD6EF000810180010213100DEE7 + EF0039424A0018212900A5BDCE00849CAD00BDD6E7009CB5C600CEE7F700CEDE + E700ADBDC6008C9CA5004A5A6300C6D6DE00A5B5BD0084949C0063737B00DEEF + F700BDCED600B5C6CE009CADB50094A5AD007B8C9400C6DEE700A5BDC600849C + A500B5CED6009CB5BD0094ADB5008CA5AD007B949C00E7EFEF00EFF7F700F7FF + FF00CED6D600DEE7E700B5BDBD00A5ADAD00BDC6C6008C949400949C9C00848C + 8C00737B7B00E7F7F7006B737300C6D6D600ADBDBD00B5C6C600BDCECE00A5B5 + B5005A6363009CADAD008C9C9C0094A5A50084949400BDD6D600ADC6C6009CB5 + B500849C9C0094B5B500182121001829290008101000BDCEC6009CADA500CEDE + D600C6D6CE00E7EFE700CED6CE00D6DED6006B736B0010181000EFEFE700F7F7 + EF00FFFFF700CECEC600DEDED600E7E7DE00BDBDB500ADADA500C6C6BD00A5A5 + 9C008C8C840084847B00CECEBD005A5A5200ADAD9C009C9C8C004A4A42004242 + 3900EFE7CE00B5AD9C0029211000BDB5A500C6A56B00C6B59C00CEC6BD00ADA5 + 9C00F7EFE700DED6CE00D6CEC600B5ADA5009C948C00948C8400EFDECE00A57B + 5200E7DED600C6BDB500B5A59C0094847B009C8C84004A393100634A4200EFE7 + E700CEC6C600E7DEDE00BDB5B500B5ADAD00C6BDBD00A59C9C00BDADAD00C6B5 + B5005A525200B5A5A500AD9C9C009C8C8C00A59494004A4242008C7B7B003931 + 3100A58C8C009C848400947B7B005A4A4A008C737300846B6B007B6363008C6B + 6B007B5A5A002118180073525200634242005A313100522929004A2121004218 + 180052212900734A52005A313900522931004A2129004A18210094737B008463 + 6B0073525A006B4A52004A293100AD949C00A58C94009C848C00EFE7EF00F7EF + F700FFF7FF00D6CED60039313900211821001810180010081000100818000000 + 0000A903FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00BBBBBBB3B3BBB3BBB3 + BBB3BBB3B3BBB3B3BBB3BBB3BBB3BBB3BBB3BBB3B3BBB3B3B3BBB3BBB3BBB3BB + B3BBBBB3BBBBB3BBB3BBB3BBB3BBB3BBB3B3BBB3BBB3BBB3BBB3B3BBB3BBB3BB + B3BBB3BBB3BBB3BBBBBBBBBBB3B3BBB3BBB3B3DDEBE4EBE5DFA2BACFC7C900BA + E5EDEBDCBBBBB3B3BBFF00C1C1C1C1A4A4C1C1A4C1A4C1C1A4C1A4A4C1A4C1A4 + C1A4C1A4C1C1A4C1A4C1A4C1A4C1A4C1A4C1A4C1A4C1C1C1A4C1C1A4C1C1A4C1 + A4C1A4C1C1A4C1A4C1A4C1A4C1C1A4C1A4C1A4C1A4C1A4C1A4C1C1A4C1C1C1C1 + C1A4C1A4C1C1A4C1DCEBE5E31E009E1AD11D1BEADED9EAE8C4C1C1A4C1FF00B6 + B6A6B6B6B6B6B6B6B6B6A6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6 + B6B6B6B6B6B6B6B6B6B6A6B6B6A6B6B6B6B6B6B6B6B6B6A6B6B6B6B6B6B6B6B6 + A6B6A6B6B6B6B6B6B6B6B6B6B6A6B6B6B6A6B6A6B6B6B6B6B6A6B6A6AAC3EBE5 + F4C7F4DF20BAEADA0000B6EAEBC4B6B6B6FF00A1BABABABABAA1BAA1BABABAA1 + BABAA1BABABABABAA1BABABAA1BABAA1BAA1BAA1BAA1BAA1BABAA1BAA1BABABA + BABABAA1A1BAA1BABAA1BABAA1BABAA1BABAA1BABABABABABABABAA1BAA1BAA1 + BABAA1BABABABABAA1BABAA1BABABABABABAD2EBE5EADD00C9E5EF001DD600CA + E5EBC4BABAFF001AB91A1A1A1AB9B9B9B91AB9B9B91AB9A21AB91AB9B9B91A1A + B91A1AB9B9B9B91AB9B9B9B9B91AB9B9A2B91A1A1AB91AB9B9B9B9B91AB9B91A + B9B91AB9A21AB9B91AB91A1AB91A1AB9B9B9B9B9B91AB9B91AB9B91AB9B91AB9 + B91AB91AB91AB9BCEBE6D81AEADC001CE9D200BBEDECEBB7A2FF00C0A2A219CA + A4CA17A2A2A2A2A2A2A2BA131313A2A2177D1215A2A2C815822A2C9C7D12A2A2 + A1CB802C8213A4C0A2C812137E137E13CAA2A21610800E0D8013A2A2A2A12714 + 13A4C0A2A2A2A2187B101028CDBAA2A2A21313137E141414A2171413D5EBEBE4 + E000C9E2D100CFE8E2D1EAEBD2FF00A3A3A37B41746C18A3A3C9A3A3A3A34D85 + 3E60A3A36B84728BA3197B4C689B4B1B9860A9A34E914B8698696B14A3237C84 + 86691C8E4DA3787A86851B9922251AA3A322224B4027A3A3A3A316781B4A6983 + 607E14A340864322401D1E16A31E1E766CFAEBE6DC00D1D200C8ECF01C00CFE5 + E5FF001CC7C77E6A4E6A65C7C79EC7C7C7C7896A916AC799643E854EC71A526E + 64916A724E894E19274D718564858318C71A8660697C69A27CC986869A4B6319 + 401C2CC7C71C401F76A5C7C7C7C74019691A404A1F760CC775764A811E374D15 + 9EFE9DFD02FD09EBEBD20000CFE4F5A01C00CEEAEAFF009F9F1D15898B896A1D + 9F1D9F1D9F1D7B6471211D9F7C868F4E1D21608539211C3A606A8E18698564BA + 218540849F1A8D78784C7979231C634B68981C1F5720171D9F1D1F1E75159F1D + 9F1F37797976201E1E1E1EA21E408C3B0F110C159F0333B2B2C510DBEBE5DAD3 + EBCE00CC1ABAE3A2C8FF001E1E1E7E736B73611E1E1E1E1E1E1E249187731E1E + 646B7B6B1E785D713A981E876A9885178469861A1983867B1E2278221BA11E1E + 1E9F1E7557221E1C1D1D1A1E1E1D76381F151E1E1E20765F3918195692494915 + 03FE31FE191E1E1E1EFDB5C11DBFB4B0CCECECE4A200D3D1C9DC1B1E00FF0000 + 00007E4D64844EA5CB18F7A000008B8685891AA64E8F89890022868E6818009B + 8569987A784C4B1A694B40250022386350160000001E1F9F1DA200793F1D1900 + 00001E7551250000007A5308310F1A350403FC16920404941800000000020B1E + C0BEB81E05D7EBEBD9EEF59FCF1EB61DA2FF00000000656F7E746B6561650B13 + 1D008B6F6B5A8261527A691C00227C408E18004B401B79215723791D2363404E + 009B976340A11E1E00001E405F4B00795F371F0000279D49FE130000001431FC + 920F1902E19203160304040118001E000003032ABA9EBA0C0233BDEBE6EA9FF8 + 9FD4C89FF0FF000000007D746B6B6B6F6B4E876F0E1E4E87644E686986257E00 + 002260643E9500681B3778220000001D864C606A0022401E1E7F9C881A7C5345 + 452800000000000000273105FB1400000019101010191A010304031604E103E1 + 090A0A160003040204000A0102020DCCEBEBD81BDDCE00EFE6FF000000006573 + 6F736B726B5D8464691B4D684B86514B86504B11005763573F18007C4B7086A2 + 00000020545A8615004D3B49FE9232FE1A7B322FFB0D00000000000000130403 + E114000000000000000019FD0304031604920392030303140003030304000A02 + 02010D1B07EBE5EBD200F4E7F3FF000000008A6B7260601D4C72526A46784E64 + 726E1B771C751C7A00406767817800571E3750A20000001B0892592D00103104 + 3103FC011A15FB04E10D000000000000001403E1031400000000000000001A01 + 03030316040403E103FC021300E1030305000A0201020D1C0202EBE5D8CCEBD2 + 00FF000000003E64393A7200006E5239421B185C75671C0043393A7100252E59 + 4927003CFEFE331C0000001B04FB040B0010FB03920C0F0C001231E1920D001E + 1F9E750000140403031400000000000000001A0204049D16030305020B0F0E00 + 0003319D05000A0202010C1C020202F2EBECC200D1FF000000004F5B72527100 + 0069508E8E226067713C1C0007593131001331042F14000731FB9D1C0000001B + 0492310A0010E1920417000000110392040D0010070706000013039203140000 + 0000000000001A0103050316E1030402980000000003030204000A0201020C1C + 02010206F1E8F4D1E5FF000000A04D3F5E6350000050475047194F94FE021D00 + 92E1040400139204E17B00060492031C00A0001A03E1E1D0001003E103180000 + 0012E104E10D000F0303030000130404031400000000A0000000210204030316 + 04040302C80000000003030205002D0202020E1B0202FD061DE2E5E5EBFF001E + 1E1E8C7482452D1E1E3030303C150A03039D14140404E12F1ECD0403FB0E1903 + E1E1031D1E1E1E190492030A1E2B03920310A71321A7E1920308180992040218 + A70E03E1030E13CB1E1E1E1E1E1EBA94E192031504030402111413191E030302 + 2FA40401020113A2020294061ECAEBEBEBFF001D1DF709FE03FBFC1D1E02E192 + 03150A0304E102FC030403D09F160392033101040492011D1D1D9F190403040A + 9FA803E1040202021117E192E10394E103030A02020392E192FC02089E1D1D1D + 1D1D190203E10215E1040392030202109F0303020201020202011B1A0202FD06 + 9F1DBDEBE4FF009EC79E099DFB9203161002E10303150AFC04319203E103011A + C71A0104E1FBFB04030114C7C7C71CA131E1030A9E2B03030304030211C792E1 + 0492E19203011A0103E10392030404091CC7C7C7C7C71994039203A531040303 + E10303A8C703020301020133FD0B9E18020102059EC7C7A4EBFF00A3A3A30903 + 040403020392E10402A20F08AE08AE08080B1DA3A3A31807080707AF0A10A3A3 + A3A3A3BA0B0A0A10A3130A0A0A0A0AAEA1A3A308090707070A12A3060A0AD00A + 0A0A0A10A3A3A3A3A3A3A10192E103150BAB0A0A0A0A0A15A3080A0909090AAF + 15A3A3A10909090EA3A3A31CC1FF00A2A2C009030303040303E1040110C0A2A2 + A2C0A2C0A2A2C0A2A2C0A2B91ABAA11AA2A2C0A2A2C0A2A2A2C0A2A2A2C0A2A2 + C0A2C0A2A2C0A2A2B9BA1AA1A2C0A2A2C0A2A2C0A2A2A2A2A2C0A2A2A2A21802 + 03E102A4A2A2A2C0A2A2A2A2C0A2C0A2A2A2C0A2C0A2A2C0A2A2B9C0A2A2A2A2 + A2FF00B91AB90A03040492042F060AA81A1AB99BB91A1A1AB91A1AB91A1A1AB9 + 1A1AB91AB91A1AB91A1A1A1AB91AB91A1AB91A1A1AB91A1A1A1AB91A1A1AB9B9 + 9B1AB91A1A1A1A1AB91AB91A1A1AB91AB91AC89404040316B91A1A1AB91AB91A + 1A1A1AB91A1AB91A9BB91AB9B91A1A1AB91AB91AB9FF00BAA1BAA1BABABABABA + BABAA1BAA1BAA1BAA1BABABAA1BABAA1BABABAA1BABAA1BAA1BABAA1BABABABA + A1BAA1BABAA1BABABAA1BABABABAA1BABABAA1A1BABAA1BABABABABAA1BAA1BA + BABAA1BAA1BAA1BABAA1BABAA1BABABAA1BAA1BABABABAA1BABAA1BABAA1BAA1 + A1BABABAA1BAA1BABAFF00B6B6B6B6B6C1AAC1AAC1AAA6B6B6B6B6B6C1B6C1AA + B6B6B6B6B6B6C1AAB6C1AAB6B6B6C1AAB6C1AAC1AAC1AAB6B6C1AAC1AAB6B6C1 + AAB6B6B6C1AAB6B6B6C1B6B6B6C1AAC1AAB6B6C1AAC1AAB6B6B6B6B6C1AAB6B6 + B6B6C1AAB6B6B6B6B6C1AAB6B6C1B6B6B6C1AAB6B6B6B6B6B6B6B6B6B6FF00A4 + C1C1A4C1C1C1C1C1C1C1C1C1C1C1A4C1C1C1C1C1A4C1C1A4C1C1C1C1C1C1C1A4 + C1C1C1C1C1C1C1C1C1C1C1A4C1C1C1C1C1A4C1C1C1A4C1C1C1C1A4C1C1C1C1A4 + C1C1C1C1A4C1C1C1C1C1C1A4C1C1A4C1C1C1C1C1A4C1C1C1A4C1A4C1C1C1C1A4 + C1C1C1C1C1C1C1A4C1C1C1A4C1C1C1C1C1FF00B3BBB3B3B3BBB3BBB3BBB3BBB3 + BBB3B3B3BBB3B3BBB3BBB3B3BBB3BBB3BBB3BBB3B3BBB3BBB3BBB3BBB3BBB3B3 + B3BBB3BBB3BBB3BBB3B3B3BBB3BBB3BBB3BBB3B3B3BBB3BBB3BBB3BBB3BBB3B3 + B3BBB3BBB3BBB3BBB3BBB3BBB3BBB3BBB3BBB3B3BBB3B3BBB3BBB3B3BBB3BBB3 + BBB3BBB3BBFF00ACC2ACC2ACC2ACC2B7B1B7B1B7B1B7B1B7B1B7B1B7B1B7B1B7 + B1B7B1B7B1B7B1B7ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2 + ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2B7B1B7B1B7B1B7B1B7B1B7B1B7B1 + B7B1B7B1B7B1B7C2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ADFF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000001E0E} + OnClick = JediImageClick + end + object Title: TLabel + Left = 8 + Top = 13 + Width = 166 + Height = 21 + Caption = 'Project JEDI Installer' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWhite + Font.Height = 21 + Font.Name = 'helvetica' + Font.Pitch = fpVariable + Font.Style = [] + ParentFont = False + end + end + object InstallBtn: TBitBtn + Left = 539 + Top = 545 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = '&Install' + TabOrder = 0 + OnClick = InstallBtnClick + Glyph.Data = { + 36030000424D3603000000000000360000002800000010000000100000000100 + 18000000000000030000230B0000230B00000000000000000000C6CED6C6CED6 + C6CECECECED6C6CED6C6CED6C6CECECECECEC6CED6BDB5B5C6C6BDC6CECEC6CE + D6C6CECEC6CED6C6CED6C6CED6C6CED6C6D6CEC6CED6C6CED6C6CECEADB5BDAD + ADADBDB5AD185294527394CEC6B59C9CADBDB5B5C6CECEC6CED6C6CED6C6CED6 + CECECEC6CED6C6CED6B5C6CE296BA5185294425A8431A5D63184B5425A7B1052 + 94637B8CCECECEC6CECEC6CED6C6CED6C6CECEC6CED6C6CECEB5BDBD4AADDE39 + A5DE1884BD39B5E7219CCE107BB5109CCE5294A5C6C6BDC6CECEC6CED6C6CED6 + C6D6CEC6CED6B5BDCE3163943194CE52BDEF39B5E739B5E731A5D6219CD6109C + CE10639C5A7394CECECEC6CED6C6CED6CECECEC6CED6ADC6D6399CD64AB5EF52 + BDEF63C6EF94ADBD396B840873B51084BD008CC6217BADCECECEC6CED6C6CECE + C6CED6C6CED6B5C6CE5ABDD652BDEF42BDEF94D6EFADADAD4A636B107BB50894 + CE109CCE52ADC6C6CECEC6CED6C6CED67BAD7BC6C6ADA5BD94088408218C844A + B5EF94D6EFADADAD4A636B219CCE189CCE9CB5BDC6CECEC6CED6C6CED69CC69C + 21AD31188C18399C3131CE5229AD7B39B5BD84CEB59C94945A636363ADC642AD + D6ADC6D6C6CECEC6CED6C6CED69CBD8452E77342D65A31CE5231CE5221BD3121 + AD314AB542847B5A847B6BC6C6C6C6CED6C6CECEC6CED6C6CED694BD9C219C21 + 42D65A4AE76B52D66B4ABD5A21AD3118AD2110A5100884088CA563CECECEC6CE + D6C6CED6C6CED6C6CECE9CD6AD52E77B52E77B52E77BADD6B5848C8C21732100 + 8C0808A510009C088CB56BC6CED6C6CECECED6D6C6CED6C6CECEC6D6CEADDEBD + 52E77B63E77BC6D6C68C8C8C318C3918AD2110A51073B55AB5CEBDC6CED6C6CE + CEC6CED6C6CED6C6CED6C6CED6C6CECE52D66B63E784C6D6C68C8C8C39944221 + B52929AD29CECEBDC6CED6C6CED6CECECEC6CED6CED6D6C6CECEC6CED6C6CED6 + ADDEBD9CD6ADBDB5A563635A8C947394C69CB5CEBDC6CED6C6CED6C6CECEC6CE + D6C6CED6C6CECEC6CED6C6CED6C6CECEC6CED6C6CED6C6C6BD9C9C9CB5BDBDC6 + CED6C6CECEC6CED6C6CED6C6CECEC6CED6C6CECEC6CED6C6CED6} + end + object QuitBtn: TBitBtn + Left = 707 + Top = 545 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = '&Quit' + TabOrder = 2 + OnClick = QuitBtnClick + Glyph.Data = { + 36050000424D3605000000000000360400002800000010000000100000000100 + 08000000000000010000230B0000230B000000010000000100000026B5000026 + B600022BBE00072FBE000F30B5001A39B7001636B8001337BD001739B9001A39 + B8001939BA001839BB001E3EBC001D3FBF002342BD002141BF002342BE00022C + C000052EC1000A32C0000B33C1000D35C0001238C200183CC0000132D7001138 + D4000439E000053AE000083EE1001F44D9001941DE001F4CDF002347D8002248 + DF00254EDE00244FDF002A4DDA002C51DB002F51DA002E51DB002F52DB002951 + DC002A50DC002D51DC003053DC000D42E0000F43E1000A43E8000E48E9001547 + E0001848E0001C4BE000134BE900264EE2002352E6002450E4002C50E1002C51 + E1002C52E2002C55E4002C58E6002456E8002D5CE8002C5DE9003053E1003054 + E2003154E2003558E2003759E300385AE3003A5BE3003A5CE3003B5DE3003F5F + E4003F60E3003763E8004261E4004162E4004363E4004066E7004464E5004564 + E5004665E5004865E4004867E5004C67E5004669E6004868E5004B68E5004B69 + E5004A69E600496AE6004E6CE6004F6CE6004E6DE600506CE600516CE600506D + E600536FE7005470E7005673E7005A75E8005B76E8005D78E8005E79E800637D + E800627CE900657EE9007F90D1006781EA006483EC006587EE006A83E9006B83 + E9006B85EA006C85EA006C86EB006F88EB006F8FEF007086EA007089EB00728A + EC00728FEE00768DEC00778EEC007990EC007A91EC007E94ED006B8DF0007192 + F1007294F1008596DC008A9BDE008093ED008195ED008097ED008398EE00899D + EE008B9EEE008CA0EF008DA1EF0095A8F00097A8F00097A9F1009DAEF10098B1 + F600A2B2F200A6B5F200B0BDF400B1BDF400B0BFF500B2BFF400B7C2F500BBC6 + F500BBC8F600B6C7F800BACAF800D2D9DC00DBE3FB00DCE4FB00E0E6FB00E2E8 + FB00E9EDFC00EBEFFC00EEF0FC00EFF1FD00F8F9FA00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000009DA6A7A7A7A7 + A7A7A7A7A7A7A7A7A69DA683040609050B080715130311016CA6A7191D242627 + 25292333312D1B1800A7A71E3844507FA1A7A79F81342F1A02A7A721454E92A7 + 9A7A769CA791301C12A7A7394C8AA788564F4B3F82A7802E14A7A74358A3995E + 5BA7A73E3D9B9E3216A7A74962A7866157A7A73C366FA71F17A7A75165A7865F + 54A7A73B376EA7220DA7A75D69A5986053A7A73A3596A02A0FA7A762738FA785 + 554C464174A7792B10A7A7687E7893A795777194A78D40280EA7A7728C87758E + A4A7A7A2894D472C0CA7A77C908B7D78706B6A67645C4D280AA7A6977B6D6663 + 5D5A59524A48422084A69DA6A7A7A7A7A7A7A7A7A7A7A7A7A69D} + end + object ProductsPageControl: TPageControl + Left = 8 + Top = 56 + Width = 775 + Height = 465 + ActivePage = ReadmePage + Anchors = [akLeft, akTop, akRight, akBottom] + MultiLine = True + TabOrder = 4 + object ReadmePage: TTabSheet + Caption = 'About this release' + object ReadmePane: TRichEdit + Left = 0 + Top = 0 + Width = 767 + Height = 436 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -15 + Font.Name = 'Arial' + Font.Pitch = fpVariable + Font.Style = [] + Lines.Strings = ( + '') + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 0 + end + end + end + object ProgressBar: TProgressBar + Left = 380 + Top = 549 + Width = 141 + Height = 19 + Anchors = [akRight, akBottom] + Min = 0 + Max = 100 + TabOrder = 5 + Visible = False + end + object UninstallBtn: TBitBtn + Left = 624 + Top = 545 + Width = 75 + Height = 25 + Anchors = [akRight, akBottom] + Caption = '&Uninstall' + TabOrder = 1 + OnClick = UninstallBtnClick + end + object ImageList: TImageList + Left = 32 + Top = 416 + Bitmap = { + 494C010104000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000003000000001002000000000000030 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BFBFBF00BFBFBF007F7F7F007F7F7F007F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000BFBFBF00BFBFBF007F7F7F007F7F7F007F7F7F00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000000000000000BFBF + BF00BFBFBF007F7F7F000000000000000000000000007F7F7F007F7F7F007F7F + 7F0000000000000000000000000000000000000000000000000000000000BFBF + BF00BFBFBF007F7F7F000000000000000000000000007F7F7F007F7F7F007F7F + 7F00000000000000000000000000000000000000000000000000000000008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080008080800000000000000000000000000000000000000000008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080008080800000000000000000000000000000000000BFBFBF00BFBF + BF0000000000FFFFFF000000FF00FFFFFF000000FF00FFFFFF00000000007F7F + 7F007F7F7F000000000000000000000000000000000000000000BFBFBF00BFBF + BF0000000000FFFFFF0000FF0000FFFFFF0000FF0000FFFFFF00000000007F7F + 7F007F7F7F000000000000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 00007F7F7F000000000000000000000000000000000000000000BFBFBF000000 + 0000FFFFFF000000000000000000000000000000000000000000FFFFFF000000 + 00007F7F7F000000000000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080808000000000000000000000000000BFBFBF007F7F7F00FFFF + FF0000000000000000000000FF0000008000000080000000000000000000FFFF + FF007F7F7F007F7F7F00000000000000000000000000BFBFBF007F7F7F00FFFF + FF00000000000000000000FF000000800000008000000000000000000000FFFF + FF007F7F7F007F7F7F0000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00000000000000000000000000FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080808000000000000000000000000000BFBFBF00000000000000 + FF00000000000000FF00000080000000FF000000800000008000000000000000 + FF00000000007F7F7F00000000000000000000000000BFBFBF000000000000FF + 00000000000000FF00000080000000FF000000800000008000000000000000FF + 0000000000007F7F7F0000000000000000000000000000000000000000008080 + 8000FFFFFF000000000000000000000000000000000000000000FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080808000000000000000000000000000FFFFFF0000000000FFFF + FF00000000000000FF000000FF000000FF000000FF000000800000000000FFFF + FF00000000007F7F7F00000000000000000000000000FFFFFF0000000000FFFF + FF000000000000FF000000FF000000FF000000FF00000080000000000000FFFF + FF00000000007F7F7F0000000000000000000000000000000000000000008080 + 8000FFFFFF000000000000000000FFFFFF00000000000000000000000000FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080808000000000000000000000000000FFFFFF00000000000000 + FF0000000000FFFFFF000000FF000000FF00000080000000FF00000000000000 + FF0000000000BFBFBF00000000000000000000000000FFFFFF000000000000FF + 000000000000FFFFFF0000FF000000FF00000080000000FF00000000000000FF + 000000000000BFBFBF0000000000000000000000000000000000000000008080 + 8000FFFFFF0000000000FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0000FFFFFF008080800000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF0080808000000000000000000000000000FFFFFF007F7F7F00FFFF + FF000000000000000000FFFFFF00FFFFFF000000FF000000000000000000FFFF + FF007F7F7F00BFBFBF00000000000000000000000000FFFFFF007F7F7F00FFFF + FF000000000000000000FFFFFF00FFFFFF0000FF00000000000000000000FFFF + FF007F7F7F00BFBFBF0000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000FFFFFF008080800000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0000FFFFFF008080800000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000008080 + 8000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080008080800000000000000000000000000000000000000000008080 + 8000808080008080800080808000808080008080800080808000808080008080 + 8000808080008080800000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000300000000100010000000000800100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFFFFFFFFFFFFFFF83FF83FFFFFFFFF + E00FE00FFFFFFFFFC007C007E003E00380038003E003E00380038003E003E003 + 00010001E003E00300010001E003E00300010001E003E00300010001E003E003 + 00010001E003E00380038003E003E00380038003E003E003C007C007E003E003 + E00FE00FFFFFFFFFF83FF83FFFFFFFFF00000000000000000000000000000000 + 000000000000} + end +end diff --git a/official/1.96/install/JediInstallerMain.pas b/official/1.96/install/JediInstallerMain.pas new file mode 100644 index 0000000..cf0d603 --- /dev/null +++ b/official/1.96/install/JediInstallerMain.pas @@ -0,0 +1,633 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ 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 JediInstallerMain.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. } +{ } +{ Contributors: } +{ Andreas Hausladen (ahuser) } +{ Robert Rossmair (rrossmair) - crossplatform & BCB support, refactoring } +{ } +{**************************************************************************************************} + +// $Id: JediInstallerMain.pas,v 1.34 2006/02/05 13:26:15 outchy Exp $ + +unit JediInstallerMain; + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + Windows, Messages, + SysUtils, Classes, + Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Menus, Buttons, ComCtrls, ImgList, + ProductFrames, + JclBorlandTools, JediInstall; + +const + UM_CHECKUPDATES = WM_USER + $100; + +type + TMainForm = class(TForm, IJediInstallTool) + InstallBtn: TBitBtn; + UninstallBtn: TBitBtn; + QuitBtn: TBitBtn; + JediImage: TImage; + TitlePanel: TPanel; + Title: TLabel; + ProductsPageControl: TPageControl; + StatusBevel: TBevel; + StatusLabel: TLabel; + Bevel1: TBevel; + ProgressBar: TProgressBar; + ImageList: TImageList; + ReadmePage: TTabSheet; + ReadmePane: TRichEdit; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure QuitBtnClick(Sender: TObject); + procedure InstallBtnClick(Sender: TObject); + procedure UninstallBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure JediImageClick(Sender: TObject); + procedure TreeViewCollapsing(Sender: TObject; Node: TTreeNode; + var AllowCollapse: Boolean); + procedure BplPathEditChange(Sender: TObject); + private + FBorRADToolInstallations: TJclBorRADToolInstallations; + FJclInstall: IJediInstall; + FSystemPaths: TStringList; + FFeatureNode: TTreeNode; + FFeatureChanged: Boolean; + FHintPos: TPoint; + function ActiveView: TProductFrame; + function CheckUpdatePack(Installation: TJclBorRADToolInstallation): Boolean; + function CreateView(Installation: TJclBorRADToolInstallation): Boolean; + function ExpandOptionTree(Installation: TJclBorRADToolInstallation): Boolean; + procedure InstallationStarted(Installation: TJclBorRADToolInstallation); + procedure InstallationFinished(Installation: TJclBorRADToolInstallation); + procedure InstallationProgress(Percent: Cardinal); + procedure ReadSystemPaths; + function View(Installation: TJclBorRADToolInstallation): TProductFrame; + procedure UMCheckUpdates(var Message: TMessage); message UM_CHECKUPDATES; + procedure TreeViewChange(Sender: TObject; Node: TTreeNode); + procedure TreeViewEnter(Sender: TObject); + procedure TreeViewExit(Sender: TObject); + procedure TreeViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure UpdateFeatureInfo(Node: TTreeNode); + protected + function InfoFile(Node: TTreeNode): string; + function OptionGUI(Installation: TJclBorRADToolInstallation): TObject; + function GUIAddOption(GUI, Parent: TObject; Option: TJediInstallOption; const Text: string; + GUIOptions: TJediInstallGUIOptions): TObject; + procedure HandleException(Sender: TObject; E: Exception); + property JclDistribution: IJediInstall read FJclInstall; + // IJediInstallTool + function GetBPLPath(Installation: TJclBorRADToolInstallation): string; + function GetDCPPath(Installation: TJclBorRADToolInstallation): string; + procedure SetBPLPath(Installation: TJclBorRADToolInstallation; const Value: string); + procedure SetDCPPath(Installation: TJclBorRADToolInstallation; const Value: string); + public + procedure ShowFeatureHint(var HintStr: string; + var CanShow: Boolean; var HintInfo: THintInfo); + function CheckRunningInstances: Boolean; + procedure Install; + procedure Uninstall; + function SystemPathValid(const Path: string): Boolean; + // IJediInstallTool + function FeatureChecked(FeatureID: Cardinal; Installation: TJclBorRADToolInstallation): Boolean; + function GetBorRADToolInstallations: TJclBorRADToolInstallations; + function Dialog(const Text: string; DialogType: TDialogType = dtInformation; + Options: TDialogResponses = [drOK]): TDialogResponse; + procedure SetReadme(const FileName: string); + procedure UpdateInfo(Installation: TJclBorRADToolInstallation; const InfoText: String); + procedure UpdateStatus(const Text: string); + procedure WriteInstallLog(Installation: TJclBorRADToolInstallation; const Text: string); + property BorRADToolInstallations: TJclBorRADToolInstallations read FBorRADToolInstallations; + property BPLPath[Installation: TJclBorRADToolInstallation]: string read GetBPLPath write SetBPLPath; + property DCPPath[Installation: TJclBorRADToolInstallation]: string read GetDCPPath write SetDCPPath; + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +uses + FileCtrl, + JclDebug, JclShell, + JclBase, JclFileUtils, JclStrings, JclSysInfo, JclSysUtils, + JclInstall; + +const + {$IFNDEF RTL140_UP} + PathSep = ';'; + {$ENDIF RTL140_UP} + SupportURLs: array[TJclBorRADToolKind] of string = ( + 'http://www.borland.com/devsupport/delphi/', + 'http://www.borland.com/devsupport/bcppbuilder/', + 'http://www.borland.com/devsupport/delphi/'); + DelphiJediURL = 'http://delphi-jedi.org'; + VersionSignature = 'D%d'; + BCBTag = $10000; + VersionMask = $FFFF; + +function FeatureID(Node: TTreeNode): Cardinal; +begin + Result := Cardinal(Node.Data) and FID_NumberMask; +end; + +{ TMainForm } + +function TMainForm.ActiveView: TProductFrame; +var + Page: TTabSheet; + Control: TControl; +begin + Result := nil; + Page := ProductsPageControl.ActivePage; + Control := Page.Controls[0]; + if Control is TProductFrame then + Result := TProductFrame(Control); +end; + +function TMainForm.InfoFile(Node: TTreeNode): string; +begin + if Assigned(Node) then + Result := FJclInstall.FeatureInfoFileName(FeatureID(Node)); +end; + +function TMainForm.CreateView(Installation: TJclBorRADToolInstallation): Boolean; +var + Page: TTabSheet; + ProductFrame: TProductFrame; +begin + Page := TTabSheet.Create(Self); + with Installation do + begin + Page.Name := Format('%sPage', [VersionNumberStr]); + Page.Caption := Name; + end; + Page.PageControl := ProductsPageControl; + ProductFrame := TProductFrame.Create(Self); + ProductFrame.Installation := Installation; + ProductFrame.TreeView.Images := ImageList; + ProductFrame.TreeView.OnChange := TreeViewChange; + ProductFrame.TreeView.OnCollapsing := TreeViewCollapsing; + ProductFrame.TreeView.OnEnter := TreeViewEnter; + ProductFrame.TreeView.OnExit := TreeViewExit; + ProductFrame.TreeView.OnMouseMove := TreeViewMouseMove; + ProductFrame.Align := alClient; + ProductFrame.Parent := Page; + FJclInstall.SetOnWriteLog(Installation, ProductFrame.LogOutputLine); + Result := True; +end; + +function TMainForm.CheckRunningInstances: Boolean; +begin + Result := FBorRADToolInstallations.AnyInstanceRunning; + if Result then + Dialog(RsCloseRADTool, dtWarning); +end; + +function TMainForm.CheckUpdatePack(Installation: TJclBorRADToolInstallation): Boolean; +var + Msg: string; +begin + Result := True; + with Installation do + if UpdateNeeded then + begin + Msg := Format(RsUpdateNeeded, [LatestUpdatePack, Name]); + if Dialog(Msg, dtWarning, [drYes, drNo]) = drYes then + ShellExecEx(SupportURLs[RadToolKind]); + end; +end; + +function TMainForm.GUIAddOption(GUI, Parent: TObject; Option: TJediInstallOption; + const Text: string; GUIOptions: TJediInstallGUIOptions): TObject; +const + Icon: array[Boolean] of Integer = (IcoUnchecked, IcoChecked); + Flag: array[Boolean] of Cardinal = (0, FID_Checked); +var + FeatureID: Cardinal; + Nodes: TTreeNodes; + Node, ParentNode: TTreeNode; + Checked: Boolean; +begin + ParentNode := TTreeNode(Parent); + Checked := goChecked in GUIOptions; + FeatureID := Cardinal(Ord(Option)) + Flag[goChecked in GUIOptions]; + if goNoAutoCheck in GUIOptions then + FeatureID := FeatureID + FID_NoAutoCheck; + if goStandAloneParent in GUIOptions then + FeatureID := FeatureID + FID_StandAloneParent; + if goRadioButton in GUIOptions then + FeatureID := FeatureID + FID_RadioButton; + if goExpandable in GUIOptions then + FeatureID := FeatureID + FID_Expandable; + Nodes := TTreeNodes(GUI); + if Parent = nil then + Node := Nodes.AddObject(nil, Text, Pointer(FeatureID)) + else + Node := Nodes.AddChildObject(ParentNode, Text, Pointer(FeatureID)); + Node.ImageIndex := Icon[Checked]; + Node.SelectedIndex := Icon[Checked]; + Result := Node; +end; + +procedure TMainForm.HandleException(Sender: TObject; E: Exception); +begin + if E is EJediInstallInitFailure then + begin + Dialog(E.Message, dtError); + Application.ShowMainForm := False; + Application.Terminate; + end + else + Application.ShowException(E); +end; + +procedure TMainForm.Install; +var + Res: Boolean; +begin + ProgressBar.Position := 0; + ProgressBar.Visible := True; + Screen.Cursor := crHourGlass; + try + Res := FJclInstall.Install; + Screen.Cursor := crDefault; + if Res then + Dialog(RsInstallSuccess) + else + Dialog(RsInstallFailure); + finally + ProgressBar.Visible := False; + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.Uninstall; +begin + ProgressBar.Position := 0; + ProgressBar.Visible := True; + Screen.Cursor := crHourGlass; + try + FJclInstall.Uninstall; + Screen.Cursor := crDefault; + finally + ProgressBar.Visible := False; + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.InstallationProgress(Percent: Cardinal); +begin + ProgressBar.Position := Percent; +end; + +function TMainForm.View(Installation: TJclBorRADToolInstallation): TProductFrame; +begin + if not Assigned(Installation) then + Result := nil + else + with Installation do + Result := FindComponent(TProductFrame.GetName(Installation)) as TProductFrame; +end; + +procedure TMainForm.ReadSystemPaths; +var + PathVar: string; + I: Integer; +begin + if GetEnvironmentVar('PATH', PathVar, False) then + begin + StrToStrings(PathVar, PathSep, FSystemPaths, False); + for I := 0 to FSystemPaths.Count - 1 do + begin + PathVar := StrTrimQuotes(FSystemPaths[I]); + ExpandEnvironmentVar(PathVar); + PathVar := AnsiUpperCase(PathRemoveSeparator(PathGetLongName(PathVar))); + FSystemPaths[I] := PathVar; + end; + FSystemPaths.Sorted := True; + end; +end; + +function TMainForm.SystemPathValid(const Path: string): Boolean; +begin + Result := FSystemPaths.IndexOf(AnsiUpperCase(Path)) <> -1; +end; + +procedure TMainForm.UpdateInfo(Installation: TJclBorRADToolInstallation; const InfoText: String); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + begin + P.InfoDisplay.Text := InfoText; + end; +end; + +procedure TMainForm.UpdateStatus(const Text: string); +begin + if Text = '' then + begin + StatusBevel.Visible := False; + StatusLabel.Visible := False; + end + else + begin + StatusLabel.Caption := Text; + StatusBevel.Visible := True; + StatusLabel.Visible := True; + end; + Application.ProcessMessages; //Update; +end; + +procedure TMainForm.WriteInstallLog(Installation: TJclBorRADToolInstallation; const Text: string); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + P.LogOutputLine(Text); +end; + +function TMainForm.GetBPLPath(Installation: TJclBorRADToolInstallation): string; +var + P: TProductFrame; + Path: string; +begin + P := View(Installation); + if Assigned(P) then + Path := P.BplPath; + Result := PathRemoveSeparator(Installation.SubstitutePath(Path)); +end; + +function TMainForm.GetDCPPath(Installation: TJclBorRADToolInstallation): string; +var + P: TProductFrame; + Path: string; +begin + P := View(Installation); + if Assigned(P) then + Path := P.DcpPath; + Result := PathRemoveSeparator(Installation.SubstitutePath(Path)); +end; + +procedure TMainForm.BplPathEditChange(Sender: TObject); +begin + with (Sender as TEdit) do + if SystemPathValid(Text) then + Font.Color := clWindowText + else + Font.Color := clRed; +end; + +function TMainForm.FeatureChecked(FeatureID: Cardinal; Installation: TJclBorRADToolInstallation): Boolean; +var + P: TProductFrame; +begin + Result := False; + P := View(Installation); + if Assigned(P) then + Result := P.FeatureChecked(FeatureID); +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + Application.OnException := HandleException; + FBorRADToolInstallations := TJclBorRADToolInstallations.Create; + FSystemPaths := TStringList.Create; + JediImage.Hint := DelphiJediURL; + FJclInstall := CreateJclInstall; + FJclInstall.SetOnProgress(InstallationProgress); + FJclInstall.SetOnStarting(InstallationStarted); + FJclInstall.SetOnEnding(InstallationFinished); + FJclInstall.SetTool(Self); + BorRADToolInstallations.Iterate(ExpandOptionTree); + + UpdateStatus(''); + + ReadSystemPaths; + TitlePanel.DoubleBuffered := True; + Application.HintPause := 50; + Application.OnShowHint := ShowFeatureHint; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FBorRADToolInstallations); + FreeAndNil(FSystemPaths); +end; + + +procedure TMainForm.UMCheckUpdates(var Message: TMessage); +begin + BorRADToolInstallations.Iterate(CheckUpdatePack); + Message.Result := 0; +end; + +procedure TMainForm.QuitBtnClick(Sender: TObject); +begin + Close; +end; + +function TMainForm.ExpandOptionTree( + Installation: TJclBorRADToolInstallation): Boolean; +var + P: TProductFrame; +begin + Result := True; + P := View(Installation); + if Assigned(P) then + P.UpdateTree; +end; + +procedure TMainForm.InstallBtnClick(Sender: TObject); +begin + if ( IsDebuggerAttached or not CheckRunningInstances) and + (Dialog(RsConfirmInstall, dtConfirmation, [drYes, drNo]) = drYes) then + begin + Install; + QuitBtn.SetFocus; + end; +end; + +procedure TMainForm.UninstallBtnClick(Sender: TObject); +begin + if ( IsDebuggerAttached or not CheckRunningInstances) then + begin + Uninstall; + QuitBtn.SetFocus; + end; +end; + +procedure TMainForm.FormShow(Sender: TObject); +begin + PostMessage(Handle, UM_CHECKUPDATES, 0, 0); +end; + +procedure TMainForm.JediImageClick(Sender: TObject); +begin + { TODO : implement for Unix } + ShellExecEx(DelphiJediURL); +end; + +procedure TMainForm.TreeViewCollapsing(Sender: TObject; Node: TTreeNode; + var AllowCollapse: Boolean); +begin + AllowCollapse := Collapsable(Node); +end; + +function TMainForm.GetBorRADToolInstallations: TJclBorRADToolInstallations; +begin + Result := FBorRADToolInstallations; +end; + +procedure TMainForm.InstallationStarted(Installation: TJclBorRADToolInstallation); +var + P: TProductFrame; +begin + P := View(Installation); + P.InfoDisplay.Lines.Clear; + ProductsPageControl.ActivePage := P.Parent as TTabSheet; + P.StartCompilation(Installation); +end; + +procedure TMainForm.InstallationFinished(Installation: TJclBorRADToolInstallation); +var + P: TProductFrame; +begin + P := View(Installation); + P.StopCompilation(Installation); + P.InfoDisplay.Lines.SaveToFile(JclInstall.LogFileName(Installation)); +end; + +function TMainForm.Dialog(const Text: string; DialogType: TDialogType = dtInformation; + Options: TDialogResponses = [drOK]): TDialogResponse; +const + DlgType: array[TDialogType] of TMsgDlgType = (mtWarning, mtError, mtInformation, mtConfirmation); + DlgButton: array[TDialogResponse] of TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel); + DlgResult: array[TDialogResponse] of Word = (mrYes, mrNo, mrOK, mrCancel); +var + Buttons: TMsgDlgButtons; + Res: Integer; +begin + Buttons := []; + for Result := Low(TDialogResponse) to High(TDialogResponse) do + if Result in Options then + Include(Buttons, DlgButton[Result]); + Res := MessageDlg(Text, DlgType[DialogType], Buttons, 0); + for Result := Low(TDialogResponse) to High(TDialogResponse) do + if DlgResult[Result] = Res then + Break; +end; + +procedure TMainForm.SetBPLPath(Installation: TJclBorRADToolInstallation; const Value: string); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + P.BplPath := Value; +end; + +procedure TMainForm.SetDCPPath(Installation: TJclBorRADToolInstallation; const Value: string); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + P.DcpPath := Value; +end; + +procedure TMainForm.SetReadme(const FileName: string); +begin + ReadmePane.Lines.LoadFromFile(FileName); + ShellExecEx('..\docs\Readme.html'); +end; + +procedure TMainForm.TreeViewChange(Sender: TObject; Node: TTreeNode); +begin + UpdateFeatureInfo(Node); +end; + +procedure TMainForm.TreeViewEnter(Sender: TObject); +begin + with ActiveView do + if InfoDisplay.ReadOnly then + UpdateFeatureInfo(TreeView.Selected); +end; + +procedure TMainForm.TreeViewExit(Sender: TObject); +begin + // +end; + +procedure TMainForm.TreeViewMouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin + UpdateFeatureInfo(ActiveView.TreeView.GetNodeAt(X, Y)); +end; + +procedure TMainForm.UpdateFeatureInfo(Node: TTreeNode); +begin + if Assigned(Node) and (Node <> FFeatureNode) then + begin + FFeatureNode := Node; + FFeatureChanged := True; + end; +end; + +procedure TMainForm.ShowFeatureHint; +var + View: TProductFrame; +begin + View := ActiveView; + if Assigned(View) and (HintInfo.HintControl = View.TreeView) then + begin + if FFeatureChanged then + begin + HintInfo.HintStr := FJclInstall.GetHint(TJediInstallOption(FeatureID(FFeatureNode) and $FF)); + FHintPos := HintInfo.HintPos; + FFeatureChanged := False; + end + else + HintInfo.HintPos := FHintPos; + HintInfo.ReshowTimeout := 500; + end; +end; + +function TMainForm.OptionGUI( + Installation: TJclBorRADToolInstallation): TObject; +begin + Result := View(Installation); + if Result = nil then + CreateView(Installation); + Result := View(Installation).TreeView.Items; +end; + +end. diff --git a/official/1.96/install/ProductFrames.dfm b/official/1.96/install/ProductFrames.dfm new file mode 100644 index 0000000..f7ed517 --- /dev/null +++ b/official/1.96/install/ProductFrames.dfm @@ -0,0 +1,151 @@ +object ProductFrame: TProductFrame + Left = 0 + Top = 0 + Width = 791 + Height = 421 + HorzScrollBar.Range = 398 + AutoScroll = False + TabOrder = 0 + object Splitter: TSplitter + Left = 426 + Top = 0 + Width = 5 + Height = 421 + Cursor = crHSplit + Align = alRight + MinSize = 150 + ResizeStyle = rsUpdate + OnCanResize = SplitterCanResize + end + object InfoPanel: TPanel + Left = 431 + Top = 0 + Width = 360 + Height = 421 + Align = alRight + BevelOuter = bvNone + TabOrder = 0 + object Label2: TLabel + Left = 9 + Top = 8 + Width = 71 + Height = 13 + Caption = 'Installation &Log' + end + object InfoDisplay: TRichEdit + Left = 8 + Top = 24 + Width = 346 + Height = 298 + Anchors = [akLeft, akTop, akRight, akBottom] + Color = clInfoBk + Font.Charset = OEM_CHARSET + Font.Color = clInfoText + Font.Height = -11 + Font.Name = 'Lucida Console' + Font.Pitch = fpFixed + Font.Style = [] + ParentFont = False + PlainText = True + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + end + object OptionsGroupBox: TGroupBox + Left = 8 + Top = 333 + Width = 346 + Height = 81 + Anchors = [akLeft, akRight, akBottom] + Caption = '&Advanced Options' + TabOrder = 1 + object BPLPathLabel: TLabel + Left = 8 + Top = 19 + Width = 42 + Height = 13 + Caption = '.bpl Path' + end + object DCPPathLabel: TLabel + Left = 8 + Top = 51 + Width = 46 + Height = 13 + Caption = '.dcp Path' + end + object BplPathEdit: TEdit + Left = 68 + Top = 16 + Width = 249 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + OnChange = PathEditChange + end + object DcpPathEdit: TEdit + Left = 68 + Top = 48 + Width = 249 + Height = 21 + Anchors = [akLeft, akTop, akRight] + TabOrder = 2 + OnChange = PathEditChange + end + object Button1: TButton + Left = 322 + Top = 16 + Width = 17 + Height = 22 + Anchors = [akTop, akRight] + Caption = '...' + TabOrder = 1 + TabStop = False + OnClick = PathSelectBtnClick + end + object Button2: TButton + Left = 322 + Top = 48 + Width = 17 + Height = 22 + Anchors = [akTop, akRight] + Caption = '...' + TabOrder = 3 + TabStop = False + OnClick = PathSelectBtnClick + end + end + end + object ComponentsTreePanel: TPanel + Left = 0 + Top = 0 + Width = 426 + Height = 421 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + object Label1: TLabel + Left = 8 + Top = 8 + Width = 132 + Height = 13 + Caption = '&Select components to install' + end + object TreeView: TTreeView + Left = 8 + Top = 24 + Width = 414 + Height = 390 + Anchors = [akLeft, akTop, akRight, akBottom] + HideSelection = False + Indent = 19 + ParentShowHint = False + ReadOnly = True + ShowHint = True + TabOrder = 0 + ToolTips = False + OnCustomDrawItem = TreeViewCustomDrawItem + OnKeyPress = TreeViewKeyPress + OnMouseDown = TreeViewMouseDown + end + end +end diff --git a/official/1.96/install/ProductFrames.pas b/official/1.96/install/ProductFrames.pas new file mode 100644 index 0000000..050f97b --- /dev/null +++ b/official/1.96/install/ProductFrames.pas @@ -0,0 +1,452 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ 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 JediInstallerMain.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. } +{ } +{ Contributors: } +{ Andreas Hausladen (ahuser) } +{ Robert Rossmair (rrossmair) - crossplatform & BCB support, refactoring } +{ } +{**************************************************************************************************} + +// $Id: ProductFrames.pas,v 1.26 2006/02/05 13:26:15 outchy Exp $ + +unit ProductFrames; + +interface + +{$I jcl.inc} +{$I crossplatform.inc} + +uses + SysUtils, Classes, + Graphics, Forms, Controls, StdCtrls, ComCtrls, ExtCtrls, + JclBorlandTools, JediInstall; + +const + // Feature masks + FID_Expandable = $08000000; + FID_RadioButton = $10000000; + FID_NoAutoCheck = $20000000; // do not auto-check when the parent node gets checked + FID_StandaloneParent = $40000000; // do not auto-uncheck when all child nodes are unchecked + FID_Checked = $80000000; + FID_NumberMask = $03FFFFFF; + + // Icon indexes + IcoProduct = 0; + IcoLevel1 = 1; + IcoChecked = 2; + IcoUnchecked = 3; + +type + TProductFrame = class(TFrame) + ComponentsTreePanel: TPanel; + Label1: TLabel; + TreeView: TTreeView; + Splitter: TSplitter; + InfoPanel: TPanel; + Label2: TLabel; + InfoDisplay: TRichEdit; + OptionsGroupBox: TGroupBox; + BplPathLabel: TLabel; + DcpPathLabel: TLabel; + BplPathEdit: TEdit; + Button1: TButton; + Button2: TButton; + DcpPathEdit: TEdit; + procedure PathEditChange(Sender: TObject); + procedure PathSelectBtnClick(Sender: TObject); + procedure SplitterCanResize(Sender: TObject; var NewSize: Integer; + var Accept: Boolean); + procedure TreeViewMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure TreeViewKeyPress(Sender: TObject; var Key: Char); + procedure TreeViewCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; + State: TCustomDrawState; var DefaultDraw: Boolean); + private + { Private declarations } + FInstallation: TJclBorRADToolInstallation; + function GetDCPPath: string; + function GetBPLPath: string; + function GetNodeChecked(Node: TTreeNode): Boolean; + function GetPathForEdit(Path: string): string; + function IsAutoChecked(Node: TTreeNode): Boolean; + function IsRadioButton(Node: TTreeNode): Boolean; + function IsStandAloneParent(Node: TTreeNode): Boolean; + procedure SetDCPPath(const Value: string); + procedure SetBPLPath(const Value: string); + procedure SetInstallation(Value: TJclBorRADToolInstallation); + procedure SetNodeChecked(Node: TTreeNode; const Value: Boolean); + procedure ToggleNodeChecked(Node: TTreeNode); + public + { Public declarations } + class function GetName(Installation: TJclBorRADToolInstallation): string; + function FeatureChecked(FeatureID: Cardinal): Boolean; + procedure LogOutputLine(const Line: string); + procedure UpdateTree; + procedure StartCompilation(Installation: TJclBorRADToolInstallation); + procedure StopCompilation(Installation: TJclBorRADToolInstallation); + property NodeChecked[Node: TTreeNode]: Boolean read GetNodeChecked write SetNodeChecked; + property Installation: TJclBorRADToolInstallation read FInstallation write SetInstallation; + property DCPPath: string read GetDCPPath write SetDCPPath; + property BPLPath: string read GetBPLPath write SetBPLPath; + end; + +function Collapsable(Node: TTreeNode): Boolean; + +implementation + +{$R *.dfm} + +uses + Windows, Messages, + FileCtrl, FrmCompile, + JclStrings, + JclInstall; + +resourcestring + RsSelectPath = 'Select path'; + RsEnterValidPath = '(Enter valid path)'; + +function Collapsable(Node: TTreeNode): Boolean; +begin + Result := (Cardinal(Node.Data) and FID_Expandable) <> 0; +end; + +procedure TProductFrame.PathEditChange(Sender: TObject); +begin + with (Sender as TEdit) do + if DirectoryExists(Text) then + Font.Color := clWindowText + else + Font.Color := clRed; +end; + +function TProductFrame.FeatureChecked(FeatureID: Cardinal): Boolean; +var + F: Cardinal; + Node: TTreeNode; +begin + Result := False; + Node := TreeView.Items.GetFirstNode; + while Node <> nil do + begin + F := Cardinal(Node.Data); + if F and FID_NumberMask = FeatureID then + begin + Result := F and FID_Checked <> 0; + Break; + end; + Node := Node.GetNext; + end; +end; + +function TProductFrame.GetDCPPath: string; +begin + Result := DcpPathEdit.Text; +end; + +function TProductFrame.GetBPLPath: string; +begin + Result := BplPathEdit.Text; +end; + +class function TProductFrame.GetName(Installation: TJclBorRADToolInstallation): string; +begin + Result := Format('%sProduct', [Installation.VersionNumberStr]); +end; + +function TProductFrame.GetNodeChecked(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_Checked <> 0; +end; + +function TProductFrame.GetPathForEdit(Path: string): string; +begin + if DirectoryExists(Path) then + Result := Path + else + Result := RsEnterValidPath; +end; + +function TProductFrame.IsAutoChecked(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_NoAutoCheck = 0; +end; + +function TProductFrame.IsRadioButton(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_RadioButton <> 0; +end; + +function TProductFrame.IsStandAloneParent(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_StandAloneParent <> 0; +end; + +procedure TProductFrame.LogOutputLine(const Line: string); + + function Cmp(const S: string): Boolean; + begin + Result := Copy(Line, 1, Length(S)) = S; + end; + +begin + if FormCompile.HandleLine(Line) <> clFileProgress then + begin + if Cmp(AnsiLineBreak + 'Installing package ') then + FormCompile.Linking(Copy(Line, 20, MaxInt)) + else if Cmp('Copying .hpp files...') then + FormCompile.Done; + + InfoDisplay.Lines.Append(Line); + InfoDisplay.Perform(EM_SCROLLCARET, 0, 0); + end; +end; + +procedure TProductFrame.SetDCPPath(const Value: string); +begin + DcpPathEdit.Text := GetPathForEdit(Value); +end; + +procedure TProductFrame.SetBPLPath(const Value: string); +begin + BplPathEdit.Text := GetPathForEdit(Value); +end; + +procedure TProductFrame.SetInstallation(Value: TJclBorRADToolInstallation); +begin + FInstallation := Value; + Name := GetName(Value); + if Value.RadToolKind = brCppBuilder then + DcpPathLabel.Caption := '.bpi Path'; +end; + +procedure TProductFrame.SetNodeChecked(Node: TTreeNode; const Value: Boolean); + + procedure UpdateNode(N: TTreeNode; C: Boolean); + const + CheckedState: array[Boolean] of Cardinal = (0, FID_Checked); + begin + N.Data := Pointer(Cardinal(N.Data) and (not FID_Checked) or CheckedState[C]); + if C then + begin + N.ImageIndex := IcoChecked; + N.SelectedIndex := IcoChecked; + end + else + begin + N.ImageIndex := IcoUnchecked; + N.SelectedIndex := IcoUnchecked; + end; + end; + + procedure UpdateTreeDown(N: TTreeNode; C: Boolean); + begin + N := N.getFirstChild; + while Assigned(N) do + begin + if not C or IsAutoChecked(N) then + begin + if not IsRadioButton(N) then + UpdateNode(N, C); + UpdateTreeDown(N, C); + end; + N := N.getNextSibling; + end; + end; + + procedure UpdateTreeUp(N: TTreeNode; C: Boolean); + var + ParentNode: TTreeNode; + ParentChecked: Boolean; + begin + if C then + while Assigned(N) do + begin + UpdateNode(N, True); + N := N.Parent; + end + else + begin + ParentNode := N.Parent; + while Assigned(ParentNode) do + begin + N := ParentNode.getFirstChild; + ParentChecked := IsStandAloneParent(ParentNode); + while Assigned(N) do + if NodeChecked[N] and not IsRadioButton(N) then + begin + ParentChecked := True; + Break; + end + else + N := N.getNextSibling; + UpdateNode(ParentNode, ParentChecked); + ParentNode := ParentNode.Parent; + end; + end; + end; + + procedure UpdateRadioButton(N: TTreeNode; C: Boolean); + var + Node: TTreeNode; + begin + if Value and not NodeChecked[N] then + begin + Node := N.Parent; + if Node <> nil then + begin + Node := Node.getFirstChild; + while Node <> nil do + begin + if IsRadioButton(Node) then + UpdateNode(Node, Node = N); + Node := Node.getNextSibling; + end; + end; + end; + end; + +begin + if IsRadioButton(Node) then + UpdateRadioButton(Node, Value) + else + begin + UpdateNode(Node, Value); + UpdateTreeDown(Node, Value); + UpdateTreeUp(Node, Value); + end; +end; + +procedure TProductFrame.ToggleNodeChecked(Node: TTreeNode); +begin + if Assigned(Node) then + NodeChecked[Node] := not NodeChecked[Node]; +end; + +procedure TProductFrame.PathSelectBtnClick(Sender: TObject); +var + I: Integer; + Button: TButton; + Edit: TEdit; + {$IFDEF USE_WIDESTRING} + Directory: WideString; + {$UNDEF USE_WIDESTRING} + {$ELSE} + Directory: string; + {$ENDIF} +begin + Button := Sender as TButton; + Edit := nil; + with Button.Parent do + for I := 0 to ControlCount - 1 do + if (Controls[I].Top = Button.Top) and (Controls[I] is TEdit) then + Edit := TEdit(Controls[I]); + if Assigned(Edit) and SelectDirectory(RsSelectPath, '', Directory) then + Edit.Text := Directory; +end; + +procedure TProductFrame.SplitterCanResize(Sender: TObject; + var NewSize: Integer; var Accept: Boolean); +begin + Accept := NewSize > 150; +end; + +procedure TProductFrame.TreeViewCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; + State: TCustomDrawState; var DefaultDraw: Boolean); +begin + case TTreeNode(Node).Level of + 0: begin + Sender.Canvas.Font.Style := [fsBold, fsUnderline]; + end; + 1: begin + Sender.Canvas.Font.Style := [fsBold]; + end; + end; +end; + +procedure TProductFrame.TreeViewKeyPress(Sender: TObject; var Key: Char); +begin + with TTreeView(Sender) do + case Key of + #32: + begin + ToggleNodeChecked(Selected); + Key := #0; + end; + '+': + Selected.Expanded := True; + '-': + Selected.Expanded := False; + end; +end; + +function TreeNodeIconHit(TreeView: TTreeView; X, Y: Integer): Boolean; +begin + Result := htOnIcon in TreeView.GetHitTestInfoAt(X, Y); +end; + +procedure TProductFrame.TreeViewMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + Node: TTreeNode; +begin + with TTreeView(Sender) do + begin + Node := GetNodeAt(X, Y); + if (Button = mbLeft) and TreeNodeIconHit(TreeView, X, Y) then + ToggleNodeChecked(Node); + end; +end; + +procedure TProductFrame.UpdateTree; +var + Node: TTreeNode; +begin + Node := TreeView.Items.GetFirstNode; + while Node <> nil do + begin + if not Collapsable(Node) then + Node.Expand(False); + Node := Node.GetNext; + end; +end; + +procedure TProductFrame.StartCompilation(Installation: TJclBorRADToolInstallation); +begin + if not Assigned(FormCompile) then + FormCompile := TFormCompile.Create(Self); + SetWindowLong(FormCompile.Handle, GWL_HWNDPARENT, Handle); + FormCompile.Init(Installation.Name, True); + FormCompile.Show; + Application.ProcessMessages; +end; + +procedure TProductFrame.StopCompilation(Installation: TJclBorRADToolInstallation); +begin + if FormCompile.Errors > 0 then // do not make the dialog modal when no error occured + FormCompile.Done(' ') + else + FormCompile.Done; + FormCompile.Free; + FormCompile := nil; +end; + +end. diff --git a/official/1.96/install/QJediInstaller.cfg b/official/1.96/install/QJediInstaller.cfg new file mode 100644 index 0000000..2813532 --- /dev/null +++ b/official/1.96/install/QJediInstaller.cfg @@ -0,0 +1,3 @@ +-E"..\bin" +-N"." +-DJCLINSTALL;VisualCLX diff --git a/official/1.96/install/QJediInstaller.conf b/official/1.96/install/QJediInstaller.conf new file mode 100644 index 0000000..a9def6d --- /dev/null +++ b/official/1.96/install/QJediInstaller.conf @@ -0,0 +1,35 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O- +-$P+ +-$Q+ +-$R+ +-$S- +-$T- +-$U- +-$V+ +-$W+ +-$X+ +-$YD +-$Z1 +-cg +-H+ +-W+ +-M +-$M1048576 +-K$00400000 +-E"../bin" +-N"." +-DJCLINSTALL diff --git a/official/1.96/install/QJediInstaller.dof b/official/1.96/install/QJediInstaller.dof new file mode 100644 index 0000000..b58ce6f --- /dev/null +++ b/official/1.96/install/QJediInstaller.dof @@ -0,0 +1,15 @@ +[Directories] +OutputDir=..\bin +UnitOutputDir=. +SearchPath= +Conditionals=JCLINSTALL;VisualCLX +[Version Info Keys] +CompanyName=Project JEDI +FileDescription=JCL x-platform installer +FileVersion=2.1.0.1802 +InternalName=QJediInstaller +LegalCopyright=Copyright (C) 1999, 2005 Project JEDI +LegalTrademarks= +OriginalFilename=QJediInstaller.dpr +ProductName=Jedi X-Platform Installer +ProductVersion=2.1 diff --git a/official/1.96/install/QJediInstaller.dpr b/official/1.96/install/QJediInstaller.dpr new file mode 100644 index 0000000..12c5be5 --- /dev/null +++ b/official/1.96/install/QJediInstaller.dpr @@ -0,0 +1,17 @@ +program QJediInstaller; + +uses + QForms, + JediInstall in 'JediInstall.pas', + JclInstall in 'JclInstall.pas', + QJediInstallerMain in 'QJediInstallerMain.pas' {MainForm}, + QProductFrames in 'QProductFrames.pas' {ProductFrame: TFrame}; + +{$R *.res} + +begin + Application.Initialize; + Application.Title := 'JEDI Installer'; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/official/1.96/install/QJediInstaller.kof b/official/1.96/install/QJediInstaller.kof new file mode 100644 index 0000000..4f54991 --- /dev/null +++ b/official/1.96/install/QJediInstaller.kof @@ -0,0 +1,61 @@ +[FileVersion] +Version=6.0 + +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=0 +P=1 +Q=1 +R=1 +S=0 +T=0 +U=0 +V=1 +W=1 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases= + +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +ResourceReserve=1048576 +ImageBase=4194304 +ExeDescription= +DynamicLoader=/lib/ld-linux.so.2 + +[Directories] +OutputDir=../bin +UnitOutputDir=. +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=$(DELPHI)/lib/debug +Conditionals=JCLINSTALL +DebugSourceDirs= +UsePackages=0 + +[Parameters] +RunParams= +HostApplication= +Launcher=/usr/X11R6/bin/xterm -T KylixDebuggerOutput -e bash -i -c %debuggee% +UseLauncher=0 +DebugCWD= diff --git a/official/1.96/install/QJediInstaller.res b/official/1.96/install/QJediInstaller.res new file mode 100644 index 0000000..b2ec6c3 Binary files /dev/null and b/official/1.96/install/QJediInstaller.res differ diff --git a/official/1.96/install/QJediInstallerMain.pas b/official/1.96/install/QJediInstallerMain.pas new file mode 100644 index 0000000..baa65af --- /dev/null +++ b/official/1.96/install/QJediInstallerMain.pas @@ -0,0 +1,662 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ 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 JediInstallerMain.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. } +{ } +{ Contributors: } +{ Andreas Hausladen (ahuser) } +{ Robert Rossmair (rrossmair) - crossplatform & BCB support, refactoring } +{ } +{**************************************************************************************************} + +// $Id: JediInstallerMain.pas,v 1.34 2006/02/05 13:26:15 outchy Exp $ + +unit QJediInstallerMain; + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, Messages, + {$ENDIF MSWINDOWS} + SysUtils, Classes, + Types, + Qt, QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, QMenus, QButtons, QComCtrls, QImgList, + QProductFrames, + JclBorlandTools, JediInstall; + +const + QEventType_UMCheckUpdates = QEventType(Integer(QEventType_ClxUser) + $100); + +type + TMainForm = class(TForm, IJediInstallTool) + InstallBtn: TBitBtn; + UninstallBtn: TBitBtn; + QuitBtn: TBitBtn; + JediImage: TImage; + TitlePanel: TPanel; + Title: TLabel; + ProductsPageControl: TPageControl; + StatusBevel: TBevel; + StatusLabel: TLabel; + Bevel1: TBevel; + ProgressBar: TProgressBar; + ImageList: TImageList; + ReadmePage: TTabSheet; + ReadmePane: TTextViewer; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure QuitBtnClick(Sender: TObject); + procedure InstallBtnClick(Sender: TObject); + procedure UninstallBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure JediImageClick(Sender: TObject); + procedure TreeViewCollapsing(Sender: TObject; Node: TTreeNode; + var AllowCollapse: Boolean); + procedure BplPathEditChange(Sender: TObject); + private + FBorRADToolInstallations: TJclBorRADToolInstallations; + FJclInstall: IJediInstall; + FSystemPaths: TStringList; + FFeatureNode: TTreeNode; + FFeatureChanged: Boolean; + FHintPos: TPoint; + function ActiveView: TProductFrame; + function CheckUpdatePack(Installation: TJclBorRADToolInstallation): Boolean; + function CreateView(Installation: TJclBorRADToolInstallation): Boolean; + function ExpandOptionTree(Installation: TJclBorRADToolInstallation): Boolean; + procedure InstallationStarted(Installation: TJclBorRADToolInstallation); + procedure InstallationFinished(Installation: TJclBorRADToolInstallation); + procedure InstallationProgress(Percent: Cardinal); + procedure ReadSystemPaths; + function View(Installation: TJclBorRADToolInstallation): TProductFrame; + procedure TreeViewChange(Sender: TObject; Node: TTreeNode); + procedure TreeViewEnter(Sender: TObject); + procedure TreeViewExit(Sender: TObject); + procedure TreeViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure UpdateFeatureInfo(Node: TTreeNode); + protected + function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override; + function InfoFile(Node: TTreeNode): string; + function OptionGUI(Installation: TJclBorRADToolInstallation): TObject; + function GUIAddOption(GUI, Parent: TObject; Option: TJediInstallOption; const Text: string; + GUIOptions: TJediInstallGUIOptions): TObject; + procedure HandleException(Sender: TObject; E: Exception); + property JclDistribution: IJediInstall read FJclInstall; + // IJediInstallTool + function GetBPLPath(Installation: TJclBorRADToolInstallation): string; + function GetDCPPath(Installation: TJclBorRADToolInstallation): string; + procedure SetBPLPath(Installation: TJclBorRADToolInstallation; const Value: string); + procedure SetDCPPath(Installation: TJclBorRADToolInstallation; const Value: string); + public + procedure ShowFeatureHint(var HintStr: WideString; + var CanShow: Boolean; var HintInfo: THintInfo); + function CheckRunningInstances: Boolean; + procedure Install; + procedure Uninstall; + function SystemPathValid(const Path: string): Boolean; + // IJediInstallTool + function FeatureChecked(FeatureID: Cardinal; Installation: TJclBorRADToolInstallation): Boolean; + function GetBorRADToolInstallations: TJclBorRADToolInstallations; + function Dialog(const Text: string; DialogType: TDialogType = dtInformation; + Options: TDialogResponses = [drOK]): TDialogResponse; + procedure SetReadme(const FileName: string); + procedure UpdateInfo(Installation: TJclBorRADToolInstallation; const InfoText: String); + procedure UpdateStatus(const Text: string); + procedure WriteInstallLog(Installation: TJclBorRADToolInstallation; const Text: string); + property BorRADToolInstallations: TJclBorRADToolInstallations read FBorRADToolInstallations; + property BPLPath[Installation: TJclBorRADToolInstallation]: string read GetBPLPath write SetBPLPath; + property DCPPath[Installation: TJclBorRADToolInstallation]: string read GetDCPPath write SetDCPPath; + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.xfm} + +uses + {$IFDEF UNIX} + Libc, + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + FileCtrl, + JclDebug, JclShell, + {$ENDIF MSWINDOWS} + JclBase, JclFileUtils, JclStrings, JclSysInfo, JclSysUtils, + JclInstall; + +const + {$IFNDEF RTL140_UP} + PathSep = ';'; + {$ENDIF RTL140_UP} + {$IFDEF MSWINDOWS} + SupportURLs: array[TJclBorRADToolKind] of string = ( + 'http://www.borland.com/devsupport/delphi/', + 'http://www.borland.com/devsupport/bcppbuilder/', + 'http://www.borland.com/devsupport/delphi/'); + {$ENDIF MSWINDOWS} + {$IFDEF KYLIX} + KylixSupportURL = 'http://www.borland.com/devsupport/kylix/'; + {$ENDIF KYLIX} + DelphiJediURL = 'http://delphi-jedi.org'; + VersionSignature = 'D%d'; + BCBTag = $10000; + VersionMask = $FFFF; + +function FeatureID(Node: TTreeNode): Cardinal; +begin + Result := Cardinal(Node.Data) and FID_NumberMask; +end; + +{ TMainForm } + +function TMainForm.ActiveView: TProductFrame; +var + Page: TTabSheet; + Control: TControl; +begin + Result := nil; + Page := ProductsPageControl.ActivePage; + Control := Page.Controls[0]; + if Control is TProductFrame then + Result := TProductFrame(Control); +end; + +function TMainForm.InfoFile(Node: TTreeNode): string; +begin + if Assigned(Node) then + Result := FJclInstall.FeatureInfoFileName(FeatureID(Node)); +end; + +function TMainForm.CreateView(Installation: TJclBorRADToolInstallation): Boolean; +var + Page: TTabSheet; + ProductFrame: TProductFrame; +begin + Page := TTabSheet.Create(Self); + with Installation do + begin + Page.Name := Format('%sPage', [VersionNumberStr]); + Page.Caption := Name; + end; + Page.PageControl := ProductsPageControl; + ProductFrame := TProductFrame.Create(Self); + ProductFrame.Installation := Installation; + ProductFrame.TreeView.Images := ImageList; + ProductFrame.TreeView.OnChange := TreeViewChange; + ProductFrame.TreeView.OnCollapsing := TreeViewCollapsing; + ProductFrame.TreeView.OnEnter := TreeViewEnter; + ProductFrame.TreeView.OnExit := TreeViewExit; + ProductFrame.TreeView.OnMouseMove := TreeViewMouseMove; + ProductFrame.Align := alClient; + ProductFrame.Parent := Page; + FJclInstall.SetOnWriteLog(Installation, ProductFrame.LogOutputLine); + Result := True; +end; + +function TMainForm.CheckRunningInstances: Boolean; +begin + Result := FBorRADToolInstallations.AnyInstanceRunning; + if Result then + Dialog(RsCloseRADTool, dtWarning); +end; + +function TMainForm.CheckUpdatePack(Installation: TJclBorRADToolInstallation): Boolean; +var + Msg: string; +begin + Result := True; + with Installation do + if UpdateNeeded then + begin + Msg := Format(RsUpdateNeeded, [LatestUpdatePack, Name]); + if Dialog(Msg, dtWarning, [drYes, drNo]) = drYes then + {$IFDEF MSWINDOWS} + ShellExecEx(SupportURLs[RadToolKind]); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + { TODO : Analoguous function for Linux }; + // Exec(KylixSupportURL); + {$ENDIF UNIX} + end; +end; + +function TMainForm.GUIAddOption(GUI, Parent: TObject; Option: TJediInstallOption; + const Text: string; GUIOptions: TJediInstallGUIOptions): TObject; +const + Icon: array[Boolean] of Integer = (IcoUnchecked, IcoChecked); + Flag: array[Boolean] of Cardinal = (0, FID_Checked); +var + FeatureID: Cardinal; + Nodes: TTreeNodes; + Node, ParentNode: TTreeNode; + Checked: Boolean; +begin + ParentNode := TTreeNode(Parent); + Checked := goChecked in GUIOptions; + FeatureID := Cardinal(Ord(Option)) + Flag[goChecked in GUIOptions]; + if goNoAutoCheck in GUIOptions then + FeatureID := FeatureID + FID_NoAutoCheck; + if goStandAloneParent in GUIOptions then + FeatureID := FeatureID + FID_StandAloneParent; + if goRadioButton in GUIOptions then + FeatureID := FeatureID + FID_RadioButton; + if goExpandable in GUIOptions then + FeatureID := FeatureID + FID_Expandable; + Nodes := TTreeNodes(GUI); + if Parent = nil then + Node := Nodes.AddObject(nil, Text, Pointer(FeatureID)) + else + Node := Nodes.AddChildObject(ParentNode, Text, Pointer(FeatureID)); + Node.ImageIndex := Icon[Checked]; + Node.SelectedIndex := Icon[Checked]; + Result := Node; +end; + +procedure TMainForm.HandleException(Sender: TObject; E: Exception); +begin + if E is EJediInstallInitFailure then + begin + Dialog(E.Message, dtError); + Application.ShowMainForm := False; + Application.Terminate; + end + else + Application.ShowException(E); +end; + +procedure TMainForm.Install; +var + Res: Boolean; +begin + ProgressBar.Position := 0; + ProgressBar.Visible := True; + Screen.Cursor := crHourGlass; + try + Res := FJclInstall.Install; + Screen.Cursor := crDefault; + if Res then + Dialog(RsInstallSuccess) + else + Dialog(RsInstallFailure); + finally + ProgressBar.Visible := False; + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.Uninstall; +begin + ProgressBar.Position := 0; + ProgressBar.Visible := True; + Screen.Cursor := crHourGlass; + try + FJclInstall.Uninstall; + Screen.Cursor := crDefault; + finally + ProgressBar.Visible := False; + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.InstallationProgress(Percent: Cardinal); +begin + ProgressBar.Position := Percent; +end; + +function TMainForm.View(Installation: TJclBorRADToolInstallation): TProductFrame; +begin + if not Assigned(Installation) then + Result := nil + else + with Installation do + Result := FindComponent(TProductFrame.GetName(Installation)) as TProductFrame; +end; + +procedure TMainForm.ReadSystemPaths; +var + PathVar: string; + I: Integer; +begin + if GetEnvironmentVar('PATH', PathVar, False) then + begin + StrToStrings(PathVar, PathSep, FSystemPaths, False); + for I := 0 to FSystemPaths.Count - 1 do + begin + PathVar := StrTrimQuotes(FSystemPaths[I]); + ExpandEnvironmentVar(PathVar); + {$IFDEF MSWINDOWS} + PathVar := AnsiUpperCase(PathRemoveSeparator(PathGetLongName(PathVar))); + {$ENDIF MSWINDOWS} + FSystemPaths[I] := PathVar; + end; + FSystemPaths.Sorted := True; + end; +end; + +function TMainForm.SystemPathValid(const Path: string): Boolean; +begin + Result := FSystemPaths.IndexOf({$IFDEF MSWINDOWS}AnsiUpperCase{$ENDIF}(Path)) <> -1; +end; + +procedure TMainForm.UpdateInfo(Installation: TJclBorRADToolInstallation; const InfoText: String); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + begin + P.InfoDisplay.Text := InfoText; + end; +end; + +procedure TMainForm.UpdateStatus(const Text: string); +begin + if Text = '' then + begin + StatusBevel.Visible := False; + StatusLabel.Visible := False; + end + else + begin + StatusLabel.Caption := Text; + StatusBevel.Visible := True; + StatusLabel.Visible := True; + end; + Application.ProcessMessages; //Update; +end; + +procedure TMainForm.WriteInstallLog(Installation: TJclBorRADToolInstallation; const Text: string); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + P.LogOutputLine(Text); +end; + +function TMainForm.GetBPLPath(Installation: TJclBorRADToolInstallation): string; +var + P: TProductFrame; + Path: string; +begin + P := View(Installation); + if Assigned(P) then + Path := P.BplPath; + Result := PathRemoveSeparator(Installation.SubstitutePath(Path)); +end; + +function TMainForm.GetDCPPath(Installation: TJclBorRADToolInstallation): string; +var + P: TProductFrame; + Path: string; +begin + P := View(Installation); + if Assigned(P) then + Path := P.DcpPath; + Result := PathRemoveSeparator(Installation.SubstitutePath(Path)); +end; + +procedure TMainForm.BplPathEditChange(Sender: TObject); +begin + with (Sender as TEdit) do + if SystemPathValid(Text) then + Font.Color := clWindowText + else + Font.Color := clRed; +end; + +function TMainForm.FeatureChecked(FeatureID: Cardinal; Installation: TJclBorRADToolInstallation): Boolean; +var + P: TProductFrame; +begin + Result := False; + P := View(Installation); + if Assigned(P) then + Result := P.FeatureChecked(FeatureID); +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + Application.OnException := HandleException; + FBorRADToolInstallations := TJclBorRADToolInstallations.Create; + FSystemPaths := TStringList.Create; + JediImage.Hint := DelphiJediURL; + FJclInstall := CreateJclInstall; + FJclInstall.SetOnProgress(InstallationProgress); + FJclInstall.SetOnStarting(InstallationStarted); + FJclInstall.SetOnEnding(InstallationFinished); + FJclInstall.SetTool(Self); + BorRADToolInstallations.Iterate(ExpandOptionTree); + + UpdateStatus(''); + + ReadSystemPaths; + //WindowState := wsMaximized; // wouldn't work in Form resource + Application.HintPause := 50; + Application.OnShowHint := ShowFeatureHint; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FBorRADToolInstallations); + FreeAndNil(FSystemPaths); +end; + +function TMainForm.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; +begin + if QEvent_type(Event) = QEventType_UMCheckUpdates then + begin + BorRADToolInstallations.Iterate(CheckUpdatePack); + Result := True; + end + else + Result := inherited EventFilter(Sender, Event); +end; + + +procedure TMainForm.QuitBtnClick(Sender: TObject); +begin + Close; +end; + +function TMainForm.ExpandOptionTree( + Installation: TJclBorRADToolInstallation): Boolean; +var + P: TProductFrame; +begin + Result := True; + P := View(Installation); + if Assigned(P) then + P.UpdateTree; +end; + +procedure TMainForm.InstallBtnClick(Sender: TObject); +begin + if ({$IFDEF MSWINDOWS} IsDebuggerAttached or {$ENDIF} not CheckRunningInstances) and + (Dialog(RsConfirmInstall, dtConfirmation, [drYes, drNo]) = drYes) then + begin + Install; + QuitBtn.SetFocus; + end; +end; + +procedure TMainForm.UninstallBtnClick(Sender: TObject); +begin + if ({$IFDEF MSWINDOWS} IsDebuggerAttached or {$ENDIF} not CheckRunningInstances) then + begin + Uninstall; + QuitBtn.SetFocus; + end; +end; + +procedure TMainForm.FormShow(Sender: TObject); +begin + QApplication_postEvent(Handle, QCustomEvent_create(QEventType_UMCheckUpdates, Self)); +end; + +procedure TMainForm.JediImageClick(Sender: TObject); +begin + { TODO : implement for Unix } + {$IFDEF MSWINDOWS} + ShellExecEx(DelphiJediURL); + {$ENDIF MSWINDOWS} +end; + +procedure TMainForm.TreeViewCollapsing(Sender: TObject; Node: TTreeNode; + var AllowCollapse: Boolean); +begin + AllowCollapse := Collapsable(Node); +end; + +function TMainForm.GetBorRADToolInstallations: TJclBorRADToolInstallations; +begin + Result := FBorRADToolInstallations; +end; + +procedure TMainForm.InstallationStarted(Installation: TJclBorRADToolInstallation); +var + P: TProductFrame; +begin + P := View(Installation); + P.InfoDisplay.Lines.Clear; + ProductsPageControl.ActivePage := P.Parent as TTabSheet; + P.StartCompilation(Installation); +end; + +procedure TMainForm.InstallationFinished(Installation: TJclBorRADToolInstallation); +var + P: TProductFrame; +begin + P := View(Installation); + P.StopCompilation(Installation); + P.InfoDisplay.Lines.SaveToFile(JclInstall.LogFileName(Installation)); +end; + +function TMainForm.Dialog(const Text: string; DialogType: TDialogType = dtInformation; + Options: TDialogResponses = [drOK]): TDialogResponse; +const + DlgType: array[TDialogType] of TMsgDlgType = (mtWarning, mtError, mtInformation, mtConfirmation); + DlgButton: array[TDialogResponse] of TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel); + DlgResult: array[TDialogResponse] of Word = (mrYes, mrNo, mrOK, mrCancel); +var + Buttons: TMsgDlgButtons; + Res: Integer; +begin + Buttons := []; + for Result := Low(TDialogResponse) to High(TDialogResponse) do + if Result in Options then + Include(Buttons, DlgButton[Result]); + Res := MessageDlg(Text, DlgType[DialogType], Buttons, 0); + for Result := Low(TDialogResponse) to High(TDialogResponse) do + if DlgResult[Result] = Res then + Break; +end; + +procedure TMainForm.SetBPLPath(Installation: TJclBorRADToolInstallation; const Value: string); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + P.BplPath := Value; +end; + +procedure TMainForm.SetDCPPath(Installation: TJclBorRADToolInstallation; const Value: string); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + P.DcpPath := Value; +end; + +procedure TMainForm.SetReadme(const FileName: string); +begin + ReadmePane.LoadFromFile(FileName); + {$IFDEF MSWINDOWS} + ShellExecEx('..\docs\Readme.html'); + {$ENDIF MSWINDOWS} +end; + +procedure TMainForm.TreeViewChange(Sender: TObject; Node: TTreeNode); +begin + UpdateFeatureInfo(Node); +end; + +procedure TMainForm.TreeViewEnter(Sender: TObject); +begin + with ActiveView do + UpdateFeatureInfo(TreeView.Selected); +end; + +procedure TMainForm.TreeViewExit(Sender: TObject); +begin + // +end; + +procedure TMainForm.TreeViewMouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin + UpdateFeatureInfo(ActiveView.TreeView.GetNodeAt(X, Y)); +end; + +procedure TMainForm.UpdateFeatureInfo(Node: TTreeNode); +begin + if Assigned(Node) and (Node <> FFeatureNode) then + begin + FFeatureNode := Node; + FFeatureChanged := True; + end; +end; + +procedure TMainForm.ShowFeatureHint; +var + View: TProductFrame; +begin + View := ActiveView; + if Assigned(View) and (HintInfo.HintControl = View.TreeView) then + begin + if FFeatureChanged then + begin + HintInfo.HintStr := FJclInstall.GetHint(TJediInstallOption(FeatureID(FFeatureNode) and $FF)); + FHintPos := HintInfo.HintPos; + FFeatureChanged := False; + end + else + HintInfo.HintPos := FHintPos; + HintInfo.ReshowTimeout := 500; + end; +end; + +function TMainForm.OptionGUI( + Installation: TJclBorRADToolInstallation): TObject; +begin + Result := View(Installation); + if Result = nil then + CreateView(Installation); + Result := View(Installation).TreeView.Items; +end; + +end. diff --git a/official/1.96/install/QJediInstallerMain.xfm b/official/1.96/install/QJediInstallerMain.xfm new file mode 100644 index 0000000..c1d5e6c --- /dev/null +++ b/official/1.96/install/QJediInstallerMain.xfm @@ -0,0 +1,474 @@ +object MainForm: TMainForm + Left = 280 + Top = 163 + Width = 846 + Height = 614 + VertScrollBar.Range = 49 + ActiveControl = ReadmePane + AutoScroll = False + Caption = 'JEDI Installer' + Color = clButton + Constraints.MinHeight = 600 + Constraints.MinWidth = 800 + Font.Color = clText + Font.Height = 12 + Font.Name = 'helvetica' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentFont = False + Position = poScreenCenter + Scaled = False + ShowHint = True + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + PixelsPerInch = 96 + object StatusBevel: TBevel + Left = 8 + Top = 582 + Width = 395 + Height = 19 + Anchors = [akLeft, akRight, akBottom] + end + object Bevel1: TBevel + Left = 8 + Top = 568 + Width = 821 + Height = 9 + Anchors = [akLeft, akRight, akBottom] + Shape = bsTopLine + end + object ProgressBar: TProgressBar + Left = 412 + Top = 582 + Width = 153 + Height = 19 + Anchors = [akLeft, akRight, akBottom] + Visible = False + end + object StatusLabel: TLabel + Left = 16 + Top = 584 + Width = 379 + Height = 14 + Anchors = [akLeft, akRight, akBottom] + AutoSize = False + Caption = 'StatusLabel' + end + object TitlePanel: TPanel + Left = 0 + Top = 0 + Width = 846 + Height = 49 + Align = alTop + BevelWidth = 2 + BorderStyle = bsSingle + Color = 9981440 + ParentColor = False + TabOrder = 2 + object JediImage: TImage + Left = 708 + Top = 9 + Width = 116 + Height = 31 + Cursor = crHandPoint + Anchors = [akTop, akRight] + AutoSize = True + Picture.Data = { + 07544269746D617046120000424D421200000000000036040000280000007400 + 00001F00000001000800000000000C0E00000000000000000000000100000001 + 0000FFFFFF000808080010101000181818002121210029292900313131003939 + 3900424242004A4A4A00525252005A5A5A00636363006B6B6B00737373007B7B + 7B00848484008C8C8C00949494009C9C9C00A5A5A500ADADAD00B5B5B500BDBD + BD00C6C6C600CECECE00D6D6D600DEDEDE00E7E7E700EFEFEF00F7F7F700E7E7 + EF00EFEFF700CECED600D6D6DE00DEDEE700A5A5AD00ADADB50094949C009C9C + A50084848C00E7E7F7006B6B73007B7B840063636B0052525A00292931002121 + 290042425200181821001818290008081000101021000808180039425A00D6DE + EF00CED6E700B5BDCE00ADB5C600525A6B0029314200C6CEDE00A5ADBD00DEE7 + F700D6DEE700949CA500CEDEEF00C6D6E700A5B5C600525A63008C9CAD00A5BD + D6003139420010182100E7EFF700CED6DE00C6CED600ADB5BD00A5ADB5008C94 + 9C00BDCEDE00B5C6D6009CADBD004A525A00BDD6EF000810180010213100DEE7 + EF0039424A0018212900A5BDCE00849CAD00BDD6E7009CB5C600CEE7F700CEDE + E700ADBDC6008C9CA5004A5A6300C6D6DE00A5B5BD0084949C0063737B00DEEF + F700BDCED600B5C6CE009CADB50094A5AD007B8C9400C6DEE700A5BDC600849C + A500B5CED6009CB5BD0094ADB5008CA5AD007B949C00E7EFEF00EFF7F700F7FF + FF00CED6D600DEE7E700B5BDBD00A5ADAD00BDC6C6008C949400949C9C00848C + 8C00737B7B00E7F7F7006B737300C6D6D600ADBDBD00B5C6C600BDCECE00A5B5 + B5005A6363009CADAD008C9C9C0094A5A50084949400BDD6D600ADC6C6009CB5 + B500849C9C0094B5B500182121001829290008101000BDCEC6009CADA500CEDE + D600C6D6CE00E7EFE700CED6CE00D6DED6006B736B0010181000EFEFE700F7F7 + EF00FFFFF700CECEC600DEDED600E7E7DE00BDBDB500ADADA500C6C6BD00A5A5 + 9C008C8C840084847B00CECEBD005A5A5200ADAD9C009C9C8C004A4A42004242 + 3900EFE7CE00B5AD9C0029211000BDB5A500C6A56B00C6B59C00CEC6BD00ADA5 + 9C00F7EFE700DED6CE00D6CEC600B5ADA5009C948C00948C8400EFDECE00A57B + 5200E7DED600C6BDB500B5A59C0094847B009C8C84004A393100634A4200EFE7 + E700CEC6C600E7DEDE00BDB5B500B5ADAD00C6BDBD00A59C9C00BDADAD00C6B5 + B5005A525200B5A5A500AD9C9C009C8C8C00A59494004A4242008C7B7B003931 + 3100A58C8C009C848400947B7B005A4A4A008C737300846B6B007B6363008C6B + 6B007B5A5A002118180073525200634242005A313100522929004A2121004218 + 180052212900734A52005A313900522931004A2129004A18210094737B008463 + 6B0073525A006B4A52004A293100AD949C00A58C94009C848C00EFE7EF00F7EF + F700FFF7FF00D6CED60039313900211821001810180010081000100818000000 + 0000A903FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00BBBBBBB3B3BBB3BBB3 + BBB3BBB3B3BBB3B3BBB3BBB3BBB3BBB3BBB3BBB3B3BBB3B3B3BBB3BBB3BBB3BB + B3BBBBB3BBBBB3BBB3BBB3BBB3BBB3BBB3B3BBB3BBB3BBB3BBB3B3BBB3BBB3BB + B3BBB3BBB3BBB3BBBBBBBBBBB3B3BBB3BBB3B3DDEBE4EBE5DFA2BACFC7C900BA + E5EDEBDCBBBBB3B3BBFF00C1C1C1C1A4A4C1C1A4C1A4C1C1A4C1A4A4C1A4C1A4 + C1A4C1A4C1C1A4C1A4C1A4C1A4C1A4C1A4C1A4C1A4C1C1C1A4C1C1A4C1C1A4C1 + A4C1A4C1C1A4C1A4C1A4C1A4C1C1A4C1A4C1A4C1A4C1A4C1A4C1C1A4C1C1C1C1 + C1A4C1A4C1C1A4C1DCEBE5E31E009E1AD11D1BEADED9EAE8C4C1C1A4C1FF00B6 + B6A6B6B6B6B6B6B6B6B6A6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6B6 + B6B6B6B6B6B6B6B6B6B6A6B6B6A6B6B6B6B6B6B6B6B6B6A6B6B6B6B6B6B6B6B6 + A6B6A6B6B6B6B6B6B6B6B6B6B6A6B6B6B6A6B6A6B6B6B6B6B6A6B6A6AAC3EBE5 + F4C7F4DF20BAEADA0000B6EAEBC4B6B6B6FF00A1BABABABABAA1BAA1BABABAA1 + BABAA1BABABABABAA1BABABAA1BABAA1BAA1BAA1BAA1BAA1BABAA1BAA1BABABA + BABABAA1A1BAA1BABAA1BABAA1BABAA1BABAA1BABABABABABABABAA1BAA1BAA1 + BABAA1BABABABABAA1BABAA1BABABABABABAD2EBE5EADD00C9E5EF001DD600CA + E5EBC4BABAFF001AB91A1A1A1AB9B9B9B91AB9B9B91AB9A21AB91AB9B9B91A1A + B91A1AB9B9B9B91AB9B9B9B9B91AB9B9A2B91A1A1AB91AB9B9B9B9B91AB9B91A + B9B91AB9A21AB9B91AB91A1AB91A1AB9B9B9B9B9B91AB9B91AB9B91AB9B91AB9 + B91AB91AB91AB9BCEBE6D81AEADC001CE9D200BBEDECEBB7A2FF00C0A2A219CA + A4CA17A2A2A2A2A2A2A2BA131313A2A2177D1215A2A2C815822A2C9C7D12A2A2 + A1CB802C8213A4C0A2C812137E137E13CAA2A21610800E0D8013A2A2A2A12714 + 13A4C0A2A2A2A2187B101028CDBAA2A2A21313137E141414A2171413D5EBEBE4 + E000C9E2D100CFE8E2D1EAEBD2FF00A3A3A37B41746C18A3A3C9A3A3A3A34D85 + 3E60A3A36B84728BA3197B4C689B4B1B9860A9A34E914B8698696B14A3237C84 + 86691C8E4DA3787A86851B9922251AA3A322224B4027A3A3A3A316781B4A6983 + 607E14A340864322401D1E16A31E1E766CFAEBE6DC00D1D200C8ECF01C00CFE5 + E5FF001CC7C77E6A4E6A65C7C79EC7C7C7C7896A916AC799643E854EC71A526E + 64916A724E894E19274D718564858318C71A8660697C69A27CC986869A4B6319 + 401C2CC7C71C401F76A5C7C7C7C74019691A404A1F760CC775764A811E374D15 + 9EFE9DFD02FD09EBEBD20000CFE4F5A01C00CEEAEAFF009F9F1D15898B896A1D + 9F1D9F1D9F1D7B6471211D9F7C868F4E1D21608539211C3A606A8E18698564BA + 218540849F1A8D78784C7979231C634B68981C1F5720171D9F1D1F1E75159F1D + 9F1F37797976201E1E1E1EA21E408C3B0F110C159F0333B2B2C510DBEBE5DAD3 + EBCE00CC1ABAE3A2C8FF001E1E1E7E736B73611E1E1E1E1E1E1E249187731E1E + 646B7B6B1E785D713A981E876A9885178469861A1983867B1E2278221BA11E1E + 1E9F1E7557221E1C1D1D1A1E1E1D76381F151E1E1E20765F3918195692494915 + 03FE31FE191E1E1E1EFDB5C11DBFB4B0CCECECE4A200D3D1C9DC1B1E00FF0000 + 00007E4D64844EA5CB18F7A000008B8685891AA64E8F89890022868E6818009B + 8569987A784C4B1A694B40250022386350160000001E1F9F1DA200793F1D1900 + 00001E7551250000007A5308310F1A350403FC16920404941800000000020B1E + C0BEB81E05D7EBEBD9EEF59FCF1EB61DA2FF00000000656F7E746B6561650B13 + 1D008B6F6B5A8261527A691C00227C408E18004B401B79215723791D2363404E + 009B976340A11E1E00001E405F4B00795F371F0000279D49FE130000001431FC + 920F1902E19203160304040118001E000003032ABA9EBA0C0233BDEBE6EA9FF8 + 9FD4C89FF0FF000000007D746B6B6B6F6B4E876F0E1E4E87644E686986257E00 + 002260643E9500681B3778220000001D864C606A0022401E1E7F9C881A7C5345 + 452800000000000000273105FB1400000019101010191A010304031604E103E1 + 090A0A160003040204000A0102020DCCEBEBD81BDDCE00EFE6FF000000006573 + 6F736B726B5D8464691B4D684B86514B86504B11005763573F18007C4B7086A2 + 00000020545A8615004D3B49FE9232FE1A7B322FFB0D00000000000000130403 + E114000000000000000019FD0304031604920392030303140003030304000A02 + 02010D1B07EBE5EBD200F4E7F3FF000000008A6B7260601D4C72526A46784E64 + 726E1B771C751C7A00406767817800571E3750A20000001B0892592D00103104 + 3103FC011A15FB04E10D000000000000001403E1031400000000000000001A01 + 03030316040403E103FC021300E1030305000A0201020D1C0202EBE5D8CCEBD2 + 00FF000000003E64393A7200006E5239421B185C75671C0043393A7100252E59 + 4927003CFEFE331C0000001B04FB040B0010FB03920C0F0C001231E1920D001E + 1F9E750000140403031400000000000000001A0204049D16030305020B0F0E00 + 0003319D05000A0202010C1C020202F2EBECC200D1FF000000004F5B72527100 + 0069508E8E226067713C1C0007593131001331042F14000731FB9D1C0000001B + 0492310A0010E1920417000000110392040D0010070706000013039203140000 + 0000000000001A0103050316E1030402980000000003030204000A0201020C1C + 02010206F1E8F4D1E5FF000000A04D3F5E6350000050475047194F94FE021D00 + 92E1040400139204E17B00060492031C00A0001A03E1E1D0001003E103180000 + 0012E104E10D000F0303030000130404031400000000A0000000210204030316 + 04040302C80000000003030205002D0202020E1B0202FD061DE2E5E5EBFF001E + 1E1E8C7482452D1E1E3030303C150A03039D14140404E12F1ECD0403FB0E1903 + E1E1031D1E1E1E190492030A1E2B03920310A71321A7E1920308180992040218 + A70E03E1030E13CB1E1E1E1E1E1EBA94E192031504030402111413191E030302 + 2FA40401020113A2020294061ECAEBEBEBFF001D1DF709FE03FBFC1D1E02E192 + 03150A0304E102FC030403D09F160392033101040492011D1D1D9F190403040A + 9FA803E1040202021117E192E10394E103030A02020392E192FC02089E1D1D1D + 1D1D190203E10215E1040392030202109F0303020201020202011B1A0202FD06 + 9F1DBDEBE4FF009EC79E099DFB9203161002E10303150AFC04319203E103011A + C71A0104E1FBFB04030114C7C7C71CA131E1030A9E2B03030304030211C792E1 + 0492E19203011A0103E10392030404091CC7C7C7C7C71994039203A531040303 + E10303A8C703020301020133FD0B9E18020102059EC7C7A4EBFF00A3A3A30903 + 040403020392E10402A20F08AE08AE08080B1DA3A3A31807080707AF0A10A3A3 + A3A3A3BA0B0A0A10A3130A0A0A0A0AAEA1A3A308090707070A12A3060A0AD00A + 0A0A0A10A3A3A3A3A3A3A10192E103150BAB0A0A0A0A0A15A3080A0909090AAF + 15A3A3A10909090EA3A3A31CC1FF00A2A2C009030303040303E1040110C0A2A2 + A2C0A2C0A2A2C0A2A2C0A2B91ABAA11AA2A2C0A2A2C0A2A2A2C0A2A2A2C0A2A2 + C0A2C0A2A2C0A2A2B9BA1AA1A2C0A2A2C0A2A2C0A2A2A2A2A2C0A2A2A2A21802 + 03E102A4A2A2A2C0A2A2A2A2C0A2C0A2A2A2C0A2C0A2A2C0A2A2B9C0A2A2A2A2 + A2FF00B91AB90A03040492042F060AA81A1AB99BB91A1A1AB91A1AB91A1A1AB9 + 1A1AB91AB91A1AB91A1A1A1AB91AB91A1AB91A1A1AB91A1A1A1AB91A1A1AB9B9 + 9B1AB91A1A1A1A1AB91AB91A1A1AB91AB91AC89404040316B91A1A1AB91AB91A + 1A1A1AB91A1AB91A9BB91AB9B91A1A1AB91AB91AB9FF00BAA1BAA1BABABABABA + BABAA1BAA1BAA1BAA1BABABAA1BABAA1BABABAA1BABAA1BAA1BABAA1BABABABA + A1BAA1BABAA1BABABAA1BABABABAA1BABABAA1A1BABAA1BABABABABAA1BAA1BA + BABAA1BAA1BAA1BABAA1BABAA1BABABAA1BAA1BABABABAA1BABAA1BABAA1BAA1 + A1BABABAA1BAA1BABAFF00B6B6B6B6B6C1AAC1AAC1AAA6B6B6B6B6B6C1B6C1AA + B6B6B6B6B6B6C1AAB6C1AAB6B6B6C1AAB6C1AAC1AAC1AAB6B6C1AAC1AAB6B6C1 + AAB6B6B6C1AAB6B6B6C1B6B6B6C1AAC1AAB6B6C1AAC1AAB6B6B6B6B6C1AAB6B6 + B6B6C1AAB6B6B6B6B6C1AAB6B6C1B6B6B6C1AAB6B6B6B6B6B6B6B6B6B6FF00A4 + C1C1A4C1C1C1C1C1C1C1C1C1C1C1A4C1C1C1C1C1A4C1C1A4C1C1C1C1C1C1C1A4 + C1C1C1C1C1C1C1C1C1C1C1A4C1C1C1C1C1A4C1C1C1A4C1C1C1C1A4C1C1C1C1A4 + C1C1C1C1A4C1C1C1C1C1C1A4C1C1A4C1C1C1C1C1A4C1C1C1A4C1A4C1C1C1C1A4 + C1C1C1C1C1C1C1A4C1C1C1A4C1C1C1C1C1FF00B3BBB3B3B3BBB3BBB3BBB3BBB3 + BBB3B3B3BBB3B3BBB3BBB3B3BBB3BBB3BBB3BBB3B3BBB3BBB3BBB3BBB3BBB3B3 + B3BBB3BBB3BBB3BBB3B3B3BBB3BBB3BBB3BBB3B3B3BBB3BBB3BBB3BBB3BBB3B3 + B3BBB3BBB3BBB3BBB3BBB3BBB3BBB3BBB3BBB3B3BBB3B3BBB3BBB3B3BBB3BBB3 + BBB3BBB3BBFF00ACC2ACC2ACC2ACC2B7B1B7B1B7B1B7B1B7B1B7B1B7B1B7B1B7 + B1B7B1B7B1B7B1B7ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2 + ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2B7B1B7B1B7B1B7B1B7B1B7B1B7B1 + B7B1B7B1B7B1B7C2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ACC2ADFF000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000001E0E} + OnClick = JediImageClick + end + object Title: TLabel + Left = 8 + Top = 13 + Width = 197 + Height = 24 + Caption = 'Project JEDI Installer' + Font.Color = clWhite + Font.Height = 21 + Font.Name = 'helvetica' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentFont = False + end + end + object InstallBtn: TBitBtn + Left = 572 + Top = 579 + Width = 80 + Height = 25 + Anchors = [akRight, akBottom] + Caption = '&Install' + TabOrder = 0 + OnClick = InstallBtnClick + Glyph.Data = { + 3A030000424D3603000000000000360000002800000010000000100000000100 + 18000000000000030000230B0000230B00000000000000000000C6CED6C6CED6 + C6CECECECED6C6CED6C6CED6C6CECECECECEC6CED6BDB5B5C6C6BDC6CECEC6CE + D6C6CECEC6CED6C6CED6C6CED6C6CED6C6D6CEC6CED6C6CED6C6CECEADB5BDAD + ADADBDB5AD185294527394CEC6B59C9CADBDB5B5C6CECEC6CED6C6CED6C6CED6 + CECECEC6CED6C6CED6B5C6CE296BA5185294425A8431A5D63184B5425A7B1052 + 94637B8CCECECEC6CECEC6CED6C6CED6C6CECEC6CED6C6CECEB5BDBD4AADDE39 + A5DE1884BD39B5E7219CCE107BB5109CCE5294A5C6C6BDC6CECEC6CED6C6CED6 + C6D6CEC6CED6B5BDCE3163943194CE52BDEF39B5E739B5E731A5D6219CD6109C + CE10639C5A7394CECECEC6CED6C6CED6CECECEC6CED6ADC6D6399CD64AB5EF52 + BDEF63C6EF94ADBD396B840873B51084BD008CC6217BADCECECEC6CED6C6CECE + C6CED6C6CED6B5C6CE5ABDD652BDEF42BDEF94D6EFADADAD4A636B107BB50894 + CE109CCE52ADC6C6CECEC6CED6C6CED67BAD7BC6C6ADA5BD94088408218C844A + B5EF94D6EFADADAD4A636B219CCE189CCE9CB5BDC6CECEC6CED6C6CED69CC69C + 21AD31188C18399C3131CE5229AD7B39B5BD84CEB59C94945A636363ADC642AD + D6ADC6D6C6CECEC6CED6C6CED69CBD8452E77342D65A31CE5231CE5221BD3121 + AD314AB542847B5A847B6BC6C6C6C6CED6C6CECEC6CED6C6CED694BD9C219C21 + 42D65A4AE76B52D66B4ABD5A21AD3118AD2110A5100884088CA563CECECEC6CE + D6C6CED6C6CED6C6CECE9CD6AD52E77B52E77B52E77BADD6B5848C8C21732100 + 8C0808A510009C088CB56BC6CED6C6CECECED6D6C6CED6C6CECEC6D6CEADDEBD + 52E77B63E77BC6D6C68C8C8C318C3918AD2110A51073B55AB5CEBDC6CED6C6CE + CEC6CED6C6CED6C6CED6C6CED6C6CECE52D66B63E784C6D6C68C8C8C39944221 + B52929AD29CECEBDC6CED6C6CED6CECECEC6CED6CED6D6C6CECEC6CED6C6CED6 + ADDEBD9CD6ADBDB5A563635A8C947394C69CB5CEBDC6CED6C6CED6C6CECEC6CE + D6C6CED6C6CECEC6CED6C6CED6C6CECEC6CED6C6CED6C6C6BD9C9C9CB5BDBDC6 + CED6C6CECEC6CED6C6CED6C6CECEC6CED6C6CECEC6CED6C6CED6} + end + object QuitBtn: TBitBtn + Left = 748 + Top = 579 + Width = 80 + Height = 25 + Anchors = [akRight, akBottom] + Caption = '&Quit' + TabOrder = 1 + OnClick = QuitBtnClick + Glyph.Data = { + 3A050000424D3605000000000000360400002800000010000000100000000100 + 08000000000000010000230B0000230B000000010000000100000026B5000026 + B600022BBE00072FBE000F30B5001A39B7001636B8001337BD001739B9001A39 + B8001939BA001839BB001E3EBC001D3FBF002342BD002141BF002342BE00022C + C000052EC1000A32C0000B33C1000D35C0001238C200183CC0000132D7001138 + D4000439E000053AE000083EE1001F44D9001941DE001F4CDF002347D8002248 + DF00254EDE00244FDF002A4DDA002C51DB002F51DA002E51DB002F52DB002951 + DC002A50DC002D51DC003053DC000D42E0000F43E1000A43E8000E48E9001547 + E0001848E0001C4BE000134BE900264EE2002352E6002450E4002C50E1002C51 + E1002C52E2002C55E4002C58E6002456E8002D5CE8002C5DE9003053E1003054 + E2003154E2003558E2003759E300385AE3003A5BE3003A5CE3003B5DE3003F5F + E4003F60E3003763E8004261E4004162E4004363E4004066E7004464E5004564 + E5004665E5004865E4004867E5004C67E5004669E6004868E5004B68E5004B69 + E5004A69E600496AE6004E6CE6004F6CE6004E6DE600506CE600516CE600506D + E600536FE7005470E7005673E7005A75E8005B76E8005D78E8005E79E800637D + E800627CE900657EE9007F90D1006781EA006483EC006587EE006A83E9006B83 + E9006B85EA006C85EA006C86EB006F88EB006F8FEF007086EA007089EB00728A + EC00728FEE00768DEC00778EEC007990EC007A91EC007E94ED006B8DF0007192 + F1007294F1008596DC008A9BDE008093ED008195ED008097ED008398EE00899D + EE008B9EEE008CA0EF008DA1EF0095A8F00097A8F00097A9F1009DAEF10098B1 + F600A2B2F200A6B5F200B0BDF400B1BDF400B0BFF500B2BFF400B7C2F500BBC6 + F500BBC8F600B6C7F800BACAF800D2D9DC00DBE3FB00DCE4FB00E0E6FB00E2E8 + FB00E9EDFC00EBEFFC00EEF0FC00EFF1FD00F8F9FA00FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000009DA6A7A7A7A7 + A7A7A7A7A7A7A7A7A69DA683040609050B080715130311016CA6A7191D242627 + 25292333312D1B1800A7A71E3844507FA1A7A79F81342F1A02A7A721454E92A7 + 9A7A769CA791301C12A7A7394C8AA788564F4B3F82A7802E14A7A74358A3995E + 5BA7A73E3D9B9E3216A7A74962A7866157A7A73C366FA71F17A7A75165A7865F + 54A7A73B376EA7220DA7A75D69A5986053A7A73A3596A02A0FA7A762738FA785 + 554C464174A7792B10A7A7687E7893A795777194A78D40280EA7A7728C87758E + A4A7A7A2894D472C0CA7A77C908B7D78706B6A67645C4D280AA7A6977B6D6663 + 5D5A59524A48422084A69DA6A7A7A7A7A7A7A7A7A7A7A7A7A69D} + end + object ProductsPageControl: TPageControl + Left = 8 + Top = 56 + Width = 821 + Height = 504 + ActivePage = ReadmePage + Anchors = [akLeft, akTop, akRight, akBottom] + MultiLine = True + TabOrder = 3 + object ReadmePage: TTabSheet + Caption = 'About...' + object ReadmePane: TTextViewer + Left = 0 + Top = 0 + Width = 813 + Height = 474 + Align = alClient + TabOrder = 0 + end + end + end + object UninstallBtn: TBitBtn + Left = 660 + Top = 579 + Width = 80 + Height = 25 + Anchors = [akRight, akBottom] + Caption = '&Uninstall' + TabOrder = 5 + OnClick = UninstallBtnClick + end + object ImageList: TImageList + Left = 32 + Top = 416 + Bitmap = { + 494D474C01000100100000001000000004000000424D360C0000000000003600 + 00002800000020000000200000000100180000000000000C0000120B0000120B + 00000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF80808080808080808080808080 + 8080808080808080808080808080808080808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF8080808080808080808080808080808080808080808080808080808080 + 80808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFF00 + 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFF00000000 + 0000000000FFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFF00000000000000 + 0000000000000000FFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFF000000000000FF + FFFF000000000000000000FFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFF000000FFFFFFFF + FFFFFFFFFF000000000000000000FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFF000000000000FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFF000000FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF80808080808080808080808080 + 8080808080808080808080808080808080808080FFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF8080808080808080808080808080808080808080808080808080808080 + 80808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000 + 0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFF000000000000000000000000000000FFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000BFBFBFBFBFBF7F + 7F7F7F7F7F7F7F7F000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF000000000000BFBFBFBFBFBF7F7F7F7F7F7F7F7F7F000000000000FFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000BFBFBFBFBFBF7F7F7F00000000 + 00000000007F7F7F7F7F7F7F7F7F000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + 000000BFBFBFBFBFBF7F7F7F0000000000000000007F7F7F7F7F7F7F7F7F0000 + 00FFFFFFFFFFFFFFFFFFFFFFFF000000BFBFBFBFBFBF000000FFFFFF0000FFFF + FFFF0000FFFFFFFF0000007F7F7F7F7F7F000000FFFFFFFFFFFFFFFFFF000000 + BFBFBFBFBFBF000000FFFFFF00FF00FFFFFF00FF00FFFFFF0000007F7F7F7F7F + 7F000000FFFFFFFFFFFFFFFFFF000000BFBFBF000000FFFFFF00000000000000 + 0000000000000000FFFFFF0000007F7F7F000000FFFFFFFFFFFFFFFFFF000000 + BFBFBF000000FFFFFF000000000000000000000000000000FFFFFF0000007F7F + 7F000000FFFFFFFFFFFF000000BFBFBF7F7F7FFFFFFF0000000000000000FF00 + 0080000080000000000000FFFFFF7F7F7F7F7F7F000000FFFFFF000000BFBFBF + 7F7F7FFFFFFF00000000000000FF00008000008000000000000000FFFFFF7F7F + 7F7F7F7F000000FFFFFF000000BFBFBF0000000000FF0000000000FF00008000 + 00FF0000800000800000000000FF0000007F7F7F000000FFFFFF000000BFBFBF + 00000000FF0000000000FF0000800000FF0000800000800000000000FF000000 + 007F7F7F000000FFFFFF000000FFFFFF000000FFFFFF0000000000FF0000FF00 + 00FF0000FF000080000000FFFFFF0000007F7F7F000000FFFFFF000000FFFFFF + 000000FFFFFF00000000FF0000FF0000FF0000FF00008000000000FFFFFF0000 + 007F7F7F000000FFFFFF000000FFFFFF0000000000FF000000FFFFFF0000FF00 + 00FF0000800000FF0000000000FF000000BFBFBF000000FFFFFF000000FFFFFF + 00000000FF00000000FFFFFF00FF0000FF0000800000FF0000000000FF000000 + 00BFBFBF000000FFFFFF000000FFFFFF7F7F7FFFFFFF000000000000FFFFFFFF + FFFF0000FF000000000000FFFFFF7F7F7FBFBFBF000000FFFFFF000000FFFFFF + 7F7F7FFFFFFF000000000000FFFFFFFFFFFF00FF00000000000000FFFFFF7F7F + 7FBFBFBF000000FFFFFFFFFFFF000000BFBFBF000000FFFFFF00000000000000 + 0000000000000000FFFFFF000000BFBFBF000000FFFFFFFFFFFFFFFFFF000000 + BFBFBF000000FFFFFF000000000000000000000000000000FFFFFF000000BFBF + BF000000FFFFFFFFFFFFFFFFFF000000FFFFFFBFBFBF000000FFFFFF0000FFFF + FFFF0000FFFFFFFF000000BFBFBFBFBFBF000000FFFFFFFFFFFFFFFFFF000000 + FFFFFFBFBFBF000000FFFFFF00FF00FFFFFF00FF00FFFFFF000000BFBFBFBFBF + BF000000FFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFBFBFBF7F7F7F00000000 + 00000000007F7F7FBFBFBFBFBFBF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + 000000FFFFFFBFBFBF7F7F7F0000000000000000007F7F7FBFBFBFBFBFBF0000 + 00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFFFFFFFFFFFF + FFFFBFBFBFBFBFBF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFF000000000000FFFFFFFFFFFFFFFFFFBFBFBFBFBFBF000000000000FFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000 + 0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFF000000000000000000000000000000FFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFF424DBE000000000000003E0000002800000020000000 + 20000000010001000000000080000000120B0000120B00000200000002000000 + FFFFFF00000000000000000000000000000000001FFC1FFC1004100411041004 + 1384100417C4100416E41004147410041034100410141004100410041FFC1FFC + 00000000000000000000000007C007C01FF01FF03FF83FF87ABC7ABC77DC77DC + EFEEEFEEFFFEFFFEAFEEAFEEBBFEBBFEACEEACEE77DC77DC5ABC5ABC2FF82FF8 + 18F018F007C007C0} + end +end diff --git a/official/1.96/install/QProductFrames.pas b/official/1.96/install/QProductFrames.pas new file mode 100644 index 0000000..2a9ecdb --- /dev/null +++ b/official/1.96/install/QProductFrames.pas @@ -0,0 +1,458 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ 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 JediInstallerMain.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. } +{ } +{ Contributors: } +{ Andreas Hausladen (ahuser) } +{ Robert Rossmair (rrossmair) - crossplatform & BCB support, refactoring } +{ } +{**************************************************************************************************} + +// $Id: ProductFrames.pas,v 1.26 2006/02/05 13:26:15 outchy Exp $ + +unit QProductFrames; + +interface + +{$I jcl.inc} +{$I crossplatform.inc} + +uses + SysUtils, Classes, + Types, + QGraphics, QForms, QControls, QStdCtrls, QComCtrls, QExtCtrls, + JclBorlandTools, JediInstall; + +const + // Feature masks + FID_Expandable = $08000000; + FID_RadioButton = $10000000; + FID_NoAutoCheck = $20000000; // do not auto-check when the parent node gets checked + FID_StandaloneParent = $40000000; // do not auto-uncheck when all child nodes are unchecked + FID_Checked = $80000000; + FID_NumberMask = $03FFFFFF; + + // Icon indexes + IcoProduct = 0; + IcoLevel1 = 1; + IcoChecked = 2; + IcoUnchecked = 3; + +type + TProductFrame = class(TFrame) + ComponentsTreePanel: TPanel; + Label1: TLabel; + TreeView: TTreeView; + Splitter: TSplitter; + InfoPanel: TPanel; + Label2: TLabel; + InfoDisplay: TMemo; + OptionsGroupBox: TGroupBox; + BplPathLabel: TLabel; + DcpPathLabel: TLabel; + BplPathEdit: TEdit; + Button1: TButton; + Button2: TButton; + DcpPathEdit: TEdit; + procedure PathEditChange(Sender: TObject); + procedure PathSelectBtnClick(Sender: TObject); + procedure SplitterCanResize(Sender: TObject; var NewSize: Integer; + var Accept: Boolean); + procedure TreeViewMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure TreeViewKeyPress(Sender: TObject; var Key: Char); + procedure TreeViewCustomDrawItem(Sender: TCustomViewControl; Item: TCustomViewItem; + Canvas: TCanvas; const Rect: TRect; State: TCustomDrawState; Stage: TCustomDrawStage; + var DefaultDraw: Boolean); + private + { Private declarations } + FInstallation: TJclBorRADToolInstallation; + function GetDCPPath: string; + function GetBPLPath: string; + function GetNodeChecked(Node: TTreeNode): Boolean; + function GetPathForEdit(Path: string): string; + function IsAutoChecked(Node: TTreeNode): Boolean; + function IsRadioButton(Node: TTreeNode): Boolean; + function IsStandAloneParent(Node: TTreeNode): Boolean; + procedure SetDCPPath(const Value: string); + procedure SetBPLPath(const Value: string); + procedure SetInstallation(Value: TJclBorRADToolInstallation); + procedure SetNodeChecked(Node: TTreeNode; const Value: Boolean); + procedure ToggleNodeChecked(Node: TTreeNode); + public + { Public declarations } + class function GetName(Installation: TJclBorRADToolInstallation): string; + function FeatureChecked(FeatureID: Cardinal): Boolean; + procedure LogOutputLine(const Line: string); + procedure UpdateTree; + procedure StartCompilation(Installation: TJclBorRADToolInstallation); + procedure StopCompilation(Installation: TJclBorRADToolInstallation); + property NodeChecked[Node: TTreeNode]: Boolean read GetNodeChecked write SetNodeChecked; + property Installation: TJclBorRADToolInstallation read FInstallation write SetInstallation; + property DCPPath: string read GetDCPPath write SetDCPPath; + property BPLPath: string read GetBPLPath write SetBPLPath; + end; + +function Collapsable(Node: TTreeNode): Boolean; + +implementation + +{$R *.xfm} + +uses + {$IFDEF MSWINDOWS} + Windows, Messages, + {$ENDIF MSWINDOWS} + Qt, QDialogs, + JclStrings, + JclInstall; + +resourcestring + RsSelectPath = 'Select path'; + RsEnterValidPath = '(Enter valid path)'; + +function Collapsable(Node: TTreeNode): Boolean; +begin + Result := (Cardinal(Node.Data) and FID_Expandable) <> 0; +end; + +procedure TProductFrame.PathEditChange(Sender: TObject); +begin + with (Sender as TEdit) do + if DirectoryExists(Text) then + Font.Color := clWindowText + else + Font.Color := clRed; +end; + +function TProductFrame.FeatureChecked(FeatureID: Cardinal): Boolean; +var + F: Cardinal; + Node: TTreeNode; +begin + Result := False; + Node := TreeView.Items.GetFirstNode; + while Node <> nil do + begin + F := Cardinal(Node.Data); + if F and FID_NumberMask = FeatureID then + begin + Result := F and FID_Checked <> 0; + Break; + end; + Node := Node.GetNext; + end; +end; + +function TProductFrame.GetDCPPath: string; +begin + Result := DcpPathEdit.Text; +end; + +function TProductFrame.GetBPLPath: string; +begin + Result := BplPathEdit.Text; +end; + +class function TProductFrame.GetName(Installation: TJclBorRADToolInstallation): string; +begin + Result := Format('%sProduct', [Installation.VersionNumberStr]); +end; + +function TProductFrame.GetNodeChecked(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_Checked <> 0; +end; + +function TProductFrame.GetPathForEdit(Path: string): string; +begin + if DirectoryExists(Path) then + Result := Path + else + Result := RsEnterValidPath; +end; + +function TProductFrame.IsAutoChecked(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_NoAutoCheck = 0; +end; + +function TProductFrame.IsRadioButton(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_RadioButton <> 0; +end; + +function TProductFrame.IsStandAloneParent(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_StandAloneParent <> 0; +end; + +procedure TProductFrame.LogOutputLine(const Line: string); +var + NewCaretPos: TCaretPos; +begin + with InfoDisplay do + begin + Lines.BeginUpdate; + Lines.Append(Line); + Lines.EndUpdate; + NewCaretPos.Line := Lines.Count; + NewCaretPos.Col := 0; + CaretPos := NewCaretPos; + end; +end; + +procedure TProductFrame.SetDCPPath(const Value: string); +begin + DcpPathEdit.Text := GetPathForEdit(Value); +end; + +procedure TProductFrame.SetBPLPath(const Value: string); +begin + BplPathEdit.Text := GetPathForEdit(Value); +end; + +procedure TProductFrame.SetInstallation(Value: TJclBorRADToolInstallation); +begin + FInstallation := Value; + Name := GetName(Value); + if Value.RadToolKind = brCppBuilder then + DcpPathLabel.Caption := '.bpi Path'; +end; + +procedure TProductFrame.SetNodeChecked(Node: TTreeNode; const Value: Boolean); + + procedure UpdateNode(N: TTreeNode; C: Boolean); + const + CheckedState: array[Boolean] of Cardinal = (0, FID_Checked); + begin + N.Data := Pointer(Cardinal(N.Data) and (not FID_Checked) or CheckedState[C]); + if C then + begin + N.ImageIndex := IcoChecked; + N.SelectedIndex := IcoChecked; + end + else + begin + N.ImageIndex := IcoUnchecked; + N.SelectedIndex := IcoUnchecked; + end; + end; + + procedure UpdateTreeDown(N: TTreeNode; C: Boolean); + begin + N := N.getFirstChild; + while Assigned(N) do + begin + if not C or IsAutoChecked(N) then + begin + if not IsRadioButton(N) then + UpdateNode(N, C); + UpdateTreeDown(N, C); + end; + N := N.getNextSibling; + end; + end; + + procedure UpdateTreeUp(N: TTreeNode; C: Boolean); + var + ParentNode: TTreeNode; + ParentChecked: Boolean; + begin + if C then + while Assigned(N) do + begin + UpdateNode(N, True); + N := N.Parent; + end + else + begin + ParentNode := N.Parent; + while Assigned(ParentNode) do + begin + N := ParentNode.getFirstChild; + ParentChecked := IsStandAloneParent(ParentNode); + while Assigned(N) do + if NodeChecked[N] and not IsRadioButton(N) then + begin + ParentChecked := True; + Break; + end + else + N := N.getNextSibling; + UpdateNode(ParentNode, ParentChecked); + ParentNode := ParentNode.Parent; + end; + end; + end; + + procedure UpdateRadioButton(N: TTreeNode; C: Boolean); + var + Node: TTreeNode; + begin + if Value and not NodeChecked[N] then + begin + Node := N.Parent; + if Node <> nil then + begin + Node := Node.getFirstChild; + while Node <> nil do + begin + if IsRadioButton(Node) then + UpdateNode(Node, Node = N); + Node := Node.getNextSibling; + end; + end; + end; + end; + +begin + if IsRadioButton(Node) then + UpdateRadioButton(Node, Value) + else + begin + UpdateNode(Node, Value); + UpdateTreeDown(Node, Value); + UpdateTreeUp(Node, Value); + end; +end; + +procedure TProductFrame.ToggleNodeChecked(Node: TTreeNode); +begin + if Assigned(Node) then + NodeChecked[Node] := not NodeChecked[Node]; +end; + +procedure TProductFrame.PathSelectBtnClick(Sender: TObject); +var + I: Integer; + Button: TButton; + Edit: TEdit; + {$IFDEF COMPILER7_UP} + {$DEFINE USE_WIDESTRING} + {$ENDIF} + {$IFDEF KYLIX} + {$DEFINE USE_WIDESTRING} + {$ENDIF KYLIX} + {$IFDEF USE_WIDESTRING} + Directory: WideString; + {$UNDEF USE_WIDESTRING} + {$ELSE} + Directory: string; + {$ENDIF} +begin + Button := Sender as TButton; + Edit := nil; + with Button.Parent do + for I := 0 to ControlCount - 1 do + if (Controls[I].Top = Button.Top) and (Controls[I] is TEdit) then + Edit := TEdit(Controls[I]); + if Assigned(Edit) and SelectDirectory(RsSelectPath, '', Directory) then + Edit.Text := Directory; +end; + +procedure TProductFrame.SplitterCanResize(Sender: TObject; + var NewSize: Integer; var Accept: Boolean); +begin + Accept := NewSize > 150; +end; + +procedure TProductFrame.TreeViewCustomDrawItem(Sender: TCustomViewControl; Item: TCustomViewItem; + Canvas: TCanvas; const Rect: TRect; State: TCustomDrawState; Stage: TCustomDrawStage; + var DefaultDraw: Boolean); +begin + case TTreeNode(Item).Level of + 0: begin + Canvas.Font.Style := [fsBold, fsUnderline]; + end; + 1: begin + Canvas.Font.Style := [fsBold]; + end; + end; +end; + +procedure TProductFrame.TreeViewKeyPress(Sender: TObject; var Key: Char); +begin + with TTreeView(Sender) do + case Key of + #32: + begin + ToggleNodeChecked(Selected); + Key := #0; + end; + '+': + Selected.Expanded := True; + '-': + Selected.Expanded := False; + end; +end; + +function TreeNodeIconHit(TreeView: TTreeView; X, Y: Integer; Node: TTreeNode = nil): Boolean; +var + Level, X1: Integer; +begin + Result := False; + if Node = nil then + Node := TreeView.GetNodeAt(X, Y); + if Assigned(Node) then + begin + Level := Node.Level; + if QListView_rootIsDecorated(TreeView.Handle) then + Inc(Level); + X1 := QListView_treeStepSize(TreeView.Handle) * Level; + Result := (X > X1) and (X <= X1 + TreeView.Images.Width); + end; +end; + +procedure TProductFrame.TreeViewMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + Node: TTreeNode; +begin + with TTreeView(Sender) do + begin + Node := GetNodeAt(X, Y); + if (Button = mbLeft) and TreeNodeIconHit(TreeView, X, Y, Node) then + ToggleNodeChecked(Node); + end; +end; + +procedure TProductFrame.UpdateTree; +var + Node: TTreeNode; +begin + Node := TreeView.Items.GetFirstNode; + while Node <> nil do + begin + if not Collapsable(Node) then + Node.Expand(False); + Node := Node.GetNext; + end; +end; + +procedure TProductFrame.StartCompilation(Installation: TJclBorRADToolInstallation); +begin +end; + +procedure TProductFrame.StopCompilation(Installation: TJclBorRADToolInstallation); +begin +end; + +end. diff --git a/official/1.96/install/QProductFrames.xfm b/official/1.96/install/QProductFrames.xfm new file mode 100644 index 0000000..69fe921 --- /dev/null +++ b/official/1.96/install/QProductFrames.xfm @@ -0,0 +1,145 @@ +object ProductFrame: TProductFrame + Left = 0 + Top = 0 + Width = 791 + Height = 424 + HorzScrollBar.Range = 385 + Color = clBackground + Font.Color = clText + Font.Height = 12 + Font.Name = 'helvetica' + Font.Pitch = fpVariable + Font.Style = [] + Font.Weight = 40 + ParentColor = False + ParentFont = False + TabOrder = 0 + object Splitter: TSplitter + Left = 406 + Top = 0 + Width = 5 + Height = 424 + Align = alRight + MinSize = 150 + ResizeStyle = rsUpdate + OnCanResize = SplitterCanResize + end + object ComponentsTreePanel: TPanel + Left = 0 + Top = 0 + Width = 406 + Height = 424 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + object Label1: TLabel + Left = 8 + Top = 8 + Width = 155 + Height = 15 + Caption = '&Select components to install' + end + object TreeView: TTreeView + Left = 8 + Top = 24 + Width = 394 + Height = 393 + Anchors = [akLeft, akTop, akRight, akBottom] + Columns = <> + Indent = 19 + ReadOnly = True + TabOrder = 0 + OnCustomDrawItem = TreeViewCustomDrawItem + OnKeyPress = TreeViewKeyPress + OnMouseDown = TreeViewMouseDown + end + end + object InfoPanel: TPanel + Left = 411 + Top = 0 + Width = 380 + Height = 424 + Align = alRight + BevelOuter = bvNone + TabOrder = 0 + object Label2: TLabel + Left = 9 + Top = 8 + Width = 84 + Height = 15 + Caption = 'Installation &Log' + end + object InfoDisplay: TMemo + Left = 8 + Top = 24 + Width = 366 + Height = 301 + Anchors = [akLeft, akTop, akRight, akBottom] + ScrollBars = ssVertical + TabOrder = 0 + end + object OptionsGroupBox: TGroupBox + Left = 8 + Top = 336 + Width = 366 + Height = 81 + Anchors = [akLeft, akRight, akBottom] + Caption = '&Advanced Options' + TabOrder = 1 + object BPLPathLabel: TLabel + Left = 8 + Top = 19 + Width = 48 + Height = 15 + Caption = '.bpl Path' + end + object DCPPathLabel: TLabel + Left = 8 + Top = 51 + Width = 51 + Height = 15 + Caption = '.dcp Path' + end + object BplPathEdit: TEdit + Left = 68 + Top = 16 + Width = 269 + Height = 23 + Anchors = [akLeft, akTop, akRight] + TabOrder = 0 + OnChange = PathEditChange + end + object DcpPathEdit: TEdit + Left = 68 + Top = 48 + Width = 269 + Height = 23 + Anchors = [akLeft, akTop, akRight] + TabOrder = 2 + OnChange = PathEditChange + end + object Button1: TButton + Left = 342 + Top = 16 + Width = 17 + Height = 22 + Anchors = [akTop, akRight] + Caption = '...' + TabOrder = 1 + TabStop = False + OnClick = PathSelectBtnClick + end + object Button2: TButton + Left = 342 + Top = 48 + Width = 17 + Height = 22 + Anchors = [akTop, akRight] + Caption = '...' + TabOrder = 3 + TabStop = False + OnClick = PathSelectBtnClick + end + end + end +end diff --git a/official/1.96/install/build/build.bdsproj b/official/1.96/install/build/build.bdsproj new file mode 100644 index 0000000..43580e9 --- /dev/null +++ b/official/1.96/install/build/build.bdsproj @@ -0,0 +1,175 @@ + + + + + + + + + + + + build.dpr + + + 7.0 + + + 8 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + False + False + False + True + True + True + True + True + True + + + + 0 + 0 + False + 1 + False + False + False + 16384 + 1048576 + 4194304 + + + + + + + + + + JCL + + False + + + newest "--make=installer" + + + False + D:\Quellen\jedi\DeXter\jcl\install\build + + True + False + + + + $00000000 + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1031 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + diff --git a/official/1.96/install/build/build.dpr b/official/1.96/install/build/build.dpr new file mode 100644 index 0000000..5da5e60 --- /dev/null +++ b/official/1.96/install/build/build.dpr @@ -0,0 +1,1258 @@ +{----------------------------------------------------------------------------- +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/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: BuildTarget.pas, released on 2004-03-25. + +The Initial Developer of the Original Code is Andreas Hausladen +Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen +All Rights Reserved. + +Contributor(s): + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.sourceforge.net + +Known Issues: +-----------------------------------------------------------------------------} +// $Id: build.dpr,v 1.10 2005/12/04 10:10:57 obones Exp $ + +program build; + +{$APPTYPE CONSOLE} + +{ build.exe setups the environment for a Delphi compiler } + +uses + Windows, ShlObj; + +type + TOption = record + Name: string; + Env: string; + Default: string; + end; + +{$IFDEF JCL} +const + LibraryName = 'JCL'; + LibraryRootDirRelativeToBuild = 2; // means: '..\..' + pgEditFile = 'install\build\pgEdit.xml'; // relative to the Library-Directory + ExtraOptions: array[0..0] of TOption = ( + (Name: ''; Env: ''; Default: '') + ); + PackageGroupName = 'JclPackages*0'; +{$ENDIF JCL} +{$IFDEF JVCL} +const + LibraryName = 'JVCL'; + LibraryRootDirRelativeToBuild = 2; // means: '..\..' + pgEditFile = 'devtools\bin\pgEdit.xml'; // relative to the Library-Directory + ExtraOptions: array[0..0] of TOption = ( + (Name: 'jcl-path'; Env: 'JCLROOT'; Default: '..\..\..\jcl') + ); + PackageGroupName = '* Packages'; +{$ENDIF JVCL} + +{$IFNDEF JCL} + {$IFNDEF JVCL} + {$IFDEF MSWINDOWS} + {$Message Fatal 'Neither JCL nor JVCL is defined'} + {$ENDIF MSWINDOWS} + {$ENDIF ~JVCL} +{$ENDIF ~JCL} + +type + TTarget = record + Name: string; + PerName: string; + PerDir: string; + end; + +const // keep in sync with JVCL Installer's DelphiData.pas + BDSVersions: array[1..4] of record + Name: string; + VersionStr: string; + Version: Integer; + CIV: string; // coreide version + ProjectDirResId: Integer; + Supported: Boolean; + end = ( + (Name: 'C#Builder'; VersionStr: '1.0'; Version: 1; CIV: '71'; ProjectDirResId: 64507; Supported: False), + (Name: 'Delphi'; VersionStr: '8'; Version: 8; CIV: '71'; ProjectDirResId: 64460; Supported: False), + (Name: 'Delphi'; VersionStr: '2005'; Version: 9; CIV: '90'; ProjectDirResId: 64431; Supported: True), + (Name: 'Borland Developer Studio'; VersionStr: '2006'; Version: 10; CIV: '100'; ProjectDirResId: 64719; Supported: True) + ); + +type + TEdition = class(TObject) + private + FMainName: string; // d7 + FName: string; // d7p ( with/-out personal "p" ) + + FRootDir: string; + FBplDir: string; + FDcpDir: string; + FLibDir: string; + FIsPersonal: Boolean; + FIsCLX: Boolean; + + function GetBDSProjectsDir: string; + procedure ReadRegistryData; + public + Typ: (Delphi, BCB, BDS); + VersionStr: string; // '9' for BDS 3.0 + Version: Integer; // 9 for BDS 3.0 + IDEVersionStr: string; // '3' for BDS 3.0 + IDEVersion: Integer; // 3 for BDS 3.0 + PkgDir: string; // d7 / d7per + public + constructor Create(const AEditionName, PerDirName: string); + + property RootDir: string read FRootDir; + property BDSProjectsDir: string read GetBDSProjectsDir; + property BplDir: string read FBplDir; + property DcpDir: string read FDcpDir; + property LibDir: string read FLibDir; + + property MainName: string read FMainName; + property Name: string read FName; + property IsPersonal: Boolean read FIsPersonal; + property IsCLX: Boolean read FIsCLX; + end; + +var + LibraryRootDir: string; + DxgettextDir: string = ''; + ExtraUnitDirs: string = ''; + MakeOptions: string = ''; + Verbose: Boolean = False; + Force: Boolean = False; // force even if the target is not installed + DccOpt: string = '-Q -M'; + UserLibDir, UserDcpDir, UserBplDir: string; + + Targets: array of TTarget = nil; + Editions: array of TEdition = nil; + +{ Helper functions because no SysUtils unit is used. } +{******************************************************************************} +function ExtractFileDir(const S: string): string; +var + ps: Integer; +begin + ps := Length(S); + while (ps > 1) and (S[ps] <> '\') do + Dec(ps); + Result := Copy(S, 1, ps - 1); +end; +{******************************************************************************} +function ExcludeTrailingPathDelimiter(const S: string): string; +begin + if (S <> '') and (S[Length(S)] = '\') then + Result := Copy(S, 1, Length(S) - 1) + else + Result := S; +end; +{******************************************************************************} +function StrLen(P: PChar): Integer; +begin + Result := 0; + while P[Result] <> #0 do + Inc(Result); +end; +{******************************************************************************} +function StrToInt(const S: string): Integer; +var + Error: Integer; +begin + Val(S, Result, Error); +end; +{******************************************************************************} +function IntToStr(Value: Integer): string; +begin + Str(Value, Result); +end; +{******************************************************************************} +function SameText(const S1, S2: string): Boolean; +var + i, len: Integer; +begin + Result := False; + len := Length(S1); + if len = Length(S2) then + begin + for i := 1 to len do + if UpCase(S1[i]) <> UpCase(S2[i]) then + Exit; + Result := True; + end; +end; +{******************************************************************************} +function StartsText(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 UpCase(SubStr[i]) <> UpCase(S[i]) then + Exit; + Result := True; + end; +end; +{******************************************************************************} +function GetEnvironmentVariable(const Name: string): string; +begin + SetLength(Result, 8 * 1024); + SetLength(Result, Windows.GetEnvironmentVariable(PChar(Name), PChar(Result), Length(Result))); +end; +{******************************************************************************} +function FileExists(const Filename: string): Boolean; +var + attr: Cardinal; +begin + attr := GetFileAttributes(PChar(Filename)); + Result := (attr <> $FFFFFFFF) and (attr and FILE_ATTRIBUTE_DIRECTORY = 0); +end; +{******************************************************************************} +function DirectoryExists(const Filename: string): Boolean; +var + attr: Cardinal; +begin + attr := GetFileAttributes(PChar(Filename)); + Result := (attr <> $FFFFFFFF) and (attr and FILE_ATTRIBUTE_DIRECTORY <> 0); +end; +{******************************************************************************} +function Execute(const Cmd: string): Integer; +var + ProcessInfo: TProcessInformation; + StartupInfo: TStartupInfo; +begin + StartupInfo.cb := SizeOf(StartupInfo); + GetStartupInfo(StartupInfo); + if CreateProcess(nil, PChar(Cmd), nil, nil, True, 0, nil, + PChar(ExtractFileDir(ParamStr(0))), StartupInfo, ProcessInfo) then + begin + CloseHandle(ProcessInfo.hThread); + WaitForSingleObject(ProcessInfo.hProcess, INFINITE); + GetExitCodeProcess(ProcessInfo.hProcess, Cardinal(Result)); + CloseHandle(ProcessInfo.hProcess); + end + else + Result := -1; +end; +{******************************************************************************} +function GetWindowsDir: string; +begin + SetLength(Result, MAX_PATH); + SetLength(Result, GetWindowsDirectory(PChar(Result), Length(Result))); +end; +{******************************************************************************} +function GetSystemDir: string; +begin + SetLength(Result, MAX_PATH); + SetLength(Result, GetSystemDirectory(PChar(Result), Length(Result))); +end; +{******************************************************************************} + +{ a very small XML parser } +type + IAttr = interface + function Name: string; + function Value: string; + end; + + ITag = interface + function Name: string; + function Attrs(const Name: string): IAttr; + end; + + TXmlFile = class(TObject) + private + FText: string; + FPosition: Integer; + public + constructor Create(const Filename: string); + function NextTag: ITag; + end; + + TTag = class(TInterfacedObject, ITag) + private + FText: string; + public + constructor Create(const AText: string); + function Name: string; + function Attrs(const Name: string): IAttr; + end; + + TAttr = class(TInterfacedObject, IAttr) + private + FText: string; + public + constructor Create(const AText: string); + function Name: string; + function Value: string; + end; + +{******************************************************************************} +{ TXmlFile } + +constructor TXmlFile.Create(const Filename: string); +var + f: file of Byte; +begin + inherited Create; + FileMode := 0; + AssignFile(f, Filename); + Reset(f); + SetLength(FText, FileSize(f)); + BlockRead(f, FText[1], FileSize(f)); + CloseFile(f); + FPosition := 0; +end; +{******************************************************************************} +function TXmlFile.NextTag: ITag; +var + F, P: PChar; + InStr1, InStr2: Boolean; + S: string; +begin + InStr1 := False; + InStr2 := False; + if FPosition >= Length(FText) then + begin + Result := nil; + Exit; + end; + + P := PChar(FText) + FPosition; + while (P[0] <> #0) and (P[0] <> '<') do + Inc(P); + if P[0] <> #0 then + begin + if P[1] = '!' then // comment + begin + while (P[0] <> #0) do + begin + if (P[0] = '-') and (P[1] = '-') and (P[2] = '>') then + Break; + Inc(P); + end; + FPosition := P - PChar(FText); + Result := NextTag; + Exit; + end; + F := P; + while True do + begin + case P[0] of + #0: + Break; + '>': + if not (InStr1 or InStr2) then + begin + SetString(S, F + 1, P - F - 1); + Result := TTag.Create(S); + Inc(P); + Break; + end; + '''': + InStr1 := not InStr1; + '"': + InStr2 := not InStr2; + end; + Inc(P); + end; + end; + FPosition := P - PChar(FText); +end; +{******************************************************************************} +{ TTag } + +constructor TTag.Create(const AText: string); +begin + inherited Create; + FText := AText; +end; +{******************************************************************************} +function TTag.Name: string; +var + ps: Integer; +begin + ps := Pos(' ', FText); + if ps = 0 then + Result := FText + else + Result := Copy(FText, 1, ps - 1); +end; +{******************************************************************************} +function TTag.Attrs(const Name: string): IAttr; +var + ps: Integer; + InStr1, InStr2: Boolean; + F, P: PChar; + S: string; +begin + Result := TAttr.Create(''); + ps := Pos(' ', FText); + if ps = 0 then + Exit; + P := PChar(FText) + ps; + while P[0] <> #0 do + begin + while P[0] in [#1..#32] do + Inc(P); + if P[0] = #0 then + Break; + F := P; + InStr1 := False; + InStr2 := False; + while True do + begin + case P[0] of + #0, #9, #32, '/': + if not (InStr1 or InStr2) or (P[0] = #0) then + begin + SetString(S, F, P - F); + Result := TAttr.Create(S); + if SameText(Result.Name, Name) then + Exit; + Inc(P); + Break; + end; + '''': + InStr1 := not InStr1; + '"': + InStr2 := not InStr2; + end; + Inc(P); + end; + end; + Result := TAttr.Create(''); +end; +{******************************************************************************} +{ TAttr } + +constructor TAttr.Create(const AText: string); +begin + inherited Create; + FText := AText; +end; +{******************************************************************************} +function TAttr.Name: string; +var + ps: Integer; +begin + ps := Pos('=', FText); + if ps = 0 then + Result := FText + else + Result := Copy(FText, 1, ps - 1); +end; +{******************************************************************************} +function TAttr.Value: string; +var + ps: Integer; +begin + ps := Pos('=', FText); + if ps = 0 then + Result := '' + else + begin + Result := Copy(FText, ps + 1, MaxInt); + if (Result <> '') and (Result[1] in ['''', '"']) then + begin + Delete(Result, 1, 1); + Delete(Result, Length(Result), 1); + end; + end; +end; +{******************************************************************************} +function AsterixMacro(const S, AsterixRepl: string): string; +var + I: Integer; +begin + Result := S; + I := Pos('*', Result); + if I > 0 then + begin + Delete(Result, I, 1); + Insert(AsterixRepl, Result, I); + end; +end; +{******************************************************************************} +procedure LoadTargetNames; +var + xml: TXmlFile; + tg: ITag; +begin + xml := TXmlFile.Create(LibraryRootDir + '\' + pgEditFile); + try + tg := xml.NextTag; + while tg <> nil do + begin + if SameText(tg.Name, 'model') and SameText(tg.Attrs('name').Value, LibraryName) then + begin + tg := xml.NextTag; + while not SameText(tg.Name, 'targets') do + tg := xml.NextTag; + while not SameText(tg.Name, '/targets') do + begin + if SameText(tg.Name, 'target') then + begin + if DirectoryExists(LibraryRootDir + '\packages\' + tg.Attrs('name').Value) then + begin + SetLength(Targets, Length(Targets) + 1); // we do not have 10tnds iterations so this is acceptable + with Targets[High(Targets)] do + begin + Name := tg.Attrs('name').Value; + PerName := tg.Attrs('pname').Value; + PerDir := tg.Attrs('pdir').Value; + end; + end; + end; + tg := xml.NextTag; + end; + Break; // we only want the "LibraryName" part + end; + tg := xml.NextTag; + end; + finally + xml.Free; + end; +end; +{******************************************************************************} +{ TEdition } + +constructor TEdition.Create(const AEditionName, PerDirName: string); +var + Index: Integer; +begin + if UpCase(AEditionName[1]) = 'D' then + Typ := Delphi + else + Typ := BCB; + + VersionStr := AEditionName[2]; + if (Length(AEditionName) > 2) and (AEditionName[3] in ['0'..'9']) then + begin + VersionStr := VersionStr + AEditionName[3]; + Index := 4; + end + else + Index := 3; + + Version := StrToInt(VersionStr); + IDEVersionStr := VersionStr; + IDEVersion := Version; + + if Version > 7 then + begin + Typ := BDS; + IDEVersion := Version - 6; // D 8 = BDS 2 + IDEVersionStr := IntToStr(IDEVersion); + end; + + FMainName := Copy(AEditionName, 1, Index - 1); + FName := AEditionName; + PkgDir := AEditionName; + + FIsCLX := SameText('clx', Copy(AEditionName, Index, 3)); + FIsPersonal := False; + if Length(AEditionName) > Index then + begin + if (UpCase(AEditionName[Index]) = 'P') or (UpCase(AEditionName[Index]) = 'S') then + begin + FIsPersonal := True; + PkgDir := PerDirName + end; + end; + + ReadRegistryData; +end; +{******************************************************************************} +procedure TEdition.ReadRegistryData; +var + KeyName: string; + Reg: HKEY; + RegTyp: LongWord; + ProjectsDir: string; + + function ReadStr(const Name: string): string; + var + Len: Longint; + begin + Len := MAX_PATH; + SetLength(Result, MAX_PATH); + RegQueryValueEx(Reg, PChar(Name), nil, @RegTyp, PByte(Result), @Len); + SetLength(Result, StrLen(PChar(Result))); + end; + + function ResolveMacros(const Dir: string): string; + var + ps, psEnd: Integer; + S: string; + begin + if StartsText('$(DELPHI)', Dir) then + Result := FRootDir + Copy(Dir, 10, MaxInt) + else if StartsText('$(BCB)', Dir) then + Result := FRootDir + Copy(Dir, 7, MaxInt) + else if StartsText('$(BDS)', Dir) then + Result := FRootDir + Copy(Dir, 7, MaxInt) + else if StartsText('$(BDSPROJECTSDIR)', Dir) then + Result := GetBDSProjectsDir + Copy(Dir, 18, MaxInt) + else + begin + Result := Dir; + ps := Pos('$(', Result); + if ps > 0 then + begin + psEnd := Pos(')', Result); + if psEnd > 0 then + begin + S := Copy(Result, ps + 2, psEnd - ps - 2); + if S <> '' then + begin + Delete(Result, ps, 2 + Length(S) + 1); + Insert(GetEnvironmentVariable(S), Result, ps); + end + end; + end; + end + end; + +begin + case Typ of + Delphi: + KeyName := 'Software\Borland\Delphi\' + IDEVersionStr + '.0'; + BCB: + KeyName := 'Software\Borland\C++Builder\' + IDEVersionStr + '.0'; + BDS: + KeyName := 'Software\Borland\BDS\' + IDEVersionStr + '.0'; + end; + + if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(KeyName), 0, KEY_QUERY_VALUE or KEY_READ, Reg) = ERROR_SUCCESS then + begin + FRootDir := ExcludeTrailingPathDelimiter(ReadStr('RootDir')); + RegCloseKey(Reg); + end; + + if Typ = BDS then + ProjectsDir := GetBDSProjectsDir + else + ProjectsDir := FRootDir + '\Projects'; + + FDcpDir := ProjectsDir + '\Bpl'; + FBplDir := ProjectsDir + '\Bpl'; + if Typ = BCB then + FLibDir := ProjectsDir + '\Lib' + else + FLibDir := ProjectsDir + '\Bpl'; + + if RegOpenKeyEx(HKEY_CURRENT_USER, PChar(KeyName + '\Library'), 0, KEY_QUERY_VALUE or KEY_READ, Reg) = ERROR_SUCCESS then + begin + FDcpDir := ResolveMacros(ExcludeTrailingPathDelimiter(ReadStr('Package DCP Output'))); + FBplDir := ResolveMacros(ExcludeTrailingPathDelimiter(ReadStr('Package DPL Output'))); + RegCloseKey(Reg); + end; +end; +{******************************************************************************} +function TEdition.GetBDSProjectsDir: string; +var + h: HMODULE; + LocaleName: array[0..4] of Char; + Filename: string; + PersDir: string; +begin + if (Typ = BDS) and (IDEVersion >= Low(BDSVersions)) and (IDEVersion <= High(BDSVersions)) then + begin + Result := 'Borland Studio Projects'; // do not localize + + FillChar(LocaleName, SizeOf(LocaleName[0]), 0); + GetLocaleInfo(GetThreadLocale, LOCALE_SABBREVLANGNAME, LocaleName, SizeOf(LocaleName)); + if LocaleName[0] <> #0 then + begin + Filename := RootDir + '\Bin\coreide' + BDSVersions[IDEVersion].CIV + '.'; + if FileExists(Filename + LocaleName) then + Filename := Filename + LocaleName + else + begin + LocaleName[2] := #0; + if FileExists(Filename + LocaleName) then + Filename := Filename + LocaleName + else + Filename := ''; + end; + + if Filename <> '' then + begin + h := LoadLibraryEx(PChar(Filename), 0, + LOAD_LIBRARY_AS_DATAFILE or DONT_RESOLVE_DLL_REFERENCES); + if h <> 0 then + begin + SetLength(Result, 1024); + SetLength(Result, LoadString(h, BDSVersions[IDEVersion].ProjectDirResId, PChar(Result), Length(Result) - 1)); + FreeLibrary(h); + end; + end; + end; + + SetLength(PersDir, MAX_PATH); + if SHGetSpecialFolderPath(0, PChar(PersDir), CSIDL_PERSONAL, False) then + begin + SetLength(PersDir, StrLen(PChar(PersDir))); + Result := ExcludeTrailingPathDelimiter(PersDir) + '\' + Result; + end + else + Result := ''; + end + else + Result := ''; +end; +{******************************************************************************} +procedure FindDxgettext(Version: Integer); +var + reg: HKEY; + len: Longint; + RegTyp: LongWord; + i: Integer; + S: string; +begin + // dxgettext detection + if RegOpenKeyEx(HKEY_CLASSES_ROOT, 'bplfile\Shell\Extract strings\Command', 0, KEY_QUERY_VALUE or KEY_READ, reg) <> ERROR_SUCCESS then + Exit; + SetLength(S, MAX_PATH); + len := MAX_PATH; + RegQueryValueEx(reg, '', nil, @RegTyp, PByte(S), @len); + SetLength(S, StrLen(PChar(S))); + RegCloseKey(reg); + + if S <> '' then + begin + if S[1] = '"' then + begin + Delete(S, 1, 1); + i := 1; + while (i <= Length(S)) and (S[i] <> '"') do + Inc(i); + SetLength(S, i - 1); + end; + S := ExtractFileDir(S); + DxgettextDir := S; + if not FileExists(DxgettextDir + '\msgfmt.exe') then + DxgettextDir := '' + else + begin + if Version = 5 then + S := S + '\delphi5'; + ExtraUnitDirs := ExtraUnitDirs + ';' + S; + end; + end; +end; +{******************************************************************************} +function TargetIndexOfEdition(const ed: string): Integer; +begin + for Result := 0 to High(Targets) do + if SameText(Targets[Result].Name, ed) or SameText(Targets[Result].PerName, ed) then + Exit; + Result := -1; +end; +{******************************************************************************} +procedure AddEdition(const ed: string); +var + I: Integer; +begin + if ed = '' then + Exit; + if SameText(ed, 'k3') then // build.exe is for Windows only (maybe CrossKylix) + Exit; + for I := 0 to High(Editions) do + if SameText(Editions[i].Name, ed) then + Exit; + + I := TargetIndexOfEdition(ed); + if I >= 0 then + begin + SetLength(Editions, Length(Editions) + 1); + Editions[High(Editions)] := TEdition.Create(ed, Targets[I].PerDir); + end; +end; +{******************************************************************************} +procedure AddAllEditions(AddPersonal: Boolean); +var + i: Integer; +begin + Editions := nil; + for i := 0 to High(Targets) do + begin + AddEdition(Targets[i].Name); + if AddPersonal then + AddEdition(Targets[i].PerName); + end; +end; +{******************************************************************************} +function GetNewestEdition: TEdition; +var + I: Integer; + ed: TEdition; +begin + Result := TEdition.Create('d5', ''); + for I := High(Targets) downto 0 do + begin + ed := TEdition.Create(Targets[I].Name, Targets[I].PerDir); + try + if ed.Version >= Result.Version then + begin + if (Result.Version < ed.Version) or + { prefer Delphi version instead of C++Builder version: } + ((Result.Typ = BCB) and (ed.Typ <> BCB)) or + { prefer the new version if the result is not valid (no root set) } + (Result.RootDir = '') then + begin + if ed.IsCLX then + Continue; // this is not a valid version + + if (ed.RootDir <> '') and FileExists(ed.RootDir + '\bin\dcc32.exe') then + begin + Result.Free; + Result := ed; + ed := nil; + end + end; + end; + finally + ed.Free; + end; + end; +end; +{******************************************************************************} +function GetNewestEditionName: string; +var + ed: TEdition; +begin + ed := GetNewestEdition; + try + if ed <> nil then + Result := ed.Name + else + Result := ''; + finally + ed.Free; + end; +end; +{******************************************************************************} +procedure AddNewestEdition; +begin + Editions := nil; + AddEdition(GetNewestEditionName); +end; +{******************************************************************************} +procedure Help; +var + I: Integer; +begin + AddAllEditions(True); + WriteLn('build.exe setups the environment for the given targets and executes the'); + WriteLn('make file that does the required actions.'); + WriteLn; + WriteLn('build.exe [TARGET] [OPTIONS]'); + WriteLn(' TARGETS:'); + + Write(' '); + for I := 0 to High(Editions) - 1 do + Write(Editions[I].Name, ', '); + if Length(Editions) > 0 then + WriteLn(Editions[High(Editions)].Name); + //WriteLn(' c5, c6, c6p, d5, d5s, d6, d6p, d7, d7p, d7clx, d9'); + + WriteLn; + WriteLn(' OPTIONS:'); + WriteLn(' --make=X X will be added to the make command line.'); + WriteLn(' --dcc-opt=X sets the DCCOPT environment variable to X.'); + WriteLn(' --bpl-path=X sets the BPLDIR and DCPDIR environment variable to X.'); + WriteLn(' --lib-path=X sets the LIBDIR environment variable to X (BCB only).'); + WriteLn(' --hpp-path=X sets the HPPDIR environment variable to X (BCB only).'); + WriteLn(' Defaults to $(ROOT)\Include\Vcl'); + WriteLn(' Set this to an empty string if you want the hpp files to'); + WriteLn(' be left in the same directory as their source pas file.'); + + for I := 0 to High(ExtraOptions) do + if ExtraOptions[I].Name <> '' then + WriteLn(' --', ExtraOptions[I].Name, '=X sets the ', ExtraOptions[I].Env, ' environment variable to X.'); + + WriteLn(' --targets=X sets the TARGETS environment variable to X. Only these .bpl'); + WriteLn(' files will be compiled.'); + WriteLn(' (Example:'); + WriteLn(' buildtarget "--targets=JvCoreD7R.bpl JvCoreD7R.bpl" )'); + WriteLn; + WriteLn(' --build forces the Delphi compiler to build the targets.'); + WriteLn(' --force Compile/Generate even if the target is not installed.'); + WriteLn(' --verbose Show all commands that are executed.'); + WriteLn; +end; +{******************************************************************************} +procedure ProcessArgs; +var + i, j, Count: Integer; + S: string; + HppPathSet: Boolean; +begin + i := 1; + Count := ParamCount; + HppPathSet := False; + while i <= Count do + begin + S := ParamStr(i); + if S[1] = '-' then + begin + if StartsText('--make=', S) then + begin + Delete(S, 1, 7); + if S <> '' then + if Pos(' ', S) > 0 then + MakeOptions := MakeOptions + ' "' + S + '"' + else + MakeOptions := MakeOptions + ' ' + S; + end + else if StartsText('--dcc-opt=', S) then + begin + Delete(S, 1, 10); + DccOpt := S; + end + else if StartsText('--bpl-path=', S) then + begin + Delete(S, 1, 11); + UserBplDir := S; + UserDcpDir := S; + end + else if StartsText('--lib-path=', S) then + begin + Delete(S, 1, 11); + UserLibDir := S; + end + else if StartsText('--hpp-path=', S) then + begin + Delete(S, 1, 11); + SetEnvironmentVariable('HPPDIR', Pointer(S)); + HppPathSet := True; + end + else if StartsText('--targets=', S) then + begin + Delete(S, 1, 10); + SetEnvironmentVariable('TARGETS', Pointer(S)); + end + else if SameText(S, '--build') then + begin + DccOpt := DccOpt + ' -B'; + end + else if SameText('--force', S) then + begin + Force := True; + end + else if SameText('--verbose', S) then + begin + Verbose := True; + end + else + begin + for j := 0 to High(ExtraOptions) do + begin + if (ExtraOptions[I].Name <> '') and StartsText('--' + ExtraOptions[j].Name + '=', S) then + begin + Delete(S, 1, 2 + Length(ExtraOptions[j].Name) + 1); + SetEnvironmentVariable(PChar(ExtraOptions[j].Env), Pointer(S)); + end; + end + end; + end + else + begin + if SameText(S, 'all') then + begin + AddAllEditions(False); + end + else if SameText(S, 'newest') then + begin + AddNewestEdition; + WriteLn('Using ', GetNewestEditionName, ' for build process.'); + WriteLn; + end + else if TargetIndexOfEdition(S) = -1 then + begin + WriteLn('Unknown edition: ', S); + Halt(1); + end + else + AddEdition(S); + end; + Inc(i); + end; + if not HppPathSet then + SetEnvironmentVariable('HPPDIR', '$(ROOT)\Include\Vcl'); +end; +{******************************************************************************} +function GetLibraryRootDir: string; +var + I: Integer; +begin + Result := ExtractFileDir(ParamStr(0)); + for I := 1 to LibraryRootDirRelativeToBuild do + Result := ExtractFileDir(Result); +end; +{******************************************************************************} +function ExtractShortPathName(const Path: string): string; +begin + SetLength(Result, MAX_PATH); + SetLength(Result, GetShortPathName(PChar(Path), PChar(Result), Length(Result))); +end; +{******************************************************************************} +procedure FixDcc32Cfg(Edition: TEdition); +var + f: TextFile; + S: string; + FoundU, FoundLU: Boolean; +begin + AssignFile(f, Edition.RootDir + '\bin\dcc32.cfg'); + if not FileExists(Edition.RootDir + '\bin\dcc32.cfg') then + begin + {$I-} + Rewrite(f); + {$I+} + if IOResult = 0 then + begin + WriteLn(f, '-aWinTypes=Windows;WinProcs=Windows;DbiProcs=BDE;DbiTypes=BDE;DbiErrs=BDE'); + if Edition.Typ <> Delphi then + WriteLn(f, '-u"', Edition.RootDir, '\lib";"', Edition.RootDir, '\lib\obj"') + else + WriteLn(f, '-u"', Edition.RootDir, '\lib"'); + if (Edition.Typ = BCB) and (Edition.Version = 5) then + WriteLn(f, '-LUvcl50'); + CloseFile(f); + end + else + begin + WriteLn('Cannot create default ', Edition.RootDir, '\bin\dcc32.cfg'); + Halt(0); + end; + end + else + begin + FoundU := False; + FoundLU := (Edition.Typ <> BCB) and (Edition.Version = 5); + Reset(f); + while not EOF(f) and not (FoundU and FoundLU) do + begin + ReadLn(f, S); + if Edition.Typ = Delphi then + FoundU := FoundU or SameText(S, '-u"' + Edition.RootDir + '\lib"') or + SameText(S, '-u"' + ExtractShortPathName(Edition.RootDir) + '\lib"') or + SameText(S, '-u' + ExtractShortPathName(Edition.RootDir) + '\lib') + else + FoundU := FoundU or SameText(S, '-u"' + Edition.RootDir + '\lib";"' + Edition.RootDir + '\lib\obj"') or + SameText(S, '-u"' + ExtractShortPathName(Edition.RootDir) + '\lib";"' + ExtractShortPathName(Edition.RootDir) + '\lib\obj"') or + SameText(S, '-u' + ExtractShortPathName(Edition.RootDir) + '\lib;' + ExtractShortPathName(Edition.RootDir) + '\lib\obj'); + if (Edition.Typ = BCB) and (Edition.Version = 5) then + FoundLU := FoundLU or SameText(S, '-LUvcl50'); + end; + CloseFile(f); + if not FoundU or not FoundLU then + begin + {$I-} + Append(f); + {$I+} + WriteLn(f); + if IOResult = 0 then + begin + if not FoundU then + begin + if Edition.Typ <> Delphi then + WriteLn(f, '-u"', Edition.RootDir, '\lib";"', Edition.RootDir, '\lib\obj"') + else + WriteLn(f, '-u"', Edition.RootDir, '\lib"'); + end; + if not FoundLU and (Edition.Typ = BCB) and (Edition.Version = 5) then + WriteLn(f, '-LUvcl50'); + CloseFile(f); + end + else + begin + WriteLn('You do not have the required permissions to alter the defect ', Edition.RootDir, '\bin\dcc32.cfg'); + Halt(0); + end; + end; + end; +end; + + +var + I: Integer; + UnitOutDir, Path: string; + Edition: TEdition; +begin + LibraryRootDir := GetLibraryRootDir; + // ahuser (2005-01-22): make.exe fails if a path with spaces is in the PATH envvar + + // set ExtraOptions default values + for I := 0 to High(ExtraOptions) do + if ExtraOptions[I].Name <> '' then + SetEnvironmentVariable(PChar(ExtraOptions[I].Env), Pointer(ExtraOptions[I].Default)); + SetEnvironmentVariable(PChar(LibraryName + 'ROOT'), PChar(LibraryRootDir)); + + UserBplDir := ''; + UserDcpDir := ''; + UserLibDir := ''; + + LoadTargetNames; + ProcessArgs; + + if Length(Editions) = 0 then + begin + Help; + Halt(1); + end; + if not Verbose then + begin + MakeOptions := ' -s' + MakeOptions; + SetEnvironmentVariable('QUIET', '-s'); + end + else + SetEnvironmentVariable('QUIET', nil); + + for I := 0 to High(Editions) do + begin + ExtraUnitDirs := ''; + + Edition := Editions[I]; + if Length(Editions) > 1 then + WriteLn('################################ ' + Edition.Name + ' #########################################'); + + // test for valid root directory/valid IDE installation + if not Force then + begin + if Edition.RootDir = '' then + begin + WriteLn('Delphi/BCB version not installed.'); + Continue; + end; + end + else + begin + if Edition.RootDir = '' then + Edition := GetNewestEdition; + if Edition.RootDir = '' then + begin + WriteLn('No Delphi/BCB version installed.'); + Continue; + end; + end; + + // correct dcc32.cfg file if necessary + FixDcc32Cfg(Edition); + + UnitOutDir := LibraryRootDir + '\lib\' + Edition.MainName; + if UserDcpDir = '' then + UserDcpDir := Edition.DcpDir; + if UserBplDir = '' then + UserBplDir := Edition.BplDir; + if UserLibDir = '' then + UserLibDir := Edition.LibDir; + + FindDxgettext(Edition.Version); + + // setup environment and execute make.exe + Path := GetWindowsDir + ';' + GetSystemDir + ';' + GetWindowsDir + '\Command'; + if UserLibDir <> UserBplDir then + Path := ExtractShortPathName(Edition.RootDir) + '\bin;' + ExtractShortPathName(UserBplDir) + ';' + ExtractShortPathName(UserLibDir) + ';' + Path + else + Path := ExtractShortPathName(Edition.RootDir) + '\bin;' + ExtractShortPathName(UserBplDir) + ';' + Path; + { Add original BPL directory for "common" BPLs, but add it as the very last + path to prevent collisions between packages in TargetConfig.BplDir and + Target.BplDir. } + Path := Path + ';' + ExtractShortPathName(Edition.BplDir); + +(* dcc32cfg := CreateDcc32Cfg([ + '-Q', + '-U"' + Edition.RootDir + '\Lib"', + '-U"' + Edition.RootDir + '\Lib\Obj"', + '-R"' + Edition.RootDir + '\Lib"', + '-I"' + Edition.RootDir + '\Include"', + '-I"' + Edition.RootDir + '\Include\Vcl"', + '-U"' + UserDcpDir + '"', + '-U"' + UserLibDir + '"' + ]); + + '-I"$(JCLINCLUDEDIRS)">>"$(CFG)" + @echo -U"$(JCLSOURCEDIRS1)">>"$(CFG)" + @echo -U"$(JCLSOURCEDIRS2)">>"$(CFG)" + # + @echo -I"$(JVCLINCLUDEDIRS)">>"$(CFG)" + @echo -U"$(UNITOUTDIR)">>"$(CFG)" + @echo -U"$(LIBDIR)">>"$(CFG)" + @echo -U"$(JVCLSOURCEDIRS1)">>"$(CFG)" + @echo -U"$(JVCLSOURCEDIRS2)">>"$(CFG)" + @echo -R"$(JVCLRESDIRS)">>"$(CFG)" + # + @echo -U"$(EXTRAUNITDIRS)">>"$(CFG)" + @echo -I"$(EXTRAINCLUDEDIRS)">>"$(CFG)" + @echo -R"$(EXTRARESDIRS)">>"$(CFG)" + # + @echo -U"$(UNITDIRS)">>"$(CFG)" + @echo -R"$(UNITDIRS)">>"$(CFG)" +*) + + //SetEnvironemntVariable('CFGFILE', PChar('..\$(PKGDIR)\dcc32.cfg'); + + SetEnvironmentVariable('PATH', Pointer(Path)); + + SetEnvironmentVariable('MAINBPLDIR', Pointer(Edition.BplDir)); + SetEnvironmentVariable('MAINDCPDIR', Pointer(Edition.DcpDir)); + SetEnvironmentVariable('BPLDIR', Pointer(UserBplDir)); + SetEnvironmentVariable('DCPDIR', Pointer(UserDcpDir)); + SetEnvironmentVariable('LIBDIR', Pointer(UserLibDir)); + SetEnvironmentVariable('BPILIBDIR', Pointer(UserLibDir)); + SetEnvironmentVariable('PERSONALEDITION_OPTION', nil); + SetEnvironmentVariable('ROOT', PChar(Edition.RootDir)); + SetEnvironmentVariable('VERSION', PChar(Edition.VersionStr)); + SetEnvironmentVariable('UNITOUTDIR', PChar(UnitOutDir)); + SetEnvironmentVariable('DCCOPT', Pointer(DccOpt)); + SetEnvironmentVariable('DCC', PChar('"' + Edition.RootDir + '\bin\dcc32.exe" ' + DccOpt)); + + if Edition.IsPersonal then + begin + SetEnvironmentVariable('PERSONALEDITION_OPTION', '-DDelphiPersonalEdition'); + SetEnvironmentVariable('PKGDIR', PChar(Edition.PkgDir)); + SetEnvironmentVariable('EDITION', PChar(Edition.MainName)); + if Verbose then + Execute('"' + Edition.RootDir + '\bin\make.exe" -f makefile.mak pg.exe') + else + Execute('"' + Edition.RootDir + '\bin\make.exe" -s -f makefile.mak pg.exe'); + end; + + SetEnvironmentVariable('EDITION', PChar(Edition.Name)); + SetEnvironmentVariable('PKGDIR', PChar(Edition.PkgDir)); + + if (ExtraUnitDirs <> '') and (ExtraUnitDirs[1] = ';') then + Delete(ExtraUnitDirs, 1, 1); + SetEnvironmentVariable('EXTRAUNITDIRS', Pointer(ExtraUnitDirs)); + SetEnvironmentVariable('DXGETTEXTDIR', Pointer(DxgettextDir)); + + + ExitCode := Execute('"' + Edition.RootDir + '\bin\make.exe" ' + MakeOptions); + if ExitCode <> 0 then + begin + if ExitCode < 0 then + WriteLn('Failed: ', '"' + Edition.RootDir + '\bin\make.exe" ' + MakeOptions); + WriteLn('Press ENTER to continue'); + ReadLn; + end; + end; +end. + diff --git a/official/1.96/install/build/build.exe b/official/1.96/install/build/build.exe new file mode 100644 index 0000000..95a3342 Binary files /dev/null and b/official/1.96/install/build/build.exe differ diff --git a/official/1.96/install/build/makefile.mak b/official/1.96/install/build/makefile.mak new file mode 100644 index 0000000..694fca1 --- /dev/null +++ b/official/1.96/install/build/makefile.mak @@ -0,0 +1,7 @@ +installer: + cd .. + make -f makefile.mak + +qinstaller: + cd .. + make -f makefile.mak clean qinstall diff --git a/official/1.96/install/build/pgEdit.xml b/official/1.96/install/build/pgEdit.xml new file mode 100644 index 0000000..7658f5d --- /dev/null +++ b/official/1.96/install/build/pgEdit.xml @@ -0,0 +1,118 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/install/build/pretest.bat b/official/1.96/install/build/pretest.bat new file mode 100644 index 0000000..b9ac2ee --- /dev/null +++ b/official/1.96/install/build/pretest.bat @@ -0,0 +1,33 @@ +@echo off + +if EXIST build.exe GOTO FOUND + +dcc32.exe -$D- -DJCL -Q build.dpr >NUL +if ERRORLEVEL 1 GOTO FAILED + +rem ======= COMPILED ======= +echo build.exe compiled. Pretest: ok + +goto LEAVE + +:FAILED +rem ======= FAILED ======= +echo. +echo. +echo Delphi Compiler for Win32 (dcc32.exe) was not found. Please add the +echo Delphi\Bin directory to the PATH environment variable. +echo. +echo You can do this by executing +echo 'SET PATH=C:\Program Files\Borland\Delphi7\Bin;%%PATH%%' +echo. +echo (Adjust the directories to your installation path) +echo. + + +goto LEAVE + +:FOUND +rem ======= FOUND ======= +echo build.exe found. Pretest: ok + +:LEAVE diff --git a/official/1.96/install/makefile.mak b/official/1.96/install/makefile.mak new file mode 100644 index 0000000..f080577 --- /dev/null +++ b/official/1.96/install/makefile.mak @@ -0,0 +1,68 @@ +#--------------------------------------------------------------------------------------------------# +# # +# JCL Install Helper # +# # +#--------------------------------------------------------------------------------------------------# + +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#--------------------------------------------------------------------------------------------------- +VClxOptions = -c -dVisualCLX -dHAS_UNIT_TYPES -uDevelop -uVCL -x.\Q +VclOptions = -c -dVCL -dVCL -dMSWINDOWS -uDevelop -uVisualCLX -uUnix -uKYLIX -x.\\ +#--------------------------------------------------------------------------------------------------- +SRC = ..\source +UNIT = "$(ROOT)\Lib;$(ROOT)\Lib\Obj;$(SRC)\common;$(SRC)\windows" +RES = +BIN = ..\bin +MAP = $(BIN)\$&.map +DRC = $&.drc +#--------------------------------------------------------------------------------------------------- +MAKE = "$(ROOT)\bin\make.exe" -$(MAKEFLAGS) -f$** +DCC = "$(ROOT)\bin\dcc32.exe" -dJCLINSTALL -e$(BIN) -i$(SRC) -q -r$(RES) -u$(UNIT) -w $< +BRCC = "$(ROOT)\bin\brcc32.exe" $** +jpp = ..\devtools\jpp.exe +#--------------------------------------------------------------------------------------------------- +default: install +#--------------------------------------------------------------------------------------------------- + +.dpr.exe: + @if exist "$(ROOT)\Lib\vcl.dcp" $(DCC) -LUvcl -LUrtl + @if exist "$(ROOT)\Lib\Obj\vcl.dcp" $(DCC) -LUvcl -LUrtl + @if exist "$(ROOT)\Lib\Obj\vcl50.dcp" $(DCC) -LUvcl50 + @if not exist "$(ROOT)\Lib\Obj" $(DCC) + @if exist *.dcu del *.dcu + +$(BIN)\JediInstaller.exe: \ + prototypes \ + JediInstaller.dpr + +$(BIN)\QJediInstaller.exe: \ + prototypes \ + QJediInstaller.dpr + +install: $(BIN)\JediInstaller.exe + cd .. + bin\JediInstaller.exe + cd install + +qinstall: $(BIN)\QJediInstaller.exe + cd .. + bin\QJediInstaller.exe + cd install + +.PHONY: clean prototypes + +clean: + cd .. + @echo cleaning up first... + -@for %f in (bin\*.exe) do @if not %f==bin\JediInstaller.exe if not %f==bin\QJediInstaller.exe (del %f) + -del /f /s *.~* bin\*.dll *.a *.bpi *.dcp *.dcu *.dpu *.hpp *.jdbg *.map *.o + cd lib + -del /f /s *.obj *.res + cd ..\install + +prototypes: + @if exist prototypes "$(MAKEDIR)\make.exe" -fprototypes.mak VclUnits + @if exist prototypes "$(MAKEDIR)\make.exe" -fprototypes.mak ClxUnits + diff --git a/official/1.96/install/prototypes.mak b/official/1.96/install/prototypes.mak new file mode 100644 index 0000000..8468ea6 --- /dev/null +++ b/official/1.96/install/prototypes.mak @@ -0,0 +1,36 @@ +#--------------------------------------------------------------------------------------------------# +# # +# JCL Install Helper # +# # +#--------------------------------------------------------------------------------------------------# + +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#--------------------------------------------------------------------------------------------------- +VClxOptions = -c -dVisualCLX -dHAS_UNIT_TYPES -uVCL -x.\Q +VclOptions = -c -dVCL -dMSWINDOWS -uVisualCLX -uUnix -uKYLIX -x.\\ +#--------------------------------------------------------------------------------------------------- +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +jpp = ..\devtools\jpp.exe +#--------------------------------------------------------------------------------------------------- +default: VclUnits ClxUnits +#--------------------------------------------------------------------------------------------------- + +VclUnits: ProductFrames.pas \ + JediInstallerMain.pas + +ClxUnits: QProductFrames.pas \ + QJediInstallerMain.pas + +{prototypes}.pas{.}.pas: + $(jpp) $(VclOptions) $< + + +QJediInstallerMain.pas: \ + prototypes\JediInstallerMain.pas + $(jpp) $(VClxOptions) $? + +QProductFrames.pas: \ + prototypes\ProductFrames.pas + $(jpp) $(VClxOptions) $? diff --git a/official/1.96/install/prototypes/JediInstallerMain.pas b/official/1.96/install/prototypes/JediInstallerMain.pas new file mode 100644 index 0000000..6009d17 --- /dev/null +++ b/official/1.96/install/prototypes/JediInstallerMain.pas @@ -0,0 +1,704 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ 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 JediInstallerMain.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. } +{ } +{ Contributors: } +{ Andreas Hausladen (ahuser) } +{ Robert Rossmair (rrossmair) - crossplatform & BCB support, refactoring } +{ } +{**************************************************************************************************} + +// $Id: JediInstallerMain.pas,v 1.34 2006/02/05 13:26:15 outchy Exp $ + +{$IFNDEF PROTOTYPE} +{$IFDEF VCL} +unit JediInstallerMain; +{$ELSE VisualCLX} +unit QJediInstallerMain; +{$ENDIF VisualCLX} +{$ENDIF ~PROTOTYPE} + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, Messages, + {$ENDIF MSWINDOWS} + SysUtils, Classes, + {$IFDEF VisualCLX} + Types, + Qt, QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, QMenus, QButtons, QComCtrls, QImgList, + QProductFrames, + {$ELSE} + Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Menus, Buttons, ComCtrls, ImgList, + ProductFrames, + {$ENDIF} + JclBorlandTools, JediInstall; + +const + {$IFDEF VisualCLX} + QEventType_UMCheckUpdates = QEventType(Integer(QEventType_ClxUser) + $100); + {$ELSE} + UM_CHECKUPDATES = WM_USER + $100; + {$ENDIF} + +type + TMainForm = class(TForm, IJediInstallTool) + InstallBtn: TBitBtn; + UninstallBtn: TBitBtn; + QuitBtn: TBitBtn; + JediImage: TImage; + TitlePanel: TPanel; + Title: TLabel; + ProductsPageControl: TPageControl; + StatusBevel: TBevel; + StatusLabel: TLabel; + Bevel1: TBevel; + ProgressBar: TProgressBar; + ImageList: TImageList; + ReadmePage: TTabSheet; + {$IFDEF VCL} + ReadmePane: TRichEdit; + {$ELSE ~VCL} + ReadmePane: TTextViewer; + {$ENDIF ~VCL} + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure QuitBtnClick(Sender: TObject); + procedure InstallBtnClick(Sender: TObject); + procedure UninstallBtnClick(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure JediImageClick(Sender: TObject); + procedure TreeViewCollapsing(Sender: TObject; Node: TTreeNode; + var AllowCollapse: Boolean); + procedure BplPathEditChange(Sender: TObject); + private + FBorRADToolInstallations: TJclBorRADToolInstallations; + FJclInstall: IJediInstall; + FSystemPaths: TStringList; + FFeatureNode: TTreeNode; + FFeatureChanged: Boolean; + FHintPos: TPoint; + function ActiveView: TProductFrame; + function CheckUpdatePack(Installation: TJclBorRADToolInstallation): Boolean; + function CreateView(Installation: TJclBorRADToolInstallation): Boolean; + function ExpandOptionTree(Installation: TJclBorRADToolInstallation): Boolean; + procedure InstallationStarted(Installation: TJclBorRADToolInstallation); + procedure InstallationFinished(Installation: TJclBorRADToolInstallation); + procedure InstallationProgress(Percent: Cardinal); + procedure ReadSystemPaths; + function View(Installation: TJclBorRADToolInstallation): TProductFrame; + {$IFDEF VCL} + procedure UMCheckUpdates(var Message: TMessage); message UM_CHECKUPDATES; + {$ENDIF VCL} + procedure TreeViewChange(Sender: TObject; Node: TTreeNode); + procedure TreeViewEnter(Sender: TObject); + procedure TreeViewExit(Sender: TObject); + procedure TreeViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure UpdateFeatureInfo(Node: TTreeNode); + protected + {$IFDEF VisualCLX} + function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override; + {$ENDIF VisualCLX} + function InfoFile(Node: TTreeNode): string; + function OptionGUI(Installation: TJclBorRADToolInstallation): TObject; + function GUIAddOption(GUI, Parent: TObject; Option: TJediInstallOption; const Text: string; + GUIOptions: TJediInstallGUIOptions): TObject; + procedure HandleException(Sender: TObject; E: Exception); + property JclDistribution: IJediInstall read FJclInstall; + // IJediInstallTool + function GetBPLPath(Installation: TJclBorRADToolInstallation): string; + function GetDCPPath(Installation: TJclBorRADToolInstallation): string; + procedure SetBPLPath(Installation: TJclBorRADToolInstallation; const Value: string); + procedure SetDCPPath(Installation: TJclBorRADToolInstallation; const Value: string); + public + procedure ShowFeatureHint(var HintStr: {$IFDEF VisualCLX}WideString{$ELSE}string{$ENDIF}; + var CanShow: Boolean; var HintInfo: THintInfo); + function CheckRunningInstances: Boolean; + procedure Install; + procedure Uninstall; + function SystemPathValid(const Path: string): Boolean; + // IJediInstallTool + function FeatureChecked(FeatureID: Cardinal; Installation: TJclBorRADToolInstallation): Boolean; + function GetBorRADToolInstallations: TJclBorRADToolInstallations; + function Dialog(const Text: string; DialogType: TDialogType = dtInformation; + Options: TDialogResponses = [drOK]): TDialogResponse; + procedure SetReadme(const FileName: string); + procedure UpdateInfo(Installation: TJclBorRADToolInstallation; const InfoText: String); + procedure UpdateStatus(const Text: string); + procedure WriteInstallLog(Installation: TJclBorRADToolInstallation; const Text: string); + property BorRADToolInstallations: TJclBorRADToolInstallations read FBorRADToolInstallations; + property BPLPath[Installation: TJclBorRADToolInstallation]: string read GetBPLPath write SetBPLPath; + property DCPPath[Installation: TJclBorRADToolInstallation]: string read GetDCPPath write SetDCPPath; + end; + +var + MainForm: TMainForm; + +implementation + +{$IFDEF VCL} +{$R *.dfm} +{$ELSE VisualCLX} +{$R *.xfm} +{$ENDIF VisualCLX} + +uses + {$IFDEF UNIX} + Libc, + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + FileCtrl, + JclDebug, JclShell, + {$ENDIF MSWINDOWS} + JclBase, JclFileUtils, JclStrings, JclSysInfo, JclSysUtils, + JclInstall; + +const + {$IFNDEF RTL140_UP} + PathSep = ';'; + {$ENDIF RTL140_UP} + {$IFDEF MSWINDOWS} + SupportURLs: array[TJclBorRADToolKind] of string = ( + 'http://www.borland.com/devsupport/delphi/', + 'http://www.borland.com/devsupport/bcppbuilder/', + 'http://www.borland.com/devsupport/delphi/'); + {$ENDIF MSWINDOWS} + {$IFDEF KYLIX} + KylixSupportURL = 'http://www.borland.com/devsupport/kylix/'; + {$ENDIF KYLIX} + DelphiJediURL = 'http://delphi-jedi.org'; + VersionSignature = 'D%d'; + BCBTag = $10000; + VersionMask = $FFFF; + +function FeatureID(Node: TTreeNode): Cardinal; +begin + Result := Cardinal(Node.Data) and FID_NumberMask; +end; + +{ TMainForm } + +function TMainForm.ActiveView: TProductFrame; +var + Page: TTabSheet; + Control: TControl; +begin + Result := nil; + Page := ProductsPageControl.ActivePage; + Control := Page.Controls[0]; + if Control is TProductFrame then + Result := TProductFrame(Control); +end; + +function TMainForm.InfoFile(Node: TTreeNode): string; +begin + if Assigned(Node) then + Result := FJclInstall.FeatureInfoFileName(FeatureID(Node)); +end; + +function TMainForm.CreateView(Installation: TJclBorRADToolInstallation): Boolean; +var + Page: TTabSheet; + ProductFrame: TProductFrame; +begin + Page := TTabSheet.Create(Self); + with Installation do + begin + Page.Name := Format('%sPage', [VersionNumberStr]); + Page.Caption := Name; + end; + Page.PageControl := ProductsPageControl; + ProductFrame := TProductFrame.Create(Self); + ProductFrame.Installation := Installation; + ProductFrame.TreeView.Images := ImageList; + ProductFrame.TreeView.OnChange := TreeViewChange; + ProductFrame.TreeView.OnCollapsing := TreeViewCollapsing; + ProductFrame.TreeView.OnEnter := TreeViewEnter; + ProductFrame.TreeView.OnExit := TreeViewExit; + ProductFrame.TreeView.OnMouseMove := TreeViewMouseMove; + ProductFrame.Align := alClient; + ProductFrame.Parent := Page; + FJclInstall.SetOnWriteLog(Installation, ProductFrame.LogOutputLine); + Result := True; +end; + +function TMainForm.CheckRunningInstances: Boolean; +begin + Result := FBorRADToolInstallations.AnyInstanceRunning; + if Result then + Dialog(RsCloseRADTool, dtWarning); +end; + +function TMainForm.CheckUpdatePack(Installation: TJclBorRADToolInstallation): Boolean; +var + Msg: string; +begin + Result := True; + with Installation do + if UpdateNeeded then + begin + Msg := Format(RsUpdateNeeded, [LatestUpdatePack, Name]); + if Dialog(Msg, dtWarning, [drYes, drNo]) = drYes then + {$IFDEF MSWINDOWS} + ShellExecEx(SupportURLs[RadToolKind]); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + { TODO : Analoguous function for Linux }; + // Exec(KylixSupportURL); + {$ENDIF UNIX} + end; +end; + +function TMainForm.GUIAddOption(GUI, Parent: TObject; Option: TJediInstallOption; + const Text: string; GUIOptions: TJediInstallGUIOptions): TObject; +const + Icon: array[Boolean] of Integer = (IcoUnchecked, IcoChecked); + Flag: array[Boolean] of Cardinal = (0, FID_Checked); +var + FeatureID: Cardinal; + Nodes: TTreeNodes; + Node, ParentNode: TTreeNode; + Checked: Boolean; +begin + ParentNode := TTreeNode(Parent); + Checked := goChecked in GUIOptions; + FeatureID := Cardinal(Ord(Option)) + Flag[goChecked in GUIOptions]; + if goNoAutoCheck in GUIOptions then + FeatureID := FeatureID + FID_NoAutoCheck; + if goStandAloneParent in GUIOptions then + FeatureID := FeatureID + FID_StandAloneParent; + if goRadioButton in GUIOptions then + FeatureID := FeatureID + FID_RadioButton; + if goExpandable in GUIOptions then + FeatureID := FeatureID + FID_Expandable; + Nodes := TTreeNodes(GUI); + if Parent = nil then + Node := Nodes.AddObject(nil, Text, Pointer(FeatureID)) + else + Node := Nodes.AddChildObject(ParentNode, Text, Pointer(FeatureID)); + Node.ImageIndex := Icon[Checked]; + Node.SelectedIndex := Icon[Checked]; + Result := Node; +end; + +procedure TMainForm.HandleException(Sender: TObject; E: Exception); +begin + if E is EJediInstallInitFailure then + begin + Dialog(E.Message, dtError); + Application.ShowMainForm := False; + Application.Terminate; + end + else + Application.ShowException(E); +end; + +procedure TMainForm.Install; +var + Res: Boolean; +begin + ProgressBar.Position := 0; + ProgressBar.Visible := True; + Screen.Cursor := crHourGlass; + try + Res := FJclInstall.Install; + Screen.Cursor := crDefault; + if Res then + Dialog(RsInstallSuccess) + else + Dialog(RsInstallFailure); + finally + ProgressBar.Visible := False; + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.Uninstall; +begin + ProgressBar.Position := 0; + ProgressBar.Visible := True; + Screen.Cursor := crHourGlass; + try + FJclInstall.Uninstall; + Screen.Cursor := crDefault; + finally + ProgressBar.Visible := False; + Screen.Cursor := crDefault; + end; +end; + +procedure TMainForm.InstallationProgress(Percent: Cardinal); +begin + ProgressBar.Position := Percent; +end; + +function TMainForm.View(Installation: TJclBorRADToolInstallation): TProductFrame; +begin + if not Assigned(Installation) then + Result := nil + else + with Installation do + Result := FindComponent(TProductFrame.GetName(Installation)) as TProductFrame; +end; + +procedure TMainForm.ReadSystemPaths; +var + PathVar: string; + I: Integer; +begin + if GetEnvironmentVar('PATH', PathVar, False) then + begin + StrToStrings(PathVar, PathSep, FSystemPaths, False); + for I := 0 to FSystemPaths.Count - 1 do + begin + PathVar := StrTrimQuotes(FSystemPaths[I]); + ExpandEnvironmentVar(PathVar); + {$IFDEF MSWINDOWS} + PathVar := AnsiUpperCase(PathRemoveSeparator(PathGetLongName(PathVar))); + {$ENDIF MSWINDOWS} + FSystemPaths[I] := PathVar; + end; + FSystemPaths.Sorted := True; + end; +end; + +function TMainForm.SystemPathValid(const Path: string): Boolean; +begin + Result := FSystemPaths.IndexOf({$IFDEF MSWINDOWS}AnsiUpperCase{$ENDIF}(Path)) <> -1; +end; + +procedure TMainForm.UpdateInfo(Installation: TJclBorRADToolInstallation; const InfoText: String); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + begin + P.InfoDisplay.Text := InfoText; + end; +end; + +procedure TMainForm.UpdateStatus(const Text: string); +begin + if Text = '' then + begin + StatusBevel.Visible := False; + StatusLabel.Visible := False; + end + else + begin + StatusLabel.Caption := Text; + StatusBevel.Visible := True; + StatusLabel.Visible := True; + end; + Application.ProcessMessages; //Update; +end; + +procedure TMainForm.WriteInstallLog(Installation: TJclBorRADToolInstallation; const Text: string); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + P.LogOutputLine(Text); +end; + +function TMainForm.GetBPLPath(Installation: TJclBorRADToolInstallation): string; +var + P: TProductFrame; + Path: string; +begin + P := View(Installation); + if Assigned(P) then + Path := P.BplPath; + Result := PathRemoveSeparator(Installation.SubstitutePath(Path)); +end; + +function TMainForm.GetDCPPath(Installation: TJclBorRADToolInstallation): string; +var + P: TProductFrame; + Path: string; +begin + P := View(Installation); + if Assigned(P) then + Path := P.DcpPath; + Result := PathRemoveSeparator(Installation.SubstitutePath(Path)); +end; + +procedure TMainForm.BplPathEditChange(Sender: TObject); +begin + with (Sender as TEdit) do + if SystemPathValid(Text) then + Font.Color := clWindowText + else + Font.Color := clRed; +end; + +function TMainForm.FeatureChecked(FeatureID: Cardinal; Installation: TJclBorRADToolInstallation): Boolean; +var + P: TProductFrame; +begin + Result := False; + P := View(Installation); + if Assigned(P) then + Result := P.FeatureChecked(FeatureID); +end; + +procedure TMainForm.FormCreate(Sender: TObject); +begin + Application.OnException := HandleException; + FBorRADToolInstallations := TJclBorRADToolInstallations.Create; + FSystemPaths := TStringList.Create; + JediImage.Hint := DelphiJediURL; + FJclInstall := CreateJclInstall; + FJclInstall.SetOnProgress(InstallationProgress); + FJclInstall.SetOnStarting(InstallationStarted); + FJclInstall.SetOnEnding(InstallationFinished); + FJclInstall.SetTool(Self); + BorRADToolInstallations.Iterate(ExpandOptionTree); + + UpdateStatus(''); + + ReadSystemPaths; + {$IFDEF VCL} + TitlePanel.DoubleBuffered := True; + {$ELSE} + //WindowState := wsMaximized; // wouldn't work in Form resource + {$ENDIF} + Application.HintPause := 50; + Application.OnShowHint := ShowFeatureHint; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + FreeAndNil(FBorRADToolInstallations); + FreeAndNil(FSystemPaths); +end; + +{$IFDEF VisualCLX} +function TMainForm.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; +begin + if QEvent_type(Event) = QEventType_UMCheckUpdates then + begin + BorRADToolInstallations.Iterate(CheckUpdatePack); + Result := True; + end + else + Result := inherited EventFilter(Sender, Event); +end; +{$ENDIF VisualCLX} + +{$IFDEF VCL} +procedure TMainForm.UMCheckUpdates(var Message: TMessage); +begin + BorRADToolInstallations.Iterate(CheckUpdatePack); + Message.Result := 0; +end; +{$ENDIF VCL} + +procedure TMainForm.QuitBtnClick(Sender: TObject); +begin + Close; +end; + +function TMainForm.ExpandOptionTree( + Installation: TJclBorRADToolInstallation): Boolean; +var + P: TProductFrame; +begin + Result := True; + P := View(Installation); + if Assigned(P) then + P.UpdateTree; +end; + +procedure TMainForm.InstallBtnClick(Sender: TObject); +begin + if ({$IFDEF MSWINDOWS} IsDebuggerAttached or {$ENDIF} not CheckRunningInstances) and + (Dialog(RsConfirmInstall, dtConfirmation, [drYes, drNo]) = drYes) then + begin + Install; + QuitBtn.SetFocus; + end; +end; + +procedure TMainForm.UninstallBtnClick(Sender: TObject); +begin + if ({$IFDEF MSWINDOWS} IsDebuggerAttached or {$ENDIF} not CheckRunningInstances) then + begin + Uninstall; + QuitBtn.SetFocus; + end; +end; + +procedure TMainForm.FormShow(Sender: TObject); +begin + {$IFDEF VisualCLX} + QApplication_postEvent(Handle, QCustomEvent_create(QEventType_UMCheckUpdates, Self)); + {$ELSE} + PostMessage(Handle, UM_CHECKUPDATES, 0, 0); + {$ENDIF} +end; + +procedure TMainForm.JediImageClick(Sender: TObject); +begin + { TODO : implement for Unix } + {$IFDEF MSWINDOWS} + ShellExecEx(DelphiJediURL); + {$ENDIF MSWINDOWS} +end; + +procedure TMainForm.TreeViewCollapsing(Sender: TObject; Node: TTreeNode; + var AllowCollapse: Boolean); +begin + AllowCollapse := Collapsable(Node); +end; + +function TMainForm.GetBorRADToolInstallations: TJclBorRADToolInstallations; +begin + Result := FBorRADToolInstallations; +end; + +procedure TMainForm.InstallationStarted(Installation: TJclBorRADToolInstallation); +var + P: TProductFrame; +begin + P := View(Installation); + P.InfoDisplay.Lines.Clear; + ProductsPageControl.ActivePage := P.Parent as TTabSheet; + P.StartCompilation(Installation); +end; + +procedure TMainForm.InstallationFinished(Installation: TJclBorRADToolInstallation); +var + P: TProductFrame; +begin + P := View(Installation); + P.StopCompilation(Installation); + P.InfoDisplay.Lines.SaveToFile(JclInstall.LogFileName(Installation)); +end; + +function TMainForm.Dialog(const Text: string; DialogType: TDialogType = dtInformation; + Options: TDialogResponses = [drOK]): TDialogResponse; +const + DlgType: array[TDialogType] of TMsgDlgType = (mtWarning, mtError, mtInformation, mtConfirmation); + DlgButton: array[TDialogResponse] of TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel); + DlgResult: array[TDialogResponse] of Word = (mrYes, mrNo, mrOK, mrCancel); +var + Buttons: TMsgDlgButtons; + Res: Integer; +begin + Buttons := []; + for Result := Low(TDialogResponse) to High(TDialogResponse) do + if Result in Options then + Include(Buttons, DlgButton[Result]); + Res := MessageDlg(Text, DlgType[DialogType], Buttons, 0); + for Result := Low(TDialogResponse) to High(TDialogResponse) do + if DlgResult[Result] = Res then + Break; +end; + +procedure TMainForm.SetBPLPath(Installation: TJclBorRADToolInstallation; const Value: string); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + P.BplPath := Value; +end; + +procedure TMainForm.SetDCPPath(Installation: TJclBorRADToolInstallation; const Value: string); +var + P: TProductFrame; +begin + P := View(Installation); + if Assigned(P) then + P.DcpPath := Value; +end; + +procedure TMainForm.SetReadme(const FileName: string); +begin + ReadmePane.{$IFDEF VCL}Lines.{$ENDIF}LoadFromFile(FileName); + {$IFDEF MSWINDOWS} + ShellExecEx('..\docs\Readme.html'); + {$ENDIF MSWINDOWS} +end; + +procedure TMainForm.TreeViewChange(Sender: TObject; Node: TTreeNode); +begin + UpdateFeatureInfo(Node); +end; + +procedure TMainForm.TreeViewEnter(Sender: TObject); +begin + with ActiveView do + {$IFDEF VCL}if InfoDisplay.ReadOnly then{$ENDIF} + UpdateFeatureInfo(TreeView.Selected); +end; + +procedure TMainForm.TreeViewExit(Sender: TObject); +begin + // +end; + +procedure TMainForm.TreeViewMouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +begin + UpdateFeatureInfo(ActiveView.TreeView.GetNodeAt(X, Y)); +end; + +procedure TMainForm.UpdateFeatureInfo(Node: TTreeNode); +begin + if Assigned(Node) and (Node <> FFeatureNode) then + begin + FFeatureNode := Node; + FFeatureChanged := True; + end; +end; + +procedure TMainForm.ShowFeatureHint; +var + View: TProductFrame; +begin + View := ActiveView; + if Assigned(View) and (HintInfo.HintControl = View.TreeView) then + begin + if FFeatureChanged then + begin + HintInfo.HintStr := FJclInstall.GetHint(TJediInstallOption(FeatureID(FFeatureNode) and $FF)); + FHintPos := HintInfo.HintPos; + FFeatureChanged := False; + end + else + HintInfo.HintPos := FHintPos; + HintInfo.ReshowTimeout := 500; + end; +end; + +function TMainForm.OptionGUI( + Installation: TJclBorRADToolInstallation): TObject; +begin + Result := View(Installation); + if Result = nil then + CreateView(Installation); + Result := View(Installation).TreeView.Items; +end; + +end. diff --git a/official/1.96/install/prototypes/ProductFrames.pas b/official/1.96/install/prototypes/ProductFrames.pas new file mode 100644 index 0000000..5bc4f6f --- /dev/null +++ b/official/1.96/install/prototypes/ProductFrames.pas @@ -0,0 +1,534 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) extension } +{ } +{ 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 JediInstallerMain.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. } +{ } +{ Contributors: } +{ Andreas Hausladen (ahuser) } +{ Robert Rossmair (rrossmair) - crossplatform & BCB support, refactoring } +{ } +{**************************************************************************************************} + +// $Id: ProductFrames.pas,v 1.26 2006/02/05 13:26:15 outchy Exp $ + +{$IFNDEF PROTOTYPE} +{$IFDEF VCL} +unit ProductFrames; +{$ELSE VisualCLX} +unit QProductFrames; +{$ENDIF VisualCLX} +{$ENDIF ~PROTOTYPE} + +interface + +{$I jcl.inc} +{$I crossplatform.inc} + +uses + SysUtils, Classes, + {$IFDEF VisualCLX} + Types, + QGraphics, QForms, QControls, QStdCtrls, QComCtrls, QExtCtrls, + {$ELSE} + Graphics, Forms, Controls, StdCtrls, ComCtrls, ExtCtrls, + {$ENDIF} + JclBorlandTools, JediInstall; + +const + // Feature masks + FID_Expandable = $08000000; + FID_RadioButton = $10000000; + FID_NoAutoCheck = $20000000; // do not auto-check when the parent node gets checked + FID_StandaloneParent = $40000000; // do not auto-uncheck when all child nodes are unchecked + FID_Checked = $80000000; + FID_NumberMask = $03FFFFFF; + + // Icon indexes + IcoProduct = 0; + IcoLevel1 = 1; + IcoChecked = 2; + IcoUnchecked = 3; + +type + TProductFrame = class(TFrame) + ComponentsTreePanel: TPanel; + Label1: TLabel; + TreeView: TTreeView; + Splitter: TSplitter; + InfoPanel: TPanel; + Label2: TLabel; + {$IFDEF VisualCLX} + InfoDisplay: TMemo; + {$ELSE VCL} + InfoDisplay: TRichEdit; + {$ENDIF VCL} + OptionsGroupBox: TGroupBox; + BplPathLabel: TLabel; + DcpPathLabel: TLabel; + BplPathEdit: TEdit; + Button1: TButton; + Button2: TButton; + DcpPathEdit: TEdit; + procedure PathEditChange(Sender: TObject); + procedure PathSelectBtnClick(Sender: TObject); + procedure SplitterCanResize(Sender: TObject; var NewSize: Integer; + var Accept: Boolean); + procedure TreeViewMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure TreeViewKeyPress(Sender: TObject; var Key: Char); + {$IFDEF VisualCLX} + procedure TreeViewCustomDrawItem(Sender: TCustomViewControl; Item: TCustomViewItem; + Canvas: TCanvas; const Rect: TRect; State: TCustomDrawState; Stage: TCustomDrawStage; + var DefaultDraw: Boolean); + {$ELSE} + procedure TreeViewCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; + State: TCustomDrawState; var DefaultDraw: Boolean); + {$ENDIF} + private + { Private declarations } + FInstallation: TJclBorRADToolInstallation; + function GetDCPPath: string; + function GetBPLPath: string; + function GetNodeChecked(Node: TTreeNode): Boolean; + function GetPathForEdit(Path: string): string; + function IsAutoChecked(Node: TTreeNode): Boolean; + function IsRadioButton(Node: TTreeNode): Boolean; + function IsStandAloneParent(Node: TTreeNode): Boolean; + procedure SetDCPPath(const Value: string); + procedure SetBPLPath(const Value: string); + procedure SetInstallation(Value: TJclBorRADToolInstallation); + procedure SetNodeChecked(Node: TTreeNode; const Value: Boolean); + procedure ToggleNodeChecked(Node: TTreeNode); + public + { Public declarations } + class function GetName(Installation: TJclBorRADToolInstallation): string; + function FeatureChecked(FeatureID: Cardinal): Boolean; + procedure LogOutputLine(const Line: string); + procedure UpdateTree; + procedure StartCompilation(Installation: TJclBorRADToolInstallation); + procedure StopCompilation(Installation: TJclBorRADToolInstallation); + property NodeChecked[Node: TTreeNode]: Boolean read GetNodeChecked write SetNodeChecked; + property Installation: TJclBorRADToolInstallation read FInstallation write SetInstallation; + property DCPPath: string read GetDCPPath write SetDCPPath; + property BPLPath: string read GetBPLPath write SetBPLPath; + end; + +function Collapsable(Node: TTreeNode): Boolean; + +implementation + +{$IFDEF VisualCLX} +{$R *.xfm} +{$ELSE} +{$R *.dfm} +{$ENDIF} + +uses + {$IFDEF MSWINDOWS} + Windows, Messages, + {$ENDIF MSWINDOWS} + {$IFDEF VisualCLX} + Qt, QDialogs, + {$ELSE} + FileCtrl, FrmCompile, + {$ENDIF} + JclStrings, + JclInstall; + +resourcestring + RsSelectPath = 'Select path'; + RsEnterValidPath = '(Enter valid path)'; + +function Collapsable(Node: TTreeNode): Boolean; +begin + Result := (Cardinal(Node.Data) and FID_Expandable) <> 0; +end; + +procedure TProductFrame.PathEditChange(Sender: TObject); +begin + with (Sender as TEdit) do + if DirectoryExists(Text) then + Font.Color := clWindowText + else + Font.Color := clRed; +end; + +function TProductFrame.FeatureChecked(FeatureID: Cardinal): Boolean; +var + F: Cardinal; + Node: TTreeNode; +begin + Result := False; + Node := TreeView.Items.GetFirstNode; + while Node <> nil do + begin + F := Cardinal(Node.Data); + if F and FID_NumberMask = FeatureID then + begin + Result := F and FID_Checked <> 0; + Break; + end; + Node := Node.GetNext; + end; +end; + +function TProductFrame.GetDCPPath: string; +begin + Result := DcpPathEdit.Text; +end; + +function TProductFrame.GetBPLPath: string; +begin + Result := BplPathEdit.Text; +end; + +class function TProductFrame.GetName(Installation: TJclBorRADToolInstallation): string; +begin + Result := Format('%sProduct', [Installation.VersionNumberStr]); +end; + +function TProductFrame.GetNodeChecked(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_Checked <> 0; +end; + +function TProductFrame.GetPathForEdit(Path: string): string; +begin + if DirectoryExists(Path) then + Result := Path + else + Result := RsEnterValidPath; +end; + +function TProductFrame.IsAutoChecked(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_NoAutoCheck = 0; +end; + +function TProductFrame.IsRadioButton(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_RadioButton <> 0; +end; + +function TProductFrame.IsStandAloneParent(Node: TTreeNode): Boolean; +begin + Result := Cardinal(Node.Data) and FID_StandAloneParent <> 0; +end; + +procedure TProductFrame.LogOutputLine(const Line: string); +{$IFDEF VCL} + + function Cmp(const S: string): Boolean; + begin + Result := Copy(Line, 1, Length(S)) = S; + end; + +begin + if FormCompile.HandleLine(Line) <> clFileProgress then + begin + if Cmp(AnsiLineBreak + 'Installing package ') then + FormCompile.Linking(Copy(Line, 20, MaxInt)) + else if Cmp('Copying .hpp files...') then + FormCompile.Done; + + InfoDisplay.Lines.Append(Line); + InfoDisplay.Perform(EM_SCROLLCARET, 0, 0); + end; +end; +{$ELSE VisualCLX} +var + NewCaretPos: TCaretPos; +begin + with InfoDisplay do + begin + Lines.BeginUpdate; + Lines.Append(Line); + Lines.EndUpdate; + NewCaretPos.Line := Lines.Count; + NewCaretPos.Col := 0; + CaretPos := NewCaretPos; + end; +end; +{$ENDIF VisualCLX} + +procedure TProductFrame.SetDCPPath(const Value: string); +begin + DcpPathEdit.Text := GetPathForEdit(Value); +end; + +procedure TProductFrame.SetBPLPath(const Value: string); +begin + BplPathEdit.Text := GetPathForEdit(Value); +end; + +procedure TProductFrame.SetInstallation(Value: TJclBorRADToolInstallation); +begin + FInstallation := Value; + Name := GetName(Value); + if Value.RadToolKind = brCppBuilder then + DcpPathLabel.Caption := '.bpi Path'; +end; + +procedure TProductFrame.SetNodeChecked(Node: TTreeNode; const Value: Boolean); + + procedure UpdateNode(N: TTreeNode; C: Boolean); + const + CheckedState: array[Boolean] of Cardinal = (0, FID_Checked); + begin + N.Data := Pointer(Cardinal(N.Data) and (not FID_Checked) or CheckedState[C]); + if C then + begin + N.ImageIndex := IcoChecked; + N.SelectedIndex := IcoChecked; + end + else + begin + N.ImageIndex := IcoUnchecked; + N.SelectedIndex := IcoUnchecked; + end; + end; + + procedure UpdateTreeDown(N: TTreeNode; C: Boolean); + begin + N := N.getFirstChild; + while Assigned(N) do + begin + if not C or IsAutoChecked(N) then + begin + if not IsRadioButton(N) then + UpdateNode(N, C); + UpdateTreeDown(N, C); + end; + N := N.getNextSibling; + end; + end; + + procedure UpdateTreeUp(N: TTreeNode; C: Boolean); + var + ParentNode: TTreeNode; + ParentChecked: Boolean; + begin + if C then + while Assigned(N) do + begin + UpdateNode(N, True); + N := N.Parent; + end + else + begin + ParentNode := N.Parent; + while Assigned(ParentNode) do + begin + N := ParentNode.getFirstChild; + ParentChecked := IsStandAloneParent(ParentNode); + while Assigned(N) do + if NodeChecked[N] and not IsRadioButton(N) then + begin + ParentChecked := True; + Break; + end + else + N := N.getNextSibling; + UpdateNode(ParentNode, ParentChecked); + ParentNode := ParentNode.Parent; + end; + end; + end; + + procedure UpdateRadioButton(N: TTreeNode; C: Boolean); + var + Node: TTreeNode; + begin + if Value and not NodeChecked[N] then + begin + Node := N.Parent; + if Node <> nil then + begin + Node := Node.getFirstChild; + while Node <> nil do + begin + if IsRadioButton(Node) then + UpdateNode(Node, Node = N); + Node := Node.getNextSibling; + end; + end; + end; + end; + +begin + if IsRadioButton(Node) then + UpdateRadioButton(Node, Value) + else + begin + UpdateNode(Node, Value); + UpdateTreeDown(Node, Value); + UpdateTreeUp(Node, Value); + end; +end; + +procedure TProductFrame.ToggleNodeChecked(Node: TTreeNode); +begin + if Assigned(Node) then + NodeChecked[Node] := not NodeChecked[Node]; +end; + +procedure TProductFrame.PathSelectBtnClick(Sender: TObject); +var + I: Integer; + Button: TButton; + Edit: TEdit; + {$IFDEF VisualCLX} + {$IFDEF COMPILER7_UP} + {$DEFINE USE_WIDESTRING} + {$ENDIF} + {$ENDIF} + {$IFDEF KYLIX} + {$DEFINE USE_WIDESTRING} + {$ENDIF KYLIX} + {$IFDEF USE_WIDESTRING} + Directory: WideString; + {$UNDEF USE_WIDESTRING} + {$ELSE} + Directory: string; + {$ENDIF} +begin + Button := Sender as TButton; + Edit := nil; + with Button.Parent do + for I := 0 to ControlCount - 1 do + if (Controls[I].Top = Button.Top) and (Controls[I] is TEdit) then + Edit := TEdit(Controls[I]); + if Assigned(Edit) and SelectDirectory(RsSelectPath, '', Directory) then + Edit.Text := Directory; +end; + +procedure TProductFrame.SplitterCanResize(Sender: TObject; + var NewSize: Integer; var Accept: Boolean); +begin + Accept := NewSize > 150; +end; + +{$IFDEF VisualCLX} +procedure TProductFrame.TreeViewCustomDrawItem(Sender: TCustomViewControl; Item: TCustomViewItem; + Canvas: TCanvas; const Rect: TRect; State: TCustomDrawState; Stage: TCustomDrawStage; + var DefaultDraw: Boolean); +{$ELSE} +procedure TProductFrame.TreeViewCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; + State: TCustomDrawState; var DefaultDraw: Boolean); +{$ENDIF} +begin + case TTreeNode({$IFDEF VisualCLX}Item{$ELSE}Node{$ENDIF}).Level of + 0: begin + {$IFDEF VCL}Sender.{$ENDIF}Canvas.Font.Style := [fsBold, fsUnderline]; + end; + 1: begin + {$IFDEF VCL}Sender.{$ENDIF}Canvas.Font.Style := [fsBold]; + end; + end; +end; + +procedure TProductFrame.TreeViewKeyPress(Sender: TObject; var Key: Char); +begin + with TTreeView(Sender) do + case Key of + #32: + begin + ToggleNodeChecked(Selected); + Key := #0; + end; + '+': + Selected.Expanded := True; + '-': + Selected.Expanded := False; + end; +end; + +{$IFDEF VisualCLX} +function TreeNodeIconHit(TreeView: TTreeView; X, Y: Integer; Node: TTreeNode = nil): Boolean; +var + Level, X1: Integer; +begin + Result := False; + if Node = nil then + Node := TreeView.GetNodeAt(X, Y); + if Assigned(Node) then + begin + Level := Node.Level; + if QListView_rootIsDecorated(TreeView.Handle) then + Inc(Level); + X1 := QListView_treeStepSize(TreeView.Handle) * Level; + Result := (X > X1) and (X <= X1 + TreeView.Images.Width); + end; +end; +{$ELSE VCL} +function TreeNodeIconHit(TreeView: TTreeView; X, Y: Integer): Boolean; +begin + Result := htOnIcon in TreeView.GetHitTestInfoAt(X, Y); +end; +{$ENDIF VCL} + +procedure TProductFrame.TreeViewMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + Node: TTreeNode; +begin + with TTreeView(Sender) do + begin + Node := GetNodeAt(X, Y); + if (Button = mbLeft) and TreeNodeIconHit(TreeView, X, Y{$IFDEF VisualCLX}, Node{$ENDIF}) then + ToggleNodeChecked(Node); + end; +end; + +procedure TProductFrame.UpdateTree; +var + Node: TTreeNode; +begin + Node := TreeView.Items.GetFirstNode; + while Node <> nil do + begin + if not Collapsable(Node) then + Node.Expand(False); + Node := Node.GetNext; + end; +end; + +procedure TProductFrame.StartCompilation(Installation: TJclBorRADToolInstallation); +begin + {$IFDEF VCL} + if not Assigned(FormCompile) then + FormCompile := TFormCompile.Create(Self); + {$IFDEF MSWINDOWS} + SetWindowLong(FormCompile.Handle, GWL_HWNDPARENT, Handle); + {$ENDIF MSWINDOWS} + FormCompile.Init(Installation.Name, True); + FormCompile.Show; + Application.ProcessMessages; + {$ENDIF VCL} +end; + +procedure TProductFrame.StopCompilation(Installation: TJclBorRADToolInstallation); +begin + {$IFDEF VCL} + if FormCompile.Errors > 0 then // do not make the dialog modal when no error occured + FormCompile.Done(' ') + else + FormCompile.Done; + FormCompile.Free; + FormCompile := nil; + {$ENDIF VCL} +end; + +end. diff --git a/official/1.96/install/prototypes/jpp.sh b/official/1.96/install/prototypes/jpp.sh new file mode 100644 index 0000000..ea40341 --- /dev/null +++ b/official/1.96/install/prototypes/jpp.sh @@ -0,0 +1,17 @@ +#!/bin/sh + +# +# shell script to generate installer units from prototypes +# +# Robert Rossmair, 2004-02-16 +# +# $Id: jpp.sh,v 1.8 2004/12/03 17:43:23 rrossmair Exp $ + +JPP=../../devtools/jpp +CLXOPTIONS="-c -dVisualCLX -dHAS_UNIT_TYPES -uDevelop -uVCL -x../Q" +VCLOPTIONS="-c -dVCL -dMSWINDOWS -uDevelop -uVisualCLX -uHAS_UNIT_LIBC -uUnix -uLinux -uKYLIX -x../" +FILES="ProductFrames.pas JediInstallerMain.pas" + +chmod a+x $JPP >/dev/null 2>/dev/null +$JPP $CLXOPTIONS $FILES +$JPP $VCLOPTIONS $FILES diff --git a/official/1.96/lib/c5/debug/dirinfo.txt b/official/1.96/lib/c5/debug/dirinfo.txt new file mode 100644 index 0000000..9104cc5 --- /dev/null +++ b/official/1.96/lib/c5/debug/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for debug library files of BCB 5 packages. diff --git a/official/1.96/lib/c5/dirinfo.txt b/official/1.96/lib/c5/dirinfo.txt new file mode 100644 index 0000000..76cd5a5 --- /dev/null +++ b/official/1.96/lib/c5/dirinfo.txt @@ -0,0 +1,3 @@ +This directory is intended as a common place for .bpi and .lib files of BCB 5 packages. + +windows.exc: List of BCB 5 incompatible files in $(JCL)/source/windows; exclude from compilation. \ No newline at end of file diff --git a/official/1.96/lib/c5/obj/dirinfo.txt b/official/1.96/lib/c5/obj/dirinfo.txt new file mode 100644 index 0000000..5a244fb --- /dev/null +++ b/official/1.96/lib/c5/obj/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for .obj files of BCB 5 packages. \ No newline at end of file diff --git a/official/1.96/lib/c5/windows.exc b/official/1.96/lib/c5/windows.exc new file mode 100644 index 0000000..887cfa2 --- /dev/null +++ b/official/1.96/lib/c5/windows.exc @@ -0,0 +1,4 @@ +JclDotNet.pas +mscoree_TLB.pas +mscorlib_TLB.pas +JclWideFormat.pas diff --git a/official/1.96/lib/c6/debug/dirinfo.txt b/official/1.96/lib/c6/debug/dirinfo.txt new file mode 100644 index 0000000..1073da0 --- /dev/null +++ b/official/1.96/lib/c6/debug/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for debug library files of BCB 6 packages. diff --git a/official/1.96/lib/c6/dirinfo.txt b/official/1.96/lib/c6/dirinfo.txt new file mode 100644 index 0000000..c8a7123 --- /dev/null +++ b/official/1.96/lib/c6/dirinfo.txt @@ -0,0 +1,3 @@ +This directory is intended as a common place for .bpi and .lib files of BCB 6 packages. + +windows.exc: List of BCB 6 incompatible files in $(JCL)/source/windows; exclude from compilation. \ No newline at end of file diff --git a/official/1.96/lib/c6/obj/dirinfo.txt b/official/1.96/lib/c6/obj/dirinfo.txt new file mode 100644 index 0000000..2b6adfb --- /dev/null +++ b/official/1.96/lib/c6/obj/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for .obj files of BCB 6 packages. \ No newline at end of file diff --git a/official/1.96/lib/c6/windows.exc b/official/1.96/lib/c6/windows.exc new file mode 100644 index 0000000..887cfa2 --- /dev/null +++ b/official/1.96/lib/c6/windows.exc @@ -0,0 +1,4 @@ +JclDotNet.pas +mscoree_TLB.pas +mscorlib_TLB.pas +JclWideFormat.pas diff --git a/official/1.96/lib/cs1/dirinfo.txt b/official/1.96/lib/cs1/dirinfo.txt new file mode 100644 index 0000000..dea1c7e --- /dev/null +++ b/official/1.96/lib/cs1/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for .dcu files of C#Builder 1 packages. \ No newline at end of file diff --git a/official/1.96/lib/d10.net/dirinfo.txt b/official/1.96/lib/d10.net/dirinfo.txt new file mode 100644 index 0000000..c4e5af3 --- /dev/null +++ b/official/1.96/lib/d10.net/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended a common place for .dcuil files of Delphi 2006 .NET packages. \ No newline at end of file diff --git a/official/1.96/lib/d10/debug/dirinfo.txt b/official/1.96/lib/d10/debug/dirinfo.txt new file mode 100644 index 0000000..1bbf133 --- /dev/null +++ b/official/1.96/lib/d10/debug/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for debug .dcu files of Delphi 10 packages. diff --git a/official/1.96/lib/d10/dirinfo.txt b/official/1.96/lib/d10/dirinfo.txt new file mode 100644 index 0000000..68006d3 --- /dev/null +++ b/official/1.96/lib/d10/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for .dcu files of Delphi 10 packages. \ No newline at end of file diff --git a/official/1.96/lib/d5/debug/dirinfo.txt b/official/1.96/lib/d5/debug/dirinfo.txt new file mode 100644 index 0000000..e3535de --- /dev/null +++ b/official/1.96/lib/d5/debug/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for debug .dcu files of Delphi 5 packages. diff --git a/official/1.96/lib/d5/dirinfo.txt b/official/1.96/lib/d5/dirinfo.txt new file mode 100644 index 0000000..97f2b66 --- /dev/null +++ b/official/1.96/lib/d5/dirinfo.txt @@ -0,0 +1,3 @@ +This directory is intended as a common place for .dcu files of Delphi 5 packages. + +windows.exc: List of D5-incompatible files in $(JCL)/source/windows; exclude from compilation. \ No newline at end of file diff --git a/official/1.96/lib/d5/windows.exc b/official/1.96/lib/d5/windows.exc new file mode 100644 index 0000000..da05486 --- /dev/null +++ b/official/1.96/lib/d5/windows.exc @@ -0,0 +1,3 @@ +JclDotNet.pas +mscoree_TLB.pas +mscorlib_TLB.pas \ No newline at end of file diff --git a/official/1.96/lib/d6/debug/dirinfo.txt b/official/1.96/lib/d6/debug/dirinfo.txt new file mode 100644 index 0000000..abf8d9b --- /dev/null +++ b/official/1.96/lib/d6/debug/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for debug .dcu files of Delphi 6 packages. diff --git a/official/1.96/lib/d6/dirinfo.txt b/official/1.96/lib/d6/dirinfo.txt new file mode 100644 index 0000000..512c0a3 --- /dev/null +++ b/official/1.96/lib/d6/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for .dcu files of Delphi 6 packages. \ No newline at end of file diff --git a/official/1.96/lib/d6/windows.exc b/official/1.96/lib/d6/windows.exc new file mode 100644 index 0000000..8806367 --- /dev/null +++ b/official/1.96/lib/d6/windows.exc @@ -0,0 +1 @@ +JclDotNet.pas=STD \ No newline at end of file diff --git a/official/1.96/lib/d7/debug/dirinfo.txt b/official/1.96/lib/d7/debug/dirinfo.txt new file mode 100644 index 0000000..bf25cf5 --- /dev/null +++ b/official/1.96/lib/d7/debug/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for debug .dcu files of Delphi 7 packages. diff --git a/official/1.96/lib/d7/dirinfo.txt b/official/1.96/lib/d7/dirinfo.txt new file mode 100644 index 0000000..4cbba17 --- /dev/null +++ b/official/1.96/lib/d7/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended a common place for .dcu files of Delphi 7 packages. \ No newline at end of file diff --git a/official/1.96/lib/d7/windows.exc b/official/1.96/lib/d7/windows.exc new file mode 100644 index 0000000..8806367 --- /dev/null +++ b/official/1.96/lib/d7/windows.exc @@ -0,0 +1 @@ +JclDotNet.pas=STD \ No newline at end of file diff --git a/official/1.96/lib/d8/dirinfo.txt b/official/1.96/lib/d8/dirinfo.txt new file mode 100644 index 0000000..bd4d0cb --- /dev/null +++ b/official/1.96/lib/d8/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for .dcu files of Delphi 8 packages. \ No newline at end of file diff --git a/official/1.96/lib/d9.net/dirinfo.txt b/official/1.96/lib/d9.net/dirinfo.txt new file mode 100644 index 0000000..117c64f --- /dev/null +++ b/official/1.96/lib/d9.net/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended a common place for .dcuil files of Delphi 2005 .NET packages. \ No newline at end of file diff --git a/official/1.96/lib/d9/debug/dirinfo.txt b/official/1.96/lib/d9/debug/dirinfo.txt new file mode 100644 index 0000000..a94ce2f --- /dev/null +++ b/official/1.96/lib/d9/debug/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for debug .dcu files of Delphi 2005 packages. diff --git a/official/1.96/lib/d9/dirinfo.txt b/official/1.96/lib/d9/dirinfo.txt new file mode 100644 index 0000000..1af2ae5 --- /dev/null +++ b/official/1.96/lib/d9/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended a common place for compiled files of Delphi 2005 packages. \ No newline at end of file diff --git a/official/1.96/lib/d9/windows.exc b/official/1.96/lib/d9/windows.exc new file mode 100644 index 0000000..b48c611 --- /dev/null +++ b/official/1.96/lib/d9/windows.exc @@ -0,0 +1 @@ +JclDotNet.pas=STD diff --git a/official/1.96/lib/dirinfo.txt b/official/1.96/lib/dirinfo.txt new file mode 100644 index 0000000..3d98d7f --- /dev/null +++ b/official/1.96/lib/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for compiled units. \ No newline at end of file diff --git a/official/1.96/lib/k3/debug/dirinfo.txt b/official/1.96/lib/k3/debug/dirinfo.txt new file mode 100644 index 0000000..ebf6c06 --- /dev/null +++ b/official/1.96/lib/k3/debug/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for debug units of Kylix 3 packages. \ No newline at end of file diff --git a/official/1.96/lib/k3/dirinfo.txt b/official/1.96/lib/k3/dirinfo.txt new file mode 100644 index 0000000..67590ec --- /dev/null +++ b/official/1.96/lib/k3/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for compiled units of Kylix 3 packages. \ No newline at end of file diff --git a/official/1.96/lib/k3/obj/dirinfo.txt b/official/1.96/lib/k3/obj/dirinfo.txt new file mode 100644 index 0000000..aa77e35 --- /dev/null +++ b/official/1.96/lib/k3/obj/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for .obj files of Kylix 3/C++ packages. \ No newline at end of file diff --git a/official/1.96/makedist.sh b/official/1.96/makedist.sh new file mode 100644 index 0000000..3ac00f5 --- /dev/null +++ b/official/1.96/makedist.sh @@ -0,0 +1,5 @@ +./clean.sh +cd .. +tar --create --exclude-from=jcl/dist-excludes --file=jcl/dist/JCL$1.tar.gz jcl --gzip +tar --create --file=jcl/dist/JCLx$1-Help.tar.gz jcl/help --gzip +cd jcl \ No newline at end of file diff --git a/official/1.96/packages/BCB.bmk b/official/1.96/packages/BCB.bmk new file mode 100644 index 0000000..e5f40d9 --- /dev/null +++ b/official/1.96/packages/BCB.bmk @@ -0,0 +1,224 @@ +# --------------------------------------------------------------------------- +BCB = $(MAKEDIR)\.. + +DCCOPT = $(DCCOPT) -N1"$(HPPDIR)" + +# --------------------------------------------------------------------------- +# 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 = %VERSION% +# --------------------------------------------------------------------------- +PROJECT = %PROJECT% +OBJFILES = %OBJFILES% +RESFILES = %RESFILES% +MAINSOURCE = %MAINSOURCE% +RESDEPEN = %RESDEPEN% +LIBFILES = %LIBFILES% +IDLFILES = %IDLFILES% +IDLGENFILES = %IDLGENFILES% +LIBRARIES = %LIBRARIES% +PACKAGES = %PACKAGES% +SPARELIBS = %SPARELIBS% +DEFFILE = %DEFFILE% +OTHERFILES = %OTHERFILES% +# --------------------------------------------------------------------------- +DEBUGLIBPATH = %DEBUGLIBPATH% +RELEASELIBPATH = %RELEASELIBPATH% +USERDEFINES = %USERDEFINES% +SYSDEFINES = %SYSDEFINES% +INCLUDEPATH = %INCLUDEPATH% +LIBPATH = %LIBPATH% +WARNINGS= %WARNINGS% +PATHCPP = %PATHCPP% +PATHASM = %PATHASM% +PATHPAS = %PATHPAS% +PATHRC = %PATHRC% +PATHOBJ = .;$(LIBPATH) +# --------------------------------------------------------------------------- +CFLAG1 = %CFLAG1% +IDLCFLAGS = %IDLCFLAGS% +PFLAGS = %PFLAGS% +RFLAGS = %RFLAGS% +AFLAGS = %AFLAGS% +LFLAGS = %LFLAGS% +# --------------------------------------------------------------------------- +ALLOBJ = %ALLOBJ% +ALLRES = %ALLRES% +ALLLIB = %ALLLIB% +# --------------------------------------------------------------------------- +!ifdef IDEOPTIONS + +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 + +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= + +[Debugging] +DebugSourceDirs=$(BCB)\source\vcl + +!endif +%FILE:.c.cpp.cc:.obj:OBJFILES% +%TARGET%: %DEPENDENCY% + $(BCB)\BIN\$(BCC32) $(CFLAG1) %CFLAG1% %WARNOPTSTR% [-I]%INCLUDEPATH%?$(INCLUDEPATH) [-D]%USERDEFINES%?$(USERDEFINES) -D$(SYSDEFINES) -n$(@D) {$** } + +%END FILE% +%FILE:idl2cpp% +%TOOL% +!if !$d(IDL2CPP) +IDL2CPP = idl2cpp +!endif + +%END TOOL% +!if "$(USERDEFINES)" != "" +DUSERDEFINES = -D$(USERDEFINES:;= -D) +!else +DUSERDEFINES = +!endif +!if "$(SYSDEFINES)" != "" +DSYSDEFINES = -D$(SYSDEFINES:;= -D) +!else +DSYSDEFINES = +!endif +%DEPENDENTS%: %DEPENDENCY% + $(IDL2CPP) $(IDLCFLAGS) %IDLCFLAGS% %IDLROOTDIR% $(DUSERDEFINES) $(DSYSDEFINES) $? + +%END FILE% +%FILE:.asm:.obj:OBJFILES% +%TARGET%: %DEPENDENCY% + $(BCB)\BIN\$(TASM32) $(AFLAGS) %AFLAGS% [-i]%INCLUDEPATH:;= -i%?$(INCLUDEPATH:;= -i) [-d]%USERDEFINES:;= -d%?$(USERDEFINES:;= -d) -d$(SYSDEFINES:;= -d) $**, $@ + +%END FILE% +%FILE:.rc:.res:RESFILES% +%TARGET%: %DEPENDENCY% + $(BCB)\BIN\$(BRCC32) $(RFLAGS) %RFLAGS% [-i]%INCLUDEPATH%?$(INCLUDEPATH) [-d]%USERDEFINES%?$(USERDEFINES) -d$(SYSDEFINES:;= -d) -fo$@ $** + +%END FILE% + +# --------------------------------------------------------------------------- +# 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 "$(USERDEFINES)" != "" +AUSERDEFINES = -d$(USERDEFINES:;= -d) +!else +AUSERDEFINES = +!endif + +!if !$d(BCC32) +BCC32 = bcc32 +!endif + +!if !$d(CPP32) +CPP32 = cpp32 +!endif + +!if !$d(DCC32) +DCC32 = dcc32 +!endif + +!if !$d(TASM32) +TASM32 = tasm32 +!endif + +!if !$d(LINKER) +LINKER = ilink32 +!endif + +!if !$d(BRCC32) +BRCC32 = brcc32 +!endif + +%TOOLS% +# --------------------------------------------------------------------------- +!if $d(PATHCPP) +.PATH.CPP = $(PATHCPP) +.PATH.C = $(PATHCPP) +!endif + +!if $d(PATHPAS) +.PATH.PAS = $(PATHPAS) +!endif + +!if $d(PATHASM) +.PATH.ASM = $(PATHASM) +!endif + +!if $d(PATHRC) +.PATH.RC = $(PATHRC) +!endif + +!if $d(PATHOBJ) +.PATH.OBJ = $(PATHOBJ) +!endif +# --------------------------------------------------------------------------- +$(PROJECT): $(OTHERFILES) $(IDLGENFILES) $(OBJFILES) $(RESDEPEN) $(DEFFILE) + "$(BCB)\BIN\$(LINKER)" @&&! + $(LFLAGS) $(MAPFLAGS) -l"$(BPILIBDIR)" -L"$(LIBPATH);$(BPILIBDIR)" + + $(ALLOBJ), + + "$(BPLDIR)\$(PROJECT)",, + + $(ALLLIB), + + $(DEFFILE), + + $(ALLRES) +! +# --------------------------------------------------------------------------- +.pas.hpp: + "$(BCB)\BIN\$(DCC32)" $(DCCOPT) $(PFLAGS) -I$(INCLUDEPATH) $(ADDFLAGS) -R$(LIBPATH) -U$(INCLUDEPATH) -U$(BCB)\Lib\Obj -D$(USERDEFINES);$(SYSDEFINES) -O$(INCLUDEPATH) --BCB {$< } + +.pas.obj: + "$(BCB)\BIN\$(DCC32)" $(DCCOPT) $(PFLAGS) -I$(INCLUDEPATH) $(ADDFLAGS) -R$(LIBPATH) -U$(INCLUDEPATH) -U$(BCB)\Lib\Obj -D$(USERDEFINES);$(SYSDEFINES) -O$(INCLUDEPATH) --BCB {$< } + +.cpp.obj: + "$(BCB)\BIN\$(BCC32)" $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n$(@D) {$< } + +.c.obj: + "$(BCB)\BIN\$(BCC32)" $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n$(@D) {$< } + +.c.i: + "$(BCB)\BIN\$(CPP32)" $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n. {$< } + +.cpp.i: + "$(BCB)\BIN\$(CPP32)" $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n. {$< } + +.asm.obj: + "$(BCB)\BIN\$(TASM32)" $(AFLAGS) -i$(INCLUDEPATH:;= -i) $(AUSERDEFINES) -d$(SYSDEFINES:;= -d) $<, $@ + +.rc.res: + "$(BCB)\BIN\$(BRCC32)" $(RFLAGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $< + +%BUILDTOOLS% + +# --------------------------------------------------------------------------- + +%FILES% + + diff --git a/official/1.96/packages/JclDevPackagesD50.bpg b/official/1.96/packages/JclDevPackagesD50.bpg new file mode 100644 index 0000000..638711c --- /dev/null +++ b/official/1.96/packages/JclDevPackagesD50.bpg @@ -0,0 +1,33 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = DJCL50.bpl IdeOpenDlgFavoriteD50.bpl JclDebugIdeD50.bpl \ + ProjectAnalyzerD50.bpl ThreadNameExpertD50.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +DJCL50.bpl: d5.dev\DJCL50.dpk + $(DCC) + +JclDebugIdeD50.bpl: ..\examples\vcl\debugextension\JclDebugIdeD50.dpk + $(DCC) + +ThreadNameExpertD50.bpl: ..\examples\vcl\debugextension\threadnames\ThreadNameExpertD50.dpk + $(DCC) + +ProjectAnalyzerD50.bpl: ..\examples\vcl\projectanalyzer\ProjectAnalyzerD50.dpk + $(DCC) + +IdeOpenDlgFavoriteD50.bpl: ..\examples\vcl\idefavopendialogs\IdeOpenDlgFavoriteD50.dpk + $(DCC) + + diff --git a/official/1.96/packages/JclDevPackagesD60.bpg b/official/1.96/packages/JclDevPackagesD60.bpg new file mode 100644 index 0000000..ff001c1 --- /dev/null +++ b/official/1.96/packages/JclDevPackagesD60.bpg @@ -0,0 +1,39 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = DJcl60.bpl DJclVcl60.bpl DJclVClx60.bpl IdeOpenDlgFavoriteD60.bpl \ + JclDebugIdeD60.bpl ProjectAnalyzerD60.bpl ThreadNameExpertD60.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + + +DJcl60.bpl: D6\DJcl.dpk + $(DCC) + +DJclVcl60.bpl: D6.dev\DJclVcl.dpk + $(DCC) + +DJclVClx60.bpl: D6.dev\DJclVClx.dpk + $(DCC) + +JclDebugIdeD60.bpl: ..\examples\vcl\debugextension\JclDebugIdeD60.dpk + $(DCC) + +ThreadNameExpertD60.bpl: ..\examples\vcl\debugextension\threadnames\ThreadNameExpertD60.dpk + $(DCC) + +ProjectAnalyzerD60.bpl: ..\examples\vcl\projectanalyzer\ProjectAnalyzerD60.dpk + $(DCC) + +IdeOpenDlgFavoriteD60.bpl: ..\examples\vcl\idefavopendialogs\IdeOpenDlgFavoriteD60.dpk + $(DCC) + diff --git a/official/1.96/packages/JclDevPackagesD70.bpg b/official/1.96/packages/JclDevPackagesD70.bpg new file mode 100644 index 0000000..fda11b5 --- /dev/null +++ b/official/1.96/packages/JclDevPackagesD70.bpg @@ -0,0 +1,37 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = DJcl70.bpl DJclVcl70.bpl DJclVClx70.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +DJcl70.bpl: D7\DJcl.dpk + $(DCC) + +DJclVcl70.bpl: D7.dev\DJclVcl.dpk + $(DCC) + +DJclVClx70.bpl: D7.dev\DJclVClx.dpk + $(DCC) + +JclDebugIdeD70.bpl: ..\examples\vcl\debugextension\JclDebugIdeD70.dpk + $(DCC) + +ThreadNameExpertD70.bpl: ..\examples\vcl\debugextension\threadnames\ThreadNameExpertD70.dpk + $(DCC) + +ProjectAnalyzerD70.bpl: ..\examples\vcl\projectanalyzer\ProjectAnalyzerD70.dpk + $(DCC) + +IdeOpenDlgFavoriteD70.bpl: ..\examples\vcl\idefavopendialogs\IdeOpenDlgFavoriteD70.dpk + $(DCC) + diff --git a/official/1.96/packages/JclDevPackagesD90.bdsgroup b/official/1.96/packages/JclDevPackagesD90.bdsgroup new file mode 100644 index 0000000..5569af8 --- /dev/null +++ b/official/1.96/packages/JclDevPackagesD90.bdsgroup @@ -0,0 +1,20 @@ + + + + + + + + + + + + + D9\DJcl.bdsproj + D9.dev\DJclVcl.bdsproj + DJcl90.bpl DJclVcl90.bpl + + + + diff --git a/official/1.96/packages/JclDevPackagesDK3.bpg b/official/1.96/packages/JclDevPackagesDK3.bpg new file mode 100644 index 0000000..eca5148 --- /dev/null +++ b/official/1.96/packages/JclDevPackagesDK3.bpg @@ -0,0 +1,24 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.02.5 +#------------------------------------------------------------------------------ +ifndef ROOT +ROOT = /usr/local/kylix3 +endif +#------------------------------------------------------------------------------ +MAKE = make -$(MAKEFLAGS) -f$** +DCC =dcc $< +#------------------------------------------------------------------------------ +PROJECTS = bplDJclK3.so.1.95.1 bplDJclVClxK3.so.1.95.1 +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + + + +bplDJclK3.so.1.95.1: k3/DJcl.dpk + $(DCC) + +bplDJclVClxK3.so.1.95.1: k3.dev/DJclVClx.dpk + $(DCC) + + diff --git a/official/1.96/packages/JclPackagesC50.bpg b/official/1.96/packages/JclPackagesC50.bpg new file mode 100644 index 0000000..f82d604 --- /dev/null +++ b/official/1.96/packages/JclPackagesC50.bpg @@ -0,0 +1,36 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = CJcl50.bpl IdeOpenDlgFavoriteC50.bpl JclDebugIdeC50.bpl \ + ThreadNameExpertC50.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + + + +CJcl50.bpl: c5\CJcl50.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + +IdeOpenDlgFavoriteC50.bpl: ..\examples\vcl\idefavopendialogs\IdeOpenDlgFavoriteC50.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + +JclDebugIdeC50.bpl: ..\examples\vcl\debugextension\JclDebugIdeC50.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + +ThreadNameExpertC50.bpl: ..\examples\vcl\debugextension\threadnames\ThreadNameExpertC50.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + + diff --git a/official/1.96/packages/JclPackagesC60.bpg b/official/1.96/packages/JclPackagesC60.bpg new file mode 100644 index 0000000..af52b5e --- /dev/null +++ b/official/1.96/packages/JclPackagesC60.bpg @@ -0,0 +1,44 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = CJcl60.bpl CJclVcl60.bpl CJclVClx60.bpl IdeOpenDlgFavoriteC60.bpl \ + JclDebugIdeC60.bpl ThreadNameExpertC60.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + + + +CJcl60.bpl: c6\CJcl.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + +CJclVcl60.bpl: c6\CJclVcl.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + +CJclVClx60.bpl: c6\CJclVClx.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + +IdeOpenDlgFavoriteC60.bpl: ..\examples\vcl\idefavopendialogs\IdeOpenDlgFavoriteC60.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + +JclDebugIdeC60.bpl: ..\examples\vcl\debugextension\JclDebugIdeC60.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + +ThreadNameExpertC60.bpl: ..\examples\vcl\debugextension\threadnames\ThreadNameExpertC60.bpk + $(ROOT)\bin\bpr2mak $** + $(ROOT)\bin\make -$(MAKEFLAGS) -f$*.mak + + diff --git a/official/1.96/packages/JclPackagesCK3.bpg b/official/1.96/packages/JclPackagesCK3.bpg new file mode 100644 index 0000000..346499c --- /dev/null +++ b/official/1.96/packages/JclPackagesCK3.bpg @@ -0,0 +1,24 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.02.5 +#------------------------------------------------------------------------------ +ifndef ROOT +ROOT = /home/kylix/kylix3 +endif +#------------------------------------------------------------------------------ +MAKE = make -$(MAKEFLAGS) -f$** +DCC =dcc $< +#------------------------------------------------------------------------------ +PROJECTS = bplCJclK3.so.1.90.0 bplCJclVClxK3.so.1.90.0 +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +bplCJclK3.so.1.90.0: k3/CJcl.bpk + $(ROOT)/bin/bpr2mak $< + make -$(MAKEFLAGS) -f$(basename $<).mak + +bplCJclVClxK3.so.1.90.0: k3/CJclVClx.bpk + $(ROOT)/bin/bpr2mak $< + make -$(MAKEFLAGS) -f$(basename $<).mak + + diff --git a/official/1.96/packages/JclPackagesD100.bdsgroup b/official/1.96/packages/JclPackagesD100.bdsgroup new file mode 100644 index 0000000..29be701 --- /dev/null +++ b/official/1.96/packages/JclPackagesD100.bdsgroup @@ -0,0 +1,28 @@ + + + + + + + + + + + ..\install\JediInstaller.bdsproj + ..\..\JVCL\JVCL3\devtools\PackagesGenerator\pgEdit.bdsproj + ..\..\JVCL\JVCL3\devtools\PackagesGenerator\pg.bdsproj + ..\..\JVCL\JVCL3\install\JVCLInstall\JVCLInstall.bdsproj + d10\Jcl.bdsproj + d10\JclBaseExpert.bdsproj + d10\JclDebugExpert.bdsproj + d10\JclFavoriteFoldersExpert.bdsproj + d10\JclProjectAnalysisExpert.bdsproj + d10\JclSIMDViewExpert.bdsproj + d10\JclUsesExpert.bdsproj + d10\JclThreadNameExpert.bdsproj + JediInstaller.exe pgEdit.exe pg.exe JVCLInstall.exe Jcl100.bpl JclBaseExpert100.bpl JclDebugExpert100.bpl JclFavoriteFoldersExpert100.bpl JclProjectAnalysisExpert100.bpl JclSIMDViewExpert100.bpl JclUsesExpert100.bpl JclThreadNameExpert100.bpl + + + + diff --git a/official/1.96/packages/JclPackagesD50.bpg b/official/1.96/packages/JclPackagesD50.bpg new file mode 100644 index 0000000..af11861 --- /dev/null +++ b/official/1.96/packages/JclPackagesD50.bpg @@ -0,0 +1,33 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = DJCL50.bpl IdeOpenDlgFavoriteD50.bpl JclDebugIdeD50.bpl \ + ProjectAnalyzerD50.bpl ThreadNameExpertD50.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +DJCL50.bpl: d5\DJCL50.dpk + $(DCC) + +JclDebugIdeD50.bpl: ..\examples\vcl\debugextension\JclDebugIdeD50.dpk + $(DCC) + +ThreadNameExpertD50.bpl: ..\examples\vcl\debugextension\threadnames\ThreadNameExpertD50.dpk + $(DCC) + +ProjectAnalyzerD50.bpl: ..\examples\vcl\projectanalyzer\ProjectAnalyzerD50.dpk + $(DCC) + +IdeOpenDlgFavoriteD50.bpl: ..\examples\vcl\idefavopendialogs\IdeOpenDlgFavoriteD50.dpk + $(DCC) + + diff --git a/official/1.96/packages/JclPackagesD60.bpg b/official/1.96/packages/JclPackagesD60.bpg new file mode 100644 index 0000000..10a0316 --- /dev/null +++ b/official/1.96/packages/JclPackagesD60.bpg @@ -0,0 +1,46 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = DJcl60.bpl DJclVcl60.bpl DJclVClx60.bpl IdeOpenDlgFavoriteD60.bpl JclDebugIdeD60.bpl \ + ProjectAnalyzerD60.bpl ThreadNameExpertD60.bpl JclSIMDViewD6.bpl JediUsesD60.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + + +DJcl60.bpl: D6\DJcl.dpk + $(DCC) + +DJclVcl60.bpl: D6\DJclVcl.dpk + $(DCC) + +DJclVClx60.bpl: D6\DJclVClx.dpk + $(DCC) + +JclDebugIdeD60.bpl: ..\examples\vcl\debugextension\JclDebugIdeD60.dpk + $(DCC) + +ThreadNameExpertD60.bpl: ..\examples\vcl\debugextension\threadnames\ThreadNameExpertD60.dpk + $(DCC) + +ProjectAnalyzerD60.bpl: ..\examples\vcl\projectanalyzer\ProjectAnalyzerD60.dpk + $(DCC) + +IdeOpenDlgFavoriteD60.bpl: ..\examples\vcl\idefavopendialogs\IdeOpenDlgFavoriteD60.dpk + $(DCC) + +JclSIMDViewD6.bpl: ..\examples\vcl\debugextension\SIMDView\JclSIMDViewD6.dpk + $(DCC) + +JediUsesD60.bpl: ..\examples\vcl\JUW\JediUsesD60.dpk + $(DCC) + + diff --git a/official/1.96/packages/JclPackagesD70.bpg b/official/1.96/packages/JclPackagesD70.bpg new file mode 100644 index 0000000..96f55f9 --- /dev/null +++ b/official/1.96/packages/JclPackagesD70.bpg @@ -0,0 +1,42 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = DJcl70.bpl DJclVcl70.bpl DJclVClx70.bpl IdeOpenDlgFavoriteD70.bpl JclDebugIdeD70.bpl \ + ProjectAnalyzerD70.bpl JclSIMDViewD7.bpl JediUsesD70.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +DJcl70.bpl: D7\DJcl.dpk + $(DCC) + +DJclVcl70.bpl: D7\DJclVcl.dpk + $(DCC) + +DJclVClx70.bpl: D7\DJclVClx.dpk + $(DCC) + +JclDebugIdeD70.bpl: ..\examples\vcl\debugextension\JclDebugIdeD70.dpk + $(DCC) + +ProjectAnalyzerD70.bpl: ..\examples\vcl\projectanalyzer\ProjectAnalyzerD70.dpk + $(DCC) + +IdeOpenDlgFavoriteD70.bpl: ..\examples\vcl\idefavopendialogs\IdeOpenDlgFavoriteD70.dpk + $(DCC) + +JclSIMDViewD7.bpl: ..\examples\vcl\debugextension\SIMDView\JclSIMDViewD7.dpk + $(DCC) + +JediUsesD70.bpl: ..\examples\vcl\JUW\JediUsesD70.dpk + $(DCC) + + diff --git a/official/1.96/packages/JclPackagesD90.bdsgroup b/official/1.96/packages/JclPackagesD90.bdsgroup new file mode 100644 index 0000000..82a1e45 --- /dev/null +++ b/official/1.96/packages/JclPackagesD90.bdsgroup @@ -0,0 +1,13 @@ + + + + + + + + + + + d9\DJcl.bdsprojd9\DJclVcl.bdsproj..\examples\vcl\debugextension\JclDebugIdeD90.bdsproj..\examples\vcl\debugextension\SIMDView\JclSIMDViewD9.bdsproj..\examples\vcl\idefavopendialogs\IdeOpenDlgFavoriteD90.bdsproj..\examples\vcl\JUW\JediUsesD90.bdsproj..\examples\vcl\projectanalyzer\ProjectAnalyzerD90.bdsprojDJcl90.bpl DJclVcl90.bpl JclDebugIdeD90.bpl JclSIMDViewD9.bpl IdeOpenDlgFavoriteD90.bpl JediUsesD90.bpl ProjectAnalyzerD90.bpl + diff --git a/official/1.96/packages/JclPackagesDK3.bpg b/official/1.96/packages/JclPackagesDK3.bpg new file mode 100644 index 0000000..d1da1c5 --- /dev/null +++ b/official/1.96/packages/JclPackagesDK3.bpg @@ -0,0 +1,22 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.02.5 +#------------------------------------------------------------------------------ +ifndef ROOT +ROOT = /usr/local/kylix3 +endif +#------------------------------------------------------------------------------ +MAKE = make -$(MAKEFLAGS) -f$** +DCC =dcc -LN../lib/k3 -N../lib/k3 -U../lib/k3 $< +#------------------------------------------------------------------------------ +PROJECTS = bplDJclK3.so.1.90.0 bplDJclVClxK3.so.1.90.0 +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + + + +bplDJclK3.so.1.90.0: k3/DJcl.dpk + $(DCC) + +bplDJclVClxK3.so.1.90.0: k3/DJclVClx.dpk + $(DCC) diff --git a/official/1.96/packages/bcb.gmk b/official/1.96/packages/bcb.gmk new file mode 100644 index 0000000..616e2bf --- /dev/null +++ b/official/1.96/packages/bcb.gmk @@ -0,0 +1,187 @@ +# Hey Emacs, this is a -*- Makefile -*- +# --------------------------------------------------------------------------- +ifndef BCB +BCB = !BCB! +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 = !VERSION! +# --------------------------------------------------------------------------- +PROJECT = !PROJECT! +OBJFILES = !OBJFILES! +RESFILES = !RESFILES! +MAINSOURCE = !MAINSOURCE! +RESDEPEN = !RESDEPEN! +LIBFILES = !LIBFILES! +IDLFILES = !IDLFILES! +IDLGENFILES = !IDLGENFILES! +LIBRARIES = !LIBRARIES! +PACKAGES = !PACKAGES! +SPARELIBS = !SPARELIBS! +DEFFILE = !DEFFILE! +OTHERFILES = !OTHERFILES! +# --------------------------------------------------------------------------- +PATHCPP = !PATHCPP! +PATHASM = !PATHASM! +PATHPAS = !PATHPAS! +PATHRC = !PATHRC! +DEBUGLIBPATH = !DEBUGLIBPATH! +RELEASELIBPATH = !RELEASELIBPATH! +USERDEFINES = !USERDEFINES! +SYSDEFINES = !SYSDEFINES! +INCLUDEPATH = ../../lib/k3:!INCLUDEPATH! +LIBPATH = !LIBPATH! +WARNINGS = !WARNINGS! +PATHOBJ = .:$(LIBPATH) +# --------------------------------------------------------------------------- +CFLAG1 = !CFLAG1! +IDLCFLAGS = !IDLCFLAGS! + +BPILIBDIR = !BPILIBDIR! + +ifneq "$(BPLDIR)" "" +LIBPATH = $(BPLDIR):!LIBPATH! +BPL = $(BPLDIR)/!PROJECT! +else +BPL = !PROJECT! +endif + +BPLFILE = \"$(BPL)\" + +PFLAGS = -I../../source -N0\"$(BPILIBDIR)\" -N2\"$(OBJDIR)\" -P -$$$$Y- -$$$$L- -$$$$D- -$$$$A8 -v -JPHNE -M +RFLAGS = !RFLAGS! +AFLAGS = !AFLAGS! + +ifneq "$(BPILIBDIR)" "" +LIBPATH = $(BPILIBDIR):!LIBPATH! +endif + +LFLAGS = -l\"$(BPILIBDIR)\" -I\"$(OBJDIR)\" -GB"CJcl" -N"" -D"" -aa -Tpp -Gpr -x -Gn -Gl -Gi +# --------------------------------------------------------------------------- +ALLOBJ = !ALLOBJ! +ALLRES = !ALLRES! +ALLLIB = !ALLLIB! +# --------------------------------------------------------------------------- +ifneq "$(USERDEFINES)" "" +AUSERDEFINES = -d$(USERDEFINES:= -d) +else +AUSERDEFINES = +endif + +ifndef BCC +BCC = $(BCB)/bin/bc++ +endif + +ifndef CPP +CPP = $(BCB)/bin/bcpp +endif + +ifndef DCC +DCC = $(BCB)/bin/dcc +endif + +ifndef LINKER +LINKER = $(BCB)/bin/ilink +endif + + +!TOOLS! +# --------------------------------------------------------------------------- +ifdef PATHCPP +PATHC = $(PATHCPP) +else +PATHCPP = $(BCB)/bin +PATHC = $(BCB)/bin +endif + +ifndef PATHPAS +PATHPAS = $(BCB)/bin +endif + +ifndef PATHASM +PATHASM = $(BCB)/bin +endif + +vpath %.o $(PATHOBJ) +vpath %.pas $(PATHPAS) + +ifdef IDEOPTIONS +[Debugging] +DebugSourceDirs=$(BCB)/source/clx +endif + +!FILE:.c.cpp.cc:.o:OBJFILES! +!TARGET!: !DEPENDENCY! + $(PATHCPP)/$(BCC) $(CFLAG1) !CFLAG1! !WARNOPTSTR! [-I]!INCLUDEPATH!?$(INCLUDEPATH) [-D]!USERDEFINES!?$(USERDEFINES) -D$(SYSDEFINES) -n$(@D) {$** } + +!END FILE! +!FILE:idl2cpp! +!TOOL! +ifndef IDL2CPP +IDL2CPP = idl2cpp +endif + +!END TOOL! +ifneq "$(USERDEFINES)" "" +DUSERDEFINES = -D$(USERDEFINES:= -D) +else +DUSERDEFINES = +endif +ifneq "$(SYSDEFINES)" "" +DSYSDEFINES = -D$(SYSDEFINES:= -D) +else +DSYSDEFINES = +endif +!DEPENDENTS!: !DEPENDENCY! + $(IDL2CPP) $(IDLCFLAGS) !IDLCFLAGS! !IDLROOTDIR! $(DUSERDEFINES) $(DSYSDEFINES) $? + +!END FILE! + +# --------------------------------------------------------------------------- +# 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. +# --------------------------------------------------------------------------- +$(PROJECT): $(OTHERFILES) $(IDLGENFILES) $(OBJFILES) $(RESDEPEN) $(DEFFILE) + $(LINKER) \ + $(LFLAGS) $(MAPFLAGS) -L\"$(LIBPATH)\" \ + $(ALLOBJ), \ + $(BPLFILE),, \ + $(ALLLIB), \ + $(DEFFILE), \ + $(ALLRES) + +# --------------------------------------------------------------------------- +%.hpp: %.pas + $(DCC) $(PFLAGS) -U$(INCLUDEPATH) -D$(USERDEFINES) -D$(SYSDEFINES) -O$(INCLUDEPATH) --BCB $< + +%.o: %.pas + $(DCC) $(PFLAGS) -U$(INCLUDEPATH) -D$(USERDEFINES) -D$(SYSDEFINES) -O$(INCLUDEPATH) --BCB $< + +%.o: %.cpp + $(BCC) $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES) -D$(SYSDEFINES) -n$(@D) $< + +%.o: %.c + $(BCC) $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES) -D$(SYSDEFINES) -n$(@D) $< + +%.i: %.c + $(CPP) $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES) -D$(SYSDEFINES) -n. $< + +%.i: %.cpp + $(CPP) $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES) -D$(SYSDEFINES) -n. $< + +!BUILDTOOLS! + +# --------------------------------------------------------------------------- + +!FILES! + + diff --git a/official/1.96/packages/c5/JclBaseExpertC50.bpk b/official/1.96/packages/c5/JclBaseExpertC50.bpk new file mode 100644 index 0000000..7d56439 --- /dev/null +++ b/official/1.96/packages/c5/JclBaseExpertC50.bpk @@ -0,0 +1,83 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclBaseExpertC50.cpp b/official/1.96/packages/c5/JclBaseExpertC50.cpp new file mode 100644 index 0000000..1203b26 --- /dev/null +++ b/official/1.96/packages/c5/JclBaseExpertC50.cpp @@ -0,0 +1,33 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 08-01-2006 17:11:05 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclBaseExpertC50.res"); +USEUNIT("..\..\experts\common\JclOtaUtils.pas"); +USEUNIT("..\..\experts\common\JclOtaResources.pas"); +USEUNIT("..\..\experts\common\JclOtaConsts.pas"); +USEUNIT("..\..\experts\common\JclOtaExceptionForm.pas"); +USEUNIT("..\..\experts\common\JclOtaConfigurationForm.pas"); +USEUNIT("..\..\experts\common\JclOtaActionConfigureSheet.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclBaseExpertC50.dof b/official/1.96/packages/c5/JclBaseExpertC50.dof new file mode 100644 index 0000000..f930b72 --- /dev/null +++ b/official/1.96/packages/c5/JclBaseExpertC50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c5/JclBaseExpertC50.dpk b/official/1.96/packages/c5/JclBaseExpertC50.dpk new file mode 100644 index 0000000..918b269 --- /dev/null +++ b/official/1.96/packages/c5/JclBaseExpertC50.dpk @@ -0,0 +1,52 @@ +package JclBaseExpertC50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 08-01-2006 17:11:05 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58000000} +{$DESCRIPTION 'JCL Package containing common units for JCL Experts'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclC50 + ; + +contains + JclOtaUtils in '..\..\experts\common\JclOtaUtils.pas' , + JclOtaResources in '..\..\experts\common\JclOtaResources.pas' , + JclOtaConsts in '..\..\experts\common\JclOtaConsts.pas' , + JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm}, + JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm}, + JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame} + ; + +end. diff --git a/official/1.96/packages/c5/JclBaseExpertC50.rc b/official/1.96/packages/c5/JclBaseExpertC50.rc new file mode 100644 index 0000000..cf5ec76 --- /dev/null +++ b/official/1.96/packages/c5/JclBaseExpertC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Package containing common units for JCL Experts\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclBaseExpertC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclBaseExpertC50C50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclBaseExpertC50.res b/official/1.96/packages/c5/JclBaseExpertC50.res new file mode 100644 index 0000000..2fa48b8 Binary files /dev/null and b/official/1.96/packages/c5/JclBaseExpertC50.res differ diff --git a/official/1.96/packages/c5/JclC50.bpk b/official/1.96/packages/c5/JclC50.bpk new file mode 100644 index 0000000..d498c74 --- /dev/null +++ b/official/1.96/packages/c5/JclC50.bpk @@ -0,0 +1,156 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclC50.cpp b/official/1.96/packages/c5/JclC50.cpp new file mode 100644 index 0000000..18b4a73 --- /dev/null +++ b/official/1.96/packages/c5/JclC50.cpp @@ -0,0 +1,109 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclC50.res"); +USEUNIT("..\..\source\common\Jcl8087.pas"); +USEUNIT("..\..\source\common\JclAbstractContainers.pas"); +USEUNIT("..\..\source\common\JclAlgorithms.pas"); +USEUNIT("..\..\source\common\JclArrayLists.pas"); +USEUNIT("..\..\source\common\JclArraySets.pas"); +USEUNIT("..\..\source\common\JclBase.pas"); +USEUNIT("..\..\source\common\JclBinaryTrees.pas"); +USEUNIT("..\..\source\common\JclBorlandTools.pas"); +USEUNIT("..\..\source\common\JclComplex.pas"); +USEUNIT("..\..\source\common\JclCompression.pas"); +USEUNIT("..\..\source\common\JclContainerIntf.pas"); +USEUNIT("..\..\source\common\JclCounter.pas"); +USEUNIT("..\..\source\common\JclDateTime.pas"); +USEUNIT("..\..\source\common\JclEDI.pas"); +USEUNIT("..\..\source\common\JclEDISEF.pas"); +USEUNIT("..\..\source\common\JclEDITranslators.pas"); +USEUNIT("..\..\source\common\JclEDIXML.pas"); +USEUNIT("..\..\source\common\JclEDI_ANSIX12.pas"); +USEUNIT("..\..\source\common\JclEDI_ANSIX12_Ext.pas"); +USEUNIT("..\..\source\common\JclEDI_UNEDIFACT.pas"); +USEUNIT("..\..\source\common\JclEDI_UNEDIFACT_Ext.pas"); +USEUNIT("..\..\source\common\JclExprEval.pas"); +USEUNIT("..\..\source\common\JclFileUtils.pas"); +USEUNIT("..\..\source\common\JclHashMaps.pas"); +USEUNIT("..\..\source\common\JclHashSets.pas"); +USEUNIT("..\..\source\common\JclIniFiles.pas"); +USEUNIT("..\..\source\common\JclLinkedLists.pas"); +USEUNIT("..\..\source\common\JclLogic.pas"); +USEUNIT("..\..\source\common\JclMath.pas"); +USEUNIT("..\..\source\common\JclMIDI.pas"); +USEUNIT("..\..\source\common\JclMime.pas"); +USEUNIT("..\..\source\common\JclPCRE.pas"); +USEUNIT("..\..\source\common\JclQueues.pas"); +USEUNIT("..\..\source\common\JclResources.pas"); +USEUNIT("..\..\source\common\JclRTTI.pas"); +USEUNIT("..\..\source\common\JclSchedule.pas"); +USEUNIT("..\..\source\common\JclStacks.pas"); +USEUNIT("..\..\source\common\JclStatistics.pas"); +USEUNIT("..\..\source\common\JclStrHashMap.pas"); +USEUNIT("..\..\source\common\JclStrings.pas"); +USEUNIT("..\..\source\common\JclSysInfo.pas"); +USEUNIT("..\..\source\common\JclSysUtils.pas"); +USEUNIT("..\..\source\common\JclUnitConv.pas"); +USEUNIT("..\..\source\common\JclUnitVersioning.pas"); +USEUNIT("..\..\source\common\JclUnitVersioningProviders.pas"); +USEUNIT("..\..\source\common\JclValidation.pas"); +USEUNIT("..\..\source\common\JclVectors.pas"); +USEUNIT("..\..\source\common\JclWideStrings.pas"); +USEUNIT("..\..\source\common\pcre.pas"); +USEUNIT("..\..\source\windows\Hardlinks.pas"); +USEUNIT("..\..\source\windows\JclAppInst.pas"); +USEUNIT("..\..\source\windows\JclCIL.pas"); +USEUNIT("..\..\source\windows\JclCLR.pas"); +USEUNIT("..\..\source\windows\JclCOM.pas"); +USEUNIT("..\..\source\windows\JclConsole.pas"); +USEUNIT("..\..\source\windows\JclDebug.pas"); +USEUNIT("..\..\source\windows\JclHookExcept.pas"); +USEUNIT("..\..\source\windows\JclLANMan.pas"); +USEUNIT("..\..\source\windows\JclLocales.pas"); +USEUNIT("..\..\source\windows\JclMapi.pas"); +USEUNIT("..\..\source\windows\JclMetadata.pas"); +USEUNIT("..\..\source\windows\JclMiscel.pas"); +USEUNIT("..\..\source\windows\JclMsdosSys.pas"); +USEUNIT("..\..\source\windows\JclMultimedia.pas"); +USEUNIT("..\..\source\windows\JclNTFS.pas"); +USEUNIT("..\..\source\windows\JclPeImage.pas"); +USEUNIT("..\..\source\windows\JclRegistry.pas"); +USEUNIT("..\..\source\windows\JclSecurity.pas"); +USEUNIT("..\..\source\windows\JclShell.pas"); +USEUNIT("..\..\source\windows\JclStructStorage.pas"); +USEUNIT("..\..\source\windows\JclSvcCtrl.pas"); +USEUNIT("..\..\source\windows\JclSynch.pas"); +USEUNIT("..\..\source\windows\JclTask.pas"); +USEUNIT("..\..\source\windows\JclTD32.pas"); +USEUNIT("..\..\source\windows\JclUnicode.pas"); +USEUNIT("..\..\source\windows\JclWin32.pas"); +USEUNIT("..\..\source\windows\JclWinMIDI.pas"); +USEUNIT("..\..\source\windows\MSTask.pas"); +USEUNIT("..\..\source\windows\Snmp.pas"); +USEUNIT("..\..\source\windows\zlibh.pas"); +USEUNIT("..\..\source\vcl\JclGraphics.pas"); +USEUNIT("..\..\source\vcl\JclGraphUtils.pas"); +USEUNIT("..\..\source\vcl\JclPrint.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("vcljpg50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclC50.dof b/official/1.96/packages/c5/JclC50.dof new file mode 100644 index 0000000..f930b72 --- /dev/null +++ b/official/1.96/packages/c5/JclC50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c5/JclC50.dpk b/official/1.96/packages/c5/JclC50.dpk new file mode 100644 index 0000000..908d267 --- /dev/null +++ b/official/1.96/packages/c5/JclC50.dpk @@ -0,0 +1,128 @@ +package JclC50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + vcljpg50 + ; + +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' , + JclGraphics in '..\..\source\vcl\JclGraphics.pas' , + JclGraphUtils in '..\..\source\vcl\JclGraphUtils.pas' , + JclPrint in '..\..\source\vcl\JclPrint.pas' + ; + +end. diff --git a/official/1.96/packages/c5/JclC50.rc b/official/1.96/packages/c5/JclC50.rc new file mode 100644 index 0000000..1bd5426 --- /dev/null +++ b/official/1.96/packages/c5/JclC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclC50C50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclC50.res b/official/1.96/packages/c5/JclC50.res new file mode 100644 index 0000000..4085ecd Binary files /dev/null and b/official/1.96/packages/c5/JclC50.res differ diff --git a/official/1.96/packages/c5/JclDebugExpertC50.RES b/official/1.96/packages/c5/JclDebugExpertC50.RES new file mode 100644 index 0000000..4f84a64 Binary files /dev/null and b/official/1.96/packages/c5/JclDebugExpertC50.RES differ diff --git a/official/1.96/packages/c5/JclDebugExpertC50.bpk b/official/1.96/packages/c5/JclDebugExpertC50.bpk new file mode 100644 index 0000000..40b84ab --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertC50.bpk @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclDebugExpertC50.cpp b/official/1.96/packages/c5/JclDebugExpertC50.cpp new file mode 100644 index 0000000..2f46b93 --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertC50.cpp @@ -0,0 +1,30 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpert-D.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclDebugExpertC50.res"); +USEUNIT("..\..\experts\debug\JclDebugIdeResult.pas"); +USEUNIT("..\..\experts\debug\JclDebugIdeImpl.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclDebugExpertC50.dof b/official/1.96/packages/c5/JclDebugExpertC50.dof new file mode 100644 index 0000000..f930b72 --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertC50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c5/JclDebugExpertC50.dpk b/official/1.96/packages/c5/JclDebugExpertC50.dpk new file mode 100644 index 0000000..92e72e2 --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertC50.dpk @@ -0,0 +1,49 @@ +package JclDebugExpertC50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclC50, + JclBaseExpertC50 + ; + +contains + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +end. diff --git a/official/1.96/packages/c5/JclDebugExpertC50.rc b/official/1.96/packages/c5/JclDebugExpertC50.rc new file mode 100644 index 0000000..aa31e28 --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpertC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertC50C50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclDebugExpertDLLC50.bpf b/official/1.96/packages/c5/JclDebugExpertDLLC50.bpf new file mode 100644 index 0000000..0f0e773 --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertDLLC50.bpf @@ -0,0 +1,5 @@ +USEUNIT("..\..\experts\debug\JclDebugIdeResult.pas"); +USEUNIT("..\..\experts\debug\JclDebugIdeImpl.pas"); +USEDEF("JclDebugExpertDLLC50.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c5/JclDebugExpertDLLC50.bpr b/official/1.96/packages/c5/JclDebugExpertDLLC50.bpr new file mode 100644 index 0000000..5c27817 --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertDLLC50.bpr @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclDebugExpertDLLC50.cpp b/official/1.96/packages/c5/JclDebugExpertDLLC50.cpp new file mode 100644 index 0000000..c05d8eb --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertDLLC50.cpp @@ -0,0 +1,30 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpertDLL-L.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclDebugExpertDLLC50.res"); +USEUNIT("..\..\experts\debug\JclDebugIdeResult.pas"); +USEUNIT("..\..\experts\debug\JclDebugIdeImpl.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclDebugExpertDLLC50.dof b/official/1.96/packages/c5/JclDebugExpertDLLC50.dof new file mode 100644 index 0000000..2290b72 --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertDLLC50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclC50;JclBaseExpertC50 + diff --git a/official/1.96/packages/c5/JclDebugExpertDLLC50.rc b/official/1.96/packages/c5/JclDebugExpertDLLC50.rc new file mode 100644 index 0000000..cd495ef --- /dev/null +++ b/official/1.96/packages/c5/JclDebugExpertDLLC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpertDLLC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertDLLC50C50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclDebugExpertDLLC50.res b/official/1.96/packages/c5/JclDebugExpertDLLC50.res new file mode 100644 index 0000000..fc37a42 Binary files /dev/null and b/official/1.96/packages/c5/JclDebugExpertDLLC50.res differ diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.bpk b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.bpk new file mode 100644 index 0000000..6ca996d --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.bpk @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.cpp b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.cpp new file mode 100644 index 0000000..203b0fb --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.cpp @@ -0,0 +1,30 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpert-D.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclFavoriteFoldersExpertC50.res"); +USEUNIT("..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas"); +USEUNIT("..\..\experts\favfolders\OpenDlgFavAdapter.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.dof b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.dof new file mode 100644 index 0000000..f930b72 --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.dpk b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.dpk new file mode 100644 index 0000000..3a145f8 --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.dpk @@ -0,0 +1,49 @@ +package JclFavoriteFoldersExpertC50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclC50, + JclBaseExpertC50 + ; + +contains + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +end. diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.rc b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.rc new file mode 100644 index 0000000..1f8c503 --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertC50C50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.res b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.res new file mode 100644 index 0000000..83e3cf5 Binary files /dev/null and b/official/1.96/packages/c5/JclFavoriteFoldersExpertC50.res differ diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.bpf b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.bpf new file mode 100644 index 0000000..03adce8 --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.bpf @@ -0,0 +1,5 @@ +USEUNIT("..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas"); +USEUNIT("..\..\experts\favfolders\OpenDlgFavAdapter.pas"); +USEDEF("JclFavoriteFoldersExpertDLLC50.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.bpr b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.bpr new file mode 100644 index 0000000..386cf15 --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.bpr @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.cpp b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.cpp new file mode 100644 index 0000000..2eb0e50 --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.cpp @@ -0,0 +1,30 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpertDLL-L.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclFavoriteFoldersExpertDLLC50.res"); +USEUNIT("..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas"); +USEUNIT("..\..\experts\favfolders\OpenDlgFavAdapter.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.dof b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.dof new file mode 100644 index 0000000..2290b72 --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclC50;JclBaseExpertC50 + diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.rc b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.rc new file mode 100644 index 0000000..ceaa4f7 --- /dev/null +++ b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertDLLC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertDLLC50C50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.res b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.res new file mode 100644 index 0000000..c34f335 Binary files /dev/null and b/official/1.96/packages/c5/JclFavoriteFoldersExpertDLLC50.res differ diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertC50.RES b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.RES new file mode 100644 index 0000000..8448210 Binary files /dev/null and b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.RES differ diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertC50.bpk b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.bpk new file mode 100644 index 0000000..75d6094 --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.bpk @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertC50.cpp b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.cpp new file mode 100644 index 0000000..ccf5481 --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.cpp @@ -0,0 +1,30 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpert-D.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclProjectAnalysisExpertC50.res"); +USEUNIT("..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas"); +USEUNIT("..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertC50.dof b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.dof new file mode 100644 index 0000000..f930b72 --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertC50.dpk b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.dpk new file mode 100644 index 0000000..29e8f51 --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.dpk @@ -0,0 +1,49 @@ +package JclProjectAnalysisExpertC50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclC50, + JclBaseExpertC50 + ; + +contains + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +end. diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertC50.rc b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.rc new file mode 100644 index 0000000..f2ef643 --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpertC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertC50C50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.bpf b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.bpf new file mode 100644 index 0000000..4b1e25a --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.bpf @@ -0,0 +1,5 @@ +USEUNIT("..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas"); +USEUNIT("..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas"); +USEDEF("JclProjectAnalysisExpertDLLC50.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.bpr b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.bpr new file mode 100644 index 0000000..9f4aa6b --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.bpr @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.cpp b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.cpp new file mode 100644 index 0000000..cd1a8d3 --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.cpp @@ -0,0 +1,30 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpertDLL-L.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclProjectAnalysisExpertDLLC50.res"); +USEUNIT("..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas"); +USEUNIT("..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.dof b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.dof new file mode 100644 index 0000000..2290b72 --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclC50;JclBaseExpertC50 + diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.rc b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.rc new file mode 100644 index 0000000..271ef9c --- /dev/null +++ b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpertDLLC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertDLLC50C50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.res b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.res new file mode 100644 index 0000000..48c0438 Binary files /dev/null and b/official/1.96/packages/c5/JclProjectAnalysisExpertDLLC50.res differ diff --git a/official/1.96/packages/c5/JclSIMDViewExpertC50.bpk b/official/1.96/packages/c5/JclSIMDViewExpertC50.bpk new file mode 100644 index 0000000..2361d29 --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertC50.bpk @@ -0,0 +1,83 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclSIMDViewExpertC50.cpp b/official/1.96/packages/c5/JclSIMDViewExpertC50.cpp new file mode 100644 index 0000000..25071b1 --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertC50.cpp @@ -0,0 +1,33 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpert-D.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclSIMDViewExpertC50.res"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDViewForm.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDView.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDUtils.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDModifyForm.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDCpuInfo.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclSIMDViewExpertC50.dof b/official/1.96/packages/c5/JclSIMDViewExpertC50.dof new file mode 100644 index 0000000..f930b72 --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertC50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c5/JclSIMDViewExpertC50.dpk b/official/1.96/packages/c5/JclSIMDViewExpertC50.dpk new file mode 100644 index 0000000..7809b8e --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertC50.dpk @@ -0,0 +1,52 @@ +package JclSIMDViewExpertC50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclC50, + JclBaseExpertC50 + ; + +contains + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +end. diff --git a/official/1.96/packages/c5/JclSIMDViewExpertC50.rc b/official/1.96/packages/c5/JclSIMDViewExpertC50.rc new file mode 100644 index 0000000..e175c95 --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpertC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertC50C50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclSIMDViewExpertC50.res b/official/1.96/packages/c5/JclSIMDViewExpertC50.res new file mode 100644 index 0000000..b7a7f61 Binary files /dev/null and b/official/1.96/packages/c5/JclSIMDViewExpertC50.res differ diff --git a/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.bpf b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.bpf new file mode 100644 index 0000000..ba788a7 --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.bpf @@ -0,0 +1,8 @@ +USEUNIT("..\..\experts\debug\simdview\JclSIMDViewForm.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDView.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDUtils.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDModifyForm.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDCpuInfo.pas"); +USEDEF("JclSIMDViewExpertDLLC50.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.bpr b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.bpr new file mode 100644 index 0000000..5625002 --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.bpr @@ -0,0 +1,80 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.cpp b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.cpp new file mode 100644 index 0000000..b8bcda4 --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.cpp @@ -0,0 +1,33 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpertDLL-L.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclSIMDViewExpertDLLC50.res"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDViewForm.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDView.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDUtils.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDModifyForm.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDCpuInfo.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.dof b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.dof new file mode 100644 index 0000000..2290b72 --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclC50;JclBaseExpertC50 + diff --git a/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.rc b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.rc new file mode 100644 index 0000000..fca115c --- /dev/null +++ b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpertDLLC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertDLLC50C50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.res b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.res new file mode 100644 index 0000000..cc0a7ef Binary files /dev/null and b/official/1.96/packages/c5/JclSIMDViewExpertDLLC50.res differ diff --git a/official/1.96/packages/c5/JclThreadNameExpertC50.RES b/official/1.96/packages/c5/JclThreadNameExpertC50.RES new file mode 100644 index 0000000..4ea44c3 Binary files /dev/null and b/official/1.96/packages/c5/JclThreadNameExpertC50.RES differ diff --git a/official/1.96/packages/c5/JclThreadNameExpertC50.bpk b/official/1.96/packages/c5/JclThreadNameExpertC50.bpk new file mode 100644 index 0000000..0a7bb47 --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertC50.bpk @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclThreadNameExpertC50.cpp b/official/1.96/packages/c5/JclThreadNameExpertC50.cpp new file mode 100644 index 0000000..4ccad4c --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertC50.cpp @@ -0,0 +1,30 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpert-D.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclThreadNameExpertC50.res"); +USEUNIT("..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas"); +USEUNIT("..\..\experts\debug\threadnames\ThreadExpertUnit.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclThreadNameExpertC50.dof b/official/1.96/packages/c5/JclThreadNameExpertC50.dof new file mode 100644 index 0000000..f930b72 --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertC50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c5/JclThreadNameExpertC50.dpk b/official/1.96/packages/c5/JclThreadNameExpertC50.dpk new file mode 100644 index 0000000..7881269 --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertC50.dpk @@ -0,0 +1,49 @@ +package JclThreadNameExpertC50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclC50, + JclBaseExpertC50 + ; + +contains + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +end. diff --git a/official/1.96/packages/c5/JclThreadNameExpertC50.rc b/official/1.96/packages/c5/JclThreadNameExpertC50.rc new file mode 100644 index 0000000..11be4b1 --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpertC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertC50C50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclThreadNameExpertDLLC50.bpf b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.bpf new file mode 100644 index 0000000..7125ae4 --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.bpf @@ -0,0 +1,5 @@ +USEUNIT("..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas"); +USEUNIT("..\..\experts\debug\threadnames\ThreadExpertUnit.pas"); +USEDEF("JclThreadNameExpertDLLC50.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c5/JclThreadNameExpertDLLC50.bpr b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.bpr new file mode 100644 index 0000000..3ae3c4a --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.bpr @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclThreadNameExpertDLLC50.cpp b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.cpp new file mode 100644 index 0000000..98302d8 --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.cpp @@ -0,0 +1,30 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpertDLL-L.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclThreadNameExpertDLLC50.res"); +USEUNIT("..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas"); +USEUNIT("..\..\experts\debug\threadnames\ThreadExpertUnit.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclThreadNameExpertDLLC50.dof b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.dof new file mode 100644 index 0000000..2290b72 --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclC50;JclBaseExpertC50 + diff --git a/official/1.96/packages/c5/JclThreadNameExpertDLLC50.rc b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.rc new file mode 100644 index 0000000..22cb2e6 --- /dev/null +++ b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpertDLLC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertDLLC50C50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclThreadNameExpertDLLC50.res b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.res new file mode 100644 index 0000000..81461be Binary files /dev/null and b/official/1.96/packages/c5/JclThreadNameExpertDLLC50.res differ diff --git a/official/1.96/packages/c5/JclUsesExpertC50.RES b/official/1.96/packages/c5/JclUsesExpertC50.RES new file mode 100644 index 0000000..9329c10 Binary files /dev/null and b/official/1.96/packages/c5/JclUsesExpertC50.RES differ diff --git a/official/1.96/packages/c5/JclUsesExpertC50.bpk b/official/1.96/packages/c5/JclUsesExpertC50.bpk new file mode 100644 index 0000000..596b01a --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertC50.bpk @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclUsesExpertC50.cpp b/official/1.96/packages/c5/JclUsesExpertC50.cpp new file mode 100644 index 0000000..9480ae6 --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertC50.cpp @@ -0,0 +1,32 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpert-D.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclUsesExpertC50.res"); +USEUNIT("..\..\experts\useswizard\JCLUsesWizard.pas"); +USEUNIT("..\..\experts\useswizard\JCLOptionsFrame.pas"); +USEUNIT("..\..\experts\useswizard\JclUsesDialog.pas"); +USEUNIT("..\..\experts\useswizard\JclParseUses.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclUsesExpertC50.dof b/official/1.96/packages/c5/JclUsesExpertC50.dof new file mode 100644 index 0000000..f930b72 --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertC50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c5/JclUsesExpertC50.dpk b/official/1.96/packages/c5/JclUsesExpertC50.dpk new file mode 100644 index 0000000..0eaae94 --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertC50.dpk @@ -0,0 +1,51 @@ +package JclUsesExpertC50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclC50, + JclBaseExpertC50 + ; + +contains + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +end. diff --git a/official/1.96/packages/c5/JclUsesExpertC50.rc b/official/1.96/packages/c5/JclUsesExpertC50.rc new file mode 100644 index 0000000..7b4d062 --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpertC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertC50C50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclUsesExpertDLLC50.bpf b/official/1.96/packages/c5/JclUsesExpertDLLC50.bpf new file mode 100644 index 0000000..d7d37a8 --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertDLLC50.bpf @@ -0,0 +1,7 @@ +USEUNIT("..\..\experts\useswizard\JCLUsesWizard.pas"); +USEUNIT("..\..\experts\useswizard\JCLOptionsFrame.pas"); +USEUNIT("..\..\experts\useswizard\JclUsesDialog.pas"); +USEUNIT("..\..\experts\useswizard\JclParseUses.pas"); +USEDEF("JclUsesExpertDLLC50.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c5/JclUsesExpertDLLC50.bpr b/official/1.96/packages/c5/JclUsesExpertDLLC50.bpr new file mode 100644 index 0000000..a7f2f3e --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertDLLC50.bpr @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclUsesExpertDLLC50.cpp b/official/1.96/packages/c5/JclUsesExpertDLLC50.cpp new file mode 100644 index 0000000..6d1bb43 --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertDLLC50.cpp @@ -0,0 +1,32 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpertDLL-L.xml) + + Last generated: 26-12-2005 11:30:52 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclUsesExpertDLLC50.res"); +USEUNIT("..\..\experts\useswizard\JCLUsesWizard.pas"); +USEUNIT("..\..\experts\useswizard\JCLOptionsFrame.pas"); +USEUNIT("..\..\experts\useswizard\JclUsesDialog.pas"); +USEUNIT("..\..\experts\useswizard\JclParseUses.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclUsesExpertDLLC50.dof b/official/1.96/packages/c5/JclUsesExpertDLLC50.dof new file mode 100644 index 0000000..2290b72 --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertDLLC50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclC50;JclBaseExpertC50 + diff --git a/official/1.96/packages/c5/JclUsesExpertDLLC50.rc b/official/1.96/packages/c5/JclUsesExpertDLLC50.rc new file mode 100644 index 0000000..6ae046d --- /dev/null +++ b/official/1.96/packages/c5/JclUsesExpertDLLC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpertDLLC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertDLLC50C50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclUsesExpertDLLC50.res b/official/1.96/packages/c5/JclUsesExpertDLLC50.res new file mode 100644 index 0000000..0c58750 Binary files /dev/null and b/official/1.96/packages/c5/JclUsesExpertDLLC50.res differ diff --git a/official/1.96/packages/c5/JclVersionControlExpertC50.bpk b/official/1.96/packages/c5/JclVersionControlExpertC50.bpk new file mode 100644 index 0000000..24667b9 --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertC50.bpk @@ -0,0 +1,80 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclVersionControlExpertC50.cpp b/official/1.96/packages/c5/JclVersionControlExpertC50.cpp new file mode 100644 index 0000000..e6ec84e --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertC50.cpp @@ -0,0 +1,32 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpert-D.xml) + + Last generated: 08-01-2006 17:55:07 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclVersionControlExpertC50.res"); +USEUNIT("..\..\experts\versioncontrol\VersionControlImpl.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclVersionControlExpertC50.dof b/official/1.96/packages/c5/JclVersionControlExpertC50.dof new file mode 100644 index 0000000..f930b72 --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertC50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c5/JclVersionControlExpertC50.dpk b/official/1.96/packages/c5/JclVersionControlExpertC50.dpk new file mode 100644 index 0000000..c92af9b --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertC50.dpk @@ -0,0 +1,51 @@ +package JclVersionControlExpertC50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpert-D.xml) + + Last generated: 15-01-2006 00:37:25 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclC50, + JclBaseExpertC50 + ; + +contains + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +end. diff --git a/official/1.96/packages/c5/JclVersionControlExpertC50.rc b/official/1.96/packages/c5/JclVersionControlExpertC50.rc new file mode 100644 index 0000000..70d05a7 --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertC50C50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclVersionControlExpertC50.res b/official/1.96/packages/c5/JclVersionControlExpertC50.res new file mode 100644 index 0000000..0ba60e5 Binary files /dev/null and b/official/1.96/packages/c5/JclVersionControlExpertC50.res differ diff --git a/official/1.96/packages/c5/JclVersionControlExpertDLLC50.bpf b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.bpf new file mode 100644 index 0000000..521e3ef --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.bpf @@ -0,0 +1,7 @@ +USEUNIT("..\..\experts\versioncontrol\VersionControlImpl.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas"); +USEDEF("JclVersionControlExpertDLLC50.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c5/JclVersionControlExpertDLLC50.bpr b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.bpr new file mode 100644 index 0000000..293a422 --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.bpr @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JclVersionControlExpertDLLC50.cpp b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.cpp new file mode 100644 index 0000000..b4ca9b8 --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.cpp @@ -0,0 +1,32 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpertDLL-L.xml) + + Last generated: 08-01-2006 17:55:07 UTC +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("JclVersionControlExpertDLLC50.res"); +USEUNIT("..\..\experts\versioncontrol\VersionControlImpl.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas"); +USEPACKAGE("vcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEPACKAGE("JclC50.bpi"); +USEPACKAGE("JclBaseExpertC50.bpi"); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/JclVersionControlExpertDLLC50.dof b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.dof new file mode 100644 index 0000000..2290b72 --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclC50;JclBaseExpertC50 + diff --git a/official/1.96/packages/c5/JclVersionControlExpertDLLC50.rc b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.rc new file mode 100644 index 0000000..5641d91 --- /dev/null +++ b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertDLLC50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertDLLC50C50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c5/JclVersionControlExpertDLLC50.res b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.res new file mode 100644 index 0000000..d81fff6 Binary files /dev/null and b/official/1.96/packages/c5/JclVersionControlExpertDLLC50.res differ diff --git a/official/1.96/packages/c5/JediUsesC50.bpk b/official/1.96/packages/c5/JediUsesC50.bpk new file mode 100644 index 0000000..0062c38 --- /dev/null +++ b/official/1.96/packages/c5/JediUsesC50.bpk @@ -0,0 +1,47 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/JediUsesC50.cpp b/official/1.96/packages/c5/JediUsesC50.cpp new file mode 100644 index 0000000..f404891 --- /dev/null +++ b/official/1.96/packages/c5/JediUsesC50.cpp @@ -0,0 +1,25 @@ +//--------------------------------------------------------------------------- + +#include +#pragma hdrstop +USEPACKAGE("vcl50.bpi"); +USEUNIT("..\debugextension\JclOtaUtils.pas"); +USEPACKAGE("CJcl50.bpi"); +USEPACKAGE("dsnide50.bpi"); +USEUNIT("JCLUsesWizard.pas"); +USEUNIT("JclParseUses.pas"); +USEFORMNS("JclUsesDialog.pas", Jclusesdialog, FormUsesConfirm); +USEFORMNS("JCLOptionsFrame.pas", Jcloptionsframe, FrameJclOptions); /* TFrame: File Type */ +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- + +// Source du paquet. +//--------------------------------------------------------------------------- + +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/dirinfo.txt b/official/1.96/packages/c5/dirinfo.txt new file mode 100644 index 0000000..01a8e6f --- /dev/null +++ b/official/1.96/packages/c5/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for C++Builder 5 packages. \ No newline at end of file diff --git a/official/1.96/packages/c5/template.bpf b/official/1.96/packages/c5/template.bpf new file mode 100644 index 0000000..66e6b5b --- /dev/null +++ b/official/1.96/packages/c5/template.bpf @@ -0,0 +1,20 @@ +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> +<%%% START FILES %%%> +USEUNIT("%FILENAME%"); +<%%% END FILES %%%> +USEDEF("%NAME%.def"); +Project file +<%%% BEGIN PROGRAMONLY %%%> +WinMain +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +DllEntryPoint +<%%% END LIBRARYONLY %%%> diff --git a/official/1.96/packages/c5/template.bpk b/official/1.96/packages/c5/template.bpk new file mode 100644 index 0000000..9e431c8 --- /dev/null +++ b/official/1.96/packages/c5/template.bpk @@ -0,0 +1,89 @@ + + + +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/c5/template.bpr b/official/1.96/packages/c5/template.bpr new file mode 100644 index 0000000..a99c678 --- /dev/null +++ b/official/1.96/packages/c5/template.bpr @@ -0,0 +1,89 @@ + + + +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/official/1.96/packages/c5/template.cpp b/official/1.96/packages/c5/template.cpp new file mode 100644 index 0000000..4032b15 --- /dev/null +++ b/official/1.96/packages/c5/template.cpp @@ -0,0 +1,68 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +*/ + +#include +#pragma hdrstop +USERES("%NAME%.res"); +<%%% START FILES %%%> +USEUNIT("%FILENAME%"); +<%%% END FILES %%%> +<%%% START REQUIRES %%%> +USEPACKAGE("%NAME%.bpi"); +<%%% END REQUIRES %%%> +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +<%%% BEGIN PACKAGEONLY %%%> +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +<%%% END DESIGNONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +<%%% END LIBRARYONLY %%%> +<%%% BEGIN PROGRAMONLY %%%> +// Program source. +//--------------------------------------------------------------------------- +#pragma argsused +WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow) +{ + return 0; +} +<%%% END PROGRAMONLY %%%> +//--------------------------------------------------------------------------- diff --git a/official/1.96/packages/c5/template.dof b/official/1.96/packages/c5/template.dof new file mode 100644 index 0000000..706ab8e --- /dev/null +++ b/official/1.96/packages/c5/template.dof @@ -0,0 +1,10 @@ +[Directories] +UnitOutputDir=..\..\lib\c5 +SearchPath=..\..\source +<%%% BEGIN LIBRARYONLY %%%> +[Compiler] +PackageNoLink=1 +[Linker] +Packages=%NOLINKPACKAGELIST% +<%%% END LIBRARYONLY %%%> + diff --git a/official/1.96/packages/c5/template.dpk b/official/1.96/packages/c5/template.dpk new file mode 100644 index 0000000..4960431 --- /dev/null +++ b/official/1.96/packages/c5/template.dpk @@ -0,0 +1,55 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. \ No newline at end of file diff --git a/official/1.96/packages/c5/template.rc b/official/1.96/packages/c5/template.rc new file mode 100644 index 0000000..bcf21d2 --- /dev/null +++ b/official/1.96/packages/c5/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%C50%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/Jcl.RES b/official/1.96/packages/c6/Jcl.RES new file mode 100644 index 0000000..70d5f34 Binary files /dev/null and b/official/1.96/packages/c6/Jcl.RES differ diff --git a/official/1.96/packages/c6/Jcl.bpk b/official/1.96/packages/c6/Jcl.bpk new file mode 100644 index 0000000..646c662 --- /dev/null +++ b/official/1.96/packages/c6/Jcl.bpk @@ -0,0 +1,238 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/Jcl.cpp b/official/1.96/packages/c6/Jcl.cpp new file mode 100644 index 0000000..3c8a7c8 --- /dev/null +++ b/official/1.96/packages/c6/Jcl.cpp @@ -0,0 +1,25 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/Jcl.dof b/official/1.96/packages/c6/Jcl.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/Jcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/Jcl.dpk b/official/1.96/packages/c6/Jcl.dpk new file mode 100644 index 0000000..014baae --- /dev/null +++ b/official/1.96/packages/c6/Jcl.dpk @@ -0,0 +1,123 @@ +package Jcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$LIBSUFFIX 'C60'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl + ; +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' + ; +end. diff --git a/official/1.96/packages/c6/Jcl.rc b/official/1.96/packages/c6/Jcl.rc new file mode 100644 index 0000000..a295ced --- /dev/null +++ b/official/1.96/packages/c6/Jcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "Jcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclBaseExpert.bpk b/official/1.96/packages/c6/JclBaseExpert.bpk new file mode 100644 index 0000000..8198488 --- /dev/null +++ b/official/1.96/packages/c6/JclBaseExpert.bpk @@ -0,0 +1,99 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclBaseExpert.cpp b/official/1.96/packages/c6/JclBaseExpert.cpp new file mode 100644 index 0000000..0117f10 --- /dev/null +++ b/official/1.96/packages/c6/JclBaseExpert.cpp @@ -0,0 +1,28 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 04-01-2006 22:23:22 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\common\JclOtaExceptionForm.pas", Jclotaexceptionform, JclExpertExceptionForm); +USEFORMNS("..\..\experts\common\JclOtaConfigurationForm.pas", Jclotaconfigurationform, JclOtaOptionsForm); +USEFORMNS("..\..\experts\common\JclOtaActionConfigureSheet.pas", Jclotaactionconfiguresheet, JclOtaActionConfigureFrame); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclBaseExpert.dof b/official/1.96/packages/c6/JclBaseExpert.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclBaseExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclBaseExpert.dpk b/official/1.96/packages/c6/JclBaseExpert.dpk new file mode 100644 index 0000000..6c248a1 --- /dev/null +++ b/official/1.96/packages/c6/JclBaseExpert.dpk @@ -0,0 +1,52 @@ +package JclBaseExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 04-01-2006 22:23:22 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JCL Package containing common units for JCL Experts'} +{$LIBSUFFIX 'C60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl + ; +contains + JclOtaUtils in '..\..\experts\common\JclOtaUtils.pas' , + JclOtaResources in '..\..\experts\common\JclOtaResources.pas' , + JclOtaConsts in '..\..\experts\common\JclOtaConsts.pas' , + JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm}, + JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm}, + JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame} + ; +end. diff --git a/official/1.96/packages/c6/JclBaseExpert.rc b/official/1.96/packages/c6/JclBaseExpert.rc new file mode 100644 index 0000000..7c1196c --- /dev/null +++ b/official/1.96/packages/c6/JclBaseExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Package containing common units for JCL Experts\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclBaseExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclBaseExpertC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclBaseExpert.res b/official/1.96/packages/c6/JclBaseExpert.res new file mode 100644 index 0000000..87167b7 Binary files /dev/null and b/official/1.96/packages/c6/JclBaseExpert.res differ diff --git a/official/1.96/packages/c6/JclDebugExpert.RES b/official/1.96/packages/c6/JclDebugExpert.RES new file mode 100644 index 0000000..afd664d Binary files /dev/null and b/official/1.96/packages/c6/JclDebugExpert.RES differ diff --git a/official/1.96/packages/c6/JclDebugExpert.bpk b/official/1.96/packages/c6/JclDebugExpert.bpk new file mode 100644 index 0000000..47d425f --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpert.bpk @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclDebugExpert.cpp b/official/1.96/packages/c6/JclDebugExpert.cpp new file mode 100644 index 0000000..7ed2c95 --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpert.cpp @@ -0,0 +1,26 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpert-D.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\debug\JclDebugIdeResult.pas", Jcldebugideresult, JclDebugResultForm); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclDebugExpert.dof b/official/1.96/packages/c6/JclDebugExpert.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclDebugExpert.dpk b/official/1.96/packages/c6/JclDebugExpert.dpk new file mode 100644 index 0000000..2390f4a --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpert.dpk @@ -0,0 +1,49 @@ +package JclDebugExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$LIBSUFFIX 'C60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; +contains + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; +end. diff --git a/official/1.96/packages/c6/JclDebugExpert.rc b/official/1.96/packages/c6/JclDebugExpert.rc new file mode 100644 index 0000000..00f6008 --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclDebugExpertDLL.bpf b/official/1.96/packages/c6/JclDebugExpertDLL.bpf new file mode 100644 index 0000000..234793a --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpertDLL.bpf @@ -0,0 +1,5 @@ +USEUNIT("..\..\experts\debug\JclDebugIdeResult.pas"); +USEUNIT("..\..\experts\debug\JclDebugIdeImpl.pas"); +USEDEF("JclDebugExpertDLL.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c6/JclDebugExpertDLL.bpr b/official/1.96/packages/c6/JclDebugExpertDLL.bpr new file mode 100644 index 0000000..9f4d2aa --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpertDLL.bpr @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclDebugExpertDLL.cpp b/official/1.96/packages/c6/JclDebugExpertDLL.cpp new file mode 100644 index 0000000..1ae209c --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpertDLL.cpp @@ -0,0 +1,26 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpertDLL-L.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\debug\JclDebugIdeResult.pas", Jcldebugideresult, JclDebugResultForm); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclDebugExpertDLL.dof b/official/1.96/packages/c6/JclDebugExpertDLL.dof new file mode 100644 index 0000000..b4fd9a4 --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/c6/JclDebugExpertDLL.rc b/official/1.96/packages/c6/JclDebugExpertDLL.rc new file mode 100644 index 0000000..4b709e6 --- /dev/null +++ b/official/1.96/packages/c6/JclDebugExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertDLLC60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclDebugExpertDLL.res b/official/1.96/packages/c6/JclDebugExpertDLL.res new file mode 100644 index 0000000..3bc55ad Binary files /dev/null and b/official/1.96/packages/c6/JclDebugExpertDLL.res differ diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpert.RES b/official/1.96/packages/c6/JclFavoriteFoldersExpert.RES new file mode 100644 index 0000000..a2b49ea Binary files /dev/null and b/official/1.96/packages/c6/JclFavoriteFoldersExpert.RES differ diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpert.bpk b/official/1.96/packages/c6/JclFavoriteFoldersExpert.bpk new file mode 100644 index 0000000..52a80de --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpert.bpk @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpert.cpp b/official/1.96/packages/c6/JclFavoriteFoldersExpert.cpp new file mode 100644 index 0000000..658ec45 --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpert.cpp @@ -0,0 +1,25 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpert-D.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpert.dof b/official/1.96/packages/c6/JclFavoriteFoldersExpert.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpert.dpk b/official/1.96/packages/c6/JclFavoriteFoldersExpert.dpk new file mode 100644 index 0000000..83ee3ce --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpert.dpk @@ -0,0 +1,49 @@ +package JclFavoriteFoldersExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX 'C60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; +contains + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; +end. diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpert.rc b/official/1.96/packages/c6/JclFavoriteFoldersExpert.rc new file mode 100644 index 0000000..c546864 --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.bpf b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.bpf new file mode 100644 index 0000000..824bd48 --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.bpf @@ -0,0 +1,5 @@ +USEUNIT("..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas"); +USEUNIT("..\..\experts\favfolders\OpenDlgFavAdapter.pas"); +USEDEF("JclFavoriteFoldersExpertDLL.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.bpr b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.bpr new file mode 100644 index 0000000..1a84cf3 --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.bpr @@ -0,0 +1,87 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.cpp b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.cpp new file mode 100644 index 0000000..209bbcd --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.cpp @@ -0,0 +1,25 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpertDLL-L.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.dof b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.dof new file mode 100644 index 0000000..b4fd9a4 --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.rc b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.rc new file mode 100644 index 0000000..b342fd0 --- /dev/null +++ b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertDLLC60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.res b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.res new file mode 100644 index 0000000..fc10cc6 Binary files /dev/null and b/official/1.96/packages/c6/JclFavoriteFoldersExpertDLL.res differ diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpert.RES b/official/1.96/packages/c6/JclProjectAnalysisExpert.RES new file mode 100644 index 0000000..90fd00e Binary files /dev/null and b/official/1.96/packages/c6/JclProjectAnalysisExpert.RES differ diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpert.bpk b/official/1.96/packages/c6/JclProjectAnalysisExpert.bpk new file mode 100644 index 0000000..5aa9d0e --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpert.bpk @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpert.cpp b/official/1.96/packages/c6/JclProjectAnalysisExpert.cpp new file mode 100644 index 0000000..4bcce50 --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpert.cpp @@ -0,0 +1,26 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpert-D.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas", Projanalyzerfrm, ProjectAnalyzerForm); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpert.dof b/official/1.96/packages/c6/JclProjectAnalysisExpert.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpert.dpk b/official/1.96/packages/c6/JclProjectAnalysisExpert.dpk new file mode 100644 index 0000000..ec68c52 --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpert.dpk @@ -0,0 +1,49 @@ +package JclProjectAnalysisExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$LIBSUFFIX 'C60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; +contains + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; +end. diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpert.rc b/official/1.96/packages/c6/JclProjectAnalysisExpert.rc new file mode 100644 index 0000000..1f951c6 --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.bpf b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.bpf new file mode 100644 index 0000000..7eca24d --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.bpf @@ -0,0 +1,5 @@ +USEUNIT("..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas"); +USEUNIT("..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas"); +USEDEF("JclProjectAnalysisExpertDLL.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.bpr b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.bpr new file mode 100644 index 0000000..52e4c54 --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.bpr @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.cpp b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.cpp new file mode 100644 index 0000000..62d3aea --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.cpp @@ -0,0 +1,26 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpertDLL-L.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas", Projanalyzerfrm, ProjectAnalyzerForm); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.dof b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.dof new file mode 100644 index 0000000..b4fd9a4 --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.rc b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.rc new file mode 100644 index 0000000..13424ae --- /dev/null +++ b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertDLLC60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.res b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.res new file mode 100644 index 0000000..b22071b Binary files /dev/null and b/official/1.96/packages/c6/JclProjectAnalysisExpertDLL.res differ diff --git a/official/1.96/packages/c6/JclSIMDViewExpert.bpk b/official/1.96/packages/c6/JclSIMDViewExpert.bpk new file mode 100644 index 0000000..8df862f --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpert.bpk @@ -0,0 +1,99 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclSIMDViewExpert.cpp b/official/1.96/packages/c6/JclSIMDViewExpert.cpp new file mode 100644 index 0000000..0f533b9 --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpert.cpp @@ -0,0 +1,28 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpert-D.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\debug\simdview\JclSIMDViewForm.pas", Jclsimdviewform, JclSIMDViewFrm); +USEFORMNS("..\..\experts\debug\simdview\JclSIMDModifyForm.pas", Jclsimdmodifyform, JclSIMDModifyFrm); +USEFORMNS("..\..\experts\debug\simdview\JclSIMDCpuInfo.pas", Jclsimdcpuinfo, JclFormCpuInfo); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclSIMDViewExpert.dof b/official/1.96/packages/c6/JclSIMDViewExpert.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclSIMDViewExpert.dpk b/official/1.96/packages/c6/JclSIMDViewExpert.dpk new file mode 100644 index 0000000..0f6999d --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpert.dpk @@ -0,0 +1,52 @@ +package JclSIMDViewExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$LIBSUFFIX 'C60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; +contains + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; +end. diff --git a/official/1.96/packages/c6/JclSIMDViewExpert.rc b/official/1.96/packages/c6/JclSIMDViewExpert.rc new file mode 100644 index 0000000..0456b4e --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclSIMDViewExpert.res b/official/1.96/packages/c6/JclSIMDViewExpert.res new file mode 100644 index 0000000..65ccff3 Binary files /dev/null and b/official/1.96/packages/c6/JclSIMDViewExpert.res differ diff --git a/official/1.96/packages/c6/JclSIMDViewExpertDLL.bpf b/official/1.96/packages/c6/JclSIMDViewExpertDLL.bpf new file mode 100644 index 0000000..5cca6a0 --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpertDLL.bpf @@ -0,0 +1,8 @@ +USEUNIT("..\..\experts\debug\simdview\JclSIMDViewForm.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDView.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDUtils.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDModifyForm.pas"); +USEUNIT("..\..\experts\debug\simdview\JclSIMDCpuInfo.pas"); +USEDEF("JclSIMDViewExpertDLL.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c6/JclSIMDViewExpertDLL.bpr b/official/1.96/packages/c6/JclSIMDViewExpertDLL.bpr new file mode 100644 index 0000000..3b60dd4 --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpertDLL.bpr @@ -0,0 +1,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclSIMDViewExpertDLL.cpp b/official/1.96/packages/c6/JclSIMDViewExpertDLL.cpp new file mode 100644 index 0000000..3c382da --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpertDLL.cpp @@ -0,0 +1,28 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpertDLL-L.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\debug\simdview\JclSIMDViewForm.pas", Jclsimdviewform, JclSIMDViewFrm); +USEFORMNS("..\..\experts\debug\simdview\JclSIMDModifyForm.pas", Jclsimdmodifyform, JclSIMDModifyFrm); +USEFORMNS("..\..\experts\debug\simdview\JclSIMDCpuInfo.pas", Jclsimdcpuinfo, JclFormCpuInfo); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclSIMDViewExpertDLL.dof b/official/1.96/packages/c6/JclSIMDViewExpertDLL.dof new file mode 100644 index 0000000..b4fd9a4 --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/c6/JclSIMDViewExpertDLL.rc b/official/1.96/packages/c6/JclSIMDViewExpertDLL.rc new file mode 100644 index 0000000..12651f4 --- /dev/null +++ b/official/1.96/packages/c6/JclSIMDViewExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertDLLC60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclSIMDViewExpertDLL.res b/official/1.96/packages/c6/JclSIMDViewExpertDLL.res new file mode 100644 index 0000000..81f00ae Binary files /dev/null and b/official/1.96/packages/c6/JclSIMDViewExpertDLL.res differ diff --git a/official/1.96/packages/c6/JclThreadNameExpert.RES b/official/1.96/packages/c6/JclThreadNameExpert.RES new file mode 100644 index 0000000..ba32612 Binary files /dev/null and b/official/1.96/packages/c6/JclThreadNameExpert.RES differ diff --git a/official/1.96/packages/c6/JclThreadNameExpert.bpk b/official/1.96/packages/c6/JclThreadNameExpert.bpk new file mode 100644 index 0000000..84d24d2 --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpert.bpk @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclThreadNameExpert.cpp b/official/1.96/packages/c6/JclThreadNameExpert.cpp new file mode 100644 index 0000000..8014b06 --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpert.cpp @@ -0,0 +1,25 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpert-D.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclThreadNameExpert.dof b/official/1.96/packages/c6/JclThreadNameExpert.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclThreadNameExpert.dpk b/official/1.96/packages/c6/JclThreadNameExpert.dpk new file mode 100644 index 0000000..b403a3d --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpert.dpk @@ -0,0 +1,49 @@ +package JclThreadNameExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$LIBSUFFIX 'C60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; +contains + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; +end. diff --git a/official/1.96/packages/c6/JclThreadNameExpert.rc b/official/1.96/packages/c6/JclThreadNameExpert.rc new file mode 100644 index 0000000..5fda2e6 --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclThreadNameExpertDLL.bpf b/official/1.96/packages/c6/JclThreadNameExpertDLL.bpf new file mode 100644 index 0000000..b6a8f79 --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpertDLL.bpf @@ -0,0 +1,5 @@ +USEUNIT("..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas"); +USEUNIT("..\..\experts\debug\threadnames\ThreadExpertUnit.pas"); +USEDEF("JclThreadNameExpertDLL.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c6/JclThreadNameExpertDLL.bpr b/official/1.96/packages/c6/JclThreadNameExpertDLL.bpr new file mode 100644 index 0000000..0b52b4d --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpertDLL.bpr @@ -0,0 +1,87 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclThreadNameExpertDLL.cpp b/official/1.96/packages/c6/JclThreadNameExpertDLL.cpp new file mode 100644 index 0000000..e786484 --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpertDLL.cpp @@ -0,0 +1,25 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpertDLL-L.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclThreadNameExpertDLL.dof b/official/1.96/packages/c6/JclThreadNameExpertDLL.dof new file mode 100644 index 0000000..b4fd9a4 --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/c6/JclThreadNameExpertDLL.rc b/official/1.96/packages/c6/JclThreadNameExpertDLL.rc new file mode 100644 index 0000000..1351bf3 --- /dev/null +++ b/official/1.96/packages/c6/JclThreadNameExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertDLLC60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclThreadNameExpertDLL.res b/official/1.96/packages/c6/JclThreadNameExpertDLL.res new file mode 100644 index 0000000..808fd6f Binary files /dev/null and b/official/1.96/packages/c6/JclThreadNameExpertDLL.res differ diff --git a/official/1.96/packages/c6/JclUsesExpert.RES b/official/1.96/packages/c6/JclUsesExpert.RES new file mode 100644 index 0000000..e2feef0 Binary files /dev/null and b/official/1.96/packages/c6/JclUsesExpert.RES differ diff --git a/official/1.96/packages/c6/JclUsesExpert.bpk b/official/1.96/packages/c6/JclUsesExpert.bpk new file mode 100644 index 0000000..3905127 --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpert.bpk @@ -0,0 +1,96 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclUsesExpert.cpp b/official/1.96/packages/c6/JclUsesExpert.cpp new file mode 100644 index 0000000..3c0487c --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpert.cpp @@ -0,0 +1,27 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpert-D.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\useswizard\JCLOptionsFrame.pas", Jcloptionsframe, FrameJclOptions); /* TFrame: File Type */ +USEFORMNS("..\..\experts\useswizard\JclUsesDialog.pas", Jclusesdialog, FormUsesConfirm); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclUsesExpert.dof b/official/1.96/packages/c6/JclUsesExpert.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclUsesExpert.dpk b/official/1.96/packages/c6/JclUsesExpert.dpk new file mode 100644 index 0000000..61d1ebe --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpert.dpk @@ -0,0 +1,51 @@ +package JclUsesExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$LIBSUFFIX 'C60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; +contains + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; +end. diff --git a/official/1.96/packages/c6/JclUsesExpert.rc b/official/1.96/packages/c6/JclUsesExpert.rc new file mode 100644 index 0000000..014a564 --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclUsesExpertDLL.bpf b/official/1.96/packages/c6/JclUsesExpertDLL.bpf new file mode 100644 index 0000000..dd01c6b --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpertDLL.bpf @@ -0,0 +1,7 @@ +USEUNIT("..\..\experts\useswizard\JCLUsesWizard.pas"); +USEUNIT("..\..\experts\useswizard\JCLOptionsFrame.pas"); +USEUNIT("..\..\experts\useswizard\JclUsesDialog.pas"); +USEUNIT("..\..\experts\useswizard\JclParseUses.pas"); +USEDEF("JclUsesExpertDLL.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c6/JclUsesExpertDLL.bpr b/official/1.96/packages/c6/JclUsesExpertDLL.bpr new file mode 100644 index 0000000..7f5df67 --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpertDLL.bpr @@ -0,0 +1,93 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclUsesExpertDLL.cpp b/official/1.96/packages/c6/JclUsesExpertDLL.cpp new file mode 100644 index 0000000..d124553 --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpertDLL.cpp @@ -0,0 +1,27 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpertDLL-L.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\useswizard\JCLOptionsFrame.pas", Jcloptionsframe, FrameJclOptions); /* TFrame: File Type */ +USEFORMNS("..\..\experts\useswizard\JclUsesDialog.pas", Jclusesdialog, FormUsesConfirm); +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclUsesExpertDLL.dof b/official/1.96/packages/c6/JclUsesExpertDLL.dof new file mode 100644 index 0000000..b4fd9a4 --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/c6/JclUsesExpertDLL.rc b/official/1.96/packages/c6/JclUsesExpertDLL.rc new file mode 100644 index 0000000..7f30c76 --- /dev/null +++ b/official/1.96/packages/c6/JclUsesExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertDLLC60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclUsesExpertDLL.res b/official/1.96/packages/c6/JclUsesExpertDLL.res new file mode 100644 index 0000000..de21123 Binary files /dev/null and b/official/1.96/packages/c6/JclUsesExpertDLL.res differ diff --git a/official/1.96/packages/c6/JclVClx.RES b/official/1.96/packages/c6/JclVClx.RES new file mode 100644 index 0000000..1bcc3ae Binary files /dev/null and b/official/1.96/packages/c6/JclVClx.RES differ diff --git a/official/1.96/packages/c6/JclVClx.bpk b/official/1.96/packages/c6/JclVClx.bpk new file mode 100644 index 0000000..f1dd29c --- /dev/null +++ b/official/1.96/packages/c6/JclVClx.bpk @@ -0,0 +1,86 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclVClx.cpp b/official/1.96/packages/c6/JclVClx.cpp new file mode 100644 index 0000000..b23882d --- /dev/null +++ b/official/1.96/packages/c6/JclVClx.cpp @@ -0,0 +1,25 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclVClx.dof b/official/1.96/packages/c6/JclVClx.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclVClx.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclVClx.dpk b/official/1.96/packages/c6/JclVClx.dpk new file mode 100644 index 0000000..911458f --- /dev/null +++ b/official/1.96/packages/c6/JclVClx.dpk @@ -0,0 +1,47 @@ +package JclVClx; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library VisualCLX package'} +{$LIBSUFFIX 'C60'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + visualclx, + Jcl + ; +contains + JclQGraphUtils in '..\..\source\visclx\JclQGraphUtils.pas' , + JclQGraphics in '..\..\source\visclx\JclQGraphics.pas' + ; +end. diff --git a/official/1.96/packages/c6/JclVClx.rc b/official/1.96/packages/c6/JclVClx.rc new file mode 100644 index 0000000..7ec0368 --- /dev/null +++ b/official/1.96/packages/c6/JclVClx.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,0,2172 +PRODUCTVERSION 1,97,0,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VisualCLX package\0" + VALUE "FileVersion", "1.97.0.2172\0" + VALUE "InternalName", "JclVClx\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVClxC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclVcl.RES b/official/1.96/packages/c6/JclVcl.RES new file mode 100644 index 0000000..0afb507 Binary files /dev/null and b/official/1.96/packages/c6/JclVcl.RES differ diff --git a/official/1.96/packages/c6/JclVcl.bpk b/official/1.96/packages/c6/JclVcl.bpk new file mode 100644 index 0000000..7c963a3 --- /dev/null +++ b/official/1.96/packages/c6/JclVcl.bpk @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclVcl.cpp b/official/1.96/packages/c6/JclVcl.cpp new file mode 100644 index 0000000..bee3b94 --- /dev/null +++ b/official/1.96/packages/c6/JclVcl.cpp @@ -0,0 +1,25 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml) + + Last generated: 26-12-2005 11:22:37 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclVcl.dof b/official/1.96/packages/c6/JclVcl.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclVcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclVcl.dpk b/official/1.96/packages/c6/JclVcl.dpk new file mode 100644 index 0000000..acd84fc --- /dev/null +++ b/official/1.96/packages/c6/JclVcl.dpk @@ -0,0 +1,49 @@ +package JclVcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library VCL package'} +{$LIBSUFFIX 'C60'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + vcljpg, + Jcl + ; +contains + JclPrint in '..\..\source\vcl\JclPrint.pas' , + JclGraphUtils in '..\..\source\vcl\JclGraphUtils.pas' , + JclGraphics in '..\..\source\vcl\JclGraphics.pas' + ; +end. diff --git a/official/1.96/packages/c6/JclVcl.rc b/official/1.96/packages/c6/JclVcl.rc new file mode 100644 index 0000000..b683ff3 --- /dev/null +++ b/official/1.96/packages/c6/JclVcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VCL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVclC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclVersionControlExpert.bpk b/official/1.96/packages/c6/JclVersionControlExpert.bpk new file mode 100644 index 0000000..843792a --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpert.bpk @@ -0,0 +1,95 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclVersionControlExpert.cpp b/official/1.96/packages/c6/JclVersionControlExpert.cpp new file mode 100644 index 0000000..102a957 --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpert.cpp @@ -0,0 +1,26 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpert-D.xml) + + Last generated: 10-01-2006 00:50:09 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas", Jclversionctrlcommonoptions, JclVersionCtrlOptionsFrame); /* TFrame: File Type */ +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclVersionControlExpert.dof b/official/1.96/packages/c6/JclVersionControlExpert.dof new file mode 100644 index 0000000..3f3fa2c --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source + diff --git a/official/1.96/packages/c6/JclVersionControlExpert.dpk b/official/1.96/packages/c6/JclVersionControlExpert.dpk new file mode 100644 index 0000000..d2cf063 --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpert.dpk @@ -0,0 +1,51 @@ +package JclVersionControlExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpert-D.xml) + + Last generated: 15-01-2006 00:37:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX 'C60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; +contains + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; +end. diff --git a/official/1.96/packages/c6/JclVersionControlExpert.rc b/official/1.96/packages/c6/JclVersionControlExpert.rc new file mode 100644 index 0000000..ce991f1 --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertC60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclVersionControlExpert.res b/official/1.96/packages/c6/JclVersionControlExpert.res new file mode 100644 index 0000000..13677e5 Binary files /dev/null and b/official/1.96/packages/c6/JclVersionControlExpert.res differ diff --git a/official/1.96/packages/c6/JclVersionControlExpertDLL.bpf b/official/1.96/packages/c6/JclVersionControlExpertDLL.bpf new file mode 100644 index 0000000..7472d64 --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpertDLL.bpf @@ -0,0 +1,7 @@ +USEUNIT("..\..\experts\versioncontrol\VersionControlImpl.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas"); +USEUNIT("..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas"); +USEDEF("JclVersionControlExpertDLL.def"); +Project file +DllEntryPoint diff --git a/official/1.96/packages/c6/JclVersionControlExpertDLL.bpr b/official/1.96/packages/c6/JclVersionControlExpertDLL.bpr new file mode 100644 index 0000000..a022697 --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpertDLL.bpr @@ -0,0 +1,92 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/JclVersionControlExpertDLL.cpp b/official/1.96/packages/c6/JclVersionControlExpertDLL.cpp new file mode 100644 index 0000000..bc04dc8 --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpertDLL.cpp @@ -0,0 +1,26 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpertDLL-L.xml) + + Last generated: 10-01-2006 00:50:09 UTC +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +USEFORMNS("..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas", Jclversionctrlcommonoptions, JclVersionCtrlOptionsFrame); /* TFrame: File Type */ +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/JclVersionControlExpertDLL.dof b/official/1.96/packages/c6/JclVersionControlExpertDLL.dof new file mode 100644 index 0000000..b4fd9a4 --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/c6/JclVersionControlExpertDLL.rc b/official/1.96/packages/c6/JclVersionControlExpertDLL.rc new file mode 100644 index 0000000..0dc3034 --- /dev/null +++ b/official/1.96/packages/c6/JclVersionControlExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertDLLC60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/c6/JclVersionControlExpertDLL.res b/official/1.96/packages/c6/JclVersionControlExpertDLL.res new file mode 100644 index 0000000..76acd0d Binary files /dev/null and b/official/1.96/packages/c6/JclVersionControlExpertDLL.res differ diff --git a/official/1.96/packages/c6/dirinfo.txt b/official/1.96/packages/c6/dirinfo.txt new file mode 100644 index 0000000..1d49fe4 --- /dev/null +++ b/official/1.96/packages/c6/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for C++Builder 6 packages. \ No newline at end of file diff --git a/official/1.96/packages/c6/template.bpf b/official/1.96/packages/c6/template.bpf new file mode 100644 index 0000000..66e6b5b --- /dev/null +++ b/official/1.96/packages/c6/template.bpf @@ -0,0 +1,20 @@ +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> +<%%% START FILES %%%> +USEUNIT("%FILENAME%"); +<%%% END FILES %%%> +USEDEF("%NAME%.def"); +Project file +<%%% BEGIN PROGRAMONLY %%%> +WinMain +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +DllEntryPoint +<%%% END LIBRARYONLY %%%> diff --git a/official/1.96/packages/c6/template.bpk b/official/1.96/packages/c6/template.bpk new file mode 100644 index 0000000..5d9a716 --- /dev/null +++ b/official/1.96/packages/c6/template.bpk @@ -0,0 +1,103 @@ + + + +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +<%%% START REQUIRES %%%> + +<%%% END REQUIRES %%%> +<%%% START LIBS %%%> + +<%%% END LIBS %%%> +<%%% START FILES %%%> + +<%%% END FILES %%%> + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/template.bpr b/official/1.96/packages/c6/template.bpr new file mode 100644 index 0000000..28bce87 --- /dev/null +++ b/official/1.96/packages/c6/template.bpr @@ -0,0 +1,103 @@ + + + +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +<%%% START REQUIRES %%%> + +<%%% END REQUIRES %%%> +<%%% START LIBS %%%> + +<%%% END LIBS %%%> +<%%% START FILES %%%> + +<%%% END FILES %%%> + + + + + +[Linker] +LibPrefix= +LibSuffix=C60 +LibVersion= + + diff --git a/official/1.96/packages/c6/template.cpp b/official/1.96/packages/c6/template.cpp new file mode 100644 index 0000000..9c16987 --- /dev/null +++ b/official/1.96/packages/c6/template.cpp @@ -0,0 +1,66 @@ +//--------------------------------------------------------------------------- +/* +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +*/ + +#include +#include +#pragma hdrstop +<%%% START FORMS %%%> +USEFORMNS("%FILENAME%", %Unitname%, %FORMNAME%); /* %FORMTYPE%: File Type */ +<%%% END FORMS %%%> +//--------------------------------------------------------------------------- +#pragma package(smart_init) +//--------------------------------------------------------------------------- +<%%% BEGIN PACKAGEONLY %%%> +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +// Package source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +<%%% END DESIGNONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +// Library source. +//--------------------------------------------------------------------------- +#pragma argsused +int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*) +{ + return 1; +} +<%%% END LIBRARYONLY %%%> +<%%% BEGIN PROGRAMONLY %%%> +// Program source. +//--------------------------------------------------------------------------- +#pragma argsused +WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow) +{ + return 0; +} +<%%% END PROGRAMONLY %%%> +//--------------------------------------------------------------------------- + diff --git a/official/1.96/packages/c6/template.dof b/official/1.96/packages/c6/template.dof new file mode 100644 index 0000000..49cc236 --- /dev/null +++ b/official/1.96/packages/c6/template.dof @@ -0,0 +1,10 @@ +[Directories] +UnitOutputDir=..\..\lib\c6 +SearchPath=..\..\source +<%%% BEGIN LIBRARYONLY %%%> +[Compiler] +PackageNoLink=1 +[Linker] +Packages=%NOLINKPACKAGELIST% +<%%% END LIBRARYONLY %%%> + diff --git a/official/1.96/packages/c6/template.dpk b/official/1.96/packages/c6/template.dpk new file mode 100644 index 0000000..472a207 --- /dev/null +++ b/official/1.96/packages/c6/template.dpk @@ -0,0 +1,54 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX 'C60'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; +end. \ No newline at end of file diff --git a/official/1.96/packages/c6/template.rc b/official/1.96/packages/c6/template.rc new file mode 100644 index 0000000..ff28b1c --- /dev/null +++ b/official/1.96/packages/c6/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%C60%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/cs1/Jcl.RES b/official/1.96/packages/cs1/Jcl.RES new file mode 100644 index 0000000..36feba5 Binary files /dev/null and b/official/1.96/packages/cs1/Jcl.RES differ diff --git a/official/1.96/packages/cs1/Jcl.bdsproj b/official/1.96/packages/cs1/Jcl.bdsproj new file mode 100644 index 0000000..d80d51d --- /dev/null +++ b/official/1.96/packages/cs1/Jcl.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + Jcl.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $48000000 + JEDI Code Library RTL package + + + + ..\..\lib\cs1 + + + ..\..\common + + + + True + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JEDI Code Library RTL package + 1.97.1.2172 + Jcl + Copyright (C) 1999, 2005 Project JEDI + + Jcl71.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/cs1/Jcl.dof b/official/1.96/packages/cs1/Jcl.dof new file mode 100644 index 0000000..d00a223 --- /dev/null +++ b/official/1.96/packages/cs1/Jcl.dof @@ -0,0 +1,7 @@ +[Directories] +UnitOutputDir=..\..\lib\cs1 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl diff --git a/official/1.96/packages/cs1/Jcl.dpk b/official/1.96/packages/cs1/Jcl.dpk new file mode 100644 index 0000000..107ce99 --- /dev/null +++ b/official/1.96/packages/cs1/Jcl.dpk @@ -0,0 +1,125 @@ +package Jcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 26-12-2005 14:30:14 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$LIBSUFFIX '71'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl + ; + +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' + ; + +end. diff --git a/official/1.96/packages/cs1/Jcl.rc b/official/1.96/packages/cs1/Jcl.rc new file mode 100644 index 0000000..99391c5 --- /dev/null +++ b/official/1.96/packages/cs1/Jcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "Jcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "Jcl71.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/cs1/JclBaseExpert.RES b/official/1.96/packages/cs1/JclBaseExpert.RES new file mode 100644 index 0000000..fd8337c Binary files /dev/null and b/official/1.96/packages/cs1/JclBaseExpert.RES differ diff --git a/official/1.96/packages/cs1/JclBaseExpert.bdsproj b/official/1.96/packages/cs1/JclBaseExpert.bdsproj new file mode 100644 index 0000000..0af4b2c --- /dev/null +++ b/official/1.96/packages/cs1/JclBaseExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclBaseExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58000000 + JCL Package containing common units for JCL Experts + + + + ..\..\lib\cs1 + + + ..\..\common + + + + True + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Package containing common units for JCL Experts + 1.97.1.2172 + JclBaseExpert + Copyright (C) 1999, 2005 Project JEDI + + JclBaseExpert71.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/cs1/JclBaseExpert.dof b/official/1.96/packages/cs1/JclBaseExpert.dof new file mode 100644 index 0000000..e171054 --- /dev/null +++ b/official/1.96/packages/cs1/JclBaseExpert.dof @@ -0,0 +1,7 @@ +[Directories] +UnitOutputDir=..\..\lib\cs1 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl diff --git a/official/1.96/packages/cs1/JclBaseExpert.dpk b/official/1.96/packages/cs1/JclBaseExpert.dpk new file mode 100644 index 0000000..3ddd628 --- /dev/null +++ b/official/1.96/packages/cs1/JclBaseExpert.dpk @@ -0,0 +1,54 @@ +package JclBaseExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 04-01-2006 22:23:23 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58000000} +{$DESCRIPTION 'JCL Package containing common units for JCL Experts'} +{$LIBSUFFIX '71'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl + ; + +contains + JclOtaUtils in '..\..\experts\common\JclOtaUtils.pas' , + JclOtaResources in '..\..\experts\common\JclOtaResources.pas' , + JclOtaConsts in '..\..\experts\common\JclOtaConsts.pas' , + JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm}, + JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm}, + JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame} + ; + +end. diff --git a/official/1.96/packages/cs1/JclBaseExpert.rc b/official/1.96/packages/cs1/JclBaseExpert.rc new file mode 100644 index 0000000..a7a0393 --- /dev/null +++ b/official/1.96/packages/cs1/JclBaseExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Package containing common units for JCL Experts\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclBaseExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclBaseExpert71.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.RES b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.RES new file mode 100644 index 0000000..66f0839 Binary files /dev/null and b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.RES differ diff --git a/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.bdsproj b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.bdsproj new file mode 100644 index 0000000..de51de5 --- /dev/null +++ b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclFavoriteFoldersExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58020000 + JCL Open and Save IDE dialogs with favorite folders + + + + ..\..\lib\cs1 + + + ..\..\common + + + + True + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Open and Save IDE dialogs with favorite folders + 1.97.1.2172 + JclFavoriteFoldersExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclFavoriteFoldersExpertDLL71.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.dof b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.dof new file mode 100644 index 0000000..a9fe08d --- /dev/null +++ b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.dof @@ -0,0 +1,7 @@ +[Directories] +UnitOutputDir=..\..\lib\cs1 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert diff --git a/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.dpr b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.dpr new file mode 100644 index 0000000..983dea7 --- /dev/null +++ b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclFavoriteFoldersExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpertDLL-L.xml) + + Last generated: 26-12-2005 14:33:14 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX '71'} + +uses + ToolsAPI, + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +begin +end. diff --git a/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.rc b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.rc new file mode 100644 index 0000000..9910a21 --- /dev/null +++ b/official/1.96/packages/cs1/JclFavoriteFoldersExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertDLL71.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/cs1/JclVersionControlExpertDLL.bdsproj b/official/1.96/packages/cs1/JclVersionControlExpertDLL.bdsproj new file mode 100644 index 0000000..6a26d3c --- /dev/null +++ b/official/1.96/packages/cs1/JclVersionControlExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclVersionControlExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58070000 + JCL Integration of version control systems in the IDE + + + + ..\..\lib\cs1 + + + ..\..\common + + + + True + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Integration of version control systems in the IDE + 1.97.1.2172 + JclVersionControlExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclVersionControlExpertDLL71.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/cs1/JclVersionControlExpertDLL.dof b/official/1.96/packages/cs1/JclVersionControlExpertDLL.dof new file mode 100644 index 0000000..a9fe08d --- /dev/null +++ b/official/1.96/packages/cs1/JclVersionControlExpertDLL.dof @@ -0,0 +1,7 @@ +[Directories] +UnitOutputDir=..\..\lib\cs1 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert diff --git a/official/1.96/packages/cs1/JclVersionControlExpertDLL.dpr b/official/1.96/packages/cs1/JclVersionControlExpertDLL.dpr new file mode 100644 index 0000000..0e6d4fe --- /dev/null +++ b/official/1.96/packages/cs1/JclVersionControlExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclVersionControlExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpertDLL-L.xml) + + Last generated: 15-01-2006 00:37:27 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX '71'} + +uses + ToolsAPI, + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +begin +end. diff --git a/official/1.96/packages/cs1/JclVersionControlExpertDLL.rc b/official/1.96/packages/cs1/JclVersionControlExpertDLL.rc new file mode 100644 index 0000000..6b64565 --- /dev/null +++ b/official/1.96/packages/cs1/JclVersionControlExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertDLL71.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/cs1/JclVersionControlExpertDLL.res b/official/1.96/packages/cs1/JclVersionControlExpertDLL.res new file mode 100644 index 0000000..4ef4d04 Binary files /dev/null and b/official/1.96/packages/cs1/JclVersionControlExpertDLL.res differ diff --git a/official/1.96/packages/cs1/template.bdsproj b/official/1.96/packages/cs1/template.bdsproj new file mode 100644 index 0000000..2038cbc --- /dev/null +++ b/official/1.96/packages/cs1/template.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + %NAME%%SOURCEEXTENSION% + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + %IMAGE_BASE% + %DESCRIPTION% + + + + ..\..\lib\cs1 + + + ..\..\common + + + + True + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + %VERSION_MAJOR_NUMBER% + %VERSION_MINOR_NUMBER% + %RELEASE_NUMBER% + %BUILD_NUMBER% + False + False + False + False + %ISDLL% + 1053 + 1252 + + + Project JEDI + %DESCRIPTION% + %VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER% + %NAME% + Copyright (C) 1999, 2005 Project JEDI + + %NAME%71%BINEXTENSION% + Jedi Code Library + %VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER% + + + diff --git a/official/1.96/packages/cs1/template.dof b/official/1.96/packages/cs1/template.dof new file mode 100644 index 0000000..1c6e540 --- /dev/null +++ b/official/1.96/packages/cs1/template.dof @@ -0,0 +1,9 @@ +[Directories] +UnitOutputDir=..\..\lib\cs1 +SearchPath=..\..\source;..\..\experts\common +<%%% BEGIN EXPERTONLY %%%> +[Compiler] +PackageNoLink=1 +[Linker] +Packages=%NOLINKPACKAGELIST% +<%%% END EXPERTONLY %%%> \ No newline at end of file diff --git a/official/1.96/packages/cs1/template.dpk b/official/1.96/packages/cs1/template.dpk new file mode 100644 index 0000000..21fc0bd --- /dev/null +++ b/official/1.96/packages/cs1/template.dpk @@ -0,0 +1,56 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '71'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. diff --git a/official/1.96/packages/cs1/template.dpr b/official/1.96/packages/cs1/template.dpr new file mode 100644 index 0000000..e51a393 --- /dev/null +++ b/official/1.96/packages/cs1/template.dpr @@ -0,0 +1,60 @@ +%PROJECT% %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '71'} + +uses +<%%% BEGIN EXPERTONLY %%%> + ToolsAPI, +<%%% END EXPERTONLY %%%> +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +<%%% BEGIN EXPERTONLY %%%> +exports + JCLWizardInit name WizardEntryPoint; +<%%% END EXPERTONLY %%%> + +begin +end. diff --git a/official/1.96/packages/cs1/template.rc b/official/1.96/packages/cs1/template.rc new file mode 100644 index 0000000..8f6a318 --- /dev/null +++ b/official/1.96/packages/cs1/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%71%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10.net/Jedi.Jcl.bdsproj b/official/1.96/packages/d10.net/Jedi.Jcl.bdsproj new file mode 100644 index 0000000..6a09b38 --- /dev/null +++ b/official/1.96/packages/d10.net/Jedi.Jcl.bdsproj @@ -0,0 +1,217 @@ + + + + + + + + + + + + Jedi.Jcl.dpr + + + 7.0 + + + 0 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Borland.Vcl.Windows;WinProcs=Borland.Vcl.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + Jedi.Jcl + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 0 + 1 + True + False + False + 4096 + 1048576 + 4194304 + + False + + + ..\..\bin + ..\..\lib\d10.net + + + + + + + True + + + + + + False + + + + + + False + + True + False + + + + $00000000 + + + + False + False + 1 + 96 + 1 + 2070 + False + False + False + False + False + 1031 + 1252 + + + + + 1.96.1.2070 + + + + + + 1.96.1.2070 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/d10.net/Jedi.Jcl.dpr b/official/1.96/packages/d10.net/Jedi.Jcl.dpr new file mode 100644 index 0000000..ca2b009 --- /dev/null +++ b/official/1.96/packages/d10.net/Jedi.Jcl.dpr @@ -0,0 +1,103 @@ +library Jedi.Jcl; + +uses + System.Reflection, + System.Runtime.InteropServices, + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas', + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas', + JclAnsiStrings in '..\..\source\common\JclAnsiStrings.pas', + JclArrayLists in '..\..\source\common\JclArrayLists.pas', + JclArraySets in '..\..\source\common\JclArraySets.pas', + JclBase in '..\..\source\common\JclBase.pas', + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas', + JclComplex in '..\..\source\common\JclComplex.pas', + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas', + JclDateTime in '..\..\source\common\JclDateTime.pas', + JclFileUtils in '..\..\source\common\JclFileUtils.pas', + JclHashSets in '..\..\source\common\JclHashSets.pas', + JclIniFiles in '..\..\source\common\JclIniFiles.pas', + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas', + JclLogic in '..\..\source\common\JclLogic.pas', + JclMath in '..\..\source\common\JclMath.pas', + JclMime in '..\..\source\common\JclMime.pas', + JclQueues in '..\..\source\common\JclQueues.pas', + JclResources in '..\..\source\common\JclResources.pas', + JclRTTI in '..\..\source\common\JclRTTI.pas', + JclStacks in '..\..\source\common\JclStacks.pas', + JclStatistics in '..\..\source\common\JclStatistics.pas', + JclStrings in '..\..\source\common\JclStrings.pas', + JclSysInfo in '..\..\source\common\JclSysInfo.pas', + JclSysUtils in '..\..\source\common\JclSysUtils.pas', + JclUnitConv in '..\..\source\common\JclUnitConv.pas', + JclValidation in '..\..\source\common\JclValidation.pas', + JclVectors in '..\..\source\common\JclVectors.pas', + JclHashMaps in '..\..\source\common\JclHashMaps.pas'; + +{$LIBSUFFIX '10'} + +[assembly: AssemblyTitle('JEDI Code Library')] +[assembly: AssemblyDescription('Functions and classes')] +[assembly: AssemblyConfiguration('')] +[assembly: AssemblyCompany('')] +[assembly: AssemblyProduct('JCL')] +[assembly: AssemblyCopyright('')] +[assembly: AssemblyTrademark('')] +[assembly: AssemblyCulture('')] + +// +// Die Versionsinformation einer Assemblierung enthält die folgenden vier Werte: +// +// Hauptversion +// Nebenversion +// Build-Nummer +// Revision +// +// Sie können alle vier Werte festlegen oder für Revision und Build-Nummer die +// Standardwerte mit '*' - wie nachfolgend gezeigt - verwenden: + +[assembly: AssemblyVersion('1.0.*')] + +// +// Zum Signieren einer Assemblierung müssen Sie einen Schlüssel angeben. Weitere Informationen +// über das Signieren von Assemblierungen finden Sie in der Microsoft .NET Framework-Dokumentation. +// +// Mit den folgenden Attributen steuern Sie, welcher Schlüssel für die Signatur verwendet wird. + +// Hinweise: +// (*) Wenn kein Schlüssel angegeben wird, ist die Assemblierung nicht signiert. +// (*) KeyName verweist auf einen Schlüssel, der im Crypto Service Provider +// (CSP) auf Ihrem Rechner installiert wurde. KeyFile verweist auf eine +// Datei, die einen Schlüssel enthält. +// (*) Wenn sowohl der KeyFile- als auch der KeyName-Wert angegeben ist, wird +// die folgende Verarbeitung durchgeführt: +// (1) Wenn KeyName in dem CSP gefunden wird, wird dieser Schlüssel verwendet. +// (2) Wenn KeyName nicht, aber KeyFile vorhanden ist, wird der Schlüssel +// in KeyFile im CSP installiert und verwendet. +// (*) Ein KeyFile können Sie mit dem Utility sn.exe (Starker Name) erzeugen. +// Der Speicherort von KeyFile sollte relativ zum Projektausgabeverzeichnis +// angegeben werden. Wenn sich Ihr KeyFile im Projektverzeichnis befindet, +// würden Sie das Attribut AssemblyKeyFile folgendermaßen festlegen: +// [assembly: AssemblyKeyFile('mykey.snk')], vorausgesetzt, Ihr +// Ausgabeverzeichnis ist das Projektverzeichnis (Vorgabe). +// (*) Verzögerte Signatur ist eine erweiterte Option; nähere Informationen +// dazu finden Sie in der Microsoft .NET Framework-Dokumentation. +// +[assembly: AssemblyDelaySign(false)] +[assembly: AssemblyKeyFile('')] +[assembly: AssemblyKeyName('')] + +// +// Verwenden Sie die folgenden Attribute zur Steuerung der COM-Sichtbarkeit Ihrer Assemblierung. +// Standardmäßig ist die gesamte Assemblierung für COM sichtbar. Die Einstellung false für ComVisible +// ist die für Ihre Assemblierung empfohlene Vorgabe. Um dann eine Klasse und ein Interface für COM +// bereitzustellen, setzen Sie jeweils ComVisible auf true. Es wird auch empfohlen das Attribut +// Guid hinzuzufügen. +// + +[assembly: ComVisible(False)] +//[assembly: Guid('')] +//[assembly: TypeLibVersion(1, 0)] + + +begin +end. diff --git a/official/1.96/packages/d10/Jcl.bdsproj b/official/1.96/packages/d10/Jcl.bdsproj new file mode 100644 index 0000000..2b85a0b --- /dev/null +++ b/official/1.96/packages/d10/Jcl.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + Jcl.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $48000000 + JEDI Code Library RTL package + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JEDI Code Library RTL package + 1.97.1.2172 + Jcl + Copyright (C) 1999, 2005 Project JEDI + + Jcl100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/Jcl.dof b/official/1.96/packages/d10/Jcl.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/Jcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/Jcl.dpk b/official/1.96/packages/d10/Jcl.dpk new file mode 100644 index 0000000..22e1d97 --- /dev/null +++ b/official/1.96/packages/d10/Jcl.dpk @@ -0,0 +1,126 @@ +package Jcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$LIBSUFFIX '100'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl + ; + +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWideFormat in '..\..\source\windows\JclWideFormat.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' + ; + +end. diff --git a/official/1.96/packages/d10/Jcl.rc b/official/1.96/packages/d10/Jcl.rc new file mode 100644 index 0000000..56d7211 --- /dev/null +++ b/official/1.96/packages/d10/Jcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "Jcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "Jcl100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/Jcl.res b/official/1.96/packages/d10/Jcl.res new file mode 100644 index 0000000..5c10a60 Binary files /dev/null and b/official/1.96/packages/d10/Jcl.res differ diff --git a/official/1.96/packages/d10/JclBaseExpert.bdsproj b/official/1.96/packages/d10/JclBaseExpert.bdsproj new file mode 100644 index 0000000..bf6a642 --- /dev/null +++ b/official/1.96/packages/d10/JclBaseExpert.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclBaseExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58000000 + JCL Package containing common units for JCL Experts + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Package containing common units for JCL Experts + 1.97.1.2172 + JclBaseExpert + Copyright (C) 1999, 2005 Project JEDI + + JclBaseExpert100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclBaseExpert.dof b/official/1.96/packages/d10/JclBaseExpert.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/JclBaseExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/JclBaseExpert.dpk b/official/1.96/packages/d10/JclBaseExpert.dpk new file mode 100644 index 0000000..7a121a2 --- /dev/null +++ b/official/1.96/packages/d10/JclBaseExpert.dpk @@ -0,0 +1,54 @@ +package JclBaseExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58000000} +{$DESCRIPTION 'JCL Package containing common units for JCL Experts'} +{$LIBSUFFIX '100'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl + ; + +contains + JclOtaUtils in '..\..\experts\common\JclOtaUtils.pas' , + JclOtaResources in '..\..\experts\common\JclOtaResources.pas' , + JclOtaConsts in '..\..\experts\common\JclOtaConsts.pas' , + JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm}, + JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm}, + JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame} + ; + +end. diff --git a/official/1.96/packages/d10/JclBaseExpert.rc b/official/1.96/packages/d10/JclBaseExpert.rc new file mode 100644 index 0000000..f6354e7 --- /dev/null +++ b/official/1.96/packages/d10/JclBaseExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Package containing common units for JCL Experts\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclBaseExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclBaseExpert100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclBaseExpert.res b/official/1.96/packages/d10/JclBaseExpert.res new file mode 100644 index 0000000..666bcee Binary files /dev/null and b/official/1.96/packages/d10/JclBaseExpert.res differ diff --git a/official/1.96/packages/d10/JclDebugExpert.bdsproj b/official/1.96/packages/d10/JclDebugExpert.bdsproj new file mode 100644 index 0000000..30b6709 --- /dev/null +++ b/official/1.96/packages/d10/JclDebugExpert.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclDebugExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58010000 + JCL Debug IDE extension + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Debug IDE extension + 1.97.1.2172 + JclDebugExpert + Copyright (C) 1999, 2005 Project JEDI + + JclDebugExpert100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclDebugExpert.dof b/official/1.96/packages/d10/JclDebugExpert.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/JclDebugExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/JclDebugExpert.dpk b/official/1.96/packages/d10/JclDebugExpert.dpk new file mode 100644 index 0000000..9ee9853 --- /dev/null +++ b/official/1.96/packages/d10/JclDebugExpert.dpk @@ -0,0 +1,51 @@ +package JclDebugExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpert-D.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$LIBSUFFIX '100'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d10/JclDebugExpert.rc b/official/1.96/packages/d10/JclDebugExpert.rc new file mode 100644 index 0000000..e293127 --- /dev/null +++ b/official/1.96/packages/d10/JclDebugExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpert100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclDebugExpert.res b/official/1.96/packages/d10/JclDebugExpert.res new file mode 100644 index 0000000..6b0ffeb Binary files /dev/null and b/official/1.96/packages/d10/JclDebugExpert.res differ diff --git a/official/1.96/packages/d10/JclDebugExpertDLL.bdsproj b/official/1.96/packages/d10/JclDebugExpertDLL.bdsproj new file mode 100644 index 0000000..3c7a02e --- /dev/null +++ b/official/1.96/packages/d10/JclDebugExpertDLL.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclDebugExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58010000 + JCL Debug IDE extension + False + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Debug IDE extension + 1.97.1.2172 + JclDebugExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclDebugExpertDLL100.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclDebugExpertDLL.dof b/official/1.96/packages/d10/JclDebugExpertDLL.dof new file mode 100644 index 0000000..4e4466b --- /dev/null +++ b/official/1.96/packages/d10/JclDebugExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d10/JclDebugExpertDLL.dpr b/official/1.96/packages/d10/JclDebugExpertDLL.dpr new file mode 100644 index 0000000..6f030b8 --- /dev/null +++ b/official/1.96/packages/d10/JclDebugExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclDebugExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpertDLL-L.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$LIBSUFFIX '100'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d10/JclDebugExpertDLL.rc b/official/1.96/packages/d10/JclDebugExpertDLL.rc new file mode 100644 index 0000000..34c2e55 --- /dev/null +++ b/official/1.96/packages/d10/JclDebugExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertDLL100.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclDebugExpertDLL.res b/official/1.96/packages/d10/JclDebugExpertDLL.res new file mode 100644 index 0000000..35fd4e4 Binary files /dev/null and b/official/1.96/packages/d10/JclDebugExpertDLL.res differ diff --git a/official/1.96/packages/d10/JclExperts.bdsgroup b/official/1.96/packages/d10/JclExperts.bdsgroup new file mode 100644 index 0000000..600aea1 --- /dev/null +++ b/official/1.96/packages/d10/JclExperts.bdsgroup @@ -0,0 +1,22 @@ + + + + + + + + + + + JclDebugExpert.bdsproj + JclSIMDViewExpert.bdsproj + JclProjectAnalysisExpert.bdsproj + JclFavoriteFoldersExpert.bdsproj + JclUsesExpert.bdsproj + JclThreadNameExpert.bdsproj + JclDebugExpert100.bpl JclSIMDViewExpert100.bpl JclProjectAnalysisExpert100.bpl JclFavoriteFoldersExpert100.bpl JclUsesExpert100.bpl JclThreadNameExpert100.bpl + + + + diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpert.bdsproj b/official/1.96/packages/d10/JclFavoriteFoldersExpert.bdsproj new file mode 100644 index 0000000..704f6b3 --- /dev/null +++ b/official/1.96/packages/d10/JclFavoriteFoldersExpert.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclFavoriteFoldersExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58020000 + JCL Open and Save IDE dialogs with favorite folders + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Open and Save IDE dialogs with favorite folders + 1.97.1.2172 + JclFavoriteFoldersExpert + Copyright (C) 1999, 2005 Project JEDI + + JclFavoriteFoldersExpert100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpert.dof b/official/1.96/packages/d10/JclFavoriteFoldersExpert.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/JclFavoriteFoldersExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpert.dpk b/official/1.96/packages/d10/JclFavoriteFoldersExpert.dpk new file mode 100644 index 0000000..df90e1d --- /dev/null +++ b/official/1.96/packages/d10/JclFavoriteFoldersExpert.dpk @@ -0,0 +1,51 @@ +package JclFavoriteFoldersExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpert-D.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX '100'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +end. diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpert.rc b/official/1.96/packages/d10/JclFavoriteFoldersExpert.rc new file mode 100644 index 0000000..ce63c17 --- /dev/null +++ b/official/1.96/packages/d10/JclFavoriteFoldersExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpert100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpert.res b/official/1.96/packages/d10/JclFavoriteFoldersExpert.res new file mode 100644 index 0000000..59d5d35 Binary files /dev/null and b/official/1.96/packages/d10/JclFavoriteFoldersExpert.res differ diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.bdsproj b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.bdsproj new file mode 100644 index 0000000..4476a5c --- /dev/null +++ b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclFavoriteFoldersExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58020000 + JCL Open and Save IDE dialogs with favorite folders + False + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Open and Save IDE dialogs with favorite folders + 1.97.1.2172 + JclFavoriteFoldersExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclFavoriteFoldersExpertDLL100.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.dof b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.dof new file mode 100644 index 0000000..4e4466b --- /dev/null +++ b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.dpr b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.dpr new file mode 100644 index 0000000..a60a1fb --- /dev/null +++ b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclFavoriteFoldersExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpertDLL-L.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX '100'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.rc b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.rc new file mode 100644 index 0000000..2c8f53c --- /dev/null +++ b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertDLL100.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.res b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.res new file mode 100644 index 0000000..c747aa0 Binary files /dev/null and b/official/1.96/packages/d10/JclFavoriteFoldersExpertDLL.res differ diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpert.RES b/official/1.96/packages/d10/JclProjectAnalysisExpert.RES new file mode 100644 index 0000000..905a539 Binary files /dev/null and b/official/1.96/packages/d10/JclProjectAnalysisExpert.RES differ diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpert.bdsproj b/official/1.96/packages/d10/JclProjectAnalysisExpert.bdsproj new file mode 100644 index 0000000..36bb10d --- /dev/null +++ b/official/1.96/packages/d10/JclProjectAnalysisExpert.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclProjectAnalysisExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58030000 + JCL Project Analyzer + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Project Analyzer + 1.97.1.2172 + JclProjectAnalysisExpert + Copyright (C) 1999, 2005 Project JEDI + + JclProjectAnalysisExpert100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpert.dof b/official/1.96/packages/d10/JclProjectAnalysisExpert.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/JclProjectAnalysisExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpert.dpk b/official/1.96/packages/d10/JclProjectAnalysisExpert.dpk new file mode 100644 index 0000000..0a47649 --- /dev/null +++ b/official/1.96/packages/d10/JclProjectAnalysisExpert.dpk @@ -0,0 +1,51 @@ +package JclProjectAnalysisExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpert-D.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$LIBSUFFIX '100'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpert.rc b/official/1.96/packages/d10/JclProjectAnalysisExpert.rc new file mode 100644 index 0000000..e407773 --- /dev/null +++ b/official/1.96/packages/d10/JclProjectAnalysisExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpert100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.bdsproj b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.bdsproj new file mode 100644 index 0000000..dee746f --- /dev/null +++ b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclProjectAnalysisExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58030000 + JCL Project Analyzer + False + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Project Analyzer + 1.97.1.2172 + JclProjectAnalysisExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclProjectAnalysisExpertDLL100.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.dof b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.dof new file mode 100644 index 0000000..4e4466b --- /dev/null +++ b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.dpr b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.dpr new file mode 100644 index 0000000..f942837 --- /dev/null +++ b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclProjectAnalysisExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpertDLL-L.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$LIBSUFFIX '100'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.rc b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.rc new file mode 100644 index 0000000..28f2c60 --- /dev/null +++ b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertDLL100.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.res b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.res new file mode 100644 index 0000000..8299e16 Binary files /dev/null and b/official/1.96/packages/d10/JclProjectAnalysisExpertDLL.res differ diff --git a/official/1.96/packages/d10/JclSIMDViewExpert.bdsproj b/official/1.96/packages/d10/JclSIMDViewExpert.bdsproj new file mode 100644 index 0000000..e1cc274 --- /dev/null +++ b/official/1.96/packages/d10/JclSIMDViewExpert.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclSIMDViewExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58040000 + JCL Debug Window of XMM registers + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Debug Window of XMM registers + 1.97.1.2172 + JclSIMDViewExpert + Copyright (C) 1999, 2005 Project JEDI + + JclSIMDViewExpert100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclSIMDViewExpert.dof b/official/1.96/packages/d10/JclSIMDViewExpert.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/JclSIMDViewExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/JclSIMDViewExpert.dpk b/official/1.96/packages/d10/JclSIMDViewExpert.dpk new file mode 100644 index 0000000..2f5b68d --- /dev/null +++ b/official/1.96/packages/d10/JclSIMDViewExpert.dpk @@ -0,0 +1,54 @@ +package JclSIMDViewExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpert-D.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$LIBSUFFIX '100'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +end. diff --git a/official/1.96/packages/d10/JclSIMDViewExpert.rc b/official/1.96/packages/d10/JclSIMDViewExpert.rc new file mode 100644 index 0000000..8a5e48d --- /dev/null +++ b/official/1.96/packages/d10/JclSIMDViewExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpert100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclSIMDViewExpert.res b/official/1.96/packages/d10/JclSIMDViewExpert.res new file mode 100644 index 0000000..69d4075 Binary files /dev/null and b/official/1.96/packages/d10/JclSIMDViewExpert.res differ diff --git a/official/1.96/packages/d10/JclSIMDViewExpertDLL.bdsproj b/official/1.96/packages/d10/JclSIMDViewExpertDLL.bdsproj new file mode 100644 index 0000000..556b8f6 --- /dev/null +++ b/official/1.96/packages/d10/JclSIMDViewExpertDLL.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclSIMDViewExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58040000 + JCL Debug Window of XMM registers + False + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Debug Window of XMM registers + 1.97.1.2172 + JclSIMDViewExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclSIMDViewExpertDLL100.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclSIMDViewExpertDLL.dof b/official/1.96/packages/d10/JclSIMDViewExpertDLL.dof new file mode 100644 index 0000000..4e4466b --- /dev/null +++ b/official/1.96/packages/d10/JclSIMDViewExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d10/JclSIMDViewExpertDLL.dpr b/official/1.96/packages/d10/JclSIMDViewExpertDLL.dpr new file mode 100644 index 0000000..10bf643 --- /dev/null +++ b/official/1.96/packages/d10/JclSIMDViewExpertDLL.dpr @@ -0,0 +1,49 @@ +Library JclSIMDViewExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpertDLL-L.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$LIBSUFFIX '100'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d10/JclSIMDViewExpertDLL.rc b/official/1.96/packages/d10/JclSIMDViewExpertDLL.rc new file mode 100644 index 0000000..4725157 --- /dev/null +++ b/official/1.96/packages/d10/JclSIMDViewExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertDLL100.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclSIMDViewExpertDLL.res b/official/1.96/packages/d10/JclSIMDViewExpertDLL.res new file mode 100644 index 0000000..29cd03b Binary files /dev/null and b/official/1.96/packages/d10/JclSIMDViewExpertDLL.res differ diff --git a/official/1.96/packages/d10/JclThreadNameExpert.bdsproj b/official/1.96/packages/d10/JclThreadNameExpert.bdsproj new file mode 100644 index 0000000..9221b9d --- /dev/null +++ b/official/1.96/packages/d10/JclThreadNameExpert.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclThreadNameExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58050000 + JCL Thread Name IDE expert + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Thread Name IDE expert + 1.97.1.2172 + JclThreadNameExpert + Copyright (C) 1999, 2005 Project JEDI + + JclThreadNameExpert100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclThreadNameExpert.dof b/official/1.96/packages/d10/JclThreadNameExpert.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/JclThreadNameExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/JclThreadNameExpert.dpk b/official/1.96/packages/d10/JclThreadNameExpert.dpk new file mode 100644 index 0000000..44b6fc8 --- /dev/null +++ b/official/1.96/packages/d10/JclThreadNameExpert.dpk @@ -0,0 +1,51 @@ +package JclThreadNameExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpert-D.xml) + + Last generated: 21-10-2005 23:10:30 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$LIBSUFFIX '100'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +end. diff --git a/official/1.96/packages/d10/JclThreadNameExpert.rc b/official/1.96/packages/d10/JclThreadNameExpert.rc new file mode 100644 index 0000000..c568913 --- /dev/null +++ b/official/1.96/packages/d10/JclThreadNameExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpert100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclThreadNameExpert.res b/official/1.96/packages/d10/JclThreadNameExpert.res new file mode 100644 index 0000000..208491d Binary files /dev/null and b/official/1.96/packages/d10/JclThreadNameExpert.res differ diff --git a/official/1.96/packages/d10/JclThreadNameExpertDLL.bdsproj b/official/1.96/packages/d10/JclThreadNameExpertDLL.bdsproj new file mode 100644 index 0000000..6941aab --- /dev/null +++ b/official/1.96/packages/d10/JclThreadNameExpertDLL.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclThreadNameExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58050000 + JCL Thread Name IDE expert + False + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Thread Name IDE expert + 1.97.1.2172 + JclThreadNameExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclThreadNameExpertDLL100.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclThreadNameExpertDLL.dof b/official/1.96/packages/d10/JclThreadNameExpertDLL.dof new file mode 100644 index 0000000..4e4466b --- /dev/null +++ b/official/1.96/packages/d10/JclThreadNameExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d10/JclThreadNameExpertDLL.dpr b/official/1.96/packages/d10/JclThreadNameExpertDLL.dpr new file mode 100644 index 0000000..6d7acee --- /dev/null +++ b/official/1.96/packages/d10/JclThreadNameExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclThreadNameExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpertDLL-L.xml) + + Last generated: 26-12-2005 14:12:49 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$LIBSUFFIX '100'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d10/JclThreadNameExpertDLL.rc b/official/1.96/packages/d10/JclThreadNameExpertDLL.rc new file mode 100644 index 0000000..069d9c5 --- /dev/null +++ b/official/1.96/packages/d10/JclThreadNameExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertDLL100.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclThreadNameExpertDLL.res b/official/1.96/packages/d10/JclThreadNameExpertDLL.res new file mode 100644 index 0000000..61642a4 Binary files /dev/null and b/official/1.96/packages/d10/JclThreadNameExpertDLL.res differ diff --git a/official/1.96/packages/d10/JclUsesExpert.bdsproj b/official/1.96/packages/d10/JclUsesExpert.bdsproj new file mode 100644 index 0000000..6873cd7 --- /dev/null +++ b/official/1.96/packages/d10/JclUsesExpert.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclUsesExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58060000 + JCL Uses Wizard + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Uses Wizard + 1.97.1.2172 + JclUsesExpert + Copyright (C) 1999, 2005 Project JEDI + + JclUsesExpert100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclUsesExpert.dof b/official/1.96/packages/d10/JclUsesExpert.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/JclUsesExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/JclUsesExpert.dpk b/official/1.96/packages/d10/JclUsesExpert.dpk new file mode 100644 index 0000000..e2bf43d --- /dev/null +++ b/official/1.96/packages/d10/JclUsesExpert.dpk @@ -0,0 +1,53 @@ +package JclUsesExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpert-D.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$LIBSUFFIX '100'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +end. diff --git a/official/1.96/packages/d10/JclUsesExpert.rc b/official/1.96/packages/d10/JclUsesExpert.rc new file mode 100644 index 0000000..40327a4 --- /dev/null +++ b/official/1.96/packages/d10/JclUsesExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpert100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclUsesExpert.res b/official/1.96/packages/d10/JclUsesExpert.res new file mode 100644 index 0000000..4f3c37c Binary files /dev/null and b/official/1.96/packages/d10/JclUsesExpert.res differ diff --git a/official/1.96/packages/d10/JclUsesExpertDLL.bdsproj b/official/1.96/packages/d10/JclUsesExpertDLL.bdsproj new file mode 100644 index 0000000..0857126 --- /dev/null +++ b/official/1.96/packages/d10/JclUsesExpertDLL.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclUsesExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58060000 + JCL Uses Wizard + False + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Uses Wizard + 1.97.1.2172 + JclUsesExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclUsesExpertDLL100.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclUsesExpertDLL.dof b/official/1.96/packages/d10/JclUsesExpertDLL.dof new file mode 100644 index 0000000..4e4466b --- /dev/null +++ b/official/1.96/packages/d10/JclUsesExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d10/JclUsesExpertDLL.dpr b/official/1.96/packages/d10/JclUsesExpertDLL.dpr new file mode 100644 index 0000000..46ffa07 --- /dev/null +++ b/official/1.96/packages/d10/JclUsesExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclUsesExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpertDLL-L.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$LIBSUFFIX '100'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d10/JclUsesExpertDLL.rc b/official/1.96/packages/d10/JclUsesExpertDLL.rc new file mode 100644 index 0000000..eaf7e85 --- /dev/null +++ b/official/1.96/packages/d10/JclUsesExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertDLL100.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclUsesExpertDLL.res b/official/1.96/packages/d10/JclUsesExpertDLL.res new file mode 100644 index 0000000..49fe550 Binary files /dev/null and b/official/1.96/packages/d10/JclUsesExpertDLL.res differ diff --git a/official/1.96/packages/d10/JclVcl.bdsproj b/official/1.96/packages/d10/JclVcl.bdsproj new file mode 100644 index 0000000..5c9358c --- /dev/null +++ b/official/1.96/packages/d10/JclVcl.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclVcl.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $48200000 + JEDI Code Library VCL package + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;vcljpg;Jcl + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JEDI Code Library VCL package + 1.97.1.2172 + JclVcl + Copyright (C) 1999, 2005 Project JEDI + + JclVcl100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclVcl.dof b/official/1.96/packages/d10/JclVcl.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/JclVcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/JclVcl.dpk b/official/1.96/packages/d10/JclVcl.dpk new file mode 100644 index 0000000..39a35e4 --- /dev/null +++ b/official/1.96/packages/d10/JclVcl.dpk @@ -0,0 +1,51 @@ +package JclVcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml) + + Last generated: 10-01-2006 20:57:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $48200000} +{$DESCRIPTION 'JEDI Code Library VCL package'} +{$LIBSUFFIX '100'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + vcljpg, + Jcl + ; + +contains + JclPrint in '..\..\source\vcl\JclPrint.pas' , + JclGraphUtils in '..\..\source\vcl\JclGraphUtils.pas' , + JclGraphics in '..\..\source\vcl\JclGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/d10/JclVcl.rc b/official/1.96/packages/d10/JclVcl.rc new file mode 100644 index 0000000..aba487e --- /dev/null +++ b/official/1.96/packages/d10/JclVcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VCL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVcl100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclVcl.res b/official/1.96/packages/d10/JclVcl.res new file mode 100644 index 0000000..ee6b471 Binary files /dev/null and b/official/1.96/packages/d10/JclVcl.res differ diff --git a/official/1.96/packages/d10/JclVersionControlExpert.bdsproj b/official/1.96/packages/d10/JclVersionControlExpert.bdsproj new file mode 100644 index 0000000..1268262 --- /dev/null +++ b/official/1.96/packages/d10/JclVersionControlExpert.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclVersionControlExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58070000 + JCL Integration of version control systems in the IDE + True + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Integration of version control systems in the IDE + 1.97.1.2172 + JclVersionControlExpert + Copyright (C) 1999, 2005 Project JEDI + + JclVersionControlExpert100.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclVersionControlExpert.dof b/official/1.96/packages/d10/JclVersionControlExpert.dof new file mode 100644 index 0000000..6177f27 --- /dev/null +++ b/official/1.96/packages/d10/JclVersionControlExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d10/JclVersionControlExpert.dpk b/official/1.96/packages/d10/JclVersionControlExpert.dpk new file mode 100644 index 0000000..958e905 --- /dev/null +++ b/official/1.96/packages/d10/JclVersionControlExpert.dpk @@ -0,0 +1,53 @@ +package JclVersionControlExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpert-D.xml) + + Last generated: 25-01-2006 20:40:55 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX '100'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d10/JclVersionControlExpert.rc b/official/1.96/packages/d10/JclVersionControlExpert.rc new file mode 100644 index 0000000..9872277 --- /dev/null +++ b/official/1.96/packages/d10/JclVersionControlExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpert100.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/JclVersionControlExpert.res b/official/1.96/packages/d10/JclVersionControlExpert.res new file mode 100644 index 0000000..4d41f76 Binary files /dev/null and b/official/1.96/packages/d10/JclVersionControlExpert.res differ diff --git a/official/1.96/packages/d10/JclVersionControlExpertDLL.bdsproj b/official/1.96/packages/d10/JclVersionControlExpertDLL.bdsproj new file mode 100644 index 0000000..092fc51 --- /dev/null +++ b/official/1.96/packages/d10/JclVersionControlExpertDLL.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + JclVersionControlExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + $58070000 + JCL Integration of version control systems in the IDE + False + + + ..\..\lib\d10 + ..\..\source + + + + rtl;vcl;designide;Jcl;JclBaseExpert + + + True + + + + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Integration of version control systems in the IDE + 1.97.1.2172 + JclVersionControlExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclVersionControlExpertDLL100.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d10/JclVersionControlExpertDLL.dof b/official/1.96/packages/d10/JclVersionControlExpertDLL.dof new file mode 100644 index 0000000..4e4466b --- /dev/null +++ b/official/1.96/packages/d10/JclVersionControlExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d10/JclVersionControlExpertDLL.dpr b/official/1.96/packages/d10/JclVersionControlExpertDLL.dpr new file mode 100644 index 0000000..e11ebe4 --- /dev/null +++ b/official/1.96/packages/d10/JclVersionControlExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclVersionControlExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpertDLL-L.xml) + + Last generated: 15-01-2006 00:37:28 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX '100'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d10/JclVersionControlExpertDLL.rc b/official/1.96/packages/d10/JclVersionControlExpertDLL.rc new file mode 100644 index 0000000..5d021e8 --- /dev/null +++ b/official/1.96/packages/d10/JclVersionControlExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertDLL100.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d10/Jedi.Jcl.bdsproj b/official/1.96/packages/d10/Jedi.Jcl.bdsproj new file mode 100644 index 0000000..f25d1d3 --- /dev/null +++ b/official/1.96/packages/d10/Jedi.Jcl.bdsproj @@ -0,0 +1,210 @@ + + + + + + + + + + + + Jedi.Jcl.dpr + + + 7.0 + + + 0 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Borland.Vcl.Windows;WinProcs=Borland.Vcl.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + Jedi.Jcl + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True True + True + + + + 0 + 0 + 1 + True + False + False + 4096 + 1048576 + 4194304 + False + + + ..\..\bin + ..\..\lib\d10 + + + ..\..\source + + + + True + + + + + + False + + + + + + False + True + False + + + + $00000000 + + + + False + False + 1 + 96 + 1 + 2070 + False + False + False + False + False + 1031 + 1252 + + + + + 1.96.1.2070 + + + + + + 1.96.1.2070 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/d10/Jedi.Jcl.dpr b/official/1.96/packages/d10/Jedi.Jcl.dpr new file mode 100644 index 0000000..c55f7f0 --- /dev/null +++ b/official/1.96/packages/d10/Jedi.Jcl.dpr @@ -0,0 +1,101 @@ +library Jedi.Jcl; + +uses + System.Reflection, + System.Runtime.InteropServices, + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas', + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas', + JclAnsiStrings in '..\..\source\common\JclAnsiStrings.pas', + JclArrayLists in '..\..\source\common\JclArrayLists.pas', + JclArraySets in '..\..\source\common\JclArraySets.pas', + JclBase in '..\..\source\common\JclBase.pas', + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas', + JclComplex in '..\..\source\common\JclComplex.pas', + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas', + JclDateTime in '..\..\source\common\JclDateTime.pas', + JclFileUtils in '..\..\source\common\JclFileUtils.pas', + JclHashSets in '..\..\source\common\JclHashSets.pas', + JclIniFiles in '..\..\source\common\JclIniFiles.pas', + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas', + JclLogic in '..\..\source\common\JclLogic.pas', + JclMath in '..\..\source\common\JclMath.pas', + JclMime in '..\..\source\common\JclMime.pas', + JclQueues in '..\..\source\common\JclQueues.pas', + JclResources in '..\..\source\common\JclResources.pas', + JclRTTI in '..\..\source\common\JclRTTI.pas', + JclStacks in '..\..\source\common\JclStacks.pas', + JclStatistics in '..\..\source\common\JclStatistics.pas', + JclStrings in '..\..\source\common\JclStrings.pas', + JclSysInfo in '..\..\source\common\JclSysInfo.pas', + JclSysUtils in '..\..\source\common\JclSysUtils.pas', + JclUnitConv in '..\..\source\common\JclUnitConv.pas', + JclValidation in '..\..\source\common\JclValidation.pas', + JclVectors in '..\..\source\common\JclVectors.pas', + JclHashMaps in '..\..\source\common\JclHashMaps.pas'; + +[assembly: AssemblyTitle('JEDI Code Library')] +[assembly: AssemblyDescription('Functions and classes')] +[assembly: AssemblyConfiguration('')] +[assembly: AssemblyCompany('')] +[assembly: AssemblyProduct('JCL')] +[assembly: AssemblyCopyright('')] +[assembly: AssemblyTrademark('')] +[assembly: AssemblyCulture('')] + +// +// Die Versionsinformation einer Assemblierung enthält die folgenden vier Werte: +// +// Hauptversion +// Nebenversion +// Build-Nummer +// Revision +// +// Sie können alle vier Werte festlegen oder für Revision und Build-Nummer die +// Standardwerte mit '*' - wie nachfolgend gezeigt - verwenden: + +[assembly: AssemblyVersion('1.0.*')] + +// +// Zum Signieren einer Assemblierung müssen Sie einen Schlüssel angeben. Weitere Informationen +// über das Signieren von Assemblierungen finden Sie in der Microsoft .NET Framework-Dokumentation. +// +// Mit den folgenden Attributen steuern Sie, welcher Schlüssel für die Signatur verwendet wird. + +// Hinweise: +// (*) Wenn kein Schlüssel angegeben wird, ist die Assemblierung nicht signiert. +// (*) KeyName verweist auf einen Schlüssel, der im Crypto Service Provider +// (CSP) auf Ihrem Rechner installiert wurde. KeyFile verweist auf eine +// Datei, die einen Schlüssel enthält. +// (*) Wenn sowohl der KeyFile- als auch der KeyName-Wert angegeben ist, wird +// die folgende Verarbeitung durchgeführt: +// (1) Wenn KeyName in dem CSP gefunden wird, wird dieser Schlüssel verwendet. +// (2) Wenn KeyName nicht, aber KeyFile vorhanden ist, wird der Schlüssel +// in KeyFile im CSP installiert und verwendet. +// (*) Ein KeyFile können Sie mit dem Utility sn.exe (Starker Name) erzeugen. +// Der Speicherort von KeyFile sollte relativ zum Projektausgabeverzeichnis +// angegeben werden. Wenn sich Ihr KeyFile im Projektverzeichnis befindet, +// würden Sie das Attribut AssemblyKeyFile folgendermaßen festlegen: +// [assembly: AssemblyKeyFile('mykey.snk')], vorausgesetzt, Ihr +// Ausgabeverzeichnis ist das Projektverzeichnis (Vorgabe). +// (*) Verzögerte Signatur ist eine erweiterte Option; nähere Informationen +// dazu finden Sie in der Microsoft .NET Framework-Dokumentation. +// +[assembly: AssemblyDelaySign(false)] +[assembly: AssemblyKeyFile('')] +[assembly: AssemblyKeyName('')] + +// +// Verwenden Sie die folgenden Attribute zur Steuerung der COM-Sichtbarkeit Ihrer Assemblierung. +// Standardmäßig ist die gesamte Assemblierung für COM sichtbar. Die Einstellung false für ComVisible +// ist die für Ihre Assemblierung empfohlene Vorgabe. Um dann eine Klasse und ein Interface für COM +// bereitzustellen, setzen Sie jeweils ComVisible auf true. Es wird auch empfohlen das Attribut +// Guid hinzuzufügen. +// + +[assembly: ComVisible(False)] +//[assembly: Guid('')] +//[assembly: TypeLibVersion(1, 0)] + + +begin +end. diff --git a/official/1.96/packages/d10/template.bdsproj b/official/1.96/packages/d10/template.bdsproj new file mode 100644 index 0000000..2cb18a8 --- /dev/null +++ b/official/1.96/packages/d10/template.bdsproj @@ -0,0 +1,163 @@ + + + + + + + + + + + + %NAME%%SOURCEEXTENSION% + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 44 + 1 + False + False + False + 16384 + 1048576 + %IMAGE_BASE% + %DESCRIPTION% + %ISPACKAGE% + + + ..\..\lib\d10 + ..\..\source + + + + %NOLINKPACKAGELIST% + + + True + + + + + + + True + False + %VERSION_MAJOR_NUMBER% + %VERSION_MINOR_NUMBER% + %RELEASE_NUMBER% + %BUILD_NUMBER% + False + False + False + False + %ISDLL% + 1053 + 1252 + + + Project JEDI + %DESCRIPTION% + %VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER% + %NAME% + Copyright (C) 1999, 2005 Project JEDI + + %NAME%100%BINEXTENSION% + Jedi Code Library + %VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER% + + + diff --git a/official/1.96/packages/d10/template.dof b/official/1.96/packages/d10/template.dof new file mode 100644 index 0000000..ecbb03e --- /dev/null +++ b/official/1.96/packages/d10/template.dof @@ -0,0 +1,10 @@ +[Directories] +UnitOutputDir=..\..\lib\d10 +SearchPath=..\..\source +<%%% BEGIN LIBRARYONLY %%%> +[Compiler] +PackageNoLink=1 +[Linker] +Packages=%NOLINKPACKAGELIST% +<%%% END LIBRARYONLY %%%> + diff --git a/official/1.96/packages/d10/template.dpk b/official/1.96/packages/d10/template.dpk new file mode 100644 index 0000000..85673e1 --- /dev/null +++ b/official/1.96/packages/d10/template.dpk @@ -0,0 +1,56 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '100'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. diff --git a/official/1.96/packages/d10/template.dpr b/official/1.96/packages/d10/template.dpr new file mode 100644 index 0000000..c94cf6a --- /dev/null +++ b/official/1.96/packages/d10/template.dpr @@ -0,0 +1,58 @@ +%PROJECT% %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '100'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +<%%% BEGIN LIBRARYONLY %%%> +exports + JCLWizardInit name WizardEntryPoint; +<%%% END LIBRARYONLY %%%> + +end. diff --git a/official/1.96/packages/d10/template.rc b/official/1.96/packages/d10/template.rc new file mode 100644 index 0000000..b3a90a0 --- /dev/null +++ b/official/1.96/packages/d10/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%100%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5.dev/JclD50.dof b/official/1.96/packages/d5.dev/JclD50.dof new file mode 100644 index 0000000..a43d358 --- /dev/null +++ b/official/1.96/packages/d5.dev/JclD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d5.dev/JclD50.dpk b/official/1.96/packages/d5.dev/JclD50.dpk new file mode 100644 index 0000000..7caa944 --- /dev/null +++ b/official/1.96/packages/d5.dev/JclD50.dpk @@ -0,0 +1,128 @@ +package JclD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl + ; + +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWideFormat in '..\..\source\windows\JclWideFormat.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' , + JclPrint in '..\..\source\vcl\JclPrint.pas' , + JclGraphics in '..\..\source\prototypes\JclGraphics.pas' , + JclGraphUtils in '..\..\source\prototypes\JclGraphUtils.pas' + ; + +end. diff --git a/official/1.96/packages/d5.dev/JclD50.rc b/official/1.96/packages/d5.dev/JclD50.rc new file mode 100644 index 0000000..9b87489 --- /dev/null +++ b/official/1.96/packages/d5.dev/JclD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5.dev/JclD50.res b/official/1.96/packages/d5.dev/JclD50.res new file mode 100644 index 0000000..28e178b Binary files /dev/null and b/official/1.96/packages/d5.dev/JclD50.res differ diff --git a/official/1.96/packages/d5.dev/dirinfo.txt b/official/1.96/packages/d5.dev/dirinfo.txt new file mode 100644 index 0000000..327d258 --- /dev/null +++ b/official/1.96/packages/d5.dev/dirinfo.txt @@ -0,0 +1,4 @@ +This is where JCL development packages for Delphi 5 reside. + +Those packages are used instead of the standard packages of the same name for +prototype unit testing and not intended for release. diff --git a/official/1.96/packages/d5.dev/template.dof b/official/1.96/packages/d5.dev/template.dof new file mode 100644 index 0000000..a43d358 --- /dev/null +++ b/official/1.96/packages/d5.dev/template.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source + diff --git a/official/1.96/packages/d5.dev/template.dpk b/official/1.96/packages/d5.dev/template.dpk new file mode 100644 index 0000000..87b1dd2 --- /dev/null +++ b/official/1.96/packages/d5.dev/template.dpk @@ -0,0 +1,49 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. \ No newline at end of file diff --git a/official/1.96/packages/d5.dev/template.rc b/official/1.96/packages/d5.dev/template.rc new file mode 100644 index 0000000..568736b --- /dev/null +++ b/official/1.96/packages/d5.dev/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%D50%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclBaseExpertD50.dof b/official/1.96/packages/d5/JclBaseExpertD50.dof new file mode 100644 index 0000000..56fdeb3 --- /dev/null +++ b/official/1.96/packages/d5/JclBaseExpertD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d5/JclBaseExpertD50.dpk b/official/1.96/packages/d5/JclBaseExpertD50.dpk new file mode 100644 index 0000000..d48160a --- /dev/null +++ b/official/1.96/packages/d5/JclBaseExpertD50.dpk @@ -0,0 +1,52 @@ +package JclBaseExpertD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 04-01-2006 22:23:22 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58000000} +{$DESCRIPTION 'JCL Package containing common units for JCL Experts'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclD50 + ; + +contains + JclOtaUtils in '..\..\experts\common\JclOtaUtils.pas' , + JclOtaResources in '..\..\experts\common\JclOtaResources.pas' , + JclOtaConsts in '..\..\experts\common\JclOtaConsts.pas' , + JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm}, + JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm}, + JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame} + ; + +end. diff --git a/official/1.96/packages/d5/JclBaseExpertD50.rc b/official/1.96/packages/d5/JclBaseExpertD50.rc new file mode 100644 index 0000000..206c322 --- /dev/null +++ b/official/1.96/packages/d5/JclBaseExpertD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Package containing common units for JCL Experts\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclBaseExpertD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclBaseExpertD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclBaseExpertD50.res b/official/1.96/packages/d5/JclBaseExpertD50.res new file mode 100644 index 0000000..c4504fe Binary files /dev/null and b/official/1.96/packages/d5/JclBaseExpertD50.res differ diff --git a/official/1.96/packages/d5/JclD50.RES b/official/1.96/packages/d5/JclD50.RES new file mode 100644 index 0000000..28e178b Binary files /dev/null and b/official/1.96/packages/d5/JclD50.RES differ diff --git a/official/1.96/packages/d5/JclD50.dof b/official/1.96/packages/d5/JclD50.dof new file mode 100644 index 0000000..56fdeb3 --- /dev/null +++ b/official/1.96/packages/d5/JclD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d5/JclD50.dpk b/official/1.96/packages/d5/JclD50.dpk new file mode 100644 index 0000000..f6580ae --- /dev/null +++ b/official/1.96/packages/d5/JclD50.dpk @@ -0,0 +1,129 @@ +package JclD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + vcljpg50 + ; + +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWideFormat in '..\..\source\windows\JclWideFormat.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' , + JclGraphics in '..\..\source\vcl\JclGraphics.pas' , + JclGraphUtils in '..\..\source\vcl\JclGraphUtils.pas' , + JclPrint in '..\..\source\vcl\JclPrint.pas' + ; + +end. diff --git a/official/1.96/packages/d5/JclD50.rc b/official/1.96/packages/d5/JclD50.rc new file mode 100644 index 0000000..9b87489 --- /dev/null +++ b/official/1.96/packages/d5/JclD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclDebugExpertD50.RES b/official/1.96/packages/d5/JclDebugExpertD50.RES new file mode 100644 index 0000000..e3f85fa Binary files /dev/null and b/official/1.96/packages/d5/JclDebugExpertD50.RES differ diff --git a/official/1.96/packages/d5/JclDebugExpertD50.dof b/official/1.96/packages/d5/JclDebugExpertD50.dof new file mode 100644 index 0000000..56fdeb3 --- /dev/null +++ b/official/1.96/packages/d5/JclDebugExpertD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d5/JclDebugExpertD50.dpk b/official/1.96/packages/d5/JclDebugExpertD50.dpk new file mode 100644 index 0000000..ffc2864 --- /dev/null +++ b/official/1.96/packages/d5/JclDebugExpertD50.dpk @@ -0,0 +1,49 @@ +package JclDebugExpertD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclD50, + JclBaseExpertD50 + ; + +contains + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d5/JclDebugExpertD50.rc b/official/1.96/packages/d5/JclDebugExpertD50.rc new file mode 100644 index 0000000..ac2ca9c --- /dev/null +++ b/official/1.96/packages/d5/JclDebugExpertD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpertD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclDebugExpertDLLD50.RES b/official/1.96/packages/d5/JclDebugExpertDLLD50.RES new file mode 100644 index 0000000..3e860d6 Binary files /dev/null and b/official/1.96/packages/d5/JclDebugExpertDLLD50.RES differ diff --git a/official/1.96/packages/d5/JclDebugExpertDLLD50.dof b/official/1.96/packages/d5/JclDebugExpertDLLD50.dof new file mode 100644 index 0000000..a36d5ed --- /dev/null +++ b/official/1.96/packages/d5/JclDebugExpertDLLD50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclD50;JclBaseExpertD50 + diff --git a/official/1.96/packages/d5/JclDebugExpertDLLD50.dpr b/official/1.96/packages/d5/JclDebugExpertDLLD50.dpr new file mode 100644 index 0000000..824299b --- /dev/null +++ b/official/1.96/packages/d5/JclDebugExpertDLLD50.dpr @@ -0,0 +1,45 @@ +Library JclDebugExpertDLLD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpertDLL-L.xml) + + Last generated: 26-12-2005 12:57:54 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d5/JclDebugExpertDLLD50.rc b/official/1.96/packages/d5/JclDebugExpertDLLD50.rc new file mode 100644 index 0000000..87c6ae5 --- /dev/null +++ b/official/1.96/packages/d5/JclDebugExpertDLLD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpertDLLD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertDLLD50D50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.RES b/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.RES new file mode 100644 index 0000000..147ea45 Binary files /dev/null and b/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.RES differ diff --git a/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.dof b/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.dof new file mode 100644 index 0000000..56fdeb3 --- /dev/null +++ b/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.dpk b/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.dpk new file mode 100644 index 0000000..d041c83 --- /dev/null +++ b/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.dpk @@ -0,0 +1,49 @@ +package JclFavoriteFoldersExpertD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclD50, + JclBaseExpertD50 + ; + +contains + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +end. diff --git a/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.rc b/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.rc new file mode 100644 index 0000000..7781c86 --- /dev/null +++ b/official/1.96/packages/d5/JclFavoriteFoldersExpertD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.RES b/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.RES new file mode 100644 index 0000000..70eeafd Binary files /dev/null and b/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.RES differ diff --git a/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.dof b/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.dof new file mode 100644 index 0000000..a36d5ed --- /dev/null +++ b/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclD50;JclBaseExpertD50 + diff --git a/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.dpr b/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.dpr new file mode 100644 index 0000000..481eb53 --- /dev/null +++ b/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.dpr @@ -0,0 +1,45 @@ +Library JclFavoriteFoldersExpertDLLD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpertDLL-L.xml) + + Last generated: 26-12-2005 12:57:54 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.rc b/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.rc new file mode 100644 index 0000000..392314e --- /dev/null +++ b/official/1.96/packages/d5/JclFavoriteFoldersExpertDLLD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertDLLD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertDLLD50D50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclProjectAnalysisExpertD50.RES b/official/1.96/packages/d5/JclProjectAnalysisExpertD50.RES new file mode 100644 index 0000000..7d59b45 Binary files /dev/null and b/official/1.96/packages/d5/JclProjectAnalysisExpertD50.RES differ diff --git a/official/1.96/packages/d5/JclProjectAnalysisExpertD50.dof b/official/1.96/packages/d5/JclProjectAnalysisExpertD50.dof new file mode 100644 index 0000000..56fdeb3 --- /dev/null +++ b/official/1.96/packages/d5/JclProjectAnalysisExpertD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d5/JclProjectAnalysisExpertD50.dpk b/official/1.96/packages/d5/JclProjectAnalysisExpertD50.dpk new file mode 100644 index 0000000..eade778 --- /dev/null +++ b/official/1.96/packages/d5/JclProjectAnalysisExpertD50.dpk @@ -0,0 +1,49 @@ +package JclProjectAnalysisExpertD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclD50, + JclBaseExpertD50 + ; + +contains + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d5/JclProjectAnalysisExpertD50.rc b/official/1.96/packages/d5/JclProjectAnalysisExpertD50.rc new file mode 100644 index 0000000..43fceb8 --- /dev/null +++ b/official/1.96/packages/d5/JclProjectAnalysisExpertD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpertD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.RES b/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.RES new file mode 100644 index 0000000..247c6c6 Binary files /dev/null and b/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.RES differ diff --git a/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.dof b/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.dof new file mode 100644 index 0000000..a36d5ed --- /dev/null +++ b/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclD50;JclBaseExpertD50 + diff --git a/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.dpr b/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.dpr new file mode 100644 index 0000000..163e35c --- /dev/null +++ b/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.dpr @@ -0,0 +1,45 @@ +Library JclProjectAnalysisExpertDLLD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpertDLL-L.xml) + + Last generated: 26-12-2005 12:57:54 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.rc b/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.rc new file mode 100644 index 0000000..9d82b43 --- /dev/null +++ b/official/1.96/packages/d5/JclProjectAnalysisExpertDLLD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpertDLLD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertDLLD50D50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclSIMDViewExpertD50.RES b/official/1.96/packages/d5/JclSIMDViewExpertD50.RES new file mode 100644 index 0000000..1a3f33f Binary files /dev/null and b/official/1.96/packages/d5/JclSIMDViewExpertD50.RES differ diff --git a/official/1.96/packages/d5/JclSIMDViewExpertD50.dof b/official/1.96/packages/d5/JclSIMDViewExpertD50.dof new file mode 100644 index 0000000..56fdeb3 --- /dev/null +++ b/official/1.96/packages/d5/JclSIMDViewExpertD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d5/JclSIMDViewExpertD50.dpk b/official/1.96/packages/d5/JclSIMDViewExpertD50.dpk new file mode 100644 index 0000000..995091c --- /dev/null +++ b/official/1.96/packages/d5/JclSIMDViewExpertD50.dpk @@ -0,0 +1,52 @@ +package JclSIMDViewExpertD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclD50, + JclBaseExpertD50 + ; + +contains + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +end. diff --git a/official/1.96/packages/d5/JclSIMDViewExpertD50.rc b/official/1.96/packages/d5/JclSIMDViewExpertD50.rc new file mode 100644 index 0000000..dbde823 --- /dev/null +++ b/official/1.96/packages/d5/JclSIMDViewExpertD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpertD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.RES b/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.RES new file mode 100644 index 0000000..cdce265 Binary files /dev/null and b/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.RES differ diff --git a/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.dof b/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.dof new file mode 100644 index 0000000..a36d5ed --- /dev/null +++ b/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclD50;JclBaseExpertD50 + diff --git a/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.dpr b/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.dpr new file mode 100644 index 0000000..b40cc85 --- /dev/null +++ b/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.dpr @@ -0,0 +1,48 @@ +Library JclSIMDViewExpertDLLD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpertDLL-L.xml) + + Last generated: 26-12-2005 12:57:54 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.rc b/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.rc new file mode 100644 index 0000000..b16f9d6 --- /dev/null +++ b/official/1.96/packages/d5/JclSIMDViewExpertDLLD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpertDLLD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertDLLD50D50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclThreadNameExpertD50.RES b/official/1.96/packages/d5/JclThreadNameExpertD50.RES new file mode 100644 index 0000000..f8f3fc8 Binary files /dev/null and b/official/1.96/packages/d5/JclThreadNameExpertD50.RES differ diff --git a/official/1.96/packages/d5/JclThreadNameExpertD50.dof b/official/1.96/packages/d5/JclThreadNameExpertD50.dof new file mode 100644 index 0000000..56fdeb3 --- /dev/null +++ b/official/1.96/packages/d5/JclThreadNameExpertD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d5/JclThreadNameExpertD50.dpk b/official/1.96/packages/d5/JclThreadNameExpertD50.dpk new file mode 100644 index 0000000..c6da8c5 --- /dev/null +++ b/official/1.96/packages/d5/JclThreadNameExpertD50.dpk @@ -0,0 +1,49 @@ +package JclThreadNameExpertD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclD50, + JclBaseExpertD50 + ; + +contains + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +end. diff --git a/official/1.96/packages/d5/JclThreadNameExpertD50.rc b/official/1.96/packages/d5/JclThreadNameExpertD50.rc new file mode 100644 index 0000000..9e39c8a --- /dev/null +++ b/official/1.96/packages/d5/JclThreadNameExpertD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpertD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclThreadNameExpertDLLD50.RES b/official/1.96/packages/d5/JclThreadNameExpertDLLD50.RES new file mode 100644 index 0000000..955e8f3 Binary files /dev/null and b/official/1.96/packages/d5/JclThreadNameExpertDLLD50.RES differ diff --git a/official/1.96/packages/d5/JclThreadNameExpertDLLD50.dof b/official/1.96/packages/d5/JclThreadNameExpertDLLD50.dof new file mode 100644 index 0000000..a36d5ed --- /dev/null +++ b/official/1.96/packages/d5/JclThreadNameExpertDLLD50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclD50;JclBaseExpertD50 + diff --git a/official/1.96/packages/d5/JclThreadNameExpertDLLD50.dpr b/official/1.96/packages/d5/JclThreadNameExpertDLLD50.dpr new file mode 100644 index 0000000..54c1468 --- /dev/null +++ b/official/1.96/packages/d5/JclThreadNameExpertDLLD50.dpr @@ -0,0 +1,45 @@ +Library JclThreadNameExpertDLLD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpertDLL-L.xml) + + Last generated: 26-12-2005 12:57:54 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d5/JclThreadNameExpertDLLD50.rc b/official/1.96/packages/d5/JclThreadNameExpertDLLD50.rc new file mode 100644 index 0000000..cc37072 --- /dev/null +++ b/official/1.96/packages/d5/JclThreadNameExpertDLLD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpertDLLD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertDLLD50D50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclUsesExpertD50.RES b/official/1.96/packages/d5/JclUsesExpertD50.RES new file mode 100644 index 0000000..b4786c2 Binary files /dev/null and b/official/1.96/packages/d5/JclUsesExpertD50.RES differ diff --git a/official/1.96/packages/d5/JclUsesExpertD50.dof b/official/1.96/packages/d5/JclUsesExpertD50.dof new file mode 100644 index 0000000..56fdeb3 --- /dev/null +++ b/official/1.96/packages/d5/JclUsesExpertD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d5/JclUsesExpertD50.dpk b/official/1.96/packages/d5/JclUsesExpertD50.dpk new file mode 100644 index 0000000..183ae96 --- /dev/null +++ b/official/1.96/packages/d5/JclUsesExpertD50.dpk @@ -0,0 +1,51 @@ +package JclUsesExpertD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpert-D.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclD50, + JclBaseExpertD50 + ; + +contains + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +end. diff --git a/official/1.96/packages/d5/JclUsesExpertD50.rc b/official/1.96/packages/d5/JclUsesExpertD50.rc new file mode 100644 index 0000000..07d84db --- /dev/null +++ b/official/1.96/packages/d5/JclUsesExpertD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpertD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclUsesExpertDLLD50.RES b/official/1.96/packages/d5/JclUsesExpertDLLD50.RES new file mode 100644 index 0000000..283000f Binary files /dev/null and b/official/1.96/packages/d5/JclUsesExpertDLLD50.RES differ diff --git a/official/1.96/packages/d5/JclUsesExpertDLLD50.dof b/official/1.96/packages/d5/JclUsesExpertDLLD50.dof new file mode 100644 index 0000000..a36d5ed --- /dev/null +++ b/official/1.96/packages/d5/JclUsesExpertDLLD50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclD50;JclBaseExpertD50 + diff --git a/official/1.96/packages/d5/JclUsesExpertDLLD50.dpr b/official/1.96/packages/d5/JclUsesExpertDLLD50.dpr new file mode 100644 index 0000000..0bd3e2a --- /dev/null +++ b/official/1.96/packages/d5/JclUsesExpertDLLD50.dpr @@ -0,0 +1,47 @@ +Library JclUsesExpertDLLD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpertDLL-L.xml) + + Last generated: 26-12-2005 12:57:54 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d5/JclUsesExpertDLLD50.rc b/official/1.96/packages/d5/JclUsesExpertDLLD50.rc new file mode 100644 index 0000000..9efc5e3 --- /dev/null +++ b/official/1.96/packages/d5/JclUsesExpertDLLD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpertDLLD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertDLLD50D50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclVersionControlExpertD50.dof b/official/1.96/packages/d5/JclVersionControlExpertD50.dof new file mode 100644 index 0000000..56fdeb3 --- /dev/null +++ b/official/1.96/packages/d5/JclVersionControlExpertD50.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d5/JclVersionControlExpertD50.dpk b/official/1.96/packages/d5/JclVersionControlExpertD50.dpk new file mode 100644 index 0000000..e88be8a --- /dev/null +++ b/official/1.96/packages/d5/JclVersionControlExpertD50.dpk @@ -0,0 +1,51 @@ +package JclVersionControlExpertD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpert-D.xml) + + Last generated: 15-01-2006 00:37:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl50, + dsnide50, + JclD50, + JclBaseExpertD50 + ; + +contains + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d5/JclVersionControlExpertD50.rc b/official/1.96/packages/d5/JclVersionControlExpertD50.rc new file mode 100644 index 0000000..7fe6954 --- /dev/null +++ b/official/1.96/packages/d5/JclVersionControlExpertD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertD50D50.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclVersionControlExpertD50.res b/official/1.96/packages/d5/JclVersionControlExpertD50.res new file mode 100644 index 0000000..32e3a13 Binary files /dev/null and b/official/1.96/packages/d5/JclVersionControlExpertD50.res differ diff --git a/official/1.96/packages/d5/JclVersionControlExpertDLLD50.dof b/official/1.96/packages/d5/JclVersionControlExpertDLLD50.dof new file mode 100644 index 0000000..a36d5ed --- /dev/null +++ b/official/1.96/packages/d5/JclVersionControlExpertDLLD50.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=vcl50;dsnide50;JclD50;JclBaseExpertD50 + diff --git a/official/1.96/packages/d5/JclVersionControlExpertDLLD50.dpr b/official/1.96/packages/d5/JclVersionControlExpertDLLD50.dpr new file mode 100644 index 0000000..b87551d --- /dev/null +++ b/official/1.96/packages/d5/JclVersionControlExpertDLLD50.dpr @@ -0,0 +1,47 @@ +Library JclVersionControlExpertDLLD50; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpertDLL-L.xml) + + Last generated: 15-01-2006 00:37:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d5/JclVersionControlExpertDLLD50.rc b/official/1.96/packages/d5/JclVersionControlExpertDLLD50.rc new file mode 100644 index 0000000..c6bf805 --- /dev/null +++ b/official/1.96/packages/d5/JclVersionControlExpertDLLD50.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertDLLD50\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertDLLD50D50.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d5/JclVersionControlExpertDLLD50.res b/official/1.96/packages/d5/JclVersionControlExpertDLLD50.res new file mode 100644 index 0000000..1ab5fb1 Binary files /dev/null and b/official/1.96/packages/d5/JclVersionControlExpertDLLD50.res differ diff --git a/official/1.96/packages/d5/dirinfo.txt b/official/1.96/packages/d5/dirinfo.txt new file mode 100644 index 0000000..ef2e4c3 --- /dev/null +++ b/official/1.96/packages/d5/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for Delphi 5 packages. \ No newline at end of file diff --git a/official/1.96/packages/d5/template.dof b/official/1.96/packages/d5/template.dof new file mode 100644 index 0000000..9c15bab --- /dev/null +++ b/official/1.96/packages/d5/template.dof @@ -0,0 +1,10 @@ +[Directories] +UnitOutputDir=..\..\lib\d5 +SearchPath=..\..\source;..\..\experts\common +<%%% BEGIN LIBRARYONLY %%%> +[Compiler] +PackageNoLink=1 +[Linker] +Packages=%NOLINKPACKAGELIST% +<%%% END LIBRARYONLY %%%> + diff --git a/official/1.96/packages/d5/template.dpk b/official/1.96/packages/d5/template.dpk new file mode 100644 index 0000000..4960431 --- /dev/null +++ b/official/1.96/packages/d5/template.dpk @@ -0,0 +1,55 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. \ No newline at end of file diff --git a/official/1.96/packages/d5/template.dpr b/official/1.96/packages/d5/template.dpr new file mode 100644 index 0000000..6c12c5f --- /dev/null +++ b/official/1.96/packages/d5/template.dpr @@ -0,0 +1,57 @@ +%PROJECT% %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> + +{$R *.res} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +<%%% BEGIN LIBRARYONLY %%%> +exports + JCLWizardInit name WizardEntryPoint; +<%%% END LIBRARYONLY %%%> + +end. \ No newline at end of file diff --git a/official/1.96/packages/d5/template.rc b/official/1.96/packages/d5/template.rc new file mode 100644 index 0000000..568736b --- /dev/null +++ b/official/1.96/packages/d5/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%D50%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6.dev/JclVClx.dof b/official/1.96/packages/d6.dev/JclVClx.dof new file mode 100644 index 0000000..8ba21b5 --- /dev/null +++ b/official/1.96/packages/d6.dev/JclVClx.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\source\common + diff --git a/official/1.96/packages/d6.dev/JclVClx.dpk b/official/1.96/packages/d6.dev/JclVClx.dpk new file mode 100644 index 0000000..387e7c6 --- /dev/null +++ b/official/1.96/packages/d6.dev/JclVClx.dpk @@ -0,0 +1,46 @@ +package JclVClx; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml) + + Last generated: 15-03-2005 18:01:54 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library VisualCLX package for Delphi 6'} +{$LIBSUFFIX 'D60'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + visualclx + +contains + JclQGraphUtils in '..\..\source\prototypes\JclQGraphUtils.pas' , + JclQGraphics in '..\..\source\prototypes\JclQGraphics.pas' + +end. diff --git a/official/1.96/packages/d6.dev/JclVClx.res b/official/1.96/packages/d6.dev/JclVClx.res new file mode 100644 index 0000000..3611514 Binary files /dev/null and b/official/1.96/packages/d6.dev/JclVClx.res differ diff --git a/official/1.96/packages/d6.dev/JclVcl.dof b/official/1.96/packages/d6.dev/JclVcl.dof new file mode 100644 index 0000000..8ba21b5 --- /dev/null +++ b/official/1.96/packages/d6.dev/JclVcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\source\common + diff --git a/official/1.96/packages/d6.dev/JclVcl.dpk b/official/1.96/packages/d6.dev/JclVcl.dpk new file mode 100644 index 0000000..7d9294e --- /dev/null +++ b/official/1.96/packages/d6.dev/JclVcl.dpk @@ -0,0 +1,48 @@ +package JclVcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml) + + Last generated: 24-10-2005 16:02:31 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48200000} +{$DESCRIPTION 'JEDI Code Library VCL package'} +{$LIBSUFFIX 'D60'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + vcljpg, + Jcl + ; +contains + JclGraphUtils in '..\..\source\prototypes\JclGraphUtils.pas' , + JclGraphics in '..\..\source\prototypes\JclGraphics.pas' + ; +end. diff --git a/official/1.96/packages/d6.dev/JclVcl.rc b/official/1.96/packages/d6.dev/JclVcl.rc new file mode 100644 index 0000000..82ce5d2 --- /dev/null +++ b/official/1.96/packages/d6.dev/JclVcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VCL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVclD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6.dev/JclVcl.res b/official/1.96/packages/d6.dev/JclVcl.res new file mode 100644 index 0000000..a1b6fa3 Binary files /dev/null and b/official/1.96/packages/d6.dev/JclVcl.res differ diff --git a/official/1.96/packages/d6.dev/dirinfo.txt b/official/1.96/packages/d6.dev/dirinfo.txt new file mode 100644 index 0000000..e8d6e4a --- /dev/null +++ b/official/1.96/packages/d6.dev/dirinfo.txt @@ -0,0 +1,4 @@ +This is where JCL development packages for Delphi 6 reside. + +Those packages are used instead of the standard packages of the same name for +prototype unit testing and not intended for release. diff --git a/official/1.96/packages/d6.dev/template.dpk b/official/1.96/packages/d6.dev/template.dpk new file mode 100644 index 0000000..a15a2b8 --- /dev/null +++ b/official/1.96/packages/d6.dev/template.dpk @@ -0,0 +1,48 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX 'D60'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; +end. \ No newline at end of file diff --git a/official/1.96/packages/d6.dev/template.rc b/official/1.96/packages/d6.dev/template.rc new file mode 100644 index 0000000..a09f195 --- /dev/null +++ b/official/1.96/packages/d6.dev/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%D60%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/Jcl.dof b/official/1.96/packages/d6/Jcl.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/Jcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/Jcl.dpk b/official/1.96/packages/d6/Jcl.dpk new file mode 100644 index 0000000..6aebc58 --- /dev/null +++ b/official/1.96/packages/d6/Jcl.dpk @@ -0,0 +1,126 @@ +package Jcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$LIBSUFFIX 'D60'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl + ; + +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWideFormat in '..\..\source\windows\JclWideFormat.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' + ; + +end. diff --git a/official/1.96/packages/d6/Jcl.rc b/official/1.96/packages/d6/Jcl.rc new file mode 100644 index 0000000..7fd5b8b --- /dev/null +++ b/official/1.96/packages/d6/Jcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "Jcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/Jcl.res b/official/1.96/packages/d6/Jcl.res new file mode 100644 index 0000000..262c24e Binary files /dev/null and b/official/1.96/packages/d6/Jcl.res differ diff --git a/official/1.96/packages/d6/JclBaseExpert.dof b/official/1.96/packages/d6/JclBaseExpert.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclBaseExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclBaseExpert.dpk b/official/1.96/packages/d6/JclBaseExpert.dpk new file mode 100644 index 0000000..0811f6f --- /dev/null +++ b/official/1.96/packages/d6/JclBaseExpert.dpk @@ -0,0 +1,54 @@ +package JclBaseExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58000000} +{$DESCRIPTION 'JCL Package containing common units for JCL Experts'} +{$LIBSUFFIX 'D60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl + ; + +contains + JclOtaUtils in '..\..\experts\common\JclOtaUtils.pas' , + JclOtaResources in '..\..\experts\common\JclOtaResources.pas' , + JclOtaConsts in '..\..\experts\common\JclOtaConsts.pas' , + JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm}, + JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm}, + JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame} + ; + +end. diff --git a/official/1.96/packages/d6/JclBaseExpert.rc b/official/1.96/packages/d6/JclBaseExpert.rc new file mode 100644 index 0000000..2f6909a --- /dev/null +++ b/official/1.96/packages/d6/JclBaseExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Package containing common units for JCL Experts\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclBaseExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclBaseExpertD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclBaseExpert.res b/official/1.96/packages/d6/JclBaseExpert.res new file mode 100644 index 0000000..3822155 Binary files /dev/null and b/official/1.96/packages/d6/JclBaseExpert.res differ diff --git a/official/1.96/packages/d6/JclDebugExpert.dof b/official/1.96/packages/d6/JclDebugExpert.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclDebugExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclDebugExpert.dpk b/official/1.96/packages/d6/JclDebugExpert.dpk new file mode 100644 index 0000000..ce6806c --- /dev/null +++ b/official/1.96/packages/d6/JclDebugExpert.dpk @@ -0,0 +1,51 @@ +package JclDebugExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpert-D.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$LIBSUFFIX 'D60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d6/JclDebugExpert.rc b/official/1.96/packages/d6/JclDebugExpert.rc new file mode 100644 index 0000000..96117ae --- /dev/null +++ b/official/1.96/packages/d6/JclDebugExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclDebugExpert.res b/official/1.96/packages/d6/JclDebugExpert.res new file mode 100644 index 0000000..a21946d Binary files /dev/null and b/official/1.96/packages/d6/JclDebugExpert.res differ diff --git a/official/1.96/packages/d6/JclDebugExpertDLL.RES b/official/1.96/packages/d6/JclDebugExpertDLL.RES new file mode 100644 index 0000000..a29a81e Binary files /dev/null and b/official/1.96/packages/d6/JclDebugExpertDLL.RES differ diff --git a/official/1.96/packages/d6/JclDebugExpertDLL.dof b/official/1.96/packages/d6/JclDebugExpertDLL.dof new file mode 100644 index 0000000..3f963ab --- /dev/null +++ b/official/1.96/packages/d6/JclDebugExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d6/JclDebugExpertDLL.dpr b/official/1.96/packages/d6/JclDebugExpertDLL.dpr new file mode 100644 index 0000000..55ed382 --- /dev/null +++ b/official/1.96/packages/d6/JclDebugExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclDebugExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpertDLL-L.xml) + + Last generated: 26-12-2005 13:04:39 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$LIBSUFFIX 'D60'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d6/JclDebugExpertDLL.rc b/official/1.96/packages/d6/JclDebugExpertDLL.rc new file mode 100644 index 0000000..4f44079 --- /dev/null +++ b/official/1.96/packages/d6/JclDebugExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertDLLD60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclFavoriteFoldersExpert.dof b/official/1.96/packages/d6/JclFavoriteFoldersExpert.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclFavoriteFoldersExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclFavoriteFoldersExpert.dpk b/official/1.96/packages/d6/JclFavoriteFoldersExpert.dpk new file mode 100644 index 0000000..1ad9791 --- /dev/null +++ b/official/1.96/packages/d6/JclFavoriteFoldersExpert.dpk @@ -0,0 +1,51 @@ +package JclFavoriteFoldersExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpert-D.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX 'D60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +end. diff --git a/official/1.96/packages/d6/JclFavoriteFoldersExpert.rc b/official/1.96/packages/d6/JclFavoriteFoldersExpert.rc new file mode 100644 index 0000000..aefa56a --- /dev/null +++ b/official/1.96/packages/d6/JclFavoriteFoldersExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclFavoriteFoldersExpert.res b/official/1.96/packages/d6/JclFavoriteFoldersExpert.res new file mode 100644 index 0000000..bb2041f Binary files /dev/null and b/official/1.96/packages/d6/JclFavoriteFoldersExpert.res differ diff --git a/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.RES b/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.RES new file mode 100644 index 0000000..fca8800 Binary files /dev/null and b/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.RES differ diff --git a/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.dof b/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.dof new file mode 100644 index 0000000..3f963ab --- /dev/null +++ b/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.dpr b/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.dpr new file mode 100644 index 0000000..e543c8c --- /dev/null +++ b/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclFavoriteFoldersExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpertDLL-L.xml) + + Last generated: 26-12-2005 13:10:25 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX 'D60'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.rc b/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.rc new file mode 100644 index 0000000..599f08f --- /dev/null +++ b/official/1.96/packages/d6/JclFavoriteFoldersExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertDLLD60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclProjectAnalysisExpert.RES b/official/1.96/packages/d6/JclProjectAnalysisExpert.RES new file mode 100644 index 0000000..7857c10 Binary files /dev/null and b/official/1.96/packages/d6/JclProjectAnalysisExpert.RES differ diff --git a/official/1.96/packages/d6/JclProjectAnalysisExpert.dof b/official/1.96/packages/d6/JclProjectAnalysisExpert.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclProjectAnalysisExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclProjectAnalysisExpert.dpk b/official/1.96/packages/d6/JclProjectAnalysisExpert.dpk new file mode 100644 index 0000000..66e81dc --- /dev/null +++ b/official/1.96/packages/d6/JclProjectAnalysisExpert.dpk @@ -0,0 +1,51 @@ +package JclProjectAnalysisExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpert-D.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$LIBSUFFIX 'D60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d6/JclProjectAnalysisExpert.rc b/official/1.96/packages/d6/JclProjectAnalysisExpert.rc new file mode 100644 index 0000000..80114eb --- /dev/null +++ b/official/1.96/packages/d6/JclProjectAnalysisExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.RES b/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.RES new file mode 100644 index 0000000..c92c5e9 Binary files /dev/null and b/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.RES differ diff --git a/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.dof b/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.dof new file mode 100644 index 0000000..3f963ab --- /dev/null +++ b/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.dpr b/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.dpr new file mode 100644 index 0000000..8696b1f --- /dev/null +++ b/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclProjectAnalysisExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpertDLL-L.xml) + + Last generated: 26-12-2005 13:10:25 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$LIBSUFFIX 'D60'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.rc b/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.rc new file mode 100644 index 0000000..e292386 --- /dev/null +++ b/official/1.96/packages/d6/JclProjectAnalysisExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertDLLD60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclSIMDViewExpert.dof b/official/1.96/packages/d6/JclSIMDViewExpert.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclSIMDViewExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclSIMDViewExpert.dpk b/official/1.96/packages/d6/JclSIMDViewExpert.dpk new file mode 100644 index 0000000..4b489af --- /dev/null +++ b/official/1.96/packages/d6/JclSIMDViewExpert.dpk @@ -0,0 +1,54 @@ +package JclSIMDViewExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpert-D.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$LIBSUFFIX 'D60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +end. diff --git a/official/1.96/packages/d6/JclSIMDViewExpert.rc b/official/1.96/packages/d6/JclSIMDViewExpert.rc new file mode 100644 index 0000000..7216c28 --- /dev/null +++ b/official/1.96/packages/d6/JclSIMDViewExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclSIMDViewExpert.res b/official/1.96/packages/d6/JclSIMDViewExpert.res new file mode 100644 index 0000000..98267a1 Binary files /dev/null and b/official/1.96/packages/d6/JclSIMDViewExpert.res differ diff --git a/official/1.96/packages/d6/JclSIMDViewExpertDLL.RES b/official/1.96/packages/d6/JclSIMDViewExpertDLL.RES new file mode 100644 index 0000000..c021fa7 Binary files /dev/null and b/official/1.96/packages/d6/JclSIMDViewExpertDLL.RES differ diff --git a/official/1.96/packages/d6/JclSIMDViewExpertDLL.dof b/official/1.96/packages/d6/JclSIMDViewExpertDLL.dof new file mode 100644 index 0000000..3f963ab --- /dev/null +++ b/official/1.96/packages/d6/JclSIMDViewExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d6/JclSIMDViewExpertDLL.dpr b/official/1.96/packages/d6/JclSIMDViewExpertDLL.dpr new file mode 100644 index 0000000..3dfac6a --- /dev/null +++ b/official/1.96/packages/d6/JclSIMDViewExpertDLL.dpr @@ -0,0 +1,49 @@ +Library JclSIMDViewExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpertDLL-L.xml) + + Last generated: 26-12-2005 13:10:25 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$LIBSUFFIX 'D60'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d6/JclSIMDViewExpertDLL.rc b/official/1.96/packages/d6/JclSIMDViewExpertDLL.rc new file mode 100644 index 0000000..ff85a3c --- /dev/null +++ b/official/1.96/packages/d6/JclSIMDViewExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertDLLD60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclThreadNameExpert.dof b/official/1.96/packages/d6/JclThreadNameExpert.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclThreadNameExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclThreadNameExpert.dpk b/official/1.96/packages/d6/JclThreadNameExpert.dpk new file mode 100644 index 0000000..ae873e4 --- /dev/null +++ b/official/1.96/packages/d6/JclThreadNameExpert.dpk @@ -0,0 +1,51 @@ +package JclThreadNameExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpert-D.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$LIBSUFFIX 'D60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +end. diff --git a/official/1.96/packages/d6/JclThreadNameExpert.rc b/official/1.96/packages/d6/JclThreadNameExpert.rc new file mode 100644 index 0000000..6752f28 --- /dev/null +++ b/official/1.96/packages/d6/JclThreadNameExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclThreadNameExpert.res b/official/1.96/packages/d6/JclThreadNameExpert.res new file mode 100644 index 0000000..b4c67a8 Binary files /dev/null and b/official/1.96/packages/d6/JclThreadNameExpert.res differ diff --git a/official/1.96/packages/d6/JclThreadNameExpertDLL.RES b/official/1.96/packages/d6/JclThreadNameExpertDLL.RES new file mode 100644 index 0000000..1b3c12f Binary files /dev/null and b/official/1.96/packages/d6/JclThreadNameExpertDLL.RES differ diff --git a/official/1.96/packages/d6/JclThreadNameExpertDLL.dof b/official/1.96/packages/d6/JclThreadNameExpertDLL.dof new file mode 100644 index 0000000..3f963ab --- /dev/null +++ b/official/1.96/packages/d6/JclThreadNameExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d6/JclThreadNameExpertDLL.dpr b/official/1.96/packages/d6/JclThreadNameExpertDLL.dpr new file mode 100644 index 0000000..533cf3b --- /dev/null +++ b/official/1.96/packages/d6/JclThreadNameExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclThreadNameExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpertDLL-L.xml) + + Last generated: 26-12-2005 13:10:25 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$LIBSUFFIX 'D60'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d6/JclThreadNameExpertDLL.rc b/official/1.96/packages/d6/JclThreadNameExpertDLL.rc new file mode 100644 index 0000000..c9dbf36 --- /dev/null +++ b/official/1.96/packages/d6/JclThreadNameExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertDLLD60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclUsesExpert.dof b/official/1.96/packages/d6/JclUsesExpert.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclUsesExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclUsesExpert.dpk b/official/1.96/packages/d6/JclUsesExpert.dpk new file mode 100644 index 0000000..b607652 --- /dev/null +++ b/official/1.96/packages/d6/JclUsesExpert.dpk @@ -0,0 +1,53 @@ +package JclUsesExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpert-D.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$LIBSUFFIX 'D60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +end. diff --git a/official/1.96/packages/d6/JclUsesExpert.rc b/official/1.96/packages/d6/JclUsesExpert.rc new file mode 100644 index 0000000..cdd53fc --- /dev/null +++ b/official/1.96/packages/d6/JclUsesExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclUsesExpert.res b/official/1.96/packages/d6/JclUsesExpert.res new file mode 100644 index 0000000..0f12f4e Binary files /dev/null and b/official/1.96/packages/d6/JclUsesExpert.res differ diff --git a/official/1.96/packages/d6/JclUsesExpertDLL.RES b/official/1.96/packages/d6/JclUsesExpertDLL.RES new file mode 100644 index 0000000..9ffae85 Binary files /dev/null and b/official/1.96/packages/d6/JclUsesExpertDLL.RES differ diff --git a/official/1.96/packages/d6/JclUsesExpertDLL.dof b/official/1.96/packages/d6/JclUsesExpertDLL.dof new file mode 100644 index 0000000..3f963ab --- /dev/null +++ b/official/1.96/packages/d6/JclUsesExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d6/JclUsesExpertDLL.dpr b/official/1.96/packages/d6/JclUsesExpertDLL.dpr new file mode 100644 index 0000000..cac7723 --- /dev/null +++ b/official/1.96/packages/d6/JclUsesExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclUsesExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpertDLL-L.xml) + + Last generated: 26-12-2005 13:10:25 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$LIBSUFFIX 'D60'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d6/JclUsesExpertDLL.rc b/official/1.96/packages/d6/JclUsesExpertDLL.rc new file mode 100644 index 0000000..6c773a6 --- /dev/null +++ b/official/1.96/packages/d6/JclUsesExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertDLLD60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclVClx.dof b/official/1.96/packages/d6/JclVClx.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclVClx.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclVClx.dpk b/official/1.96/packages/d6/JclVClx.dpk new file mode 100644 index 0000000..864e8b5 --- /dev/null +++ b/official/1.96/packages/d6/JclVClx.dpk @@ -0,0 +1,49 @@ +package JclVClx; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48300000} +{$DESCRIPTION 'JEDI Code Library VisualCLX package'} +{$LIBSUFFIX 'D60'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + visualclx, + Jcl + ; + +contains + JclQGraphUtils in '..\..\source\visclx\JclQGraphUtils.pas' , + JclQGraphics in '..\..\source\visclx\JclQGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/d6/JclVClx.rc b/official/1.96/packages/d6/JclVClx.rc new file mode 100644 index 0000000..afa9c6c --- /dev/null +++ b/official/1.96/packages/d6/JclVClx.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,0,2172 +PRODUCTVERSION 1,97,0,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VisualCLX package\0" + VALUE "FileVersion", "1.97.0.2172\0" + VALUE "InternalName", "JclVClx\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVClxD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclVClx.res b/official/1.96/packages/d6/JclVClx.res new file mode 100644 index 0000000..616773a Binary files /dev/null and b/official/1.96/packages/d6/JclVClx.res differ diff --git a/official/1.96/packages/d6/JclVcl.dof b/official/1.96/packages/d6/JclVcl.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclVcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclVcl.dpk b/official/1.96/packages/d6/JclVcl.dpk new file mode 100644 index 0000000..4502b3c --- /dev/null +++ b/official/1.96/packages/d6/JclVcl.dpk @@ -0,0 +1,51 @@ +package JclVcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48200000} +{$DESCRIPTION 'JEDI Code Library VCL package'} +{$LIBSUFFIX 'D60'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + vcljpg, + Jcl + ; + +contains + JclPrint in '..\..\source\vcl\JclPrint.pas' , + JclGraphUtils in '..\..\source\vcl\JclGraphUtils.pas' , + JclGraphics in '..\..\source\vcl\JclGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/d6/JclVcl.rc b/official/1.96/packages/d6/JclVcl.rc new file mode 100644 index 0000000..82ce5d2 --- /dev/null +++ b/official/1.96/packages/d6/JclVcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VCL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVclD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclVcl.res b/official/1.96/packages/d6/JclVcl.res new file mode 100644 index 0000000..a1b6fa3 Binary files /dev/null and b/official/1.96/packages/d6/JclVcl.res differ diff --git a/official/1.96/packages/d6/JclVersionControlExpert.dof b/official/1.96/packages/d6/JclVersionControlExpert.dof new file mode 100644 index 0000000..a9597ca --- /dev/null +++ b/official/1.96/packages/d6/JclVersionControlExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d6/JclVersionControlExpert.dpk b/official/1.96/packages/d6/JclVersionControlExpert.dpk new file mode 100644 index 0000000..b178916 --- /dev/null +++ b/official/1.96/packages/d6/JclVersionControlExpert.dpk @@ -0,0 +1,53 @@ +package JclVersionControlExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpert-D.xml) + + Last generated: 03-02-2006 19:27:26 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX 'D60'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d6/JclVersionControlExpert.rc b/official/1.96/packages/d6/JclVersionControlExpert.rc new file mode 100644 index 0000000..bfbbba4 --- /dev/null +++ b/official/1.96/packages/d6/JclVersionControlExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertD60.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclVersionControlExpert.res b/official/1.96/packages/d6/JclVersionControlExpert.res new file mode 100644 index 0000000..c21faaa Binary files /dev/null and b/official/1.96/packages/d6/JclVersionControlExpert.res differ diff --git a/official/1.96/packages/d6/JclVersionControlExpertDLL.dof b/official/1.96/packages/d6/JclVersionControlExpertDLL.dof new file mode 100644 index 0000000..3f963ab --- /dev/null +++ b/official/1.96/packages/d6/JclVersionControlExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d6/JclVersionControlExpertDLL.dpr b/official/1.96/packages/d6/JclVersionControlExpertDLL.dpr new file mode 100644 index 0000000..5118ea2 --- /dev/null +++ b/official/1.96/packages/d6/JclVersionControlExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclVersionControlExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpertDLL-L.xml) + + Last generated: 15-01-2006 00:37:27 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX 'D60'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d6/JclVersionControlExpertDLL.rc b/official/1.96/packages/d6/JclVersionControlExpertDLL.rc new file mode 100644 index 0000000..918f706 --- /dev/null +++ b/official/1.96/packages/d6/JclVersionControlExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertDLLD60.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d6/JclVersionControlExpertDLL.res b/official/1.96/packages/d6/JclVersionControlExpertDLL.res new file mode 100644 index 0000000..f2c9314 Binary files /dev/null and b/official/1.96/packages/d6/JclVersionControlExpertDLL.res differ diff --git a/official/1.96/packages/d6/dirinfo.txt b/official/1.96/packages/d6/dirinfo.txt new file mode 100644 index 0000000..34e4fef --- /dev/null +++ b/official/1.96/packages/d6/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for Delphi 6 packages. \ No newline at end of file diff --git a/official/1.96/packages/d6/template.dof b/official/1.96/packages/d6/template.dof new file mode 100644 index 0000000..cf32206 --- /dev/null +++ b/official/1.96/packages/d6/template.dof @@ -0,0 +1,10 @@ +[Directories] +UnitOutputDir=..\..\lib\d6 +SearchPath=..\..\source;..\..\experts\common +<%%% BEGIN LIBRARYONLY %%%> +[Compiler] +PackageNoLink=1 +[Linker] +Packages=%NOLINKPACKAGELIST% +<%%% END LIBRARYONLY %%%> + diff --git a/official/1.96/packages/d6/template.dpk b/official/1.96/packages/d6/template.dpk new file mode 100644 index 0000000..8a9442d --- /dev/null +++ b/official/1.96/packages/d6/template.dpk @@ -0,0 +1,56 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX 'D60'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. diff --git a/official/1.96/packages/d6/template.dpr b/official/1.96/packages/d6/template.dpr new file mode 100644 index 0000000..685bdd0 --- /dev/null +++ b/official/1.96/packages/d6/template.dpr @@ -0,0 +1,58 @@ +%PROJECT% %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX 'D60'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +<%%% BEGIN LIBRARYONLY %%%> +exports + JCLWizardInit name WizardEntryPoint; +<%%% END LIBRARYONLY %%%> + +end. diff --git a/official/1.96/packages/d6/template.rc b/official/1.96/packages/d6/template.rc new file mode 100644 index 0000000..a09f195 --- /dev/null +++ b/official/1.96/packages/d6/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%D60%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7.dev/JclVClx.dof b/official/1.96/packages/d7.dev/JclVClx.dof new file mode 100644 index 0000000..e69d2b7 --- /dev/null +++ b/official/1.96/packages/d7.dev/JclVClx.dof @@ -0,0 +1,3 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\source\common diff --git a/official/1.96/packages/d7.dev/JclVClx.dpk b/official/1.96/packages/d7.dev/JclVClx.dpk new file mode 100644 index 0000000..e117822 --- /dev/null +++ b/official/1.96/packages/d7.dev/JclVClx.dpk @@ -0,0 +1,49 @@ +package JclVClx; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48300000} +{$DESCRIPTION 'JEDI Code Library VisualCLX package'} +{$LIBSUFFIX '70'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + visualclx, + Jcl + ; + +contains + JclQGraphUtils in '..\..\source\prototypes\JclQGraphUtils.pas' , + JclQGraphics in '..\..\source\prototypes\JclQGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/d7.dev/JclVClx.rc b/official/1.96/packages/d7.dev/JclVClx.rc new file mode 100644 index 0000000..da4400b --- /dev/null +++ b/official/1.96/packages/d7.dev/JclVClx.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,0,2172 +PRODUCTVERSION 1,97,0,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VisualCLX package\0" + VALUE "FileVersion", "1.97.0.2172\0" + VALUE "InternalName", "JclVClx\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVClx70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7.dev/JclVClx.res b/official/1.96/packages/d7.dev/JclVClx.res new file mode 100644 index 0000000..dcd1fda Binary files /dev/null and b/official/1.96/packages/d7.dev/JclVClx.res differ diff --git a/official/1.96/packages/d7.dev/JclVcl.dof b/official/1.96/packages/d7.dev/JclVcl.dof new file mode 100644 index 0000000..544a865 --- /dev/null +++ b/official/1.96/packages/d7.dev/JclVcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\source\common + diff --git a/official/1.96/packages/d7.dev/JclVcl.dpk b/official/1.96/packages/d7.dev/JclVcl.dpk new file mode 100644 index 0000000..f6516e5 --- /dev/null +++ b/official/1.96/packages/d7.dev/JclVcl.dpk @@ -0,0 +1,50 @@ +package JclVcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48200000} +{$DESCRIPTION 'JEDI Code Library VCL package'} +{$LIBSUFFIX '70'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + vcljpg, + Jcl + ; + +contains + JclGraphUtils in '..\..\source\prototypes\JclGraphUtils.pas' , + JclGraphics in '..\..\source\prototypes\JclGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/d7.dev/JclVcl.rc b/official/1.96/packages/d7.dev/JclVcl.rc new file mode 100644 index 0000000..58cdb6d --- /dev/null +++ b/official/1.96/packages/d7.dev/JclVcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VCL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVcl70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7.dev/JclVcl.res b/official/1.96/packages/d7.dev/JclVcl.res new file mode 100644 index 0000000..b043104 Binary files /dev/null and b/official/1.96/packages/d7.dev/JclVcl.res differ diff --git a/official/1.96/packages/d7.dev/dirinfo.txt b/official/1.96/packages/d7.dev/dirinfo.txt new file mode 100644 index 0000000..845eb32 --- /dev/null +++ b/official/1.96/packages/d7.dev/dirinfo.txt @@ -0,0 +1,4 @@ +This is where JCL development packages for Delphi 7 reside. + +Those packages are used instead of the standard packages of the same name for +prototype unit testing and not intended for release. diff --git a/official/1.96/packages/d7.dev/template.dpk b/official/1.96/packages/d7.dev/template.dpk new file mode 100644 index 0000000..8577254 --- /dev/null +++ b/official/1.96/packages/d7.dev/template.dpk @@ -0,0 +1,50 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '70'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. \ No newline at end of file diff --git a/official/1.96/packages/d7.dev/template.rc b/official/1.96/packages/d7.dev/template.rc new file mode 100644 index 0000000..ea040f6 --- /dev/null +++ b/official/1.96/packages/d7.dev/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%70%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/Jcl.dof b/official/1.96/packages/d7/Jcl.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/Jcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/Jcl.dpk b/official/1.96/packages/d7/Jcl.dpk new file mode 100644 index 0000000..b54f3c9 --- /dev/null +++ b/official/1.96/packages/d7/Jcl.dpk @@ -0,0 +1,126 @@ +package Jcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$LIBSUFFIX '70'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl + ; + +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWideFormat in '..\..\source\windows\JclWideFormat.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' + ; + +end. diff --git a/official/1.96/packages/d7/Jcl.rc b/official/1.96/packages/d7/Jcl.rc new file mode 100644 index 0000000..a767ed0 --- /dev/null +++ b/official/1.96/packages/d7/Jcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "Jcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "Jcl70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/Jcl.res b/official/1.96/packages/d7/Jcl.res new file mode 100644 index 0000000..ec599a3 Binary files /dev/null and b/official/1.96/packages/d7/Jcl.res differ diff --git a/official/1.96/packages/d7/JclBaseExpert.dof b/official/1.96/packages/d7/JclBaseExpert.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclBaseExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclBaseExpert.dpk b/official/1.96/packages/d7/JclBaseExpert.dpk new file mode 100644 index 0000000..3bdfa98 --- /dev/null +++ b/official/1.96/packages/d7/JclBaseExpert.dpk @@ -0,0 +1,54 @@ +package JclBaseExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 04-01-2006 22:23:23 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58000000} +{$DESCRIPTION 'JCL Package containing common units for JCL Experts'} +{$LIBSUFFIX '70'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl + ; + +contains + JclOtaUtils in '..\..\experts\common\JclOtaUtils.pas' , + JclOtaResources in '..\..\experts\common\JclOtaResources.pas' , + JclOtaConsts in '..\..\experts\common\JclOtaConsts.pas' , + JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm}, + JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm}, + JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame} + ; + +end. diff --git a/official/1.96/packages/d7/JclBaseExpert.rc b/official/1.96/packages/d7/JclBaseExpert.rc new file mode 100644 index 0000000..c43fa99 --- /dev/null +++ b/official/1.96/packages/d7/JclBaseExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Package containing common units for JCL Experts\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclBaseExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclBaseExpert70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclBaseExpert.res b/official/1.96/packages/d7/JclBaseExpert.res new file mode 100644 index 0000000..0349d51 Binary files /dev/null and b/official/1.96/packages/d7/JclBaseExpert.res differ diff --git a/official/1.96/packages/d7/JclDebugExpert.dof b/official/1.96/packages/d7/JclDebugExpert.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclDebugExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclDebugExpert.dpk b/official/1.96/packages/d7/JclDebugExpert.dpk new file mode 100644 index 0000000..7267a62 --- /dev/null +++ b/official/1.96/packages/d7/JclDebugExpert.dpk @@ -0,0 +1,51 @@ +package JclDebugExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$LIBSUFFIX '70'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d7/JclDebugExpert.rc b/official/1.96/packages/d7/JclDebugExpert.rc new file mode 100644 index 0000000..41c65dd --- /dev/null +++ b/official/1.96/packages/d7/JclDebugExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpert70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclDebugExpert.res b/official/1.96/packages/d7/JclDebugExpert.res new file mode 100644 index 0000000..dffceaf Binary files /dev/null and b/official/1.96/packages/d7/JclDebugExpert.res differ diff --git a/official/1.96/packages/d7/JclDebugExpertDLL.RES b/official/1.96/packages/d7/JclDebugExpertDLL.RES new file mode 100644 index 0000000..7e1de8f Binary files /dev/null and b/official/1.96/packages/d7/JclDebugExpertDLL.RES differ diff --git a/official/1.96/packages/d7/JclDebugExpertDLL.dof b/official/1.96/packages/d7/JclDebugExpertDLL.dof new file mode 100644 index 0000000..2e8f808 --- /dev/null +++ b/official/1.96/packages/d7/JclDebugExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d7/JclDebugExpertDLL.dpr b/official/1.96/packages/d7/JclDebugExpertDLL.dpr new file mode 100644 index 0000000..32128a1 --- /dev/null +++ b/official/1.96/packages/d7/JclDebugExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclDebugExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpertDLL-L.xml) + + Last generated: 26-12-2005 13:14:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$LIBSUFFIX '70'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d7/JclDebugExpertDLL.rc b/official/1.96/packages/d7/JclDebugExpertDLL.rc new file mode 100644 index 0000000..4dcff93 --- /dev/null +++ b/official/1.96/packages/d7/JclDebugExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertDLL70.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclFavoriteFoldersExpert.dof b/official/1.96/packages/d7/JclFavoriteFoldersExpert.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclFavoriteFoldersExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclFavoriteFoldersExpert.dpk b/official/1.96/packages/d7/JclFavoriteFoldersExpert.dpk new file mode 100644 index 0000000..a4389aa --- /dev/null +++ b/official/1.96/packages/d7/JclFavoriteFoldersExpert.dpk @@ -0,0 +1,51 @@ +package JclFavoriteFoldersExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX '70'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +end. diff --git a/official/1.96/packages/d7/JclFavoriteFoldersExpert.rc b/official/1.96/packages/d7/JclFavoriteFoldersExpert.rc new file mode 100644 index 0000000..63bb4f5 --- /dev/null +++ b/official/1.96/packages/d7/JclFavoriteFoldersExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpert70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclFavoriteFoldersExpert.res b/official/1.96/packages/d7/JclFavoriteFoldersExpert.res new file mode 100644 index 0000000..26cc944 Binary files /dev/null and b/official/1.96/packages/d7/JclFavoriteFoldersExpert.res differ diff --git a/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.RES b/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.RES new file mode 100644 index 0000000..2cfffb6 Binary files /dev/null and b/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.RES differ diff --git a/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.dof b/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.dof new file mode 100644 index 0000000..2e8f808 --- /dev/null +++ b/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.dpr b/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.dpr new file mode 100644 index 0000000..37c2056 --- /dev/null +++ b/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclFavoriteFoldersExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpertDLL-L.xml) + + Last generated: 26-12-2005 13:14:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX '70'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.rc b/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.rc new file mode 100644 index 0000000..38ada02 --- /dev/null +++ b/official/1.96/packages/d7/JclFavoriteFoldersExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertDLL70.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclProjectAnalysisExpert.RES b/official/1.96/packages/d7/JclProjectAnalysisExpert.RES new file mode 100644 index 0000000..2ddd201 Binary files /dev/null and b/official/1.96/packages/d7/JclProjectAnalysisExpert.RES differ diff --git a/official/1.96/packages/d7/JclProjectAnalysisExpert.dof b/official/1.96/packages/d7/JclProjectAnalysisExpert.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclProjectAnalysisExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclProjectAnalysisExpert.dpk b/official/1.96/packages/d7/JclProjectAnalysisExpert.dpk new file mode 100644 index 0000000..7d00e15 --- /dev/null +++ b/official/1.96/packages/d7/JclProjectAnalysisExpert.dpk @@ -0,0 +1,51 @@ +package JclProjectAnalysisExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$LIBSUFFIX '70'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d7/JclProjectAnalysisExpert.rc b/official/1.96/packages/d7/JclProjectAnalysisExpert.rc new file mode 100644 index 0000000..97c90aa --- /dev/null +++ b/official/1.96/packages/d7/JclProjectAnalysisExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpert70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.RES b/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.RES new file mode 100644 index 0000000..ca1d62f Binary files /dev/null and b/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.RES differ diff --git a/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.dof b/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.dof new file mode 100644 index 0000000..2e8f808 --- /dev/null +++ b/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.dpr b/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.dpr new file mode 100644 index 0000000..224ee30 --- /dev/null +++ b/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclProjectAnalysisExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpertDLL-L.xml) + + Last generated: 26-12-2005 13:14:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$LIBSUFFIX '70'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.rc b/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.rc new file mode 100644 index 0000000..4d88569 --- /dev/null +++ b/official/1.96/packages/d7/JclProjectAnalysisExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertDLL70.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclSIMDViewExpert.dof b/official/1.96/packages/d7/JclSIMDViewExpert.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclSIMDViewExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclSIMDViewExpert.dpk b/official/1.96/packages/d7/JclSIMDViewExpert.dpk new file mode 100644 index 0000000..5289db7 --- /dev/null +++ b/official/1.96/packages/d7/JclSIMDViewExpert.dpk @@ -0,0 +1,54 @@ +package JclSIMDViewExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$LIBSUFFIX '70'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +end. diff --git a/official/1.96/packages/d7/JclSIMDViewExpert.rc b/official/1.96/packages/d7/JclSIMDViewExpert.rc new file mode 100644 index 0000000..9bfa8f2 --- /dev/null +++ b/official/1.96/packages/d7/JclSIMDViewExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpert70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclSIMDViewExpert.res b/official/1.96/packages/d7/JclSIMDViewExpert.res new file mode 100644 index 0000000..01e53a5 Binary files /dev/null and b/official/1.96/packages/d7/JclSIMDViewExpert.res differ diff --git a/official/1.96/packages/d7/JclSIMDViewExpertDLL.RES b/official/1.96/packages/d7/JclSIMDViewExpertDLL.RES new file mode 100644 index 0000000..796d6be Binary files /dev/null and b/official/1.96/packages/d7/JclSIMDViewExpertDLL.RES differ diff --git a/official/1.96/packages/d7/JclSIMDViewExpertDLL.dof b/official/1.96/packages/d7/JclSIMDViewExpertDLL.dof new file mode 100644 index 0000000..2e8f808 --- /dev/null +++ b/official/1.96/packages/d7/JclSIMDViewExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d7/JclSIMDViewExpertDLL.dpr b/official/1.96/packages/d7/JclSIMDViewExpertDLL.dpr new file mode 100644 index 0000000..9eb85d0 --- /dev/null +++ b/official/1.96/packages/d7/JclSIMDViewExpertDLL.dpr @@ -0,0 +1,49 @@ +Library JclSIMDViewExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpertDLL-L.xml) + + Last generated: 26-12-2005 13:14:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$LIBSUFFIX '70'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d7/JclSIMDViewExpertDLL.rc b/official/1.96/packages/d7/JclSIMDViewExpertDLL.rc new file mode 100644 index 0000000..64bfe2e --- /dev/null +++ b/official/1.96/packages/d7/JclSIMDViewExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertDLL70.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclThreadNameExpert.dof b/official/1.96/packages/d7/JclThreadNameExpert.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclThreadNameExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclThreadNameExpert.dpk b/official/1.96/packages/d7/JclThreadNameExpert.dpk new file mode 100644 index 0000000..f66f68e --- /dev/null +++ b/official/1.96/packages/d7/JclThreadNameExpert.dpk @@ -0,0 +1,51 @@ +package JclThreadNameExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$LIBSUFFIX '70'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +end. diff --git a/official/1.96/packages/d7/JclThreadNameExpert.rc b/official/1.96/packages/d7/JclThreadNameExpert.rc new file mode 100644 index 0000000..5b6255c --- /dev/null +++ b/official/1.96/packages/d7/JclThreadNameExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpert70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclThreadNameExpert.res b/official/1.96/packages/d7/JclThreadNameExpert.res new file mode 100644 index 0000000..5d8cdd7 Binary files /dev/null and b/official/1.96/packages/d7/JclThreadNameExpert.res differ diff --git a/official/1.96/packages/d7/JclThreadNameExpertDLL.RES b/official/1.96/packages/d7/JclThreadNameExpertDLL.RES new file mode 100644 index 0000000..2342371 Binary files /dev/null and b/official/1.96/packages/d7/JclThreadNameExpertDLL.RES differ diff --git a/official/1.96/packages/d7/JclThreadNameExpertDLL.dof b/official/1.96/packages/d7/JclThreadNameExpertDLL.dof new file mode 100644 index 0000000..2e8f808 --- /dev/null +++ b/official/1.96/packages/d7/JclThreadNameExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d7/JclThreadNameExpertDLL.dpr b/official/1.96/packages/d7/JclThreadNameExpertDLL.dpr new file mode 100644 index 0000000..61765ea --- /dev/null +++ b/official/1.96/packages/d7/JclThreadNameExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclThreadNameExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpertDLL-L.xml) + + Last generated: 26-12-2005 13:14:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$LIBSUFFIX '70'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d7/JclThreadNameExpertDLL.rc b/official/1.96/packages/d7/JclThreadNameExpertDLL.rc new file mode 100644 index 0000000..ee57089 --- /dev/null +++ b/official/1.96/packages/d7/JclThreadNameExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertDLL70.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclUsesExpert.dof b/official/1.96/packages/d7/JclUsesExpert.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclUsesExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclUsesExpert.dpk b/official/1.96/packages/d7/JclUsesExpert.dpk new file mode 100644 index 0000000..99c4e2f --- /dev/null +++ b/official/1.96/packages/d7/JclUsesExpert.dpk @@ -0,0 +1,53 @@ +package JclUsesExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$LIBSUFFIX '70'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +end. diff --git a/official/1.96/packages/d7/JclUsesExpert.rc b/official/1.96/packages/d7/JclUsesExpert.rc new file mode 100644 index 0000000..f258558 --- /dev/null +++ b/official/1.96/packages/d7/JclUsesExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpert70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclUsesExpert.res b/official/1.96/packages/d7/JclUsesExpert.res new file mode 100644 index 0000000..46b3a03 Binary files /dev/null and b/official/1.96/packages/d7/JclUsesExpert.res differ diff --git a/official/1.96/packages/d7/JclUsesExpertDLL.RES b/official/1.96/packages/d7/JclUsesExpertDLL.RES new file mode 100644 index 0000000..192f488 Binary files /dev/null and b/official/1.96/packages/d7/JclUsesExpertDLL.RES differ diff --git a/official/1.96/packages/d7/JclUsesExpertDLL.dof b/official/1.96/packages/d7/JclUsesExpertDLL.dof new file mode 100644 index 0000000..2e8f808 --- /dev/null +++ b/official/1.96/packages/d7/JclUsesExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d7/JclUsesExpertDLL.dpr b/official/1.96/packages/d7/JclUsesExpertDLL.dpr new file mode 100644 index 0000000..dd84ea3 --- /dev/null +++ b/official/1.96/packages/d7/JclUsesExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclUsesExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpertDLL-L.xml) + + Last generated: 26-12-2005 13:14:02 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$LIBSUFFIX '70'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d7/JclUsesExpertDLL.rc b/official/1.96/packages/d7/JclUsesExpertDLL.rc new file mode 100644 index 0000000..7befdc3 --- /dev/null +++ b/official/1.96/packages/d7/JclUsesExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertDLL70.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclVClx.dof b/official/1.96/packages/d7/JclVClx.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclVClx.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclVClx.dpk b/official/1.96/packages/d7/JclVClx.dpk new file mode 100644 index 0000000..12bca3c --- /dev/null +++ b/official/1.96/packages/d7/JclVClx.dpk @@ -0,0 +1,49 @@ +package JclVClx; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48300000} +{$DESCRIPTION 'JEDI Code Library VisualCLX package'} +{$LIBSUFFIX '70'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + visualclx, + Jcl + ; + +contains + JclQGraphUtils in '..\..\source\visclx\JclQGraphUtils.pas' , + JclQGraphics in '..\..\source\visclx\JclQGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/d7/JclVClx.rc b/official/1.96/packages/d7/JclVClx.rc new file mode 100644 index 0000000..da4400b --- /dev/null +++ b/official/1.96/packages/d7/JclVClx.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,0,2172 +PRODUCTVERSION 1,97,0,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VisualCLX package\0" + VALUE "FileVersion", "1.97.0.2172\0" + VALUE "InternalName", "JclVClx\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVClx70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclVClx.res b/official/1.96/packages/d7/JclVClx.res new file mode 100644 index 0000000..dcd1fda Binary files /dev/null and b/official/1.96/packages/d7/JclVClx.res differ diff --git a/official/1.96/packages/d7/JclVcl.dof b/official/1.96/packages/d7/JclVcl.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclVcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclVcl.dpk b/official/1.96/packages/d7/JclVcl.dpk new file mode 100644 index 0000000..70a79a6 --- /dev/null +++ b/official/1.96/packages/d7/JclVcl.dpk @@ -0,0 +1,51 @@ +package JclVcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48200000} +{$DESCRIPTION 'JEDI Code Library VCL package'} +{$LIBSUFFIX '70'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + vcljpg, + Jcl + ; + +contains + JclPrint in '..\..\source\vcl\JclPrint.pas' , + JclGraphUtils in '..\..\source\vcl\JclGraphUtils.pas' , + JclGraphics in '..\..\source\vcl\JclGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/d7/JclVcl.rc b/official/1.96/packages/d7/JclVcl.rc new file mode 100644 index 0000000..58cdb6d --- /dev/null +++ b/official/1.96/packages/d7/JclVcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VCL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVcl70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclVcl.res b/official/1.96/packages/d7/JclVcl.res new file mode 100644 index 0000000..b043104 Binary files /dev/null and b/official/1.96/packages/d7/JclVcl.res differ diff --git a/official/1.96/packages/d7/JclVersionControlExpert.dof b/official/1.96/packages/d7/JclVersionControlExpert.dof new file mode 100644 index 0000000..7369c17 --- /dev/null +++ b/official/1.96/packages/d7/JclVersionControlExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d7/JclVersionControlExpert.dpk b/official/1.96/packages/d7/JclVersionControlExpert.dpk new file mode 100644 index 0000000..2ed6f06 --- /dev/null +++ b/official/1.96/packages/d7/JclVersionControlExpert.dpk @@ -0,0 +1,53 @@ +package JclVersionControlExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpert-D.xml) + + Last generated: 15-01-2006 00:37:27 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX '70'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d7/JclVersionControlExpert.rc b/official/1.96/packages/d7/JclVersionControlExpert.rc new file mode 100644 index 0000000..fdf8274 --- /dev/null +++ b/official/1.96/packages/d7/JclVersionControlExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpert70.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclVersionControlExpert.res b/official/1.96/packages/d7/JclVersionControlExpert.res new file mode 100644 index 0000000..e4bb7b9 Binary files /dev/null and b/official/1.96/packages/d7/JclVersionControlExpert.res differ diff --git a/official/1.96/packages/d7/JclVersionControlExpertDLL.dof b/official/1.96/packages/d7/JclVersionControlExpertDLL.dof new file mode 100644 index 0000000..2e8f808 --- /dev/null +++ b/official/1.96/packages/d7/JclVersionControlExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d7/JclVersionControlExpertDLL.dpr b/official/1.96/packages/d7/JclVersionControlExpertDLL.dpr new file mode 100644 index 0000000..53f1f33 --- /dev/null +++ b/official/1.96/packages/d7/JclVersionControlExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclVersionControlExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpertDLL-L.xml) + + Last generated: 15-01-2006 00:37:27 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX '70'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d7/JclVersionControlExpertDLL.rc b/official/1.96/packages/d7/JclVersionControlExpertDLL.rc new file mode 100644 index 0000000..ee3b5ba --- /dev/null +++ b/official/1.96/packages/d7/JclVersionControlExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertDLL70.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d7/JclVersionControlExpertDLL.res b/official/1.96/packages/d7/JclVersionControlExpertDLL.res new file mode 100644 index 0000000..102cde3 Binary files /dev/null and b/official/1.96/packages/d7/JclVersionControlExpertDLL.res differ diff --git a/official/1.96/packages/d7/dirinfo.txt b/official/1.96/packages/d7/dirinfo.txt new file mode 100644 index 0000000..0786a6f --- /dev/null +++ b/official/1.96/packages/d7/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for Delphi 7 packages. \ No newline at end of file diff --git a/official/1.96/packages/d7/template.dof b/official/1.96/packages/d7/template.dof new file mode 100644 index 0000000..766d44b --- /dev/null +++ b/official/1.96/packages/d7/template.dof @@ -0,0 +1,10 @@ +[Directories] +UnitOutputDir=..\..\lib\d7 +SearchPath=..\..\source;..\..\experts\common +<%%% BEGIN LIBRARYONLY %%%> +[Compiler] +PackageNoLink=1 +[Linker] +Packages=%NOLINKPACKAGELIST% +<%%% END LIBRARYONLY %%%> + diff --git a/official/1.96/packages/d7/template.dpk b/official/1.96/packages/d7/template.dpk new file mode 100644 index 0000000..97fc917 --- /dev/null +++ b/official/1.96/packages/d7/template.dpk @@ -0,0 +1,56 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '70'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. diff --git a/official/1.96/packages/d7/template.dpr b/official/1.96/packages/d7/template.dpr new file mode 100644 index 0000000..1aaebf1 --- /dev/null +++ b/official/1.96/packages/d7/template.dpr @@ -0,0 +1,58 @@ +%PROJECT% %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '70'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +<%%% BEGIN LIBRARYONLY %%%> +exports + JCLWizardInit name WizardEntryPoint; +<%%% END LIBRARYONLY %%%> + +end. diff --git a/official/1.96/packages/d7/template.rc b/official/1.96/packages/d7/template.rc new file mode 100644 index 0000000..ea040f6 --- /dev/null +++ b/official/1.96/packages/d7/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%70%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d8/Jcl.RES b/official/1.96/packages/d8/Jcl.RES new file mode 100644 index 0000000..2c2d17d Binary files /dev/null and b/official/1.96/packages/d8/Jcl.RES differ diff --git a/official/1.96/packages/d8/Jcl.bdsproj b/official/1.96/packages/d8/Jcl.bdsproj new file mode 100644 index 0000000..437671c --- /dev/null +++ b/official/1.96/packages/d8/Jcl.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + Jcl.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $48000000 + JEDI Code Library RTL package + + + + ..\..\lib\d8 + + + ..\..\common + + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JEDI Code Library RTL package + 1.97.1.2172 + Jcl + Copyright (C) 1999, 2005 Project JEDI + + Jcl80.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d8/Jcl.dof b/official/1.96/packages/d8/Jcl.dof new file mode 100644 index 0000000..1ccd66c --- /dev/null +++ b/official/1.96/packages/d8/Jcl.dof @@ -0,0 +1,7 @@ +[Directories] +UnitOutputDir=..\..\lib\d8 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl diff --git a/official/1.96/packages/d8/Jcl.dpk b/official/1.96/packages/d8/Jcl.dpk new file mode 100644 index 0000000..d9490a5 --- /dev/null +++ b/official/1.96/packages/d8/Jcl.dpk @@ -0,0 +1,126 @@ +package Jcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 26-12-2005 14:30:14 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$LIBSUFFIX '80'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl + ; + +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWideFormat in '..\..\source\windows\JclWideFormat.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' + ; + +end. diff --git a/official/1.96/packages/d8/Jcl.rc b/official/1.96/packages/d8/Jcl.rc new file mode 100644 index 0000000..dd0c442 --- /dev/null +++ b/official/1.96/packages/d8/Jcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "Jcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "Jcl80.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d8/JclBaseExpert.RES b/official/1.96/packages/d8/JclBaseExpert.RES new file mode 100644 index 0000000..06a92a6 Binary files /dev/null and b/official/1.96/packages/d8/JclBaseExpert.RES differ diff --git a/official/1.96/packages/d8/JclBaseExpert.bdsproj b/official/1.96/packages/d8/JclBaseExpert.bdsproj new file mode 100644 index 0000000..03bb766 --- /dev/null +++ b/official/1.96/packages/d8/JclBaseExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclBaseExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58000000 + JCL Package containing common units for JCL Experts + + + + ..\..\lib\d8 + + + ..\..\common + + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Package containing common units for JCL Experts + 1.97.1.2172 + JclBaseExpert + Copyright (C) 1999, 2005 Project JEDI + + JclBaseExpert80.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d8/JclBaseExpert.dof b/official/1.96/packages/d8/JclBaseExpert.dof new file mode 100644 index 0000000..8b47796 --- /dev/null +++ b/official/1.96/packages/d8/JclBaseExpert.dof @@ -0,0 +1,7 @@ +[Directories] +UnitOutputDir=..\..\lib\d8 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl diff --git a/official/1.96/packages/d8/JclBaseExpert.dpk b/official/1.96/packages/d8/JclBaseExpert.dpk new file mode 100644 index 0000000..a22c522 --- /dev/null +++ b/official/1.96/packages/d8/JclBaseExpert.dpk @@ -0,0 +1,54 @@ +package JclBaseExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 04-01-2006 22:23:23 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58000000} +{$DESCRIPTION 'JCL Package containing common units for JCL Experts'} +{$LIBSUFFIX '80'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl + ; + +contains + JclOtaUtils in '..\..\experts\common\JclOtaUtils.pas' , + JclOtaResources in '..\..\experts\common\JclOtaResources.pas' , + JclOtaConsts in '..\..\experts\common\JclOtaConsts.pas' , + JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm}, + JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm}, + JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame} + ; + +end. diff --git a/official/1.96/packages/d8/JclBaseExpert.rc b/official/1.96/packages/d8/JclBaseExpert.rc new file mode 100644 index 0000000..72fb115 --- /dev/null +++ b/official/1.96/packages/d8/JclBaseExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Package containing common units for JCL Experts\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclBaseExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclBaseExpert80.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.RES b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.RES new file mode 100644 index 0000000..dbbf080 Binary files /dev/null and b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.RES differ diff --git a/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.bdsproj b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.bdsproj new file mode 100644 index 0000000..b2b9a46 --- /dev/null +++ b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclFavoriteFoldersExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58020000 + JCL Open and Save IDE dialogs with favorite folders + + + + ..\..\lib\d8 + + + ..\..\common + + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Open and Save IDE dialogs with favorite folders + 1.97.1.2172 + JclFavoriteFoldersExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclFavoriteFoldersExpertDLL80.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.dof b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.dof new file mode 100644 index 0000000..598dcbf --- /dev/null +++ b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.dof @@ -0,0 +1,7 @@ +[Directories] +UnitOutputDir=..\..\lib\d8 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert diff --git a/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.dpr b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.dpr new file mode 100644 index 0000000..165fea2 --- /dev/null +++ b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclFavoriteFoldersExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpertDLL-L.xml) + + Last generated: 26-12-2005 14:33:14 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX '80'} + +uses + ToolsAPI, + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +begin +end. diff --git a/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.rc b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.rc new file mode 100644 index 0000000..d5a7762 --- /dev/null +++ b/official/1.96/packages/d8/JclFavoriteFoldersExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertDLL80.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d8/JclVersionControlExpertDLL.bdsproj b/official/1.96/packages/d8/JclVersionControlExpertDLL.bdsproj new file mode 100644 index 0000000..07270a3 --- /dev/null +++ b/official/1.96/packages/d8/JclVersionControlExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclVersionControlExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58070000 + JCL Integration of version control systems in the IDE + + + + ..\..\lib\d8 + + + ..\..\common + + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Integration of version control systems in the IDE + 1.97.1.2172 + JclVersionControlExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclVersionControlExpertDLL80.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d8/JclVersionControlExpertDLL.dof b/official/1.96/packages/d8/JclVersionControlExpertDLL.dof new file mode 100644 index 0000000..598dcbf --- /dev/null +++ b/official/1.96/packages/d8/JclVersionControlExpertDLL.dof @@ -0,0 +1,7 @@ +[Directories] +UnitOutputDir=..\..\lib\d8 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert diff --git a/official/1.96/packages/d8/JclVersionControlExpertDLL.dpr b/official/1.96/packages/d8/JclVersionControlExpertDLL.dpr new file mode 100644 index 0000000..2933883 --- /dev/null +++ b/official/1.96/packages/d8/JclVersionControlExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclVersionControlExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpertDLL-L.xml) + + Last generated: 15-01-2006 00:37:27 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX '80'} + +uses + ToolsAPI, + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +begin +end. diff --git a/official/1.96/packages/d8/JclVersionControlExpertDLL.rc b/official/1.96/packages/d8/JclVersionControlExpertDLL.rc new file mode 100644 index 0000000..084e8b9 --- /dev/null +++ b/official/1.96/packages/d8/JclVersionControlExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertDLL80.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d8/JclVersionControlExpertDLL.res b/official/1.96/packages/d8/JclVersionControlExpertDLL.res new file mode 100644 index 0000000..0daef6c Binary files /dev/null and b/official/1.96/packages/d8/JclVersionControlExpertDLL.res differ diff --git a/official/1.96/packages/d8/template.bdsproj b/official/1.96/packages/d8/template.bdsproj new file mode 100644 index 0000000..fbb1e65 --- /dev/null +++ b/official/1.96/packages/d8/template.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + %NAME%%SOURCEEXTENSION% + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + %IMAGE_BASE% + %DESCRIPTION% + + + + ..\..\lib\d8 + + + ..\..\common + + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + %VERSION_MAJOR_NUMBER% + %VERSION_MINOR_NUMBER% + %RELEASE_NUMBER% + %BUILD_NUMBER% + False + False + False + False + %ISDLL% + 1053 + 1252 + + + Project JEDI + %DESCRIPTION% + %VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER% + %NAME% + Copyright (C) 1999, 2005 Project JEDI + + %NAME%80%BINEXTENSION% + Jedi Code Library + %VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER% + + + diff --git a/official/1.96/packages/d8/template.dof b/official/1.96/packages/d8/template.dof new file mode 100644 index 0000000..646f9bb --- /dev/null +++ b/official/1.96/packages/d8/template.dof @@ -0,0 +1,9 @@ +[Directories] +UnitOutputDir=..\..\lib\d8 +SearchPath=..\..\source;..\..\experts\common +<%%% BEGIN EXPERTONLY %%%> +[Compiler] +PackageNoLink=1 +[Linker] +Packages=%NOLINKPACKAGELIST% +<%%% END EXPERTONLY %%%> \ No newline at end of file diff --git a/official/1.96/packages/d8/template.dpk b/official/1.96/packages/d8/template.dpk new file mode 100644 index 0000000..f7257e8 --- /dev/null +++ b/official/1.96/packages/d8/template.dpk @@ -0,0 +1,56 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '80'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. diff --git a/official/1.96/packages/d8/template.dpr b/official/1.96/packages/d8/template.dpr new file mode 100644 index 0000000..bcd1532 --- /dev/null +++ b/official/1.96/packages/d8/template.dpr @@ -0,0 +1,60 @@ +%PROJECT% %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '80'} + +uses +<%%% BEGIN EXPERTONLY %%%> + ToolsAPI, +<%%% END EXPERTONLY %%%> +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +<%%% BEGIN EXPERTONLY %%%> +exports + JCLWizardInit name WizardEntryPoint; +<%%% END EXPERTONLY %%%> + +begin +end. diff --git a/official/1.96/packages/d8/template.rc b/official/1.96/packages/d8/template.rc new file mode 100644 index 0000000..7f6a146 --- /dev/null +++ b/official/1.96/packages/d8/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%80%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9.net/Jedi.Jcl.bdsproj b/official/1.96/packages/d9.net/Jedi.Jcl.bdsproj new file mode 100644 index 0000000..5ec7d9d --- /dev/null +++ b/official/1.96/packages/d9.net/Jedi.Jcl.bdsproj @@ -0,0 +1,213 @@ + + + + + + + + + + + + Jedi.Jcl.dpr + + + 7.0 + + + 0 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + + + False + Jedi.Jcl + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + + 0 + 0 + 1 + True + False + False + 4096 + 1048576 + 4194304 + + False + + + ..\..\bin + ..\..\lib\d9.net + + + + + + + True + + + + + + False + + + + + + False + + True + False + + + + $00000000 + + + + False + False + 1 + 96 + 1 + 2070 + False + False + False + False + True + 1031 + 1252 + + + + + 1.96.1.2070 + Jedi.Jcl + Copyright (C) 1999, 2005 Project JEDI + + Jedi.Jcl90.dll + Jedi Code Library + 1.96 Build 2070 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/d9.net/Jedi.Jcl.dpr b/official/1.96/packages/d9.net/Jedi.Jcl.dpr new file mode 100644 index 0000000..9f2b7c5 --- /dev/null +++ b/official/1.96/packages/d9.net/Jedi.Jcl.dpr @@ -0,0 +1,63 @@ +Library Jedi.Jcl; + +uses + , + + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclAnsiStrings in '..\..\source\common\JclAnsiStrings.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' + ; + +{$LIBSUFFIX '9'} + +[assembly: AssemblyTitle('JEDI Code Library')] +[assembly: AssemblyDescription('Functions and classes')] +[assembly: AssemblyConfiguration('')] +[assembly: AssemblyCompany('')] +[assembly: AssemblyProduct('JCL')] +[assembly: AssemblyCopyright('')] +[assembly: AssemblyTrademark('')] +[assembly: AssemblyCulture('')] + +// MajorVersion.MinorVersion.BuildNumber.Revision +[assembly: AssemblyVersion('1.0.*')] + +// Package signature +[assembly: AssemblyDelaySign(false)] +[assembly: AssemblyKeyFile('')] +[assembly: AssemblyKeyName('')] + +// Com visibility of the assembly +[assembly: ComVisible(False)] +//[assembly: Guid('')] +//[assembly: TypeLibVersion(1, 0)] + + +begin +end. diff --git a/official/1.96/packages/d9/Jcl.RES b/official/1.96/packages/d9/Jcl.RES new file mode 100644 index 0000000..39199f7 Binary files /dev/null and b/official/1.96/packages/d9/Jcl.RES differ diff --git a/official/1.96/packages/d9/Jcl.bdsproj b/official/1.96/packages/d9/Jcl.bdsproj new file mode 100644 index 0000000..bf43c8b --- /dev/null +++ b/official/1.96/packages/d9/Jcl.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + Jcl.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $48000000 + JEDI Code Library RTL package + + + + ..\..\lib\d9 + + + ..\..\common + rtl + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JEDI Code Library RTL package + 1.97.1.2172 + Jcl + Copyright (C) 1999, 2005 Project JEDI + + Jcl90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/Jcl.dof b/official/1.96/packages/d9/Jcl.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/Jcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/Jcl.dpk b/official/1.96/packages/d9/Jcl.dpk new file mode 100644 index 0000000..61bb4a1 --- /dev/null +++ b/official/1.96/packages/d9/Jcl.dpk @@ -0,0 +1,126 @@ +package Jcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$LIBSUFFIX '90'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl + ; + +contains + Jcl8087 in '..\..\source\common\Jcl8087.pas' , + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas' , + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas' , + JclArrayLists in '..\..\source\common\JclArrayLists.pas' , + JclArraySets in '..\..\source\common\JclArraySets.pas' , + JclBase in '..\..\source\common\JclBase.pas' , + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas' , + JclBorlandTools in '..\..\source\common\JclBorlandTools.pas' , + JclComplex in '..\..\source\common\JclComplex.pas' , + JclCompression in '..\..\source\common\JclCompression.pas' , + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas' , + JclCounter in '..\..\source\common\JclCounter.pas' , + JclDateTime in '..\..\source\common\JclDateTime.pas' , + JclEDI in '..\..\source\common\JclEDI.pas' , + JclEDISEF in '..\..\source\common\JclEDISEF.pas' , + JclEDITranslators in '..\..\source\common\JclEDITranslators.pas' , + JclEDIXML in '..\..\source\common\JclEDIXML.pas' , + JclEDI_ANSIX12 in '..\..\source\common\JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '..\..\source\common\JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '..\..\source\common\JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '..\..\source\common\JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '..\..\source\common\JclExprEval.pas' , + JclFileUtils in '..\..\source\common\JclFileUtils.pas' , + JclHashMaps in '..\..\source\common\JclHashMaps.pas' , + JclHashSets in '..\..\source\common\JclHashSets.pas' , + JclIniFiles in '..\..\source\common\JclIniFiles.pas' , + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas' , + JclLogic in '..\..\source\common\JclLogic.pas' , + JclMath in '..\..\source\common\JclMath.pas' , + JclMIDI in '..\..\source\common\JclMIDI.pas' , + JclMime in '..\..\source\common\JclMime.pas' , + JclPCRE in '..\..\source\common\JclPCRE.pas' , + JclQueues in '..\..\source\common\JclQueues.pas' , + JclResources in '..\..\source\common\JclResources.pas' , + JclRTTI in '..\..\source\common\JclRTTI.pas' , + JclSchedule in '..\..\source\common\JclSchedule.pas' , + JclStacks in '..\..\source\common\JclStacks.pas' , + JclStatistics in '..\..\source\common\JclStatistics.pas' , + JclStrHashMap in '..\..\source\common\JclStrHashMap.pas' , + JclStrings in '..\..\source\common\JclStrings.pas' , + JclSysInfo in '..\..\source\common\JclSysInfo.pas' , + JclSysUtils in '..\..\source\common\JclSysUtils.pas' , + JclUnitConv in '..\..\source\common\JclUnitConv.pas' , + JclUnitVersioning in '..\..\source\common\JclUnitVersioning.pas' , + JclUnitVersioningProviders in '..\..\source\common\JclUnitVersioningProviders.pas' , + JclValidation in '..\..\source\common\JclValidation.pas' , + JclVectors in '..\..\source\common\JclVectors.pas' , + JclWideStrings in '..\..\source\common\JclWideStrings.pas' , + pcre in '..\..\source\common\pcre.pas' , + Hardlinks in '..\..\source\windows\Hardlinks.pas' , + JclAppInst in '..\..\source\windows\JclAppInst.pas' , + JclCIL in '..\..\source\windows\JclCIL.pas' , + JclCLR in '..\..\source\windows\JclCLR.pas' , + JclCOM in '..\..\source\windows\JclCOM.pas' , + JclConsole in '..\..\source\windows\JclConsole.pas' , + JclDebug in '..\..\source\windows\JclDebug.pas' , + JclHookExcept in '..\..\source\windows\JclHookExcept.pas' , + JclLANMan in '..\..\source\windows\JclLANMan.pas' , + JclLocales in '..\..\source\windows\JclLocales.pas' , + JclMapi in '..\..\source\windows\JclMapi.pas' , + JclMetadata in '..\..\source\windows\JclMetadata.pas' , + JclMiscel in '..\..\source\windows\JclMiscel.pas' , + JclMsdosSys in '..\..\source\windows\JclMsdosSys.pas' , + JclMultimedia in '..\..\source\windows\JclMultimedia.pas' , + JclNTFS in '..\..\source\windows\JclNTFS.pas' , + JclPeImage in '..\..\source\windows\JclPeImage.pas' , + JclRegistry in '..\..\source\windows\JclRegistry.pas' , + JclSecurity in '..\..\source\windows\JclSecurity.pas' , + JclShell in '..\..\source\windows\JclShell.pas' , + JclStructStorage in '..\..\source\windows\JclStructStorage.pas' , + JclSvcCtrl in '..\..\source\windows\JclSvcCtrl.pas' , + JclSynch in '..\..\source\windows\JclSynch.pas' , + JclTask in '..\..\source\windows\JclTask.pas' , + JclTD32 in '..\..\source\windows\JclTD32.pas' , + JclUnicode in '..\..\source\windows\JclUnicode.pas' , + JclWideFormat in '..\..\source\windows\JclWideFormat.pas' , + JclWin32 in '..\..\source\windows\JclWin32.pas' , + JclWinMIDI in '..\..\source\windows\JclWinMIDI.pas' , + MSTask in '..\..\source\windows\MSTask.pas' , + Snmp in '..\..\source\windows\Snmp.pas' , + zlibh in '..\..\source\windows\zlibh.pas' + ; + +end. diff --git a/official/1.96/packages/d9/Jcl.rc b/official/1.96/packages/d9/Jcl.rc new file mode 100644 index 0000000..a9fac5e --- /dev/null +++ b/official/1.96/packages/d9/Jcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "Jcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "Jcl90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclBaseExpert.bdsproj b/official/1.96/packages/d9/JclBaseExpert.bdsproj new file mode 100644 index 0000000..ff2c51c --- /dev/null +++ b/official/1.96/packages/d9/JclBaseExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclBaseExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58000000 + JCL Package containing common units for JCL Experts + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Package containing common units for JCL Experts + 1.97.1.2172 + JclBaseExpert + Copyright (C) 1999, 2005 Project JEDI + + JclBaseExpert90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclBaseExpert.dof b/official/1.96/packages/d9/JclBaseExpert.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/JclBaseExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/JclBaseExpert.dpk b/official/1.96/packages/d9/JclBaseExpert.dpk new file mode 100644 index 0000000..e429a3e --- /dev/null +++ b/official/1.96/packages/d9/JclBaseExpert.dpk @@ -0,0 +1,54 @@ +package JclBaseExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclBaseExpert-D.xml) + + Last generated: 04-01-2006 22:23:23 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58000000} +{$DESCRIPTION 'JCL Package containing common units for JCL Experts'} +{$LIBSUFFIX '90'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl + ; + +contains + JclOtaUtils in '..\..\experts\common\JclOtaUtils.pas' , + JclOtaResources in '..\..\experts\common\JclOtaResources.pas' , + JclOtaConsts in '..\..\experts\common\JclOtaConsts.pas' , + JclOtaExceptionForm in '..\..\experts\common\JclOtaExceptionForm.pas' {JclExpertExceptionForm}, + JclOtaConfigurationForm in '..\..\experts\common\JclOtaConfigurationForm.pas' {JclOtaOptionsForm}, + JclOtaActionConfigureSheet in '..\..\experts\common\JclOtaActionConfigureSheet.pas' {JclOtaActionConfigureFrame} + ; + +end. diff --git a/official/1.96/packages/d9/JclBaseExpert.rc b/official/1.96/packages/d9/JclBaseExpert.rc new file mode 100644 index 0000000..3f8160b --- /dev/null +++ b/official/1.96/packages/d9/JclBaseExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Package containing common units for JCL Experts\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclBaseExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclBaseExpert90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclBaseExpert.res b/official/1.96/packages/d9/JclBaseExpert.res new file mode 100644 index 0000000..8ecab08 Binary files /dev/null and b/official/1.96/packages/d9/JclBaseExpert.res differ diff --git a/official/1.96/packages/d9/JclDebugExpert.RES b/official/1.96/packages/d9/JclDebugExpert.RES new file mode 100644 index 0000000..3c3c10a Binary files /dev/null and b/official/1.96/packages/d9/JclDebugExpert.RES differ diff --git a/official/1.96/packages/d9/JclDebugExpert.bdsproj b/official/1.96/packages/d9/JclDebugExpert.bdsproj new file mode 100644 index 0000000..25d59ed --- /dev/null +++ b/official/1.96/packages/d9/JclDebugExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclDebugExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58010000 + JCL Debug IDE extension + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Debug IDE extension + 1.97.1.2172 + JclDebugExpert + Copyright (C) 1999, 2005 Project JEDI + + JclDebugExpert90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclDebugExpert.dof b/official/1.96/packages/d9/JclDebugExpert.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/JclDebugExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/JclDebugExpert.dpk b/official/1.96/packages/d9/JclDebugExpert.dpk new file mode 100644 index 0000000..c732c2d --- /dev/null +++ b/official/1.96/packages/d9/JclDebugExpert.dpk @@ -0,0 +1,51 @@ +package JclDebugExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$LIBSUFFIX '90'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d9/JclDebugExpert.rc b/official/1.96/packages/d9/JclDebugExpert.rc new file mode 100644 index 0000000..2a1f60d --- /dev/null +++ b/official/1.96/packages/d9/JclDebugExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpert90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclDebugExpertDLL.RES b/official/1.96/packages/d9/JclDebugExpertDLL.RES new file mode 100644 index 0000000..c0ba383 Binary files /dev/null and b/official/1.96/packages/d9/JclDebugExpertDLL.RES differ diff --git a/official/1.96/packages/d9/JclDebugExpertDLL.bdsproj b/official/1.96/packages/d9/JclDebugExpertDLL.bdsproj new file mode 100644 index 0000000..417c74d --- /dev/null +++ b/official/1.96/packages/d9/JclDebugExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclDebugExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58010000 + JCL Debug IDE extension + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Debug IDE extension + 1.97.1.2172 + JclDebugExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclDebugExpertDLL90.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclDebugExpertDLL.dof b/official/1.96/packages/d9/JclDebugExpertDLL.dof new file mode 100644 index 0000000..0fa3967 --- /dev/null +++ b/official/1.96/packages/d9/JclDebugExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d9/JclDebugExpertDLL.dpr b/official/1.96/packages/d9/JclDebugExpertDLL.dpr new file mode 100644 index 0000000..fed75e5 --- /dev/null +++ b/official/1.96/packages/d9/JclDebugExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclDebugExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclDebugExpertDLL-L.xml) + + Last generated: 26-12-2005 13:23:40 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58010000} +{$DESCRIPTION 'JCL Debug IDE extension'} +{$LIBSUFFIX '90'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclDebugIdeResult in '..\..\experts\debug\JclDebugIdeResult.pas' {JclDebugResultForm}, + JclDebugIdeImpl in '..\..\experts\debug\JclDebugIdeImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d9/JclDebugExpertDLL.rc b/official/1.96/packages/d9/JclDebugExpertDLL.rc new file mode 100644 index 0000000..14eb667 --- /dev/null +++ b/official/1.96/packages/d9/JclDebugExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug IDE extension\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclDebugExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclDebugExpertDLL90.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclExperts.bdsgroup b/official/1.96/packages/d9/JclExperts.bdsgroup new file mode 100644 index 0000000..16eb44f --- /dev/null +++ b/official/1.96/packages/d9/JclExperts.bdsgroup @@ -0,0 +1,22 @@ + + + + + + + + + + + JclDebugExpert.bdsproj + JclSIMDViewExpert.bdsproj + JclProjectAnalysisExpert.bdsproj + JclFavoriteFoldersExpert.bdsproj + JclUsesExpert.bdsproj + JclThreadNameExpert.bdsproj + JclDebugExpert90.bpl JclSIMDViewExpert90.bpl JclProjectAnalysisExpert90.bpl JclFavoriteFoldersExpert90.bpl JclUsesExpert90.bpl JclThreadNameExpert90.bpl + + + + diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpert.bdsproj b/official/1.96/packages/d9/JclFavoriteFoldersExpert.bdsproj new file mode 100644 index 0000000..ecb3185 --- /dev/null +++ b/official/1.96/packages/d9/JclFavoriteFoldersExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclFavoriteFoldersExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58020000 + JCL Open and Save IDE dialogs with favorite folders + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Open and Save IDE dialogs with favorite folders + 1.97.1.2172 + JclFavoriteFoldersExpert + Copyright (C) 1999, 2005 Project JEDI + + JclFavoriteFoldersExpert90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpert.dof b/official/1.96/packages/d9/JclFavoriteFoldersExpert.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/JclFavoriteFoldersExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpert.dpk b/official/1.96/packages/d9/JclFavoriteFoldersExpert.dpk new file mode 100644 index 0000000..0c54d20 --- /dev/null +++ b/official/1.96/packages/d9/JclFavoriteFoldersExpert.dpk @@ -0,0 +1,51 @@ +package JclFavoriteFoldersExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX '90'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +end. diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpert.rc b/official/1.96/packages/d9/JclFavoriteFoldersExpert.rc new file mode 100644 index 0000000..3655348 --- /dev/null +++ b/official/1.96/packages/d9/JclFavoriteFoldersExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpert90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpert.res b/official/1.96/packages/d9/JclFavoriteFoldersExpert.res new file mode 100644 index 0000000..2cad39b Binary files /dev/null and b/official/1.96/packages/d9/JclFavoriteFoldersExpert.res differ diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.RES b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.RES new file mode 100644 index 0000000..8c266d5 Binary files /dev/null and b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.RES differ diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.bdsproj b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.bdsproj new file mode 100644 index 0000000..2596401 --- /dev/null +++ b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclFavoriteFoldersExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58020000 + JCL Open and Save IDE dialogs with favorite folders + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Open and Save IDE dialogs with favorite folders + 1.97.1.2172 + JclFavoriteFoldersExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclFavoriteFoldersExpertDLL90.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.dof b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.dof new file mode 100644 index 0000000..0fa3967 --- /dev/null +++ b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.dpr b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.dpr new file mode 100644 index 0000000..a3baba7 --- /dev/null +++ b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclFavoriteFoldersExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclFavoriteFoldersExpertDLL-L.xml) + + Last generated: 26-12-2005 13:23:40 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58020000} +{$DESCRIPTION 'JCL Open and Save IDE dialogs with favorite folders'} +{$LIBSUFFIX '90'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + IdeOpenDlgFavoriteUnit in '..\..\experts\favfolders\IdeOpenDlgFavoriteUnit.pas' , + OpenDlgFavAdapter in '..\..\experts\favfolders\OpenDlgFavAdapter.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.rc b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.rc new file mode 100644 index 0000000..6fb2890 --- /dev/null +++ b/official/1.96/packages/d9/JclFavoriteFoldersExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Open and Save IDE dialogs with favorite folders\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclFavoriteFoldersExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclFavoriteFoldersExpertDLL90.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpert.RES b/official/1.96/packages/d9/JclProjectAnalysisExpert.RES new file mode 100644 index 0000000..33321a2 Binary files /dev/null and b/official/1.96/packages/d9/JclProjectAnalysisExpert.RES differ diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpert.bdsproj b/official/1.96/packages/d9/JclProjectAnalysisExpert.bdsproj new file mode 100644 index 0000000..f61bd49 --- /dev/null +++ b/official/1.96/packages/d9/JclProjectAnalysisExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclProjectAnalysisExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58030000 + JCL Project Analyzer + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Project Analyzer + 1.97.1.2172 + JclProjectAnalysisExpert + Copyright (C) 1999, 2005 Project JEDI + + JclProjectAnalysisExpert90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpert.dof b/official/1.96/packages/d9/JclProjectAnalysisExpert.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/JclProjectAnalysisExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpert.dpk b/official/1.96/packages/d9/JclProjectAnalysisExpert.dpk new file mode 100644 index 0000000..a9fe5ef --- /dev/null +++ b/official/1.96/packages/d9/JclProjectAnalysisExpert.dpk @@ -0,0 +1,51 @@ +package JclProjectAnalysisExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$LIBSUFFIX '90'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpert.rc b/official/1.96/packages/d9/JclProjectAnalysisExpert.rc new file mode 100644 index 0000000..f0d47ae --- /dev/null +++ b/official/1.96/packages/d9/JclProjectAnalysisExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpert90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.RES b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.RES new file mode 100644 index 0000000..f278a8c Binary files /dev/null and b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.RES differ diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.bdsproj b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.bdsproj new file mode 100644 index 0000000..de2ba07 --- /dev/null +++ b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclProjectAnalysisExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58030000 + JCL Project Analyzer + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Project Analyzer + 1.97.1.2172 + JclProjectAnalysisExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclProjectAnalysisExpertDLL90.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.dof b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.dof new file mode 100644 index 0000000..0fa3967 --- /dev/null +++ b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.dpr b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.dpr new file mode 100644 index 0000000..ffce46d --- /dev/null +++ b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclProjectAnalysisExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclProjectAnalysisExpertDLL-L.xml) + + Last generated: 26-12-2005 13:23:40 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58030000} +{$DESCRIPTION 'JCL Project Analyzer'} +{$LIBSUFFIX '90'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ProjAnalyzerFrm in '..\..\experts\projectanalyzer\ProjAnalyzerFrm.pas' {ProjectAnalyzerForm}, + ProjAnalyzerImpl in '..\..\experts\projectanalyzer\ProjAnalyzerImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.rc b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.rc new file mode 100644 index 0000000..00ae1e0 --- /dev/null +++ b/official/1.96/packages/d9/JclProjectAnalysisExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Project Analyzer\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclProjectAnalysisExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclProjectAnalysisExpertDLL90.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclSIMDViewExpert.bdsproj b/official/1.96/packages/d9/JclSIMDViewExpert.bdsproj new file mode 100644 index 0000000..3ab223c --- /dev/null +++ b/official/1.96/packages/d9/JclSIMDViewExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclSIMDViewExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58040000 + JCL Debug Window of XMM registers + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Debug Window of XMM registers + 1.97.1.2172 + JclSIMDViewExpert + Copyright (C) 1999, 2005 Project JEDI + + JclSIMDViewExpert90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclSIMDViewExpert.dof b/official/1.96/packages/d9/JclSIMDViewExpert.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/JclSIMDViewExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/JclSIMDViewExpert.dpk b/official/1.96/packages/d9/JclSIMDViewExpert.dpk new file mode 100644 index 0000000..e3f7e37 --- /dev/null +++ b/official/1.96/packages/d9/JclSIMDViewExpert.dpk @@ -0,0 +1,54 @@ +package JclSIMDViewExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$LIBSUFFIX '90'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +end. diff --git a/official/1.96/packages/d9/JclSIMDViewExpert.rc b/official/1.96/packages/d9/JclSIMDViewExpert.rc new file mode 100644 index 0000000..7384b67 --- /dev/null +++ b/official/1.96/packages/d9/JclSIMDViewExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpert90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclSIMDViewExpertDLL.RES b/official/1.96/packages/d9/JclSIMDViewExpertDLL.RES new file mode 100644 index 0000000..1db3d2b Binary files /dev/null and b/official/1.96/packages/d9/JclSIMDViewExpertDLL.RES differ diff --git a/official/1.96/packages/d9/JclSIMDViewExpertDLL.bdsproj b/official/1.96/packages/d9/JclSIMDViewExpertDLL.bdsproj new file mode 100644 index 0000000..36a41d2 --- /dev/null +++ b/official/1.96/packages/d9/JclSIMDViewExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclSIMDViewExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58040000 + JCL Debug Window of XMM registers + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Debug Window of XMM registers + 1.97.1.2172 + JclSIMDViewExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclSIMDViewExpertDLL90.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclSIMDViewExpertDLL.dof b/official/1.96/packages/d9/JclSIMDViewExpertDLL.dof new file mode 100644 index 0000000..0fa3967 --- /dev/null +++ b/official/1.96/packages/d9/JclSIMDViewExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d9/JclSIMDViewExpertDLL.dpr b/official/1.96/packages/d9/JclSIMDViewExpertDLL.dpr new file mode 100644 index 0000000..46f48ba --- /dev/null +++ b/official/1.96/packages/d9/JclSIMDViewExpertDLL.dpr @@ -0,0 +1,49 @@ +Library JclSIMDViewExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclSIMDViewExpertDLL-L.xml) + + Last generated: 26-12-2005 13:23:40 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58040000} +{$DESCRIPTION 'JCL Debug Window of XMM registers'} +{$LIBSUFFIX '90'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JclSIMDViewForm in '..\..\experts\debug\simdview\JclSIMDViewForm.pas' {JclSIMDViewFrm}, + JclSIMDView in '..\..\experts\debug\simdview\JclSIMDView.pas' , + JclSIMDUtils in '..\..\experts\debug\simdview\JclSIMDUtils.pas' , + JclSIMDModifyForm in '..\..\experts\debug\simdview\JclSIMDModifyForm.pas' {JclSIMDModifyFrm}, + JclSIMDCpuInfo in '..\..\experts\debug\simdview\JclSIMDCpuInfo.pas' {JclFormCpuInfo} + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d9/JclSIMDViewExpertDLL.rc b/official/1.96/packages/d9/JclSIMDViewExpertDLL.rc new file mode 100644 index 0000000..7ea06d4 --- /dev/null +++ b/official/1.96/packages/d9/JclSIMDViewExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Debug Window of XMM registers\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclSIMDViewExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclSIMDViewExpertDLL90.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclSimdViewExpert.RES b/official/1.96/packages/d9/JclSimdViewExpert.RES new file mode 100644 index 0000000..963b812 Binary files /dev/null and b/official/1.96/packages/d9/JclSimdViewExpert.RES differ diff --git a/official/1.96/packages/d9/JclThreadNameExpert.RES b/official/1.96/packages/d9/JclThreadNameExpert.RES new file mode 100644 index 0000000..50dd331 Binary files /dev/null and b/official/1.96/packages/d9/JclThreadNameExpert.RES differ diff --git a/official/1.96/packages/d9/JclThreadNameExpert.bdsproj b/official/1.96/packages/d9/JclThreadNameExpert.bdsproj new file mode 100644 index 0000000..c388c9b --- /dev/null +++ b/official/1.96/packages/d9/JclThreadNameExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclThreadNameExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58050000 + JCL Thread Name IDE expert + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Thread Name IDE expert + 1.97.1.2172 + JclThreadNameExpert + Copyright (C) 1999, 2005 Project JEDI + + JclThreadNameExpert90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclThreadNameExpert.dof b/official/1.96/packages/d9/JclThreadNameExpert.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/JclThreadNameExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/JclThreadNameExpert.dpk b/official/1.96/packages/d9/JclThreadNameExpert.dpk new file mode 100644 index 0000000..d65aa79 --- /dev/null +++ b/official/1.96/packages/d9/JclThreadNameExpert.dpk @@ -0,0 +1,51 @@ +package JclThreadNameExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$LIBSUFFIX '90'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +end. diff --git a/official/1.96/packages/d9/JclThreadNameExpert.rc b/official/1.96/packages/d9/JclThreadNameExpert.rc new file mode 100644 index 0000000..41b184e --- /dev/null +++ b/official/1.96/packages/d9/JclThreadNameExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpert90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclThreadNameExpertDLL.RES b/official/1.96/packages/d9/JclThreadNameExpertDLL.RES new file mode 100644 index 0000000..010c282 Binary files /dev/null and b/official/1.96/packages/d9/JclThreadNameExpertDLL.RES differ diff --git a/official/1.96/packages/d9/JclThreadNameExpertDLL.bdsproj b/official/1.96/packages/d9/JclThreadNameExpertDLL.bdsproj new file mode 100644 index 0000000..1d9ec6c --- /dev/null +++ b/official/1.96/packages/d9/JclThreadNameExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclThreadNameExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58050000 + JCL Thread Name IDE expert + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Thread Name IDE expert + 1.97.1.2172 + JclThreadNameExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclThreadNameExpertDLL90.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclThreadNameExpertDLL.dof b/official/1.96/packages/d9/JclThreadNameExpertDLL.dof new file mode 100644 index 0000000..0fa3967 --- /dev/null +++ b/official/1.96/packages/d9/JclThreadNameExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d9/JclThreadNameExpertDLL.dpr b/official/1.96/packages/d9/JclThreadNameExpertDLL.dpr new file mode 100644 index 0000000..14f4d41 --- /dev/null +++ b/official/1.96/packages/d9/JclThreadNameExpertDLL.dpr @@ -0,0 +1,46 @@ +Library JclThreadNameExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclThreadNameExpertDLL-L.xml) + + Last generated: 26-12-2005 13:23:40 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58050000} +{$DESCRIPTION 'JCL Thread Name IDE expert'} +{$LIBSUFFIX '90'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + ThreadExpertSharedNames in '..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas' , + ThreadExpertUnit in '..\..\experts\debug\threadnames\ThreadExpertUnit.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d9/JclThreadNameExpertDLL.rc b/official/1.96/packages/d9/JclThreadNameExpertDLL.rc new file mode 100644 index 0000000..d294f70 --- /dev/null +++ b/official/1.96/packages/d9/JclThreadNameExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Thread Name IDE expert\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclThreadNameExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclThreadNameExpertDLL90.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclUsesExpert.bdsproj b/official/1.96/packages/d9/JclUsesExpert.bdsproj new file mode 100644 index 0000000..bd9559b --- /dev/null +++ b/official/1.96/packages/d9/JclUsesExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclUsesExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58060000 + JCL Uses Wizard + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Uses Wizard + 1.97.1.2172 + JclUsesExpert + Copyright (C) 1999, 2005 Project JEDI + + JclUsesExpert90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclUsesExpert.dof b/official/1.96/packages/d9/JclUsesExpert.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/JclUsesExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/JclUsesExpert.dpk b/official/1.96/packages/d9/JclUsesExpert.dpk new file mode 100644 index 0000000..907897e --- /dev/null +++ b/official/1.96/packages/d9/JclUsesExpert.dpk @@ -0,0 +1,53 @@ +package JclUsesExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpert-D.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$LIBSUFFIX '90'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +end. diff --git a/official/1.96/packages/d9/JclUsesExpert.rc b/official/1.96/packages/d9/JclUsesExpert.rc new file mode 100644 index 0000000..d223a72 --- /dev/null +++ b/official/1.96/packages/d9/JclUsesExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpert90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclUsesExpert.res b/official/1.96/packages/d9/JclUsesExpert.res new file mode 100644 index 0000000..fd61c83 Binary files /dev/null and b/official/1.96/packages/d9/JclUsesExpert.res differ diff --git a/official/1.96/packages/d9/JclUsesExpertDLL.RES b/official/1.96/packages/d9/JclUsesExpertDLL.RES new file mode 100644 index 0000000..e67c67f Binary files /dev/null and b/official/1.96/packages/d9/JclUsesExpertDLL.RES differ diff --git a/official/1.96/packages/d9/JclUsesExpertDLL.bdsproj b/official/1.96/packages/d9/JclUsesExpertDLL.bdsproj new file mode 100644 index 0000000..953f586 --- /dev/null +++ b/official/1.96/packages/d9/JclUsesExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclUsesExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58060000 + JCL Uses Wizard + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Uses Wizard + 1.97.1.2172 + JclUsesExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclUsesExpertDLL90.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclUsesExpertDLL.dof b/official/1.96/packages/d9/JclUsesExpertDLL.dof new file mode 100644 index 0000000..0fa3967 --- /dev/null +++ b/official/1.96/packages/d9/JclUsesExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d9/JclUsesExpertDLL.dpr b/official/1.96/packages/d9/JclUsesExpertDLL.dpr new file mode 100644 index 0000000..eb329bf --- /dev/null +++ b/official/1.96/packages/d9/JclUsesExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclUsesExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclUsesExpertDLL-L.xml) + + Last generated: 26-12-2005 13:23:40 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58060000} +{$DESCRIPTION 'JCL Uses Wizard'} +{$LIBSUFFIX '90'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + JCLUsesWizard in '..\..\experts\useswizard\JCLUsesWizard.pas' , + JCLOptionsFrame in '..\..\experts\useswizard\JCLOptionsFrame.pas' {FrameJclOptions: TFrame}, + JclUsesDialog in '..\..\experts\useswizard\JclUsesDialog.pas' {FormUsesConfirm}, + JclParseUses in '..\..\experts\useswizard\JclParseUses.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d9/JclUsesExpertDLL.rc b/official/1.96/packages/d9/JclUsesExpertDLL.rc new file mode 100644 index 0000000..9a7a9a6 --- /dev/null +++ b/official/1.96/packages/d9/JclUsesExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Uses Wizard\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclUsesExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclUsesExpertDLL90.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclVcl.RES b/official/1.96/packages/d9/JclVcl.RES new file mode 100644 index 0000000..3c2cbc3 Binary files /dev/null and b/official/1.96/packages/d9/JclVcl.RES differ diff --git a/official/1.96/packages/d9/JclVcl.bdsproj b/official/1.96/packages/d9/JclVcl.bdsproj new file mode 100644 index 0000000..9ba6d46 --- /dev/null +++ b/official/1.96/packages/d9/JclVcl.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclVcl.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $48200000 + JEDI Code Library VCL package + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;vcljpg;Jcl + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JEDI Code Library VCL package + 1.97.1.2172 + JclVcl + Copyright (C) 1999, 2005 Project JEDI + + JclVcl90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclVcl.dof b/official/1.96/packages/d9/JclVcl.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/JclVcl.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/JclVcl.dpk b/official/1.96/packages/d9/JclVcl.dpk new file mode 100644 index 0000000..e27a717 --- /dev/null +++ b/official/1.96/packages/d9/JclVcl.dpk @@ -0,0 +1,51 @@ +package JclVcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVcl-R.xml) + + Last generated: 24-10-2005 16:02:32 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48200000} +{$DESCRIPTION 'JEDI Code Library VCL package'} +{$LIBSUFFIX '90'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + vcljpg, + Jcl + ; + +contains + JclPrint in '..\..\source\vcl\JclPrint.pas' , + JclGraphUtils in '..\..\source\vcl\JclGraphUtils.pas' , + JclGraphics in '..\..\source\vcl\JclGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/d9/JclVcl.rc b/official/1.96/packages/d9/JclVcl.rc new file mode 100644 index 0000000..1d738c2 --- /dev/null +++ b/official/1.96/packages/d9/JclVcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VCL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVcl90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclVersionControlExpert.bdsproj b/official/1.96/packages/d9/JclVersionControlExpert.bdsproj new file mode 100644 index 0000000..7f0ef80 --- /dev/null +++ b/official/1.96/packages/d9/JclVersionControlExpert.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclVersionControlExpert.dpk + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58070000 + JCL Integration of version control systems in the IDE + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + False + 1053 + 1252 + + + Project JEDI + JCL Integration of version control systems in the IDE + 1.97.1.2172 + JclVersionControlExpert + Copyright (C) 1999, 2005 Project JEDI + + JclVersionControlExpert90.bpl + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclVersionControlExpert.dof b/official/1.96/packages/d9/JclVersionControlExpert.dof new file mode 100644 index 0000000..377d643 --- /dev/null +++ b/official/1.96/packages/d9/JclVersionControlExpert.dof @@ -0,0 +1,4 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common + diff --git a/official/1.96/packages/d9/JclVersionControlExpert.dpk b/official/1.96/packages/d9/JclVersionControlExpert.dpk new file mode 100644 index 0000000..ad7c550 --- /dev/null +++ b/official/1.96/packages/d9/JclVersionControlExpert.dpk @@ -0,0 +1,53 @@ +package JclVersionControlExpert; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpert-D.xml) + + Last generated: 15-01-2006 00:37:27 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX '90'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + Jcl, + JclBaseExpert + ; + +contains + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +end. diff --git a/official/1.96/packages/d9/JclVersionControlExpert.rc b/official/1.96/packages/d9/JclVersionControlExpert.rc new file mode 100644 index 0000000..e1083c0 --- /dev/null +++ b/official/1.96/packages/d9/JclVersionControlExpert.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpert\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpert90.bpl\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclVersionControlExpert.res b/official/1.96/packages/d9/JclVersionControlExpert.res new file mode 100644 index 0000000..d6121ca Binary files /dev/null and b/official/1.96/packages/d9/JclVersionControlExpert.res differ diff --git a/official/1.96/packages/d9/JclVersionControlExpertDLL.bdsproj b/official/1.96/packages/d9/JclVersionControlExpertDLL.bdsproj new file mode 100644 index 0000000..dd2c749 --- /dev/null +++ b/official/1.96/packages/d9/JclVersionControlExpertDLL.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + JclVersionControlExpertDLL.dpr + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + $58070000 + JCL Integration of version control systems in the IDE + + + + ..\..\lib\d9 + + + ..\..\common + rtl;vcl;designide;Jcl;JclBaseExpert + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + 1 + 97 + 1 + 2172 + False + False + False + False + True + 1053 + 1252 + + + Project JEDI + JCL Integration of version control systems in the IDE + 1.97.1.2172 + JclVersionControlExpertDLL + Copyright (C) 1999, 2005 Project JEDI + + JclVersionControlExpertDLL90.dll + Jedi Code Library + 1.97 Build 2172 + + + diff --git a/official/1.96/packages/d9/JclVersionControlExpertDLL.dof b/official/1.96/packages/d9/JclVersionControlExpertDLL.dof new file mode 100644 index 0000000..0fa3967 --- /dev/null +++ b/official/1.96/packages/d9/JclVersionControlExpertDLL.dof @@ -0,0 +1,8 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common +[Compiler] +PackageNoLink=1 +[Linker] +Packages=rtl;vcl;designide;Jcl;JclBaseExpert + diff --git a/official/1.96/packages/d9/JclVersionControlExpertDLL.dpr b/official/1.96/packages/d9/JclVersionControlExpertDLL.dpr new file mode 100644 index 0000000..7aefd59 --- /dev/null +++ b/official/1.96/packages/d9/JclVersionControlExpertDLL.dpr @@ -0,0 +1,48 @@ +Library JclVersionControlExpertDLL; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVersionControlExpertDLL-L.xml) + + Last generated: 15-01-2006 00:37:27 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $58070000} +{$DESCRIPTION 'JCL Integration of version control systems in the IDE'} +{$LIBSUFFIX '90'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, + VersionControlImpl in '..\..\experts\versioncontrol\VersionControlImpl.pas' , + JclVersionCtrlCommonOptions in '..\..\experts\versioncontrol\JclVersionCtrlCommonOptions.pas' {JclVersionCtrlOptionsFrame: TFrame}, + JclVersionCtrlCVSImpl in '..\..\experts\versioncontrol\JclVersionCtrlCVSImpl.pas' , + JclVersionCtrlSVNImpl in '..\..\experts\versioncontrol\JclVersionCtrlSVNImpl.pas' + ; + +exports + JCLWizardInit name WizardEntryPoint; + +end. diff --git a/official/1.96/packages/d9/JclVersionControlExpertDLL.rc b/official/1.96/packages/d9/JclVersionControlExpertDLL.rc new file mode 100644 index 0000000..e3b38eb --- /dev/null +++ b/official/1.96/packages/d9/JclVersionControlExpertDLL.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JCL Integration of version control systems in the IDE\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "JclVersionControlExpertDLL\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "JclVersionControlExpertDLL90.dll\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/d9/JclVersionControlExpertDLL.res b/official/1.96/packages/d9/JclVersionControlExpertDLL.res new file mode 100644 index 0000000..2f912d1 Binary files /dev/null and b/official/1.96/packages/d9/JclVersionControlExpertDLL.res differ diff --git a/official/1.96/packages/d9/Jedi.Jcl.bdsproj b/official/1.96/packages/d9/Jedi.Jcl.bdsproj new file mode 100644 index 0000000..192056b --- /dev/null +++ b/official/1.96/packages/d9/Jedi.Jcl.bdsproj @@ -0,0 +1,206 @@ + + + + + + + + + + + + Jedi.Jcl.dpr + + + 7.0 + + + 0 + 0 + 1 + 1 + 0 + 0 + 1 + 1 + 1 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + 0 + 0 + 0 + 0 + 0 + 1 + 0 + 1 + 1 + 1 + True + True + WinTypes=Borland.Vcl.Windows;WinProcs=Borland.Vcl.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + + False + Jedi.Jcl + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + True + False + False + 4096 + 1048576 + 4194304 + + + + ..\..\bin + ..\..\lib\d9 + + + ..\..\source + + + + True + + + + + + False + + + + + + False + + + + $00000000 + + + + False + False + 1 + 96 + 1 + 2070 + False + False + False + False + False + 1031 + 1252 + + + + + 1.96.1.2070 + + + + + + 1.96.1.2070 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/d9/Jedi.Jcl.dpr b/official/1.96/packages/d9/Jedi.Jcl.dpr new file mode 100644 index 0000000..c55f7f0 --- /dev/null +++ b/official/1.96/packages/d9/Jedi.Jcl.dpr @@ -0,0 +1,101 @@ +library Jedi.Jcl; + +uses + System.Reflection, + System.Runtime.InteropServices, + JclAbstractContainers in '..\..\source\common\JclAbstractContainers.pas', + JclAlgorithms in '..\..\source\common\JclAlgorithms.pas', + JclAnsiStrings in '..\..\source\common\JclAnsiStrings.pas', + JclArrayLists in '..\..\source\common\JclArrayLists.pas', + JclArraySets in '..\..\source\common\JclArraySets.pas', + JclBase in '..\..\source\common\JclBase.pas', + JclBinaryTrees in '..\..\source\common\JclBinaryTrees.pas', + JclComplex in '..\..\source\common\JclComplex.pas', + JclContainerIntf in '..\..\source\common\JclContainerIntf.pas', + JclDateTime in '..\..\source\common\JclDateTime.pas', + JclFileUtils in '..\..\source\common\JclFileUtils.pas', + JclHashSets in '..\..\source\common\JclHashSets.pas', + JclIniFiles in '..\..\source\common\JclIniFiles.pas', + JclLinkedLists in '..\..\source\common\JclLinkedLists.pas', + JclLogic in '..\..\source\common\JclLogic.pas', + JclMath in '..\..\source\common\JclMath.pas', + JclMime in '..\..\source\common\JclMime.pas', + JclQueues in '..\..\source\common\JclQueues.pas', + JclResources in '..\..\source\common\JclResources.pas', + JclRTTI in '..\..\source\common\JclRTTI.pas', + JclStacks in '..\..\source\common\JclStacks.pas', + JclStatistics in '..\..\source\common\JclStatistics.pas', + JclStrings in '..\..\source\common\JclStrings.pas', + JclSysInfo in '..\..\source\common\JclSysInfo.pas', + JclSysUtils in '..\..\source\common\JclSysUtils.pas', + JclUnitConv in '..\..\source\common\JclUnitConv.pas', + JclValidation in '..\..\source\common\JclValidation.pas', + JclVectors in '..\..\source\common\JclVectors.pas', + JclHashMaps in '..\..\source\common\JclHashMaps.pas'; + +[assembly: AssemblyTitle('JEDI Code Library')] +[assembly: AssemblyDescription('Functions and classes')] +[assembly: AssemblyConfiguration('')] +[assembly: AssemblyCompany('')] +[assembly: AssemblyProduct('JCL')] +[assembly: AssemblyCopyright('')] +[assembly: AssemblyTrademark('')] +[assembly: AssemblyCulture('')] + +// +// Die Versionsinformation einer Assemblierung enthält die folgenden vier Werte: +// +// Hauptversion +// Nebenversion +// Build-Nummer +// Revision +// +// Sie können alle vier Werte festlegen oder für Revision und Build-Nummer die +// Standardwerte mit '*' - wie nachfolgend gezeigt - verwenden: + +[assembly: AssemblyVersion('1.0.*')] + +// +// Zum Signieren einer Assemblierung müssen Sie einen Schlüssel angeben. Weitere Informationen +// über das Signieren von Assemblierungen finden Sie in der Microsoft .NET Framework-Dokumentation. +// +// Mit den folgenden Attributen steuern Sie, welcher Schlüssel für die Signatur verwendet wird. + +// Hinweise: +// (*) Wenn kein Schlüssel angegeben wird, ist die Assemblierung nicht signiert. +// (*) KeyName verweist auf einen Schlüssel, der im Crypto Service Provider +// (CSP) auf Ihrem Rechner installiert wurde. KeyFile verweist auf eine +// Datei, die einen Schlüssel enthält. +// (*) Wenn sowohl der KeyFile- als auch der KeyName-Wert angegeben ist, wird +// die folgende Verarbeitung durchgeführt: +// (1) Wenn KeyName in dem CSP gefunden wird, wird dieser Schlüssel verwendet. +// (2) Wenn KeyName nicht, aber KeyFile vorhanden ist, wird der Schlüssel +// in KeyFile im CSP installiert und verwendet. +// (*) Ein KeyFile können Sie mit dem Utility sn.exe (Starker Name) erzeugen. +// Der Speicherort von KeyFile sollte relativ zum Projektausgabeverzeichnis +// angegeben werden. Wenn sich Ihr KeyFile im Projektverzeichnis befindet, +// würden Sie das Attribut AssemblyKeyFile folgendermaßen festlegen: +// [assembly: AssemblyKeyFile('mykey.snk')], vorausgesetzt, Ihr +// Ausgabeverzeichnis ist das Projektverzeichnis (Vorgabe). +// (*) Verzögerte Signatur ist eine erweiterte Option; nähere Informationen +// dazu finden Sie in der Microsoft .NET Framework-Dokumentation. +// +[assembly: AssemblyDelaySign(false)] +[assembly: AssemblyKeyFile('')] +[assembly: AssemblyKeyName('')] + +// +// Verwenden Sie die folgenden Attribute zur Steuerung der COM-Sichtbarkeit Ihrer Assemblierung. +// Standardmäßig ist die gesamte Assemblierung für COM sichtbar. Die Einstellung false für ComVisible +// ist die für Ihre Assemblierung empfohlene Vorgabe. Um dann eine Klasse und ein Interface für COM +// bereitzustellen, setzen Sie jeweils ComVisible auf true. Es wird auch empfohlen das Attribut +// Guid hinzuzufügen. +// + +[assembly: ComVisible(False)] +//[assembly: Guid('')] +//[assembly: TypeLibVersion(1, 0)] + + +begin +end. diff --git a/official/1.96/packages/d9/template.bdsproj b/official/1.96/packages/d9/template.bdsproj new file mode 100644 index 0000000..2f654ba --- /dev/null +++ b/official/1.96/packages/d9/template.bdsproj @@ -0,0 +1,174 @@ + + + + + + + + + + + + %NAME%%SOURCEEXTENSION% + + + 7.0 + + + 8 + 0 + 0 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 0 + 0 + 0 + 1 + 1 + 1 + 0 + 1 + 0 + 0 + 0 + 1 + 0 + 1 + 0 + 1 + True + True + + + False + + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + True + + + 0 + 0 + 1 + False + False + False + 16384 + 1048576 + %IMAGE_BASE% + %DESCRIPTION% + + + + ..\..\lib\d9 + + + ..\..\common + %NOLINKPACKAGELIST% + + + False + + + + + + False + + + + + + False + + + + $00000000 + + + + True + False + %VERSION_MAJOR_NUMBER% + %VERSION_MINOR_NUMBER% + %RELEASE_NUMBER% + %BUILD_NUMBER% + False + False + False + False + %ISDLL% + 1053 + 1252 + + + Project JEDI + %DESCRIPTION% + %VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER% + %NAME% + Copyright (C) 1999, 2005 Project JEDI + + %NAME%90%BINEXTENSION% + Jedi Code Library + %VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER% + + + diff --git a/official/1.96/packages/d9/template.dof b/official/1.96/packages/d9/template.dof new file mode 100644 index 0000000..631a3aa --- /dev/null +++ b/official/1.96/packages/d9/template.dof @@ -0,0 +1,10 @@ +[Directories] +UnitOutputDir=..\..\lib\d9 +SearchPath=..\..\source;..\..\experts\common +<%%% BEGIN LIBRARYONLY %%%> +[Compiler] +PackageNoLink=1 +[Linker] +Packages=%NOLINKPACKAGELIST% +<%%% END LIBRARYONLY %%%> + diff --git a/official/1.96/packages/d9/template.dpk b/official/1.96/packages/d9/template.dpk new file mode 100644 index 0000000..3fec35e --- /dev/null +++ b/official/1.96/packages/d9/template.dpk @@ -0,0 +1,56 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PROGRAMONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PROGRAMONLY %%%> +<%%% BEGIN LIBRARYONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END LIBRARYONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '90'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. diff --git a/official/1.96/packages/d9/template.dpr b/official/1.96/packages/d9/template.dpr new file mode 100644 index 0000000..191bc1b --- /dev/null +++ b/official/1.96/packages/d9/template.dpr @@ -0,0 +1,58 @@ +%PROJECT% %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} +<%%% BEGIN PACKAGEONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END PACKAGEONLY %%%> +<%%% BEGIN RUNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END RUNONLY %%%> +<%%% BEGIN DESIGNONLY %%%> +<%%% DO NOT GENERATE %%%> +<%%% END DESIGNONLY %%%> + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '90'} +{$IMPLICITBUILD OFF} + +uses + ToolsAPI, +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +<%%% BEGIN LIBRARYONLY %%%> +exports + JCLWizardInit name WizardEntryPoint; +<%%% END LIBRARYONLY %%%> + +end. diff --git a/official/1.96/packages/d9/template.rc b/official/1.96/packages/d9/template.rc new file mode 100644 index 0000000..0a2bcb7 --- /dev/null +++ b/official/1.96/packages/d9/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "%NAME%90%BINEXTENSION%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/dirinfo.txt b/official/1.96/packages/dirinfo.txt new file mode 100644 index 0000000..cdb04d3 --- /dev/null +++ b/official/1.96/packages/dirinfo.txt @@ -0,0 +1,12 @@ +JCL package directory; version-specific packages are located in the respective subdirectories. + +Files located in jcl/packages: + +JclPackagesCxy.bpg: Borland project group file for C++Builder version x.y packages +JclPackagesDxy.bpg: Borland project group file for Delphi version x.y packages +BCB.bmk: bpr2mak Borland Make template file for C++Builder/Win32 +bcb.gmk: bpr2mak GNU Make template file for Kylix/C++ + +Files not intended for end users: + +JclDevPackagesDnn.bpg: Borland project group file for Delphi version nn development packages diff --git a/official/1.96/packages/k3.dev/JclVClx.bpf b/official/1.96/packages/k3.dev/JclVClx.bpf new file mode 100644 index 0000000..735e95e --- /dev/null +++ b/official/1.96/packages/k3.dev/JclVClx.bpf @@ -0,0 +1,5 @@ +This file is used by the project manager only and should be treated like the project file + +To add a file to this project use the Project menu 'Add to Project' + +PackageProject diff --git a/official/1.96/packages/k3.dev/JclVClx.bpk b/official/1.96/packages/k3.dev/JclVClx.bpk new file mode 100644 index 0000000..9dd6384 --- /dev/null +++ b/official/1.96/packages/k3.dev/JclVClx.bpk @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Debugging] +DebugSourceDirs= + +[Parameters] +RunParams= +Launcher=/usr/X11R6/bin/xterm -T KylixDebuggerOutput -e bash -i -c %debuggee% +UseLauncher=0 +DebugCWD= +HostApplication= + +[Compiler] +ShowInfoMsgs=0 +LinkDebugVcl=0 + +[Linker] +LibPrefix= +LibPrefixDefined=0 +LibSuffix=69 +LibVersion=1.97.0 + + diff --git a/official/1.96/packages/k3.dev/JclVClx.dpk b/official/1.96/packages/k3.dev/JclVClx.dpk new file mode 100644 index 0000000..0a26533 --- /dev/null +++ b/official/1.96/packages/k3.dev/JclVClx.dpk @@ -0,0 +1,50 @@ +package JclVClx; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml) + + Last generated: 05-02-2006 14:01:49 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48300000} +{$DESCRIPTION 'JEDI Code Library VisualCLX package'} +{$LIBSUFFIX '69'} +{$LIBVERSION '1.97.0'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + visualclx, + Jcl + ; + +contains + JclQGraphUtils in '../../source/prototypes/JclQGraphUtils.pas' , + JclQGraphics in '../../source/prototypes/JclQGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/k3.dev/JclVClx.kof b/official/1.96/packages/k3.dev/JclVClx.kof new file mode 100644 index 0000000..5728b5a --- /dev/null +++ b/official/1.96/packages/k3.dev/JclVClx.kof @@ -0,0 +1,3 @@ +[Directories] +UnitOutputDir=../../lib/k3 +SearchPath=../../source:../../source/common:../../source/visclx diff --git a/official/1.96/packages/k3.dev/JclVClx.rc b/official/1.96/packages/k3.dev/JclVClx.rc new file mode 100644 index 0000000..a95f8c3 --- /dev/null +++ b/official/1.96/packages/k3.dev/JclVClx.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,0,2172 +PRODUCTVERSION 1,97,0,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VisualCLX package\0" + VALUE "FileVersion", "1.97.0.2172\0" + VALUE "InternalName", "JclVClx\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "bplJclVClx69.so.1.97.0\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/k3.dev/dirinfo.txt b/official/1.96/packages/k3.dev/dirinfo.txt new file mode 100644 index 0000000..a018cb9 --- /dev/null +++ b/official/1.96/packages/k3.dev/dirinfo.txt @@ -0,0 +1,4 @@ +This is where JCL development packages for Kylix 3 reside. + +Those packages are used instead of the standard packages of the same name for +prototype unit testing and not intended for release. diff --git a/official/1.96/packages/k3.dev/template.bpf b/official/1.96/packages/k3.dev/template.bpf new file mode 100644 index 0000000..4253811 --- /dev/null +++ b/official/1.96/packages/k3.dev/template.bpf @@ -0,0 +1,5 @@ +This file is used by the project manager only and should be treated like the project file + +To add a file to this project use the Project menu 'Add to Project' + +PackageProject \ No newline at end of file diff --git a/official/1.96/packages/k3.dev/template.bpk b/official/1.96/packages/k3.dev/template.bpk new file mode 100644 index 0000000..310ebd1 --- /dev/null +++ b/official/1.96/packages/k3.dev/template.bpk @@ -0,0 +1,98 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +<%%% START FILES %%%> + +<%%% END FILES %%%> +<%%% START REQUIRES %%%> + +<%%% END REQUIRES %%%> +<%%% START LIBS %%%> + +<%%% END LIBS %%%> + + + + + +[Debugging] +DebugSourceDirs= + +[Parameters] +RunParams= +Launcher=/usr/X11R6/bin/xterm -T KylixDebuggerOutput -e bash -i -c %debuggee% +UseLauncher=0 +DebugCWD= +HostApplication= + +[Compiler] +ShowInfoMsgs=0 +LinkDebugVcl=0 + +[Linker] +LibPrefix= +LibPrefixDefined=0 +LibSuffix=69 +LibVersion=%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER% + + \ No newline at end of file diff --git a/official/1.96/packages/k3.dev/template.dpk b/official/1.96/packages/k3.dev/template.dpk new file mode 100644 index 0000000..5f36bd6 --- /dev/null +++ b/official/1.96/packages/k3.dev/template.dpk @@ -0,0 +1,51 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '69'} +{$LIBVERSION '%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. diff --git a/official/1.96/packages/k3.dev/template.rc b/official/1.96/packages/k3.dev/template.rc new file mode 100644 index 0000000..d561ba8 --- /dev/null +++ b/official/1.96/packages/k3.dev/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "bpl%NAME%69.so.%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/k3/Jcl.bpf b/official/1.96/packages/k3/Jcl.bpf new file mode 100644 index 0000000..735e95e --- /dev/null +++ b/official/1.96/packages/k3/Jcl.bpf @@ -0,0 +1,5 @@ +This file is used by the project manager only and should be treated like the project file + +To add a file to this project use the Project menu 'Add to Project' + +PackageProject diff --git a/official/1.96/packages/k3/Jcl.bpk b/official/1.96/packages/k3/Jcl.bpk new file mode 100644 index 0000000..77a5fcd --- /dev/null +++ b/official/1.96/packages/k3/Jcl.bpk @@ -0,0 +1,178 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Debugging] +DebugSourceDirs= + +[Parameters] +RunParams= +Launcher=/usr/X11R6/bin/xterm -T KylixDebuggerOutput -e bash -i -c %debuggee% +UseLauncher=0 +DebugCWD= +HostApplication= + +[Compiler] +ShowInfoMsgs=0 +LinkDebugVcl=0 + +[Linker] +LibPrefix= +LibPrefixDefined=0 +LibSuffix=69 +LibVersion=1.97.1 + + diff --git a/official/1.96/packages/k3/Jcl.dpk b/official/1.96/packages/k3/Jcl.dpk new file mode 100644 index 0000000..10ad90f --- /dev/null +++ b/official/1.96/packages/k3/Jcl.dpk @@ -0,0 +1,95 @@ +package Jcl; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (Jcl-R.xml) + + Last generated: 05-02-2006 14:01:49 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48000000} +{$DESCRIPTION 'JEDI Code Library RTL package'} +{$LIBSUFFIX '69'} +{$LIBVERSION '1.97.1'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl + ; + +contains + Jcl8087 in '../../source/common/Jcl8087.pas' , + JclAbstractContainers in '../../source/common/JclAbstractContainers.pas' , + JclAlgorithms in '../../source/common/JclAlgorithms.pas' , + JclArrayLists in '../../source/common/JclArrayLists.pas' , + JclArraySets in '../../source/common/JclArraySets.pas' , + JclBase in '../../source/common/JclBase.pas' , + JclBinaryTrees in '../../source/common/JclBinaryTrees.pas' , + JclBorlandTools in '../../source/common/JclBorlandTools.pas' , + JclComplex in '../../source/common/JclComplex.pas' , + JclCompression in '../../source/common/JclCompression.pas' , + JclContainerIntf in '../../source/common/JclContainerIntf.pas' , + JclCounter in '../../source/common/JclCounter.pas' , + JclDateTime in '../../source/common/JclDateTime.pas' , + JclEDI in '../../source/common/JclEDI.pas' , + JclEDISEF in '../../source/common/JclEDISEF.pas' , + JclEDITranslators in '../../source/common/JclEDITranslators.pas' , + JclEDIXML in '../../source/common/JclEDIXML.pas' , + JclEDI_ANSIX12 in '../../source/common/JclEDI_ANSIX12.pas' , + JclEDI_ANSIX12_Ext in '../../source/common/JclEDI_ANSIX12_Ext.pas' , + JclEDI_UNEDIFACT in '../../source/common/JclEDI_UNEDIFACT.pas' , + JclEDI_UNEDIFACT_Ext in '../../source/common/JclEDI_UNEDIFACT_Ext.pas' , + JclExprEval in '../../source/common/JclExprEval.pas' , + JclFileUtils in '../../source/common/JclFileUtils.pas' , + JclHashMaps in '../../source/common/JclHashMaps.pas' , + JclHashSets in '../../source/common/JclHashSets.pas' , + JclIniFiles in '../../source/common/JclIniFiles.pas' , + JclLinkedLists in '../../source/common/JclLinkedLists.pas' , + JclLogic in '../../source/common/JclLogic.pas' , + JclMath in '../../source/common/JclMath.pas' , + JclMIDI in '../../source/common/JclMIDI.pas' , + JclMime in '../../source/common/JclMime.pas' , + JclPCRE in '../../source/common/JclPCRE.pas' , + JclQueues in '../../source/common/JclQueues.pas' , + JclResources in '../../source/common/JclResources.pas' , + JclRTTI in '../../source/common/JclRTTI.pas' , + JclSchedule in '../../source/common/JclSchedule.pas' , + JclStacks in '../../source/common/JclStacks.pas' , + JclStatistics in '../../source/common/JclStatistics.pas' , + JclStrHashMap in '../../source/common/JclStrHashMap.pas' , + JclStrings in '../../source/common/JclStrings.pas' , + JclSysInfo in '../../source/common/JclSysInfo.pas' , + JclSysUtils in '../../source/common/JclSysUtils.pas' , + JclUnitConv in '../../source/common/JclUnitConv.pas' , + JclUnitVersioning in '../../source/common/JclUnitVersioning.pas' , + JclUnitVersioningProviders in '../../source/common/JclUnitVersioningProviders.pas' , + JclValidation in '../../source/common/JclValidation.pas' , + JclVectors in '../../source/common/JclVectors.pas' , + JclWideStrings in '../../source/common/JclWideStrings.pas' , + pcre in '../../source/common/pcre.pas' + ; + +end. diff --git a/official/1.96/packages/k3/Jcl.kof b/official/1.96/packages/k3/Jcl.kof new file mode 100644 index 0000000..5728b5a --- /dev/null +++ b/official/1.96/packages/k3/Jcl.kof @@ -0,0 +1,3 @@ +[Directories] +UnitOutputDir=../../lib/k3 +SearchPath=../../source:../../source/common:../../source/visclx diff --git a/official/1.96/packages/k3/Jcl.rc b/official/1.96/packages/k3/Jcl.rc new file mode 100644 index 0000000..c9b793a --- /dev/null +++ b/official/1.96/packages/k3/Jcl.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,1,2172 +PRODUCTVERSION 1,97,1,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library RTL package\0" + VALUE "FileVersion", "1.97.1.2172\0" + VALUE "InternalName", "Jcl\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "bplJcl69.so.1.97.1\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/k3/JclVClx.bpf b/official/1.96/packages/k3/JclVClx.bpf new file mode 100644 index 0000000..735e95e --- /dev/null +++ b/official/1.96/packages/k3/JclVClx.bpf @@ -0,0 +1,5 @@ +This file is used by the project manager only and should be treated like the project file + +To add a file to this project use the Project menu 'Add to Project' + +PackageProject diff --git a/official/1.96/packages/k3/JclVClx.bpk b/official/1.96/packages/k3/JclVClx.bpk new file mode 100644 index 0000000..971f2bb --- /dev/null +++ b/official/1.96/packages/k3/JclVClx.bpk @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +[Debugging] +DebugSourceDirs= + +[Parameters] +RunParams= +Launcher=/usr/X11R6/bin/xterm -T KylixDebuggerOutput -e bash -i -c %debuggee% +UseLauncher=0 +DebugCWD= +HostApplication= + +[Compiler] +ShowInfoMsgs=0 +LinkDebugVcl=0 + +[Linker] +LibPrefix= +LibPrefixDefined=0 +LibSuffix=69 +LibVersion=1.97.0 + + diff --git a/official/1.96/packages/k3/JclVClx.dpk b/official/1.96/packages/k3/JclVClx.dpk new file mode 100644 index 0000000..239bc3a --- /dev/null +++ b/official/1.96/packages/k3/JclVClx.dpk @@ -0,0 +1,50 @@ +package JclVClx; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (JclVClx-R.xml) + + Last generated: 05-02-2006 14:01:49 UTC +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $48300000} +{$DESCRIPTION 'JEDI Code Library VisualCLX package'} +{$LIBSUFFIX '69'} +{$LIBVERSION '1.97.0'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + visualclx, + Jcl + ; + +contains + JclQGraphUtils in '../../source/visclx/JclQGraphUtils.pas' , + JclQGraphics in '../../source/visclx/JclQGraphics.pas' + ; + +end. diff --git a/official/1.96/packages/k3/JclVClx.kof b/official/1.96/packages/k3/JclVClx.kof new file mode 100644 index 0000000..5728b5a --- /dev/null +++ b/official/1.96/packages/k3/JclVClx.kof @@ -0,0 +1,3 @@ +[Directories] +UnitOutputDir=../../lib/k3 +SearchPath=../../source:../../source/common:../../source/visclx diff --git a/official/1.96/packages/k3/JclVClx.rc b/official/1.96/packages/k3/JclVClx.rc new file mode 100644 index 0000000..a95f8c3 --- /dev/null +++ b/official/1.96/packages/k3/JclVClx.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION 1,97,0,2172 +PRODUCTVERSION 1,97,0,2172 + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "JEDI Code Library VisualCLX package\0" + VALUE "FileVersion", "1.97.0.2172\0" + VALUE "InternalName", "JclVClx\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "bplJclVClx69.so.1.97.0\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "1.97 Build 2172\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/k3/dirinfo.txt b/official/1.96/packages/k3/dirinfo.txt new file mode 100644 index 0000000..7993f46 --- /dev/null +++ b/official/1.96/packages/k3/dirinfo.txt @@ -0,0 +1 @@ +This directory is intended as a common place for Kylix 3 packages. \ No newline at end of file diff --git a/official/1.96/packages/k3/template.bpf b/official/1.96/packages/k3/template.bpf new file mode 100644 index 0000000..4253811 --- /dev/null +++ b/official/1.96/packages/k3/template.bpf @@ -0,0 +1,5 @@ +This file is used by the project manager only and should be treated like the project file + +To add a file to this project use the Project menu 'Add to Project' + +PackageProject \ No newline at end of file diff --git a/official/1.96/packages/k3/template.bpk b/official/1.96/packages/k3/template.bpk new file mode 100644 index 0000000..310ebd1 --- /dev/null +++ b/official/1.96/packages/k3/template.bpk @@ -0,0 +1,98 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +<%%% START FILES %%%> + +<%%% END FILES %%%> +<%%% START REQUIRES %%%> + +<%%% END REQUIRES %%%> +<%%% START LIBS %%%> + +<%%% END LIBS %%%> + + + + + +[Debugging] +DebugSourceDirs= + +[Parameters] +RunParams= +Launcher=/usr/X11R6/bin/xterm -T KylixDebuggerOutput -e bash -i -c %debuggee% +UseLauncher=0 +DebugCWD= +HostApplication= + +[Compiler] +ShowInfoMsgs=0 +LinkDebugVcl=0 + +[Linker] +LibPrefix= +LibPrefixDefined=0 +LibSuffix=69 +LibVersion=%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER% + + \ No newline at end of file diff --git a/official/1.96/packages/k3/template.dpk b/official/1.96/packages/k3/template.dpk new file mode 100644 index 0000000..5f36bd6 --- /dev/null +++ b/official/1.96/packages/k3/template.dpk @@ -0,0 +1,51 @@ +package %NAME%; +{ +----------------------------------------------------------------------------- + DO NOT EDIT THIS FILE, IT IS GENERATED BY THE PACKAGE GENERATOR + ALWAYS EDIT THE RELATED XML FILE (%XMLNAME%) + + Last generated: %DATETIME% +----------------------------------------------------------------------------- +} + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE %IMAGE_BASE%} +{$DESCRIPTION '%DESCRIPTION%'} +{$LIBSUFFIX '69'} +{$LIBVERSION '%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%'} +{$%TYPE%ONLY} +{$IMPLICITBUILD OFF} + +requires +<%%% START REQUIRES %%%> + %NAME%, +<%%% END REQUIRES %%%> + ; + +contains +<%%% START FILES %%%> + %UNITNAME% in '%FILENAME%' {%FORMNAMEANDTYPE%}, +<%%% END FILES %%%> + ; + +end. diff --git a/official/1.96/packages/k3/template.kof b/official/1.96/packages/k3/template.kof new file mode 100644 index 0000000..685d44e --- /dev/null +++ b/official/1.96/packages/k3/template.kof @@ -0,0 +1,3 @@ +[Directories] +UnitOutputDir=../../lib/k3 +SearchPath=../../source:../../source/common:../../source/visclx \ No newline at end of file diff --git a/official/1.96/packages/k3/template.rc b/official/1.96/packages/k3/template.rc new file mode 100644 index 0000000..d561ba8 --- /dev/null +++ b/official/1.96/packages/k3/template.rc @@ -0,0 +1,32 @@ +VS_VERSION_INFO VERSIONINFO +FILEVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% +PRODUCTVERSION %VERSION_MAJOR_NUMBER%,%VERSION_MINOR_NUMBER%,%RELEASE_NUMBER%,%BUILD_NUMBER% + FILEFLAGSMASK VS_FFI_FILEFLAGSMASK +#ifdef _DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_DLL + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904E4" + BEGIN + VALUE "CompanyName", "Project JEDI\0" + VALUE "FileDescription", "%DESCRIPTION%\0" + VALUE "FileVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%.%BUILD_NUMBER%\0" + VALUE "InternalName", "%NAME%\0" + VALUE "LegalCopyright", "Copyright (C) 1999, 2005 Project JEDI\0" + VALUE "OriginalFilename", "bpl%NAME%69.so.%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER%.%RELEASE_NUMBER%\0" + VALUE "ProductName", "Jedi Code Library\0" + VALUE "ProductVersion", "%VERSION_MAJOR_NUMBER%.%VERSION_MINOR_NUMBER% Build %BUILD_NUMBER%\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x0409, 1252 + END +END diff --git a/official/1.96/packages/resources.mak b/official/1.96/packages/resources.mak new file mode 100644 index 0000000..aa16624 --- /dev/null +++ b/official/1.96/packages/resources.mak @@ -0,0 +1,155 @@ +ROOTDIR = $(MAKEDIR)\.. + +# --------------------------------------------------------------------------- +RESFILES = c5\JclBaseExpertC50.res \ + c5\JclThreadNameExpertC50.res \ + c5\JclC50.res \ + c5\JclDebugExpertC50.res \ + c5\JclFavoriteFoldersExpertC50.res \ + c5\JclDebugExpertDLLC50.res \ + c5\JclFavoriteFoldersExpertDLLC50.res \ + c5\JclProjectAnalysisExpertC50.res \ + c5\JclProjectAnalysisExpertDLLC50.res \ + c5\JclSIMDViewExpertC50.res \ + c5\JclThreadNameExpertDLLC50.res \ + c5\JclSIMDViewExpertDLLC50.res \ + c5\JclUsesExpertC50.res \ + c5\JclUsesExpertDLLC50.res \ + c5\JclVersionControlExpertC50.res \ + c5\JclVersionControlExpertDLLC50.res \ + c6\Jcl.res \ + c6\JclBaseExpert.res \ + c6\JclDebugExpert.res \ + c6\JclDebugExpertDLL.res \ + c6\JclFavoriteFoldersExpert.res \ + c6\JclFavoriteFoldersExpertDLL.res \ + c6\JclProjectAnalysisExpert.res \ + c6\JclProjectAnalysisExpertDLL.res \ + c6\JclSIMDViewExpert.res \ + c6\JclThreadNameExpertDLL.res \ + c6\JclSIMDViewExpertDLL.res \ + c6\JclUsesExpert.res \ + c6\JclThreadNameExpert.res \ + c6\JclUsesExpertDLL.res \ + c6\JclVersionControlExpert.res \ + c6\JclVClx.res \ + c6\JclVcl.res \ + c6\JclVersionControlExpertDLL.res \ + cs1\Jcl.res \ + cs1\JclBaseExpert.res \ + cs1\JclFavoriteFoldersExpertDLL.res \ + cs1\JclVersionControlExpertDLL.res \ + d10\JclUsesExpert.res \ + d10\Jcl.res \ + d10\JclBaseExpert.res \ + d10\JclDebugExpert.res \ + d10\JclDebugExpertDLL.res \ + d10\JclFavoriteFoldersExpert.res \ + d10\JclProjectAnalysisExpert.res \ + d10\JclFavoriteFoldersExpertDLL.res \ + d10\JclProjectAnalysisExpertDLL.res \ + d10\JclSIMDViewExpert.res \ + d10\JclUsesExpertDLL.res \ + d10\JclSIMDViewExpertDLL.res \ + d10\JclVcl.res \ + d10\JclThreadNameExpert.res \ + d10\JclThreadNameExpertDLL.res \ + d10\JclVersionControlExpert.res \ + d10\JclVersionControlExpertDLL.res \ + d5\JclUsesExpertDLLD50.res \ + d5\JclBaseExpertD50.res \ + d5\JclD50.res \ + d5\JclDebugExpertD50.res \ + d5\JclProjectAnalysisExpertDLLD50.res \ + d5\JclDebugExpertDLLD50.res \ + d5\JclFavoriteFoldersExpertD50.res \ + d5\JclFavoriteFoldersExpertDLLD50.res \ + d5\JclProjectAnalysisExpertD50.res \ + d5\JclSIMDViewExpertD50.res \ + d5\JclSIMDViewExpertDLLD50.res \ + d5\JclThreadNameExpertD50.res \ + d5\JclThreadNameExpertDLLD50.res \ + d5\JclUsesExpertD50.res \ + d5\JclVersionControlExpertD50.res \ + d5\JclVersionControlExpertDLLD50.res \ + d5.dev\JclD50.res \ + d6\Jcl.res \ + d6\JclBaseExpert.res \ + d6\JclDebugExpert.res \ + d6\JclDebugExpertDLL.res \ + d6\JclFavoriteFoldersExpert.res \ + d6\JclFavoriteFoldersExpertDLL.res \ + d6\JclProjectAnalysisExpert.res \ + d6\JclProjectAnalysisExpertDLL.res \ + d6\JclSIMDViewExpert.res \ + d6\JclVcl.res \ + d6\JclSIMDViewExpertDLL.res \ + d6\JclThreadNameExpert.res \ + d6\JclThreadNameExpertDLL.res \ + d6\JclUsesExpert.res \ + d6\JclUsesExpertDLL.res \ + d6\JclVClx.res \ + d6\JclVersionControlExpert.res \ + d6\JclVersionControlExpertDLL.res \ + d6.dev\JclVcl.res \ + d7\Jcl.res \ + d7\JclBaseExpert.res \ + d7\JclDebugExpert.res \ + d7\JclDebugExpertDLL.res \ + d7\JclFavoriteFoldersExpert.res \ + d7\JclFavoriteFoldersExpertDLL.res \ + d7\JclProjectAnalysisExpert.res \ + d7\JclProjectAnalysisExpertDLL.res \ + d7\JclSIMDViewExpert.res \ + d7\JclVcl.res \ + d7\JclSIMDViewExpertDLL.res \ + d7\JclThreadNameExpert.res \ + d7\JclThreadNameExpertDLL.res \ + d7\JclUsesExpert.res \ + d7\JclUsesExpertDLL.res \ + d7\JclVClx.res \ + d7\JclVersionControlExpert.res \ + d7\JclVersionControlExpertDLL.res \ + d7.dev\JclVClx.res \ + d7.dev\JclVcl.res \ + d8\Jcl.res \ + d8\JclBaseExpert.res \ + d8\JclFavoriteFoldersExpertDLL.res \ + d8\JclVersionControlExpertDLL.res \ + d9\JclThreadNameExpertDLL.res \ + d9\Jcl.res \ + d9\JclBaseExpert.res \ + d9\JclDebugExpert.res \ + d9\JclDebugExpertDLL.res \ + d9\JclFavoriteFoldersExpert.res \ + d9\JclFavoriteFoldersExpertDLL.res \ + d9\JclProjectAnalysisExpert.res \ + d9\JclProjectAnalysisExpertDLL.res \ + d9\JclSIMDViewExpert.res \ + d9\JclUsesExpert.res \ + d9\JclSIMDViewExpertDLL.res \ + d9\JclUsesExpertDLL.res \ + d9\JclThreadNameExpert.res \ + d9\JclVcl.res \ + d9\JclVersionControlExpert.res \ + d9\JclVersionControlExpertDLL.res +# --------------------------------------------------------------------------- +!if !$d(BRCC32) +BRCC32 = brcc32 +!endif +# --------------------------------------------------------------------------- +!if $d(PATHRC) +.PATH.res = $(PATHRC) +!endif +# --------------------------------------------------------------------------- +resources.res: $(RESFILES) + +# --------------------------------------------------------------------------- +.rc.res: + &"$(ROOTDIR)\BIN\$(BRCC32)" -fo$@ $< + +# --------------------------------------------------------------------------- + + + + diff --git a/official/1.96/packages/xml/Jcl-R.xml b/official/1.96/packages/xml/Jcl-R.xml new file mode 100644 index 0000000..265fdd1 --- /dev/null +++ b/official/1.96/packages/xml/Jcl-R.xml @@ -0,0 +1,107 @@ + + + JEDI Code Library RTL package + + -LUvcl50 + + + + $48000000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclBaseExpert-D.xml b/official/1.96/packages/xml/JclBaseExpert-D.xml new file mode 100644 index 0000000..d31123e --- /dev/null +++ b/official/1.96/packages/xml/JclBaseExpert-D.xml @@ -0,0 +1,31 @@ + + + JCL Package containing common units for JCL Experts + + -LUvcl50 -LUdsnide50 -LUJclC50 + -LUdesignide + + + $58000000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclDebugExpert-D.xml b/official/1.96/packages/xml/JclDebugExpert-D.xml new file mode 100644 index 0000000..01c5286 --- /dev/null +++ b/official/1.96/packages/xml/JclDebugExpert-D.xml @@ -0,0 +1,28 @@ + + + JCL Debug IDE extension + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58010000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclDebugExpertDLL-L.xml b/official/1.96/packages/xml/JclDebugExpertDLL-L.xml new file mode 100644 index 0000000..1995c47 --- /dev/null +++ b/official/1.96/packages/xml/JclDebugExpertDLL-L.xml @@ -0,0 +1,28 @@ + + + JCL Debug IDE extension + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58010000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclFavoriteFoldersExpert-D.xml b/official/1.96/packages/xml/JclFavoriteFoldersExpert-D.xml new file mode 100644 index 0000000..33950f6 --- /dev/null +++ b/official/1.96/packages/xml/JclFavoriteFoldersExpert-D.xml @@ -0,0 +1,28 @@ + + + JCL Open and Save IDE dialogs with favorite folders + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58020000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclFavoriteFoldersExpertDLL-L.xml b/official/1.96/packages/xml/JclFavoriteFoldersExpertDLL-L.xml new file mode 100644 index 0000000..218e8c7 --- /dev/null +++ b/official/1.96/packages/xml/JclFavoriteFoldersExpertDLL-L.xml @@ -0,0 +1,28 @@ + + + JCL Open and Save IDE dialogs with favorite folders + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58020000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclProjectAnalysisExpert-D.xml b/official/1.96/packages/xml/JclProjectAnalysisExpert-D.xml new file mode 100644 index 0000000..d4f844e --- /dev/null +++ b/official/1.96/packages/xml/JclProjectAnalysisExpert-D.xml @@ -0,0 +1,28 @@ + + + JCL Project Analyzer + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58030000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclProjectAnalysisExpertDLL-L.xml b/official/1.96/packages/xml/JclProjectAnalysisExpertDLL-L.xml new file mode 100644 index 0000000..6bcaff1 --- /dev/null +++ b/official/1.96/packages/xml/JclProjectAnalysisExpertDLL-L.xml @@ -0,0 +1,28 @@ + + + JCL Project Analyzer + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58030000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclSIMDViewExpert-D.xml b/official/1.96/packages/xml/JclSIMDViewExpert-D.xml new file mode 100644 index 0000000..54e655d --- /dev/null +++ b/official/1.96/packages/xml/JclSIMDViewExpert-D.xml @@ -0,0 +1,31 @@ + + + JCL Debug Window of XMM registers + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58040000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclSIMDViewExpertDLL-L.xml b/official/1.96/packages/xml/JclSIMDViewExpertDLL-L.xml new file mode 100644 index 0000000..9f73c68 --- /dev/null +++ b/official/1.96/packages/xml/JclSIMDViewExpertDLL-L.xml @@ -0,0 +1,31 @@ + + + JCL Debug Window of XMM registers + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58040000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclThreadNameExpert-D.xml b/official/1.96/packages/xml/JclThreadNameExpert-D.xml new file mode 100644 index 0000000..1a503c3 --- /dev/null +++ b/official/1.96/packages/xml/JclThreadNameExpert-D.xml @@ -0,0 +1,28 @@ + + + JCL Thread Name IDE expert + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58050000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclThreadNameExpertDLL-L.xml b/official/1.96/packages/xml/JclThreadNameExpertDLL-L.xml new file mode 100644 index 0000000..f1e1a57 --- /dev/null +++ b/official/1.96/packages/xml/JclThreadNameExpertDLL-L.xml @@ -0,0 +1,28 @@ + + + JCL Thread Name IDE expert + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58050000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclUsesExpert-D.xml b/official/1.96/packages/xml/JclUsesExpert-D.xml new file mode 100644 index 0000000..e3c3c1b --- /dev/null +++ b/official/1.96/packages/xml/JclUsesExpert-D.xml @@ -0,0 +1,30 @@ + + + JCL Uses Wizard + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58060000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclUsesExpertDLL-L.xml b/official/1.96/packages/xml/JclUsesExpertDLL-L.xml new file mode 100644 index 0000000..2302c27 --- /dev/null +++ b/official/1.96/packages/xml/JclUsesExpertDLL-L.xml @@ -0,0 +1,30 @@ + + + JCL Uses Wizard + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58060000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclVClx-R.xml b/official/1.96/packages/xml/JclVClx-R.xml new file mode 100644 index 0000000..ef6a743 --- /dev/null +++ b/official/1.96/packages/xml/JclVClx-R.xml @@ -0,0 +1,25 @@ + + + JEDI Code Library VisualCLX package + + + + + + $48300000 + 1 + 97 + 0 + 2172 + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclVcl-R.xml b/official/1.96/packages/xml/JclVcl-R.xml new file mode 100644 index 0000000..5a4b200 --- /dev/null +++ b/official/1.96/packages/xml/JclVcl-R.xml @@ -0,0 +1,29 @@ + + + JEDI Code Library VCL package + + + + + + $48200000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclVersionControlExpert-D.xml b/official/1.96/packages/xml/JclVersionControlExpert-D.xml new file mode 100644 index 0000000..522dc4e --- /dev/null +++ b/official/1.96/packages/xml/JclVersionControlExpert-D.xml @@ -0,0 +1,30 @@ + + + JCL Integration of version control systems in the IDE + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58070000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + + + diff --git a/official/1.96/packages/xml/JclVersionControlExpertDLL-L.xml b/official/1.96/packages/xml/JclVersionControlExpertDLL-L.xml new file mode 100644 index 0000000..b549576 --- /dev/null +++ b/official/1.96/packages/xml/JclVersionControlExpertDLL-L.xml @@ -0,0 +1,30 @@ + + + JCL Integration of version control systems in the IDE + + -LUvcl50 -LUdsnide50 -LUJclC50 -LUJclBaseExpertC50 + -LUdesignide + + + $58070000 + 1 + 97 + 1 + 2172 + + + + + + + + + + + + + + + + + diff --git a/official/1.96/source/Makefile.fpc b/official/1.96/source/Makefile.fpc new file mode 100644 index 0000000..ff8bbda --- /dev/null +++ b/official/1.96/source/Makefile.fpc @@ -0,0 +1,13 @@ +FpcRtl = $(fpc)\rtl +Fcl = $(fpc)\fcl +FpcOut = ..\lib\fpc # for now... + +PPCOptions = -Mdelphi -FE$(FpcOut) -Fu$(FpcOut);$(Fcl)\inc;common;windows;..\..\Win32API + +PPC = ppc386 $(PPCOptions) + +target: + @echo Compiling $(file)... + @if not exist $(FpcOut) mkdir $(FpcOut) + @$(PPC) $(PPCOptions) $(file) >> fpctest.err + diff --git a/official/1.96/source/common/Jcl8087.pas b/official/1.96/source/common/Jcl8087.pas new file mode 100644 index 0000000..f88c5ca --- /dev/null +++ b/official/1.96/source/common/Jcl8087.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 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: 2005/02/24 16:34:39 $ +// For history see end of file + +unit Jcl8087; + +{$I jcl.inc} + +interface + +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; + +implementation + +const + X87ExceptBits = $3F; + +function Get8087ControlWord: Word; assembler; +asm + {$IFDEF FPC} + SUB ESP, $2 + {$ELSE} + SUB ESP, TYPE WORD + {$ENDIF FPC} + FSTCW [ESP] + FWAIT + POP AX +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; + +function Get8087StatusWord(ClearExceptions: Boolean): Word; assembler; +asm + TEST AX, AX // if ClearExceptions then + JE @@NoClearExceptions + FSTSW AX // get status word (clears exceptions) + RET +@@NoClearExceptions: // else + FNSTSW AX // get status word (without clearing exceptions) +end; + +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; assembler; +asm + FNCLEX + {$IFDEF FPC} + SUB ESP, $2 + {$ELSE} + SUB ESP, TYPE WORD + {$ENDIF FPC} + FSTCW [ESP] + XCHG [ESP], AX + FLDCW [ESP] + {$IFDEF FPC} + ADD ESP, $2 + {$ELSE} + ADD ESP, TYPE WORD + {$ENDIF FPC} +end; + +function ClearPending8087Exceptions: T8087Exceptions; +asm + FNSTSW AX + AND AX, X87ExceptBits + FNCLEX +end; + +function GetPending8087Exceptions: T8087Exceptions; +asm + FNSTSW AX + AND AX, X87ExceptBits +end; + +function GetMasked8087Exceptions: T8087Exceptions; +asm + {$IFDEF FPC} + SUB ESP, $2 + {$ELSE} + SUB ESP, TYPE WORD + {$ENDIF FPC} + FSTCW [ESP] + FWAIT + POP AX + AND AX, X87ExceptBits +end; + +function SetMasked8087Exceptions(Exceptions: T8087Exceptions; ClearBefore: Boolean): T8087Exceptions; +asm + TEST DL, DL // if ClearBefore then + JZ @1 + FNCLEX // clear pending exceptions +@1: + {$IFDEF FPC} + SUB ESP, $2 + {$ELSE} + SUB ESP, TYPE WORD + {$ENDIF FPC} + FSTCW [ESP] + FWAIT + AND AX, X87ExceptBits // mask exception mask bits 0..5 + MOV DX, [ESP] + AND WORD PTR [ESP], NOT X87ExceptBits + OR [ESP], AX + FLDCW [ESP] + {$IFDEF FPC} + ADD ESP, $2 + {$ELSE} + ADD ESP, TYPE WORD + {$ENDIF FPC} + MOV AX, DX + AND AX, X87ExceptBits +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; + +// History: + +// rr 2003-10-12: +// Removed references to Default8087CW because of compiler problems when including Jcl8087 in +// package (D7, I remember having seen that with D5, too; Kylix 3 however went smoothly). Error +// message was, in spite of {$IMPORTEDDATA ON}: +// "Need imported data reference ($G) to access Default8087CW". + +// $Log: Jcl8087.pas,v $ +// Revision 1.7 2005/02/24 16:34:39 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.6 2004/10/17 20:02:05 mthoma +// Clean. Fileheader update (contributors list). +// +// Revision 1.5 2004/06/14 06:24:52 marquardt +// style cleaning IFDEF +// +// Revision 1.4 2004/05/05 00:04:10 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.3 2004/04/06 04:53:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/common/JclAbstractContainers.pas b/official/1.96/source/common/JclAbstractContainers.pas new file mode 100644 index 0000000..cb3ad9c --- /dev/null +++ b/official/1.96/source/common/JclAbstractContainers.pas @@ -0,0 +1,301 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:41 $ +// For history see end of file + +unit JclAbstractContainers; + +{$I jcl.inc} + +interface + +uses + {$IFDEF CLR} + System.Threading, + {$ELSE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$ENDIF CLR} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + SysUtils, Classes, JclBase, JclContainerIntf; + +type + TJclIntfCriticalSection = class(TObject, IInterface) + {$IFNDEF CLR} + private + FCriticalSection: TRTLCriticalSection; + protected + function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + constructor Create; + destructor Destroy; override; + {$ENDIF ~CLR} + end; + + TJclAbstractContainer = class(TInterfacedObject) + {$IFDEF THREADSAFE} + private + FCriticalSection: TJclIntfCriticalSection; + protected + function EnterCriticalSection: IInterface; + public + constructor Create; + destructor Destroy; override; + {$ENDIF THREADSAFE} + end; + + TJclStrCollection = class(TJclAbstractContainer, IJclStrCollection) + protected + { IJclStrCollection } + function Add(const AString: string): Boolean; virtual; abstract; + function AddAll(ACollection: IJclStrCollection): Boolean; virtual; abstract; + procedure Clear; virtual; abstract; + function Contains(const AString: string): Boolean; virtual; abstract; + function ContainsAll(ACollection: IJclStrCollection): Boolean; virtual; abstract; + function Equals(ACollection: IJclStrCollection): Boolean; virtual; abstract; + function First: IJclStrIterator; virtual; abstract; + function IsEmpty: Boolean; virtual; abstract; + function Last: IJclStrIterator; virtual; abstract; + function Remove(const AString: string): Boolean; overload; virtual; abstract; + function RemoveAll(ACollection: IJclStrCollection): Boolean; virtual; abstract; + function RetainAll(ACollection: IJclStrCollection): Boolean; virtual; abstract; + function Size: Integer; virtual; abstract; + procedure LoadFromStrings(Strings: TStrings); + procedure SaveToStrings(Strings: TStrings); + procedure AppendToStrings(Strings: TStrings); + procedure AppendFromStrings(Strings: TStrings); + function GetAsStrings: TStrings; + function GetAsDelimited(const Separator: string = AnsiLineBreak): string; + procedure AppendDelimited(const AString: string; const Separator: string = AnsiLineBreak); + procedure LoadDelimited(const AString: string; const Separator: string = AnsiLineBreak); + end; + +implementation + +//=== { TJclIntfCriticalSection } ============================================ + +{$IFNDEF CLR} +constructor TJclIntfCriticalSection.Create; +begin + inherited Create; + InitializeCriticalSection(FCriticalSection); +end; + +destructor TJclIntfCriticalSection.Destroy; +begin + DeleteCriticalSection(FCriticalSection); + inherited Destroy; +end; + +function TJclIntfCriticalSection._AddRef: Integer; +begin + EnterCriticalSection(FCriticalSection); + Result := 0; +end; + +function TJclIntfCriticalSection._Release: Integer; +begin + LeaveCriticalSection(FCriticalSection); + Result := 0; +end; + +function TJclIntfCriticalSection.QueryInterface(const IID: TGUID; out Obj): HRESULT; +begin + if GetInterface(IID, Obj) then + Result := S_OK + else + Result := E_NOINTERFACE; +end; +{$ENDIF ~CLR} + +//=== { TJclAbstractContainer } ============================================== + +{$IFDEF THREADSAFE} + +constructor TJclAbstractContainer.Create; +begin + FCriticalSection := TJclIntfCriticalSection.Create; +end; + +destructor TJclAbstractContainer.Destroy; +begin + FCriticalSection.Free; + inherited Destroy; +end; + +function TJclAbstractContainer.EnterCriticalSection: IInterface; +begin + Result := FCriticalSection as IInterface; +end; + +{$ENDIF THREADSAFE} + +//=== { TJclStrCollection } ================================================== + +procedure TJclStrCollection.AppendDelimited(const AString, Separator: string); +{$IFDEF CLR} +var + I, StartIndex: Integer; +begin + I := Pos(Separator, AString); + if I <> 0 then + begin + Dec(I); // to .NET string index base + StartIndex := 0; + repeat + Add(AString.Substring(StartIndex, I - StartIndex + 1)); + StartIndex := I + 1; + I := AString.IndexOf(Separator, StartIndex); + until I < 0; + end + else + Add(AString); +end; +{$ELSE} +var + Item: string; + SepLen: Integer; + PString, PSep, PPos: PChar; +begin + PString := PChar(AString); + PSep := PChar(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); + //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; +{$ENDIF CLR} + +procedure TJclStrCollection.AppendFromStrings(Strings: TStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Add(Strings[I]); +end; + +procedure TJclStrCollection.AppendToStrings(Strings: TStrings); +var + It: IJclStrIterator; +begin + It := First; + Strings.BeginUpdate; + try + while It.HasNext do + Strings.Add(It.Next); + finally + Strings.EndUpdate; + end; +end; + +function TJclStrCollection.GetAsDelimited(const Separator: string): string; +var + It: IJclStrIterator; +begin + It := First; + Result := ''; + if It.HasNext then + Result := It.Next; + while It.HasNext do + Result := Result + Separator + It.Next; +end; + +function TJclStrCollection.GetAsStrings: TStrings; +begin + Result := TStringList.Create; + try + AppendToStrings(Result); + except + Result.Free; + raise; + end; +end; + +procedure TJclStrCollection.LoadDelimited(const AString, Separator: string); +begin + Clear; + AppendDelimited(AString, Separator); +end; + +procedure TJclStrCollection.LoadFromStrings(Strings: TStrings); +begin + Clear; + AppendFromStrings(Strings); +end; + +procedure TJclStrCollection.SaveToStrings(Strings: TStrings); +begin + Strings.Clear; + AppendToStrings(Strings); +end; + +// History: + +// $Log: JclAbstractContainers.pas,v $ +// Revision 1.6 2005/05/05 20:08:41 ahuser +// JCL.NET support +// +// Revision 1.5 2005/03/14 08:46:53 rrossmair +// - check-in in preparation for release 1.95 +// +// Revision 1.4 2005/03/03 08:02:56 marquardt +// various style cleanings, bugfixes and improvements +// +// Revision 1.3 2005/03/02 17:48:54 rrossmair +// - replaced $IFDEF UNIX by $IFDEF HAS_UNIT_LIBC, fixed header +// +// Revision 1.2 2005/03/02 09:59:30 dade2004 +// - added TJclStrCollection, which now serves as a common ancestor to all classes implementing IJclStrCollection. +// - replaced and bug-fixed JclAlgorithms.DCLAppendDelimited() by TJclStrCollection.AppendDelimited +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclAlgorithms.pas b/official/1.96/source/common/JclAlgorithms.pas new file mode 100644 index 0000000..d2a6dd0 --- /dev/null +++ b/official/1.96/source/common/JclAlgorithms.pas @@ -0,0 +1,608 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/03/02 17:51:15 $ +// For history see end of file + +unit JclAlgorithms; + +{$I jcl.inc} + +interface + +uses + JclBase, JclContainerIntf; + +// function pointer types +type + // pointer functions for Apply Algorithms + TIntfApplyFunction = function(AInterface: IInterface): IInterface; + TStrApplyFunction = function(const AString: string): string; + TApplyFunction = function(AObject: TObject): TObject; + // Pointer functions for comparator + TIntfCompare = function(Obj1, Obj2: IInterface): Integer; + TStrCompare = function(const Obj, Obj2: string): Integer; + TCompare = function(Obj1, Obj2: TObject): Integer; + +// Compare functions +function IntfSimpleCompare(Obj1, Obj2: IInterface): Integer; +function StrSimpleCompare(const Obj1, Obj2: string): Integer; +function SimpleCompare(Obj1, Obj2: TObject): Integer; + +function IntegerCompare(Obj1, Obj2: TObject): Integer; + +// Apply algorithms +procedure Apply(First: IJclIntfIterator; Count: Integer; F: TIntfApplyFunction); overload; +procedure Apply(First: IJclStrIterator; Count: Integer; F: TStrApplyFunction); overload; +procedure Apply(First: IJclIterator; Count: Integer; F: TApplyFunction); overload; + +// Find algorithms +function Find(First: IJclIntfIterator; Count: Integer; AInterface: IInterface; + AComparator: TIntfCompare): IJclIntfIterator; overload; +function Find(First: IJclStrIterator; Count: Integer; const AString: string; + AComparator: TStrCompare): IJclStrIterator; overload; +function Find(First: IJclIterator; Count: Integer; AObject: TObject; + AComparator: TCompare): IJclIterator; overload; + +// CountObject algorithms +function CountObject(First: IJclIntfIterator; Count: Integer; AInterface: IInterface; + AComparator: TIntfCompare): Integer; overload; +function CountObject(First: IJclStrIterator; Count: Integer; const AString: string; + AComparator: TStrCompare): Integer; overload; +function CountObject(First: IJclIterator; Count: Integer; AObject: TObject; + AComparator: TCompare): Integer; overload; + +// Copy algorithms +procedure Copy(First: IJclIntfIterator; Count: Integer; Output: IJclIntfIterator); overload; +procedure Copy(First: IJclStrIterator; Count: Integer; Output: IJclStrIterator); overload; +procedure Copy(First: IJclIterator; Count: Integer; Output: IJclIterator); overload; + +// Generate algorithms +procedure Generate(List: IJclIntfList; Count: Integer; AInterface: IInterface); overload; +procedure Generate(List: IJclStrList; Count: Integer; const AString: string); overload; +procedure Generate(List: IJclList; Count: Integer; AObject: TObject); overload; + +// Fill algorithms +procedure Fill(First: IJclIntfIterator; Count: Integer; AInterface: IInterface); overload; +procedure Fill(First: IJclStrIterator; Count: Integer; const AString: string); overload; +procedure Fill(First: IJclIterator; Count: Integer; AObject: TObject); overload; + +// Reverse algorithms +procedure Reverse(First, Last: IJclIntfIterator); overload; +procedure Reverse(First, Last: IJclStrIterator); overload; +procedure Reverse(First, Last: IJclIterator); overload; + +type + // Pointer functions for sort algorithms + TIntfSortProc = procedure(AList: IJclIntfList; L, R: Integer; AComparator: TIntfCompare); + TStrSortProc = procedure(AList: IJclStrList; L, R: Integer; AComparator: TStrCompare); + TSortProc = procedure(AList: IJclList; L, R: Integer; AComparator: TCompare); + +procedure QuickSort(AList: IJclIntfList; L, R: Integer; AComparator: TIntfCompare); overload; +procedure QuickSort(AList: IJclStrList; L, R: Integer; AComparator: TStrCompare); overload; +procedure QuickSort(AList: IJclList; L, R: Integer; AComparator: TCompare); overload; + +var + IntfSortProc: TIntfSortProc = QuickSort; + StrSortProc: TStrSortProc = QuickSort; + SortProc: TSortProc = QuickSort; + +// Sort algorithms +procedure Sort(AList: IJclIntfList; First, Last: Integer; AComparator: TIntfCompare); overload; +procedure Sort(AList: IJclStrList; First, Last: Integer; AComparator: TStrCompare); overload; +procedure Sort(AList: IJclList; First, Last: Integer; AComparator: TCompare); overload; + +implementation + +uses + SysUtils; + +function IntfSimpleCompare(Obj1, Obj2: IInterface): Integer; +begin + if Cardinal(Obj1) < Cardinal(Obj2) then + Result := -1 + else + if Cardinal(Obj1) > Cardinal(Obj2) then + Result := 1 + else + Result := 0; +end; + +function StrSimpleCompare(const Obj1, Obj2: string): Integer; +begin + // (rom) changed to case sensitive compare + Result := CompareStr(Obj1, Obj2); +end; + +function SimpleCompare(Obj1, Obj2: TObject): Integer; +begin + if Cardinal(Obj1) < Cardinal(Obj2) then + Result := -1 + else + if Cardinal(Obj1) > Cardinal(Obj2) then + Result := 1 + else + Result := 0; +end; + +function IntegerCompare(Obj1, Obj2: TObject): Integer; +begin + Result := Integer(Obj1) - Integer(Obj2); +end; + +procedure Apply(First: IJclIntfIterator; Count: Integer; F: TIntfApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.SetObject(F(First.GetObject)); + First.Next; + end + else + Break; +end; + +procedure Apply(First: IJclStrIterator; Count: Integer; F: TStrApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.SetString(F(First.GetString)); + First.Next; + end + else + Break; +end; + +procedure Apply(First: IJclIterator; Count: Integer; F: TApplyFunction); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.SetObject(F(First.GetObject)); + First.Next; + end + else + Break; +end; + +function Find(First: IJclIntfIterator; Count: Integer; 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.GetObject, AInterface) = 0 then + begin + Result := First; + Break; + end; + First.Next; + end + else + Break; +end; + +function Find(First: IJclStrIterator; Count: Integer; const AString: string; + AComparator: TStrCompare): IJclStrIterator; +var + I: Integer; +begin + Result := nil; + for I := Count - 1 downto 0 do + if First.HasNext then + begin + if AComparator(First.GetString, AString) = 0 then + begin + Result := First; + Break; + end; + First.Next; + end + else + Break; +end; + +function Find(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.GetObject, AObject) = 0 then + begin + Result := First; + Break; + end; + First.Next; + end + else + Break; +end; + +function CountObject(First: IJclIntfIterator; Count: Integer; 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(First: IJclStrIterator; Count: Integer; const AString: string; + AComparator: TStrCompare): 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(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; + +procedure Copy(First: IJclIntfIterator; Count: Integer; Output: IJclIntfIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.SetObject(First.GetObject); + First.Next; + Output.Next; + end + else + Break; +end; + +procedure Copy(First: IJclStrIterator; Count: Integer; Output: IJclStrIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.SetString(First.GetString); + First.Next; + Output.Next; + end + else + Break; +end; + +procedure Copy(First: IJclIterator; Count: Integer; Output: IJclIterator); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if Output.HasNext and First.HasNext then + begin + Output.SetObject(First.GetObject); + First.Next; + Output.Next; + end + else + Break; +end; + +procedure Generate(List: IJclIntfList; Count: Integer; AInterface: IInterface); +var + I: Integer; +begin + List.Clear; + for I := 0 to Count - 1 do + List.Add(AInterface); +end; + +procedure Generate(List: IJclStrList; Count: Integer; const AString: string); +var + I: Integer; +begin + List.Clear; + for I := Count - 1 downto 0 do + List.Add(AString); +end; + +procedure Generate(List: IJclList; Count: Integer; AObject: TObject); +var + I: Integer; +begin + List.Clear; + for I := Count - 1 downto 0 do + List.Add(AObject); +end; + +procedure Fill(First: IJclIntfIterator; Count: Integer; AInterface: IInterface); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.SetObject(AInterface); + First.Next; + end + else + Break; +end; + +procedure Fill(First: IJclStrIterator; Count: Integer; const AString: string); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.SetString(AString); + First.Next; + end + else + Break; +end; + +procedure Fill(First: IJclIterator; Count: Integer; AObject: TObject); +var + I: Integer; +begin + for I := Count - 1 downto 0 do + if First.HasNext then + begin + First.SetObject(AObject); + First.Next; + end + else + Break; +end; + +procedure Reverse(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.GetObject; + Last.Previous; + First.SetObject(Last.GetObject); + Last.SetObject(Obj); + First.Next; + end; +end; + +procedure Reverse(First, Last: IJclStrIterator); +var + Obj: string; +begin + if not First.HasNext then + Exit; + if not Last.HasPrevious then + Exit; + while First.NextIndex <= Last.PreviousIndex do + begin + Obj := First.GetString; + Last.Previous; + First.SetString(Last.GetString); + Last.SetString(Obj); + First.Next; + end; +end; + +procedure Reverse(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.GetObject; + Last.Previous; + First.SetObject(Last.GetObject); + Last.SetObject(Obj); + First.Next; + end; +end; + +procedure QuickSort(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 + while AComparator(AList.GetObject(I), AList.GetObject(P)) < 0 do + Inc(I); + while AComparator(AList.GetObject(J), AList.GetObject(P)) > 0 do + Dec(J); + if I <= J then + begin + Obj := AList.GetObject(I); + AList.SetObject(I, AList.GetObject(J)); + AList.SetObject(J, Obj); + 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(AList: IJclStrList; L, R: Integer; AComparator: TStrCompare); +var + I, J, P: Integer; + Obj: string; +begin + repeat + I := L; + J := R; + P := (L + R) shr 1; + repeat + while AComparator(AList.GetString(I), AList.GetString(P)) < 0 do + Inc(I); + while AComparator(AList.GetString(J), AList.GetString(P)) > 0 do + Dec(J); + if I <= J then + begin + Obj := AList.GetString(I); + AList.SetString(I, AList.GetString(J)); + AList.SetString(J, Obj); + 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(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 + while AComparator(AList.GetObject(I), AList.GetObject(P)) < 0 do + Inc(I); + while AComparator(AList.GetObject(J), AList.GetObject(P)) > 0 do + Dec(J); + if I <= J then + begin + Obj := AList.GetObject(I); + AList.SetObject(I, AList.GetObject(J)); + AList.SetObject(J, Obj); + 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(AList: IJclIntfList; First, Last: Integer; AComparator: TIntfCompare); +begin + IntfSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(AList: IJclStrList; First, Last: Integer; AComparator: TStrCompare); +begin + StrSortProc(AList, First, Last, AComparator); +end; + +procedure Sort(AList: IJclList; First, Last: Integer; AComparator: TCompare); +begin + SortProc(AList, First, Last, AComparator); +end; + +// History: + +// $Log: JclAlgorithms.pas,v $ +// Revision 1.5 2005/03/02 17:51:15 rrossmair +// - removed DCLAppendDelimited from JclAlgorithms, changed uses clauses accordingly +// +// Revision 1.4 2005/03/02 09:59:30 dade2004 +// Added +// -TJclStrCollection in JclContainerIntf +// Every common methods for IJclStrCollection are implemented here +// +// -Every class that implement IJclStrCollection now derive from TJclStrCollection instead of TJclAbstractContainer +// -Every abstract method in TJclStrCollection has been marked as "override" in descendent classes +// +// DCLAppendDelimited has been removed from JclAlgorothms, his body has been fixed for a bug and put into +// relative method in TJclStrCollection +// +// Revision 1.3 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.2 2005/02/24 07:36:24 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclAnsiStrings.pas b/official/1.96/source/common/JclAnsiStrings.pas new file mode 100644 index 0000000..d9e9c7a --- /dev/null +++ b/official/1.96/source/common/JclAnsiStrings.pas @@ -0,0 +1,4095 @@ +{**************************************************************************************************} +{ } +{ 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 } +{ Anthony Steele } +{ Azret Botash } +{ Barry Kelly } +{ Huanlin Tsai } +{ Jack N.A. Bakker } +{ Jean-Fabien Connault } +{ John C Molyneux } +{ Leonard Wennekers } +{ Martin Kimmings } +{ Martin Kubecka } +{ Massimo Maria Ghisalberti } +{ Matthias Thoma (mthoma) } +{ Michael Winter } +{ Nick Hodges } +{ Olivier Sannier } +{ Pelle F. S. Liljendal } +{ Petr Vones } +{ Robert Lee } +{ Robert Marquardt } +{ Robert Rossmair (rrossmair) } +{ } +{**************************************************************************************************} +{ } +{ Various character and string routines (searching, testing and transforming) } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/10/25 12:52:23 $ +// For history see end of file + +unit JclAnsiStrings; // former JclStrings + +{$I jcl.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + {$IFDEF CLR} + System.Text, + {$ELSE} + JclWideStrings, + {$ENDIF CLR} + JclBase; + +// 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 = JclBase.AnsiLineFeed; + AnsiVerticalTab = AnsiChar(#11); + AnsiFormFeed = AnsiChar(#12); + AnsiCarriageReturn = JclBase.AnsiCarriageReturn; + AnsiCrLf = JclBase.AnsiCrLf; + 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(''''); + + AnsiLineBreak = JclBase.AnsiLineBreak; + +// Misc. character sets + + AnsiWhiteSpace = [AnsiTab, AnsiLineFeed, AnsiVerticalTab, + AnsiFormFeed, AnsiCarriageReturn, AnsiSpace]; + AnsiSigns = ['-', '+']; + AnsiUppercaseLetters = JclBase.AnsiUppercaseLetters; + AnsiLowercaseLetters = JclBase.AnsiLowercaseLetters; + AnsiLetters = JclBase.AnsiLetters; + AnsiDecDigits = JclBase.AnsiDecDigits; + AnsiOctDigits = JclBase.AnsiOctDigits; + AnsiHexDigits = JclBase.AnsiHexDigits; + AnsiValidIdentifierLetters = JclBase.AnsiValidIdentifierLetters; + +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: Integer; C: AnsiChar = ' '): AnsiString; +function StrCharPosLower(const S: AnsiString; CharPos: Integer): AnsiString; +function StrCharPosUpper(const S: AnsiString; CharPos: Integer): 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); +{$IFNDEF CLR} +procedure StrLowerBuff(S: PAnsiChar); +{$ENDIF ~CLR} +procedure StrMove(var Dest: AnsiString; const Source: AnsiString; const ToIndex, + FromIndex, Count: Integer); +function StrPadLeft(const S: AnsiString; Len: Integer; C: AnsiChar = AnsiSpace ): AnsiString; +function StrPadRight(const S: AnsiString; Len: Integer; C: AnsiChar = AnsiSpace ): AnsiString; +function StrProper(const S: AnsiString): AnsiString; +{$IFNDEF CLR} +procedure StrProperBuff(S: PAnsiChar); +{$ENDIF ~CLR} +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: Integer): AnsiString; +function StrRepeatLength(const S: AnsiString; const L: Integer): AnsiString; +function StrReverse(const S: AnsiString): AnsiString; +procedure StrReverseInPlace(var S: AnsiString); +function StrSingleQuote(const S: AnsiString): AnsiString; +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; +function StrUpper(const S: AnsiString): AnsiString; +procedure StrUpperInPlace(var S: AnsiString); +{$IFNDEF CLR} +procedure StrUpperBuff(S: PAnsiChar); +{$ENDIF ~CLR} +{$IFDEF WIN32} +function StrOemToAnsi(const S: AnsiString): AnsiString; +function StrAnsiToOem(const S: AnsiString): AnsiString; +{$ENDIF WIN32} + +{$IFNDEF CLR} +// String Management +procedure StrAddRef(var S: AnsiString); +function StrAllocSize(const S: AnsiString): Longint; +procedure StrDecRef(var S: AnsiString); +function StrLen(S: PAnsiChar): Integer; +function StrLength(const S: AnsiString): Longint; +function StrRefCount(const S: AnsiString): Longint; +{$ENDIF ~CLR} +procedure StrResetLength(var S: AnsiString); + +// String Search and Replace Routines +function StrCharCount(const S: AnsiString; C: AnsiChar): Integer; +function StrCharsCount(const S: AnsiString; Chars: TSysCharSet): Integer; +function StrStrCount(const S, SubS: AnsiString): Integer; +function StrCompare(const S1, S2: AnsiString): Integer; +function StrCompareRange(const S1, S2: AnsiString; const Index, Count: Integer): Integer; +function StrFillChar(const C: AnsiChar; Count: Integer): AnsiString; overload; +{$IFDEF CLR} +function StrFillChar(const C: Char; Count: Integer): string; overload; +{$ENDIF CLR} +function StrFind(const Substr, S: AnsiString; const Index: Integer = 1): Integer; +function StrHasPrefix(const S: AnsiString; const Prefixes: array of string): Boolean; +function StrIndex(const S: AnsiString; const List: array of AnsiString): Integer; +function StrILastPos(const SubStr, S: AnsiString): Integer; +function StrIPos(const SubStr, S: AnsiString): Integer; +function StrIsOneOf(const S: AnsiString; const List: array of AnsiString): Boolean; +function StrLastPos(const SubStr, S: AnsiString): Integer; +{$IFNDEF CLR} +function StrMatch(const Substr, S: AnsiString; const Index: Integer = 1): Integer; +function StrMatches(const Substr, S: AnsiString; const Index: Integer = 1): Boolean; +{$ENDIF ~CLR} +function StrNIPos(const S, SubStr: AnsiString; N: Integer): Integer; +function StrNPos(const S, SubStr: AnsiString; N: Integer): Integer; +function StrPrefixIndex(const S: AnsiString; const Prefixes: array of string): Integer; +function StrSearch(const Substr, S: AnsiString; const Index: Integer = 1): Integer; + +// String Extraction +function StrAfter(const SubStr, S: AnsiString): AnsiString; +function StrBefore(const SubStr, S: AnsiString): AnsiString; +function StrBetween(const S: AnsiString; const Start, Stop: AnsiChar): AnsiString; +function StrChopRight(const S: AnsiString; N: Integer): AnsiString; +function StrLeft(const S: AnsiString; Count: Integer): AnsiString; +function StrMid(const S: AnsiString; Start, Count: Integer): AnsiString; +function StrRestOf(const S: AnsiString; N: Integer): AnsiString; +function StrRight(const S: AnsiString; Count: Integer): AnsiString; + +// Character Test Routines +function CharEqualNoCase(const C1, C2: AnsiChar): Boolean; +function CharIsAlpha(const C: AnsiChar): Boolean; +function CharIsAlphaNum(const C: AnsiChar): Boolean; +function CharIsBlank(const C: AnsiChar): Boolean; +function CharIsControl(const C: AnsiChar): Boolean; +function CharIsDelete(const C: AnsiChar): Boolean; +function CharIsDigit(const C: AnsiChar): Boolean; +function CharIsLower(const C: AnsiChar): Boolean; +function CharIsNumberChar(const C: AnsiChar): Boolean; +function CharIsPrintable(const C: AnsiChar): Boolean; +function CharIsPunctuation(const C: AnsiChar): Boolean; +function CharIsReturn(const C: AnsiChar): Boolean; +function CharIsSpace(const C: AnsiChar): Boolean; +function CharIsUpper(const C: AnsiChar): Boolean; +function CharIsWhiteSpace(const C: AnsiChar): Boolean; +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: Integer = 1): Integer; +function CharLastPos(const S: AnsiString; const C: AnsiChar; const Index: Integer = 1): Integer; +function CharIPos(const S: AnsiString; C: AnsiChar; const Index: Integer = 1 ): Integer; +function CharReplace(var S: AnsiString; const Search, Replace: AnsiChar): Integer; + +{$IFNDEF CLR} +// PCharVector +type + PCharVector = ^PAnsiChar; + +function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector; +function PCharVectorCount(Source: PCharVector): Integer; +procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector); +procedure FreePCharVector(var Dest: PCharVector); + +// MultiSz Routines +type + PMultiSz = PAnsiChar; + PWideMultiSz = PWideChar; + +function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz; +procedure MultiSzToStrings(const Dest: TStrings; const Source: PMultiSz); +function MultiSzLength(const Source: PMultiSz): Integer; +procedure AllocateMultiSz(var Dest: PMultiSz; Len: Integer); +procedure FreeMultiSz(var Dest: PMultiSz); +function MultiSzDup(const Source: PMultiSz): PMultiSz; + +function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): PWideMultiSz; +procedure WideMultiSzToWideStrings(const Dest: TWideStrings; const Source: PWideMultiSz); +function WideMultiSzLength(const Source: PWideMultiSz): Integer; +procedure AllocateWideMultiSz(var Dest: PWideMultiSz; Len: Integer); +procedure FreeWideMultiSz(var Dest: PWideMultiSz); +function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz; +{$ENDIF ~CLR} + +// TStrings Manipulation +procedure StrIToStrings(S, Sep: AnsiString; const List: TStrings; const AllowEmptyString: Boolean = True); +procedure StrToStrings(S, Sep: AnsiString; const List: TStrings; const AllowEmptyString: Boolean = True); +function StringsToStr(const List: TStrings; const Sep: AnsiString; const AllowEmptyString: Boolean = True): AnsiString; +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 +function BooleanToStr(B: Boolean): AnsiString; +function FileToString(const FileName: AnsiString): AnsiString; +procedure StringToFile(const FileName, Contents: AnsiString); +function StrToken(var S: AnsiString; Separator: AnsiChar): AnsiString; +{$IFNDEF CLR} +procedure StrTokens(const S: AnsiString; const List: TStrings); +procedure StrTokenToStrings(S: AnsiString; Separator: AnsiChar; const List: TStrings); +function StrWord(var S: PAnsiChar; out Word: AnsiString): Boolean; +{$ENDIF ~CLR} +function StrToFloatSafe(const S: AnsiString): Float; +function StrToIntSafe(const S: AnsiString): Integer; +procedure StrNormIndex(const StrLen: integer; var Index: integer; var Count: integer); overload; + +{$IFDEF CLR} +function ArrayOf(List: TStrings): TDynStringArray; overload; +{$ENDIF CLR} + +// Exceptions +type + EJclStringError = EJclError; + +implementation + +uses + {$IFDEF CLR} + System.Globalization, + {$ENDIF CLR} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + JclLogic, JclResources; + +//=== Internal =============================================================== + +{$IFNDEF CLR} +type + TAnsiStrRec = packed record + AllocSize: Longint; + RefCount: Longint; + Length: Longint; + end; +{$ENDIF ~CLR} + +const + {$IFNDEF CLR} + AnsiStrRecSize = SizeOf(TAnsiStrRec); // size of the AnsiString header rec + {$ENDIF ~CLR} + 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 + AnsiAlOffset = 12; // offset to AllocSize in StrRec + AnsiRfOffset = 8; // offset to RefCount in StrRec + AnsiLnOffset = 4; // offset to Length in StrRec + 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; + +procedure LoadCharTypes; +var + CurrChar: AnsiChar; + CurrType: Word; + {$IFDEF CLR} + Category: System.Globalization.UnicodeCategory; + {$ENDIF CLR} +begin + for CurrChar := Low(AnsiChar) to High(AnsiChar) do + begin + {$IFDEF CLR} + Category := System.Char.GetUnicodeCategory(Char(CurrChar)); + case Category of + UnicodeCategory.UppercaseLetter: + CurrType := C1_UPPER or C1_ALPHA; + UnicodeCategory.LowercaseLetter: + CurrType := C1_LOWER or C1_ALPHA; + UnicodeCategory.DecimalDigitNumber: + CurrType := C1_DIGIT; + UnicodeCategory.SpaceSeparator: + CurrType := C1_SPACE; + UnicodeCategory.ClosePunctuation, + UnicodeCategory.ConnectorPunctuation, + UnicodeCategory.DashPunctuation, + UnicodeCategory.FinalQuotePunctuation, + UnicodeCategory.InitialQuotePunctuation, + UnicodeCategory.OpenPunctuation, + UnicodeCategory.OtherPunctuation: + CurrType := C1_PUNCT; + UnicodeCategory.Control: + CurrType := C1_CNTRL; + UnicodeCategory.OtherNotAssigned: + CurrType := C1_BLANK; + UnicodeCategory.LetterNumber: + CurrType := C1_XDIGIT; + UnicodeCategory.ModifierLetter, + UnicodeCategory.OtherLetter: + CurrType := C1_ALPHA; + else + CurrType := 0; + end; + {$DEFINE CHAR_TYPES_INITIALIZED} + {$ELSE} + {$IFDEF MSWINDOWS} + 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} + {$ENDIF CLR} + 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 CLR} + LoCaseChar := AnsiChar(System.Char.ToLower(Char(CurrChar))); + UpCaseChar := AnsiChar(System.Char.ToUpper(Char(CurrChar))); + {$DEFINE CASE_MAP_INITIALIZED} + {$ELSE} + {$IFDEF MSWINDOWS} + LoCaseChar := CurrChar; + UpCaseChar := CurrChar; + Windows.CharLowerBuff(@LoCaseChar, 1); + Windows.CharUpperBuff(@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} + {$ENDIF CLR} + {$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) + +{$IFDEF CLR} +procedure StrCase(var Str: AnsiString; const Offset: Integer); +var + I: Integer; +begin + for I := 0 to Length(Str) - 1 do + Str[I + 1] := AnsiCaseMap[Offset + Ord(Str[I + 1])]; +end; +{$ELSE} +procedure StrCase(var Str: AnsiString; const Offset: Integer); register; assembler; +asm + // make sure that the string is not null + + TEST EAX, EAX + JZ @@StrIsNull + + // create unique string if this one is ref-counted + + PUSH EDX + CALL UniqueString + POP EDX + + // make sure that the new string is not null + + TEST EAX, EAX + JZ @@StrIsNull + + // get the length, and prepare the counter + + MOV ECX, [EAX - AnsiStrRecSize].TAnsiStrRec.Length + DEC ECX + JS @@StrIsNull + + // ebx will hold the case map, esi pointer to Str + + PUSH EBX + PUSH ESI + PUSH EDI + + // load case map and prepare variables } + + {$IFDEF PIC} + LEA EBX, [EBX][AnsiCaseMap + EDX] + {$ELSE} + LEA EBX, [AnsiCaseMap + EDX] + {$ENDIF PIC} + MOV ESI, EAX + XOR EDX, EDX + XOR EAX, EAX + +@@NextChar: + // get current char from the AnsiString + + MOV DL, [ESI] + + // get corresponding char from the case map + + MOV AL, [EBX + EDX] + + // store it back in the string + + MOV [ESI], AL + + // update the loop counter and check the end of stirng + + DEC ECX + JL @@Done + + // do the same thing with next 3 chars + + MOV DL, [ESI + 1] + MOV AL, [EBX + EDX] + MOV [ESI + 1], AL + + DEC ECX + JL @@Done + MOV DL, [ESI + 2] + MOV AL, [EBX+EDX] + MOV [ESI + 2], AL + + DEC ECX + JL @@Done + MOV DL, [ESI + 3] + MOV AL, [EBX + EDX] + MOV [ESI + 3], AL + + // point AnsiString to next 4 chars + + ADD ESI, 4 + + // update the loop counter and check the end of stirng + + DEC ECX + JGE @@NextChar + +@@Done: + POP EDI + POP ESI + POP EBX + +@@StrIsNull: +end; +{$ENDIF CLR} + +{$IFNDEF CLR} +// Internal utility function +// Uppercases or Lowercases a give null terminated string depending on the +// passed offset. (UpOffset or LoOffset) + +procedure StrCaseBuff(S: PAnsiChar; const Offset: Integer); register; assembler; +asm + // make sure the string is not null + + TEST EAX, EAX + JZ @@StrIsNull + + // ebx will hold the case map, esi pointer to Str + + PUSH EBX + PUSH ESI + + // load case map and prepare variables + + {$IFDEF PIC} + LEA EBX, [EBX][AnsiCaseMap + EDX] + {$ELSE} + LEA EBX, [AnsiCaseMap + EDX] + {$ENDIF PIC} + MOV ESI, EAX + XOR EDX, EDX + XOR EAX, EAX + +@@NextChar: + // get current char from the string + + MOV DL, [ESI] + + // check for null char + + TEST DL, DL + JZ @@Done + + // get corresponding char from the case map + + MOV AL, [EBX + EDX] + + // store it back in the string + + MOV [ESI], AL + + // do the same thing with next 3 chars + + MOV DL, [ESI + 1] + TEST DL, DL + JZ @@Done + MOV AL, [EBX+EDX] + MOV [ESI + 1], AL + + MOV DL, [ESI + 2] + TEST DL, DL + JZ @@Done + MOV AL, [EBX+EDX] + MOV [ESI + 2], AL + + MOV DL, [ESI + 3] + TEST DL, DL + JZ @@Done + MOV AL, [EBX+EDX] + MOV [ESI + 3], AL + + // point string to next 4 chars + + ADD ESI, 4 + JMP @@NextChar + +@@Done: + POP ESI + POP EBX + +@@StrIsNull: +end; + +function StrEndW(Str: PWideChar): PWideChar; assembler; +// returns a pointer to the end of a null terminated string +// stolen from JclUnicode +asm + MOV EDX, EDI + MOV EDI, EAX + MOV ECX, 0FFFFFFFFH + XOR AX, AX + REPNE SCASW + LEA EAX, [EDI - 2] + MOV EDI, EDX +end; +{$ENDIF ~CLR} + +// String Test Routines +function StrIsAlpha(const S: AnsiString): Boolean; +var + I: Integer; +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: Integer; +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: Integer; +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: Integer; + 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: Integer; + 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: Integer; +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: Integer; +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: Integer; 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: Integer): AnsiString; +begin + Result := S; + if (CharPos > 0) and (CharPos <= Length(S)) then + Result[CharPos] := CharLower(Result[CharPos]); +end; + +function StrCharPosUpper(const S: AnsiString; CharPos: Integer): AnsiString; +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 : Integer; +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 : Integer; + StrLength : Integer; +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: Integer; +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: Integer; +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; +var + I, Len, N, Val: Integer; + + procedure HandleHexEscapeSeq; + const + HexDigits = AnsiString('0123456789abcdefABCDEF'); + begin + N := Pos(S[I + 1], HexDigits) - 1; + if N < 0 then + // '\x' without hex digit following is not escape sequence + Result := Result + '\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 > 255 then + {$IFDEF CLR} + raise EJclStringError.Create(RsNumericConstantTooLarge); + {$ELSE} + raise EJclStringError.CreateRes(@RsNumericConstantTooLarge); + {$ENDIF CLR} + + Result := Result + Chr(Val); + end; + end; + + procedure HandleOctEscapeSeq; + const + OctDigits = AnsiString('01234567'); + begin + // 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 > 255 then + {$IFDEF CLR} + raise EJclStringError.Create(RsNumericConstantTooLarge); + {$ELSE} + raise EJclStringError.CreateRes(@RsNumericConstantTooLarge); + {$ENDIF CLR} + + Result := Result + Chr(Val); + end; + +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 + else + // '\x' at end of AnsiString is not escape sequence + Result := Result + '\x'; + '0'..'7': + // start of octal escape sequence + HandleOctEscapeSeq; + 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); +{$IFDEF PIC} +begin + StrCase(S, AnsiLoOffset); +end; +{$ELSE} +assembler; +asm + // StrCase(S, AnsiLoOffset) + + XOR EDX, EDX // MOV EDX, LoOffset + JMP StrCase +end; +{$ENDIF PIC} + +{$IFNDEF CLR} +procedure StrLowerBuff(S: PAnsiChar); +{$IFDEF PIC} +begin + StrCaseBuff(S, AnsiLoOffset); +end; +{$ELSE} +assembler; +asm + // StrCaseBuff(S, LoOffset) + XOR EDX, EDX // MOV EDX, LoOffset + JMP StrCaseBuff +end; +{$ENDIF PIC} +{$ENDIF ~CLR} + +{$IFDEF CLR} +procedure MoveAnsiString(const Source: AnsiString; SrcIndex: Integer; + var Dest: AnsiString; DstIndex, Count: Integer); +var + I: Integer; +begin + for I := 0 to Count - 1 do + Dest[DstIndex + I] := Source[SrcIndex + I]; +end; +{$ENDIF CLR} + +procedure StrMove(var Dest: AnsiString; const Source: AnsiString; + const ToIndex, FromIndex, Count: Integer); +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 + {$IFDEF CLR} + MoveAnsiString(Source, FromIndex, Dest, ToIndex, Count); + {$ELSE} + Move(Source[FromIndex], Dest[ToIndex], Count); + {$ENDIF CLR} +end; + +function StrPadLeft(const S: AnsiString; Len: Integer; C: AnsiChar): AnsiString; +var + L: Integer; +begin + L := Length(S); + if L < Len then + Result := StringOfChar(C, Len - L) + S + else + Result := S; +end; + +function StrPadRight(const S: AnsiString; Len: Integer; C: AnsiChar): AnsiString; +var + L: Integer; +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 + {$IFDEF CLR} + Result := AnsiUpperCase(S); + {$ELSE} + Result := StrLower(S); + {$ENDIF CLR} + if Result <> '' then + Result[1] := UpCase(Result[1]); +end; + +{$IFNDEF CLR} +procedure StrProperBuff(S: PAnsiChar); +begin + if (S <> nil) and (S^ <> #0) then + begin + StrLowerBuff(S); + S^ := CharUpper(S^); + end; +end; +{$ENDIF ~CLR} + +function StrQuote(const S: AnsiString; C: AnsiChar): AnsiString; +var + L: Integer; +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; +{$IFDEF CLR} +var + I, Index: Integer; +begin + SetLength(Result, Length(S)); + Index := 1; + for I := 1 to Length(S) do + if not (S[I] in Chars) then + begin + Result[Index] := S[I]; + Inc(Index); + end; + SetLength(Result, Index); +end; +{$ELSE} +var + Source, Dest: PAnsiChar; + Index, Len: Integer; +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,SizeOf(AnsiChar)); + end; + Inc(Source,SizeOf(AnsiChar)); + end; + SetLength(Result, (Longint(Dest) - Longint(PAnsiChar(Result))) div SizeOf(AnsiChar)); +end; +{$ENDIF CLR} + +function StrKeepChars(const S: AnsiString; const Chars: TSysCharSet): AnsiString; +{$IFDEF CLR} +var + I, Index: Integer; +begin + SetLength(Result, Length(S)); + Index := 1; + for I := 1 to Length(S) do + if S[I] in Chars then + begin + Result[Index] := S[I]; + Inc(Index); + end; + SetLength(Result, Index); +end; +{$ELSE} +var + Source, Dest: PAnsiChar; + Index, Len: Integer; +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,SizeOf(AnsiChar)); + end; + Inc(Source,SizeOf(AnsiChar)); + end; + SetLength(Result, (Longint(Dest) - Longint(PAnsiChar(Result))) div SizeOf(AnsiChar)); +end; +{$ENDIF CLR} + +function StrRepeat(const S: AnsiString; Count: Integer): AnsiString; +{$IFDEF CLR} +var + I, Len: Integer; +begin + Len := Length(S); + SetLength(Result, Count * Len); + if Result <> '' then + for I := 1 to Count do + MoveAnsiString(S, 1, Result, I * Len, Len); +end; +{$ELSE} +var + L: Integer; + 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; +{$ENDIF CLR} + +function StrRepeatLength(const S: AnsiString; const L: Integer): AnsiString; +{$IFDEF CLR} +var + Count: Integer; + LenS, Index: Integer; +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); + Index := 1; + while Count > 0 do + begin + MoveAnsiString(S, 1, Result, Index, LenS); + Inc(Index, LenS); + Dec(Count); + end; + if Length(S) > L then + SetLength(Result, L); + end; +end; +{$ELSE} +var + Count: Integer; + LenS: Integer; + 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; +{$ENDIF CLR} + +procedure StrReplace(var S: AnsiString; const Search, Replace: AnsiString; Flags: TReplaceFlags); +{$IFDEF CLR} +begin + S := StringReplace(S, Search, Replace, Flags); // !!! Convertion to System.String +end; +{$ELSE} +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, + SearchLength, { length of search string } + ReplaceLength, { length of replace string } + BufferLength, { length of temporary result buffer } + ResultLength: Integer; { length of result string } + C: AnsiChar; { first character of search string } + IgnoreCase: Boolean; +begin + if Search = '' then + if S = '' then + begin + S := Replace; + Exit; + end + else + raise EJclStringError.CreateRes(@RsBlankSearchString); + + if S <> '' then + begin + IgnoreCase := rfIgnoreCase in Flags; + if IgnoreCase then + SearchStr := AnsiUpperCase(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; +{$ENDIF CLR} + +function StrReplaceChar(const S: AnsiString; const Source, Replace: AnsiChar): AnsiString; +var + I: Integer; +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: Integer; +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: Integer; +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); +{$IFDEF CLR} +var + I, EndI: Integer; + C: AnsiChar; +begin + I := 1; + EndI := Length(S); + while I > EndI do + begin + C := S[I]; + S[I] := S[EndI]; + S[EndI] := C; + Inc(I); + Dec(EndI); + end; +end; +{$ELSE} +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; +{$ENDIF CLR} + +function StrSingleQuote(const S: AnsiString): AnsiString; +begin + Result := AnsiSingleQuote + S + AnsiSingleQuote; +end; + +function StrSmartCase(const S: AnsiString; Delimiters: TSysCharSet): AnsiString; +var +{$IFDEF CLR} + Index: Integer; + LenS: Integer; +{$ELSE} + Source, Dest: PAnsiChar; + Index, Len: Integer; +{$ENDIF CLR} +begin + Result := ''; + if Delimiters = [] then + Include(Delimiters, AnsiSpace); + + if S <> '' then + begin + Result := S; + {$IFDEF CLR} + LenS := Length(S); + Index := 1; + while Index < LenS do + begin + if (S[Index] in Delimiters) and (Index + 1 < LenS) then + Result[Index + 1] := CharUpper(Result[Index + 1]); + Inc(Index); + end; + {$ELSE} + 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; + {$ENDIF CLR} + + Result[1] := CharUpper(Result[1]); + end; +end; + +function StrStringToEscaped(const S: AnsiString): AnsiString; +var + I: Integer; +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 + Format('\x%.2x',[Integer(S[I])]) + else + Result := Result + S[I]; + end; + end; +end; + +function StrStripNonNumberChars(const S: AnsiString): AnsiString; +var + I: Integer; + 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: Integer; + C, L, N: Integer; + 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((BH shl 4) + BL); + Inc(N); + end; + end; +end; + +function StrTrimCharLeft(const S: AnsiString; C: AnsiChar): AnsiString; +var + I, L: Integer; +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: Integer; +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: Integer; +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: Integer; +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: Integer; +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 StrUpper(const S: AnsiString): AnsiString; +begin + Result := S; + StrUpperInPlace(Result); +end; + +procedure StrUpperInPlace(var S: AnsiString); +{$IFDEF PIC} +begin + StrCase(S, AnsiUpOffset); +end; +{$ELSE} +asm + // StrCase(Str, AnsiUpOffset) + MOV EDX, AnsiUpOffset + JMP StrCase +end; +{$ENDIF PIC} + +{$IFNDEF CLR} +procedure StrUpperBuff(S: PAnsiChar); +{$IFDEF PIC} +begin + StrCaseBuff(S, AnsiUpOffset); +end; +{$ELSE} +asm + // StrCaseBuff(S, UpOffset) + MOV EDX, AnsiUpOffset + JMP StrCaseBuff +end; +{$ENDIF PIC} +{$ENDIF ~CLR} + +{$IFDEF WIN32} +function StrOemToAnsi(const S: AnsiString): AnsiString; +begin + SetLength(Result, Length(S)); + OemToAnsiBuff(@S[1], @Result[1], Length(S)); +end; +{$ENDIF WIN32} + +{$IFDEF WIN32} +function StrAnsiToOem(const S: AnsiString): AnsiString; +begin + SetLength(Result, Length(S)); + AnsiToOemBuff(@S[1], @Result[1], Length(S)); +end; +{$ENDIF WIN32} + + +{$IFNDEF CLR} +//=== String Management ====================================================== + +procedure StrAddRef(var S: AnsiString); +var + Foo: AnsiString; +begin + if StrRefCount(S) = -1 then + UniqueString(S) + else + begin + Foo := S; + Pointer(Foo) := nil; + end; +end; + +function StrAllocSize(const S: AnsiString): Longint; +var + P: Pointer; +begin + Result := 0; + if Pointer(S) <> nil then + begin + P := Pointer(Integer(Pointer(S)) - AnsiRfOffset); + if Integer(P^) <> -1 then + begin + P := Pointer(Integer(Pointer(S)) - AnsiAlOffset); + Result := Integer(P^); + end; + end; +end; + +procedure StrDecRef(var S: AnsiString); +var + Foo: AnsiString; +begin + case StrRefCount(S) of + -1, 0: { nothing } ; + 1: + begin + Finalize(S); + Pointer(S) := nil; + end; + else + Pointer(Foo) := Pointer(S); + end; +end; + +function StrLen(S: PAnsiChar): Integer; assembler; +asm + TEST EAX, EAX + JZ @@EXIT + + PUSH EBX + MOV EDX, EAX // save pointer +@L1: MOV EBX, [EAX] // read 4 bytes + ADD EAX, 4 // increment pointer + LEA ECX, [EBX-$01010101] // subtract 1 from each byte + NOT EBX // invert all bytes + AND ECX, EBX // and these two + AND ECX, $80808080 // test all sign bits + JZ @L1 // no zero bytes, continue loop + TEST ECX, $00008080 // test first two bytes + JZ @L2 + SHL ECX, 16 // not in the first 2 bytes + SUB EAX, 2 +@L2: SHL ECX, 9 // use carry flag to avoid a branch + SBB EAX, EDX // compute length + POP EBX + + JZ @@EXIT // Az: SBB sets zero flag + DEC EAX // do not include null terminator +@@EXIT: +end; + +function StrLength(const S: AnsiString): Longint; +var + P: Pointer; +begin + Result := 0; + if Pointer(S) <> nil then + begin + P := Pointer(Integer(Pointer(S)) - AnsiLnOffset); + Result := Integer(P^) and (not $80000000 shr 1); + end; +end; + +function StrRefCount(const S: AnsiString): Longint; +var + P: Pointer; +begin + Result := 0; + if Pointer(S) <> nil then + begin + P := Pointer(Integer(Pointer(S)) - AnsiRfOffset); + Result := Integer(P^); + end; +end; +{$ENDIF ~CLR} + +procedure StrResetLength(var S: AnsiString); +{$IFDEF CLR} +var + I: Integer; +{$ENDIF CLR} +begin + {$IFDEF CLR} + for I := 1 to Length(S) do + if S[I] = #0 then + begin + SetLength(S, I); + Exit; + end; + {$ELSE} + SetLength(S, StrLen(PAnsiChar(S))); + {$ENDIF CLR} +end; + +//=== String Search and Replace Routines ===================================== + +function StrCharCount(const S: AnsiString; C: AnsiChar): Integer; +var + I: Integer; +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): Integer; +var + I: Integer; +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): Integer; +var + I: Integer; +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; + +{$IFDEF CLR} +function StrCompare(const S1, S2: AnsiString): Integer; +begin + Result := AnsiCompareStr(S1, S2); +end; +{$ELSE} +{$IFDEF PIC} +function _StrCompare(const S1, S2: AnsiString): Integer; forward; + +function StrCompare(const S1, S2: AnsiString): Integer; +begin + Result := _StrCompare(S1, S2); +end; + +function _StrCompare(const S1, S2: AnsiString): Integer; assembler; +{$ELSE} +function StrCompare(const S1, S2: AnsiString): Integer; assembler; +{$ENDIF PIC} +asm + // check if pointers are equal + + CMP EAX, EDX + JE @@Equal + + // if S1 is nil return - Length(S2) + + TEST EAX, EAX + JZ @@Str1Null + + // if S2 is nil return Length(S1) + + TEST EDX, EDX + JZ @@Str2Null + + // EBX will hold case map, ESI S1, EDI S2 + + PUSH EBX + PUSH ESI + PUSH EDI + + // move AnsiString pointers + + MOV ESI, EAX + MOV EDI, EDX + + // get the length of strings + + MOV EAX, [ESI-AnsiStrRecSize].TAnsiStrRec.Length + MOV EDX, [EDI-AnsiStrRecSize].TAnsiStrRec.Length + + // exit if Length(S1) <> Length(S2) + + CMP EAX, EDX + JNE @@MissMatch + + // check the length just in case + + DEC EDX + JS @@InvalidStr + + DEC EAX + JS @@InvalidStr + + // load case map + + LEA EBX, AnsiCaseMap + + // make ECX our loop counter + + MOV ECX, EAX + + // clear working regs + + XOR EAX, EAX + XOR EDX, EDX + + // get last chars + + MOV AL, [ESI+ECX] + MOV DL, [EDI+ECX] + + // lower case them + + MOV AL, [EBX+EAX] + MOV DL, [EBX+EDX] + + // compare them + + CMP AL, DL + JNE @@MissMatch + + // if there was only 1 char then exit + + JECXZ @@Match + +@@NextChar: + // case sensitive compare of strings + + REPE CMPSB + JE @@Match + + // if there was a missmatch try case insensitive compare, get the chars + + MOV AL, [ESI-1] + MOV DL, [EDI-1] + + // lowercase and compare them, if equal then continue + + MOV AL, [EBX+EAX] + MOV DL, [EBX+EDX] + CMP AL, DL + JE @@NextChar + + // if we make it here then strings don't match, return the difference + +@@MissMatch: + SUB EAX, EDX + POP EDI + POP ESI + POP EBX + RET + +@@Match: + // match, return 0 + + XOR EAX, EAX + POP EDI + POP ESI + POP EBX + RET + +@@InvalidStr: + XOR EAX, EAX + DEC EAX + POP EDI + POP ESI + POP EBX + RET + +@@Str1Null: + // return = - Length(Str2); + + MOV EDX, [EDX-AnsiStrRecSize].TAnsiStrRec.Length + SUB EAX, EDX + RET + +@@Str2Null: + // return = Length(Str2); + + MOV EAX, [EAX-AnsiStrRecSize].TAnsiStrRec.Length + RET + +@@Equal: + XOR EAX, EAX +end; +{$ENDIF CLR} + +{$IFDEF CLR} +function StrCompareRange(const S1, S2: AnsiString; const Index, Count: Integer): Integer; +begin + Result := System.String.Compare(S1, Index - 1, S2, Index - 1, Count, False); +end; +{$ELSE} +function StrCompareRange(const S1, S2: AnsiString; const Index, Count: Integer): Integer; assembler; +asm + TEST EAX, EAX + JZ @@Str1Null + + TEST EDX, EDX + JZ @@StrNull + + DEC ECX + JS @@StrNull + + PUSH EBX + PUSH ESI + PUSH EDI + + MOV EBX, Count + DEC EBX + JS @@NoWork + + MOV ESI, EAX + MOV EDI, EDX + + MOV EDX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length + + // # of chars in S1 - (Index - 1) + SUB EDX, ECX + JLE @@NoWork + + // # of chars in S1 - (Count - 1) + SUB EDX, EBX + JLE @@NoWork + + // move to index'th char + ADD ESI, ECX + + MOV ECX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length + DEC ECX + JS @@NoWork + + // if Length(S2) > Count then ECX := Count else ECX := Length(S2) + + CMP ECX, EBX + JLE @@Skip1 + MOV ECX, EBX + +@@Skip1: + XOR EAX, EAX + XOR EDX, EDX + +@@Loop: + MOV AL, [ESI] + INC ESI + MOV DL, [EDI] + INC EDI + + CMP AL, DL + JNE @@MisMatch + + DEC ECX + JGE @@Loop + +@@Match: + XOR EAX, EAX + POP EDI + POP ESI + POP EBX + JMP @@Exit + +@@MisMatch: + SUB EAX, EDX + POP EDI + POP ESI + POP EBX + JMP @@Exit + +@@NoWork: + MOV EAX, -2 + POP EDI + POP ESI + POP EBX + JMP @@Exit + +@@Str1Null: + MOV EAX, 0 + TEST EDX, EDX + JZ @@Exit + +@@StrNull: + MOV EAX, -1 + +@@Exit: +end; +{$ENDIF CLR} + +function StrFillChar(const C: AnsiChar; Count: Integer): AnsiString; +begin + Assert(Count >= 0); + SetLength(Result, Count); + if (Count > 0) then + {$IFDEF CLR} + begin + Dec(Count); + while Count >= 0 do + Result[Count] := C; + end; + {$ELSE} + FillChar(Result[1], Count, Ord(C)); + {$ENDIF CLR} +end; + +{$IFDEF CLR} +function StrFillChar(const C: Char; Count: Integer): string; +var + sb: System.Text.StringBuilder; +begin + sb := System.Text.StringBuilder.Create(Count); + while Count > 0 do + begin + sb.Append(C); + Dec(Count); + end; + Result := sb.ToString(); +end; +{$ENDIF CLR} + +{$IFDEF CLR} +function StrFind(const Substr, S: AnsiString; const Index: Integer): Integer; +begin + Result := System.String(S).ToLower().IndexOf(System.String(SubStr).ToLower(), Index - 1) + 1; +end; +{$ELSE} +function StrFind(const Substr, S: AnsiString; const Index: Integer): Integer; assembler; +const + SearchChar: Byte = 0; + NumberOfChars: Integer = 0; +asm + // if SubStr = '' then Return := 0; + + TEST EAX, EAX + JZ @@SubstrIsNull + + // if Str = '' then Return := 0; + + TEST EDX, EDX + JZ @@StrIsNull + + // Index := Index - 1; if Index < 0 then Return := 0; + + DEC ECX + JL @@IndexIsSmall + + // EBX will hold the case table, ESI pointer to Str, EDI pointer + // to Substr and - # of chars in Substr to compare + + PUSH EBX + PUSH ESI + PUSH EDI + + // set the string pointers + + MOV ESI, EDX + MOV EDI, EAX + + // save the Index in EDX + + MOV EDX, ECX + + // temporary get the length of Substr and Str + + MOV EBX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length + MOV ECX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length + + // save the address of Str to compute the result + + PUSH ESI + + // dec the length of Substr because the first char is brought out of it + + DEC EBX + JS @@NotFound + + // #positions in Str to look at = Length(Str) - Length(Substr) - Index - 2 + + SUB ECX, EBX + JLE @@NotFound + + SUB ECX, EDX + JLE @@NotFound + + // # of chars in Substr to compare + + MOV NumberOfChars, EBX + + // point Str to Index'th char + + ADD ESI, EDX + + // load case map into EBX, and clear EAX + + LEA EBX, AnsiCaseMap + XOR EAX, EAX + XOR EDX, EDX + + // bring the first char out of the Substr and point Substr to the next char + + MOV DL, [EDI] + INC EDI + + // lower case it + + MOV DL, [EBX + EDX] + MOV SearchChar, DL + + JMP @@Find + +@@FindNext: + + // update the loop counter and check the end of AnsiString. + // if we reached the end, Substr was not found. + + DEC ECX + JL @@NotFound + +@@Find: + + // get current char from the AnsiString, and point Str to the next one + + MOV AL, [ESI] + INC ESI + + + // lower case current char + + MOV AL, [EBX + EAX] + + // does current char match primary search char? if not, go back to the main loop + + CMP AL, SearchChar + JNE @@FindNext + +@@Compare: + + // # of chars in Substr to compare + + MOV EDX, NumberOfChars + +@@CompareNext: + + // dec loop counter and check if we reached the end. If yes then we found it + + DEC EDX + JL @@Found + + // get the chars from Str and Substr, if they are equal then continue comparing + + MOV AL, [ESI + EDX] + CMP AL, [EDI + EDX] + JE @@CompareNext + + // otherwise try the reverse case. If they still don't match go back to the Find loop + + MOV AL, [EBX + EAX + AnsiReOffset] + CMP AL, [EDI + EDX] + JNE @@FindNext + + // if they matched, continue comparing + + JMP @@CompareNext + +@@Found: + // we found it, calculate the result + + MOV EAX, ESI + POP ESI + SUB EAX, ESI + + POP EDI + POP ESI + POP EBX + RET + +@@NotFound: + + // not found it, clear the result + + XOR EAX, EAX + POP ESI + POP EDI + POP ESI + POP EBX + RET + +@@IndexIsSmall: +@@StrIsNull: + + // clear the result + + XOR EAX, EAX + +@@SubstrIsNull: +@@Exit: +end; +{$ENDIF CLR} + +function StrHasPrefix(const S: AnsiString; const Prefixes: array of string): Boolean; +begin + Result := StrPrefixIndex(S, Prefixes) > -1; +end; + +function StrIndex(const S: AnsiString; const List: array of AnsiString): Integer; +var + I: Integer; +begin + Result := -1; + for I := Low(List) to High(List) do + begin + if AnsiSameText(S, List[I]) then + begin + Result := I; + Break; + end; + end; +end; + +function StrILastPos(const SubStr, S: AnsiString): Integer; +begin + Result := StrLastPos(StrUpper(SubStr), StrUpper(S)); +end; + +function StrIPos(const SubStr, S: AnsiString): integer; +begin + Result := Pos(AnsiUpperCase(SubStr), AnsiUpperCase(S)); +end; + +function StrIsOneOf(const S: AnsiString; const List: array of AnsiString): Boolean; +begin + Result := StrIndex(S, List) > -1; +end; + +function StrLastPos(const SubStr, S: AnsiString): Integer; +{$IFDEF CLR} +begin + Result := System.String(S).LastIndexOf(SubStr) + 1; +end; +{$ELSE} +var + Last, Current: PAnsiChar; +begin + Result := 0; + Last := nil; + Current := PAnsiChar(S); + + while (Current <> nil) and (Current^ <> #0) do + begin + Current := AnsiStrPos(PAnsiChar(Current), PAnsiChar(SubStr)); + if Current <> nil then + begin + Last := Current; + Inc(Current); + end; + end; + if Last <> nil then + Result := Abs((Longint(PAnsiChar(S)) - Longint(Last)) div SizeOf(AnsiChar)) + 1; +end; +{$ENDIF CLR} + +// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*) + +{$IFNDEF CLR} +function StrMatch(const Substr, S: AnsiString; const Index: Integer): Integer; assembler; +asm + // make sure that strings are not null + + TEST EAX, EAX + JZ @@SubstrIsNull + + TEST EDX, EDX + JZ @@StrIsNull + + // limit index to satisfy 1 <= index, and dec it + + DEC ECX + JL @@IndexIsSmall + + // EBX will hold the case table, ESI pointer to Str, EDI pointer + // to Substr and EBP # of chars in Substr to compare + + PUSH EBX + PUSH ESI + PUSH EDI + PUSH EBP + + // set the AnsiString pointers + + MOV ESI, EDX + MOV EDI, EAX + + // save the Index in EDX + + MOV EDX, ECX + + // save the address of Str to compute the result + + PUSH ESI + + // temporary get the length of Substr and Str + + MOV EBX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length + MOV ECX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length + + // dec the length of Substr because the first char is brought out of it + + DEC EBX + JS @@NotFound + + // #positions in Str to look at = Length(Str) - Length(Substr) - Index - 2 + + SUB ECX, EBX + JLE @@NotFound + + SUB ECX, EDX + JLE @@NotFound + + // # of chars in Substr to compare + + MOV EBP, EBX + + // point Str to Index'th char + + ADD ESI, EDX + + // load case map into EBX, and clear EAX & ECX + + LEA EBX, AnsiCaseMap + XOR EAX, EAX + XOR ECX, ECX + + // bring the first char out of the Substr and point Substr to the next char + + MOV CL, [EDI] + INC EDI + + // lower case it + + MOV CL, [EBX + ECX] + +@@FindNext: + + // get the current char from Str into al + + MOV AL, [ESI] + INC ESI + + // check the end of AnsiString + + TEST AL, AL + JZ @@NotFound + + + CMP CL, '*' // Wild Card? + JE @@Compare + + CMP CL, '?' // Wild Card? + JE @@Compare + + // lower case current char + + MOV AL, [EBX + EAX] + + // check if the current char matches the primary search char, + // if not continue searching + + CMP AL, CL + JNE @@FindNext + +@@Compare: + + // # of chars in Substr to compare } + + MOV EDX, EBP + +@@CompareNext: + + // dec loop counter and check if we reached the end. If yes then we found it + + DEC EDX + JL @@Found + + // get the chars from Str and Substr, if they are equal then continue comparing + + MOV AL, [EDI + EDX] // char from Substr + + CMP AL, '*' // wild card? + JE @@CompareNext + + CMP AL, '?' // wild card? + JE @@CompareNext + + CMP AL, [ESI + EDX] // equal to PAnsiChar(Str)^ ? + JE @@CompareNext + + MOV AL, [EBX + EAX + AnsiReOffset] // reverse case? + CMP AL, [ESI + EDX] + JNE @@FindNext // if still no, go back to the main loop + + // if they matched, continue comparing + + JMP @@CompareNext + +@@Found: + // we found it, calculate the result + + MOV EAX, ESI + POP ESI + SUB EAX, ESI + + POP EBP + POP EDI + POP ESI + POP EBX + RET + +@@NotFound: + + // not found it, clear the result + + XOR EAX, EAX + POP ESI + POP EBP + POP EDI + POP ESI + POP EBX + RET + +@@IndexIsSmall: +@@StrIsNull: + + // clear the result + + XOR EAX, EAX + +@@SubstrIsNull: +@@Exit: +end; + +// Derived from "Like" by Michael Winter + +function StrMatches(const Substr, S: AnsiString; const Index: Integer): Boolean; +var + StringPtr: PAnsiChar; + PatternPtr: PAnsiChar; + StringRes: PAnsiChar; + PatternRes: PAnsiChar; +begin + if SubStr = '' then + raise EJclStringError.CreateRes(@RsBlankSearchString); + + Result := SubStr = '*'; + + if Result or (S = '') then + Exit; + + 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; +{$ENDIF ~CLR} + +function StrNPos(const S, SubStr: AnsiString; N: Integer): Integer; +var + I, P: Integer; +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: Integer): Integer; +var + I, P: Integer; +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 string): Integer; +var + I: Integer; + Test: string; +begin + Result := -1; + for I := Low(Prefixes) to High(Prefixes) do + begin + Test := StrLeft(S, Length(Prefixes[I])); + if AnsiSameText(Test, Prefixes[I]) then + begin + Result := I; + Break; + end; + end; +end; + +{$IFDEF CLR} +function StrSearch(const Substr, S: AnsiString; const Index: Integer): Integer; +begin + Result := System.String(S).IndexOf(SubStr, Index - 1) + 1; +end; +{$ELSE} +function StrSearch(const Substr, S: AnsiString; const Index: Integer): Integer; assembler; +asm + // make sure that strings are not null + + TEST EAX, EAX + JZ @@SubstrIsNull + + TEST EDX, EDX + JZ @@StrIsNull + + // limit index to satisfy 1 <= index, and dec it + + DEC ECX + JL @@IndexIsSmall + + // ebp will hold # of chars in Substr to compare, esi pointer to Str, + // edi pointer to Substr, ebx primary search char + + PUSH EBX + PUSH ESI + PUSH EDI + PUSH EBP + + // set the AnsiString pointers + + MOV ESI, EDX + MOV EDI, EAX + + // save the (Index - 1) in edx + + MOV EDX, ECX + + // save the address of Str to compute the result + + PUSH ESI + + // temporary get the length of Substr and Str + + MOV EBX, [EDI-AnsiStrRecSize].TAnsiStrRec.Length + MOV ECX, [ESI-AnsiStrRecSize].TAnsiStrRec.Length + + // dec the length of Substr because the first char is brought out of it + + DEC EBX + JS @@NotFound + + // # of positions in Str to look at = Length(Str) - Length(Substr) - Index - 2 + + SUB ECX, EBX + JLE @@NotFound + + SUB ECX, EDX + JLE @@NotFound + + // point Str to Index'th char + + ADD ESI, EDX + + // # of chars in Substr to compare + + MOV EBP, EBX + + // clear EAX & ECX (working regs) + + XOR EAX, EAX + XOR EBX, EBX + + // bring the first char out of the Substr, and + // point Substr to the next char + + MOV BL, [EDI] + INC EDI + + // jump into the loop + + JMP @@Find + +@@FindNext: + + // update the loop counter and check the end of AnsiString. + // if we reached the end, Substr was not found. + + DEC ECX + JL @@NotFound + +@@Find: + + // get current char from the AnsiString, and /point Str to the next one. + MOV AL, [ESI] + INC ESI + + // does current char match primary search char? if not, go back to the main loop + + CMP AL, BL + JNE @@FindNext + + // otherwise compare SubStr + +@@Compare: + + // move # of char to compare into edx, edx will be our compare loop counter. + + MOV EDX, EBP + +@@CompareNext: + + // check if we reached the end of Substr. If yes we found it. + + DEC EDX + JL @@Found + + // get last chars from Str and SubStr and compare them, + // if they don't match go back to out main loop. + + MOV AL, [EDI+EDX] + CMP AL, [ESI+EDX] + JNE @@FindNext + + // if they matched, continue comparing + + JMP @@CompareNext + +@@Found: + // we found it, calculate the result and exit. + + MOV EAX, ESI + POP ESI + SUB EAX, ESI + + POP EBP + POP EDI + POP ESI + POP EBX + RET + +@@NotFound: + // not found it, clear result and exit. + + XOR EAX, EAX + POP ESI + POP EBP + POP EDI + POP ESI + POP EBX + RET + +@@IndexIsSmall: +@@StrIsNull: + // clear result and exit. + + XOR EAX, EAX + +@@SubstrIsNull: +@@Exit: +end; +{$ENDIF CLR} + +//=== String Extraction ====================================================== + +function StrAfter(const SubStr, S: AnsiString): AnsiString; +var + P: Integer; +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: Integer; +begin + P := StrFind(SubStr, S, 1); + if P <= 0 then + Result := S + else + Result := StrLeft(S, P - 1); +end; + + +function StrBetween(const S: AnsiString; const Start, Stop: AnsiChar): AnsiString; +var + PosStart, PosEnd: Integer; + L: Integer; +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: Integer): AnsiString; +begin + Result := Copy(S, 1, Length(S) - N); +end; + +function StrLeft(const S: AnsiString; Count: Integer): AnsiString; +begin + Result := Copy(S, 1, Count); +end; + +function StrMid(const S: AnsiString; Start, Count: Integer): AnsiString; +begin + Result := Copy(S, Start, Count); +end; + +function StrRestOf(const S: AnsiString; N: Integer ): AnsiString; +begin + Result := Copy(S, N, (Length(S) - N + 1)); +end; + +function StrRight(const S: AnsiString; Count: Integer): 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 CharIsLower(const C: AnsiChar): Boolean; +begin + Result := (AnsiCharTypes[C] and C1_LOWER) <> 0; +end; + +function CharIsNumberChar(const C: AnsiChar): Boolean; +begin + Result := ((AnsiCharTypes[C] and C1_DIGIT) <> 0) or + (C in AnsiSigns) or (C = DecimalSeparator); +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 CharIsWhiteSpace(const C: AnsiChar): Boolean; +begin + Result := C in AnsiWhiteSpace; +end; + +function CharType(const C: AnsiChar): Word; +begin + Result := AnsiCharTypes[C]; +end; + +{$IFNDEF CLR} +//=== PCharVector ============================================================ + +function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector; +var + I: Integer; + 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]; + List[I] := StrAlloc(Length(S) + SizeOf(AnsiChar)); + StrPCopy(List[I], S); + end; + List[Source.Count] := nil; + Move(List[0], Dest^, (Source.Count + 1) * SizeOf(PAnsiChar)); + Result := Dest; +end; + +function PCharVectorCount(Source: PCharVector): Integer; +var + P: PAnsiChar; +begin + Result := 0; + if Source <> nil then + begin + P := Source^; + while P <> nil do + begin + Inc(Result); + P := PCharVector(Longint(Source) + (SizeOf(PAnsiChar) * Result))^; + end; + end; +end; + +procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector); +var + I, Count: Integer; + 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: PCharVector); +var + I, Count: Integer; + 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 + StrDispose(List[I]); + FreeMem(Dest, (Count + 1) * SizeOf(PAnsiChar)); + Dest := nil; + end; +end; +{$ENDIF ~CLR} + +//=== Character Transformation Routines ====================================== + +function CharHex(const C: AnsiChar): Byte; +begin + Result := $FF; + if C in AnsiDecDigits then + Result := Ord(CharUpper(C)) - Ord('0') + else + begin + if C in AnsiHexDigits then + Result := Ord(CharUpper(C)) - (Ord('A')) + 10; + 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: Integer): Integer; +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: AnsiString; const C: AnsiChar; const Index: Integer): Integer; +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: AnsiString; C: AnsiChar; const Index: Integer): Integer; +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): Integer; +{$IFDEF CLR} +var + I: Integer; +begin + Result := 0; + for I := 1 to Length(S) do + if S[I] = Search then + begin + S[I] := Replace; + Inc(Result); + end; +end; +{$ELSE} +var + P: PAnsiChar; + Index, Len: Integer; +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; +{$ENDIF CLR} + +{$IFNDEF CLR} +//=== MultiSz ================================================================ + +function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz; +var + I, TotalLength: Integer; + 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(PAnsiChar(Source[I])) + 1); + AllocateMultiSz(Dest, TotalLength); + P := Dest; + for I := 0 to Source.Count - 1 do + begin + P := StrECopy(P, PAnsiChar(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): Integer; +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: Integer); +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: Integer; +begin + if Source <> nil then + begin + Len := MultiSzLength(Source); + AllocateMultiSz(Result, Len); + Move(Source^, Result^, Len * SizeOf(Char)); + end + else + Result := nil; +end; + +function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): 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 EJclStringError.CreateRes(@RsInvalidEmptyStringItem) + else + Inc(TotalLength, StrLenW(PWideChar(Source[I])) + 1); + AllocateWideMultiSz(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 WideMultiSzToWideStrings(const Dest: TWideStrings; 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 WideMultiSzLength(const Source: PWideMultiSz): Integer; +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 AllocateWideMultiSz(var Dest: PWideMultiSz; Len: Integer); +begin + if Len > 0 then + GetMem(Dest, Len * SizeOf(WideChar)) + else + Dest := nil; +end; + +procedure FreeWideMultiSz(var Dest: PWideMultiSz); +begin + if Dest <> nil then + FreeMem(Dest); + Dest := nil; +end; + +function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz; +var + Len: Integer; +begin + if Source <> nil then + begin + Len := WideMultiSzLength(Source); + AllocateWideMultiSz(Result, Len); + Move(Source^, Result^, Len * SizeOf(WideChar)); + end + else + Result := nil; +end; +{$ENDIF ~CLR} + +//=== TStrings Manipulation ================================================== + +procedure StrToStrings(S, Sep: AnsiString; const List: TStrings; const AllowEmptyString: Boolean = True); +var + I, L: Integer; + 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 <> '' then + List.Add(S); // Ignore empty strings at the end. + finally + List.EndUpdate; + end; +end; + +procedure StrIToStrings(S, Sep: AnsiString; const List: TStrings; const AllowEmptyString: Boolean = True); +var + I, L: Integer; + LowerCaseStr: string; + 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 <> '' then + List.Add(S); // Ignore empty strings at the end. + finally + List.EndUpdate; + end; +end; + +function StringsToStr(const List: TStrings; const Sep: AnsiString; const AllowEmptyString: Boolean): AnsiString; +var + I, L: Integer; +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: TStrings; DeleteIfEmpty: Boolean); +var + I: Integer; +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: Integer; +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: Integer; +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 BooleanToStr(B: Boolean): AnsiString; +const + Bools: array [Boolean] of AnsiString = ('False', 'True'); +begin + Result := Bools[B]; +end; + +function FileToString(const FileName: AnsiString): AnsiString; +var + fs: TFileStream; + Len: Integer; + {$IFDEF CLR} + Buf: array of Byte; + {$ENDIF CLR} +begin + fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + Len := fs.Size; + SetLength(Result, Len); + if Len > 0 then + {$IFDEF CLR} + begin + SetLength(Buf, Len); + fs.ReadBuffer(Buf, Len); + Result := Buf; + end; + {$ELSE} + fs.ReadBuffer(Result[1], Len); + {$ENDIF CLR} + finally + fs.Free; + end; +end; + +procedure StringToFile(const FileName: AnsiString; const Contents: AnsiString); +var + fs: TFileStream; + Len: Integer; +begin + fs := TFileStream.Create(FileName, fmCreate); + try + Len := Length(Contents); + if Len > 0 then + {$IFDEF CLR} + fs.WriteBuffer(BytesOf(Contents), Len); + {$ELSE} + fs.WriteBuffer(Contents[1], Len); + {$ENDIF CLR} + finally + fs.Free; + end; +end; + +function StrToken(var S: AnsiString; Separator: AnsiChar): AnsiString; +var + I: Integer; +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; + +{$IFNDEF CLR} +procedure StrTokens(const S: AnsiString; const List: TStrings); +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: TStrings); +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(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 (S^ in [AnsiSpace, AnsiLineFeed, AnsiCarriageReturn]) do + Inc(S); + end; + else + if Start = nil then + Start := S; + Inc(S); + end; + end; +end; +{$ENDIF ~CLR} + +function StrToFloatSafe(const S: AnsiString): Float; +var + Temp: AnsiString; + I, J, K: Integer; + SwapSeparators, IsNegative: Boolean; + DecSep: AnsiChar; + ThouSep: AnsiChar; +begin + {$IFDEF CLR} + DecSep := AnsiChar(DecimalSeparator[1]); + ThouSep := AnsiChar(ThousandSeparator[1]); + {$ELSE} + DecSep := DecimalSeparator; + ThouSep := ThousandSeparator; + {$ENDIF CLR} + 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(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: integer; var Index: integer; var Count: integer); overload; +begin + Index := Max(1, Min(Index, StrLen+1)); + Count := Max(0, Min(Count, StrLen+1 - Index)); +end; + +{$IFDEF CLR} +function ArrayOf(List: TStrings): TDynStringArray; +var + I: Integer; +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; +{$ENDIF CLR} + +initialization + LoadCharTypes; // this table first + LoadCaseMap; // or this function does not work + +// History: + +// MT: + +// - StrIToStrings default parameter now true +// - StrToStrings default parameter now true +// - Rewrote StrSmartCase to fix a bug. +// - Fixed a bug in StrIsAlphaNumUnderscore +// - Fixed a bug in StrIsSubset +// - Simplified StrLower +// - Fixed a bug in StrRepeatLength +// - Fixed a bug in StrLastPos +// - Added function StrTrimCharsRight (Leonard Wennekers) +// - Added function StrTrimCharsLeft (Leonard Wennekers) +// - Added StrNormIndex function (Alexander Radchenko) +// - Changed Assert in StrTokens/ to If List <> nil +// - Deleted an commented out version of StrReplace. If anyone ever want to finish the old +// version please go the archive version 0.39 +// - Modified StrFillChar a little bit (added an if for count > 0) +// - StrCharPosLower (Jean-Fabien Connault) +// - StrCharPosUpper (Jean-Fabien Connault) +// - Changed to 100 chars per line style +// - Note to Marcel: Have a look at StrToStrings and StrItoStrings. They are untested but +// should work more or less equal to the BreakApart functions by JFC. +// - Changed StrNPos for special case +// - Changed StrIPos for special case +// - Fixed a bug in CharPos : didn'T work if index = length(s) +// - Fixed a bug in CharIPos : didn'T work if index = length(s) + +// 2003-02-25, Robert Rossmair +// - Linux port (implemented LoadCharTypes & LoadCaseMap) + +// 2002-01-20, Marcel van Brakel +// - added StrIToStrings to interface section +// - added AllowEmptyString parameter to StringsToStr function +// - added AddStringToStrings() by Jeff + +// $Log: JclAnsiStrings.pas,v $ +// Revision 1.3 2005/10/25 12:52:23 outchy +// First corrections of IT#3259. +// StrReplace, StrLastPos, StrMatches are NOT fixed. +// +// Revision 1.2 2005/08/09 10:30:21 ahuser +// JCL.NET changes +// +// Revision 1.1 2005/05/05 20:31:01 ahuser +// JCL.NET support +// +// Revision 1.37 2005/03/08 16:10:08 marquardt +// standard char sets extended and used, some optimizations for string literals +// +// Revision 1.36 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.35 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.34 2005/02/05 03:45:35 rrossmair +// - fixed issue #0002455 (Calculation of ResultLength inappropriate in StrReplace) +// +// Revision 1.33 2005/01/06 18:48:31 marquardt +// AnsiLineBreak, AnsiLineFeed, AnsiCarriageReturn, AnsiCrLf moved to JclBase JclStrings now reexports the names +// +// Revision 1.32 2004/12/23 04:31:43 rrossmair +// - check-in for JCL 1.94 RC 1 +// +// Revision 1.31 2004/10/18 04:54:42 marquardt +// remove PH contributor +// +// Revision 1.30 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.29 2004/10/11 14:54:38 marquardt +// MultiSz finetuning +// +// Revision 1.28 2004/10/11 08:13:03 marquardt +// cleaning of JclStrings +// +// Revision 1.27 2004/10/10 12:52:12 marquardt +// DestroyEnvironmentBlock introduced +// +// Revision 1.26 2004/09/30 13:11:27 marquardt +// remove contributions +// +// Revision 1.25 2004/09/30 07:50:29 marquardt +// remove contributions +// +// Revision 1.24 2004/08/03 07:22:37 marquardt +// resourcestring cleanup +// +// Revision 1.23 2004/07/30 07:20:25 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate +// +// Revision 1.22 2004/06/14 06:24:52 marquardt +// style cleaning IFDEF +// +// Revision 1.21 2004/05/30 23:54:42 rrossmair +// Processed documentation TODOs +// +// Revision 1.20 2004/05/08 08:44:17 rrossmair +// introduced & applied symbol HAS_UNIT_LIBC +// +// Revision 1.19 2004/05/06 16:22:27 rrossmair +// fixed LoadCaseMap for Kylix +// +// Revision 1.18 2004/05/06 05:09:55 rrossmair +// Changes for FPC v1.9.4 compatibility +// +// Revision 1.17 2004/05/05 00:11:24 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.16 2004/04/19 06:12:34 rrossmair +// AddStringToStrings help TODO done +// +// Revision 1.15 2004/04/14 20:39:59 mthoma +// Reintroduced StrIsNumber as StrConsistsofNumberChars, copied local function StrEndW from JclUnicode to get rid of that dependency. +// +// Revision 1.14 2004/04/12 22:07:45 +// Bugfix: StringsToMultiString, MultiStringToStrings, +// empty list entries are not allowed +// Add: StringsToMultiWideString, MultiWideStringToStrings +// +// Revision 1.13 2004/04/11 15:58:25 mthoma +// Fixed #1119. Removed StrIsNumber (see bugnote), renamed CharIsNumber to CharisNumberChar. Changed some Strings to AnsiString (unit now compiles also in H- mode). +// +// Revision 1.12 2004/04/09 20:35:14 mthoma +// Added StrLastPos. changed $Data$ to $Date: 2005/10/25 12:52:23 $ +// +// Revision 1.11 2004/04/08 19:40:26 mthoma +// Fixed 0000947, 0001060 (StrBetween with same start/end symbol problem). Added a note to the docs. +// +// Revision 1.10 2004/04/06 04:31:32 +// Add functions for String <--> MultiString conversion +// + +end. diff --git a/official/1.96/source/common/JclArrayLists.pas b/official/1.96/source/common/JclArrayLists.pas new file mode 100644 index 0000000..9366af6 --- /dev/null +++ b/official/1.96/source/common/JclArrayLists.pas @@ -0,0 +1,2068 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:42 $ +// For history see end of file + +unit JclArrayLists; + +{$I jcl.inc} + +interface + +uses + Classes, + JclBase, JclAbstractContainers, JclContainerIntf; + +type + TJclIntfArrayList = class(TJclAbstractContainer, IJclIntfCollection, + IJclIntfList, IJclIntfArray, IJclIntfCloneable) + private + FElementData: TDynIInterfaceArray; + FSize: Integer; + FCapacity: Integer; + procedure SetCapacity(ACapacity: Integer); + protected + procedure Grow; virtual; + { IJclIntfCollection } + function Add(AInterface: IInterface): Boolean; overload; + function AddAll(ACollection: IJclIntfCollection): Boolean; overload; + procedure Clear; + function Contains(AInterface: IInterface): Boolean; + function ContainsAll(ACollection: IJclIntfCollection): Boolean; + function Equals(ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(AInterface: IInterface): Boolean; overload; + function RemoveAll(ACollection: IJclIntfCollection): Boolean; + function RetainAll(ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + { IJclIntfList } + procedure Insert(Index: Integer; AInterface: IInterface); overload; + function InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; overload; + function GetObject(Index: Integer): IInterface; + function IndexOf(AInterface: IInterface): Integer; + function LastIndexOf(AInterface: IInterface): Integer; + function Remove(Index: Integer): IInterface; overload; + procedure SetObject(Index: Integer; AInterface: IInterface); + function SubList(First, Count: Integer): IJclIntfList; + { IJclIntfCloneable } + function Clone: IInterface; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); overload; + constructor Create(ACollection: IJclIntfCollection); overload; + destructor Destroy; override; + property Capacity: Integer read FCapacity write SetCapacity; + end; + + //Daniele Teti 02/03/2005 + TJclStrArrayList = class(TJclStrCollection, IJclStrList, IJclStrArray, IJclCloneable) + private + FCapacity: Integer; + FElementData: TDynStringArray; + FSize: Integer; + procedure SetCapacity(ACapacity: Integer); + protected + procedure Grow; virtual; + { IJclStrCollection } + function Add(const AString: string): Boolean; overload; override; + function AddAll(ACollection: IJclStrCollection): Boolean; overload; override; + procedure Clear; override; + function Contains(const AString: string): Boolean; override; + function ContainsAll(ACollection: IJclStrCollection): Boolean; override; + function Equals(ACollection: IJclStrCollection): Boolean; override; + function First: IJclStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclStrIterator; override; + function Remove(const AString: string): Boolean; overload; override; + function RemoveAll(ACollection: IJclStrCollection): Boolean; override; + function RetainAll(ACollection: IJclStrCollection): Boolean; override; + function Size: Integer; override; + { IJclStrList } + procedure Insert(Index: Integer; const AString: string); overload; + function InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; overload; + function GetString(Index: Integer): string; + function IndexOf(const AString: string): Integer; + function LastIndexOf(const AString: string): Integer; + function Remove(Index: Integer): string; overload; + procedure SetString(Index: Integer; const AString: string); + function SubList(First, Count: Integer): IJclStrList; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); overload; + constructor Create(ACollection: IJclStrCollection); overload; + destructor Destroy; override; + { IJclCloneable } + function Clone: TObject; + property Capacity: Integer read FCapacity write SetCapacity; + end; + + TJclArrayList = class(TJclAbstractContainer, IJclCollection, IJclList, + IJclArray, IJclCloneable) + private + FCapacity: Integer; + FElementData: TDynObjectArray; + FOwnsObjects: Boolean; + FSize: Integer; + procedure SetCapacity(ACapacity: Integer); + protected + procedure Grow; virtual; + procedure FreeObject(var AObject: TObject); + { IJclCollection } + function Add(AObject: TObject): Boolean; overload; + function AddAll(ACollection: IJclCollection): Boolean; overload; + procedure Clear; + function Contains(AObject: TObject): Boolean; + function ContainsAll(ACollection: IJclCollection): Boolean; + function Equals(ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; overload; + function RemoveAll(ACollection: IJclCollection): Boolean; + function RetainAll(ACollection: IJclCollection): Boolean; + function Size: Integer; + { IJclList } + procedure Insert(Index: Integer; AObject: TObject); overload; + function InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; overload; + function GetObject(Index: Integer): TObject; + function IndexOf(AObject: TObject): Integer; + function LastIndexOf(AObject: TObject): Integer; + function Remove(Index: Integer): TObject; overload; + procedure SetObject(Index: Integer; AObject: TObject); + function SubList(First, Count: Integer): IJclList; + { IJclCloneable } + function Clone: TObject; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity; AOwnsObjects: Boolean = True); overload; + constructor Create(ACollection: IJclCollection; AOwnsObjects: Boolean = True); overload; + destructor Destroy; override; + property Capacity: Integer read FCapacity write SetCapacity; + property OwnsObjects: Boolean read FOwnsObjects; + end; + +implementation + +uses + SysUtils, + JclResources; + +//=== { TIntfItr } =========================================================== + +type + TIntfItr = class(TJclAbstractContainer, IJclIntfIterator) + private + FCursor: Integer; + FOwnList: TJclIntfArrayList; + //FLastRet: Integer; + FSize: Integer; + protected + { IJclIntfIterator} + procedure Add(AInterface: IInterface); + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AInterface: IInterface); + public + constructor Create(AOwnList: TJclIntfArrayList); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TIntfItr.Create(AOwnList: TJclIntfArrayList); +begin + inherited Create; + FCursor := 0; + FOwnList := AOwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} + //FLastRet := -1; + FSize := FOwnList.Size; +end; + +{$IFNDEF CLR} +destructor TIntfItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TIntfItr.Add(AInterface: IInterface); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + // inlined FOwnList.Add + if FOwnList.FSize = FOwnList.Capacity then + FOwnList.Grow; + if FOwnList.FSize <> FCursor then + MoveArray(FOwnList.FElementData, FCursor, FCursor + 1, FOwnList.FSize - FCursor); + FOwnList.FElementData[FCursor] := AInterface; + Inc(FOwnList.FSize); + + Inc(FSize); + Inc(FCursor); + //FLastRet := -1; +end; + +function TIntfItr.GetObject: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FOwnList.FElementData[FCursor]; +end; + +function TIntfItr.HasNext: Boolean; +begin + Result := FCursor < FSize; +end; + +function TIntfItr.HasPrevious: Boolean; +begin + Result := FCursor > 0; +end; + +function TIntfItr.Next: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FOwnList.FElementData[FCursor]; + //FLastRet := FCursor; + Inc(FCursor); +end; + +function TIntfItr.NextIndex: Integer; +begin + Result := FCursor; +end; + +function TIntfItr.Previous: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Dec(FCursor); + //FLastRet := FCursor; + Result := FOwnList.FElementData[FCursor]; +end; + +function TIntfItr.PreviousIndex: Integer; +begin + Result := FCursor - 1; +end; + +procedure TIntfItr.Remove; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + with FOwnList do + begin + FElementData[FCursor] := nil; // Force Release + if FSize <> FCursor then + MoveArray(FElementData, FCursor + 1, FCursor, FSize - FCursor); + end; + Dec(FOwnList.FSize); + Dec(FSize); +end; + +procedure TIntfItr.SetObject(AInterface: IInterface); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + { + if FLastRet = -1 then + raise EJclIllegalState.Create(SIllegalState); + } +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + FOwnList.FElementData[FCursor] := AInterface; +end; + +//=== { TStrItr } ============================================================ + +type + TStrItr = class(TJclAbstractContainer, IJclStrIterator) + private + FCursor: Integer; + FOwnList: TJclStrArrayList; + //FLastRet: Integer; + FSize: Integer; + protected + { IJclStrIterator} + procedure Add(const AString: string); + function GetString: string; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: string; + function NextIndex: Integer; + function Previous: string; + function PreviousIndex: Integer; + procedure Remove; + procedure SetString(const AString: string); + public + constructor Create(AOwnList: TJclStrArrayList); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TStrItr.Create(AOwnList: TJclStrArrayList); +begin + inherited Create; + FCursor := 0; + FOwnList := AOwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} + //FLastRet := -1; + FSize := FOwnList.Size; +end; + +{$IFNDEF CLR} +destructor TStrItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TStrItr.Add(const AString: string); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + // inlined FOwnList.Add + if FOwnList.FSize = FOwnList.Capacity then + FOwnList.Grow; + if FOwnList.FSize <> FCursor then + MoveArray(FOwnList.FElementData, FCursor, FCursor + 1, FOwnList.FSize - FCursor); + FOwnList.FElementData[FCursor] := AString; + Inc(FOwnList.FSize); + + Inc(FSize); + Inc(FCursor); + //FLastRet := -1; +end; + +function TStrItr.GetString: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FOwnList.FElementData[FCursor]; +end; + +function TStrItr.HasNext: Boolean; +begin + Result := FCursor < FSize; +end; + +function TStrItr.HasPrevious: Boolean; +begin + Result := FCursor > 0; +end; + +function TStrItr.Next: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FOwnList.FElementData[FCursor]; + //FLastRet := FCursor; + Inc(FCursor); +end; + +function TStrItr.NextIndex: Integer; +begin + Result := FCursor; +end; + +function TStrItr.Previous: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Dec(FCursor); + //FLastRet := FCursor; + Result := FOwnList.FElementData[FCursor]; +end; + +function TStrItr.PreviousIndex: Integer; +begin + Result := FCursor - 1; +end; + +procedure TStrItr.Remove; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + with FOwnList do + begin + FElementData[FCursor] := ''; // Force Release + if FSize <> FCursor then + MoveArray(FElementData, FCursor + 1, FCursor, FSize - FCursor); + end; + Dec(FOwnList.FSize); + Dec(FSize); +end; + +procedure TStrItr.SetString(const AString: string); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + { + if FLastRet = -1 then + raise EJclIllegalState.Create(SIllegalState); + } +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + FOwnList.FElementData[FCursor] := AString; +end; + +//=== { TItr } =============================================================== + +type + TItr = class(TJclAbstractContainer, IJclIterator) + private + FCursor: Integer; + FOwnList: TJclArrayList; + //FLastRet: Integer; + FSize: Integer; + protected + { IJclIterator} + procedure Add(AObject: TObject); + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AObject: TObject); + public + constructor Create(AOwnList: TJclArrayList); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TItr.Create(AOwnList: TJclArrayList); +begin + inherited Create; + FCursor := 0; + FOwnList := AOwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} + //FLastRet := -1; + FSize := FOwnList.Size; +end; + +{$IFNDEF CLR} +destructor TItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TItr.Add(AObject: TObject); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + // inlined FOwnList.Add + if FOwnList.FSize = FOwnList.Capacity then + FOwnList.Grow; + if FOwnList.FSize <> FCursor then + MoveArray(FOwnList.FElementData, FCursor, FCursor + 1, FOwnList.FSize - FCursor); + FOwnList.FElementData[FCursor] := AObject; + Inc(FOwnList.FSize); + + Inc(FSize); + Inc(FCursor); + //FLastRet := -1; +end; + +function TItr.GetObject: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FOwnList.FElementData[FCursor]; +end; + +function TItr.HasNext: Boolean; +begin + Result := FCursor <> FSize; +end; + +function TItr.HasPrevious: Boolean; +begin + Result := FCursor > 0; +end; + +function TItr.Next: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FOwnList.FElementData[FCursor]; + //FLastRet := FCursor; + Inc(FCursor); +end; + +function TItr.NextIndex: Integer; +begin + Result := FCursor; +end; + +function TItr.Previous: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Dec(FCursor); + //FLastRet := FCursor; + Result := FOwnList.FElementData[FCursor]; +end; + +function TItr.PreviousIndex: Integer; +begin + Result := FCursor - 1; +end; + +procedure TItr.Remove; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + with FOwnList do + begin + FreeObject(FElementData[FCursor]); + if FSize <> FCursor then + MoveArray(FElementData, FCursor + 1, FCursor, FSize - FCursor); + end; + Dec(FOwnList.FSize); + Dec(FSize); +end; + +procedure TItr.SetObject(AObject: TObject); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + FOwnList.FElementData[FCursor] := AObject; +end; + +//=== { TJclIntfArrayList } ================================================== + +constructor TJclIntfArrayList.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FSize := 0; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FElementData, FCapacity); +end; + +constructor TJclIntfArrayList.Create(ACollection: IJclIntfCollection); +begin + // (rom) disabled because the following Create already calls inherited + // inherited Create; + if ACollection = nil then + {$IFDEF CLR} + raise EJclIllegalArgumentError.Create(RsENoCollection); + {$ELSE} + raise EJclIllegalArgumentError.CreateRes(@RsENoCollection); + {$ENDIF CLR} + Create(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclIntfArrayList.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclIntfArrayList.Insert(Index: Integer; AInterface: IInterface); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index > FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if FSize = Capacity then + Grow; + if FSize <> Index then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AInterface; + Inc(FSize); +end; + +function TJclIntfArrayList.InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + Size: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if ACollection = nil then + Exit; + Size := ACollection.Size; + if FSize + Size >= Capacity then + Capacity := FSize + Size; + if Size <> 0 then + MoveArray(FElementData, Index, Index + Size, Size); + It := ACollection.First; + Result := It.HasNext; + while It.HasNext do + begin + FElementData[Index] := It.Next; + Inc(Index); + end; +end; + +function TJclIntfArrayList.Add(AInterface: IInterface): Boolean; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if FSize = Capacity then + Grow; + {$IFNDEF CLR} + FillChar(FElementData[FSize], SizeOf(IInterface), 0); + {$ENDIF ~CLR} + FElementData[FSize] := AInterface; + Inc(FSize); + Result := True; +end; + +function TJclIntfArrayList.AddAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + begin + // (rom) inlining Add() gives about 5 percent performance increase + if FSize = Capacity then + Grow; + {$IFNDEF CLR} + FillChar(FElementData[FSize], SizeOf(IInterface), 0); + {$ENDIF ~CLR} + FElementData[FSize] := It.Next; + Inc(FSize); + end; + Result := True; +end; + +procedure TJclIntfArrayList.Clear; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FElementData[I] := nil; + FSize := 0; +end; + +function TJclIntfArrayList.Clone: IInterface; +var + NewList: IJclIntfList; +begin + NewList := TJclIntfArrayList.Create(Capacity); + NewList.AddAll(Self); + Result := NewList; +end; + +function TJclIntfArrayList.Contains(AInterface: IInterface): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + for I := 0 to FSize - 1 do + if FElementData[I] = AInterface then + begin + Result := True; + Break; + end; +end; + +function TJclIntfArrayList.ContainsAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := contains(It.Next); +end; + +function TJclIntfArrayList.Equals(ACollection: IJclIntfCollection): Boolean; +var + I: Integer; + It: IJclIntfIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$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 FElementData[I] <> It.Next then + Exit; + Result := True; +end; + +function TJclIntfArrayList.GetObject(Index: Integer): IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + Result := nil + else + Result := FElementData[Index]; +end; + +procedure TJclIntfArrayList.SetCapacity(ACapacity: Integer); +begin + if ACapacity >= FSize then + begin + SetLength(FElementData, ACapacity); + FCapacity := ACapacity; + end + else + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} +end; + +procedure TJclIntfArrayList.Grow; +begin + if Capacity > 64 then + Capacity := Capacity + Capacity div 4 + else if FCapacity = 0 then + FCapacity := 64 + else + Capacity := Capacity * 4; +end; + +function TJclIntfArrayList.IndexOf(AInterface: IInterface): Integer; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AInterface = nil then + Exit; + for I := 0 to FSize - 1 do + if FElementData[I] = AInterface then + begin + Result := I; + Break; + end; +end; + +function TJclIntfArrayList.First: IJclIntfIterator; +begin + Result := TIntfItr.Create(Self); +end; + +function TJclIntfArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfArrayList.Last: IJclIntfIterator; +var + NewIterator: TIntfItr; +begin + NewIterator := TIntfItr.Create(Self); + NewIterator.FCursor := NewIterator.FOwnList.FSize; + NewIterator.FSize := NewIterator.FOwnList.FSize; + Result := NewIterator; +end; + +function TJclIntfArrayList.LastIndexOf(AInterface: IInterface): Integer; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AInterface = nil then + Exit; + for I := FSize - 1 downto 0 do + if FElementData[I] = AInterface then + begin + Result := I; + Break; + end; +end; + +function TJclIntfArrayList.Remove(AInterface: IInterface): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + for I := FSize - 1 downto 0 do + if FElementData[I] = AInterface then // Removes all AInterface + begin + FElementData[I] := nil; // Force Release + if FSize <> I then + MoveArray(FElementData, I + 1, I, FSize - I); + Dec(FSize); + Result := True; + end; +end; + +function TJclIntfArrayList.Remove(Index: Integer): IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + Result := FElementData[Index]; + FElementData[Index] := nil; + if FSize <> Index then + MoveArray(FElementData, Index + 1, Index, FSize - Index); + Dec(FSize); +end; + +function TJclIntfArrayList.RemoveAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclIntfArrayList.RetainAll(ACollection: IJclIntfCollection): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Remove(I); +end; + +procedure TJclIntfArrayList.SetObject(Index: Integer; AInterface: IInterface); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + FElementData[Index] := AInterface; +end; + +function TJclIntfArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfArrayList.SubList(First, Count: Integer): IJclIntfList; +var + I: Integer; + Last: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := TJclIntfArrayList.Create(Count); + for I := First to Last do + Result.Add(FElementData[I]); +end; + +//=== { TJclStrArrayList } =================================================== + +constructor TJclStrArrayList.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FSize := 0; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FElementData, FCapacity); +end; + +constructor TJclStrArrayList.Create(ACollection: IJclStrCollection); +begin + // (rom) disabled because the following Create already calls inherited + // inherited Create; + if ACollection = nil then + {$IFDEF CLR} + raise EJclIllegalArgumentError.Create(RsENoCollection); + {$ELSE} + raise EJclIllegalArgumentError.CreateRes(@RsENoCollection); + {$ENDIF CLR} + Create(ACollection.Size); + AddAll(ACollection); +end; + +destructor TJclStrArrayList.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclStrArrayList.Insert(Index: Integer; const AString: string); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index > FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if FSize = Capacity then + Grow; + if FSize <> Index then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AString; + Inc(FSize); +end; + +function TJclStrArrayList.InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; + Size: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + + if ACollection = nil then + Exit; + Size := ACollection.Size; + if FSize + Size >= Capacity then + begin + Capacity := FSize + Size; + FSize := Capacity; + end; + if Size <> 0 then + MoveArray(FElementData, Index, Index + Size, Size); + It := ACollection.First; + Result := It.HasNext; + while It.HasNext do + begin + FElementData[Index] := It.Next; + Inc(Index); + end; +end; + +function TJclStrArrayList.Add(const AString: string): Boolean; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if FSize = Capacity then + Grow; + {$IFNDEF CLR} + FillChar(FElementData[FSize], SizeOf(string), 0); + {$ENDIF ~CLR} + FElementData[FSize] := AString; + Inc(FSize); + Result := True; +end; + +function TJclStrArrayList.AddAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + begin + // (rom) inlining Add() gives about 5 percent performance increase + // without THREADSAFE and about 30 percent with THREADSAFE + if FSize = Capacity then + Grow; + {$IFNDEF CLR} + FillChar(FElementData[FSize], SizeOf(string), 0); + {$ENDIF ~CLR} + FElementData[FSize] := It.Next; + Inc(FSize); + end; + Result := True; +end; + +procedure TJclStrArrayList.Clear; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FElementData[I] := ''; + FSize := 0; +end; + +function TJclStrArrayList.Clone: TObject; +var + NewList: TJclStrArrayList; +begin + NewList := TJclStrArrayList.Create(Capacity); + NewList.AddAll(Self); + Result := NewList; +end; + +function TJclStrArrayList.Contains(const AString: string): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + for I := 0 to FSize - 1 do + if FElementData[I] = AString then + begin + Result := True; + Break; + end; +end; + +function TJclStrArrayList.ContainsAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := contains(It.Next); +end; + +function TJclStrArrayList.Equals(ACollection: IJclStrCollection): Boolean; +var + I: Integer; + It: IJclStrIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$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 FElementData[I] <> It.Next then + Exit; + Result := True; +end; + +function TJclStrArrayList.First: IJclStrIterator; +begin + Result := TStrItr.Create(Self); +end; + +function TJclStrArrayList.GetString(Index: Integer): string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + Result := '' + else + Result := FElementData[Index]; +end; + +procedure TJclStrArrayList.SetCapacity(ACapacity: Integer); +begin + if ACapacity >= FSize then + begin + SetLength(FElementData, ACapacity); + FCapacity := ACapacity; + end + else + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} +end; + +procedure TJclStrArrayList.Grow; +begin + if Capacity > 64 then + Capacity := Capacity + Capacity div 4 + else if FCapacity = 0 then + FCapacity := 64 + else + Capacity := Capacity * 4; +end; + +function TJclStrArrayList.IndexOf(const AString: string): Integer; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AString = '' then + Exit; + for I := 0 to FSize - 1 do + if FElementData[I] = AString then + begin + Result := I; + Break; + end; +end; + +function TJclStrArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclStrArrayList.Last: IJclStrIterator; +var + NewIterator: TStrItr; +begin + NewIterator := TStrItr.Create(Self); + NewIterator.FCursor := NewIterator.FOwnList.FSize; + NewIterator.FSize := NewIterator.FOwnList.FSize; + Result := NewIterator; +end; + +function TJclStrArrayList.LastIndexOf(const AString: string): Integer; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AString = '' then + Exit; + for I := FSize - 1 downto 0 do + if FElementData[I] = AString then + begin + Result := I; + Break; + end; +end; + +function TJclStrArrayList.Remove(const AString: string): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + for I := FSize - 1 downto 0 do + if FElementData[I] = AString then // Removes all AString + begin + FElementData[I] := ''; // Force Release + if FSize <> I then + MoveArray(FElementData, I + 1, I, FSize - I); + Dec(FSize); + Result := True; + end; +end; + +function TJclStrArrayList.Remove(Index: Integer): string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + Result := FElementData[Index]; + FElementData[Index] := ''; + if FSize <> Index then + MoveArray(FElementData, Index + 1, Index, FSize - Index); + Dec(FSize); +end; + +function TJclStrArrayList.RemoveAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclStrArrayList.RetainAll(ACollection: IJclStrCollection): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + for I := FSize - 1 downto 0 do + if not ACollection.Contains(FElementData[I]) then + Remove(I); +end; + +procedure TJclStrArrayList.SetString(Index: Integer; const AString: string); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + FElementData[Index] := AString +end; + +function TJclStrArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclStrArrayList.SubList(First, Count: Integer): IJclStrList; +var + I: Integer; + Last: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := TJclStrArrayList.Create(Count); + for I := First to Last do + Result.Add(FElementData[I]); +end; + +//=== { TJclArrayList } ====================================================== + +constructor TJclArrayList.Create(ACapacity: Integer = DefaultContainerCapacity; + AOwnsObjects: Boolean = True); +begin + inherited Create; + FSize := 0; + FOwnsObjects := AOwnsObjects; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FElementData, FCapacity); +end; + +constructor TJclArrayList.Create(ACollection: IJclCollection; AOwnsObjects: Boolean = True); +begin + // (rom) disabled because the following Create already calls inherited + // inherited Create; + if ACollection = nil then + {$IFDEF CLR} + raise EJclIllegalArgumentError.Create(RsENoCollection); + {$ELSE} + raise EJclIllegalArgumentError.CreateRes(@RsENoCollection); + {$ENDIF CLR} + Create(ACollection.Size, AOwnsObjects); + AddAll(ACollection); +end; + +destructor TJclArrayList.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclArrayList.Insert(Index: Integer; AObject: TObject); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index > FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if FSize = Capacity then + Grow; + if FSize <> Index then + MoveArray(FElementData, Index, Index + 1, FSize - Index); + FElementData[Index] := AObject; + Inc(FSize); +end; + +function TJclArrayList.InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + Size: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if ACollection = nil then + Exit; + Size := ACollection.Size; + if FSize + Size >= Capacity then + Capacity := FSize + Size; + if Size <> 0 then + MoveArray(FElementData, Index, Index + Size, Size); + It := ACollection.First; + Result := It.HasNext; + while It.HasNext do + begin + FElementData[Index] := It.Next; + Inc(Index); + end; +end; + +function TJclArrayList.Add(AObject: TObject): Boolean; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if FSize = Capacity then + Grow; + FElementData[FSize] := AObject; + Inc(FSize); + Result := True; +end; + +function TJclArrayList.AddAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + begin + // (rom) inlining Add() gives about 5 percent performance increase + if FSize = Capacity then + Grow; + FElementData[FSize] := It.Next; + Inc(FSize); + end; + Result := True; +end; + +procedure TJclArrayList.Clear; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + for I := 0 to FSize - 1 do + FreeObject(FElementData[I]); + FSize := 0; +end; + +function TJclArrayList.Clone: TObject; +var + NewList: TJclArrayList; +begin + NewList := TJclArrayList.Create(Capacity, False); // Only one can have FOwnsObject = True + NewList.AddAll(Self); + Result := NewList; +end; + +function TJclArrayList.Contains(AObject: TObject): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + for I := 0 to FSize - 1 do + if FElementData[I] = AObject then + begin + Result := True; + Break; + end; +end; + +function TJclArrayList.ContainsAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := contains(It.Next); +end; + +function TJclArrayList.Equals(ACollection: IJclCollection): Boolean; +var + I: Integer; + It: IJclIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$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 FElementData[I] <> It.Next then + Exit; + Result := True; +end; + +procedure TJclArrayList.FreeObject(var AObject: TObject); +begin + if FOwnsObjects then + begin + AObject.Free; + AObject := nil; + end; +end; + +function TJclArrayList.GetObject(Index: Integer): TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + Result := nil + else + Result := FElementData[Index]; +end; + +procedure TJclArrayList.SetCapacity(ACapacity: Integer); +begin + if ACapacity >= FSize then + begin + SetLength(FElementData, ACapacity); + FCapacity := ACapacity; + end + else + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} +end; + +procedure TJclArrayList.Grow; +begin + if Capacity > 64 then + Capacity := Capacity + Capacity div 4 + else if FCapacity = 0 then + FCapacity := 64 + else + Capacity := Capacity * 4; +end; + +function TJclArrayList.IndexOf(AObject: TObject): Integer; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AObject = nil then + Exit; + for I := 0 to FSize - 1 do + if FElementData[I] = AObject then + begin + Result := I; + Break; + end; +end; + +function TJclArrayList.First: IJclIterator; +begin + Result := TItr.Create(Self); +end; + +function TJclArrayList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclArrayList.Last: IJclIterator; +var + NewIterator: TItr; +begin + NewIterator := TItr.Create(Self); + NewIterator.FCursor := NewIterator.FOwnList.FSize; + NewIterator.FSize := NewIterator.FOwnList.FSize; + Result := NewIterator; +end; + +function TJclArrayList.LastIndexOf(AObject: TObject): Integer; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AObject = nil then + Exit; + for I := FSize - 1 downto 0 do + if FElementData[I] = AObject then + begin + Result := I; + Break; + end; +end; + +function TJclArrayList.Remove(AObject: TObject): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + for I := FSize - 1 downto 0 do + if FElementData[I] = AObject then // Removes all AObject + begin + FreeObject(FElementData[I]); + if FSize <> I then + MoveArray(FElementData, I + 1, I, FSize - I); + Dec(FSize); + Result := True; + end; +end; + +function TJclArrayList.Remove(Index: Integer): TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + Result := nil; + FreeObject(FElementData[Index]); + if FSize <> Index then + MoveArray(FElementData, Index + 1, Index, FSize - Index); + Dec(FSize); +end; + +function TJclArrayList.RemoveAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclArrayList.RetainAll(ACollection: IJclCollection): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + for I := FSize - 1 to 0 do + if not ACollection.Contains(FElementData[I]) then + Remove(I); +end; + +procedure TJclArrayList.SetObject(Index: Integer; AObject: TObject); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + FElementData[Index] := AObject; +end; + +function TJclArrayList.Size: Integer; +begin + Result := FSize; +end; + +function TJclArrayList.SubList(First, Count: Integer): IJclList; +var + I: Integer; + Last: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last >= FSize then + Last := FSize - 1; + Result := TJclArrayList.Create(Count, FOwnsObjects); + for I := First to Last do + Result.Add(FElementData[I]); +end; + +// History: + +// $Log: JclArrayLists.pas,v $ +// Revision 1.11 2005/05/05 20:08:42 ahuser +// JCL.NET support +// +// Revision 1.10 2005/03/08 15:14:00 dade2004 +// Fixed some bug on +// IJclStrList.InsertAll implementation +// +// Revision 1.9 2005/03/08 15:03:08 dade2004 +// Fixed some bug on +// IJclStrList.InsertAll implementation +// +// Revision 1.8 2005/03/08 08:33:15 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.7 2005/03/03 08:02:56 marquardt +// various style cleanings, bugfixes and improvements +// +// Revision 1.6 2005/03/02 17:51:24 rrossmair +// - removed DCLAppendDelimited from JclAlgorithms, changed uses clauses accordingly +// +// Revision 1.5 2005/03/02 09:59:30 dade2004 +// Added +// -TJclStrCollection in JclContainerIntf +// Every common methods for IJclStrCollection are implemented here +// +// -Every class that implement IJclStrCollection now derive from TJclStrCollection instead of TJclAbstractContainer +// -Every abstract method in TJclStrCollection has been marked as "override" in descendent classes +// +// DCLAppendDelimited has been removed from JclAlgorothms, his body has been fixed for a bug and put into +// relative method in TJclStrCollection +// +// Revision 1.4 2005/02/27 11:36:19 marquardt +// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec +// +// Revision 1.3 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.2 2005/02/24 07:36:24 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclArraySets.pas b/official/1.96/source/common/JclArraySets.pas new file mode 100644 index 0000000..ef36c59 --- /dev/null +++ b/official/1.96/source/common/JclArraySets.pas @@ -0,0 +1,434 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:42 $ +// For history see end of file + +unit JclArraySets; + +{$I jcl.inc} + +interface + +uses + JclBase, JclAbstractContainers, JclContainerIntf, JclArrayLists; + +type + TJclIntfArraySet = class(TJclIntfArrayList, IJclIntfCollection, IJclIntfSet, + IJclIntfCloneable) + private + function BinarySearch(AInterface: IInterface): Integer; + protected + { IJclIntfCollection } + function Add(AInterface: IInterface): Boolean; + function AddAll(ACollection: IJclIntfCollection): Boolean; + function Contains(AInterface: IInterface): Boolean; + { IJclIntfList } + procedure Insert(Index: Integer; AInterface: IInterface); overload; + { IJclIntfSet } + procedure Intersect(ACollection: IJclIntfCollection); + procedure Subtract(ACollection: IJclIntfCollection); + procedure Union(ACollection: IJclIntfCollection); + end; + + TJclStrArraySet = class(TJclStrArrayList, IJclStrSet, IJclCloneable) + private + function BinarySearch(const AString: string): Integer; + protected + { IJclStrCollection } + function Add(const AString: string): Boolean; override; + function AddAll(ACollection: IJclStrCollection): Boolean; override; + function Contains(const AString: string): Boolean; override; + { IJclStrList } + procedure Insert(Index: Integer; const AString: string); overload; + { IJclStrSet } + procedure Intersect(ACollection: IJclStrCollection); + procedure Subtract(ACollection: IJclStrCollection); + procedure Union(ACollection: IJclStrCollection); + end; + + TJclArraySet = class(TJclArrayList, IJclCollection, IJclSet, IJclCloneable) + private + function BinarySearch(AObject: TObject): Integer; + protected + { IJclCollection } + function Add(AObject: TObject): Boolean; + function AddAll(ACollection: IJclCollection): Boolean; + function Contains(AObject: TObject): Boolean; + { IJclList } + procedure Insert(Index: Integer; AObject: TObject); overload; + { IJclSet } + procedure Intersect(ACollection: IJclCollection); + procedure Subtract(ACollection: IJclCollection); + procedure Union(ACollection: IJclCollection); + end; + +implementation + +uses + SysUtils, + JclResources; + +function ObjectCompare(Obj1, Obj2: TObject): Integer; +begin + if Cardinal(Obj1) < Cardinal(Obj2) then + Result := -1 + else + if Cardinal(Obj1) > Cardinal(Obj2) then + Result := 1 + else + Result := 0; +end; + +function InterfaceCompare(Obj1, Obj2: IInterface): Integer; +begin + if Cardinal(Obj1) < Cardinal(Obj2) then + Result := -1 + else + if Cardinal(Obj1) > Cardinal(Obj2) then + Result := 1 + else + Result := 0; +end; + +//=== { TJclIntfArraySet } =================================================== + +function TJclIntfArraySet.Add(AInterface: IInterface): Boolean; +var + Idx: Integer; +begin + Idx := BinarySearch(AInterface); + if Idx >= 0 then + Result := InterfaceCompare(GetObject(Idx), AInterface) <> 0 + else + Result := True; + if Result then + inherited Insert(Idx + 1, AInterface); +end; + +function TJclIntfArraySet.AddAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; + +function TJclIntfArraySet.BinarySearch(AInterface: IInterface): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos - LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := InterfaceCompare(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 + LoPos; + end; + Result := HiPos; +end; + +function TJclIntfArraySet.Contains(AInterface: IInterface): Boolean; +var + Idx: Integer; +begin + Idx := BinarySearch(AInterface); + if Idx >= 0 then + Result := InterfaceCompare(GetObject(Idx), AInterface) = 0 + else + Result := False; +end; + +procedure TJclIntfArraySet.Insert(Index: Integer; AInterface: IInterface); +begin + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +procedure TJclIntfArraySet.Intersect(ACollection: IJclIntfCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclIntfArraySet.Subtract(ACollection: IJclIntfCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclIntfArraySet.Union(ACollection: IJclIntfCollection); +begin + AddAll(ACollection); +end; + +//=== { TJclStrArraySet } ==================================================== + +function TJclStrArraySet.Add(const AString: string): Boolean; +var + Idx: Integer; +begin + Idx := BinarySearch(AString); + if Idx >= 0 then + Result := CompareStr(GetString(Idx), AString) <> 0 + else + Result := True; + if Result then + inherited Insert(Idx + 1, AString); +end; + +function TJclStrArraySet.AddAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; + +function TJclStrArraySet.BinarySearch(const AString: string): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos - LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := CompareStr(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 + LoPos; + end; + Result := HiPos; +end; + +function TJclStrArraySet.Contains(const AString: string): Boolean; +var + Idx: Integer; +begin + Idx := BinarySearch(AString); + if Idx >= 0 then + Result := CompareStr(GetString(Idx), AString) = 0 + else + Result := False; +end; + +procedure TJclStrArraySet.Insert(Index: Integer; const AString: string); +begin + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +procedure TJclStrArraySet.Intersect(ACollection: IJclStrCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclStrArraySet.Subtract(ACollection: IJclStrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclStrArraySet.Union(ACollection: IJclStrCollection); +begin + AddAll(ACollection); +end; + +//=== { TJclArraySet } ======================================================= + +function TJclArraySet.Add(AObject: TObject): Boolean; +var + Idx: Integer; +begin + Idx := BinarySearch(AObject); + if Idx >= 0 then + Result := ObjectCompare(GetObject(Idx), AObject) <> 0 + else + Result := True; + if Result then + inherited Insert(Idx + 1, AObject); +end; + +function TJclArraySet.AddAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; + +function TJclArraySet.BinarySearch(AObject: TObject): Integer; +var + HiPos, LoPos, CompPos: Integer; + Comp: Integer; +begin + LoPos := 0; + HiPos := Size - 1; + CompPos := (HiPos - LoPos) div 2; + while HiPos >= LoPos do + begin + Comp := ObjectCompare(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 + LoPos; + end; + Result := HiPos; +end; + +function TJclArraySet.Contains(AObject: TObject): Boolean; +var + Idx: Integer; +begin + Idx := BinarySearch(AObject); + if Idx >= 0 then + Result := ObjectCompare(GetObject(Idx), AObject) = 0 + else + Result := False; +end; + +procedure TJclArraySet.Insert(Index: Integer; AObject: TObject); +begin + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +procedure TJclArraySet.Intersect(ACollection: IJclCollection); +begin + RetainAll(ACollection); +end; + +procedure TJclArraySet.Subtract(ACollection: IJclCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclArraySet.Union(ACollection: IJclCollection); +begin + AddAll(ACollection); +end; + +// History: + +// $Log: JclArraySets.pas,v $ +// Revision 1.8 2005/05/05 20:08:42 ahuser +// JCL.NET support +// +// Revision 1.7 2005/03/09 22:44:10 rrossmair +// - fixed comment +// +// Revision 1.6 2005/03/08 08:33:15 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.5 2005/03/03 08:02:56 marquardt +// various style cleanings, bugfixes and improvements +// +// Revision 1.4 2005/03/02 09:59:30 dade2004 +// Added +// -TJclStrCollection in JclContainerIntf +// Every common methods for IJclStrCollection are implemented here +// +// -Every class that implement IJclStrCollection now derive from TJclStrCollection instead of TJclAbstractContainer +// -Every abstract method in TJclStrCollection has been marked as "override" in descendent classes +// +// DCLAppendDelimited has been removed from JclAlgorothms, his body has been fixed for a bug and put into +// relative method in TJclStrCollection +// +// Revision 1.3 2005/02/27 11:36:20 marquardt +// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec +// +// Revision 1.2 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclBase.pas b/official/1.96/source/common/JclBase.pas new file mode 100644 index 0000000..3e3243d --- /dev/null +++ b/official/1.96/source/common/JclBase.pas @@ -0,0 +1,616 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ This unit contains generic JCL base classes and routines to support earlier } +{ versions of Delphi as well as FPC. } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/15 11:35:13 $ +// For history see end of file + +unit JclBase; + +{$I jcl.inc} + +interface + +uses + {$IFDEF CLR} + System.Reflection, + {$ELSE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$ENDIF CLR} + SysUtils; + +// Version +const + JclVersionMajor = 1; // 0=pre-release|beta/1, 2, ...=final + JclVersionMinor = 96; // Fifth minor release since JCL 1.90 + JclVersionRelease = 1; // 0: pre-release|beta/>=1: release + JclVersionBuild = 2070; // 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); + {$IFDEF CLR} + DWORD = LongWord; + TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1; + {$ENDIF CLR} + +// 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); + {$IFNDEF CLR} + constructor CreateRes(Ident: Integer); overload; + constructor CreateRes(ResStringRec: PResStringRec); overload; + {$ENDIF ~CLR} + property LastError: DWORD read FLastError; + property LastErrorMsg: string read FLastErrorMsg; + end; +{$ENDIF MSWINDOWS} + +// 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} + PPointer = ^Pointer; + {$IFDEF RTL140_UP} + {$IFDEF CLR} + PJclByteArray = array of Byte; + {$ELSE} + PByte = System.PByte; + Int8 = ShortInt; + Int16 = Smallint; + Int32 = Integer; + UInt8 = Byte; + UInt16 = Word; + UInt32 = LongWord; + {$ENDIF CLR} + {$ELSE ~RTL140_UP} + PBoolean = ^Boolean; + PByte = Windows.PByte; + {$ENDIF ~RTL140_UP} + {$ENDIF FPC} + PCardinal = ^Cardinal; + {$IFNDEF COMPILER7_UP} + UInt64 = Int64; + {$ENDIF ~COMPILER7_UP} + +// Interface compatibility +{$IFDEF SUPPORTS_INTERFACE} +{$IFNDEF FPC} +{$IFNDEF RTL140_UP} + +type + IInterface = IUnknown; + +{$ENDIF ~RTL140_UP} +{$ENDIF ~FPC} +{$ENDIF SUPPORTS_INTERFACE} + +// Int64 support +procedure I64ToCardinals(I: Int64; var LowPart, HighPart: Cardinal); +procedure CardinalsToI64(var I: Int64; const LowPart, HighPart: Cardinal); + +// Redefinition of TLargeInteger to relieve dependency on Windows.pas + +type + PLargeInteger = ^TLargeInteger; + TLargeInteger = Int64; + +{$IFNDEF CLR} +// Redefinition of PByteArray to avoid range check exceptions. +type + TJclByteArray = array[0..MaxInt div SizeOf(Byte) - 1] of Byte; + PJclByteArray = ^TJclByteArray; + TBytes = Pointer; // under .NET System.pas: TBytes = array of Byte; + +// Redefinition of TULargeInteger to relieve dependency on Windows.pas +type + PULargeInteger = ^TULargeInteger; + TULargeInteger = record + case Integer of + 0: + (LowPart: LongWord; + HighPart: LongWord); + 1: + (QuadPart: Int64); + end; +{$ENDIF ~CLR} + +// 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; + TDynExtendedArray = array of Extended; + TDynDoubleArray = array of Double; + TDynSingleArray = array of Single; + TDynFloatArray = array of Float; + {$IFNDEF CLR} + TDynPointerArray = array of Pointer; + {$ENDIF ~CLR} + TDynStringArray = array of string; + TDynIInterfaceArray = array of IInterface; + TDynObjectArray = array of TObject; + +// Cross-Platform Compatibility +const + // (rom) too basic for JclStrings + AnsiLineFeed = AnsiChar(#10); + AnsiCarriageReturn = AnsiChar(#13); + AnsiCrLf = AnsiString(#13#10); + {$IFDEF MSWINDOWS} + AnsiLineBreak = AnsiCrLf; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + AnsiLineBreak = AnsiLineFeed; + {$ENDIF UNIX} + + AnsiSigns = ['-', '+']; + 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', '_']; + +{$IFNDEF XPLATFORM_RTL} +procedure RaiseLastOSError; +{$ENDIF ~XPLATFORM_RTL} + +procedure MoveArray(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: Integer); overload; +procedure MoveArray(var List: TDynStringArray; FromIndex, ToIndex, Count: Integer); overload; +procedure MoveArray(var List: TDynObjectArray; FromIndex, ToIndex, Count: Integer); overload; +procedure MoveArray(var List: TDynIntegerArray; FromIndex, ToIndex, Count: Integer); overload; +procedure MoveChar(const Source: string; FromIndex: Integer; + var Dest: string; ToIndex, Count: Integer); overload; // Index: 0..n-1 +{$IFDEF CLR} +function GetBytesEx(const Value): TBytes; +procedure SetBytesEx(var Value; Bytes: TBytes); +procedure SetIntegerSet(var DestSet: TIntegerSet; Value: UInt32); inline; + +function ByteArrayStringLen(Data: TBytes): Integer; +function StringToByteArray(const S: string): TBytes; +function ByteArrayToString(const Data: TBytes; Count: Integer): string; +{$ENDIF CLR} + +implementation + +uses + JclResources; + +procedure MoveArray(var List: TDynIInterfaceArray; FromIndex, ToIndex, Count: Integer); overload; +{$IFDEF CLR} +var + I: Integer; +begin + if FromIndex < ToIndex then + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I] + else + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; +{$ELSE} +begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + { Keep reference counting working } + if FromIndex < ToIndex then + FillChar(List[FromIndex], (ToIndex - FromIndex) * SizeOf(List[0]), 0) + else if FromIndex > ToIndex then + FillChar(List[FromIndex + Count - 1], (FromIndex - ToIndex) * SizeOf(List[0]), 0); +{$ENDIF CLR} +end; + +procedure MoveArray(var List: TDynStringArray; FromIndex, ToIndex, Count: Integer); overload; +{$IFDEF CLR} +var + I: Integer; +begin + if FromIndex < ToIndex then + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I] + else + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; +{$ELSE} +begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + { Keep reference counting working } + if FromIndex < ToIndex then + FillChar(List[FromIndex], (ToIndex - FromIndex) * SizeOf(List[0]), 0) + else if FromIndex > ToIndex then + FillChar(List[FromIndex + Count - 1], (FromIndex - ToIndex) * SizeOf(List[0]), 0); +{$ENDIF CLR} +end; + +procedure MoveArray(var List: TDynObjectArray; FromIndex, ToIndex, Count: Integer); overload; +{$IFDEF CLR} +var + I: Integer; +begin + if FromIndex < ToIndex then + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I] + else + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; +{$ELSE} +begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); +{$ENDIF CLR} +end; + +procedure MoveArray(var List: TDynIntegerArray; FromIndex, ToIndex, Count: Integer); overload; +{$IFDEF CLR} +var + I: Integer; +begin + if FromIndex < ToIndex then + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I] + else + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; +{$ELSE} +begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); +{$ENDIF CLR} +end; + +procedure MoveChar(const Source: string; FromIndex: Integer; + var Dest: string; ToIndex, Count: Integer); +{$IFDEF CLR} +var + i: Integer; + Buf: array of Char; +begin + Buf := Dest.ToCharArray; + if FromIndex <= ToIndex then + for i := 0 to Count - 1 do + Buf[ToIndex + i] := Source[FromIndex + i] + else + for i := Count - 1 downto 0 do + Buf[ToIndex + i] := Source[FromIndex + i]; + Dest := System.String.Create(Buf); +{$ELSE} +begin + Move(Source[FromIndex + 1], Dest[ToIndex + 1], Count * SizeOf(Char)); +{$ENDIF CLR} +end; + +{$IFDEF CLR} +function GetBytesEx(const Value): TBytes; +begin + if TObject(Value) is TBytes then + Result := Copy(TBytes(Value)) + else + if TObject(Value) is TDynByteArray then + Result := Copy(TDynByteArray(Value)) + else + if TObject(Value) is System.Enum then // e.g. TIntegerSet + BitConverter.GetBytes(UInt32(Value)) + { TODO : Add further types } + else + raise EJclError.CreateFmt('GetBytesEx(): Unsupported value type: %s', [TObject(Value).GetType.FullName]); +end; + +procedure SetBytesEx(var Value; Bytes: TBytes); +begin + if TObject(Value) is TBytes then + Value := Copy(Bytes) + else + if TObject(Value) is TDynByteArray then + Value := Copy(Bytes) + else + if TObject(Value) is System.Enum then // e.g. TIntegerSet + Value := BitConverter.ToUInt32(Bytes, 0) + { TODO : Add further types } + else + raise EJclError.CreateFmt('SetBytesEx(): Unsupported value type: %s', [TObject(Value).GetType.FullName]); +end; + +procedure SetIntegerSet(var DestSet: TIntegerSet; Value: UInt32); +begin + DestSet := TIntegerSet(Value); +end; + +function ByteArrayStringLen(Data: TBytes): Integer; +var + I: Integer; +begin + for I := 0 to High(Data) do + if Data[I] = 0 then + begin + Result := I + 1; + Exit; + end; + Result := Length(Data); +end; + +function StringToByteArray(const S: string): TBytes; +var + I: Integer; + AnsiS: AnsiString; +begin + AnsiS := S; // convert to AnsiString + SetLength(Result, Length(AnsiS)); + for I := 0 to High(Result) do + Result[I] := Byte(AnsiS[I + 1]); +end; + +function ByteArrayToString(const Data: TBytes; Count: Integer): string; +var + I: Integer; + 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 := AnsiS; // convert to System.String +end; + +{$ENDIF CLR} + +//== { EJclWin32Error } ====================================================== + +{$IFDEF MSWINDOWS} + +constructor EJclWin32Error.Create(const Msg: string); +begin + {$IFDEF CLR} + inherited Create(''); // this works because the GC cleans the memory + {$ENDIF CLR} + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateFmt(Msg + AnsiLineBreak + RsWin32Prefix, [FLastErrorMsg, FLastError]); +end; + +constructor EJclWin32Error.CreateFmt(const Msg: string; const Args: array of const); +begin + {$IFDEF CLR} + inherited Create(''); // this works because the GC cleans the memory + {$ENDIF CLR} + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateFmt(Msg + AnsiLineBreak + Format(RsWin32Prefix, [FLastErrorMsg, FLastError]), Args); +end; + +{$IFNDEF CLR} +constructor EJclWin32Error.CreateRes(Ident: Integer); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + inherited CreateFmt(LoadStr(Ident) + AnsiLineBreak + RsWin32Prefix, [FLastErrorMsg, FLastError]); +end; + +constructor EJclWin32Error.CreateRes(ResStringRec: PResStringRec); +begin + FLastError := GetLastError; + FLastErrorMsg := SysErrorMessage(FLastError); + {$IFDEF FPC} + inherited CreateFmt(ResStringRec^ + AnsiLineBreak + RsWin32Prefix, [FLastErrorMsg, FLastError]); + {$ELSE} + inherited CreateFmt(LoadResString(ResStringRec) + AnsiLineBreak + RsWin32Prefix, [FLastErrorMsg, FLastError]); + {$ENDIF FPC} +end; +{$ENDIF ~CLR} + +{$ENDIF MSWINDOWS} + +// Int64 support + +procedure I64ToCardinals(I: Int64; var LowPart, HighPart: Cardinal); +begin + {$IFDEF CLR} + LowPart := Cardinal(I and $00000000FFFFFFFF); + HighPart := Cardinal(I shr 32); + {$ELSE} + LowPart := TULargeInteger(I).LowPart; + HighPart := TULargeInteger(I).HighPart; + {$ENDIF CLR} +end; + +procedure CardinalsToI64(var I: Int64; const LowPart, HighPart: Cardinal); +begin + {$IFDEF CLR} + I := Int64(HighPart) shl 16 or LowPart; + {$ELSE} + TULargeInteger(I).LowPart := LowPart; + TULargeInteger(I).HighPart := HighPart; + {$ENDIF CLR} +end; + +// Cross Platform Compatibility + +{$IFNDEF XPLATFORM_RTL} +procedure RaiseLastOSError; +begin + RaiseLastWin32Error; +end; +{$ENDIF ~XPLATFORM_RTL} + +// History: + +// $Log: JclBase.pas,v $ +// Revision 1.46 2005/12/15 11:35:13 ahuser +// Additional MoveArray function for .NET (should have been committed months ago) +// +// Revision 1.45 2005/10/30 05:24:20 rrossmair +// - updated version information for release 1.96 +// +// Revision 1.44 2005/10/26 09:00:32 ahuser +// Extended GetBytes() function to allow TBytes and TDynByteArray usage +// +// Revision 1.43 2005/10/12 04:25:47 rrossmair +// - fixed issue #3255 (error in PJclByteArray declaration) +// +// Revision 1.42 2005/09/11 11:28:25 ahuser +// typo +// +// Revision 1.41 2005/08/12 14:08:53 ahuser +// Fixed compile bug +// +// Revision 1.40 2005/08/11 18:11:24 ahuser +// Added MoveChar function +// +// Revision 1.39 2005/08/07 13:09:54 outchy +// Changed PByteArray to PJclByteArray to avoid RangeCheck exceptions. +// +// Revision 1.38 2005/05/05 20:08:42 ahuser +// JCL.NET support +// +// Revision 1.37 2005/03/23 13:19:06 rrossmair +// - check-in in preparation of release 1.95.3 (Build 1848) +// +// Revision 1.36 2005/03/15 20:12:27 rrossmair +// - version info updated, now 1.95.2, Build 1840 +// +// Revision 1.35 2005/03/14 08:46:53 rrossmair +// - check-in in preparation for release 1.95 +// +// Revision 1.34 2005/03/09 23:56:45 rrossmair +// - fixed compilation condition for UInt64 declaration ($IFDEF COMPILER7_UP instead of $IFDEF COMPILER7) +// +// Revision 1.33 2005/03/08 16:10:07 marquardt +// standard char sets extended and used, some optimizations for string literals +// +// Revision 1.32 2005/03/08 08:33:15 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.31 2005/02/24 16:34:39 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.30 2005/02/14 00:41:58 rrossmair +// - supply PByte for D5/BCB5. Pbyte is required by JclMath.GetParity; including it here helps +// avoid inclusion of unit Windows in the uses clause of unit JclMath just because of PByte. +// +// Revision 1.29 2005/02/13 22:24:25 rrossmair +// moved PCardinal declaration from JclMime to JclBase +// +// Revision 1.28 2005/02/05 14:21:59 rrossmair +// - version information updated +// +// Revision 1.27 2005/01/06 18:48:31 marquardt +// AnsiLineBreak, AnsiLineFeed, AnsiCarriageReturn, AnsiCrLf moved to JclBase JclStrings now reexports the names +// +// Revision 1.26 2004/12/23 04:31:42 rrossmair +// - check-in for JCL 1.94 RC 1 +// +// Revision 1.25 2004/12/18 03:58:05 rrossmair +// - fixed to compile in Delphi 5 again +// +// Revision 1.24 2004/12/17 05:33:02 marquardt +// updates for DCL +// +// Revision 1.23 2004/11/18 00:57:14 rrossmair +// - check-in for release 1.93 +// +// Revision 1.22 2004/11/06 02:13:24 mthoma +// history cleaning. +// +// Revision 1.21 2004/09/30 07:50:29 marquardt +// remove PH contributions +// +// Revision 1.20 2004/09/16 19:47:32 rrossmair +// check-in in preparation for release 1.92 +// +// Revision 1.19 2004/06/16 07:30:14 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.18 2004/06/14 11:05:50 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.17 2004/06/14 06:24:52 marquardt +// style cleaning IFDEF +// +// Revision 1.16 2004/06/06 01:31:09 rrossmair +// version information updated for build #1558 +// +// Revision 1.15 2004/05/31 01:43:18 rrossmair +// Processed documentation TODOs +// +// Revision 1.14 2004/05/13 07:47:30 rrossmair +// Removed FPC compatibility code rendered superfluous by latest FPC updates; updated build # +// +// Revision 1.13 2004/05/08 19:56:55 rrossmair +// FPC-related improvements +// +// Revision 1.12 2004/05/06 05:09:55 rrossmair +// Changes for FPC v1.9.4 compatibility +// +// Revision 1.11 2004/05/05 00:04:10 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.10 2004/04/19 06:02:18 rrossmair +// fixed QueryPerformanceCounter (FPC compatibility routine) +// +// Revision 1.9 2004/04/14 23:04:09 +// add TDynLongWordArray, TDynBooleanArray +// +// Revision 1.8 2004/04/06 04:53:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/common/JclBinaryTrees.pas b/official/1.96/source/common/JclBinaryTrees.pas new file mode 100644 index 0000000..0efcd31 --- /dev/null +++ b/official/1.96/source/common/JclBinaryTrees.pas @@ -0,0 +1,3285 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:42 $ +// For history see end of file + +unit JclBinaryTrees; + +{$I jcl.inc} + +{.DEFINE RECURSIVE} + +interface + +uses + Classes, + JclBase, JclAbstractContainers, JclAlgorithms, JclContainerIntf; + +type + TJclTreeColor = (tcBlack, tcRed); + + {$IFDEF CLR} + TJclIntfBinaryNode = class; + PJclIntfBinaryNode = TJclIntfBinaryNode; + TJclIntfBinaryNode = class + {$ELSE} + PJclIntfBinaryNode = ^TJclIntfBinaryNode; + TJclIntfBinaryNode = record + {$ENDIF CLR} + Obj: IInterface; + Left: PJclIntfBinaryNode; + Right: PJclIntfBinaryNode; + Parent: PJclIntfBinaryNode; + Color: TJclTreeColor; + end; + + {$IFDEF CLR} + TJclStrBinaryNode = class; + PJclStrBinaryNode = TJclStrBinaryNode; + TJclStrBinaryNode = class + {$ELSE} + PJclStrBinaryNode = ^TJclStrBinaryNode; + TJclStrBinaryNode = record + {$ENDIF CLR} + Str: string; + Left: PJclStrBinaryNode; + Right: PJclStrBinaryNode; + Parent: PJclStrBinaryNode; + Color: TJclTreeColor; + end; + + {$IFDEF CLR} + TJclBinaryNode = class; + PJclBinaryNode = TJclBinaryNode; + TJclBinaryNode = class + {$ELSE} + PJclBinaryNode = ^TJclBinaryNode; + TJclBinaryNode = record + {$ENDIF CLR} + Obj: TObject; + Left: PJclBinaryNode; + Right: PJclBinaryNode; + Parent: PJclBinaryNode; + Color: TJclTreeColor; + end; + + TJclIntfBinaryTree = class(TJclAbstractContainer, IJclIntfCollection, + IJclIntfTree, IJclIntfCloneable) + private + FComparator: TIntfCompare; + FCount: Integer; + FRoot: PJclIntfBinaryNode; + FTraverseOrder: TJclTraverseOrder; + procedure RotateLeft(Node: PJclIntfBinaryNode); + procedure RotateRight(Node: PJclIntfBinaryNode); + protected + { IJclIntfCollection } + function Add(AInterface: IInterface): Boolean; + function AddAll(ACollection: IJclIntfCollection): Boolean; + procedure Clear; + function Contains(AInterface: IInterface): Boolean; + function ContainsAll(ACollection: IJclIntfCollection): Boolean; + function Equals(ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(AInterface: IInterface): Boolean; + function RemoveAll(ACollection: IJclIntfCollection): Boolean; + function RetainAll(ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + { IJclIntfTree } + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + { IJclIntfCloneable } + function Clone: IInterface; + public + constructor Create(AComparator: TIntfCompare = nil); + destructor Destroy; override; + end; + + { + TJclStrBinaryTree = class(TJclAbstractContainer, IJclStrCollection, + IJclStrTree, IJclCloneable) + } + TJclStrBinaryTree = class(TJclStrCollection, IJclStrTree, IJclCloneable) + private + FComparator: TStrCompare; + FCount: Integer; + FRoot: PJclStrBinaryNode; + FTraverseOrder: TJclTraverseOrder; + procedure RotateLeft(Node: PJclStrBinaryNode); + procedure RotateRight(Node: PJclStrBinaryNode); + protected + { IJclStrCollection } + function Add(const AString: string): Boolean; override; + function AddAll(ACollection: IJclStrCollection): Boolean; override; + procedure Clear; override; + function Contains(const AString: string): Boolean; override; + function ContainsAll(ACollection: IJclStrCollection): Boolean; override; + function Equals(ACollection: IJclStrCollection): Boolean; override; + function First: IJclStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclStrIterator; override; + function Remove(const AString: string): Boolean; override; + function RemoveAll(ACollection: IJclStrCollection): Boolean; override; + function RetainAll(ACollection: IJclStrCollection): Boolean; override; + function Size: Integer; override; + { IJclStrTree } + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + { IJclCloneable } + function Clone: TObject; + public + constructor Create(AComparator: TStrCompare = nil); + destructor Destroy; override; + end; + + TJclBinaryTree = class(TJclAbstractContainer, IJclCollection, IJclTree, + IJclCloneable) + private + FComparator: TCompare; + FCount: Integer; + FRoot: PJclBinaryNode; + FTraverseOrder: TJclTraverseOrder; + procedure RotateLeft(Node: PJclBinaryNode); + procedure RotateRight(Node: PJclBinaryNode); + protected + { IJclCollection } + function Add(AObject: TObject): Boolean; + function AddAll(ACollection: IJclCollection): Boolean; + procedure Clear; + function Contains(AObject: TObject): Boolean; + function ContainsAll(ACollection: IJclCollection): Boolean; + function Equals(ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; + function RemoveAll(ACollection: IJclCollection): Boolean; + function RetainAll(ACollection: IJclCollection): Boolean; + function Size: Integer; + { IJclTree } + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + { IJclCloneable } + function Clone: TObject; + public + constructor Create(AComparator: TCompare = nil); + destructor Destroy; override; + end; + +implementation + +uses + SysUtils, + JclResources; + +//=== { TIntfItr } =========================================================== + +type + TIntfItr = class(TJclAbstractContainer, IJclIntfIterator) + private + FCursor: PJclIntfBinaryNode; + FOwnList: TJclIntfBinaryTree; + FLastRet: PJclIntfBinaryNode; + protected + { IJclIntfIterator } + procedure Add(AInterface: IInterface); + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: IInterface; virtual; + function NextIndex: Integer; + function Previous: IInterface; virtual; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AInterface: IInterface); + public + constructor Create(OwnList: TJclIntfBinaryTree; Start: PJclIntfBinaryNode); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TIntfItr.Create(OwnList: TJclIntfBinaryTree; Start: PJclIntfBinaryNode); +begin + inherited Create; + FCursor := Start; + FOwnList := OwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} +end; + +{$IFNDEF CLR} +destructor TIntfItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TIntfItr.Add(AInterface: IInterface); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + FOwnList.Add(AInterface); +end; + +function TIntfItr.GetObject: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; +end; + +function TIntfItr.HasNext: Boolean; +begin + Result := FCursor <> nil; +end; + +function TIntfItr.HasPrevious: Boolean; +begin + Result := FCursor <> nil; +end; + +function TIntfItr.Next: IInterface; +begin +end; + +function TIntfItr.NextIndex: Integer; +begin + // No index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TIntfItr.Previous: IInterface; +begin +end; + +function TIntfItr.PreviousIndex: Integer; +begin + // No index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +procedure TIntfItr.Remove; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + FOwnList.Remove(Next); +end; + +procedure TIntfItr.SetObject(AInterface: IInterface); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + FCursor.Obj := AInterface; +end; + +//=== { TPreOrderIntfItr } =================================================== + +type + TPreOrderIntfItr = class(TIntfItr, IJclIntfIterator) + protected + { IJclIntfIterator } + function Next: IInterface; override; + function Previous: IInterface; override; + end; + +function TPreOrderIntfItr.Next: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + if FCursor.Left <> nil then + FCursor := FCursor.Left + else + if FCursor.Right <> nil then + FCursor := FCursor.Right + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and (FCursor.Left <> FLastRet) do // come from Right + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + while (FCursor <> nil) and (FCursor.Right = nil) do + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + if FCursor <> nil then // not root + FCursor := FCursor.Right; + end; +end; + +function TPreOrderIntfItr.Previous: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + FCursor := FCursor.Parent; + if (FCursor <> nil) and (FCursor.Left <> FLastRet) then // come from Right + if FCursor.Left <> nil then + begin + FLastRet := FCursor; + FCursor := FCursor.Left; + while FCursor.Right <> nil do + begin + FLastRet := FCursor; + FCursor := FCursor.Right; + end; + end; +end; + +//=== { TInOrderIntfItr } ==================================================== + +type + TInOrderIntfItr = class(TIntfItr, IJclIntfIterator) + protected + { IJclIntfIterator } + function Next: IInterface; override; + function Previous: IInterface; override; + end; + +function TInOrderIntfItr.Next: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if FCursor.Left <> FLastRet then + while FCursor.Left <> nil do + FCursor := FCursor.Left; + Result := FCursor.Obj; + FLastRet := FCursor; + if FCursor.Right <> nil then + FCursor := FCursor.Right + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and (FCursor.Right = FLastRet) do + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + end; +end; + +function TInOrderIntfItr.Previous: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + if FCursor.Left <> nil then + begin + FCursor := FCursor.Left; + while FCursor.Right <> nil do + begin + FLastRet := FCursor; + FCursor := FCursor.Right; + end; + end + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and (FCursor.Right <> FLastRet) do // Come from Left + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + end; +end; + +//=== { TPostOrderIntfItr } ================================================== + +type + TPostOrderIntfItr = class(TIntfItr, IJclIntfIterator) + protected + { IJclIntfIterator } + function Next: IInterface; override; + function Previous: IInterface; override; + end; + +function TPostOrderIntfItr.Next: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if (FCursor.Left <> FLastRet) and (FCursor.Right <> FLastRet) then + while FCursor.Left <> nil do + FCursor := FCursor.Left; + if (FCursor.Right <> nil) and (FCursor.Right <> FLastRet) then + begin + FCursor := FCursor.Right; + while FCursor.Left <> nil do + FCursor := FCursor.Left; + if FCursor.Right <> nil then // particular worst case + FCursor := FCursor.Right; + end; + Result := FCursor.Obj; + FLastRet := FCursor; + FCursor := FCursor.Parent; +end; + +function TPostOrderIntfItr.Previous: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + if (FCursor.Right <> nil) and (FCursor.Right <> FLastRet) then + FCursor := FCursor.Right + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and ((FCursor.Left = nil) or (FCursor.Left = FLastRet)) do + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + if FCursor <> nil then // not root + FCursor := FCursor.Left; + end; +end; + +//=== { TStrItr } ============================================================ + +type + TStrItr = class(TJclAbstractContainer, IJclStrIterator) + protected + FCursor: PJclStrBinaryNode; + FOwnList: TJclStrBinaryTree; + FLastRet: PJclStrBinaryNode; + { IJclStrIterator } + procedure Add(const AString: string); + function GetString: string; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: string; virtual; + function NextIndex: Integer; + function Previous: string; virtual; + function PreviousIndex: Integer; + procedure Remove; + procedure SetString(const AString: string); + public + constructor Create(OwnList: TJclStrBinaryTree; Start: PJclStrBinaryNode); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TStrItr.Create(OwnList: TJclStrBinaryTree; Start: PJclStrBinaryNode); +begin + inherited Create; + FCursor := Start; + FOwnList := OwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} +end; + +{$IFNDEF CLR} +destructor TStrItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TStrItr.Add(const AString: string); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + FOwnList.Add(AString); +end; + +function TStrItr.GetString: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Str; +end; + +function TStrItr.HasNext: Boolean; +begin + Result := FCursor <> nil; +end; + +function TStrItr.HasPrevious: Boolean; +begin + Result := FCursor <> nil; +end; + +function TStrItr.Next: string; +begin +end; + +function TStrItr.NextIndex: Integer; +begin + // No index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TStrItr.Previous: string; +begin +end; + +function TStrItr.PreviousIndex: Integer; +begin + // No index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +procedure TStrItr.Remove; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + FOwnList.Remove(Next); +end; + +procedure TStrItr.SetString(const AString: string); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + FCursor.Str := AString; +end; + +//=== { TPreOrderStrItr } ==================================================== + +type + TPreOrderStrItr = class(TStrItr, IJclStrIterator) + protected + { IJclStrIterator } + function Next: string; override; + function Previous: string; override; + end; + +function TPreOrderStrItr.Next: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Str; + FLastRet := FCursor; + if FCursor.Left <> nil then + FCursor := FCursor.Left + else + if FCursor.Right <> nil then + FCursor := FCursor.Right + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and (FCursor.Left <> FLastRet) do // come from Right + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + while (FCursor <> nil) and (FCursor.Right = nil) do + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + if FCursor <> nil then // not root + FCursor := FCursor.Right; + end; +end; + +function TPreOrderStrItr.Previous: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Str; + FLastRet := FCursor; + FCursor := FCursor.Parent; + if (FCursor <> nil) and (FCursor.Left <> FLastRet) then // come from Right + if FCursor.Left <> nil then + begin + FLastRet := FCursor; + FCursor := FCursor.Left; + while FCursor.Right <> nil do + begin + FLastRet := FCursor; + FCursor := FCursor.Right; + end; + end; +end; + +//=== { TInOrderStrItr } ===================================================== + +type + TInOrderStrItr = class(TStrItr, IJclStrIterator) + protected + { IJclStrIterator } + function Next: string; override; + function Previous: string; override; + end; + +function TInOrderStrItr.Next: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if FCursor.Left <> FLastRet then + while FCursor.Left <> nil do + FCursor := FCursor.Left; + Result := FCursor.Str; + FLastRet := FCursor; + if FCursor.Right <> nil then + FCursor := FCursor.Right + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and (FCursor.Right = FLastRet) do + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + end; +end; + +function TInOrderStrItr.Previous: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Str; + FLastRet := FCursor; + if FCursor.Left <> nil then + begin + FCursor := FCursor.Left; + while FCursor.Right <> nil do + begin + FLastRet := FCursor; + FCursor := FCursor.Right; + end; + end + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and (FCursor.Right <> FLastRet) do // Come from Left + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + end; +end; + +//=== { TPostOrderStrItr } =================================================== + +type + TPostOrderStrItr = class(TStrItr, IJclStrIterator) + protected + { IJclStrIterator } + function Next: string; override; + function Previous: string; override; + end; + +function TPostOrderStrItr.Next: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if (FCursor.Left <> FLastRet) and (FCursor.Right <> FLastRet) then + while FCursor.Left <> nil do + FCursor := FCursor.Left; + if (FCursor.Right <> nil) and (FCursor.Right <> FLastRet) then + begin + FCursor := FCursor.Right; + while FCursor.Left <> nil do + FCursor := FCursor.Left; + if FCursor.Right <> nil then // particular worst case + FCursor := FCursor.Right; + end; + Result := FCursor.Str; + FLastRet := FCursor; + FCursor := FCursor.Parent; +end; + +function TPostOrderStrItr.Previous: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Str; + FLastRet := FCursor; + if (FCursor.Right <> nil) and (FCursor.Right <> FLastRet) then + FCursor := FCursor.Right + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and ((FCursor.Left = nil) or (FCursor.Left = FLastRet)) do + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + if FCursor <> nil then // not root + FCursor := FCursor.Left; + end; +end; + +//=== { TItr } =============================================================== + +type + TItr = class(TJclAbstractContainer, IJclIterator) + protected + FCursor: PJclBinaryNode; + FOwnList: TJclBinaryTree; + FLastRet: PJclBinaryNode; + { IJclIntfIterator } + procedure Add(AObject: TObject); + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: TObject; virtual; + function NextIndex: Integer; + function Previous: TObject; virtual; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AObject: TObject); + public + constructor Create(OwnList: TJclBinaryTree; Start: PJclBinaryNode); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TItr.Create(OwnList: TJclBinaryTree; Start: PJclBinaryNode); +begin + inherited Create; + FCursor := Start; + FOwnList := OwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} +end; + +{$IFNDEF CLR} +destructor TItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TItr.Add(AObject: TObject); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + FOwnList.Add(AObject); +end; + +function TItr.GetObject: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; +end; + +function TItr.HasNext: Boolean; +begin + Result := FCursor <> nil; +end; + +function TItr.HasPrevious: Boolean; +begin + Result := FCursor <> nil; +end; + +function TItr.Next: TObject; +begin + Result := nil; // overriden in derived class +end; + +function TItr.NextIndex: Integer; +begin + // No index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TItr.Previous: TObject; +begin + Result := nil; // overriden in derived class +end; + +function TItr.PreviousIndex: Integer; +begin + // No index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +procedure TItr.Remove; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + FOwnList.Remove(Next); +end; + +procedure TItr.SetObject(AObject: TObject); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + FCursor.Obj := AObject; +end; + +//=== { TPreOrderItr } ======================================================= + +type + TPreOrderItr = class(TItr, IJclIterator) + protected + { IJclIterator } + function Next: TObject; override; + function Previous: TObject; override; + end; + +function TPreOrderItr.Next: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + if FCursor.Left <> nil then + FCursor := FCursor.Left + else + if FCursor.Right <> nil then + FCursor := FCursor.Right + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and (FCursor.Left <> FLastRet) do // come from Right + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + while (FCursor <> nil) and (FCursor.Right = nil) do + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + if FCursor <> nil then // not root + FCursor := FCursor.Right; + end; +end; + +function TPreOrderItr.Previous: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + FCursor := FCursor.Parent; + if (FCursor <> nil) and (FCursor.Left <> FLastRet) then // come from Right + if FCursor.Left <> nil then + begin + FLastRet := FCursor; + FCursor := FCursor.Left; + while FCursor.Right <> nil do + begin + FLastRet := FCursor; + FCursor := FCursor.Right; + end; + end; +end; + +//=== { TInOrderItr } ======================================================== + +type + TInOrderItr = class(TItr, IJclIterator) + protected + { IJclIterator } + function Next: TObject; override; + function Previous: TObject; override; + end; + +function TInOrderItr.Next: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if FCursor.Left <> FLastRet then + while FCursor.Left <> nil do + FCursor := FCursor.Left; + Result := FCursor.Obj; + FLastRet := FCursor; + if FCursor.Right <> nil then + FCursor := FCursor.Right + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and (FCursor.Right = FLastRet) do + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + end; +end; + +function TInOrderItr.Previous: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + if FCursor.Left <> nil then + begin + FCursor := FCursor.Left; + while FCursor.Right <> nil do + begin + FLastRet := FCursor; + FCursor := FCursor.Right; + end; + end + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and (FCursor.Right <> FLastRet) do // Come from Left + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + end; +end; + +//=== { TPostOrderItr } ====================================================== + +type + TPostOrderItr = class(TItr, IJclIterator) + protected + { IJclIterator } + function Next: TObject; override; + function Previous: TObject; override; + end; + +function TPostOrderItr.Next: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if (FCursor.Left <> FLastRet) and (FCursor.Right <> FLastRet) then + while FCursor.Left <> nil do + FCursor := FCursor.Left; + if (FCursor.Right <> nil) and (FCursor.Right <> FLastRet) then + begin + FCursor := FCursor.Right; + while FCursor.Left <> nil do + FCursor := FCursor.Left; + if FCursor.Right <> nil then // particular worst case + FCursor := FCursor.Right; + end; + Result := FCursor.Obj; + FLastRet := FCursor; + FCursor := FCursor.Parent; +end; + +function TPostOrderItr.Previous: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + if (FCursor.Right <> nil) and (FCursor.Right <> FLastRet) then + FCursor := FCursor.Right + else + begin + FCursor := FCursor.Parent; + while (FCursor <> nil) and ((FCursor.Left = nil) or (FCursor.Left = FLastRet)) do + begin + FLastRet := FCursor; + FCursor := FCursor.Parent; + end; + if FCursor <> nil then // not root + FCursor := FCursor.Left; + end; +end; + +//=== { TJclIntfBinaryTree } ================================================= + +constructor TJclIntfBinaryTree.Create(AComparator: TIntfCompare = nil); +begin + inherited Create; + if Assigned(AComparator) then + FComparator := AComparator + else + FComparator := @IntfSimpleCompare; + FTraverseOrder := toPreOrder; +end; + +destructor TJclIntfBinaryTree.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TJclIntfBinaryTree.Add(AInterface: IInterface): Boolean; +var + NewNode: PJclIntfBinaryNode; + Current, Save: PJclIntfBinaryNode; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + {$IFDEF CLR} + NewNode := TJclIntfBinaryNode.Create; + {$ELSE} + NewNode := AllocMem(SizeOf(TJclIntfBinaryNode)); + {$ENDIF CLR} + NewNode.Obj := AInterface; + // Insert into right place + Save := nil; + Current := FRoot; + while Current <> nil do + begin + Save := Current; + if FComparator(NewNode.Obj, Current.Obj) < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if FComparator(NewNode.Obj, Save.Obj) < 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + // RB balanced + NewNode.Color := tcRed; + while (NewNode <> FRoot) and (NewNode.Parent.Color = tcRed) do + begin + if (NewNode.Parent.Parent <> nil) and (NewNode.Parent = NewNode.Parent.Parent.Left) then + begin + Current := NewNode.Parent.Parent.Right; + if Current.Color = tcRed then + begin + NewNode.Parent.Color := tcBlack; + Current.Color := tcBlack; + NewNode.Parent.Parent.Color := tcRed; + NewNode := NewNode.Parent.Parent; + end + else + begin + if NewNode = NewNode.Parent.Right then + begin + NewNode := NewNode.Parent; + RotateLeft(NewNode); + end; + NewNode.Parent.Color := tcBlack; + NewNode.Parent.Parent.Color := tcRed; + RotateRight(NewNode.Parent.Parent); + end; + end + else + begin + if NewNode.Parent.Parent = nil then + Current := nil + else + Current := NewNode.Parent.Parent.Left; + if (Current <> nil) and (Current.Color = tcRed) then + begin + NewNode.Parent.Color := tcBlack; + Current.Color := tcBlack; + NewNode.Parent.Parent.Color := tcRed; + NewNode := NewNode.Parent.Parent; + end + else + begin + if NewNode = NewNode.Parent.Left then + begin + NewNode := NewNode.Parent; + RotateRight(NewNode); + end; + NewNode.Parent.Color := tcBlack; + if NewNode.Parent.Parent <> nil then + NewNode.Parent.Parent.Color := tcRed; + RotateLeft(NewNode.Parent.Parent); + end; + end; + end; + FRoot.Color := tcBlack; + Inc(FCount); + Result := True; +end; + +function TJclIntfBinaryTree.AddAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; + +procedure TJclIntfBinaryTree.Clear; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} + +{$IFDEF RECURSIVE} + procedure FreeChild(Node: PJclIntfBinaryNode); + begin + if Node.Left <> nil then + FreeChild(Node.Left); + if Node.Right <> nil then + FreeChild(Node.Right); + Node.Obj := nil; // Force Release + FreeMem(Node); + end; +{$ELSE} +var + Current: PJclIntfBinaryNode; + Save: PJclIntfBinaryNode; +{$ENDIF RECURSIVE} + +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + {$IFDEF RECURSIVE} + // recursive version + if FRoot <> nil then + begin + FreeChild(FRoot); + FRoot := nil; + end; + {$ELSE} + // iterative version + Current := FRoot; + while Current <> nil do + begin + if Current.Left <> nil then + Current := Current.Left + else + if Current.Right <> nil then + Current := Current.Right + else + begin + Current.Obj := nil; // Force Release + if Current.Parent = nil then // Root + begin + {$IFDEF CLR} + Current.Free; + {$ELSE} + FreeMem(Current); + {$ENDIF CLR} + Current := nil; + FRoot := nil; + end + else + begin + Save := Current; + Current := Current.Parent; + if Save = Current.Right then // True = from Right + begin + {$IFDEF CLR} + Save.Free; + {$ELSE} + FreeMem(Save); + {$ENDIF CLR} + Current.Right := nil; + end + else + begin + {$IFDEF CLR} + Save.Free; + {$ELSE} + FreeMem(Save); + {$ENDIF CLR} + Current.Left := nil; + end + end; + end; + end; + {$ENDIF RECURSIVE} + FCount := 0; +end; + +function TJclIntfBinaryTree.Clone: IInterface; +var + NewTree: TJclIntfBinaryTree; + + function CloneNode(Node, Parent: PJclIntfBinaryNode): PJclIntfBinaryNode; + begin + if Node <> nil then + begin + {$IFDEF CLR} + Result := TJclIntfBinaryNode.Create; + {$ELSE} + GetMem(Result, SizeOf(TJclIntfBinaryNode)); + {$ENDIF CLR} + Result.Obj := Node.Obj; + Result.Color := Node.Color; + Result.Parent := Parent; + Result.Left := CloneNode(Node.Left, Result); // recursive call + Result.Right := CloneNode(Node.Right, Result); // recursive call + end + else + Result := nil; + end; + +begin + NewTree := TJclIntfBinaryTree.Create(FComparator); + NewTree.FCount := FCount; + NewTree.FRoot := CloneNode(FRoot, nil); + Result := NewTree; +end; + +function TJclIntfBinaryTree.Contains(AInterface: IInterface): Boolean; +var + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} + Comp: Integer; + +{$IFDEF RECURSIVE} + function ContainsChild(Node: PJclIntfBinaryNode): Boolean; + begin + Result := False; + if Node = nil then + Exit; + Comp := FComparator(Node.Obj, AInterface); + if Comp = 0 then + Result := True + else + if Comp > 0 then + Result := ContainsChild(Node.Left) + else + Result := ContainsChild(Node.Right); + end; +{$ELSE} +var + Current: PJclIntfBinaryNode; +{$ENDIF RECURSIVE} + +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + {$IFDEF RECURSIVE} + // recursive version + Result := ContainsChild(FRoot); + {$ELSE} + // iterative version + Current := FRoot; + while Current <> nil do + begin + Comp := FComparator(Current.Obj, AInterface); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$ENDIF RECURSIVE} +end; + +function TJclIntfBinaryTree.ContainsAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); +end; + +function TJclIntfBinaryTree.Equals(ACollection: IJclIntfCollection): Boolean; +var + It, ItSelf: IJclIntfIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FCount <> ACollection.Size then + Exit; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if FComparator(ItSelf.Next, It.Next) <> 0 then + Exit; + Result := True; +end; + +function TJclIntfBinaryTree.First: IJclIntfIterator; +begin + case GetTraverseOrder of + toPreOrder: + Result := TPreOrderIntfItr.Create(Self, FRoot); + toOrder: + Result := TInOrderIntfItr.Create(Self, FRoot); + toPostOrder: + Result := TPostOrderIntfItr.Create(Self, FRoot); + end; +end; + +function TJclIntfBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclIntfBinaryTree.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclIntfBinaryTree.Last: IJclIntfIterator; +var + Start: PJclIntfBinaryNode; +begin + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TPreOrderIntfItr.Create(Self, Start); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TInOrderIntfItr.Create(Self, Start); + end; + toPostOrder: + Result := TPostOrderIntfItr.Create(Self, Start); + end; +end; + +procedure TJclIntfBinaryTree.RotateLeft(Node: PJclIntfBinaryNode); +var + TempNode: PJclIntfBinaryNode; +begin + if Node = nil then + Exit; + TempNode := Node.Right; + // if TempNode = nil then Exit; + Node.Right := TempNode.Left; + if TempNode.Left <> nil then + TempNode.Left.Parent := Node; + TempNode.Parent := Node.Parent; + if Node.Parent = nil then + FRoot := TempNode + else + if Node.Parent.Left = Node then + Node.Parent.Left := TempNode + else + Node.Parent.Right := TempNode; + TempNode.Left := Node; + Node.Parent := TempNode; +end; + +procedure TJclIntfBinaryTree.RotateRight(Node: PJclIntfBinaryNode); +var + TempNode: PJclIntfBinaryNode; +begin + if Node = nil then + Exit; + TempNode := Node.Left; + // if TempNode = nil then Exit; + Node.Left := TempNode.Right; + if TempNode.Right <> nil then + TempNode.Right.Parent := Node; + TempNode.Parent := Node.Parent; + if Node.Parent = nil then + FRoot := TempNode + else + if Node.Parent.Right = Node then + Node.Parent.Right := TempNode + else + Node.Parent.Left := TempNode; + TempNode.Right := Node; + Node.Parent := TempNode; +end; + +function TJclIntfBinaryTree.Remove(AInterface: IInterface): Boolean; +var + Current: PJclIntfBinaryNode; + Node: PJclIntfBinaryNode; + Save: PJclIntfBinaryNode; + Comp: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} + + procedure Correction(Node: PJclIntfBinaryNode); + var + TempNode: PJclIntfBinaryNode; + begin + while (Node <> FRoot) and (Node.Color = tcBlack) do + begin + if Node = Node.Parent.Left then + begin + TempNode := Node.Parent.Right; + if TempNode = nil then + begin + Node := Node.Parent; + Continue; + end; + if TempNode.Color = tcRed then + begin + TempNode.Color := tcBlack; + Node.Parent.Color := tcRed; + RotateLeft(Node.Parent); + TempNode := Node.Parent.Right; + end; + if (TempNode.Left <> nil) and (TempNode.Left.Color = tcBlack) and + (TempNode.Right <> nil) and (TempNode.Right.Color = tcBlack) then + begin + TempNode.Color := tcRed; + Node := Node.Parent; + end + else + begin + if (TempNode.Right <> nil) and (TempNode.Right.Color = tcBlack) then + begin + TempNode.Left.Color := tcBlack; + TempNode.Color := tcRed; + RotateRight(TempNode); + TempNode := Node.Parent.Right; + end; + TempNode.Color := Node.Parent.Color; + Node.Parent.Color := tcBlack; + if TempNode.Right <> nil then + TempNode.Right.Color := tcBlack; + RotateLeft(Node.Parent); + Node := FRoot; + end; + end + else + begin + TempNode := Node.Parent.Left; + if TempNode = nil then + begin + Node := Node.Parent; + Continue; + end; + if TempNode.Color = tcRed then + begin + TempNode.Color := tcBlack; + Node.Parent.Color := tcRed; + RotateRight(Node.Parent); + TempNode := Node.Parent.Left; + end; + if (TempNode.Left.Color = tcBlack) and (TempNode.Right.Color = tcBlack) then + begin + TempNode.Color := tcRed; + Node := Node.Parent; + end + else + begin + if TempNode.Left.Color = tcBlack then + begin + TempNode.Right.Color := tcBlack; + TempNode.Color := tcRed; + RotateLeft(TempNode); + TempNode := Node.Parent.Left; + end; + TempNode.Color := Node.Parent.Color; + Node.Parent.Color := tcBlack; + if TempNode.Left <> nil then + TempNode.Left.Color := tcBlack; + RotateRight(Node.Parent); + Node := FRoot; + end; + end; + end; + Node.Color := tcBlack; + end; + +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + // locate AInterface in the tree + Current := FRoot; + while Current <> nil do + begin + Comp := FComparator(AInterface, Current.Obj); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Exit; + // Remove + if (Current.Left = nil) or (Current.Right = nil) then + Save := Current + else + begin // Successor in Save + if Current.Right <> nil then + begin + Save := Current.Right; + while Save.Left <> nil do // Minimum + Save := Save.Left; + end + else + begin + Save := Current.Parent; + while (Save <> nil) and (Current = Save.Right) do + begin + Current := Save; + Save := Save.Parent; + end; + end; + end; + if Save.Left <> nil then + Node := Save.Left + else + Node := Save.Right; + if Node <> nil then + begin + Node.Parent := Save.Parent; + if Save.Parent = nil then + FRoot := Node + else + if Save = Save.Parent.Left then + Save.Parent.Left := Node + else + Save.Parent.Right := Node; + if Save.Color = tcBlack then + Correction(Node); + end + else + if Save.Parent = nil then + FRoot := nil + else + begin + if Save.Color = tcBlack then + Correction(Save); + if Save.Parent <> nil then + if Save = Save.Parent.Left then + Save.Parent.Left := nil + else + if Save = Save.Parent.Right then + Save.Parent.Right := nil + end; + {$IFDEF CLR} + Save.Free; + {$ELSE} + FreeMem(Save); + {$ENDIF CLR} + Dec(FCount); +end; + +function TJclIntfBinaryTree.RemoveAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclIntfBinaryTree.RetainAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; +end; + +procedure TJclIntfBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclIntfBinaryTree.Size: Integer; +begin + Result := FCount; +end; + +//=== { TJclStrBinaryTree } ================================================== + +constructor TJclStrBinaryTree.Create(AComparator: TStrCompare = nil); +begin + inherited Create; + if Assigned(AComparator) then + FComparator := AComparator + else + FComparator := @StrSimpleCompare; + FTraverseOrder := toPreOrder; +end; + +destructor TJclStrBinaryTree.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TJclStrBinaryTree.Add(const AString: string): Boolean; +var + NewNode: PJclStrBinaryNode; + Current, Save: PJclStrBinaryNode; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + {$IFDEF CLR} + NewNode := TJclStrBinaryNode.Create; + {$ELSE} + NewNode := AllocMem(SizeOf(TJclStrBinaryNode)); + {$ENDIF CLR} + NewNode.Str := AString; + // Insert into right place + Save := nil; + Current := FRoot; + while Current <> nil do + begin + Save := Current; + if FComparator(NewNode.Str, Current.Str) < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if FComparator(NewNode.Str, Save.Str) < 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + // RB balanced + NewNode.Color := tcRed; + while (NewNode <> FRoot) and (NewNode.Parent.Color = tcRed) do + begin + if (NewNode.Parent.Parent <> nil) and (NewNode.Parent = NewNode.Parent.Parent.Left) then + begin + Current := NewNode.Parent.Parent.Right; + if (Current <> nil) and (Current.Color = tcRed) then + begin + NewNode.Parent.Color := tcBlack; + Current.Color := tcBlack; + NewNode.Parent.Parent.Color := tcRed; + NewNode := NewNode.Parent.Parent; + end + else + begin + if NewNode = NewNode.Parent.Right then + begin + NewNode := NewNode.Parent; + RotateLeft(NewNode); + end; + NewNode.Parent.Color := tcBlack; + NewNode.Parent.Parent.Color := tcRed; + RotateRight(NewNode.Parent.Parent); + end; + end + else + begin + if NewNode.Parent.Parent = nil then + Current := nil + else + Current := NewNode.Parent.Parent.Left; + if (Current <> nil) and (Current.Color = tcRed) then + begin + NewNode.Parent.Color := tcBlack; + Current.Color := tcBlack; + NewNode.Parent.Parent.Color := tcRed; + NewNode := NewNode.Parent.Parent; + end + else + begin + if NewNode = NewNode.Parent.Left then + begin + NewNode := NewNode.Parent; + RotateRight(NewNode); + end; + NewNode.Parent.Color := tcBlack; + if NewNode.Parent.Parent <> nil then + NewNode.Parent.Parent.Color := tcRed; + RotateLeft(NewNode.Parent.Parent); + end; + end; + end; + FRoot.Color := tcBlack; + Inc(FCount); + Result := True; +end; + +function TJclStrBinaryTree.AddAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; +{ + +function TJclStrBinaryTree.GetAsStrings: TStrings; +begin + Result := TStringList.Create; + try + AppendToStrings(Result); + except + Result.Free; + raise; + end; +end; + +procedure TJclStrBinaryTree.LoadFromStrings(Strings: TStrings); +begin + Clear; + AppendFromStrings(Strings); +end; + +procedure TJclStrBinaryTree.AppendToStrings(Strings: TStrings); +var + It: IJclStrIterator; +begin + It := First; + Strings.BeginUpdate; + try + while It.HasNext do + Strings.Add(It.Next); + finally + Strings.EndUpdate; + end; +end; + +procedure TJclStrBinaryTree.SaveToStrings(Strings: TStrings); +begin + Strings.Clear; + AppendToStrings(Strings); +end; + +procedure TJclStrBinaryTree.AppendFromStrings(Strings: TStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Add(Strings[I]); +end; + +function TJclStrBinaryTree.GetAsDelimited(Separator: string): string; +var + It: IJclStrIterator; +begin + It := First; + Result := ''; + if It.HasNext then + Result := It.Next; + while It.HasNext do + Result := Result + Separator + It.Next; +end; + +procedure TJclStrBinaryTree.LoadDelimited(AString, Separator: string); +begin + Clear; + AppendDelimited(AString, Separator); +end; + +procedure TJclStrBinaryTree.AppendDelimited(AString, Separator: string); +begin + DCLAppendDelimited(Self, AString, Separator); +end; +} + +procedure TJclStrBinaryTree.Clear; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} + +{$IFDEF RECURSIVE} + procedure FreeChild(Node: PJclStrBinaryNode); + begin + if Node.Left <> nil then + FreeChild(Node.Left); + if Node.Right <> nil then + FreeChild(Node.Right); + Node.Str := ''; // Force Release + FreeMem(Node); + end; +{$ELSE} +var + Current: PJclStrBinaryNode; + Save: PJclStrBinaryNode; +{$ENDIF RECURSIVE} + +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + {$IFDEF RECURSIVE} + // recursive version + if FRoot <> nil then + begin + FreeChild(FRoot); + FRoot := nil; + end; + {$ELSE} + // iterative version + Current := FRoot; + while Current <> nil do + begin + if Current.Left <> nil then + Current := Current.Left + else + if Current.Right <> nil then + Current := Current.Right + else + begin + Current.Str := ''; // Force Release + if Current.Parent = nil then // Root + begin + {$IFDEF CLR} + Current.Free; + {$ELSE} + FreeMem(Current); + {$ENDIF CLR} + Current := nil; + FRoot := nil; + end + else + begin + Save := Current; + Current := Current.Parent; + if Save = Current.Right then // True = from Right + begin + {$IFDEF CLR} + Save.Free; + {$ELSE} + FreeMem(Save); + {$ENDIF CLR} + Current.Right := nil; + end + else + begin + {$IFDEF CLR} + Save.Free; + {$ELSE} + FreeMem(Save); + {$ENDIF CLR} + Current.Left := nil; + end + end; + end; + end; + {$ENDIF RECURSIVE} + FCount := 0; +end; + +function TJclStrBinaryTree.Clone: TObject; +var + NewTree: TJclStrBinaryTree; + + function CloneNode(Node, Parent: PJclStrBinaryNode): PJclStrBinaryNode; + begin + if Node <> nil then + begin + {$IFDEF CLR} + Result := TJclStrBinaryNode.Create; + {$ELSE} + GetMem(Result, SizeOf(TJclStrBinaryNode)); + {$ENDIF CLR} + Result.Str := Node.Str; + Result.Color := Node.Color; + Result.Parent := Parent; + Result.Left := CloneNode(Node.Left, Result); // recursive call + Result.Right := CloneNode(Node.Right, Result); // recursive call + end + else + Result := nil; + end; + +begin + NewTree := TJclStrBinaryTree.Create(FComparator); + NewTree.FCount := FCount; + NewTree.FRoot := CloneNode(FRoot, nil); + Result := NewTree; +end; + +function TJclStrBinaryTree.Contains(const AString: string): Boolean; +var + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} + Comp: Integer; + +{$IFDEF RECURSIVE} + function ContainsChild(Node: PJclStrBinaryNode): Boolean; + begin + Result := False; + if Node = nil then + Exit; + Comp := FComparator(Node.Str, AString); + if Comp = 0 then + Result := True + else + if Comp > 0 then + Result := ContainsChild(Node.Left) + else + Result := ContainsChild(Node.Right) + end; +{$ELSE} +var + Current: PJclStrBinaryNode; +{$ENDIF RECURSIVE} + +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + {$IFDEF RECURSIVE} + // recursive version + Result := ContainsChild(FRoot); + {$ELSE} + // iterative version + Current := FRoot; + while Current <> nil do + begin + Comp := FComparator(Current.Str, AString); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$ENDIF RECURSIVE} +end; + +function TJclStrBinaryTree.ContainsAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); +end; + +function TJclStrBinaryTree.Equals(ACollection: IJclStrCollection): Boolean; +var + It, ItSelf: IJclStrIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FCount <> ACollection.Size then + Exit; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if FComparator(ItSelf.Next, It.Next) <> 0 then + Exit; + Result := True; +end; + +function TJclStrBinaryTree.First: IJclStrIterator; +begin + case GetTraverseOrder of + toPreOrder: + Result := TPreOrderStrItr.Create(Self, FRoot); + toOrder: + Result := TInOrderStrItr.Create(Self, FRoot); + toPostOrder: + Result := TPostOrderStrItr.Create(Self, FRoot); + end; +end; + +function TJclStrBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclStrBinaryTree.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclStrBinaryTree.Last: IJclStrIterator; +var + Start: PJclStrBinaryNode; +begin + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TPreOrderStrItr.Create(Self, Start); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TInOrderStrItr.Create(Self, Start); + end; + toPostOrder: + Result := TPostOrderStrItr.Create(Self, Start); + end; +end; + +function TJclStrBinaryTree.Remove(const AString: string): Boolean; +var + Current: PJclStrBinaryNode; + Node: PJclStrBinaryNode; + Save: PJclStrBinaryNode; + Comp: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} + + procedure Correction(Node: PJclStrBinaryNode); + var + TempNode: PJclStrBinaryNode; + begin + while (Node <> FRoot) and (Node.Color = tcBlack) do + begin + if Node = Node.Parent.Left then + begin + TempNode := Node.Parent.Right; + if TempNode = nil then + begin + Node := Node.Parent; + Continue; + end; + if TempNode.Color = tcRed then + begin + TempNode.Color := tcBlack; + Node.Parent.Color := tcRed; + RotateLeft(Node.Parent); + TempNode := Node.Parent.Right; + end; + if (TempNode.Left <> nil) and (TempNode.Left.Color = tcBlack) and + (TempNode.Right <> nil) and (TempNode.Right.Color = tcBlack) then + begin + TempNode.Color := tcRed; + Node := Node.Parent; + end + else + begin + if (TempNode.Right <> nil) and (TempNode.Right.Color = tcBlack) then + begin + TempNode.Left.Color := tcBlack; + TempNode.Color := tcRed; + RotateRight(TempNode); + TempNode := Node.Parent.Right; + end; + TempNode.Color := Node.Parent.Color; + Node.Parent.Color := tcBlack; + if TempNode.Right <> nil then + TempNode.Right.Color := tcBlack; + RotateLeft(Node.Parent); + Node := FRoot; + end; + end + else + begin + TempNode := Node.Parent.Left; + if TempNode = nil then + begin + Node := Node.Parent; + Continue; + end; + if TempNode.Color = tcRed then + begin + TempNode.Color := tcBlack; + Node.Parent.Color := tcRed; + RotateRight(Node.Parent); + TempNode := Node.Parent.Left; + end; + if (TempNode.Left.Color = tcBlack) and (TempNode.Right.Color = tcBlack) then + begin + TempNode.Color := tcRed; + Node := Node.Parent; + end + else + begin + if TempNode.Left.Color = tcBlack then + begin + TempNode.Right.Color := tcBlack; + TempNode.Color := tcRed; + RotateLeft(TempNode); + TempNode := Node.Parent.Left; + end; + TempNode.Color := Node.Parent.Color; + Node.Parent.Color := tcBlack; + if TempNode.Left <> nil then + TempNode.Left.Color := tcBlack; + RotateRight(Node.Parent); + Node := FRoot; + end; + end + end; + Node.Color := tcBlack; + end; + +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + // locate AObject in the tree + Current := FRoot; + while Current <> nil do + begin + Comp := FComparator(AString, Current.Str); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Exit; + // Remove + if (Current.Left = nil) or (Current.Right = nil) then + Save := Current + else + begin // Successor in Save + if Current.Right <> nil then + begin + Save := Current.Right; + while Save.Left <> nil do // Minimum + Save := Save.Left; + end + else + begin + Save := Current.Parent; + while (Save <> nil) and (Current = Save.Right) do + begin + Current := Save; + Save := Save.Parent; + end; + end; + end; + if Save.Left <> nil then + Node := Save.Left + else + Node := Save.Right; + if Node <> nil then + begin + Node.Parent := Save.Parent; + if Save.Parent = nil then + FRoot := Node + else + if Save = Save.Parent.Left then + Save.Parent.Left := Node + else + Save.Parent.Right := Node; + if Save.Color = tcBlack then // Correction + Correction(Node); + end + else + if Save.Parent = nil then + FRoot := nil + else + begin + if Save.Color = tcBlack then // Correction + Correction(Save); + if Save.Parent <> nil then + if Save = Save.Parent.Left then + Save.Parent.Left := nil + else + if Save = Save.Parent.Right then + Save.Parent.Right := nil + end; + {$IFDEF CLR} + Save.Free; + {$ELSE} + FreeMem(Save); + {$ENDIF CLR} + Dec(FCount); +end; + +function TJclStrBinaryTree.RemoveAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclStrBinaryTree.RetainAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; +end; + +procedure TJclStrBinaryTree.RotateLeft(Node: PJclStrBinaryNode); +var + TempNode: PJclStrBinaryNode; +begin + if Node = nil then + Exit; + TempNode := Node.Right; + // if TempNode = nil then Exit; + Node.Right := TempNode.Left; + if TempNode.Left <> nil then + TempNode.Left.Parent := Node; + TempNode.Parent := Node.Parent; + if Node.Parent = nil then + FRoot := TempNode + else + if Node.Parent.Left = Node then + Node.Parent.Left := TempNode + else + Node.Parent.Right := TempNode; + TempNode.Left := Node; + Node.Parent := TempNode; +end; + +procedure TJclStrBinaryTree.RotateRight(Node: PJclStrBinaryNode); +var + TempNode: PJclStrBinaryNode; +begin + if Node = nil then + Exit; + TempNode := Node.Left; + // if TempNode = nil then Exit; + Node.Left := TempNode.Right; + if TempNode.Right <> nil then + TempNode.Right.Parent := Node; + TempNode.Parent := Node.Parent; + if Node.Parent = nil then + FRoot := TempNode + else + if Node.Parent.Right = Node then + Node.Parent.Right := TempNode + else + Node.Parent.Left := TempNode; + TempNode.Right := Node; + Node.Parent := TempNode; +end; + +procedure TJclStrBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclStrBinaryTree.Size: Integer; +begin + Result := FCount; +end; + +//=== { TJclBinaryTree } ===================================================== + +constructor TJclBinaryTree.Create(AComparator: TCompare = nil); +begin + inherited Create; + if Assigned(AComparator) then + FComparator := AComparator + else + FComparator := @SimpleCompare; + FTraverseOrder := toPreOrder; +end; + +destructor TJclBinaryTree.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TJclBinaryTree.Add(AObject: TObject): Boolean; +var + NewNode: PJclBinaryNode; + Current, Save: PJclBinaryNode; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + {$IFDEF CLR} + NewNode := TJclBinaryNode.Create; + {$ELSE} + NewNode := AllocMem(SizeOf(TJclBinaryNode)); + {$ENDIF CLR} + NewNode.Obj := AObject; + // Insert into right place + Save := nil; + Current := FRoot; + while Current <> nil do + begin + Save := Current; + if FComparator(NewNode.Obj, Current.Obj) < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + NewNode.Parent := Save; + if Save = nil then + FRoot := NewNode + else + if FComparator(NewNode.Obj, Save.Obj) < 0 then + Save.Left := NewNode + else + Save.Right := NewNode; + // RB balanced + NewNode.Color := tcRed; + while (NewNode <> FRoot) and (NewNode.Parent.Color = tcRed) do + begin + if (NewNode.Parent.Parent <> nil) and (NewNode.Parent = NewNode.Parent.Parent.Left) then + begin + Current := NewNode.Parent.Parent.Right; + if Current.Color = tcRed then + begin + NewNode.Parent.Color := tcBlack; + Current.Color := tcBlack; + NewNode.Parent.Parent.Color := tcRed; + NewNode := NewNode.Parent.Parent; + end + else + begin + if NewNode = NewNode.Parent.Right then + begin + NewNode := NewNode.Parent; + RotateLeft(NewNode); + end; + NewNode.Parent.Color := tcBlack; + NewNode.Parent.Parent.Color := tcRed; + RotateRight(NewNode.Parent.Parent); + end; + end + else + begin + if NewNode.Parent.Parent = nil then + Current := nil + else + Current := NewNode.Parent.Parent.Left; + if (Current <> nil) and (Current.Color = tcRed) then + begin + NewNode.Parent.Color := tcBlack; + Current.Color := tcBlack; + NewNode.Parent.Parent.Color := tcRed; + NewNode := NewNode.Parent.Parent; + end + else + begin + if NewNode = NewNode.Parent.Left then + begin + NewNode := NewNode.Parent; + RotateRight(NewNode); + end; + NewNode.Parent.Color := tcBlack; + if NewNode.Parent.Parent <> nil then + NewNode.Parent.Parent.Color := tcRed; + RotateLeft(NewNode.Parent.Parent); + end; + end; + end; + FRoot.Color := tcBlack; + Inc(FCount); + Result := True; +end; + +function TJclBinaryTree.AddAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; + +procedure TJclBinaryTree.Clear; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} + +{$IFDEF RECURSIVE} + procedure FreeChild(Node: PJclBinaryNode); + begin + if Node.Left <> nil then + FreeChild(Node.Left); + if Node.Right <> nil then + FreeChild(Node.Right); + Node.Obj := nil; // Force Release + FreeMem(Node); + end; +{$ELSE} +var + Current: PJclBinaryNode; + Save: PJclBinaryNode; +{$ENDIF RECURSIVE} + +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + {$IFDEF RECURSIVE} + // recursive version + if FRoot <> nil then + begin + FreeChild(FRoot); + FRoot := nil; + end; + {$ELSE} + // iterative version + Current := FRoot; + while Current <> nil do + begin + if Current.Left <> nil then + Current := Current.Left + else + if Current.Right <> nil then + Current := Current.Right + else + begin + Current.Obj := nil; // Force Release + if Current.Parent = nil then // Root + begin + {$IFDEF CLR} + Current.Free; + {$ELSE} + FreeMem(Current); + {$ENDIF CLR} + Current := nil; + FRoot := nil; + end + else + begin + Save := Current; + Current := Current.Parent; + if Save = Current.Right then // True = from Right + begin + {$IFDEF CLR} + Save.Free; + {$ELSE} + FreeMem(Save); + {$ENDIF CLR} + Current.Right := nil; + end + else + begin + {$IFDEF CLR} + Save.Free; + {$ELSE} + FreeMem(Save); + {$ENDIF CLR} + Current.Left := nil; + end + end; + end; + end; + {$ENDIF RECURSIVE} + FCount := 0; +end; + +function TJclBinaryTree.Clone: TObject; +var + NewTree: TJclBinaryTree; + + function CloneNode(Node, Parent: PJclBinaryNode): PJclBinaryNode; + begin + if Node <> nil then + begin + {$IFDEF CLR} + Result := TJclBinaryNode.Create; + {$ELSE} + GetMem(Result, SizeOf(TJclBinaryNode)); + {$ENDIF CLR} + Result.Obj := Node.Obj; + Result.Color := Node.Color; + Result.Parent := Parent; + Result.Left := CloneNode(Node.Left, Result); // recursive call + Result.Right := CloneNode(Node.Right, Result); // recursive call + end + else + Result := nil; + end; + +begin + NewTree := TJclBinaryTree.Create(FComparator); + NewTree.FCount := FCount; + NewTree.FRoot := CloneNode(FRoot, nil); + Result := NewTree; +end; + +function TJclBinaryTree.Contains(AObject: TObject): Boolean; +var + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} + Comp: Integer; + +{$IFDEF RECURSIVE} + function ContainsChild(Node: PJclBinaryNode): Boolean; + begin + Result := False; + if Node = nil then + Exit; + Comp := FComparator(Node.Obj, AObject); + if Comp = 0 then + Result := True + else + if Comp > 0 then + Result := ContainsChild(Node.Left) + else + Result := ContainsChild(Node.Right); + end; +{$ELSE} +var + Current: PJclBinaryNode; +{$ENDIF RECURSIVE} + +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + {$IFDEF RECURSIVE} + // recursive version + Result := ContainsChild(FRoot); + {$ELSE} + // iterative version + Current := FRoot; + while Current <> nil do + begin + Comp := FComparator(Current.Obj, AObject); + if Comp = 0 then + begin + Result := True; + Break; + end + else + if Comp > 0 then + Current := Current.Left + else + Current := Current.Right; + end; + {$ENDIF RECURSIVE} +end; + +function TJclBinaryTree.ContainsAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); +end; + +function TJclBinaryTree.Equals(ACollection: IJclCollection): Boolean; +var + It, ItSelf: IJclIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FCount <> ACollection.Size then + Exit; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if FComparator(ItSelf.Next, It.Next) <> 0 then + Exit; + Result := True; +end; + +function TJclBinaryTree.First: IJclIterator; +begin + case GetTraverseOrder of + toPreOrder: + Result := TPreOrderItr.Create(Self, FRoot); + toOrder: + Result := TInOrderItr.Create(Self, FRoot); + toPostOrder: + Result := TPostOrderItr.Create(Self, FRoot); + end; +end; + +function TJclBinaryTree.GetTraverseOrder: TJclTraverseOrder; +begin + Result := FTraverseOrder; +end; + +function TJclBinaryTree.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclBinaryTree.Last: IJclIterator; +var + Start: PJclBinaryNode; +begin + Start := FRoot; + case FTraverseOrder of + toPreOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TPreOrderItr.Create(Self, Start); + end; + toOrder: + begin + if Start <> nil then + while Start.Right <> nil do + Start := Start.Right; + Result := TInOrderItr.Create(Self, Start); + end; + toPostOrder: + Result := TPostOrderItr.Create(Self, Start); + end; +end; + +function TJclBinaryTree.Remove(AObject: TObject): Boolean; +var + Current: PJclBinaryNode; + Node: PJclBinaryNode; + Save: PJclBinaryNode; + Comp: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} + + procedure Correction(Node: PJclBinaryNode); + var + TempNode: PJclBinaryNode; + begin + while (Node <> FRoot) and (Node.Color = tcBlack) do + begin + if Node = Node.Parent.Left then + begin + TempNode := Node.Parent.Right; + if TempNode = nil then + begin + Node := Node.Parent; + Continue; + end; + if TempNode.Color = tcRed then + begin + TempNode.Color := tcBlack; + Node.Parent.Color := tcRed; + RotateLeft(Node.Parent); + TempNode := Node.Parent.Right; + end; + if (TempNode.Left <> nil) and (TempNode.Left.Color = tcBlack) and + (TempNode.Right <> nil) and (TempNode.Right.Color = tcBlack) then + begin + TempNode.Color := tcRed; + Node := Node.Parent; + end + else + begin + if (TempNode.Right <> nil) and (TempNode.Right.Color = tcBlack) then + begin + TempNode.Left.Color := tcBlack; + TempNode.Color := tcRed; + RotateRight(TempNode); + TempNode := Node.Parent.Right; + end; + TempNode.Color := Node.Parent.Color; + Node.Parent.Color := tcBlack; + if TempNode.Right <> nil then + TempNode.Right.Color := tcBlack; + RotateLeft(Node.Parent); + Node := FRoot; + end; + end + else + begin + TempNode := Node.Parent.Left; + if TempNode = nil then + begin + Node := Node.Parent; + Continue; + end; + if TempNode.Color = tcRed then + begin + TempNode.Color := tcBlack; + Node.Parent.Color := tcRed; + RotateRight(Node.Parent); + TempNode := Node.Parent.Left; + end; + if (TempNode.Left.Color = tcBlack) and (TempNode.Right.Color = tcBlack) then + begin + TempNode.Color := tcRed; + Node := Node.Parent; + end + else + begin + if TempNode.Left.Color = tcBlack then + begin + TempNode.Right.Color := tcBlack; + TempNode.Color := tcRed; + RotateLeft(TempNode); + TempNode := Node.Parent.Left; + end; + TempNode.Color := Node.Parent.Color; + Node.Parent.Color := tcBlack; + if TempNode.Left <> nil then + TempNode.Left.Color := tcBlack; + RotateRight(Node.Parent); + Node := FRoot; + end; + end + end; + Node.Color := tcBlack; + end; + +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + // locate AObject in the tree + Current := FRoot; + while Current <> nil do + begin + Comp := FComparator(AObject, Current.Obj); + if Comp = 0 then + Break + else + if Comp < 0 then + Current := Current.Left + else + Current := Current.Right; + end; + if Current = nil then + Exit; + // Remove + if (Current.Left = nil) or (Current.Right = nil) then + Save := Current + else + begin // Successor in Save + if Current.Right <> nil then + begin + Save := Current.Right; + while Save.Left <> nil do // Minimum + Save := Save.Left; + end + else + begin + Save := Current.Parent; + while (Save <> nil) and (Current = Save.Right) do + begin + Current := Save; + Save := Save.Parent; + end; + end; + end; + if Save.Left <> nil then + Node := Save.Left + else + Node := Save.Right; + if Node <> nil then + begin + Node.Parent := Save.Parent; + if Save.Parent = nil then + FRoot := Node + else + if Save = Save.Parent.Left then + Save.Parent.Left := Node + else + Save.Parent.Right := Node; + if Save.Color = tcBlack then // Correction + Correction(Node); + end + else + if Save.Parent = nil then + FRoot := nil + else + begin + if Save.Color = tcBlack then // Correction + Correction(Save); + if Save.Parent <> nil then + if Save = Save.Parent.Left then + Save.Parent.Left := nil + else + if Save = Save.Parent.Right then + Save.Parent.Right := nil + end; + {$IFDEF CLR} + Save.Free; + {$ELSE} + FreeMem(Save); + {$ENDIF CLR} + Dec(FCount); +end; + +function TJclBinaryTree.RemoveAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclBinaryTree.RetainAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; +end; + +procedure TJclBinaryTree.RotateLeft(Node: PJclBinaryNode); +var + TempNode: PJclBinaryNode; +begin + if Node = nil then + Exit; + TempNode := Node.Right; + // if TempNode = nil then Exit; + Node.Right := TempNode.Left; + if TempNode.Left <> nil then + TempNode.Left.Parent := Node; + TempNode.Parent := Node.Parent; + if Node.Parent = nil then + FRoot := TempNode + else + if Node.Parent.Left = Node then + Node.Parent.Left := TempNode + else + Node.Parent.Right := TempNode; + TempNode.Left := Node; + Node.Parent := TempNode; +end; + +procedure TJclBinaryTree.RotateRight(Node: PJclBinaryNode); +var + TempNode: PJclBinaryNode; +begin + if Node = nil then + Exit; + TempNode := Node.Left; + // if TempNode = nil then Exit; + Node.Left := TempNode.Right; + if TempNode.Right <> nil then + TempNode.Right.Parent := Node; + TempNode.Parent := Node.Parent; + if Node.Parent = nil then + FRoot := TempNode + else + if Node.Parent.Right = Node then + Node.Parent.Right := TempNode + else + Node.Parent.Left := TempNode; + TempNode.Right := Node; + Node.Parent := TempNode; +end; + +procedure TJclBinaryTree.SetTraverseOrder(Value: TJclTraverseOrder); +begin + FTraverseOrder := Value; +end; + +function TJclBinaryTree.Size: Integer; +begin + Result := FCount; +end; + +// History: + +// $Log: JclBinaryTrees.pas,v $ +// Revision 1.9 2005/05/05 20:08:42 ahuser +// JCL.NET support +// +// Revision 1.8 2005/03/08 08:33:15 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.7 2005/03/04 06:40:25 marquardt +// changed overloaded constructors to constructor with default parameter (BCB friendly) +// +// Revision 1.6 2005/03/03 08:02:56 marquardt +// various style cleanings, bugfixes and improvements +// +// Revision 1.5 2005/03/02 09:59:30 dade2004 +// Added +// -TJclStrCollection in JclContainerIntf +// Every common methods for IJclStrCollection are implemented here +// +// -Every class that implement IJclStrCollection now derive from TJclStrCollection instead of TJclAbstractContainer +// -Every abstract method in TJclStrCollection has been marked as "override" in descendent classes +// +// DCLAppendDelimited has been removed from JclAlgorothms, his body has been fixed for a bug and put into +// relative method in TJclStrCollection +// +// Revision 1.4 2005/02/27 11:36:20 marquardt +// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec +// +// Revision 1.3 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.2 2005/02/26 16:42:08 marquardt +// deactivated THREADSAFE and fixed bugs stemming from that +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclBorlandTools.pas b/official/1.96/source/common/JclBorlandTools.pas new file mode 100644 index 0000000..700d7dc --- /dev/null +++ b/official/1.96/source/common/JclBorlandTools.pas @@ -0,0 +1,4486 @@ +{**************************************************************************************************} +{ } +{ 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://codecentral.borland.com): } +{ - "IDE Integration pack for C#Builder 1.0" http://codecentral.borland.com/Item.aspx?ID=21334 } +{ - "IDE Integration pack for Delphi 8" http://codecentral.borland.com/Item.aspx?ID=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 } +{ } +{**************************************************************************************************} +{ } +{ Unit owner: Petr Vones } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2006/02/08 19:45:58 $ + +unit JclBorlandTools; + +{$I jcl.inc} +{$I crossplatform.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, IniFiles, Contnrs, + JclBase, JclSysUtils; + +// Various definitions +type + EJclBorRADException = class (Exception); + + TJclBorRADToolKind = (brDelphi, brCppBuilder, brBorlandDevStudio); + {$IFDEF KYLIX} + TJclBorRADToolEdition = (deOPEN, dePRO, deSVR); + {$ELSE} + TJclBorRADToolEdition = (deSTD, dePRO, deCSS, deARC); + {$ENDIF KYLIX} + TJclBorRADToolPath = string; + +const + SupportedDelphiVersions = [5, 6, 7, 8, 9, 10]; + SupportedBCBVersions = [5, 6, 10]; + SupportedBDSVersions = [1, 2, 3, 4]; + + // 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'; + + SourceExtensionDelphiPackage = '.dpk'; + SourceExtensionBCBPackage = '.bpk'; + SourceExtensionDelphiProject = '.dpr'; + SourceExtensionBCBProject = '.bpr'; + BinaryExtensionPackage = '.bpl'; + BinaryExtensionLibrary = '.dll'; + BinaryExtensionExecutable = '.exe'; + CompilerExtensionDCP = '.dcp'; + CompilerExtensionBPI = '.bpi'; + CompilerExtensionLIB = '.lib'; + CompilerExtensionTDS = '.tds'; + CompilerExtensionMAP = '.map'; + CompilerExtensionDEF = '.def'; + + ProjectTypePackage = 'package'; + ProjectTypeLibrary = 'library'; + ProjectTypeProgram = 'program'; + + PersonalityDelphi = 'Delphi'; + PersonalityBCB = 'C++Builder'; + PersonalityCSB = 'C#Builder'; + PersonalityBDS = 'Borland Developer Studio'; + + DOFDirectoriesSection = 'Directories'; + DOFUnitOutputDirKey = 'UnitOutputDir'; + DOFSearchPathName = 'SearchPath'; + DOFLinkerSection = 'Linker'; + DOFPackagesKey = 'Packages'; + DOFCompilerSection = 'Compiler'; + DOFPackageNoLinkKey = 'PackageNoLink'; + + {$IFDEF KYLIX} + BorRADToolEditionIDs: array [TJclBorRADToolEdition] of PChar = + ('OPEN', 'PRO', 'SVR'); + {$ELSE ~KYLIX} + BorRADToolEditionIDs: array [TJclBorRADToolEdition] of PChar = + ('STD', 'PRO', 'CSS', 'ARC'); // 'ARC' is an assumption + {$ENDIF ~KYLIX} + +// Installed versions information classes +type + TJclBorPersonality = (bpDelphi32, bpBCBuilder32, bpDelphiNet32, bpDelphiNet64, + bpCSBuilder32, bpCSBuilder64); + // bpDelphi64, bpBCBuilder64); + + TJclBorPersonalities = set of TJclBorPersonality; + + TJclBorRADToolInstallation = class; + + TJclBorRADToolInstallationObject = class(TInterfacedObject) + private + FInstallation: TJclBorRADToolInstallation; + protected + constructor Create(AInstallation: TJclBorRADToolInstallation); + public + property Installation: TJclBorRADToolInstallation read FInstallation; + end; + + {$IFDEF MSWINDOWS} + TJclBorlandOpenHelp = class(TJclBorRADToolInstallationObject) + private + function GetContentFileName: string; + function GetIndexFileName: string; + function GetLinkFileName: string; + function GetGidFileName: string; + function GetProjectFileName: string; + function ReadFileName(const FormatName: string): string; + public + 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 IndexFileName: string read GetIndexFileName; + property LinkFileName: string read GetLinkFileName; + property ProjectFileName: string read GetProjectFileName; + end; + {$ENDIF MSWINDOWS} + + 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 + constructor Create(AInstallation: TJclBorRADToolInstallation); + procedure CheckIndex(Index: Integer); + public + property Count: Integer read GetCount write SetCount; + function IndexOfPath(const Value: string): Integer; + function IndexOfTitle(const Value: string): 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 + FDisabledPackages: TStringList; + FKnownPackages: TStringList; + FKnownIDEPackages: TStringList; + FExperts: TStringList; + function GetCount: Integer; + function GetIDECount: Integer; + function GetExpertCount: Integer; + function GetPackageDescriptions(Index: Integer): string; + function GetIDEPackageDescriptions(Index: Integer): string; + function GetExpertDescriptions(Index: Integer): string; + function GetPackageDisabled(Index: Integer): Boolean; + function GetPackageFileNames(Index: Integer): string; + function GetIDEPackageFileNames(Index: Integer): string; + function GetExpertFileNames(Index: Integer): string; + protected + constructor Create(AInstallation: TJclBorRADToolInstallation); + function PackageEntryToFileName(const Entry: string): string; + procedure ReadPackages; + procedure RemoveDisabled(const FileName: string); + public + destructor Destroy; override; + function AddPackage(const FileName, Description: string): Boolean; + function AddIDEPackage(const FileName, Description: string): Boolean; + function AddExpert(const FileName, Description: string): Boolean; + function RemovePackage(const FileName: string): Boolean; + function RemoveIDEPackage(const FileName: string): Boolean; + function RemoveExpert(const FileName: string): Boolean; + property Count: Integer read GetCount; + property IDECount: Integer read GetIDECount; + property ExpertCount: Integer read GetExpertCount; + property PackageDescriptions[Index: Integer]: string read GetPackageDescriptions; + property IDEPackageDescriptions[Index: Integer]: string read GetIDEPackageDescriptions; + property ExpertDescriptions[Index: Integer]: string read GetExpertDescriptions; + property PackageFileNames[Index: Integer]: string read GetPackageFileNames; + property IDEPackageFileNames[Index: Integer]: string read GetIDEPackageFileNames; + property ExpertFileNames[Index: Integer]: string read GetExpertFileNames; + property PackageDisabled[Index: Integer]: Boolean read GetPackageDisabled; + end; + + IJclCommandLineTool = interface + ['{A0034B09-A074-D811-847D-0030849E4592}'] + function GetExeName: string; + function GetOptions: TStrings; + function GetOutput: string; + function GetOutputCallback: TTextHandler; + procedure AddPathOption(const Option, Path: string); + function Execute(const CommandLine: string): Boolean; + procedure SetOutputCallback(const CallbackMethod: TTextHandler); + property ExeName: string read GetExeName; + property Options: TStrings read GetOptions; + property OutputCallback: TTextHandler write SetOutputCallback; + property Output: string read GetOutput; + end; + + EJclCommandLineToolError = class(EJclError); + + TJclCommandLineTool = class(TInterfacedObject, IJclCommandLineTool) + private + FExeName: string; + FOptions: TStringList; + FOutput: string; + FOutputCallback: TTextHandler; + protected + function GetExeName: string; + function GetOutput: string; + function GetOptions: TStrings; + function GetOutputCallback: TTextHandler; + procedure SetOutputCallback(const CallbackMethod: TTextHandler); + constructor Create(const AExeName: string); + procedure AddPathOption(const Option, Path: string); + function Execute(const CommandLine: string): Boolean; + property ExeName: string read GetExeName; + property Output: string read GetOutput; + public + destructor Destroy; override; + end; + + TJclBorlandCommandLineTool = class(TJclBorRADToolInstallationObject, IJclCommandLineTool) + private + FOptions: TStringList; + FOutputCallback: TTextHandler; + FOutput: string; + protected + constructor Create(AInstallation: TJclBorRADToolInstallation); virtual; + procedure CheckOutputValid; + function GetExeName: string; virtual; + function GetFileName: string; + function GetOptions: TStrings; + function GetOutputCallback: TTextHandler; + procedure SetOutputCallback(const CallbackMethod: TTextHandler); + function GetOutput: string; + public + destructor Destroy; override; + procedure AddPathOption(const Option, Path: string); + function Execute(const CommandLine: string): Boolean; virtual; + property FileName: string read GetFileName; + property Output: string read GetOutput; + property OutputCallback: TTextHandler read FOutputCallback write SetOutputCallback; + property Options: TStrings read GetOptions; + end; + + TJclBCC32 = class(TJclBorlandCommandLineTool) + protected + constructor Create(AInstallation: TJclBorRADToolInstallation); override; + function GetExeName: string; override; + public + {$IFDEF KEEP_DEPRECATED} + function SupportsLibSuffix: Boolean; + {$ENDIF KEEP_DEPRECATED} + end; + + TJclDCC32 = class(TJclBorlandCommandLineTool) + protected + constructor Create(AInstallation: TJclBorRADToolInstallation); override; + function GetExeName: string; override; + procedure SaveOptionsToFile(const ConfigFileName: string); + procedure AddProjectOptions(const ProjectFileName, DCPPath: string); + function Compile(const ProjectFileName: string): Boolean; + public + function Execute(const CommandLine: string): Boolean; override; + function MakePackage(const PackageName, BPLPath, DCPPath: string; ExtraOptions: string = ''): Boolean; + function MakeProject(const ProjectName, OutputDir, DcpSearchPath: string; ExtraOptions: string = ''): Boolean; + procedure SetDefaultOptions; + {$IFDEF KEEP_DEPRECATED} + function SupportsLibSuffix: Boolean; + {$ENDIF KEEP_DEPRECATED} + end; + {$IFDEF KEEP_DEPRECATED} + TJclDCC = TJclDCC32; + {$ENDIF KEEP_DEPRECATED} + + TJclBpr2Mak = class(TJclBorlandCommandLineTool) + protected + function GetExeName: string; override; + end; + + TJclBorlandMake = class(TJclBorlandCommandLineTool) + protected + function GetExeName: string; override; + 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; + protected + constructor Create(AInstallation: TJclBorRADToolInstallation); + public + 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; + protected + constructor Create(AInstallation: TJclBorRADToolInstallation); + public + 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, clDcc32, clDccIL, clMake, clProj2Mak); + TCommandLineTools = set of TCommandLineTool; + + TJclBorRADToolInstallationClass = class of TJclBorRADToolInstallation; + + TJclBorRADToolInstallation = class(TObject) + private + FConfigData: TCustomIniFile; + FConfigDataLocation: string; + FGlobals: TStringList; + FRootDir: string; + FBinFolderName: string; + FBCC32: TJclBCC32; + 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; + FVersionNumber: Integer; + FVersionNumberStr: string; + FIDEVersionNumber: Integer; // Delphi 2005: 3 - Delphi 7: 7 + FMapCreate: Boolean; + {$IFDEF MSWINDOWS} + FMapLink: Boolean; + FMapDelete: Boolean; + {$ENDIF MSWINDOWS} + FCommandLineTools: TCommandLineTools; + FPersonalities: TJclBorPersonalities; + FOutputCallback: TTextHandler; + function GetSupportsLibSuffix: Boolean; + function GetBCC32: TJclBCC32; + function GetDCC32: TJclDCC32; + function GetBpr2Mak: TJclBpr2Mak; + function GetMake: IJclCommandLineTool; + function GetDebugDCUPath: string; + function GetDescription: string; + function GetEditionAsText: string; + function GetIdeExeFileName: string; + function GetGlobals: TStrings; + function GetIdeExeBuildNumber: string; + function GetIdePackages: TJclBorRADToolIdePackages; + function GetLatestUpdatePack: Integer; + function GetLibrarySearchPath: TJclBorRADToolPath; + function GetPalette: TJclBorRADToolPalette; + function GetRepository: TJclBorRADToolRepository; + function GetUpdateNeeded: Boolean; + function GetValid: Boolean; + procedure SetLibrarySearchPath(const Value: TJclBorRADToolPath); + function GetLibraryBrowsingPath: TJclBorRADToolPath; + procedure SetLibraryBrowsingPath(const Value: TJclBorRADToolPath); + procedure SetDebugDCUPath(const Value: string); + procedure SetOutputCallback(const Value: TTextHandler); + protected + constructor Create(const AConfigDataLocation: string); virtual; + + function LinkMapFile(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: string; virtual; + function GetBPLOutputPath: string; virtual; + function GetEnvironmentVariables: TStrings; virtual; + function GetVclIncludeDir: string; virtual; + function GetName: string; virtual; + procedure OutputString(const AText: string); + function OutputFileDelete(const FileName: string): Boolean; + public + 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): Boolean; + function AddToLibrarySearchPath(const Path: string): Boolean; + function AddToLibraryBrowsingPath(const Path: string): Boolean; + {$IFDEF KYLIX} + function ConfigFileName(const Extension: string): string; virtual; + {$ENDIF KYLIX} + function FindFolderInPath(Folder: string; List: TStrings): Integer; + // package functions + // install = package compile + registration + // uninstall = unregistration + deletion + function CompilePackage(const PackageName, BPLPath, DCPPath: string): Boolean; 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; virtual; + function UnregisterPackage(const BinaryFileName: string): Boolean; virtual; + function RegisterIDEPackage(const BinaryFileName, Description: string): Boolean; virtual; + function UnregisterIDEPackage(const BinaryFileName: string): Boolean; virtual; + function RegisterExpert(const BinaryFileName, Description: string): Boolean; virtual; + function UnregisterExpert(const BinaryFileName: string): Boolean; virtual; + + {$IFDEF KEEP_DEPRECATED} + function IsBDSPersonality: Boolean; + {$ENDIF KEEP_DEPRECATED} + function GetDefaultProjectsDir: string; virtual; + function RemoveFromDebugDCUPath(const Path: string): Boolean; + function RemoveFromLibrarySearchPath(const Path: string): Boolean; + function RemoveFromLibraryBrowsingPath(const Path: string): Boolean; + function SubstitutePath(const Path: string): string; + {$IFDEF KEEP_DEPRECATED} + function SupportsBCB: Boolean; + {$ENDIF KEEP_DEPRECATED} + function SupportsVisualCLX: Boolean; + function LibFolderName: string; + // Command line tools + property CommandLineTools: TCommandLineTools read FCommandLineTools; + property BCC32: TJclBCC32 read GetBCC32; + property DCC32: TJclDCC32 read GetDCC32; + property Bpr2Mak: TJclBpr2Mak read GetBpr2Mak; + property Make: IJclCommandLineTool read GetMake; + // Paths + property BinFolderName: string read FBinFolderName; + property BPLOutputPath: string read GetBPLOutputPath; + property DebugDCUPath: string read GetDebugDCUPath write SetDebugDCUPath; + property DCPOutputPath: string read GetDCPOutputPath; + property DefaultProjectsDir: string read GetDefaultProjectsDir; + // + 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: TJclBorRADToolPath read GetLibrarySearchPath write SetLibrarySearchPath; + property LibraryBrowsingPath: TJclBorRADToolPath read GetLibraryBrowsingPath write SetLibraryBrowsingPath; + {$IFDEF MSWINDOWS} + property OpenHelp: TJclBorlandOpenHelp read FOpenHelp; + {$ENDIF MSWINDOWS} + property MapCreate: Boolean read FMapCreate write FMapCreate; + {$IFDEF MSWINDOWS} + property MapLink: Boolean read FMapLink write FMapLink; + 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: string read GetVclIncludeDir; + property IDEVersionNumber: Integer read FIDEVersionNumber; + property VersionNumber: Integer read FVersionNumber; + property VersionNumberStr: string read FVersionNumberStr; + property Personalities: TJclBorPersonalities read FPersonalities; + {$IFDEF KEEP_DEPRECATED} + property DCC: TJclDCC32 read GetDCC32; + {$ENDIF KEEP_DEPRECATED} + property SupportsLibSuffix: Boolean read GetSupportsLibSuffix; + property OutputCallback: TTextHandler read FOutputCallback write SetOutputCallback; + end; + + TJclBCBInstallation = class(TJclBorRADToolInstallation) + protected + constructor Create(const AConfigDataLocation: string); override; + function GetEnvironmentVariables: TStrings; override; + public + 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; + {$IFDEF KYLIX} + function ConfigFileName(const Extension: string): string; override; + {$ENDIF KYLIX} + end; + + TJclDelphiInstallation = class(TJclBorRADToolInstallation) + protected + constructor Create(const AConfigDataLocation: string); override; + function GetEnvironmentVariables: TStrings; override; + public + 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; + {$IFDEF KYLIX} + function ConfigFileName(const Extension: string): string; override; + {$ENDIF KYLIX} + end; + + {$IFDEF MSWINDOWS} + TJclBDSInstallation = class(TJclBorRADToolInstallation) + private + FDualPackageInstallation: Boolean; + procedure SetDualPackageInstallation(const Value: Boolean); + protected + constructor Create(const AConfigDataLocation: string); override; + function GetDCPOutputPath: string; override; + function GetBPLOutputPath: 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: string; override; + function GetName: string; override; + public + // 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 GetBorlandStudioProjectsDir: string; + function GetDefaultProjectsDir: string; override; + {class }function RadToolName: string; override; + + function RegisterPackage(const BinaryFileName, Description: string): Boolean; override; + function UnregisterPackage(const BinaryFileName: string): Boolean; override; + function CleanPackageCache(const BinaryFileName: string): Boolean; + + property DualPackageInstallation: Boolean read FDualPackageInstallation write SetDualPackageInstallation; + 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 KEEP_DEPRECATED} +function BPLFileName(const BPLPath, PackageFileName: string): string; +{$ENDIF KEEP_DEPRECATE} +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); + +implementation + +uses + SysConst, + {$IFDEF MSWINDOWS} + Registry, + JclRegistry, + JclDebug, + {$ENDIF MSWINDOWS} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + JclFileUtils, JclLogic, JclResources, JclStrings, JclSysInfo; + +// Internal + +type + TUpdatePack = record + Version: Byte; + LatestUpdatePack: Integer; + end; + {$IFDEF KYLIX} + TKylixVersion = 1..3; + {$ENDIF KYLIX} + + {$IFDEF MSWINDOWS} + TBDSVersionInfo = record + Name: string; + VersionStr: string; + Version: Integer; + CoreIdeVersion: string; + ProjectsDirResId: Integer; + Supported: Boolean; + end; + {$ENDIF MSWINDOWS} + +const + {$IFDEF MSWINDOWS} + {$IFNDEF RTL140_UP} + PathSep = ';'; + {$ENDIF ~RTL140_UP} + + MSHelpSystemKeyName = 'SOFTWARE\Microsoft\Windows\Help'; + + BCBKeyName = 'SOFTWARE\Borland\C++Builder'; + BDSKeyName = 'SOFTWARE\Borland\BDS'; + DelphiKeyName = 'SOFTWARE\Borland\Delphi'; + + BDSVersions: array [1..4] of TBDSVersionInfo = ( + ( + Name: RsCSharpName; + VersionStr: '1.0'; + Version: 1; + CoreIdeVersion: '71'; + ProjectsDirResId: 64507; + Supported: True), + ( + Name: RsDelphiName; + VersionStr: '8'; + Version: 8; + CoreIdeVersion: '71'; + ProjectsDirResId: 64460; + Supported: True), + ( + Name: RsDelphiName; + VersionStr: '2005'; + Version: 9; + CoreIdeVersion: '90'; + ProjectsDirResId: 64431; + Supported: True), + ( + Name: RsBDSName; + VersionStr: '2006'; + Version: 10; + CoreIdeVersion: '100'; + ProjectsDirResId: 64719; + Supported: True) + ); + {$ENDIF MSWINDOWS} + + {$IFDEF KYLIX} + RootDirValueName = 'DelphiRoot'; + {$ELSE} + RootDirValueName = 'RootDir'; + {$ENDIF KYLIX} + + 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'; + + TransferKeyName = 'Transfer'; + TransferCountValueName = 'Count'; + TransferPathValueName = 'Path%d'; + TransferParamsValueName = 'Params%d'; + TransferTitleValueName = 'Title%d'; + TransferWorkDirValueName = 'WorkingDir%d'; + + DisabledPackagesKeyName = 'Disabled Packages'; + EnvVariablesKeyName = 'Environment Variables'; + EnvVariableBDSValueName = 'BDS'; + EnvVariableBDSPROJDIRValueName = 'BDSPROJECTSDIR'; + KnownPackagesKeyName = 'Known Packages'; + KnownIDEPackagesKeyName = 'Known IDE Packages'; + ExpertsKeyName = 'Experts'; + PackageCacheKeyName = 'Package Cache'; + + PaletteKeyName = 'Palette'; + PaletteHiddenTag = '.Hidden'; + + {$IFDEF MSWINDOWS} + AsmExeName = 'tasm32.exe'; + BCC32ExeName = 'bcc32.exe'; + DCC32ExeName = 'dcc32.exe'; + DCCILExeName = 'dccil.exe'; + Bpr2MakExeName = 'bpr2mak.exe'; + MakeExeName = 'make.exe'; + DelphiOptionsFileExtension = '.dof'; + ConfigurationExtension = '.cfg'; + BorRADToolRepositoryFileName = 'delphi32.dro'; + HelpContentFileName = '%s\Help\%s%d.ohc'; + HelpIndexFileName = '%s\Help\%s%d.ohi'; + HelpLinkFileName = '%s\Help\%s%d.ohl'; + HelpProjectFileName = '%s\Help\%s%d.ohp'; + HelpGidFileName = '%s\Help\%s%d.gid'; + {$ENDIF MSWINDOWS} + + {$IFDEF KYLIX} + IDs: array [TKylixVersion] of Integer = (60, 65, 69); + LibSuffixes: array [TKylixVersion] of string[3] = ('6.0', '6.5', '6.9'); + + BCC32ExeName = 'bcc'; + DCC32ExeName = 'dcc'; + Bpr2MakExeName = 'bpr2mak'; + MakeExeName = 'make'; + + DelphiIdeExeName = 'delphi'; + BCBIdeExeName = 'bcblin'; + DelphiOptionsFileExtension = '.kof'; + + KylixHelpNamePart = 'k%d'; + {$ENDIF KYLIX} + + 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) 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) 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) 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) 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 BPLFileName(const BPLPath, PackageFileName: string): string; +var + PackageExtension, LibSuffix: string; + RunOnly: Boolean; +begin + PackageExtension := ExtractFileExt(PackageFileName); + if SameText(PackageExtension, SourceExtensionDelphiPackage) then + begin + GetDPKFileInfo(PackageFileName, RunOnly, @LibSuffix); + Result := PathExtractFileNameNoExt(PackageFileName) + LibSuffix + BinaryExtensionPackage; + end else if SameText(PackageExtension, SourceExtensionBCBPackage) then + GetBPKFileInfo(PackageFileName, RunOnly, @Result) + else + raise EJclBorRadException.CreateResFmt(@RsUnknownPackageExtension, [PackageExtension]); + + Result := PathAddSeparator(BPLPath) + Result; +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 EJclBorRadException.CreateResFmt(@RsUnknownProjectExtension, [ProjectExtension]); + + Result := PathAddSeparator(OutputPath) + Result; +end; + +function IsDelphiPackage(const FileName: string): Boolean; +begin + Result := SameText(ExtractFileExt(FileName), SourceExtensionDelphiPackage); + { TODO : Add some plausibility tests } + { like + var + F: TextFile; + FirstLine: string; + + if FileExists(FileName) then + begin + AssignFile(F, FileName); + Reset(F); + ReadLn(F, FirstLine); + Result := Pos('package ', FirstLine) = 1; + CloseFile(F); + end; + } +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} +function RegGetValueNamesAndValues(const RootKey: HKEY; const Key: string; const List: TStrings): Boolean; +var + I: Integer; + TempList: TStringList; + Name: string; + DataType: DWORD; +begin + TempList := TStringList.Create; + try + 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 + TempList[I] := Name + '=' + RegReadStringDef(RootKey, Key, Name, ''); + end; + List.AddStrings(TempList); + end; + finally + TempList.Free; + end; +end; +{$ENDIF MSWINDOWS} + +function SamePath(const Path1, Path2: string): Boolean; +begin + {$IFDEF MSWINDOWS} + Result := AnsiSameText(PathGetLongName(Path1), PathGetLongName(Path2)); + {$ELSE} + Result := Path1 = Path2; + {$ENDIF} +end; + +//=== { TJclBorRADToolInstallationObject } =================================== + +constructor TJclBorRADToolInstallationObject.Create(AInstallation: TJclBorRADToolInstallation); +begin + FInstallation := AInstallation; +end; + +//=== { TJclBorlandOpenHelp } ================================================ + +{$IFDEF MSWINDOWS} + +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(HKEY_LOCAL_MACHINE, MSHelpSystemKeyName, HelpName, ExtractFilePath(HelpFileName)); + RegWriteString(HKEY_LOCAL_MACHINE, 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; + +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; +var + S: string; +begin + with Installation do + begin + case RadToolKind of + brDelphi : + if VersionNumber <= 6 then + S := 'delphi' + else + S := 'd'; + brCppBuilder : + S := 'bcb'; + else + //brBorlandDevStudio : + raise EJclBorRadException.Create('open help not present in Borland Developer Studio'); + end; + Result := Format(FormatName, [RootDir, S, VersionNumber]); + end; +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; + +{$ENDIF MSWINDOWS} + +//== { 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(@RsIndexOufOfRange); +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.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); + FDisabledPackages := TStringList.Create; + FDisabledPackages.Sorted := True; + FDisabledPackages.Duplicates := dupIgnore; + FKnownPackages := TStringList.Create; + FKnownPackages.Sorted := True; + FKnownPackages.Duplicates := dupIgnore; + FKnownIDEPackages := TStringList.Create; + FKnownIDEPackages.Sorted := True; + FKnownIDEPackages.Duplicates := dupIgnore; + FExperts := TStringList.Create; + FExperts.Sorted := True; + FExperts.Duplicates := dupIgnore; + ReadPackages; +end; + +destructor TJclBorRADToolIdePackages.Destroy; +begin + FreeAndNil(FDisabledPackages); + FreeAndNil(FKnownPackages); + FreeAndNil(FKnownIDEPackages); + FreeAndNil(FExperts); + inherited Destroy; +end; + +function TJclBorRADToolIdePackages.AddPackage(const FileName, Description: string): Boolean; +begin + Result := True; + RemoveDisabled(FileName); + Installation.ConfigData.WriteString(KnownPackagesKeyName, FileName, Description); + ReadPackages; +end; + +function TJclBorRADToolIdePackages.AddExpert(const FileName, + Description: string): Boolean; +begin + Result := True; + RemoveDisabled(FileName); + Installation.ConfigData.WriteString(ExpertsKeyName, Description, FileName); + ReadPackages; +end; + +function TJclBorRADToolIdePackages.AddIDEPackage(const FileName, Description: string): Boolean; +begin + Result := True; + RemoveDisabled(FileName); + Installation.ConfigData.WriteString(KnownIDEPackagesKeyName, FileName, Description); + ReadPackages; +end; + +function TJclBorRADToolIdePackages.GetCount: Integer; +begin + Result := FKnownPackages.Count; +end; + +function TJclBorRADToolIdePackages.GetExpertCount: Integer; +begin + Result := FExperts.Count; +end; + +function TJclBorRADToolIdePackages.GetExpertDescriptions( + Index: Integer): string; +begin + Result := FExperts.Names[Index]; +end; + +function TJclBorRADToolIdePackages.GetExpertFileNames(Index: Integer): string; +begin + Result := PackageEntryToFileName(FExperts.Values[FExperts.Names[Index]]); +end; + +function TJclBorRADToolIdePackages.GetIDECount: Integer; +begin + Result := FKnownIDEPackages.Count; +end; + +function TJclBorRADToolIdePackages.GetPackageDescriptions(Index: Integer): string; +begin + Result := FKnownPackages.Values[FKnownPackages.Names[Index]]; +end; + +function TJclBorRADToolIdePackages.GetIDEPackageDescriptions(Index: Integer): string; +begin + Result := FKnownPackages.Values[FKnownIDEPackages.Names[Index]]; +end; + +function TJclBorRADToolIdePackages.GetPackageDisabled(Index: Integer): Boolean; +begin + Result := Boolean(FKnownPackages.Objects[Index]); +end; + +function TJclBorRADToolIdePackages.GetPackageFileNames(Index: Integer): string; +begin + Result := PackageEntryToFileName(FKnownPackages.Names[Index]); +end; + +function TJclBorRADToolIdePackages.GetIDEPackageFileNames(Index: Integer): string; +begin + Result := PackageEntryToFileName(FKnownIDEPackages.Names[Index]); +end; + +function TJclBorRADToolIdePackages.PackageEntryToFileName(const Entry: string): string; +begin + Result := Installation.SubstitutePath(Entry); +end; + +procedure TJclBorRADToolIdePackages.ReadPackages; + + 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; + +var + I: Integer; +begin + if (Installation.RadToolKind = brBorlandDevStudio) then + ReadPackageList(KnownIDEPackagesKeyName, FKnownIDEPackages); + ReadPackageList(KnownPackagesKeyName, FKnownPackages); + ReadPackageList(DisabledPackagesKeyName, FDisabledPackages); + ReadPackageList(ExpertsKeyName, FExperts); + for I := 0 to Count - 1 do + if FDisabledPackages.IndexOfName(FKnownPackages.Names[I]) <> -1 then + FKnownPackages.Objects[I] := Pointer(True); +end; + +procedure TJclBorRADToolIdePackages.RemoveDisabled(const FileName: string); +var + I: Integer; +begin + for I := 0 to FDisabledPackages.Count - 1 do + if SamePath(FileName, PackageEntryToFileName(FDisabledPackages.Names[I])) then + begin + Installation.ConfigData.DeleteKey(DisabledPackagesKeyName, FDisabledPackages.Names[I]); + ReadPackages; + Break; + end; +end; + +function TJclBorRADToolIdePackages.RemoveExpert( + const FileName: string): Boolean; +var + I: Integer; + KnownExpertDescription, KnownExpert, KnownExpertFileName: string; +begin + Result := False; + for I := 0 to FExperts.Count - 1 do + begin + KnownExpertDescription := FExperts.Names[I]; + KnownExpert := FExperts.Values[KnownExpertDescription]; + KnownExpertFileName := PackageEntryToFileName(KnownExpert); + if SamePath(FileName, KnownExpertFileName) then + begin + RemoveDisabled(KnownExpertFileName); + Installation.ConfigData.DeleteKey(ExpertsKeyName, KnownExpertDescription); + ReadPackages; + Result := True; + Break; + end; + end; +end; + +function TJclBorRADToolIdePackages.RemovePackage(const FileName: string): Boolean; +var + I: Integer; + KnownPackage, KnownPackageFileName: string; +begin + Result := False; + for I := 0 to FKnownPackages.Count - 1 do + begin + KnownPackage := FKnownPackages.Names[I]; + KnownPackageFileName := PackageEntryToFileName(KnownPackage); + if SamePath(FileName, KnownPackageFileName) then + begin + RemoveDisabled(KnownPackageFileName); + Installation.ConfigData.DeleteKey(KnownPackagesKeyName, KnownPackage); + ReadPackages; + Result := True; + Break; + end; + end; +end; + +function TJclBorRADToolIdePackages.RemoveIDEPackage(const FileName: string): Boolean; +var + I: Integer; + KnownIDEPackage, KnownIDEPackageFileName: string; +begin + Result := False; + for I := 0 to FKnownIDEPackages.Count - 1 do + begin + KnownIDEPackage := FKnownIDEPackages.Names[I]; + KnownIDEPackageFileName := PackageEntryToFileName(KnownIDEPackage); + if SamePath(FileName, KnownIDEPackageFileName) then + begin + RemoveDisabled(KnownIDEPackageFileName); + Installation.ConfigData.DeleteKey(KnownIDEPackagesKeyName, KnownIDEPackage); + ReadPackages; + Result := True; + Break; + end; + end; +end; + +//=== { TJclBorlandCommandLineTool } ========================================= + +constructor TJclBorlandCommandLineTool.Create(AInstallation: TJclBorRADToolInstallation); +begin + inherited Create(AInstallation); + FOptions := TStringList.Create; +end; + +destructor TJclBorlandCommandLineTool.Destroy; +begin + FreeAndNil(FOptions); + inherited Destroy; +end; + +procedure TJclBorlandCommandLineTool.AddPathOption(const Option, Path: string); +var + S: string; + + {$IFDEF MSWINDOWS} + // 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 + 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} + +begin + S := PathRemoveSeparator(Path); + {$IFDEF MSWINDOWS} + S := LowerCase(S); // file names are case insensitive + ConvertToShortPathNames(S); + {$ENDIF MSWINDOWS} + { 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(@RsCmdLineToolOutputInvalid, [GetExeName]); +end; + +function TJclBorlandCommandLineTool.Execute(const CommandLine: string): Boolean; +var + LaunchCommand: string; +begin + LaunchCommand := Format('%s %s', [FileName, CommandLine]); + if Assigned(FOutputCallback) then + begin + FOutputCallback(LaunchCommand); + Result := JclSysUtils.Execute(LaunchCommand, FOutputCallback) = 0 + end + else + Result := JclSysUtils.Execute(LaunchCommand, FOutput) = 0; +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 := Installation.BinFolderName + 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; + +procedure TJclBorlandCommandLineTool.SetOutputCallback(const CallbackMethod: TTextHandler); +begin + FOutputCallback := CallbackMethod; +end; + +//=== { TJclBCC32 } ============================================================ + +constructor TJclBCC32.Create(AInstallation: TJclBorRADToolInstallation); +begin + inherited Create(AInstallation); +end; + +function TJclBCC32.GetExeName: string; +begin + Result := BCC32ExeName; +end; + +{$IFDEF KEEP_DEPRECATED} +function TJclBCC32.SupportsLibSuffix: Boolean; +begin + Result := Installation.SupportsLibSuffix; +end; +{$ENDIF KEEP_DEPRECATED} + +//=== { TJclDCC32 } ============================================================ + +procedure TJclDCC32.AddProjectOptions(const ProjectFileName, DCPPath: string); +var + SearchPath, DynamicPackages, SearchDcpPath, ConfigurationFileName, + OptionsFileName: string; + OptionsFile: TIniFile; +begin + ConfigurationFileName := ChangeFileExt(ProjectFileName, ConfigurationExtension); + if FileExists(ConfigurationFileName) then + FileDelete(ConfigurationFileName); + + OptionsFileName := ChangeFileExt(ProjectFileName, DelphiOptionsFileExtension); + + if FileExists(OptionsFileName) then + begin + OptionsFile := TIniFile.Create(OptionsFileName); + try + SearchPath := OptionsFile.ReadString(DOFDirectoriesSection, DOFSearchPathName, ''); + AddPathOption('N', OptionsFile.ReadString(DOFDirectoriesSection, DOFUnitOutputDirKey, '')); + AddPathOption('I', SearchPath); + AddPathOption('R', SearchPath); + + if SamePath(DCPPath, Installation.DCPOutputPath) then + SearchDcpPath := DCPPath + else + SearchDcpPath := StrEnsureSuffix(PathSep, DCPPath) + Installation.DCPOutputPath; + AddPathOption('U', StrEnsureSuffix(PathSep, SearchDcpPath) + SearchPath); + + if OptionsFile.ReadString(DOFCompilerSection,DOFPackageNoLinkKey,'') = '1' then + begin + DynamicPackages := OptionsFile.ReadString(DOFLinkerSection, DOFPackagesKey, ''); + if DynamicPackages <> '' then + Options.Add(Format('-LU"%s"',[DynamicPackages])); + end; + finally + OptionsFile.Free; + end; + end; +end; + +function TJclDCC32.Compile(const ProjectFileName: string): Boolean; +begin + {$IFDEF MSWINDOWS} + // quotes not required with short path names + Result := Execute(PathGetShortName(ExtractFileDir(ProjectFileName)) + + PathSeparator + ExtractFileName(ProjectFileName)); + {$ELSE} + Result := Execute(StrDoubleQuote(StrTrimQuotes(ProjectFileName))); + {$ENDIF} +end; + +constructor TJclDCC32.Create(AInstallation: TJclBorRADToolInstallation); +begin + inherited Create(AInstallation); + SetDefaultOptions; // in case $(DELPHI)\bin\dcc32.cfg (replace as appropriate) is invalid +end; + +function TJclDCC32.Execute(const CommandLine: string): Boolean; +const + {$IFDEF WIN32} + ConfFileName = 'DCC32.CFG'; + {$ENDIF WIN32} + {$IFDEF KYLIX} + ConfFileName = 'dcc.conf'; + {$ENDIF KYLIX} +begin + FOutput := ''; + SaveOptionsToFile(ConfFileName); + Result := inherited Execute(CommandLine); + FileDelete(ConfFileName); +end; + +procedure TJclDCC32.SaveOptionsToFile(const ConfigFileName: string); +{$IFDEF MSWINDOWS} + + function IsPathOption(const S: string; out Len: Integer): Boolean; + begin + Result := False; + if Length(S) >= 2 then + case UpCase(S[2]) of + 'E', 'I', 'O', 'R', 'U': + begin + Result := True; + Len := 2; + end; + 'L': + if Length(S) >= 3 then + begin + Result := UpCase(S[3]) in ['E', 'N']; + Len := 3; + end; + 'N': + begin + Result := True; + if (Length(S) >= 3) and (S[3] in ['0'..'9']) then + Len := 3 + else + Len := 2; + end; + end; + end; + +var + I, J: Integer; + List: TStringList; + S: string; + F: TextFile; +begin + AssignFile(F, ConfigFileName); + Rewrite(F); + List := TStringList.Create; + try + for I := 0 to Options.Count - 1 do + begin + S := Options[I]; + if IsPathOption(S, J) then + begin + Write(F, Copy(S, 1, J), '"'); + StrToStrings(StrTrimQuotes(PChar(@S[J + 1])), PathSep, List); + // change to relative paths to avoid DCC32 126 character path limit + for J := 0 to List.Count - 1 do + List[J] := PathGetRelativePath(GetCurrentFolder, ExpandFileName(List[J])); + if List.Count > 0 then + begin + for J := 0 to List.Count - 2 do + Write(F, List[J], PathSep); + WriteLn(F, List[List.Count - 1], '"'); + end; + end + else + WriteLn(F, S); + end; + finally + List.Free; + end; + CloseFile(F); +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +begin + FOptions.SaveToFile(ConfigFileName); +end; +{$ENDIF UNIX} + +function TJclDCC32.GetExeName: string; +begin + Result := DCC32ExeName; +end; + +function TJclDCC32.MakePackage(const PackageName, BPLPath, DCPPath: string; ExtraOptions:string): Boolean; +var + SaveDir: string; +begin + SaveDir := GetCurrentDir; + SetCurrentDir(ExtractFilePath(PackageName) + '.'); + try + Options.Clear; + AddProjectOptions(PackageName, DCPPath); + AddPathOption('LN', DCPPath); + AddPathOption('LE', BPLPath); + Options.Add(ExtraOptions); + Result := Compile(PackageName); + finally + SetCurrentDir(SaveDir); + end; +end; + +function TJclDCC32.MakeProject(const ProjectName, OutputDir, DcpSearchPath: string; + ExtraOptions: string): Boolean; +var + SaveDir: string; +begin + SaveDir := GetCurrentDir; + SetCurrentDir(ExtractFilePath(ProjectName) + '.'); + try + Options.Clear; + AddProjectOptions(ProjectName, DcpSearchPath); + AddPathOption('E', OutputDir); + Options.Add(ExtraOptions); + Result := Compile(ProjectName); + finally + SetCurrentDir(SaveDir); + end; +end; + +procedure TJclDCC32.SetDefaultOptions; +begin + Options.Clear; + AddPathOption('U', Installation.LibFolderName); + if Installation.RadToolKind = brCppBuilder then + begin + AddPathOption('U', Installation.LibFolderName + PathAddSeparator('obj')); + {$IFNDEF KYLIX} + if (Installation.RadToolKind <> brBorlandDevStudio) + and (Installation.VersionNumber = 5) then + Options.Add('-LUvcl50') + else + Options.Add('-LUrtl'); + {$ENDIF ~KYLIX} + end; +end; + +{$IFDEF KEEP_DEPRECATED} +function TJclDCC32.SupportsLibSuffix: Boolean; +begin + Result := Installation.SupportsLibSuffix; +end; +{$ENDIF KEEP_DEPRECATED} + +//=== { TJclBorlandMake } ==================================================== + +function TJclBorlandMake.GetExeName: string; +begin + Result := MakeExeName; +end; + +//=== { TJclBpr2Mak } ======================================================== + +function TJclBpr2Mak.GetExeName: string; +begin + Result := Bpr2MakExeName; +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); + {$IFDEF KYLIX} + FFileName := AInstallation.ConfigFileName('dro'); + {$ELSE} + FFileName := AInstallation.BinFolderName + BorRADToolRepositoryFileName; + {$ENDIF KYLIX} + 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 + begin + if OptionalIndex < Pages.Count then + Result := Pages[OptionalIndex] + else + Result := ''; + end; +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; +begin + inherited Create; + FConfigDataLocation := AConfigDataLocation; + {$IFDEF KYLIX} + FConfigData := TMemIniFile.Create(AConfigDataLocation); + {$ELSE ~KYLIX} + FConfigData := TRegistryIniFile.Create(AConfigDataLocation); + {$ENDIF ~KYLIX} + FGlobals := TStringList.Create; + ReadInformation; + FIdeTools := TJclBorRADToolIdeTool.Create(Self); + {$IFDEF MSWINDOWS} + FOpenHelp := TJclBorlandOpenHelp.Create(Self); + {$ENDIF ~MSWINDOWS} + FMapCreate := False; + {$IFDEF MSWINDOWS} + FMapLink := False; + FMapDelete := False; + {$ENDIF ~MSWINDOWS} + if FileExists(BinFolderName + AsmExeName) then + Include(FCommandLineTools, clAsm); + if FileExists(BinFolderName + BCC32ExeName) then + Include(FCommandLineTools, clBcc32); + if FileExists(BinFolderName + DCC32ExeName) then + Include(FCommandLineTools, clDcc32); + if FileExists(BinFolderName + DCCILExeName) then + Include(FCommandLineTools, clDccIL); + 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); + {$IFDEF KYLIX} + FConfigData.UpdateFile; // TMemIniFile.Destroy doesn't call UpdateFile + {$ENDIF KYLIX} + FreeAndNil(FConfigData); + inherited Destroy; +end; + +function TJclBorRADToolInstallation.AddToDebugDCUPath(const Path: string): Boolean; +var + TempDebugDCUPath: TJclBorRADToolPath; +begin + TempDebugDCUPath := DebugDCUPath; + Result := AddMissingPathItems(TempDebugDCUPath, Path); + DebugDCUPath := TempDebugDCUPath; +end; + +function TJclBorRADToolInstallation.AddToLibrarySearchPath(const Path: string): Boolean; +var + TempLibraryPath: TJclBorRADToolPath; +begin + TempLibraryPath := LibrarySearchPath; + Result := AddMissingPathItems(TempLibraryPath, Path); + LibrarySearchPath := TempLibraryPath; +end; + +function TJclBorRADToolInstallation.AddToLibraryBrowsingPath(const Path: string): Boolean; +var + TempLibraryPath: TJclBorRADToolPath; +begin + TempLibraryPath := LibraryBrowsingPath; + Result := AddMissingPathItems(TempLibraryPath, Path); + LibraryBrowsingPath := TempLibraryPath; +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; + +{$IFDEF KYLIX} +function TJclBorRADToolInstallation.ConfigFileName(const Extension: string): string; +begin + Result := ''; +end; +{$ENDIF KYLIX} + +class procedure TJclBorRADToolInstallation.ExtractPaths(const Path: TJclBorRADToolPath; List: TStrings); +begin + StrToStrings(Path, PathSep, List); +end; + +function TJclBorRADToolInstallation.AddMissingPathItems(var Path: string; const NewPath: string): Boolean; +var + PathItems, NewItems: TStringList; + Folder: string; + I: Integer; + Missing: Boolean; +begin + Result := False; + PathItems := nil; + NewItems := nil; + try + PathItems := TStringList.Create; + NewItems := TStringList.Create; + ExtractPaths(Path, PathItems); + ExtractPaths(NewPath, NewItems); + for I := 0 to NewItems.Count - 1 do + begin + Folder := NewItems[I]; + Missing := FindFolderInPath(Folder, PathItems) = -1; + if Missing then + begin + Path := StrEnsureSuffix(PathSep, Path) + Folder; + Result := True; + end; + end; + finally + PathItems.Free; + NewItems.Free; + end; +end; + +function TJclBorRADToolInstallation.CompileBCBPackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +var + SaveDir, PackagePath, MakeFileName, BinaryFileName: string; + RunOnly: Boolean; +begin + OutputString(Format(RsCompilingPackage, [PackageName])); + + if not IsBCBPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsNotABCBPackage, [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 + begin + // Kylix bpr2mak doesn't like full file names + Result := Bpr2Mak.Execute(StringsToStr(Bpr2Mak.Options, ' ') + ' ' + ExtractFileName(PackageName)) + end + 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'); + + GetBPKFileInfo(PackageName, RunOnly, @BinaryFileName); + + Result := Result and Make.Execute(Format('%s -f%s', [StringsToStr(Make.Options, ' '), StrDoubleQuote(MakeFileName)])) + and LinkMapFile(PathAddSeparator(BPLPath) + BinaryFileName); + finally + SetCurrentDir(SaveDir); + end; + + if Result then + OutputString(RsCompilationOk) + else + OutputString(RsCompilationFailed); +end; + +function TJclBorRADToolInstallation.CompileBCBProject(const ProjectName, + OutputDir, DcpSearchPath: string): Boolean; +var + SaveDir, PackagePath, MakeFileName, BinaryFileName: string; +begin + OutputString(Format(RsCompilingProject, [ProjectName])); + + if not IsBCBProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsNotADelphiProject, [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 + // Kylix bpr2mak doesn't like full file names + 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'); + + GetBPRFileInfo(ProjectName, BinaryFileName); + + Result := Result and Make.Execute(Format('%s -f%s', [StringsToStr(Make.Options, ' '), StrDoubleQuote(MakeFileName)])) + and LinkMapFile(PathAddSeparator(OutputDir) + BinaryFileName); + finally + SetCurrentDir(SaveDir); + end; + + if Result then + OutputString(RsCompilationOk) + else + OutputString(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, LibSuffix, BinaryFileName: string; + RunOnly: Boolean; +begin + OutputString(Format(RsCompilingPackage, [PackageName])); + + if not IsDelphiPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsNotADelphiPackage, [PackageName]); + + if MapCreate then + NewOptions := ExtraOptions + ' -GD' + else + NewOptions := ExtraOptions; + + GetDPKFileInfo(PackageName, RunOnly, @LibSuffix); + BinaryFileName := PathAddSeparator(BPLPath) + PathExtractFileNameNoExt(PackageName) + LibSuffix + BinaryExtensionPackage; + + Result := DCC32.MakePackage(PackageName, BPLPath, DCPPath, NewOptions) + and LinkMapFile(BinaryFileName); + + if Result then + OutputString(RsCompilationOk) + else + OutputString(RsCompilationFailed); +end; + +function TJclBorRADToolInstallation.CompileDelphiProject(const ProjectName, + OutputDir, DcpSearchPath: string): Boolean; +var + ExtraOptions, BinaryExtension, LibSuffix, BinaryFileName: string; +begin + OutputString(Format(RsCompilingProject, [ProjectName])); + + if not IsDelphiProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsNotADelphiProject, [ProjectName]); + + if MapCreate then + ExtraOptions := '-GD' + else + ExtraOptions := ''; + + GetDPRFileInfo(ProjectName, BinaryExtension, @LibSuffix); + BinaryFileName := PathAddSeparator(OutputDir) + PathExtractFileNameNoExt(ProjectName) + LibSuffix + BinaryExtension; + + Result := DCC32.MakeProject(ProjectName, OutputDir, DcpSearchPath, ExtraOptions) + and LinkMapFile(BinaryFileName); + + if Result then + OutputString(RsCompilationOk) + else + OutputString(RsCompilationFailed); +end; + +function TJclBorRADToolInstallation.CompilePackage(const PackageName, BPLPath, + DCPPath: 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) + else + raise EJclBorRadException.CreateResFmt(@RsUnknownPackageExtension, [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(@RsUnknownProjectExtension, [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: string; +begin + 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(@RsNotFound, [Bpr2MakExeName]); + FBpr2Mak := TJclBpr2Mak.Create(Self); + end; + Result := FBpr2Mak; +end; + +function TJclBorRADToolInstallation.GetBCC32: TJclBCC32; +begin + if not Assigned(FBCC32) then + begin + if not (clBcc32 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsNotFound, [Bcc32ExeName]); + FBCC32 := TJclBCC32.Create(Self); + end; + Result := FBCC32; +end; + +function TJclBorRADToolInstallation.GetDCC32: TJclDCC32; +begin + if not Assigned(FDCC32) then + begin + if not (clDcc32 in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsNotFound, [Dcc32ExeName]); + FDCC32 := TJclDCC32.Create(Self); + end; + Result := FDCC32; +end; + +function TJclBorRADToolInstallation.GetDCPOutputPath: string; +begin + Result := SubstitutePath(ConfigData.ReadString(LibraryKeyName, LibraryDCPOutputValueName, '')); +end; + +function TJclBorRADToolInstallation.GetDebugDCUPath: string; +begin + Result := ConfigData.ReadString(DebuggingKeyName, DebugDCUPathValueName, ''); +end; + +function TJclBorRADToolInstallation.GetDefaultProjectsDir: string; +begin + {$IFDEF KYLIX} + Result := GetPersonalFolder; + {$ELSE ~KYLIX} + Result := Globals.Values['DefaultProjectsDirectory']; + if Result = '' then + Result := PathAddSeparator(RootDir) + 'Projects'; + {$ENDIF ~KYLIX} +end; + +function TJclBorRADToolInstallation.GetDescription: string; +begin + Result := Format('%s %s', [Name, EditionAsText]); + if InstalledUpdatePack > 0 then + Result := Result + ' ' + Format(RsUpdatePackName, [InstalledUpdatePack]); +end; + +function TJclBorRADToolInstallation.GetEditionAsText: string; +begin + {$IFDEF KYLIX} + case Edition of + deOPEN: + Result := RsOpenEdition; + dePRO: + Result := RsProfessional; + deSVR: + if VersionNumber >= 2 then + Result := RsEnterprise + else + Result := RsServerDeveloper; + end; + {$ELSE} + Result := FEditionStr; + if Length(FEditionStr) = 3 then + case Edition of + deSTD: + if (VersionNumber >= 6) or (RadToolKind = brBorlandDevStudio) then + Result := RsPersonal + else + Result := RsStandard; + dePRO: + Result := RsProfessional; + deCSS: + if (VersionNumber >= 5) or (RadToolKind = brBorlandDevStudio) then + Result := RsEnterprise + else + Result := RsClientServer; + deARC: + Result := RsArchitect; + end; + {$ENDIF KYLIX} +end; + +function TJclBorRADToolInstallation.GetEnvironmentVariables: TStrings; +var + EnvNames: TStringList; + EnvVarKeyName: string; + I: Integer; +begin + if FEnvironmentVariables = nil then + begin + FEnvironmentVariables := TStringList.Create; + 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]; + FEnvironmentVariables.Values[EnvVarKeyName] := ConfigData.ReadString(EnvVariablesKeyName, EnvVarKeyName, ''); + end; + finally + EnvNames.Free; + end; + end; + end; + Result := FEnvironmentVariables; +end; + +function TJclBorRADToolInstallation.GetGlobals: TStrings; +begin + Result := FGlobals; +end; + +function TJclBorRADToolInstallation.GetIdeExeFileName: string; +{$IFDEF KYLIX} +const + IdeFileNames: array [brDelphi..brCppBuilder] of string = (DelphiIdeExeName, BCBIdeExeName); +begin + Result := FBinFolderName + IdeFileNames[RADToolKind]; +end; +{$ENDIF KYLIX} +{$IFDEF MSWINDOWS} +begin + Result := Globals.Values['App']; +end; +{$ENDIF MSWINDOWS} + +function TJclBorRADToolInstallation.GetIdeExeBuildNumber: string; +begin + {$IFDEF KYLIX} + { TODO : determine Kylix IDE build # } + Result := '?'; + {$ELSE} + Result := VersionFixedFileInfoString(IdeExeFileName, vfFull); + {$ENDIF KYLIX} +end; + +function TJclBorRADToolInstallation.GetIdePackages: TJclBorRADToolIdePackages; +begin + if not Assigned(FIdePackages) then + FIdePackages := TJclBorRADToolIdePackages.Create(Self); + Result := FIdePackages; +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: TJclBorRADToolPath; +begin + Result := ConfigData.ReadString(LibraryKeyName, LibrarySearchPathValueName, ''); +end; + +function TJclBorRADToolInstallation.GetMake: IJclCommandLineTool; +begin + if not Assigned(FMake) then + begin + if not (clMake in CommandLineTools) then + raise EJclBorRadException.CreateResFmt(@RsNotFound, [MakeExeName]); + {$IFDEF KYLIX} + FMake := TJclCommandLineTool.Create(MakeExeName); + {$ELSE ~KYLIX} + FMake := TJclBorlandMake.Create(Self); + // 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+'); + {$ENDIF ~KYLIX} + end; + Result := FMake; +end; + +function TJclBorRADToolInstallation.GetLibraryBrowsingPath: TJclBorRADToolPath; +begin + Result := ConfigData.ReadString(LibraryKeyName, LibraryBrowsingPathValueName, ''); +end; + +function TJclBorRADToolInstallation.GetName: string; +begin + {$IFDEF KYLIX} + Result := Format(RsKylixVersionName, [VersionNumber, RADToolName]); + {$ELSE ~KYLIX} + Result := Format('%s %d', [RADToolName, VersionNumber]); + {$ENDIF ~KYLIX} +end; + +function TJclBorRADToolInstallation.GetPalette: TJclBorRADToolPalette; +begin + if not Assigned(FPalette) then + FPalette := TJclBorRADToolPalette.Create(Self); + Result := FPalette; +end; + +function TJclBorRADToolInstallation.GetRepository: TJclBorRADToolRepository; +begin + if not Assigned(FRepository) then + FRepository := TJclBorRADToolRepository.Create(Self); + Result := FRepository; +end; + +function TJclBorRADToolInstallation.GetSupportsLibSuffix: Boolean; +begin +{$IFDEF KYLIX} + Result := True; +{$ELSE} + Result := (RadToolKind = brBorlandDevStudio) or (VersionNumber >= 6); +{$ENDIF KYLIX} +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: string; +begin + Result := RootDir + RsVclIncludeDir; + if not DirectoryExists(Result) then + Result := ''; +end; + +function TJclBorRADToolInstallation.InstallBCBExpert(const ProjectName, + OutputDir, DcpSearchPath: string): Boolean; +var + BinaryFileName, Description: string; +begin + OutputString(Format(RsExpertInstallationStarted, [ProjectName])); + + GetBPRFileInfo(ProjectName, BinaryFileName, @Description); + BinaryFileName := PathAddSeparator(OutputDir) + BinaryFileName; + + Result := CompileBCBProject(ProjectName, OutputDir, DcpSearchPath) + and RegisterExpert(BinaryFileName, Description); + + OutputString(RsExpertInstallationFinished); +end; + +function TJclBorRADToolInstallation.InstallBCBIdePackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +var + RunOnly: Boolean; + BinaryFileName, Description: string; +begin + OutputString(Format(RsIdePackageInstallationStarted, [PackageName])); + + GetBPKFileInfo(PackageName, RunOnly, @BinaryFileName, @Description); + BinaryFileName := PathAddSeparator(BPLPath) + BinaryFileName; + if RunOnly then + raise EJclBorRadException.CreateResFmt(@RsCannotInstallRunOnly, [PackageName]); + + Result := CompileBCBPackage(PackageName, BPLPath, DCPPath) + and RegisterIdePackage(BinaryFileName, Description); + + OutputString(RsIdePackageInstallationFinished); +end; + +function TJclBorRADToolInstallation.InstallBCBPackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +var + RunOnly: Boolean; + BinaryFileName, Description: string; +begin + OutputString(Format(RsPackageInstallationStarted, [PackageName])); + + GetBPKFileInfo(PackageName, RunOnly, @BinaryFileName, @Description); + BinaryFileName := PathAddSeparator(BPLPath) + BinaryFileName; + if RunOnly then + raise EJclBorRadException.CreateResFmt(@RsCannotInstallRunOnly, [PackageName]); + + Result := CompileBCBPackage(PackageName, BPLPath, DCPPath) + and RegisterPackage(BinaryFileName, Description); + + OutputString(RsPackageInstallationFinished); +end; + +function TJclBorRADToolInstallation.InstallDelphiExpert(const ProjectName, + OutputDir, DcpSearchPath: string): Boolean; +var + LibSuffix, BinaryFileName, BinaryExtension, BaseName: string; +begin + OutputString(Format(RsExpertInstallationStarted, [ProjectName])); + + BaseName := PathExtractFileNameNoExt(ProjectName); + + GetDPRFileInfo(ProjectName, BinaryExtension, @LibSuffix); + if BinaryExtension = '' then + BinaryExtension := BinaryExtensionLibrary; + + BinaryFileName := PathAddSeparator(OutputDir) + BaseName + LibSuffix + BinaryExtension; + + Result := CompileDelphiProject(ProjectName, OutputDir, DcpSearchPath) + and RegisterExpert(BinaryFileName, BaseName); + + OutputString(RsExpertInstallationFinished); +end; + +function TJclBorRADToolInstallation.InstallDelphiIdePackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +var + RunOnly: Boolean; + LibSuffix, BPLFileName, Description: string; +begin + OutputString(Format(RsIdePackageInstallationStarted, [PackageName])); + + GetDPKFileInfo(PackageName, RunOnly, @LibSuffix, @Description); + if RunOnly then + raise EJclBorRadException.CreateResFmt(@RsCannotInstallRunOnly, [PackageName]); + BPLFileName := PathAddSeparator(BPLPath) + PathExtractFileNameNoExt(PackageName) + LibSuffix + BinaryExtensionPackage; + + Result := CompileDelphiPackage(PackageName, BPLPath, DCPPath) + and RegisterIdePackage(BPLFileName, Description); + + OutputString(RsIdePackageInstallationFinished); +end; + +function TJclBorRADToolInstallation.InstallDelphiPackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +var + RunOnly: Boolean; + LibSuffix, BPLFileName, Description: string; +begin + OutputString(Format(RsPackageInstallationStarted, [PackageName])); + + GetDPKFileInfo(PackageName, RunOnly, @LibSuffix, @Description); + if RunOnly then + raise EJclBorRadException.CreateResFmt(@RsCannotInstallRunOnly, [PackageName]); + BPLFileName := PathAddSeparator(BPLPath) + PathExtractFileNameNoExt(PackageName) + LibSuffix + BinaryExtensionPackage; + + Result := CompileDelphiPackage(PackageName, BPLPath, DCPPath) + and RegisterPackage(BPLFileName, Description); + + OutputString(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(@RsUnknownProjectExtension, [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(@RsUnknownIdePackageExtension, [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(@RsUnknownPackageExtension, [PackageExtension]); +end; + +{$IFDEF KEEP_DEPRECATED} +function TJclBorRADToolInstallation.IsBDSPersonality: Boolean; +begin + {$IFDEF MSWINDOWS} + Result := InheritsFrom(TJclBDSInstallation); + {$ELSE} + Result := False; + {$ENDIF MSWINDOWS} +end; +{$ENDIF KEEP_DEPRECATED} + +function TJclBorRADToolInstallation.LibFolderName: string; +begin + Result := PathAddSeparator(RootDir) + PathAddSeparator('lib'); +end; + +function TJclBorRADToolInstallation.LinkMapFile( + const BinaryFileName: string): Boolean; +var + MAPFileName, LinkerBugUnit: string; + MAPFileSize, JclDebugDataSize: Integer; +begin + {$IFDEF MSWINDOWS} + if MapLink then + begin + OutputString(Format(RsLinkingMap, [BinaryFileName])); + MAPFileName := ChangeFileExt(BinaryFileName,'.MAP'); + Result := InsertDebugDataIntoExecutableFile(BinaryFileName, MAPFileName, + LinkerBugUnit, MAPFileSize, JclDebugDataSize); + if Result then + begin + OutputString(RsLinkMapOk); + OutputString(Format(RsLinkMapInfo, [LinkerBugUnit, MAPFileSize, JclDebugDataSize])); + if MapDelete then + OutputFileDelete(MAPFileName); + end + else + OutputString(RsLinkMapFailed); + end + else + Result := True; + {$ELSE MSWINDOWS} + Result := True; + {$ENDIF MSWINDOWS} +end; + +function TJclBorRADToolInstallation.OutputFileDelete( + const FileName: string): Boolean; +begin + OutputString(Format(RsDeletingFile, [FileName])); + Result := FileDelete(FileName); + if Result then + OutputString(RsFileDeletionOk) + else + OutputString(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; +const + {$IFDEF KYLIX} + BinDir = 'bin/'; + {$ELSE ~KYLIX} + BinDir = 'bin\'; + {$ENDIF ~KYLIX} + UpdateKeyName = 'Update #'; + BDSUpdateKeyName = 'UpdatePackInstalled'; +var + KeyLen, I: Integer; + Key: string; + Ed: TJclBorRADToolEdition; +begin + Key := ConfigData.FileName; + {$IFDEF KYLIX} + ConfigData.ReadSectionValues(GlobalsKeyName, Globals); + {$ELSE ~KYLIX} + RegGetValueNamesAndValues(HKEY_LOCAL_MACHINE, Key, Globals); + + KeyLen := Length(Key); + if (KeyLen > 3) and StrIsDigit(Key[KeyLen - 2]) and (Key[KeyLen - 1] = '.') and (Key[KeyLen] = '0') then + FIDEVersionNumber := Ord(Key[KeyLen - 2]) - Ord('0') + else + FIDEVersionNumber := 0; + + FVersionNumber := FIDEVersionNumber; + {$ENDIF ~KYLIX} + + case RadToolKind of + brDelphi : + FVersionNumberStr := Format('d%d', [VersionNumber]); + brCppBuilder : + FVersionNumberStr := Format('c%d', [VersionNumber]); + brBorlandDevStudio : + if VersionNumber = 1 then + FVersionNumberStr := 'cs1' + else + FVersionNumberStr := Format('d%d', [VersionNumber+6]); // BDS 2 goes to D8 + 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 BinaryFileName, + Description: string): Boolean; +var + InternalDescription: string; +begin + OutputString(Format(RsRegisteringExpert, [BinaryFileName])); + + if Description = '' then + InternalDescription := PathExtractFileNameNoExt(BinaryFileName) + else + InternalDescription := Description; + + Result := IdePackages.AddExpert(BinaryFileName, InternalDescription); + if Result then + OutputString(RsRegistrationOk) + else + OutputString(RsRegistrationFailed); +end; + +function TJclBorRADToolInstallation.RegisterIDEPackage(const BinaryFileName, + Description: string): Boolean; +var + InternalDescription: string; +begin + OutputString(Format(RsRegisteringIdePackage, [BinaryFileName])); + + if Description = '' then + InternalDescription := PathExtractFileNameNoExt(BinaryFileName) + else + InternalDescription := Description; + + Result := IdePackages.AddIDEPackage(BinaryFileName, InternalDescription); + if Result then + OutputString(RsRegistrationOk) + else + OutputString(RsRegistrationFailed); +end; + +function TJclBorRADToolInstallation.RegisterPackage(const BinaryFileName, + Description: string): Boolean; +var + InternalDescription: string; +begin + OutputString(Format(RsRegisteringPackage, [BinaryFileName])); + + if Description = '' then + InternalDescription := PathExtractFileNameNoExt(BinaryFileName) + else + InternalDescription := Description; + + Result := IdePackages.AddPackage(BinaryFileName, InternalDescription); + if Result then + OutputString(RsRegistrationOk) + else + OutputString(RsRegistrationFailed); +end; + +function TJclBorRADToolInstallation.RemoveFromDebugDCUPath(const Path: string): Boolean; +var + TempDebugDCUPath: TJclBorRADToolPath; +begin + TempDebugDCUPath := DebugDCUPath; + Result := RemoveFromPath(TempDebugDCUPath, Path); + DebugDCUPath := TempDebugDCUPath; +end; + +function TJclBorRADToolInstallation.RemoveFromLibrarySearchPath(const Path: string): Boolean; +var + TempLibraryPath: TJclBorRADToolPath; +begin + TempLibraryPath := LibrarySearchPath; + Result := RemoveFromPath(TempLibraryPath, Path); + LibrarySearchPath := TempLibraryPath; +end; + +function TJclBorRADToolInstallation.RemoveFromLibraryBrowsingPath(const Path: string): Boolean; +var + TempLibraryPath: TJclBorRADToolPath; +begin + TempLibraryPath := LibraryBrowsingPath; + Result := RemoveFromPath(TempLibraryPath, Path); + LibraryBrowsingPath := TempLibraryPath; +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.SetDebugDCUPath(const Value: string); +begin + ConfigData.WriteString(DebuggingKeyName, DebugDCUPathValueName, Value); +end; + +procedure TJclBorRADToolInstallation.SetLibrarySearchPath(const Value: TJclBorRADToolPath); +begin + ConfigData.WriteString(LibraryKeyName, LibrarySearchPathValueName, 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.SetLibraryBrowsingPath(const Value: TJclBorRADToolPath); +begin + 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, PathSeparator + PathSeparator, PathSeparator, [rfReplaceAll]); +end; + +{$IFDEF KEEP_DEPRECATED} +function TJclBorRADToolInstallation.SupportsBCB: Boolean; +begin + Result := clBCC32 in CommandLineTools; +end; +{$ENDIF KEEP_DEPRECATED} + +function TJclBorRADToolInstallation.SupportsVisualCLX: Boolean; +begin + {$IFDEF KYLIX} + Result := True; + {$ELSE} + Result := (Edition <> deSTD) and (VersionNumber in [6, 7]) and (RadToolKind <> brBorlandDevStudio); + {$ENDIF KYLIX} +end; + +function TJclBorRADToolInstallation.UninstallBCBExpert(const ProjectName, + OutputDir: string): Boolean; +var + BinaryFileName: string; +begin + OutputString(Format(RsExpertUninstallationStarted, [ProjectName])); + + if not IsBCBProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsNotABCBProject, [ProjectName]); + + GetBPRFileInfo(ProjectName, BinaryFileName); + BinaryFileName := PathAddSeparator(OutputDir) + BinaryFileName; + + // important: remove from experts /before/ deleting; + // otherwise PathGetLongPathName won't work + Result := UnregisterExpert(BinaryFileName); + + if Result then + OutputFileDelete(BinaryFileName); + + OutputString(RsExpertUninstallationFinished); +end; + +function TJclBorRADToolInstallation.UninstallBCBIdePackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +var + MAPFileName, TDSFileName, + BPIFileName, LIBFileName, BPLFileName: string; + BinaryFileName: string; + RunOnly: Boolean; +begin + OutputString(Format(RsIdePackageUninstallationStarted, [PackageName])); + + if not IsBCBPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsNotABCBPackage, [PackageName]); + + GetBPKFileInfo(PackageName, RunOnly, @BinaryFileName); + + BPLFileName := PathAddSeparator(BPLPath) + BinaryFileName; + + // 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(RsIdePackageUninstallationFinished); +end; + +function TJclBorRADToolInstallation.UninstallBCBPackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +var + MAPFileName, TDSFileName, + BPIFileName, LIBFileName, BPLFileName: string; + BinaryFileName: string; + RunOnly: Boolean; +begin + OutputString(Format(RsPackageUninstallationStarted, [PackageName])); + + if not IsBCBPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsNotABCBPackage, [PackageName]); + + GetBPKFileInfo(PackageName, RunOnly, @BinaryFileName); + + BPLFileName := PathAddSeparator(BPLPath) + BinaryFileName; + + // 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(RsPackageUninstallationFinished); +end; + +function TJclBorRADToolInstallation.UninstallDelphiExpert(const ProjectName, + OutputDir: string): Boolean; +var + BinaryFileName: string; + BaseName, LibSuffix, BinaryExtension: string; +begin + OutputString(Format(RsExpertUninstallationStarted, [ProjectName])); + + if not IsDelphiProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsNotADelphiProject, [ProjectName]); + + BaseName := PathExtractFileNameNoExt(ProjectName); + GetDPRFileInfo(ProjectName, BinaryExtension, @LibSuffix); + if BinaryExtension = '' then + BinaryExtension := BinaryExtensionLibrary; + BinaryFileName := PathAddSeparator(OutputDir) + BaseName + LibSuffix + BinaryExtension; + + // important: remove from experts /before/ deleting; + // otherwise PathGetLongPathName won't work + Result := UnregisterExpert(BinaryFileName); + + if Result then + OutputFileDelete(BinaryFileName); + + OutputString(RsExpertUninstallationFinished); +end; + +function TJclBorRADToolInstallation.UninstallDelphiIdePackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +var + MAPFileName, + BPLFileName, DCPFileName: string; + BaseName, LibSuffix: string; + RunOnly: Boolean; +begin + OutputString(Format(RsIdePackageUninstallationStarted, [PackageName])); + + if not IsDelphiPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsNotADelphiPackage, [PackageName]); + + GetDPKFileInfo(PackageName, RunOnly, @LibSuffix); + BaseName := PathExtractFileNameNoExt(PackageName); + + BPLFileName := PathAddSeparator(BPLPath) + BaseName + LibSuffix + BinaryExtensionPackage; + + // 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(RsIdePackageUninstallationFinished); +end; + +function TJclBorRADToolInstallation.UninstallDelphiPackage(const PackageName, + BPLPath, DCPPath: string): Boolean; +var + MAPFileName, + BPLFileName, DCPFileName: string; + BaseName, LibSuffix: string; + RunOnly: Boolean; +begin + OutputString(Format(RsPackageUninstallationStarted, [PackageName])); + + if not IsDelphiPackage(PackageName) then + raise EJclBorRADException.CreateResFmt(@RsNotADelphiPackage, [PackageName]); + + GetDPKFileInfo(PackageName, RunOnly, @LibSuffix); + BaseName := PathExtractFileNameNoExt(PackageName); + + BPLFileName := PathAddSeparator(BPLPath) + BaseName + LibSuffix + BinaryExtensionPackage; + + // 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(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(@RsUnknownProjectExtension, [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(@RsUnknownIdePackageExtension, [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(@RsUnknownPackageExtension, [PackageExtension]); +end; + +function TJclBorRADToolInstallation.UnregisterExpert( + const BinaryFileName: string): Boolean; +begin + OutputString(Format(RsUnregisteringExpert, [BinaryFileName])); + + Result := IdePackages.RemoveExpert(BinaryFileName); + if Result then + OutputString(RsUnregistrationOk) + else + OutputString(RsUnregistrationFailed); +end; + +function TJclBorRADToolInstallation.UnregisterIDEPackage( + const BinaryFileName: string): Boolean; +begin + OutputString(Format(RsUnregisteringIDEPackage, [BinaryFileName])); + + Result := IdePackages.RemoveIDEPackage(BinaryFileName); + if Result then + OutputString(RsUnregistrationOk) + else + OutputString(RsUnregistrationFailed); +end; + +function TJclBorRADToolInstallation.UnregisterPackage( + const BinaryFileName: string): Boolean; +begin + OutputString(Format(RsUnregisteringPackage, [BinaryFileName])); + + Result := IdePackages.RemovePackage(BinaryFileName); + if Result then + OutputString(RsUnregistrationOk) + else + OutputString(RsUnregistrationFailed); +end; + +//=== { TJclBCBInstallation } ================================================ + +constructor TJclBCBInstallation.Create(const AConfigDataLocation: string); +begin + inherited Create(AConfigDataLocation); + FPersonalities := [bpBCBuilder32]; + if clDcc32 in CommandLineTools then + Include(FPersonalities, bpDelphi32); +end; + +destructor TJclBCBInstallation.Destroy; +begin + inherited Destroy; +end; + +{$IFDEF KYLIX} +function TJclBCBInstallation.ConfigFileName(const Extension: string): string; +begin + Result := Format('%s/.borland/bcb%d%s', [GetPersonalFolder, IDs[VersionNumber], Extension]); +end; +{$ENDIF KYLIX} + +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 }class function TJclBCBInstallation.RadToolKind: TJclBorRadToolKind; +begin + Result := brCppBuilder; +end; + +function TJclBCBInstallation.RADToolName: string; +begin + Result := RsBCBName; +end; + +//=== { TJclDelphiInstallation } ============================================= + +{$IFDEF KYLIX} +function TJclDelphiInstallation.ConfigFileName(const Extension: string): string; +begin + Result := Format('%s/.borland/delphi%d%s', [GetPersonalFolder, IDs[VersionNumber], Extension]); +end; +{$ENDIF KYLIX} + +constructor TJclDelphiInstallation.Create( + const AConfigDataLocation: string); +begin + inherited Create(AConfigDataLocation); + 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 }class function TJclDelphiInstallation.RadToolKind: TJclBorRadToolKind; +begin + Result := brDelphi; +end; + +function TJclDelphiInstallation.RADToolName: string; +begin + Result := RsDelphiName; +end; + +//=== { TJclBDSInstallation } ================================================== + +{$IFDEF MSWINDOWS} + +function TJclBDSInstallation.CleanPackageCache( + const BinaryFileName: string): Boolean; +var + FileName: string; +begin + Result := True; + + if VersionNumber >= 3 then + begin + FileName := ExtractFileName(BinaryFileName); + + try + OutputString(Format(RsCleaningPackageCache, [FileName])); + + Result := RegDeleteKeyTree(HKCU, PathAddSeparator(ConfigDataLocation) + + PackageCacheKeyName + '\' + FileName); + + if Result then + OutputString(RsCleaningOk) + else + OutputString(RsCleaningFailed); + except + // trap possible exceptions + end; + end; +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(@RsDualPackageNotSupported, [Name]); + + NewOptions := Format('%s -JL -NB"%s" -NO"%s" -N1"%s"', + [ExtraOptions, DcpPath, DcpPath, VclIncludeDir]); + end + else + NewOptions := ExtraOptions; + + Result := inherited CompileDelphiPackage(PackageName, BPLPath, DCPPath, NewOptions); +end; + +function TJclBDSInstallation.CompileDelphiProject(const ProjectName, + OutputDir, DcpSearchPath: string): Boolean; +var + ExtraOptions, BinaryExtension, LibSuffix, BinaryFileName: string; +begin + if VersionNumber <= 2 then + begin + OutputString(Format(RsCompilingProject, [ProjectName])); + + if not IsDelphiProject(ProjectName) then + raise EJclBorRADException.CreateResFmt(@RsNotADelphiProject, [ProjectName]); + + if MapCreate then + ExtraOptions := '-GD' + else + ExtraOptions := ''; + + GetDPRFileInfo(ProjectName, BinaryExtension, @LibSuffix); + if BinaryExtension = '' then + BinaryExtension := BinaryExtensionLibrary; + BinaryFileName := PathAddSeparator(OutputDir) + PathExtractFileNameNoExt(ProjectName) + LibSuffix + BinaryExtension; + + Result := DCC32.MakeProject(ProjectName, OutputDir, DcpSearchPath, ExtraOptions) + and LinkMapFile(BinaryFileName); + + if Result then + OutputString(RsCompilationOk) + else + OutputString(RsCompilationFailed); + end + else + Result := inherited CompileDelphiProject(ProjectName, DcpSearchPath, OutputDir); +end; + +constructor TJclBDSInstallation.Create(const AConfigDataLocation: string); +const + PersonalitiesSection = 'Personalities'; +begin + inherited Create(AConfigDataLocation); + //FBCBInstallation := TJclBCBInstallation.Create(AConfigDataLocation); + + { TODO : .net 64 bit } + 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 + Include(FPersonalities, bpDelphiNet32); + + if clDcc32 in CommandLineTools then + Include(FPersonalities, bpDelphi32); + + if FPersonalities = [] then + raise EJclBorRadException.CreateRes(@RsNoSupportedPersonality); +end; + +{ TODO -cHelp : Donator: Adreas Hausladen } +function TJclBDSInstallation.GetBorlandStudioProjectsDir: string; +var + h: HMODULE; + LocaleName: array[0..4] of Char; + Filename: string; +begin + Result := 'Borland Studio Projects'; // do not localize + + FillChar(LocaleName, SizeOf(LocaleName[0]), 0); + GetLocaleInfo(GetThreadLocale, LOCALE_SABBREVLANGNAME, LocaleName, SizeOf(LocaleName)); + if LocaleName[0] <> #0 then + begin + Filename := RootDir + '\Bin\coreide' + BDSVersions[IDEVersionNumber].CoreIdeVersion + '.'; + if FileExists(Filename + LocaleName) then + Filename := Filename + LocaleName + else + begin + LocaleName[2] := #0; + if FileExists(Filename + LocaleName) then + Filename := Filename + LocaleName + else + Filename := ''; + end; + + if Filename <> '' then + begin + h := LoadLibraryEx(PChar(Filename), 0, + LOAD_LIBRARY_AS_DATAFILE or DONT_RESOLVE_DLL_REFERENCES); + if h <> 0 then + begin + SetLength(Result, 1024); + SetLength(Result, LoadString(h, BDSVersions[IDEVersionNumber].ProjectsDirResId, PChar(Result), Length(Result) - 1)); + FreeLibrary(h); + end; + end; + end; + + Result := PathAddSeparator(GetPersonalFolder) + Result; +end; + +function TJclBDSInstallation.GetBPLOutputPath: string; +begin +// BDS 1 (C#Builder 1) and BDS 2 (Delphi 8) don't have a valid BPL output path +// set in the registry + if VersionNumber <= 2 then + Result := PathAddSeparator(GetDefaultProjectsDir) + 'bpl' + else + Result := inherited GetBPLOutputPath; +end; + +function TJclBDSInstallation.GetDCPOutputPath: string; +begin + if VersionNumber <= 2 then + Result := PathAddSeparator(RootDir) + 'lib' + else + Result := inherited GetDCPOutputPath; +end; + +function TJclBDSInstallation.GetDefaultProjectsDir: string; +begin + Result := GetBorlandStudioProjectsDir; +end; + +function TJclBDSInstallation.GetEnvironmentVariables: TStrings; +begin + Result := inherited GetEnvironmentVariables; + 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; + end; +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.GetName: string; +begin + if VersionNumber in [Low(BDSVersions)..High(BDSVersions)] then + Result := Format('%s %s', [RadToolName, BDSVersions[VersionNumber].VersionStr]) + else + Result := Format('%s ***%s***', [RadToolName, VersionNumber]); +end; + +function TJclBDSInstallation.GetVclIncludeDir: string; +begin + if not (bpBCBuilder32 in Personalities) then + raise EJclBorRadException.CreateResFmt(@RsDualPackageNotSupported, [Name]); + Result := inherited GetVclIncludeDir; +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; + +function TJclBDSInstallation.RadToolName: string; +begin + if VersionNumber in [Low(BDSVersions)..High(BDSVersions)] then + Result := BDSVersions[VersionNumber].Name + else + Result := RsBDSName; +end; + +function TJclBDSInstallation.RegisterPackage(const BinaryFileName, + Description: string): Boolean; +begin + if VersionNumber >= 3 then + CleanPackageCache(BinaryFileName); + + Result := inherited RegisterPackage(BinaryFileName, Description); +end; + +procedure TJclBDSInstallation.SetDualPackageInstallation(const Value: Boolean); +begin + if Value and not (bpBCBuilder32 in Personalities) then + raise EJclBorRadException.CreateResFmt(@RsDualPackageNotSupported, [Name]); + FDualPackageInstallation := Value; +end; + +function TJclBDSInstallation.UnregisterPackage( + const BinaryFileName: string): Boolean; +begin + if VersionNumber >= 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(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].VersionNumber = VersionNumber then + begin + Result := Installations[I]; + Break; + end; + brBorlandDevStudio: + if (VersionNumber >= 10) and (Installations[I].VersionNumber = (VersionNumber-6)) 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].VersionNumber = VersionNumber then + begin + Result := Installations[I]; + Break; + end; + brBorlandDevStudio: + if (VersionNumber >= 8) and (Installations[I].VersionNumber = (VersionNumber-6)) 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].VersionNumber = 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; +{$IFDEF KYLIX} +var + I: Integer; + + procedure CheckForInstallation(RADToolKind: TJclBorRADToolKind; VersionNumber: Integer); + const + RcBaseFileNames: array [brDelphi..brCppBuilder] of string = ('delphi', 'bcb'); + var + Item: TJclBorRADToolInstallation; + RcFileName: string; + begin + RcFileName := Format('%s/.borland/%s%drc', [GetPersonalFolder, RcBaseFileNames[RADToolKind], IDs[VersionNumber]]); + if FileExists(RcFileName) then + begin + if RADToolKind = brCppBuilder then + Item := TJclBCBInstallation.Create(RcFileName) + else + Item := TJclDelphiInstallation.Create(RcFileName); + Item.FVersionNumber := VersionNumber; + FList.Add(Item); + end; + end; + +begin + FList.Clear; + for I := Low(TKylixVersion) to High(TKylixVersion) do + CheckForInstallation(brDelphi, I); + CheckForInstallation(brCppBuilder, 3); // Kylix 3 only +end; +{$ELSE ~KYLIX} +var + VersionNumbers: TStringList; + + function EnumVersions(const KeyName: string; const Personalities: array of string; CreateClass: TJclBorRADToolInstallationClass) : Boolean; + var + I, J: Integer; + VersionKeyName: string; + PersonalitiesList: TStrings; + 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], ['.', '0'..'9']) then + begin + VersionKeyName := KeyName + PathSeparator + VersionNumbers[I]; + if RegKeyExists(HKEY_LOCAL_MACHINE, VersionKeyName) then + begin + if Length(Personalities) = 0 then + begin + try + FList.Add(CreateClass.Create(VersionKeyName)); + finally + Result := True; + end; + end + else + begin + PersonalitiesList := TStringList.Create; + try + RegGetValueNames(HKEY_LOCAL_MACHINE, VersionKeyName + '\Personalities', PersonalitiesList); + for J := Low(Personalities) to High(Personalities) do + if PersonalitiesList.IndexOf(Personalities[J]) >= 0 then + begin + try + FList.Add(CreateClass.Create(VersionKeyName)); + finally + Result := True; + end; + Break; + end; + finally + PersonalitiesList.Free; + end; + end; + end; + end; + end; + +begin + FList.Clear; + VersionNumbers := TStringList.Create; + try + EnumVersions(DelphiKeyName, [], TJclDelphiInstallation); + EnumVersions(BCBKeyName, [], TJclBCBInstallation); + EnumVersions(BDSKeyName, ['Delphi.Win32','BCB','Delphi8','C#Builder'], TJclBDSInstallation); + finally + VersionNumbers.Free; + end; +end; +{$ENDIF ~KYLIX} + +//=== { TJclCommandLineTool } ================================================ + +constructor TJclCommandLineTool.Create(const AExeName: string); +begin + inherited Create; + FOptions := TStringList.Create; + FExeName := AExeName; +end; + +destructor TJclCommandLineTool.Destroy; +begin + FreeAndNil(FOptions); + inherited Destroy; +end; + +procedure TJclCommandLineTool.AddPathOption(const Option, Path: string); +var + S: string; +begin + S := PathRemoveSeparator(Path); + {$IFDEF MSWINDOWS} + S := LowerCase(S); // file names are case insensitive + {$ENDIF MSWINDOWS} + S := Format('-%s"%s"', [Option, S]); + // avoid duplicate entries (note that search is case sensitive) + if GetOptions.IndexOf(S) = -1 then + GetOptions.Add(S); +end; + +function TJclCommandLineTool.Execute(const CommandLine: string): Boolean; +begin + if Assigned(FOutputCallback) then + Result := JclSysUtils.Execute(Format('"%s" %s', [ExeName, CommandLine]), FOutputCallback) = 0 + else + Result := JclSysUtils.Execute(Format('"%s" %s', [ExeName, CommandLine]), FOutput) = 0; +end; + +function TJclCommandLineTool.GetExeName: string; +begin + Result := FExeName; +end; + +function TJclCommandLineTool.GetOptions: TStrings; +begin + Result := FOptions; +end; + +function TJclCommandLineTool.GetOutput: string; +begin + Result := FOutput; +end; + +function TJclCommandLineTool.GetOutputCallback: TTextHandler; +begin + Result := FOutputCallback; +end; + +procedure TJclCommandLineTool.SetOutputCallback(const CallbackMethod: TTextHandler); +begin + FOutputCallback := CallbackMethod; +end; + +// History: + +// $Log: JclBorlandTools.pas,v $ +// Revision 1.55 2006/02/08 19:45:58 outchy +// Command line is now added to output +// +// Revision 1.54 2006/02/05 13:26:15 outchy +// dcp, bpi and lib files are created in \lib\ver +// +// Revision 1.53 2006/02/02 20:33:40 outchy +// Package cache cleaned +// +// Revision 1.52 2005/12/26 20:18:02 uschuster +// fixed BDS Update Pack detection +// +// Revision 1.51 2005/12/26 20:02:09 outchy +// IT3363: overriden environment variables +// +// Revision 1.50 2005/12/26 18:03:51 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.48 2005/11/13 17:04:20 uschuster +// fix for Kylix +// +// Revision 1.47 2005/11/10 22:16:31 outchy +// Added creation/link/deletion of MAP files for packages. +// +// Revision 1.46 2005/10/28 04:38:53 rrossmair +// - fixes related to package uninstallation, and more +// +// Revision 1.45 2005/10/04 04:22:48 rrossmair +// - saved local function TJclDCC.SaveOptionsToFile.IsPathOption +// +// Revision 1.44 2005/08/07 13:22:09 outchy +// IT3116: Added REG_EXPAND_SZ and REG_BINARY to the list of valid keys. +// +// Revision 1.43 2005/08/06 11:33:50 rrossmair +// - TJclBorRADToolInstallations.ReadInstallations: fixed processing of HK*\Software\Borland\BDS\* registry keys +// +// Revision 1.42 2005/07/28 21:57:49 outchy +// JEDI Installer can now install design-time packages for C++Builder 5 and 6 +// +// Revision 1.41 2005/03/22 03:36:09 rrossmair +// - fixed PathGetShortName usage for packages +// - TJclDCC.SetDefaultOptions extended for BCB +// +// Revision 1.40 2005/03/21 04:24:34 rrossmair +// - identifier mistake fixed (Kylix) +// +// Revision 1.39 2005/03/21 04:05:31 rrossmair +// - workarounds for DCC32 126 character path limit +// +// Revision 1.38 2005/03/14 04:03:21 rrossmair +// - fixed TJclBorRADToolIdePackages.RemovePackage +// +// Revision 1.37 2005/03/08 08:33:15 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.36 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.35 2005/02/24 16:34:39 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.34 2005/02/23 07:53:13 rrossmair +// - added TJclDCC.SetDefaultOptions, which includes the path(s) normally found in $(DELPHI)\bin\dcc32.cfg. +// - AddPathOption() methods enhanced. +// +// Revision 1.33 2005/02/04 05:11:21 rrossmair +// - fixed TJclBorRADToolInstallation.UninstallPackage +// +// Revision 1.32 2005/02/04 04:49:08 rrossmair +// - fixed GetDPKFileInfo +// - more uninstall support +// +// Revision 1.31 2005/02/03 05:17:54 rrossmair +// - some uninstall support added +// - refactoring: TJclDCC.InstallPackage replaced by TJclDCC.MakelPackage, IDE installation part moved to TJclBorRADToolInstallation.InstallPackage +// +// Revision 1.30 2004/12/23 04:31:42 rrossmair +// - check-in for JCL 1.94 RC 1 +// +// Revision 1.29 2004/12/20 05:15:48 rrossmair +// - fixed for Kylix ($IFDEFed GetBorlandStudioProjectsDir) +// +// Revision 1.28 2004/12/18 04:03:30 rrossmair +// - more D2005 support +// +// Revision 1.27 2004/12/16 19:56:58 rrossmair +// - fixed for Windows +// +// Revision 1.26 2004/12/15 22:54:04 rrossmair +// - fixed for Kylix +// +// Revision 1.25 2004/12/15 21:46:40 rrossmair +// - D2005 support (incomplete) +// +// Revision 1.24 2004/11/18 00:57:14 rrossmair +// - check-in for release 1.93 +// +// Revision 1.23 2004/11/16 06:17:27 marquardt +// style cleaning +// +// Revision 1.22 2004/11/15 20:42:35 rrossmair +// - TJclBorRADToolInstallation.SubstitutePath: remove duplicate path delimiters +// +// Revision 1.21 2004/11/09 07:51:37 rrossmair +// - installer refactoring (incomplete) +// +// Revision 1.20 2004/10/25 06:58:44 rrossmair +// - fixed bug #0002065 +// - outsourced JclMiscel.Win32ExecAndRedirectOutput() + JclBorlandTools.ExecAndRedirectOutput() code into JclSysUtils.Execute() +// - refactored this code +// - added overload to supply callback capability per line of output +// +// Revision 1.19 2004/10/17 05:23:06 rrossmair +// replaced PathGetLongName2() by PathGetLongName() +// +// Revision 1.18 2004/08/09 06:38:08 marquardt +// add JvWStrUtils.pas as JclWideStrings.pas +// +// Revision 1.17 2004/08/01 05:52:10 marquardt +// move constructors/destructors +// +// Revision 1.16 2004/07/30 07:20:24 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate +// +// Revision 1.15 2004/07/28 18:00:48 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.14 2004/07/14 03:36:20 rrossmair +// fixed bug #1897 ( TJclBorRADToolInstallation.GetEnvironmentVariables failure) +// +// Revision 1.13 2004/06/16 07:30:26 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.12 2004/06/14 06:24:52 marquardt +// style cleaning IFDEF +// +// Revision 1.11 2004/05/13 16:38:45 rrossmair +// fixed for paths w/ spaces +// +// Revision 1.10 2004/05/11 11:55:43 rrossmair +// added TJclBCBInstallation.VclIncludeDir +// +// Revision 1.9 2004/05/08 08:44:17 rrossmair +// introduced & applied symbol HAS_UNIT_LIBC +// +// Revision 1.8 2004/05/05 00:04:10 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.7 2004/04/18 05:15:07 rrossmair +// code clean-up +// + +end. + diff --git a/official/1.96/source/common/JclComplex.pas b/official/1.96/source/common/JclComplex.pas new file mode 100644 index 0000000..0c38800 --- /dev/null +++ b/official/1.96/source/common/JclComplex.pas @@ -0,0 +1,1618 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/05/05 20:08:42 $ +// For history see end of file + +unit JclComplex; + +{$I jcl.inc} + +interface + +uses + SysUtils, + 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 1 + Theta: Float; // polar 2 + end; + + TRectCoord = record + X: Float; + Y: Float; + end; + + TJclComplex = class(TObject) + private {z = x + yi} + FCoord: TCoords; + FFracLen: Byte; + function MiscalcSingle(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(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 + function CLn: TJclComplex; + function CNewLn: TJclComplex; + function CExp: TJclComplex; + function CNewExp: TJclComplex; + function CPwr(const PwrValue: TJclComplex): TJclComplex; overload; + function CPwr(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CNewPwr(PwrValue: TJclComplex): TJclComplex; overload; + function CNewPwr(const X, Y: Float; const ComplexType: TComplexKind = crRectangular): TJclComplex; overload; + function CIntPwr(const Pwr: Integer): TJclComplex; overload; + function CNewIntPwr(const Pwr: Integer): TJclComplex; overload; + function CRealPwr(const Pwr: Float): TJclComplex; overload; + function CNewRealPwr(const Pwr: Float): TJclComplex; overload; + function CRoot(const K, N: Word): TJclComplex; overload; + function CNewRoot(const K, N: Word): TJclComplex; overload; + function CSqrt: TJclComplex; overload; + function CNewSqrt: TJclComplex; overload; + + //----------- trigonometric functions + function CCos: TJclComplex; + function CNewCos: TJclComplex; + function CSin: TJclComplex; + function CNewSin: TJclComplex; + function CTan: TJclComplex; + function CNewTan: TJclComplex; + function CCot: TJclComplex; + function CNewCot: TJclComplex; + function CSec: TJclComplex; + function CNewSec: TJclComplex; + function CCsc: TJclComplex; + function CNewCsc: TJclComplex; + + //----------- complex hyperbolic functions + function CCosH: TJclComplex; + function CNewCosH: TJclComplex; + function CSinH: TJclComplex; + function CNewSinH: TJclComplex; + function CTanH: TJclComplex; + function CNewTanH: TJclComplex; + function CCotH: TJclComplex; + function CNewCotH: TJclComplex; + function CSecH: TJclComplex; + function CNewSecH: TJclComplex; + function CCscH: TJclComplex; + function CNewCscH: TJclComplex; + + //----------- complex Bessel functions of order zero + function CI0: TJclComplex; + function CNewI0: TJclComplex; + function CJ0: TJclComplex; + function CNewJ0: TJclComplex; + + function CApproxLnGamma: TJclComplex; + function CNewApproxLnGamma: TJclComplex; + function CLnGamma: TJclComplex; + function CNewLnGamma: TJclComplex; + function CGamma: 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; + + {$IFDEF CLR} + { TODO : Implement operators } + {$ENDIF CLR} + end; + +var + ComplexPrecision: Float = 1E-14; + +const + MaxTerm: Byte = 35; + EpsilonSqr: Float = 1E-20; + +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(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 * Cos(FCoord.Theta); + FCoord.Y := FCoord.R * Sin(FCoord.Theta); + end; + crRectangular: + begin + if FCoord.X = 0.0 then + begin + FCoord.R := Abs(FCoord.Y); + FCoord.Theta := PiOn2 * Sgn(FCoord.Y); + end + else + begin + FCoord.R := AbsoluteValue; + FCoord.Theta := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.ArcTan(FCoord.Y / FCoord.X); + if FCoord.X < 0.0 then + FCoord.Theta := FCoord.Theta + Pi * Sgn(FCoord.Y); + end; + end; + end; + MiscalcComplex; +end; + +function TJclComplex.MiscalcSingle(const X: Float): Float; +begin + Result := X; + if Abs(Result) < ComplexPrecision then + Result := 0.0; +end; + +procedure TJclComplex.MiscalcComplex; // eliminates miscalculation +begin + FCoord.X := MiscalcSingle(FCoord.X); + FCoord.Y := MiscalcSingle(FCoord.Y); + FCoord.R := MiscalcSingle(FCoord.R); + if FCoord.R = 0.0 then + FCoord.Theta := 0.0 + else + FCoord.Theta := MiscalcSingle(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; +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)) + 'i'; + end + else + Result := FormatExtended(FCoord.Y) + 'i'; +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, [' ']); + 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 + {$IFDEF CLR} + raise EJclMathError.Create(RsComplexInvalidString); + {$ELSE} + raise EJclMathError.CreateRes(@RsComplexInvalidString); + {$ENDIF CLR} + end; + try + ImagPart := StrToFloat(Copy(StrToParse, SignPos, Length(StrToParse) - SignPos)); + except + {$IFDEF CLR} + raise EJclMathError.Create(RsComplexInvalidString); + {$ELSE} + raise EJclMathError.CreateRes(@RsComplexInvalidString); + {$ENDIF CLR} + 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 + {$IFDEF CLR} + raise EJclMathError.Create(RsComplexInvalidString); + {$ELSE} + raise EJclMathError.CreateRes(@RsComplexInvalidString); + {$ENDIF CLR} + end; + end + else + begin + try + RealPart := StrToFloat(StrToParse); + except + {$IFDEF CLR} + raise EJclMathError.Create(RsComplexInvalidString); + {$ELSE} + raise EJclMathError.CreateRes(@RsComplexInvalidString); + {$ENDIF CLR} + end; + ImagPart := 0.0; + end; + end; + Assign(RealPart, ImagPart, crRectangular); +end; + +procedure TJclComplex.SetPolarString(StrToParse: string); +var + AstPos: Integer; + Radius, Angle: Float; +begin + {$IFDEF CLR} + StrToParse := StrRemoveChars(StrToParse, [' ']).toUpper; + {$ELSE} + StrToParse := AnsiUpperCase(StrRemoveChars(StrToParse, [' '])); + {$ENDIF CLR} + AstPos := Pos('*', StrToParse); + if AstPos = 0 then + {$IFDEF CLR} + raise EJclMathError.Create(RsComplexInvalidString); + {$ELSE} + raise EJclMathError.CreateRes(@RsComplexInvalidString); + {$ENDIF CLR} + try + Radius := StrToFloat(StrLeft(StrToParse, AstPos - 1)); + except + {$IFDEF CLR} + raise EJclMathError.Create(RsComplexInvalidString); + {$ELSE} + raise EJclMathError.CreateRes(@RsComplexInvalidString); + {$ENDIF CLR} + end; + AstPos := Pos('(', StrToParse); + if AstPos = 0 then + {$IFDEF CLR} + raise EJclMathError.Create(RsComplexInvalidString); + {$ELSE} + raise EJclMathError.CreateRes(@RsComplexInvalidString); + {$ENDIF CLR} + try + Angle := StrToFloat(Copy(StrToParse, AstPos + 1, Length(StrToParse) - AstPos - 1)); + except + {$IFDEF CLR} + raise EJclMathError.Create(RsComplexInvalidString); + {$ELSE} + raise EJclMathError.CreateRes(@RsComplexInvalidString); + {$ENDIF CLR} + 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 := {$IFDEF CLR}Borland.Delphi.{$ENDIF}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 := Exp(ExpValue.X); + Result.X := ExpX * Cos(ExpValue.Y); + Result.Y := ExpX * 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 := MiscalcSingle(First.X); + First.Y := MiscalcSingle(First.Y); + Second.X := MiscalcSingle(Second.X); + Second.Y := MiscalcSingle(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 := MiscalcSingle(First.X); + First.Y := MiscalcSingle(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 := MiscalcSingle(First.X); + First.Y := MiscalcSingle(First.Y); + if AbsoluteValueSqr(First) = 0.0 then + if MiscalcSingle(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 := MiscalcSingle(First.X); + First.Y := MiscalcSingle(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(Cos(Value.X) * CosH(Value.Y), -Sin(Value.X) * 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(Sin(Value.X) * CosH(Value.Y), Cos(Value.X) * 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 := Cos(2.0 * Value.X) + CosH(2.0 * Value.Y); + if MiscalcSingle(TempValue) <> 0.0 then + Result := RectCoord(Sin(2.0 * Value.X) / TempValue, 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 := Cosh(2.0 * Value.Y) - Cos(2.0 * Value.X); + if MiscalcSingle(TempValue) <> 0.0 then + Result := RectCoord(Sin(2.0 * Value.X) / TempValue, -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 MiscalcSingle(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 MiscalcSingle(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(CosH(Value.X) * Cos(Value.Y), SinH(Value.X) * 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(SinH(Value.X) * Cos(Value.Y), CosH(Value.X) * 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 := CosH(2.0 * Value.X) + Cos(2.0 * Value.Y); + if MiscalcSingle(TempValue) <> 0.0 then + Result := RectCoord(SinH(2.0 * Value.X) / TempValue, 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 := Cosh(2.0 * Value.X) - Cos(2.0 * Value.Y); + if MiscalcSingle(TempValue) <> 0.0 then + Result := RectCoord(SinH(2.0 * Value.X) / TempValue, -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 MiscalcSingle(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 MiscalcSingle(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 (MiscalcSingle(Value.Y) = 0.0) then + if MiscalcSingle(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(Value: Float): Float; +begin + FillCoords(crRectangular); + while Value > Pi do + Value := Value - TwoPi; + while Value < -Pi do + Value := Value + TwoPi; + Value := MiscalcSingle(Value); + Result := Value; +end; + +// History: + +// $Log: JclComplex.pas,v $ +// Revision 1.15 2005/05/05 20:08:42 ahuser +// JCL.NET support +// +// Revision 1.14 2005/03/08 16:10:07 marquardt +// standard char sets extended and used, some optimizations for string literals +// +// Revision 1.13 2005/03/08 08:33:15 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.12 2005/02/24 16:34:39 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.11 2005/02/13 09:55:20 mthoma +// Fixed: 0000060: Don's use parameter 'Value' in trigonometric functions +// +// Revision 1.10 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.9 2004/10/12 17:21:54 rrossmair +// restore JclMath compatibility +// +// Revision 1.8 2004/09/16 19:47:32 rrossmair +// check-in in preparation for release 1.92 +// +// Revision 1.7 2004/08/01 05:52:11 marquardt +// move constructors/destructors +// +// Revision 1.6 2004/07/28 18:00:49 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.5 2004/05/05 00:04:10 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names +// when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.4 2004/04/06 04:53:18 +// adapt compiler conditions, add log entry +// +// Revision 1.3 2004/03/23 08:54 rrossmair +// to work around D7 trial issues, $WEAKPACKAGEUNIT directives now depend on symbol in jedi.inc +// modification date comments replaced by $Id: JclComplex.pas,v 1.15 2005/05/05 20:08:42 ahuser Exp $ CVS key word +// +// Revision 1.2 2003/11/27 16:54 rrossmair +// removed unused JclSysUtils from uses clause +// +// Revision 1.1 2003/11/19 16:43 mthoma +// Initial upload. + +end. diff --git a/official/1.96/source/common/JclCompression.pas b/official/1.96/source/common/JclCompression.pas new file mode 100644 index 0000000..ebad465 --- /dev/null +++ b/official/1.96/source/common/JclCompression.pas @@ -0,0 +1,779 @@ +{**************************************************************************************************} +{ } +{ 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: } +{ } +{**************************************************************************************************} +{ } +{ 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 unit is still in alpha state. It is likely that it will change a lot. Suggestions are } +{ welcome. } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/10/25 04:46:31 $ +// For history see end of file + +unit JclCompression; + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Types, + {$ENDIF UNIX} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + SysUtils, Classes, + JclBase, + zlibh; + +{**************************************************************************************************} +{ + TJclCompressionStream + - - + ----------------------- -------------------------- + - - + TJclCompressStream TJclDecompressStream + - - + --------------------------------- --------------------------------- + - - - - - - + - - - - - - + TJclZLibCompressStream - TBZIP2CompressStram TJclZLibDecompressStream - TBZIP2DeCompressStream + - - + - TGZDecompressStream + TGZCompressStream + + } +{**************************************************************************************************} + +type + TJclCompressionStream = class(TStream) + 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 + constructor Create(Stream: TStream); + destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + procedure Reset; virtual; + end; + + TJclCompressStream = class(TJclCompressionStream) + public + function Flush: Integer; dynamic; abstract; + constructor Create(Destination: TStream); + end; + + TJclDecompressStream = class(TJclCompressionStream) + public + constructor Create(Source: TStream); + end; + + // ZIP Support + 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 + constructor Create(Destination: TStream; CompressionLevel: TJclCompressionLevel = -1); + destructor Destroy; override; + function Flush: Integer; override; + procedure Reset; override; + function Seek(Offset: Longint; Origin: Word): Longint; 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; + + TJclZLibDecompressStream = class(TJclDecompressStream) + private + FWindowBits: Integer; + FInflateInitialized: Boolean; + protected + ZLibRecord: TZStreamRec; + procedure SetWindowBits(Value: Integer); + public + constructor Create(Source: TStream; WindowBits: Integer = DEF_WBITS); + destructor Destroy; override; + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + property WindowBits: Integer read FWindowBits write SetWindowBits; + end; + + // GZIP Support + TJclGZIPCompressionStream = class(TJclCompressionStream) + end; + + TJclGZIPDecompressionStream = class(TJclDecompressStream) + end; + + // RAR Support + TJclRARCompressionStream = class(TJclCompressionStream) + end; + + TJclRARDecompressionStream = class(TJclDecompressStream) + end; + + // TAR Support + TJclTARCompressionStream = class(TJclCompressionStream) + end; + + TJclTARDecompressionStream = class(TJclDecompressStream) + end; + + // BZIP2 Support +(* + TJclBZIP2CompressStream = class(TJclCompressStream) + private + FDeflateInitialized: Boolean; + + protected + BZLibRecord: TBZStream; + public + function Flush: Integer; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + + constructor Create(Destination: TStream; CompressionLevel: TJclCompressionLevel = -1); + destructor Destroy; override; + end; + + TJclBZIP2DecompressStream = class(TJclDecompressStream) + private + FInflateInitialized: Boolean; + + protected + BZLibRecord: TBZStream; + + public + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + + constructor Create(Source: TStream); overload; + destructor Destroy; override; + end; +*) + + EJclCompressionError = class(EJclError); + +implementation + +uses + JclResources; + +const + JclDefaultBufferSize = 131072; // 128k + +//=== { TJclCompressionStream } ============================================== + +constructor TJclCompressionStream.Create(Stream: TStream); +begin + inherited Create; + FBuffer := nil; + SetBufferSize(JclDefaultBufferSize); +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(Offset: Longint; Origin: Word): Longint; +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; + +procedure TJclCompressionStream.Progress(Sender: TObject); +begin + if Assigned(FOnProgress) then + FOnProgress(Sender); +end; + +//=== { TJclCompressStream } ================================================= + +constructor TJclCompressStream.Create(Destination: TStream); +begin + inherited Create(Destination); + FStream := Destination; +end; + +//=== { TJclDecompressStream } =============================================== + +constructor TJclDecompressStream.Create(Source: TStream); +begin + inherited Create(Source); + FStream := Source; +end; + + +//=== { TJclZLibCompressionStream } ========================================== + +{ Error checking helper } + +function ZLibCheck(const ErrCode: Integer): Integer; +begin + Result := ErrCode; + if ErrCode < 0 then + case ErrCode of + 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.CreateRes(@RsCompressionZLibError); + end; +end; + +constructor TJclZLibCompressStream.Create(Destination: TStream; CompressionLevel: TJclCompressionLevel); +begin + inherited Create(Destination); + + Assert(FBuffer <> nil); + Assert(FBufferSize > 0); + + // Initialize ZLib StreamRecord + with ZLibRecord do + begin + zalloc := nil; // Use build-in memory allocation functionality + zfree := nil; + next_in := nil; + avail_in := 0; + next_out := FBuffer; + avail_out := FBufferSize; + end; + + 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(Offset: Longint; Origin: Word): Longint; +begin + if (Offset = 0) and (Origin = soFromCurrent) then + Result := ZLibRecord.total_in + else + if (Offset = 0) and (Origin = soFromBeginning) and (ZLibRecord.total_in = 0) then + Result := 0 + else + Result := inherited Seek(Offset, Origin); +end; + +procedure TJclZLibCompressStream.SetWindowBits(Value: Integer); +begin + FWindowBits := Value; +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 = DEF_WBITS); +begin + inherited Create(Source); + + // Initialize ZLib StreamRecord + with ZLibRecord do + begin + zalloc := nil; // Use build-in memory allocation functionality + zfree := nil; + next_in := nil; + avail_in := 0; + next_out := FBuffer; + avail_out := FBufferSize; + end; + + FInflateInitialized := False; + FWindowBits := WindowBits; +end; + +destructor TJclZLibDecompressStream.Destroy; +begin + if FInflateInitialized then + begin + FStream.Seek(-ZLibRecord.avail_in, soFromCurrent); + ZLibCheck(inflateEnd(ZLibRecord)); + end; + + inherited Destroy; +end; + +function TJclZLibDecompressStream.Read(var Buffer; Count: Longint): Longint; +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 + ZLibCheck(inflate(ZLibRecord, Z_NO_FLUSH)); + Progress(Self); + end; + end; + + Result := Count; +end; + +function TJclZLibDecompressStream.Seek(Offset: Longint; Origin: Word): Longint; +begin + if (Offset = 0) and (Origin = soFromCurrent) then + Result := ZLibRecord.total_out + else + Result := inherited Seek(Offset, Origin); +end; + +procedure TJclZLibDecompressStream.SetWindowBits(Value: Integer); +begin + FWindowBits := Value; +end; + +//=== { TJclBZLibCompressionStream } ========================================= +(* +{ Error checking helper } + +function BZIP2LibCheck(const ErrCode: Integer): Integer; +begin + Result := ErrCode; + + if ErrCode < 0 then + begin + case ErrCode of + 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.CreateRes(@RsCompressionZLibError); + end; + end; +end; + +constructor TJclBZIP2CompressStream.Create(Destination: TStream; CompressionLevel: TJclCompressionLevel); +begin + inherited Create(Destination); + + Assert(FBuffer <> nil); + Assert(FBufferSize > 0); + + // Initialize ZLib StreamRecord + with BZLibRecord do + begin + bzalloc := nil; // Use build-in memory allocation functionality + bzfree := nil; + next_in := nil; + avail_in := 0; + next_out := FBuffer; + avail_out := FBufferSize; + + end; + + FDeflateInitialized := False; +end; + +destructor TJclBZIP2CompressStream.Destroy; +begin + Flush; + if FDeflateInitialized then + BZIP2LibCheck(BZ2_bzCompressEnd(@BZLibRecord)); + + inherited Destroy; +end; + +function TJclBZIP2CompressStream.Write(const Buffer; Count: Longint): Longint; +begin + if not FDeflateInitialized then + begin + BZIP2LibCheck(BZ2_bzCompressInit(@BZLibRecord,9,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; + +function TJclBZIP2CompressStream.Flush: Integer; +begin + Result := 0; + + if FDeflateInitialized then + begin + BZLibRecord.next_in := nil; + BZLibRecord.avail_in := 0; + + while (BZIP2LibCheck(BZ2_bzCompress(@BZLibRecord, BZ_FLUSH)) <> Z_STREAM_END) and (BZLibRecord.avail_out = 0) do + begin + FStream.WriteBuffer(FBuffer^, FBufferSize); + Progress(Self); + + BZLibRecord.next_out := FBuffer; + BZLibRecord.avail_out := FBufferSize; + Result := Result + FBufferSize; + end; + + if BZLibRecord.avail_out < FBufferSize then + begin + FStream.WriteBuffer(FBuffer^, FBufferSize-BZLibRecord.avail_out); + Progress(Self); + Result := Result + FBufferSize-BZLibRecord.avail_out; + BZLibRecord.next_out := FBuffer; + BZLibRecord.avail_out := FBufferSize; + end; + end; +end; + +function TJclBZIP2CompressStream.Seek(Offset: Longint; Origin: Word): Longint; +begin + if (Offset = 0) and (Origin = soFromCurrent) then + Result := BZLibRecord.total_in_lo32 + else + if (Offset = 0) and (Origin = soFromBeginning) and (BZLibRecord.total_in_lo32 = 0) then + Result := 0 + else + Result := inherited Seek(Offset, Origin); +end; + +//=== { TJclZLibDecompressionStream } ======================================== + +constructor TJclBZIP2DecompressStream.Create(Source: TStream); +begin + inherited Create(Source); + + // Initialize ZLib StreamRecord + with BZLibRecord do + begin + bzalloc := nil; // Use build-in memory allocation functionality + bzfree := nil; + opaque := nil; + next_in := nil; + state := nil; + avail_in := 0; + next_out := FBuffer; + avail_out := FBufferSize; + end; + + FInflateInitialized := False; +end; + +destructor TJclBZIP2DecompressStream.Destroy; +begin + if FInflateInitialized then + begin + FStream.Seek(-BZLibRecord.avail_in, soFromCurrent); + BZIP2LibCheck(BZ2_bzDecompressEnd(@BZLibRecord)); + end; + + inherited Destroy; +end; + +function TJclBZIP2DecompressStream.Read(var Buffer; Count: Longint): Longint; +var + avail_out_ctr: Integer; + +begin + if not FInflateInitialized then + begin + BZIP2LibCheck(BZ2_bzDecompressInit(@BZLibRecord,0,0)); + FInflateInitialized := True; + end; + + BZLibRecord.next_out := @Buffer; + BZLibRecord.avail_out := Count; + avail_out_ctr := Count; + + while avail_out_ctr > 0 do // as long as we have data + begin + if BZLibRecord.avail_in = 0 then + begin + BZLibRecord.avail_in := FStream.Read(FBuffer^, FBufferSize); + if BZLibRecord.avail_in = 0 then + begin + Result := Count - avail_out_ctr; + Exit; + end; + + BZLibRecord.next_in := FBuffer; + end; + + + if BZLibRecord.avail_in > 0 then + begin + BZIP2LibCheck(BZ2_bzDecompress(@BZLibRecord)); + avail_out_ctr := Count - BZLibRecord.avail_out; + end + end; + + Result := Count; +end; + +function TJclBZIP2DecompressStream.Seek(Offset: Longint; Origin: Word): Longint; +begin + if (Offset = 0) and (Origin = soFromCurrent) then + Result := BZLibRecord.total_out_lo32 + else + Result := inherited Seek(Offset, Origin); +end; +*) + +// History: +// $Log: JclCompression.pas,v $ +// Revision 1.9 2005/10/25 04:46:31 rrossmair +// - fix for issue #0003276 (as provided by reporter) +// +// Revision 1.8 2005/03/08 08:33:15 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.7 2005/02/27 14:55:25 marquardt +// changed overloaded constructors to constructor with default parameter (BCB friendly) +// +// Revision 1.6 2005/02/24 16:34:39 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.5 2005/02/24 07:36:24 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.4 2004/11/17 03:24:43 mthoma +// Just noticed that I checked in the wrong version... this one is bugfixed and contains +// $date and $log +// + +end. + diff --git a/official/1.96/source/common/JclContainerIntf.pas b/official/1.96/source/common/JclContainerIntf.pas new file mode 100644 index 0000000..1fb7107 --- /dev/null +++ b/official/1.96/source/common/JclContainerIntf.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 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) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:42 $ +// For history see end of file + +unit JclContainerIntf; + +{$I jcl.inc} + +interface + +uses + Classes, + JclBase; + +const + DefaultContainerCapacity = 16; + +type + IJclIntfCloneable = interface + ['{BCF77740-FB60-4306-9BD1-448AADE5FF4E}'] + function Clone: IInterface; + end; + + IJclCloneable = interface + ['{D224AE70-2C93-4998-9479-1D513D75F2B2}'] + function Clone: TObject; + end; + + IJclIntfIterator = interface + ['{E121A98A-7C43-4587-806B-9189E8B2F106}'] + procedure Add(AInterface: IInterface); + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AInterface: IInterface); + end; + + IJclStrIterator = interface + ['{D5D4B681-F902-49C7-B9E1-73007C9D64F0}'] + procedure Add(const AString: string); + function GetString: string; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: string; + function NextIndex: Integer; + function Previous: string; + function PreviousIndex: Integer; + procedure Remove; + procedure SetString(const AString: string); + end; + + IJclIterator = interface + ['{997DF9B7-9AA2-4239-8B94-14DFFD26D790}'] + procedure Add(AObject: TObject); + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AObject: TObject); + end; + + IJclIntfCollection = interface + ['{8E178463-4575-487A-B4D5-DC2AED3C7ACA}'] + function Add(AInterface: IInterface): Boolean; + function AddAll(ACollection: IJclIntfCollection): Boolean; + procedure Clear; + function Contains(AInterface: IInterface): Boolean; + function ContainsAll(ACollection: IJclIntfCollection): Boolean; + function Equals(ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(AInterface: IInterface): Boolean; + function RemoveAll(ACollection: IJclIntfCollection): Boolean; + function RetainAll(ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + end; + + IJclStrCollection = interface + ['{3E3CFC19-E8AF-4DD7-91FA-2DF2895FC7B9}'] + function Add(const AString: string): Boolean; + function AddAll(ACollection: IJclStrCollection): Boolean; + procedure Clear; + function Contains(const AString: string): Boolean; + function ContainsAll(ACollection: IJclStrCollection): Boolean; + function Equals(ACollection: IJclStrCollection): Boolean; + function First: IJclStrIterator; + function IsEmpty: Boolean; + function Last: IJclStrIterator; + function Remove(const AString: string): Boolean; + function RemoveAll(ACollection: IJclStrCollection): Boolean; + function RetainAll(ACollection: IJclStrCollection): Boolean; + function Size: Integer; + //Daniele Teti 27/12/2004 + procedure LoadFromStrings(Strings: TStrings); + procedure SaveToStrings(Strings: TStrings); + procedure AppendToStrings(Strings: TStrings); + procedure AppendFromStrings(Strings: TStrings); + function GetAsStrings: TStrings; + function GetAsDelimited(const Separator: string = AnsiLineBreak): string; + procedure AppendDelimited(const AString: string; const Separator: string = AnsiLineBreak); + procedure LoadDelimited(const AString: string; const Separator: string = AnsiLineBreak); + end; + + IJclCollection = interface + ['{58947EF1-CD21-4DD1-AE3D-225C3AAD7EE5}'] + function Add(AObject: TObject): Boolean; + function AddAll(ACollection: IJclCollection): Boolean; + procedure Clear; + function Contains(AObject: TObject): Boolean; + function ContainsAll(ACollection: IJclCollection): Boolean; + function Equals(ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; + function RemoveAll(ACollection: IJclCollection): Boolean; + function RetainAll(ACollection: IJclCollection): Boolean; + function Size: Integer; + end; + + IJclIntfList = interface(IJclIntfCollection) + ['{E14EDA4B-1DAA-4013-9E6C-CDCB365C7CF9}'] + procedure Insert(Index: Integer; AInterface: IInterface); overload; + function InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; overload; + function GetObject(Index: Integer): IInterface; + function IndexOf(AInterface: IInterface): Integer; + function LastIndexOf(AInterface: IInterface): Integer; + function Remove(Index: Integer): IInterface; overload; + procedure SetObject(Index: Integer; AInterface: IInterface); + function SubList(First, Count: Integer): IJclIntfList; + end; + + IJclStrList = interface(IJclStrCollection) + ['{07DD7644-EAC6-4059-99FC-BEB7FBB73186}'] + procedure Insert(Index: Integer; const AString: string); overload; + function InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; overload; + function GetString(Index: Integer): string; + function IndexOf(const AString: string): Integer; + function LastIndexOf(const AString: string): Integer; + function Remove(Index: Integer): string; overload; + procedure SetString(Index: Integer; const AString: string); + function SubList(First, Count: Integer): IJclStrList; + //Daniele Teti + property Items[Key: Integer]: string read GetString write SetString; default; + end; + + IJclList = interface(IJclCollection) + ['{8ABC70AC-5C06-43EA-AFE0-D066379BCC28}'] + procedure Insert(Index: Integer; AObject: TObject); overload; + function InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; overload; + function GetObject(Index: Integer): TObject; + function IndexOf(AObject: TObject): Integer; + function LastIndexOf(AObject: TObject): Integer; + function Remove(Index: Integer): TObject; overload; + procedure SetObject(Index: Integer; AObject: TObject); + function SubList(First, Count: Integer): IJclList; + //Daniele Teti + property Items[Key: Integer]: TObject read GetObject write SetObject; default; + end; + + IJclIntfArray = interface(IJclIntfList) + ['{B055B427-7817-43FC-97D4-AD1845643D63}'] + {$IFDEF CLR} + function GetObject(Index: Integer): IInterface; + procedure SetObject(Index: Integer; AInterface: IInterface); + {$ENDIF CLR} + property Items[Index: Integer]: IInterface read GetObject write SetObject; default; + end; + + IJclStrArray = interface(IJclStrList) + ['{B055B427-7817-43FC-97D4-AD1845643D63}'] + {$IFDEF CLR} + function GetString(Index: Integer): string; + procedure SetString(Index: Integer; const AString: string); + {$ENDIF CLR} + property Items[Index: Integer]: string read GetString write SetString; default; + end; + + IJclArray = interface(IJclList) + ['{A69F6D35-54B2-4361-852E-097ED75E648A}'] + {$IFDEF CLR} + function GetObject(Index: Integer): TObject; + procedure SetObject(Index: Integer; AObject: TObject); + {$ENDIF CLR} + property Items[Index: Integer]: TObject read GetObject write SetObject; default; + end; + + IJclIntfSet = interface(IJclIntfCollection) + ['{E2D28852-9774-49B7-A739-5DBA2B705924}'] + procedure Intersect(ACollection: IJclIntfCollection); + procedure Subtract(ACollection: IJclIntfCollection); + procedure Union(ACollection: IJclIntfCollection); + end; + + IJclStrSet = interface(IJclStrCollection) + ['{72204D85-2B68-4914-B9F2-09E5180C12E9}'] + procedure Intersect(ACollection: IJclStrCollection); + procedure Subtract(ACollection: IJclStrCollection); + procedure Union(ACollection: IJclStrCollection); + end; + + IJclSet = interface(IJclCollection) + ['{0B7CDB90-8588-4260-A54C-D87101C669EA}'] + procedure Intersect(ACollection: IJclCollection); + procedure Subtract(ACollection: IJclCollection); + procedure Union(ACollection: IJclCollection); + end; + + TJclTraverseOrder = (toPreOrder, toOrder, toPostOrder); + + IJclIntfTree = interface(IJclIntfCollection) + ['{5A21688F-113D-41B4-A17C-54BDB0BD6559}'] + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclStrTree = interface(IJclStrCollection) + ['{1E1896C0-0497-47DF-83AF-A9422084636C}'] + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclTree = interface(IJclCollection) + ['{B0C658CC-FEF5-4178-A4C5-442C0DEDE207}'] + function GetTraverseOrder: TJclTraverseOrder; + procedure SetTraverseOrder(Value: TJclTraverseOrder); + property TraverseOrder: TJclTraverseOrder read GetTraverseOrder write SetTraverseOrder; + end; + + IJclIntfIntfMap = interface + ['{01D05399-4A05-4F3E-92F4-0C236BE77019}'] + procedure Clear; + function ContainsKey(Key: IInterface): Boolean; + function ContainsValue(Value: IInterface): Boolean; + function Equals(AMap: IJclIntfIntfMap): Boolean; + function GetValue(Key: IInterface): IInterface; + function IsEmpty: Boolean; + function KeySet: IJclIntfSet; + procedure PutAll(AMap: IJclIntfIntfMap); + procedure PutValue(Key, Value: IInterface); + function Remove(Key: IInterface): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + IJclMultiIntfIntfMap = interface(IJclIntfIntfMap) + ['{497775A5-D3F1-49FC-A641-15CC9E77F3D0}'] + function GetValues(Key: IInterface): IJclIntfIterator; + function Count(Key: IInterface): Integer; + end; + + IJclStrIntfMap = interface + ['{A4788A96-281A-4924-AA24-03776DDAAD8A}'] + procedure Clear; + function ContainsKey(const Key: string): Boolean; + function ContainsValue(Value: IInterface): Boolean; + function Equals(AMap: IJclStrIntfMap): Boolean; + function GetValue(const Key: string): IInterface; + function IsEmpty: Boolean; + function KeySet: IJclStrSet; + procedure PutAll(AMap: IJclStrIntfMap); + procedure PutValue(const Key: string; Value: IInterface); + function Remove(const Key: string): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + end; + + IJclStrStrMap = interface + ['{A4788A96-281A-4924-AA24-03776DDAAD8A}'] + procedure Clear; + function ContainsKey(const Key: string): Boolean; + function ContainsValue(const Value: string): Boolean; + function Equals(AMap: IJclStrStrMap): Boolean; + function GetValue(const Key: string): string; + function IsEmpty: Boolean; + function KeySet: IJclStrSet; + procedure PutAll(AMap: IJclStrStrMap); + procedure PutValue(const Key, Value: string); + function Remove(const Key: string): string; + function Size: Integer; + function Values: IJclStrCollection; + //Daniele Teti + function KeyOfValue(const Value: string): string; + //Daniele Teti + property Items[const Key: string]: string read GetValue write PutValue; default; + end; + + IJclStrMap = interface + ['{A7D0A882-6952-496D-A258-23D47DDCCBC4}'] + procedure Clear; + function ContainsKey(const Key: string): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Equals(AMap: IJclStrMap): Boolean; + function GetValue(const Key: string): TObject; + function IsEmpty: Boolean; + function KeySet: IJclStrSet; + procedure PutAll(AMap: IJclStrMap); + procedure PutValue(const Key: string; Value: TObject); + function Remove(const Key: string): TObject; + function Size: Integer; + function Values: IJclCollection; + //Daniele Teti + property Items[const Key: string]: TObject read GetValue write PutValue; default; + end; + + IJclMap = interface + ['{A7D0A882-6952-496D-A258-23D47DDCCBC4}'] + procedure Clear; + function ContainsKey(Key: TObject): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Equals(AMap: IJclMap): Boolean; + function GetValue(Key: TObject): TObject; + function IsEmpty: Boolean; + function KeySet: IJclSet; + procedure PutAll(AMap: IJclMap); + procedure PutValue(Key, Value: TObject); + function Remove(Key: TObject): TObject; + function Size: Integer; + function Values: IJclCollection; + //Daniele Teti + property Items[Key: TObject]: TObject read GetValue write PutValue; default; + end; + + IJclIntfQueue = interface + ['{B88756FE-5553-4106-957E-3E33120BFA99}'] + function Contains(AInterface: IInterface): Boolean; + function Dequeue: IInterface; + function Empty: Boolean; + procedure Enqueue(AInterface: IInterface); + function Size: Integer; + end; + + IJclStrQueue = interface + ['{5BA0ED9A-5AF3-4F79-9D80-34FA7FF15D1F}'] + function Contains(const AString: string): Boolean; + function Dequeue: string; + function Empty: Boolean; + procedure Enqueue(const AString: string); + function Size: Integer; + end; + + IJclQueue = interface + ['{7D0F9DE4-71EA-46EF-B879-88BCFD5D9610}'] + function Contains(AObject: TObject): Boolean; + function Dequeue: TObject; + function Empty: Boolean; + procedure Enqueue(AObject: TObject); + function Size: Integer; + end; + + IJclStrStrSortedMap = interface(IJclStrStrMap) + ['{4F457799-5D03-413D-A46C-067DC4200CC3}'] + function FirstKey: string; + function HeadMap(ToKey: string): IJclStrStrSortedMap; + function LastKey: string; + function SubMap(FromKey, ToKey: string): IJclStrStrSortedMap; + function TailMap(FromKey: string): IJclStrStrSortedMap; + 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; + + IJclIntfSortedSet = interface(IJclIntfSet) + ['{159BE5A7-7349-42FF-BE55-9CA1B9DBA991}'] + function HeadSet(AEndObject: IInterface): IJclIntfSortedSet; + function SubSet(Start, Finish: IInterface): IJclIntfSortedSet; + function TailSet(AStartObject: IInterface): IJclIntfSortedSet; + end; + + IJclSortedSet = interface(IJclSet) + ['{A3D23E76-ADE9-446C-9B97-F49FCE895D9F}'] + function HeadSet(AEndObject: TObject): IJclSortedSet; + function SubSet(Start, Finish: TObject): IJclSortedSet; + function TailSet(AStartObject: TObject): IJclSortedSet; + end; + + IJclIntfStack = interface + ['{CA1DC7A1-8D8F-4A5D-81D1-0FE32E9A4E84}'] + function Contains(AInterface: IInterface): Boolean; + function Empty: Boolean; + function Pop: IInterface; + procedure Push(AInterface: IInterface); + function Size: Integer; + end; + + IJclStrStack = interface + ['{649BB74C-D7BE-40D9-9F4E-32DDC3F13F3B}'] + function Contains(const AString: string): Boolean; + function Empty: Boolean; + function Pop: string; + procedure Push(const AString: string); + function Size: Integer; + end; + + IJclStack = interface + ['{E07E0BD8-A831-41B9-B9A0-7199BD4873B9}'] + function Contains(AObject: TObject): Boolean; + function Empty: Boolean; + function Pop: TObject; + procedure Push(AObject: TObject); + function Size: Integer; + end; + + // Exceptions + EJclOutOfBoundsError = class(EJclError); + EJclNoSuchElementError = class(EJclError); + EJclIllegalStateError = class(EJclError); + EJclConcurrentModificationError = class(EJclError); + EJclIllegalArgumentError = class(EJclError); + EJclOperationNotSupportedError = class(EJclError); + +implementation + +// History: + +// $Log: JclContainerIntf.pas,v $ +// Revision 1.6 2005/05/05 20:08:42 ahuser +// JCL.NET support +// +// Revision 1.5 2005/04/09 23:01:46 rrossmair +// - fixed IJclStrStrSortedMap, IJclSortedMap, IJclIntfSortedSet declarations; +// First and Last methods of the latter 2 conflicted with inherited method names +// +// Revision 1.4 2005/03/02 17:51:24 rrossmair +// - removed DCLAppendDelimited from JclAlgorithms, changed uses clauses accordingly +// +// Revision 1.3 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.2 2005/02/24 07:36:24 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclCounter.pas b/official/1.96/source/common/JclCounter.pas new file mode 100644 index 0000000..6f21270 --- /dev/null +++ b/official/1.96/source/common/JclCounter.pas @@ -0,0 +1,243 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/08/07 12:24:02 $ +// For history see end of file + +unit JclCounter; + +{$I jcl.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$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); + +implementation + +uses + SysUtils, + JclResources; + +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 + raise EJclCounterError.CreateRes(@RsNoCounter); + {$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 + raise EJclCounterError.CreateRes(@RsNoCounter); + {$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 + raise EJclCounterError.CreateRes(@RsNoCounter); + {$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} + if not QueryPerformanceCounter(TimeNow) then + raise EJclCounterError.CreateRes(@RsNoCounter); + {$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; + +// History: + +// $Log: JclCounter.pas,v $ +// Revision 1.13 2005/08/07 12:24:02 outchy +// IT3137: Fixed the Iteration count in the loop. +// +// Revision 1.12 2005/03/08 08:33:15 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.11 2005/02/24 16:34:39 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.10 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.9 2004/07/28 18:00:49 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.8 2004/06/14 13:05:16 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.7 2004/06/14 11:05:50 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.6 2004/05/08 08:44:17 rrossmair +// introduced & applied symbol HAS_UNIT_LIBC +// +// Revision 1.5 2004/05/05 00:04:10 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.4 2004/04/06 04:53:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/common/JclDITs-1.92.int b/official/1.96/source/common/JclDITs-1.92.int new file mode 100644 index 0000000..80a0fc0 --- /dev/null +++ b/official/1.96/source/common/JclDITs-1.92.int @@ -0,0 +1,114 @@ +unit JclDITs; + +{$I jcl.inc} + +interface + +uses + SysUtils; + +//-------------------------------------------------------------------------------------------------- +// Date and Time Data Interchange (ISO 8601) +//-------------------------------------------------------------------------------------------------- + +type + TISODateTimeOption = (dtoDate, dtoTime, dtoMilliseconds, dtoBasic); + TISODateTimeOptions = set of TISODateTimeOption; + TISODateTimeSeparator = (dtsT, dtsSpace); + TISOFloatDecimalSeparator = (fdsComma, fdsPoint); + +const + // basic formats + ISOBasicDateFormat = 'YYYYMMDD'; + ISOBasicTimeFormat = 'hhnnss'; + // extended formats + ISODateFormat = 'YYYY"-"MM"-"DD'; + ISOTimeFormat = 'hh":"nn":"ss'; + // milliseconds + ISOTimeMSec = '","zzz'; + // date time separator + ISODateTimeSeparatorT = 'T'; + ISODateTimeSeparatorSpace = ' '; + ISODateTimeSeparators: array [TISODateTimeSeparator] of Char = + (ISODateTimeSeparatorT, ISODateTimeSeparatorSpace); + // date time format + ISOBasicDateTimeFormat = ISOBasicDateFormat + '"' + ISODateTimeSeparatorT + '"' + ISOBasicTimeFormat; + ISODateTimeFormat = ISODateFormat + ISODateTimeSeparatorT + ISOTimeFormat; + // float decimal separator + ISOFloatDecimalSeparatorComma = ','; + ISOFloatDecimalSeparatorPoint = '.'; + ISOFloatDecimalSeparators: array [TISOFloatDecimalSeparator] of Char = + (ISOFloatDecimalSeparatorComma, ISOFloatDecimalSeparatorPoint); + +// Convert TDateTime to string +function ISODateTimeToStrCustom(const Value: TDateTime; + Options: TISODateTimeOptions; + DateTimeSeparator: TISODateTimeSeparator = dtsT): string; +// Converts TDateTime to date string 'YYYY-MM-DD' +function ISODateToStr(const Value: TDateTime): string; +// Converts TDateTime to time string 'hh:mm:ss' +function ISOTimeToStr(const Value: TDateTime): string; +// Converts TDateTime to date time string 'YYYY-MM-DDThh:mm:ss' +function ISODateTimeToStr(const Value: TDateTime): string; +// Converts TDateTime to date string 'YYYYMMDD' +function ISOBasicDateToStr(const Value: TDateTime): string; +// Converts TDateTime to time string 'hhmmss' +function ISOBasicTimeToStr(const Value: TDateTime): string; +// Converts TDateTime to date time string 'YYYYMMDDThhmmss' +function ISOBasicDateTimeToStr(const Value: TDateTime): string; +// Converts an ISO date string to TDateTime and replaces the date part of Date +// Valid strings are +// 'YYYY-MM-DD' and 'YYYYMMDD' +function TryISOStrToDate(const Value: string; var Date: TDateTime): Boolean; +// Converts an ISO time string to TDateTime and replace the time part of Time +// Valid strings are +// 'hh:mm:ss,zzz', 'hh:mm:ss.zzz', 'hhmmss,zzz', 'hhmmss.zzz', +// 'hh:mm:ss', 'hhmmss', 'hh:mm' and 'hhmm' +function TryISOStrToTime(const Value: string; var Time: TDateTime): Boolean; +// Converts an ISO time stamp to a TDateTime, +// date and time are separated with 'T' or ' ' +function TryISOStrToDateTime(const Value: string; out DateTime: TDateTime): Boolean; +// Converts an ISO date string to TDateTime +// Valid strings: +// 'YYYY-MM-DD' and 'YYYYMMDD' +function ISOStrToDate(const Value: string): TDateTime; +function ISOStrToDateDef(const Value: string; const Default: TDateTime): TDateTime; +// Converts an ISO time string to TDateTime +// Valid strings: +// 'hh:mm:ss,zzz', 'hh:mm:ss.zzz', 'hhmmss,zzz', 'hhmmss.zzz', +// 'hh:mm:ss', 'hhmmss', 'hh:mm' and 'hhmm' +function ISOStrToTime(const Value: string): TDateTime; +function ISOStrToTimeDef(const Value: string; const Default: TDateTime): TDateTime; +// Converts an ISO time stamp to a TDateTime, +// date and time are separated with 'T' or ' ' +function ISOStrToDateTime(const Value: string): TDateTime; +function ISOStrToDateTimeDef(const Value: string; const Default: TDateTime): TDateTime; + +//-------------------------------------------------------------------------------------------------- +// Float Data Interchange (ISO 31-0) +//-------------------------------------------------------------------------------------------------- + +// Converts a float value to a string +// DecimalSeparator is decimal separator, no thousand separator +// Value: the value to convert +// Precision: precision of the result, 1..18, default: 15 digits +// DecimalSeparator: used separator +// if Abs(Value) < 10^-4 or >= 10^15 the function returns a string in the +// 'Scientific' format +// if Value is NAN, INF or -INF the function return 'NAN', 'INF' or '-INF' +function ISOFloatToStr(const Value: Extended; + Precision: Integer = 15 ; + DecimalSeparator: TISOFloatDecimalSeparator = fdsComma): string; +// Converts a string to a float value +// Decimal separators are ',' or '.' +// Thousands separator ' ' +// The string can be a number in the 'Scientific' format +// 'NAN', 'INF', '-INF' are allowed +function ISOTextToFloat(Value: string; out Float: Extended): Boolean; +// Converts a string to a float value +// Decimal separators are ',' or '.' +// Thousands separator ' ' or '' +// The string can be a number in the 'Scientific' format +// 'NAN', 'INF', '-INF' are allowed +function ISOStrToFloat(const Value: string): Extended; +function ISOStrToFloatDef(const Value: string; const Default: Extended): Extended; diff --git a/official/1.96/source/common/JclDateTime.pas b/official/1.96/source/common/JclDateTime.pas new file mode 100644 index 0000000..6ce3b5a --- /dev/null +++ b/official/1.96/source/common/JclDateTime.pas @@ -0,0 +1,1345 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/05/20 19:55:49 $ +// For history see end of file + +// 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} +{$IFNDEF CLR} +{$I crossplatform.inc} +{$ENDIF ~CLR} + +interface + +uses + {$IFDEF CLR} + System.Globalization, System.Runtime.InteropServices, + {$ELSE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$ENDIF CLR} + {$IFDEF HAS_UNIT_TYPES} + Types, + {$ENDIF HAS_UNIT_TYPES} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF FPC} + {$IFNDEF LINUX} + Unix, + {$ENDIF ~LINUX} + {$ENDIF FPC} + SysUtils, + JclBase, JclResources; + +const + // 1970-01-01T00:00:00 in TDateTime + UnixTimeStart = 25569; + +{$IFDEF CLR} +type + TFileTime = System.Runtime.InteropServices.FILETIME; +{$ENDIF CLR} + +{ Encode / Decode functions } + +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; +procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word); overload; +procedure DecodeDate(Date: TDateTime; var Year: Integer; var Month, Day: Word); overload; +procedure DecodeDate(Date: TDateTime; var 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; var 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 GetISOYearNumberOfDays(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; var YearOfWeekNumber, WeekDay: Integer): Integer; overload; +function ISOWeekNumber(DateTime: TDateTime; var 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; + +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} +function DateTimeToDosDateTime(const DateTime: TDateTime): TDosDateTime; +function DateTimeToFileTime(DateTime: TDateTime): TFileTime; +function DateTimeToSystemTime(DateTime: TDateTime): TSystemTime; overload; +procedure DateTimeToSystemTime(DateTime: TDateTime; var SysTime: TSystemTime); overload; + +function LocalDateTimeToFileTime(DateTime: TDateTime): FileTime; +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +function DosDateTimeToDateTime(const DosTime: TDosDateTime): TDateTime; +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} +function DosDateTimeToFileTime(DosTime: TDosDateTime): TFileTime; overload; +procedure DosDateTimeToFileTime(DTH, DTL: Word; FT: TFileTime); overload; +function DosDateTimeToSystemTime(const DosTime: TDosDateTime): TSystemTime; +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} +function DosDateTimeToStr(DateTime: Integer): string; + +function FileTimeToDateTime(const FileTime: TFileTime): TDateTime; +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} +function FileTimeToLocalDateTime(const FileTime: TFileTime): TDateTime; +function FileTimeToDosDateTime(const FileTime: TFileTime): TDosDateTime; overload; +procedure FileTimeToDosDateTime(const FileTime: TFileTime; var Date, Time: Word); overload; +function FileTimeToSystemTime(const FileTime: TFileTime): TSystemTime; overload; +procedure FileTimeToSystemTime(const FileTime: TFileTime; var ST: TSystemTime); overload; +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} +function FileTimeToStr(const FileTime: TFileTime): string; + +{$IFNDEF CLR} +{$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} +{$ENDIF ~CLR} + +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} + +type + EJclDateTimeError = class(EJclError); + +implementation + +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 := 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 := Round(Result) + (Day - 1); + end; +end; + +procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word); +begin + SysUtils.DecodeDate(Date, Year, Month, Day); +end; + +procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Integer); +var + WMonth, WDay: Word; +begin + DecodeDate(Date, Year, WMonth, WDay); + Month := WMonth; + Day := WDay; +end; + +procedure DecodeDate(Date: TDateTime; var Year: Integer; var Month, Day: Word); +var + WYear: Word; + RDays, RMonths: TDateTime; +begin + if (Date >= DateTimeBaseDay) and (Date < DateTimeMaxDay) then + begin + 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 + {$IFDEF CLR} + raise EJclDateTimeError.Create(RsDateConversion); + {$ELSE} + raise EJclDateTimeError.CreateRes(@RsDateConversion); + {$ENDIF CLR} +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; var 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 := 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 GetISOYearNumberOfDays(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; var YearOfWeekNumber, WeekDay: Integer): Integer; +var + TmpYear: Integer; + January4th: TDateTime; + FirstMonday: TDateTime; +begin + // Applying the rule: The first calender 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 := GetISOYearNumberOfDays(TmpYear - 1); + YearOfWeekNumber := TmpYear - 1; + Exit; + end + else + begin + YearOfWeekNumber := TmpYear; + Result := (Trunc(DateTime - FirstMonday) div 7) + 1; + end; + + if Result > GetISOYearNumberOfDays(YearOfDate(DateTime)) then + Result := GetISOYearNumberOfDays(YearOfDate(DateTime)); +end; + +function ISOWeekNumber(DateTime: TDateTime; var 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 := 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 syncronize 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; +{$IFDEF CLR} +begin + Result := System.TimeZone.CurrentTimeZone.ToLocalTime(DateTime); +end; +{$ELSE} +var + TimeZoneInfo: TTimeZoneInformation; +begin + FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0); + 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 CLR} +{$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} + Offset := -TZSeconds; + {$ENDIF LINUX} + Result := ((DateTime * SecsPerDay) - Offset) / SecsPerDay; +end; +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} +function LocalDateTimeToDateTime(DateTime: TDateTime): TDateTime; +{$IFDEF CLR} +begin + Result := System.TimeZone.CurrentTimeZone.ToUniversalTime(DateTime); +end; +{$ELSE} +var + TimeZoneInfo: TTimeZoneInformation; +begin + FillChar(TimeZoneInfo, SizeOf(TimeZoneInfo), #0); + 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 CLR} +{$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} + 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 + {$IFDEF CLR} + Result := System.DateTime.FromFileTime(Int64(FileTime.dwHighDateTime) shl 32 or FileTime.dwLowDateTime); + {$ELSE} + Result := Int64(FileTime) / FileTimeStep; + Result := Result + FileTimeBase; + {$ENDIF CLR} +end; + +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} + +function FileTimeToLocalDateTime(const FileTime: TFileTime): TDateTime; +var + LocalFileTime: TFileTime; +begin + ResultCheck(FileTimeToLocalFileTime(FileTime, LocalFileTime)); + Result := FileTimeToDateTime(LocalFileTime); + { TODO : daylight saving time } +end; + +function LocalDateTimeToFileTime(DateTime: TDateTime): FileTime; +var + LocalFileTime: TFileTime; +begin + LocalFileTime := DateTimeToFileTime(DateTime); + ResultCheck(LocalFileTimeToFileTime(LocalFileTime, Result)); + { TODO : daylight saving time } +end; + +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +function DateTimeToFileTime(DateTime: TDateTime): TFileTime; +var + E: Extended; + F64: Int64; +begin + E := (DateTime - FileTimeBase) * FileTimeStep; + F64 := Round(E); + {$IFDEF CLR} + Result.dwLowDateTime := F64 and $00000000FFFFFFFF; + Result.dwHighDateTime := F64 shr 32; + {$ELSE} + Result := TFileTime(F64); + {$ENDIF CLR} +end; + +{$IFNDEF CLR} +{$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} +{$ENDIF ~CLR} + +// 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 := 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 := SysUtils.DateTimeToFileDate(DateTime); +end; + +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} + +function FileTimeToSystemTime(const FileTime: TFileTime): TSystemTime; overload; +begin + ResultCheck(Windows.FileTimeToSystemTime(FileTime, Result)); +end; + +procedure FileTimeToSystemTime(const FileTime: TFileTime; var ST: TSystemTime); overload; +begin + Windows.FileTimeToSystemTime(FileTime, ST); +end; + +function SystemTimeToFileTime(const SystemTime: TSystemTime): TFileTime; overload; +begin + ResultCheck(Windows.SystemTimeToFileTime(SystemTime, Result)); +end; + +procedure SystemTimeToFileTime(const SystemTime: TSystemTime; FTime: TFileTime); overload; +begin + Windows.SystemTimeToFileTime(SystemTime, FTime); +end; + +function DateTimeToSystemTime(DateTime: TDateTime): TSystemTime; overload; +begin + SysUtils.DateTimeToSystemTime(DateTime, Result); +end; + +procedure DateTimeToSystemTime(DateTime: TDateTime; var SysTime: TSystemTime); overload; +begin + SysUtils.DateTimeToSystemTime(DateTime, SysTime); +end; + +function DosDateTimeToFileTime(DosTime: TDosDateTime): TFileTime; overload; +begin + ResultCheck(Windows.DosDateTimeToFileTime(HIWORD(DosTime), LOWORD(DosTime), Result)); +end; + +procedure DosDateTimeToFileTime(DTH, DTL: Word; FT: TFileTime); overload; +begin + Windows.DosDateTimeToFileTime(DTH, DTL, FT); +end; + +function FileTimeToDosDateTime(const FileTime: TFileTime): TDosDateTime; overload; +var + Date, Time: Word; +begin + ResultCheck(Windows.FileTimeToDosDateTime(FileTime, Date, Time)); + Result := (Date shl 16) or Time; +end; + +procedure FileTimeToDosDateTime(const FileTime: TFileTime; var Date, Time: Word); overload; +begin + Windows.FileTimeToDosDateTime(FileTime, Date, Time); +end; + +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +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; + +{$IFNDEF CLR} +{$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} +{$ENDIF ~CLR} + +// 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 := 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; +{$IFDEF CLR} +var + FT1, FT2: Int64; +{$ENDIF CLR} +begin + {$IFDEF CLR} + FT1 := Int64(FileTime1.dwHighDateTime) shl 32 or FileTime1.dwLowDateTime; + FT2 := Int64(FileTime2.dwHighDateTime) shl 32 or FileTime2.dwLowDateTime; + Result := FATDatesEqual(FT1, FT2); + {$ELSE} + Result := FATDatesEqual(Int64(FileTime1), Int64(FileTime2)); + {$ENDIF CLR} +end; + +// Conversion Unix time <--> TDateTime / FileTime, constants + +{$IFDEF MSWINDOWS} +const + // 1 second in FileTime resolution + FileTimeSecond = 1000 * 1000 * 10; + // 1 day in FileTime resolution: 24 * 60 * 60 * 1000 * 1000 * 10; + FileTimeDay = 864000000000; + + // 1601-01-01T00:00:00 in TDateTime + FileTimeStart = -109205; + // Time between 1601-01-01 and 1970-01-01 in FileTime resolution + FileTimeUnixStart = (UnixTimeStart - FileTimeStart) * FileTimeDay; +{$ENDIF MSWINDOWS} + +// Conversion Unix time <--> TDateTime + +function DateTimeToUnixTime(DateTime: TDateTime): TJclUnixTime32; +begin + Result := Trunc((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} + +// History: + +// $Log: JclDateTime.pas,v $ +// Revision 1.22 2005/05/20 19:55:49 uschuster +// FPC FreeBSD support +// +// Revision 1.21 2005/05/05 20:08:42 ahuser +// JCL.NET support +// +// Revision 1.20 2005/03/09 23:09:01 rrossmair +// - published UnixTimeStart constant +// +// Revision 1.19 2005/03/08 08:33:16 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.18 2005/02/24 16:34:39 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.17 2005/02/12 16:29:53 mthoma +// Linux version of DateTimeToLocalDateTime and LocalDateTimeToDateTime added. +// +// Fixed #0002500 JclDateTime.FormatDateTime returns incorrect week result +// +// Revision 1.16 2004/10/19 06:26:48 marquardt +// JclRegistry extended, JclNTFS made compiling, JclDateTime style cleaned +// +// Revision 1.15 2004/10/17 20:05:31 mthoma +// style cleaned. +// +// Revision 1.14 2004/10/17 19:43:44 mthoma +// Wrote "placeholders" for FileTimeToUnixTime, UnixTimeToFileTime until someone writes a better cleanroom solution. Rewrote ISOWeekNumber and ISOWeekToDateTime. Introduced new functions: GetISOYearNumberOfDays, +// IsISOLongYear, ISODayOfWeek. +// +// Revision 1.13 2004/10/15 14:41:00 rrossmair +// restored Kylix compatibility +// +// Revision 1.12 2004/10/15 03:36:46 rrossmair +// - rearranged pre-CVS history +// +// Revision 1.11 2004/10/14 14:38:50 rikbarker +// Added DateTimeToUnixTime +// Rewrote UnixTimeToDateTime to remove PH Code +// Removed unnecessary constants and moved the relevant ones to the top of the unit +// +// Revision 1.10 2004/07/29 07:58:20 marquardt +// inc files updated +// +// Revision 1.9 2004/07/28 18:00:49 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.8 2004/06/14 13:05:16 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.7 2004/05/31 01:54:38 rrossmair +// $IFDEF LINUX replaced by $IFDEF HAS_UNIT_LIBC +// +// Revision 1.6 2004/05/05 00:04:10 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.5 2004/04/08 18:14:00 mthoma +// Fixed 402, 403, 1045, 236 (all DateTimeToLocalDateTime and vice versa problems), +// changed $data$ to $date$, removed the todoc statements, changed function prototypes from Value +// to a more JclDateTime like naming. +// +// 2001-02-10, Michael Schnell +// added overload procedures for compatibility: +// DateTimeToSystemTime, DosDateTimeToFileTime, FileTimeToDosDateTime, +// FileTimeToSystemTime, SystemTimeToFileTime +// +// 2000-10-19, Michael Schnell +// changed EasterSunday to the code by Marc Convents (marc dott convents att progen dott be) +// +// 2000-10-15, Michael Schnell +// avoiding "absolute" (in locations where stated) +// extended functionality for MakeYear4Digit: can pass Result unchanged if appropriate +// added function FATDatesEqual +// +// 2000-09-18, Michael Schnell +// added function FormatDateTime +// +// 2000-09-14, Michael Schnell +// added functions DayOfTheYear and DayOfTheYearToDateTime +// +// 2000-09-12, Michael Schnell: +// more elegant code for ISOWeekNumber +// added ISOWeekToDateTime +// added overload for ISOWeekNumber with three integer parameters +// +// 2000-09-07, Michael Schnell: +// added ISOWeekNumber with 1 and 3 parameters +// +// 2000-08-28, Michael Schnell: +// added function MakeYear4Digit +// +// 2000-08-09, Michael Schnell: +// added functions +// CreationDateTimeOfFile, LastAccessDateTimeOfFile and LastWriteDateTimeOfFile +// +// 2000-07-16, Michael Schnell: +// Support for negative dates and Year >= 10000 added for DecodeDate and EncodeDate +// +// 2000-07-08, Michael Schnell: +// Swapped function names CenturyOfDate and CenturyBaseYear +// those were obviously called wrong before +// Attention: must be done in the Help, too +// +// 2000-07-06, Michael Schnell: +// Formatted according to style rules +// +// 2000-06-25, Michael Schnell: +// Added function SystemTimeToFileTime +// Added function FieTimeToSystemTime +// Added function Datetimetosystemtime +// Added function DosDateTimeToFileTime +// Added function FileTimeToDosDateTime +// Added function SystemTimeToStr +// +// 2000-06-24, Michael Schnell: +// DateTimeToDosDateTime performs the same action as SysUtils.DateTimeToFileDate +// so let's have Delphi do the work here +// DosDateTimeToDateTime performs the same action as SysUtils.FileDateToDateTime +// so let's have Delphi do the work here +// +// DosDateTimeToStr does not use FileTime any more +// +// Added function DateTimeToFileTime +// Added function LocalDateTimeToFileTime +// Changed function FileTimeToDateTime +// not using TSystemDate and avoid systemcalls +// Changed function FileTimeToLocalDateTime +// not using TSystemDate and avoid systemcalls +// +// 2000-06-22, Michael Schnell: +// Name changed GetCenturyOfDate -> CenturyOfDate +// Name changed GetCenturyBaseYear -> CenturyBaseYear +// +// function GetWeekNumber(Today: TDateTime): string; -> +// function ISOWeekNumber(DateTime: TDateTime; var YearOfWeekDay: Integer): Integer; +// +// Added overload function IsLeapYear(Year: Integer): Boolean; +// to avoid wrong results if the user thinks he calls SysUtils.IsLeapYear +// IsLeapYear is now using SysUtils.IsLeapYear +// +// Changed function DateTimeToSeconds(DateTime: TDateTime): extended; -> +// function TimeOfDateTimeToSeconds(DateTime: TDateTime): Integer; +// now not calling DecodeTime any more +// +// Added function TimeOfDateTimeToMSecs(DateTime: TDateTime): Integer + +end. + diff --git a/official/1.96/source/common/JclEDI.pas b/official/1.96/source/common/JclEDI.pas new file mode 100644 index 0000000..3dfca23 --- /dev/null +++ b/official/1.96/source/common/JclEDI.pas @@ -0,0 +1,1641 @@ +{**************************************************************************************************} +{ } +{ 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 JclEDI.pas. } +{ } +{ The Initial Developer of the Original Code is Raymond Alexander. } +{ Portions created by Raymond Alexander are Copyright Raymond Alexander. All rights reserved. } +{ } +{ Contributor(s): } +{ Raymond Alexander (rayspostbox3), Robert Marquardt, Robert Rossmair, Petr Vones, } +{ Andreas Hausladen } +{ } +{**************************************************************************************************} +{ } +{ Contains classes to eaisly parse EDI documents and data. Variable delimiter detection allows } +{ parsing of the file without knowledge of the standards at an Interchange level. This enables } +{ parsing and construction of EDI documents with different delimiters. } +{ } +{ Unit owner: Raymond Alexander } +{ Date created: Before February, 1, 2001 } +{ Additional Info: } +{ E-Mail at RaysDelphiBox3 att hotmail dott com } +{ For latest EDI specific demos see http://sourceforge.net/projects/edisdk } +{ See home page for latest news & events and online help. } +{ } +{**************************************************************************************************} + +// $Id: JclEDI.pas,v 1.17 2005/08/09 10:30:21 ahuser Exp $ + +unit JclEDI; + +{$I jcl.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$WEAKPACKAGEUNIT ON} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +// Add the following directive in project options for debugging memory leaks. +// {$DEFINE ENABLE_EDI_DEBUGGING} + +interface + +uses + SysUtils, Classes, + JclBase; + +const + NA_LoopId = 'N/A'; // Constant used for loop id comparison + ElementSpecId_Reserved = 'Reserved'; + + EDIDataType_Numeric = 'N'; + EDIDataType_Decimal = 'R'; + EDIDataType_Identifier = 'ID'; + EDIDataType_String = 'AN'; + EDIDataType_Date = 'DT'; + EDIDataType_Time = 'TM'; + EDIDataType_Binary = 'B'; + +{$IFDEF ENABLE_EDI_DEBUGGING} +var + Debug_EDIDataObjectsCreated: Int64; + Debug_EDIDataObjectsDestroyed: Int64; + Debug_EDIDataObjectListCreated: Int64; + Debug_EDIDataObjectListDestroyed: Int64; + Debug_EDIDataObjectListItemsCreated: Int64; + Debug_EDIDataObjectListItemsDestroyed: Int64; +{$ENDIF ENABLE_EDI_DEBUGGING} + +type + TEDIObject = class(TObject); // Base EDI Object + TEDIObjectArray = array of TEDIObject; + + EJclEDIError = EJclError; + + // EDI Forward Class Declarations + TEDIDataObject = class; + TEDIDataObjectGroup = class; + TEDIObjectListItem = class; + TEDIObjectList = class; + TEDIDataObjectListItem = class; + TEDIDataObjectList = class; + + // EDI Delimiters Object + TEDIDelimiters = class(TEDIObject) + private + FSegmentDelimiter: string; + FElementDelimiter: string; + FSubElementSeperator: string; // Also known as: Component Data Seperator + FSegmentDelimiterLength: Integer; + FElementDelimiterLength: Integer; + FSubelementSeperatorLength: Integer; + procedure SetSD(const Delimiter: string); + procedure SetED(const Delimiter: string); + procedure SetSS(const Delimiter: string); + public + constructor Create; overload; + constructor Create(const SD, ED, SS: string); overload; + published + property SD: string read FSegmentDelimiter write SetSD; + property ED: string read FElementDelimiter write SetED; + property SS: string read FSubElementSeperator write SetSS; + property SDLen: Integer read FSegmentDelimiterLength; + property EDLen: Integer read FElementDelimiterLength; + property SSLen: Integer read FSubElementSeperatorLength; + end; + + // EDI Data Object + TEDIDataObjectType = + (ediUnknown, ediElement, ediCompositeElement, ediSegment, ediLoop, + ediTransactionSet, ediMessage, ediFunctionalGroup, + ediInterchangeControl, ediFile, ediCustom); + + TEDIDataObjectDataState = (ediCreated, ediAssembled, ediDisassembled); + + {$IFDEF CLR} + TCustomData = TObject; + {$ELSE} + TCustomData = Pointer; // backward compatibility + {$ENDIF CLR} + + TEDIDataObject = class(TEDIObject) + private + procedure SetDelimiters(const Delimiters: TEDIDelimiters); + protected + FEDIDOT: TEDIDataObjectType; + FState: TEDIDataObjectDataState; + FData: string; + FLength: Integer; + FParent: TEDIDataObject; + FDelimiters: TEDIDelimiters; + FErrorLog: TStrings; + FSpecPointer: TEDIObject; + FCustomData1: TCustomData; + FCustomData2: TCustomData; + function GetData: string; + procedure SetData(const Data: string); + public + constructor Create(Parent: TEDIDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; virtual; abstract; + procedure Disassemble; virtual; abstract; + property SpecPointer: TEDIObject read FSpecPointer write FSpecPointer; + property CustomData1: TCustomData read FCustomData1 write FCustomData1; + property CustomData2: TCustomData read FCustomData2 write FCustomData2; + published + property State: TEDIDataObjectDataState read FState; + property Data: string read GetData write SetData; + property DataLength: Integer read FLength; + property Parent: TEDIDataObject read FParent write FParent; + property Delimiters: TEDIDelimiters read FDelimiters write SetDelimiters; + end; + + TEDIDataObjectArray = array of TEDIDataObject; + + // EDI Data Object Group + TEDIDataObjectGroup = class(TEDIDataObject) + protected + FGroupIsParent: Boolean; + FEDIDataObjects: TEDIDataObjectList; + FCreateObjectType: TEDIDataObjectType; + function GetCount: Integer; + function GetEDIDataObject(Index: Integer): TEDIDataObject; + procedure SetEDIDataObject(Index: Integer; EDIDataObject: TEDIDataObject); + function InternalAssignDelimiters: TEDIDelimiters; virtual; abstract; + function InternalCreateEDIDataObject: TEDIDataObject; virtual; abstract; + public + constructor Create(Parent: TEDIDataObject; EDIDataObjectCount: Integer = 0); reintroduce; + destructor Destroy; override; + function IndexIsValid(Index: Integer): Boolean; + // + function AddEDIDataObject: Integer; + function AppendEDIDataObject(EDIDataObject: TEDIDataObject): Integer; + function InsertEDIDataObject(InsertIndex: Integer): Integer; overload; + function InsertEDIDataObject(InsertIndex: Integer; EDIDataObject: + TEDIDataObject): Integer; overload; + procedure DeleteEDIDataObject(Index: Integer); overload; + procedure DeleteEDIDataObject(EDIDataObject: TEDIDataObject); overload; + // + function AddEDIDataObjects(Count: Integer): Integer; + function AppendEDIDataObjects(EDIDataObjectArray: TEDIDataObjectArray): Integer; + function InsertEDIDataObjects(InsertIndex, Count: Integer): Integer; overload; + function InsertEDIDataObjects(InsertIndex: Integer; + EDIDataObjectArray: TEDIDataObjectArray): Integer; overload; + procedure DeleteEDIDataObjects; overload; + procedure DeleteEDIDataObjects(Index, Count: Integer); overload; + // + function GetIndexPositionFromParent: Integer; virtual; + // + property EDIDataObject[Index: Integer]: TEDIDataObject read GetEDIDataObject + write SetEDIDataObject; default; + property EDIDataObjects: TEDIDataObjectList read FEDIDataObjects; + published + property CreateObjectType: TEDIDataObjectType read FCreateObjectType; + property EDIDataObjectCount: Integer read GetCount; + end; + + TEDIDataObjectGroupArray = array of TEDIDataObjectGroup; + + // EDI Data Object Linked List Header and Item classes + TEDIObjectListItem = class(TEDIObject) + protected + FParent: TEDIObjectList; + FPriorItem: TEDIObjectListItem; + FNextItem: TEDIObjectListItem; + FEDIObject: TEDIObject; + FItemIndex: Integer; + FName: string; + public + constructor Create(Parent: TEDIObjectList; PriorItem: TEDIObjectListItem; + EDIObject: TEDIObject = nil); + destructor Destroy; override; + function GetIndexPositionFromParent: Integer; + procedure FreeAndNilEDIDataObject; + published + property ItemIndex: Integer read FItemIndex write FItemIndex; + property PriorItem: TEDIObjectListItem read FPriorItem write FPriorItem; + property NextItem: TEDIObjectListItem read FNextItem write FNextItem; + property EDIObject: TEDIObject read FEDIObject write FEDIObject; + property Name: string read FName write FName; + property Parent: TEDIObjectList read FParent write FParent; + end; + + TEDIDataObjectListOptions = set of (loAutoUpdateIndexes); + + TEDIObjectList = class(TEDIObject) + private + function GetItem(Index: Integer): TEDIObjectListItem; + protected + FOwnsObjects: Boolean; + FCount: Integer; + FOptions: TEDIDataObjectListOptions; + FFirstItem: TEDIObjectListItem; + FLastItem: TEDIObjectListItem; + FCurrentItem: TEDIObjectListItem; + function GetEDIObject(Index: Integer): TEDIObject; + procedure SetEDIObject(Index: Integer; const Value: TEDIObject); + function CreateListItem(PriorItem: TEDIObjectListItem; + EDIObject: TEDIObject = nil): TEDIObjectListItem; virtual; + public + constructor Create(OwnsObjects: Boolean = True); + destructor Destroy; override; + procedure Add(Item: TEDIObjectListItem; Name: string = ''); overload; + function Add(EDIObject: TEDIObject; Name: string = ''): TEDIObjectListItem; overload; + function Find(Item: TEDIObjectListItem): TEDIObjectListItem; overload; + function Find(EDIObject: TEDIObject): TEDIObjectListItem; overload; + function FindEDIObject(EDIObject: TEDIObject): TEDIObject; + function Extract(Item: TEDIObjectListItem): TEDIObjectListItem; overload; virtual; + function Extract(EDIObject: TEDIObject): TEDIObject; overload; virtual; + procedure Remove(Item: TEDIObjectListItem); overload; + procedure Remove(EDIObject: TEDIObject); overload; + function Insert(Item, BeforeItem: TEDIObjectListItem): TEDIObjectListItem; overload; + function Insert(EDIObject, BeforeEDIObject: TEDIObject): TEDIObjectListItem; overload; + function Insert(BeforeItem: TEDIObjectListItem): TEDIObjectListItem; overload; + function Insert(BeforeEDIObject: TEDIObject): TEDIObjectListItem; overload; + procedure Clear; + function First(Index: Integer = 0): TEDIObjectListItem; virtual; + function Next: TEDIObjectListItem; virtual; + function Prior: TEDIObjectListItem; virtual; + function Last: TEDIObjectListItem; virtual; + procedure UpdateCount; + // ...ByName procedures and functions + function FindItemByName(Name: string; + StartItem: TEDIObjectListItem = nil): TEDIObjectListItem; virtual; + function ReturnListItemsByName(Name: string): TEDIObjectList; virtual; + // Dynamic Array Emulation + function IndexOf(Item: TEDIObjectListItem): Integer; overload; + function IndexOf(EDIObject: TEDIObject): Integer; overload; + function IndexIsValid(Index: Integer): Boolean; + procedure Insert(InsertIndex: Integer; EDIObject: TEDIObject); overload; + procedure Delete(Index: Integer); overload; + procedure Delete(EDIObject: TEDIObject); overload; + procedure UpdateIndexes(StartItem: TEDIObjectListItem = nil); + // + property Item[Index: Integer]: TEDIObjectListItem read GetItem; + property EDIObject[Index: Integer]: TEDIObject read GetEDIObject + write SetEDIObject; default; + published + property Count: Integer read FCount; + property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects; + property Options: TEDIDataObjectListOptions read FOptions write FOptions; + property CurrentItem: TEDIObjectListItem read FCurrentItem; + end; + + TEDIDataObjectListItem = class(TEDIObjectListItem) + private + function GetEDIDataObject: TEDIDataObject; + procedure SetEDIDataObject(const Value: TEDIDataObject); + published + property EDIDataObject: TEDIDataObject read GetEDIDataObject write SetEDIDataObject; + end; + + TEDIDataObjectList = class(TEDIObjectList) + private + function GetEDIDataObject(Index: Integer): TEDIDataObject; + procedure SetEDIDataObject(Index: Integer; const Value: TEDIDataObject); + public + function CreateListItem(PriorItem: TEDIObjectListItem; + EDIObject: TEDIObject = nil): TEDIObjectListItem; override; + property EDIDataObject[Index: Integer]: TEDIDataObject read GetEDIDataObject + write SetEDIDataObject; default; + end; + + // EDI Loop Stack + TEDILoopStackRecord = record + SegmentId: string; + SpecStartIndex: Integer; + OwnerLoopId: string; + ParentLoopId: string; + EDIObject: TEDIObject; + EDISpecObject: TEDIObject; + end; + + TEDILoopStackArray = array of TEDILoopStackRecord; + + TEDILoopStackFlags = (ediAltStackPointer, ediStackResized, ediLoopRepeated); + + TEDILoopStackFlagSet = set of TEDILoopStackFlags; + + TEDILoopStackOnAddLoopEvent = procedure(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject) of object; + + TEDILoopStack = class(TEDIObject) + private + function GetSize: Integer; + protected + FStack: TEDILoopStackArray; + FFlags: TEDILoopStackFlagSet; + FCheckAssignedEDIObject: Boolean; + FOnAddLoop: TEDILoopStackOnAddLoopEvent; + procedure DoAddLoop(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); + public + constructor Create; + destructor Destroy; override; + // Basic Stack Routines + function Peek: TEDILoopStackRecord; overload; + function Peek(Index: Integer): TEDILoopStackRecord; overload; + procedure Pop(Index: Integer); + function Push(SegmentId, OwnerLoopId, ParentLoopId: string; StartIndex: Integer; + EDIObject: TEDIObject): Integer; + // Extended Stack Routines + function GetSafeStackIndex(Index: Integer): Integer; + function SetStackPointer(OwnerLoopId, ParentLoopId: string): Integer; + procedure UpdateStackObject(EDIObject: TEDIObject); + procedure UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId: string; StartIndex: Integer; + EDIObject: TEDIObject); + // Extended Stack Routines + function ValidateLoopStack(SegmentId, OwnerLoopId, ParentLoopId: string; StartIndex: Integer; + EDIObject: TEDIObject): TEDILoopStackRecord; + function Debug: string; + // + property Stack: TEDILoopStackArray read FStack; + published + property Size: Integer read GetSize; + property Flags: TEDILoopStackFlagSet read FFlags write FFlags; + property OnAddLoop: TEDILoopStackOnAddLoopEvent read FOnAddLoop write FOnAddLoop; + end; + +// Other +// Compatibility functions +function StringRemove(const S, Pattern: string; Flags: TReplaceFlags): string; +function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string; + +implementation + +uses + JclResources, JclStrings; + +// Other +function StringRemove(const S, Pattern: string; Flags: TReplaceFlags): string; +var + SearchPattern: string; + I, Offset, SearchPatternLength: Integer; +begin + if rfIgnoreCase in Flags then + begin + Result := AnsiUpperCase(S); + SearchPattern := AnsiUpperCase(Pattern); + end + else + begin + Result := S; + SearchPattern := Pattern; + end; + SearchPatternLength := Length(SearchPattern); + Result := S; + + I := 1; + Offset := 1; + while I <= Length(Result) do + begin + if SearchPatternLength = 1 then + begin + while Result[I] = SearchPattern[1] do + begin + Offset := Offset + SearchPatternLength; + if not (rfReplaceAll in Flags) then + Break; + Inc(I); + end; + end + else // SearchPatternLength > 1 + begin + while Copy(Result, Offset, SearchPatternLength) = SearchPattern do + begin + Offset := Offset + SearchPatternLength; + if not (rfReplaceAll in Flags) then + Break; + end; + end; + + if Offset <= Length(Result) then + Result[I] := S[Offset] + else + begin + Result[I] := #0; + SetLength(Result, I-1); + Break; + end; + + if not (rfReplaceAll in Flags) then + Break; + + Inc(I); + Inc(Offset); + end; +end; + +function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string; +var + SearchString, SearchPattern: string; + I, SearchIndex, ReplaceIndex: Integer; + SearchPatternLength, ReplacePatternLength: Integer; + SearchResult, ReplaceCount: Integer; +begin + Result := ''; + // Handle Case Sensitivity + if rfIgnoreCase in Flags then + begin + SearchString := AnsiUpperCase(S); + SearchPattern := AnsiUpperCase(OldPattern); + end + else + begin + SearchString := S; + SearchPattern := OldPattern; + end; + SearchPatternLength := Length(OldPattern); + ReplacePatternLength := Length(NewPattern); + // Calculate length of result string + ReplaceCount := 0; + SearchResult := StrSearch(SearchPattern, SearchString, 1); + if rfReplaceAll in Flags then + while SearchResult <> 0 do + begin + Inc(SearchResult); + Inc(ReplaceCount); + SearchResult := StrSearch(SearchPattern, SearchString, SearchResult); + end + else + if SearchResult <> 0 then + Inc(ReplaceCount); + SetLength(Result, Length(S) + ((ReplacePatternLength - SearchPatternLength) * ReplaceCount)); + // Copy the characters by looping through the result and source at the same time + ReplaceCount := 0; + ReplaceIndex := 1; + SearchIndex := 1; + // Loop while the indexes are still in range + while (ReplaceIndex <= Length(Result)) and (SearchIndex <= Length(SearchString)) do + begin + // Enter algorithm if replacing a pattern or there have been no replacements yet + if (rfReplaceAll in Flags) or ((not (rfReplaceAll in Flags)) and (ReplaceCount = 0)) then + // Replace the pattern (including repeating patterns) + while Copy(SearchString, SearchIndex, SearchPatternLength) = SearchPattern do + begin + // Move forward in the search string + SearchIndex := SearchIndex + Length(SearchPattern); + // Replace an old pattern by writing the new pattern to the result + I := 1; + while (ReplaceIndex <= Length(Result)) and (I <= ReplacePatternLength) do + begin + Result[ReplaceIndex] := NewPattern[I]; + Inc(I); + Inc(ReplaceIndex); + end; + // + Inc(ReplaceCount); + // If only making one replacement then break + if not (rfReplaceAll in Flags) then + Break; + end; + + // Copy character + if (ReplaceIndex <= Length(Result)) and (SearchIndex <= Length(SearchString)) then + Result[ReplaceIndex] := S[SearchIndex]; + + // Set indexes for next copy + Inc(SearchIndex); + Inc(ReplaceIndex); + end; +end; + +//=== { TEDIDelimiters } ===================================================== + +constructor TEDIDelimiters.Create; +begin + Create('~', '*', '>'); +end; + +constructor TEDIDelimiters.Create(const SD, ED, SS: string); +begin + inherited Create; + SetSD(SD); + SetED(ED); + SetSS(SS); +end; + +procedure TEDIDelimiters.SetED(const Delimiter: string); +begin + FElementDelimiter := Delimiter; + FElementDelimiterLength := Length(FElementDelimiter); +end; + +procedure TEDIDelimiters.SetSD(const Delimiter: string); +begin + FSegmentDelimiter := Delimiter; + FSegmentDelimiterLength := Length(FSegmentDelimiter); +end; + +procedure TEDIDelimiters.SetSS(const Delimiter: string); +begin + FSubelementSeperator := Delimiter; + FSubelementSeperatorLength := Length(FSubElementSeperator); +end; + +//=== { TEDIDataObject } ===================================================== + +constructor TEDIDataObject.Create(Parent: TEDIDataObject); +begin + inherited Create; + FState := ediCreated; + FEDIDOT := ediUnknown; + FData := ''; + FLength := 0; + FParent := Parent; + FDelimiters := nil; + FSpecPointer := nil; + FCustomData1 := nil; + FCustomData2 := nil; + {$IFDEF ENABLE_EDI_DEBUGGING} + Inc(Debug_EDIDataObjectsCreated); + {$ENDIF ENABLE_EDI_DEBUGGING} +end; + +destructor TEDIDataObject.Destroy; +begin + {$IFDEF ENABLE_EDI_DEBUGGING} + Inc(Debug_EDIDataObjectsDestroyed); + {$ENDIF ENABLE_EDI_DEBUGGING} + if not Assigned(FParent) then + FDelimiters.Free; + FDelimiters := nil; + FSpecPointer := nil; + FCustomData1 := nil; + FCustomData2 := nil; + inherited Destroy; +end; + +function TEDIDataObject.GetData: string; +begin + Result := FData; +end; + +procedure TEDIDataObject.SetData(const Data: string); +begin + FData := Data; + FLength := Length(FData); +end; + +procedure TEDIDataObject.SetDelimiters(const Delimiters: TEDIDelimiters); +begin + if not Assigned(FParent) then + FreeAndNil(FDelimiters); + FDelimiters := Delimiters; +end; + +//=== { TEDIDataObjectGroup } ================================================ + +constructor TEDIDataObjectGroup.Create(Parent: TEDIDataObject; EDIDataObjectCount: Integer); +begin + inherited Create(Parent); + FCreateObjectType := ediUnknown; + FGroupIsParent := True; + FEDIDataObjects := TEDIDataObjectList.Create; + if EDIDataObjectCount > 0 then + AddEDIDataObjects(EDIDataObjectCount); +end; + +function TEDIDataObjectGroup.AddEDIDataObjects(Count: Integer): Integer; +var + I: Integer; +begin + Result := FEDIDataObjects.Count; // Return position of 1st + for I := 1 to Count do + FEDIDataObjects.Add(InternalCreateEDIDataObject); +end; + +function TEDIDataObjectGroup.AddEDIDataObject: Integer; +begin + Result := FEDIDataObjects.Count; // Return position + FEDIDataObjects.Add(InternalCreateEDIDataObject); +end; + +function TEDIDataObjectGroup.AppendEDIDataObject(EDIDataObject: TEDIDataObject): Integer; +begin + Result := FEDIDataObjects.Count; // Return position + FEDIDataObjects.Add(EDIDataObject); + if FGroupIsParent then + EDIDataObject.Parent := Self; +end; + +function TEDIDataObjectGroup.AppendEDIDataObjects(EDIDataObjectArray: TEDIDataObjectArray): Integer; +var + I: Integer; +begin + Result := FEDIDataObjects.Count; // Return position of 1st + for I := Low(EDIDataObjectArray) to High(EDIDataObjectArray) do + begin + FEDIDataObjects.Add(EDIDataObjectArray[I]); + if FGroupIsParent then + EDIDataObjectArray[I].Parent := Self; + end; +end; + +procedure TEDIDataObjectGroup.DeleteEDIDataObject(EDIDataObject: TEDIDataObject); +begin + if loAutoUpdateIndexes in FEDIDataObjects.Options then + FEDIDataObjects.Delete(EDIDataObject) + else + FEDIDataObjects.Remove(EDIDataObject); +end; + +procedure TEDIDataObjectGroup.DeleteEDIDataObject(Index: Integer); +begin + if IndexIsValid(Index) then + FEDIDataObjects.Delete(Index) + else + {$IFNDEF CLR} + raise EJclEDIError.CreateResFmt(@RsEDIError010, [Self.ClassName, IntToStr(Index)]); + {$ELSE} + raise EJclEDIError.CreateFmt(RsEDIError010, [Self.ClassName, IntToStr(Index)]); + {$ENDIF ~CLR} +end; + +procedure TEDIDataObjectGroup.DeleteEDIDataObjects; +begin + FEDIDataObjects.Clear; +end; + +procedure TEDIDataObjectGroup.DeleteEDIDataObjects(Index, Count: Integer); +var + I: Integer; +begin + if IndexIsValid(Index) then + begin + FEDIDataObjects.Options := FEDIDataObjects.Options - [loAutoUpdateIndexes]; + try + for I := 1 to Count do + DeleteEDIDataObject(Index); + finally + FEDIDataObjects.Options := FEDIDataObjects.Options + [loAutoUpdateIndexes]; + end; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateResFmt(@RsEDIError011, [IntToStr(Index)]); + {$ELSE} + raise EJclEDIError.CreateFmt(RsEDIError011, [IntToStr(Index)]); + {$ENDIF ~CLR} +end; + +destructor TEDIDataObjectGroup.Destroy; +begin + DeleteEDIDataObjects; + FreeAndNil(FEDIDataObjects); + inherited Destroy; +end; + +function TEDIDataObjectGroup.GetEDIDataObject(Index: Integer): TEDIDataObject; +begin + if FEDIDataObjects.Count > 0 then + if Index >= 0 then + if Index <= FEDIDataObjects.Count - 1 then + begin + if not Assigned(FEDIDataObjects[Index]) then + raise EJclEDIError.CreateFmt(RsEDIError006, [Self.ClassName, IntToStr(Index)]); + Result := FEDIDataObjects[Index]; + end + else + raise EJclEDIError.CreateFmt(RsEDIError005, [Self.ClassName, IntToStr(Index)]) + else + raise EJclEDIError.CreateFmt(RsEDIError004, [Self.ClassName, IntToStr(Index)]) + else + raise EJclEDIError.CreateFmt(RsEDIError003, [Self.ClassName, IntToStr(Index)]); +end; + +function TEDIDataObjectGroup.IndexIsValid(Index: Integer): Boolean; +begin + Result := FEDIDataObjects.IndexIsValid(Index); +end; + +function TEDIDataObjectGroup.InsertEDIDataObject(InsertIndex: Integer): Integer; +begin + Result := InsertIndex; // Return position + if IndexIsValid(InsertIndex) then + FEDIDataObjects.Insert(InsertIndex, InternalCreateEDIDataObject) + else + Result := AddEDIDataObject; +end; + +function TEDIDataObjectGroup.InsertEDIDataObject(InsertIndex: Integer; + EDIDataObject: TEDIDataObject): Integer; +begin + Result := InsertIndex; // Return position + if IndexIsValid(InsertIndex) then + begin + FEDIDataObjects.Insert(InsertIndex, EDIDataObject); + if FGroupIsParent then + EDIDataObject.Parent := Self; + end + else + Result := AppendEDIDataObject(EDIDataObject); +end; + +function TEDIDataObjectGroup.InsertEDIDataObjects(InsertIndex: Integer; + EDIDataObjectArray: TEDIDataObjectArray): Integer; +var + I: Integer; +begin + Result := InsertIndex; // Return position of 1st + if IndexIsValid(InsertIndex) then + begin + for I := High(EDIDataObjectArray) downto Low(EDIDataObjectArray) do + begin + FEDIDataObjects.Insert(InsertIndex, EDIDataObjectArray[I]); + if FGroupIsParent then + EDIDataObjectArray[I].Parent := Self; + end; + end + else + Result := AppendEDIDataObjects(EDIDataObjectArray); +end; + +function TEDIDataObjectGroup.InsertEDIDataObjects(InsertIndex, Count: Integer): Integer; +var + I: Integer; +begin + Result := InsertIndex; // Return position of 1st + if IndexIsValid(InsertIndex) then + begin + for I := 1 to Count do + FEDIDataObjects.Insert(InsertIndex, InternalCreateEDIDataObject); + end + else + Result := AddEDIDataObjects(Count); +end; + +procedure TEDIDataObjectGroup.SetEDIDataObject(Index: Integer; EDIDataObject: TEDIDataObject); +begin + if FEDIDataObjects.Count > 0 then + if Index >= 0 then + if Index <= FEDIDataObjects.Count - 1 then + begin + FEDIDataObjects.Item[Index].FreeAndNilEDIDataObject; + FEDIDataObjects[Index] := EDIDataObject; + if FGroupIsParent then + FEDIDataObjects[Index].Parent := Self; + end + else + raise EJclEDIError.CreateFmt(RsEDIError009, [Self.ClassName, IntToStr(Index)]) + else + raise EJclEDIError.CreateFmt(RsEDIError008, [Self.ClassName, IntToStr(Index)]) + else + raise EJclEDIError.CreateFmt(RsEDIError007, [Self.ClassName, IntToStr(Index)]); +end; + +function TEDIDataObjectGroup.GetIndexPositionFromParent: Integer; +var + I: Integer; + ParentGroup: TEDIDataObjectGroup; +begin + Result := -1; + if Assigned(Parent) and (Parent is TEDIDataObjectGroup) then + begin + ParentGroup := TEDIDataObjectGroup(Parent); + for I := 0 to ParentGroup.EDIDataObjectCount - 1 do + if ParentGroup.EDIDataObject[I] = Self then + begin + Result := I; + Break; + end; + end; // if +end; + +function TEDIDataObjectGroup.GetCount: Integer; +begin + Result := FEDIDataObjects.Count; +end; + +//=== { TEDIObjectListItem } ================================================= + +constructor TEDIObjectListItem.Create(Parent: TEDIObjectList; + PriorItem: TEDIObjectListItem; EDIObject: TEDIObject = nil); +begin + inherited Create; + FName := ''; + FParent := Parent; + FItemIndex := 0; + FEDIObject := EDIObject; + FPriorItem := PriorItem; + FNextItem := nil; + if FPriorItem <> nil then + FItemIndex := FPriorItem.ItemIndex + 1; + {$IFDEF ENABLE_EDI_DEBUGGING} + Inc(Debug_EDIDataObjectListItemsCreated); + {$ENDIF ENABLE_EDI_DEBUGGING} +end; + +destructor TEDIObjectListItem.Destroy; +begin + {$IFDEF ENABLE_EDI_DEBUGGING} + Inc(Debug_EDIDataObjectListItemsDestroyed); + {$ENDIF ENABLE_EDI_DEBUGGING} + FPriorItem := nil; + FNextItem := nil; + if FParent.OwnsObjects then + FreeAndNilEDIDataObject; + FEDIObject := nil; + FParent := nil; + inherited Destroy; +end; + +procedure TEDIObjectListItem.FreeAndNilEDIDataObject; +begin + FreeAndNil(FEDIObject); +end; + +function TEDIObjectListItem.GetIndexPositionFromParent: Integer; +begin + Result := FParent.IndexOf(Self); +end; + +//=== { TEDIObjectList } ===================================================== + +constructor TEDIObjectList.Create(OwnsObjects: Boolean = True); +begin + inherited Create; + FOwnsObjects := OwnsObjects; + FFirstItem := nil; + FLastItem := nil; + FCurrentItem := nil; + FCount := 0; + FOptions := [loAutoUpdateIndexes]; + {$IFDEF ENABLE_EDI_DEBUGGING} + Inc(Debug_EDIDataObjectListCreated); + {$ENDIF ENABLE_EDI_DEBUGGING} +end; + +destructor TEDIObjectList.Destroy; +begin + {$IFDEF ENABLE_EDI_DEBUGGING} + Inc(Debug_EDIDataObjectListDestroyed); + {$ENDIF ENABLE_EDI_DEBUGGING} + Clear; + inherited Destroy; +end; + +procedure TEDIObjectList.Clear; +var + ListItem: TEDIObjectListItem; + TempItem: TEDIObjectListItem; +begin + ListItem := FFirstItem; + while ListItem <> nil do + begin + TempItem := ListItem; + ListItem := ListItem.NextItem; + TempItem.Free; + end; + FFirstItem := nil; + FLastItem := nil; + FCurrentItem := nil; + FCount := 0; +end; + +function TEDIObjectList.First(Index: Integer): TEDIObjectListItem; +begin + if Index = 0 then + Result := FFirstItem + else + Result := GetItem(Index); + FCurrentItem := Result; +end; + +function TEDIObjectList.Last: TEDIObjectListItem; +begin + FCurrentItem := FLastItem; + Result := FCurrentItem; +end; + +function TEDIObjectList.Next: TEDIObjectListItem; +begin + FCurrentItem := FCurrentItem.NextItem; + Result := FCurrentItem; +end; + +function TEDIObjectList.Prior: TEDIObjectListItem; +begin + FCurrentItem := FCurrentItem.PriorItem; + Result := FCurrentItem; +end; + +function TEDIObjectList.Add(EDIObject: TEDIObject; Name: string): TEDIObjectListItem; +begin + Result := CreateListItem(FLastItem, EDIObject); + Result.Name := Name; + if FLastItem <> nil then + FLastItem.NextItem := Result; + if FFirstItem = nil then + FFirstItem := Result; + FLastItem := Result; + FCurrentItem := Result; + Inc(FCount); +end; + +function TEDIObjectList.FindItemByName(Name: string; + StartItem: TEDIObjectListItem): TEDIObjectListItem; +var + ListItem: TEDIObjectListItem; +begin + Result := nil; + if StartItem <> nil then + ListItem := StartItem + else + ListItem := First; + while ListItem <> nil do + begin + if ListItem.Name = Name then + begin + Result := ListItem; + Break; + end; + ListItem := Next; + end; +end; + +procedure TEDIObjectList.Insert(InsertIndex: Integer; EDIObject: TEDIObject); +var + ListItem: TEDIObjectListItem; +begin + FCurrentItem := GetItem(InsertIndex); + if FCurrentItem <> nil then + begin + //Link new item + ListItem := CreateListItem(FCurrentItem.PriorItem); + ListItem.NextItem := FCurrentItem; + ListItem.EDIObject := EDIObject; + //Relink current item + if FCurrentItem.PriorItem <> nil then + FCurrentItem.PriorItem.NextItem := ListItem + else + FFirstItem := ListItem; + FCurrentItem.PriorItem := ListItem; + // + FCurrentItem := ListItem; + Inc(FCount); + // Update the indexes starting at the current item. + if loAutoUpdateIndexes in FOptions then + UpdateIndexes(FCurrentItem); //Pass nil to force update of all items + end + else + Add(EDIObject); +end; + +function TEDIObjectList.GetItem(Index: Integer): TEDIObjectListItem; +var + I: Integer; + ListItem: TEDIObjectListItem; +begin + Result := nil; + if FCurrentItem <> nil then // Attempt to search from the current item. + begin + if Index = FCurrentItem.ItemIndex then // The index already points to the current item. + Result := FCurrentItem + else + if Index > FCurrentItem.ItemIndex then // Search forward in the list. + begin + I := FCurrentItem.ItemIndex - 1; + ListItem := FCurrentItem; + while ListItem <> nil do + begin + Inc(I); + if I = Index then + begin + Result := ListItem; + Break; + end; + ListItem := ListItem.NextItem; + end; + FCurrentItem := Result; + end + else // if Index < FCurrentItem.ItemIndex then // Search backward in the list. + begin + I := FCurrentItem.ItemIndex + 1; + ListItem := FCurrentItem; + while ListItem <> nil do + begin + Dec(I); + if I = Index then + begin + Result := ListItem; + Break; + end; + ListItem := ListItem.PriorItem; + end; + FCurrentItem := Result; + end; + end + else // No current item was assigned so search from the beginning of the structure. + begin + I := -1; + FCurrentItem := FFirstItem; + ListItem := FFirstItem; + while ListItem <> nil do + begin + Inc(I); + if I = Index then + begin + Result := ListItem; + Break; + end; + ListItem := ListItem.NextItem; + end; + FCurrentItem := Result; + end; +end; + +procedure TEDIObjectList.Delete(Index: Integer); +var + ListItem: TEDIObjectListItem; +begin + ListItem := GetItem(Index); + if ListItem <> nil then + begin + Remove(ListItem); + // Update the indexes starting at the current item. + if loAutoUpdateIndexes in FOptions then + UpdateIndexes(FCurrentItem.PriorItem); //Pass nil to force update of all items + end; +end; + +procedure TEDIObjectList.Delete(EDIObject: TEDIObject); +begin + Remove(EDIObject); + // Update the indexes starting at the current item. + if loAutoUpdateIndexes in FOptions then + UpdateIndexes(nil); //Pass nil to force update of all items +end; + +procedure TEDIObjectList.UpdateIndexes(StartItem: TEDIObjectListItem = nil); +var + I: Integer; + ListItem: TEDIObjectListItem; +begin + if StartItem <> nil then + begin + ListItem := StartItem; + I := StartItem.ItemIndex - 1; + end + else + begin + ListItem := FFirstItem; + I := -1; + end; + while ListItem <> nil do + begin + Inc(I); + ListItem.ItemIndex := I; + ListItem := ListItem.NextItem; + end; +end; + +procedure TEDIObjectList.UpdateCount; +var + ListItem: TEDIObjectListItem; +begin + FCount := 0; + ListItem := FFirstItem; + while ListItem <> nil do + begin + ListItem := ListItem.NextItem; + Inc(FCount); + end; +end; + +procedure TEDIObjectList.Remove(EDIObject: TEDIObject); +var + ListItem: TEDIObjectListItem; +begin + ListItem := Find(EDIObject); + if ListItem <> nil then + begin + // Remove the item from the list + ListItem := Extract(ListItem); + // Free the list item + FreeAndNil(ListItem); + end; +end; + +function TEDIObjectList.Extract(EDIObject: TEDIObject): TEDIObject; +var + ListItem: TEDIObjectListItem; +begin + Result := nil; + ListItem := Find(EDIObject); + if ListItem <> nil then + begin + // Extract the EDI Data Object + Result := ListItem.EDIObject; + ListItem.EDIObject := nil; + // Remove the item from the list + ListItem := Extract(ListItem); + // Free the list item + FreeAndNil(ListItem); + end; +end; + +function TEDIObjectList.IndexOf(EDIObject: TEDIObject): Integer; +var + I: Integer; + ListItem: TEDIObjectListItem; +begin + Result := -1; + I := 0; + ListItem := FFirstItem; + while ListItem <> nil do + begin + if ListItem.EDIObject = EDIObject then + begin + FCurrentItem := ListItem; + FCurrentItem.ItemIndex := I; + Result := I; + Break; + end; + ListItem := ListItem.NextItem; + Inc(I); + end; +end; + +function TEDIObjectList.GetEDIObject(Index: Integer): TEDIObject; +var + ListItem: TEDIObjectListItem; +begin + Result := nil; + ListItem := GetItem(Index); + if ListItem <> nil then + Result := ListItem.EDIObject; +end; + +procedure TEDIObjectList.SetEDIObject(Index: Integer; const Value: TEDIObject); +var + ListItem: TEDIObjectListItem; +begin + ListItem := GetItem(Index); + if ListItem <> nil then + ListItem.EDIObject := Value; +end; + +function TEDIObjectList.ReturnListItemsByName(Name: string): TEDIObjectList; +var + ListItem: TEDIObjectListItem; +begin + Result := TEDIObjectList.Create(False); + ListItem := First; + while ListItem <> nil do + begin + if ListItem.Name = Name then + Result.Add(ListItem.EDIObject, ListItem.Name); + ListItem := Next; + end; //while +end; + +function TEDIObjectList.IndexOf(Item: TEDIObjectListItem): Integer; +var + I: Integer; + ListItem: TEDIObjectListItem; +begin + Result := -1; + I := 0; + ListItem := FFirstItem; + while ListItem <> nil do + begin + if ListItem = Item then + begin + FCurrentItem := ListItem; + FCurrentItem.ItemIndex := I; + Result := I; + Break; + end; + ListItem := ListItem.NextItem; + Inc(I); + end; +end; + +procedure TEDIObjectList.Remove(Item: TEDIObjectListItem); +begin + // Remove the item from the list + Item := Extract(Item); + // Free the list item + FreeAndNil(Item); +end; + +function TEDIObjectList.Extract(Item: TEDIObjectListItem): TEDIObjectListItem; +begin + Result := Item; + // Set current item + if Item.NextItem <> nil then + FCurrentItem := Item.NextItem + else + FCurrentItem := Item.PriorItem; + // Extract the item and relink existing items. + if Item.NextItem <> nil then + Item.NextItem.PriorItem := Item.PriorItem; + if Item.PriorItem <> nil then + Item.PriorItem.NextItem := Item.NextItem; + if Item = FFirstItem then + FFirstItem := Item.NextItem; + if Item = FLastItem then + FLastItem := Item.PriorItem; + // Update the count + Dec(FCount); +end; + +procedure TEDIObjectList.Add(Item: TEDIObjectListItem; Name: string); +begin + Item.Parent := Self; + Item.Name := Name; + Item.NextItem := nil; + Item.PriorItem := nil; + if FLastItem <> nil then + begin + Item.PriorItem := FLastItem; + FLastItem.NextItem := Item; + end; + if FFirstItem = nil then + FFirstItem := Item; + FLastItem := Item; + FCurrentItem := Item; + Inc(FCount); +end; + +function TEDIObjectList.FindEDIObject(EDIObject: TEDIObject): TEDIObject; +var + ListItem: TEDIObjectListItem; +begin + Result := nil; + ListItem := FFirstItem; + while ListItem <> nil do + begin + if ListItem.EDIObject = EDIObject then + begin + FCurrentItem := ListItem; + Result := ListItem.EDIObject; + Break; + end; + ListItem := ListItem.NextItem; + end; +end; + +function TEDIObjectList.Find(Item: TEDIObjectListItem): TEDIObjectListItem; +var + ListItem: TEDIObjectListItem; +begin + Result := nil; + ListItem := FFirstItem; + while ListItem <> nil do + begin + if ListItem = Item then + begin + FCurrentItem := ListItem; + Result := ListItem; + Break; + end; + ListItem := ListItem.NextItem; + end; +end; + +function TEDIObjectList.Find(EDIObject: TEDIObject): TEDIObjectListItem; +var + ListItem: TEDIObjectListItem; +begin + Result := nil; + ListItem := FFirstItem; + while ListItem <> nil do + begin + if ListItem.EDIObject = EDIObject then + begin + FCurrentItem := ListItem; + Result := ListItem; + Break; + end; + ListItem := ListItem.NextItem; + end; +end; + +function TEDIObjectList.IndexIsValid(Index: Integer): Boolean; +begin + Result := False; + if (FCount > 0) and (Index >= 0) and (Index <= FCount - 1) then + Result := True; +end; + +function TEDIObjectList.Insert(Item, BeforeItem: TEDIObjectListItem): TEDIObjectListItem; +begin + Result := Item; + if Result = nil then + Result := CreateListItem(BeforeItem, nil); + Result.Parent := Self; + Result.PriorItem := nil; + Result.NextItem := nil; + if BeforeItem <> nil then // Insert item + begin + Result.PriorItem := BeforeItem.PriorItem; + BeforeItem.PriorItem := Result; + if Result.PriorItem <> nil then + Result.PriorItem.NextItem := Result; + Result.NextItem := BeforeItem; + end + else + if FFirstItem <> nil then // Insert as first item + begin + FFirstItem.PriorItem := Result; + Result.NextItem := FFirstItem; + FFirstItem := Result; + end + else + Add(Result); // Add as first item + FCurrentItem := Result; + Inc(FCount); +end; + +function TEDIObjectList.Insert(EDIObject, BeforeEDIObject: TEDIObject): TEDIObjectListItem; +var + BeforeItem: TEDIObjectListItem; +begin + BeforeItem := Find(BeforeEDIObject); + Result := CreateListItem(BeforeItem, EDIObject); + Insert(Result, BeforeItem); +end; + +function TEDIObjectList.Insert(BeforeItem: TEDIObjectListItem): TEDIObjectListItem; +begin + Result := CreateListItem(BeforeItem, nil); + Insert(Result, BeforeItem); +end; + +function TEDIObjectList.Insert(BeforeEDIObject: TEDIObject): TEDIObjectListItem; +begin + Result := Insert(nil, BeforeEDIObject); +end; + +//=== { TEDIDataObjectListItem } ============================================= + +function TEDIDataObjectListItem.GetEDIDataObject: TEDIDataObject; +begin + Result := TEDIDataObject(FEDIObject); +end; + +procedure TEDIDataObjectListItem.SetEDIDataObject(const Value: TEDIDataObject); +begin + FEDIObject := Value; +end; + +//=== { TEDIDataObjectList } ================================================= + +function TEDIDataObjectList.CreateListItem(PriorItem: TEDIObjectListItem; + EDIObject: TEDIObject): TEDIObjectListItem; +begin + Result := TEDIDataObjectListItem.Create(Self, PriorItem, EDIObject); +end; + +function TEDIDataObjectList.GetEDIDataObject(Index: Integer): TEDIDataObject; +begin + Result := TEDIDataObject(GetEDIObject(Index)); +end; + +procedure TEDIDataObjectList.SetEDIDataObject(Index: Integer; const Value: TEDIDataObject); +begin + SetEDIObject(Index, Value); +end; + +function TEDIObjectList.CreateListItem(PriorItem: TEDIObjectListItem; + EDIObject: TEDIObject = nil): TEDIObjectListItem; +begin + Result := TEDIObjectListItem.Create(Self, PriorItem, EDIObject); +end; + +//=== { TEDILoopStack } ====================================================== + +constructor TEDILoopStack.Create; +begin + inherited Create; + SetLength(FStack, 0); + FFlags := []; +end; + +destructor TEDILoopStack.Destroy; +var + I: Integer; +begin + for I := Low(FStack) to High(FStack) do + FStack[I].EDIObject := nil; + SetLength(FStack, 0); + inherited Destroy; +end; + +function TEDILoopStack.Debug: string; +var + I: Integer; +begin + Result := 'Loop Stack' + AnsiLineBreak; + for I := 0 to High(FStack) do + Result := Result + FStack[I].SegmentId + ', ' + + FStack[I].OwnerLoopId + ', ' + + FStack[I].ParentLoopId + ', ' + + IntToStr(FStack[I].SpecStartIndex) + AnsiLineBreak; +end; + +procedure TEDILoopStack.DoAddLoop(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); +begin + if Assigned(FOnAddLoop) then + FOnAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject); +end; + +function TEDILoopStack.GetSafeStackIndex(Index: Integer): Integer; +begin + if Length(FStack) > 0 then + begin + if Index >= Low(FStack) then + begin + if Index <= High(FStack) then + Result := Index + else + Result := High(FStack); + end + else + Result := Low(FStack); + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateResFmt(@RsEDIError057, [IntToStr(Index)]); + {$ELSE} + raise EJclEDIError.CreateFmt(RsEDIError057, [IntToStr(Index)]); + {$ENDIF ~CLR} +end; + +function TEDILoopStack.GetSize: Integer; +begin + Result := Length(FStack); +end; + +function TEDILoopStack.Peek: TEDILoopStackRecord; +begin + Result := FStack[High(FStack)]; +end; + +function TEDILoopStack.Peek(Index: Integer): TEDILoopStackRecord; +begin + if Length(FStack) > 0 then + if Index >= Low(FStack) then + if Index <= High(FStack) then + Result := FStack[Index] + else + raise EJclEDIError.CreateFmt(RsEDIError054, [IntToStr(Index)]) + else + raise EJclEDIError.CreateFmt(RsEDIError055, [IntToStr(Index)]) + else + raise EJclEDIError.CreateFmt(RsEDIError056, [IntToStr(Index)]); +end; + +procedure TEDILoopStack.Pop(Index: Integer); +begin + // Resize loop stack if the index is less than the length + if (Index >= 0) and (Index < Length(FStack)) then + begin + SetLength(FStack, Index); + FFlags := FFlags + [ediStackResized]; + end; +end; + +function TEDILoopStack.Push(SegmentId, OwnerLoopId, ParentLoopId: string; StartIndex: Integer; + EDIObject: TEDIObject): Integer; +begin + // Add to loop stack + SetLength(FStack, Length(FStack) + 1); + UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject); + Result := High(FStack); +end; + +function TEDILoopStack.SetStackPointer(OwnerLoopId, + ParentLoopId: string): Integer; +var + I: Integer; +begin + FFlags := FFlags - [ediStackResized]; + FFlags := FFlags - [ediAltStackPointer]; + Result := -1; // Entry not found + // Find the loop in the stack + for I := High(FStack) downto 0 do + begin + if (OwnerLoopId = FStack[I].OwnerLoopId) and + (ParentLoopId = FStack[I].ParentLoopId) then + begin + Result := I; + // Pop entries from the stack starting at the index after the found loop + Pop(I + 1); + Break; + end; + end; + // Check if an exact entry was found + if Result = -1 then + begin + // Find the parent loop in the stack + for I := High(FStack) downto 0 do + begin + if (ParentLoopId = FStack[I].ParentLoopId) and + (FStack[I].OwnerLoopId <> NA_LoopId) then + begin + FFlags := FFlags + [ediAltStackPointer]; + Result := GetSafeStackIndex(I); + // Pop entries from the stack starting at the index after the found loop + Pop(I + 1); + Break; + end; + end; + end; +end; + +procedure TEDILoopStack.UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId: string; + StartIndex: Integer; EDIObject: TEDIObject); +begin + FStack[High(FStack)].SegmentId := SegmentId; + FStack[High(FStack)].OwnerLoopId := OwnerLoopId; + FStack[High(FStack)].ParentLoopId := ParentLoopId; + FStack[High(FStack)].SpecStartIndex := StartIndex; + FStack[High(FStack)].EDIObject := EDIObject; +end; + +procedure TEDILoopStack.UpdateStackObject(EDIObject: TEDIObject); +begin + FStack[High(FStack)].EDIObject := EDIObject; +end; + +function TEDILoopStack.ValidateLoopStack(SegmentId, OwnerLoopId, ParentLoopId: string; + StartIndex: Integer; EDIObject: TEDIObject): TEDILoopStackRecord; +var + I: Integer; + StackRecord: TEDILoopStackRecord; +begin + if Length(FStack) <= 0 then + // Add entry to stack + Push(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject) + else + begin + I := SetStackPointer(OwnerLoopId, ParentLoopId); + if I >= 0 then // Entry found + begin + if ediLoopRepeated in FFlags then + begin + // Get the previous stack record so the repeated loop will not be nested + StackRecord := Peek(I-1); + // In event handler add loop to external data structure since it repeated + // See JclEDI_ANSIX12.TEDITransactionSetDocument class for implementation example. + DoAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject); + // Update stack object only + UpdateStackObject(EDIObject); + // Debug + // ShowMessage('LoopRepeated'); + end + else + if ediAltStackPointer in FFlags then + begin + // Get the previous stack record because the loop + // is not to be nested at the current stack pointer + StackRecord := Peek(I-1); + // In event handler add loop to external data structure since it is new + // See JclEDI_ANSIX12.TEDITransactionSetDocument class for implementation example. + DoAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject); + // Update stack entry + UpdateStackData(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject); + // Debug + // ShowMessage('AltStackPointer'); + end + else + if ediStackResized in FFlags then + begin + // Debug + // ShowMessage('Stack Size Decreased'); + end + else + begin + // Segment is part of loop + end; + end + else + if I = -1 then // Entry not found. + begin + // In event handler add loop since it is new + StackRecord := Peek; + // In event handler add loop to external data structure since it is new + DoAddLoop(StackRecord, SegmentId, OwnerLoopId, ParentLoopId, EDIObject); + // Add entry to stack + Push(SegmentId, OwnerLoopId, ParentLoopId, StartIndex, EDIObject); + // Debug + // ShowMessage('Stack Size Increased'); + end; + end; + Result := Peek; +end; + +end. diff --git a/official/1.96/source/common/JclEDISEF.pas b/official/1.96/source/common/JclEDISEF.pas new file mode 100644 index 0000000..40f372c --- /dev/null +++ b/official/1.96/source/common/JclEDISEF.pas @@ -0,0 +1,4677 @@ +{**************************************************************************************************} +{ } +{ 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 JclEDISEF.pas. } +{ } +{ The Initial Developer of the Original Code is Raymond Alexander. } +{ Portions created by Raymond Alexander are Copyright (C) Raymond Alexander. All rights reserved. } +{ } +{ Contributor(s): } +{ Raymond Alexander (rayspostbox3), Robert Marquardt, Robert Rossmair, Petr Vones } +{ } +{**************************************************************************************************} +{ } +{ EDI Standard Exchange Format (*.sef) File Parser Unit } +{ } +{ This unit is still in development } +{ } +{ Unit owner: Raymond Alexander } +{ Date created: July, 20, 2003 } +{ Additional Info: } +{ E-Mail at RaysDelphiBox3 att hotmail dott com } +{ For latest EDI specific demos see http://sourceforge.net/projects/edisdk } +{ See home page for latest news & events and online help. } +{ } +{**************************************************************************************************} + +// $Id: JclEDISEF.pas,v 1.21 2005/08/09 10:30:21 ahuser Exp $ + +unit JclEDISEF; + +{$I jcl.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$WEAKPACKAGEUNIT ON} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +interface + +uses + SysUtils, Classes, Contnrs, + JclEDI; + +const + SectionTag_VER = '.VER'; + SectionTag_INI = '.INI'; + SectionTag_PRIVATE = ''; + SectionTag_PUBLIC = ''; + SectionTag_STD = '.STD'; + SectionTag_SETS = '.SETS'; + SectionTag_SEGS = '.SEGS'; + SectionTag_COMS = '.COMS'; + SectionTag_ELMS = '.ELMS'; + SectionTag_CODES = '.CODES'; + SectionTag_VALLISTS = ''; + SectionTag_OBJVARS = ''; + SectionTag_SEMREFS = ''; + SectionTag_TEXT = ''; + SectionTag_TEXTSETS = '.TEXT,SETS'; + SectionTag_ = ''; + // EDI SDK Specific Extensions + SectionTag_JCL_SETSEXT = '.SETSEXT'; + SectionTag_JCL_SEGSEXT = '.SEGSEXT'; + SectionTag_JCL_COMSEXT = '.COMSEXT'; + SectionTag_JCL_ELMSEXT = '.ELMSEXT'; + + Value_UndefinedMaximum = MaxInt; + + EDISEFUserAttributePeriod = '.'; + EDISEFUserAttributeExclamationPoint = '!'; + EDISEFUserAttributeDollarSign = '$'; + EDISEFUserAttributeHyphen = '-'; + EDISEFUserAttributeAmpersand = '&'; + + EDISEFUserAttributePeriodDesc = 'Not Used'; + EDISEFUserAttributeExclamationPointDesc = 'Mandatory'; + EDISEFUserAttributeDollarSignDesc = 'Recommended'; + EDISEFUserAttributeHyphenDesc = 'Not Recommended'; + EDISEFUserAttributeAmpersandDesc = 'Dependent'; + + EDISEFUserAttributeSet = + [EDISEFUserAttributePeriod, EDISEFUserAttributeExclamationPoint, + EDISEFUserAttributeDollarSign, EDISEFUserAttributeHyphen, + EDISEFUserAttributeAmpersand]; + +const + // EDI SEF Text,Sets Constants + SEFTextCR = '\r'; // carriage return + SEFTextLF = '\n'; // line feed + SEFTextCRLF = SEFTextCR + SEFTextLF; + // Example: Transaction Set:850 + SEFTextSetsCode_Set0 = '0'; // Transaction Set or message title. + SEFTextSetsCode_Set1 = '1'; // Transaction Set functional group (X12). + SEFTextSetsCode_Set2 = '2'; // Transaction Set or message purpose. + SEFTextSetsCode_Set3 = '3'; // Level 1 note on transaction set or message. + SEFTextSetsCode_Set4 = '4'; // Level 2 note on transaction set or message. + SEFTextSetsCode_Set5 = '5'; // Level 3 note on transaction set or message. See * below for other levels of notes. + // Example: Transaction Set~segment ordinal number: 850~1 + SEFTextSetsCode_Seg0 = '0'; // Segment reference notes that are part of the transaction set in X12. + SEFTextSetsCode_Seg1 = '1'; // Segment reference notes documented with the segment (like in VICS/UCS). + SEFTextSetsCode_Seg2 = '2'; // Segment reference comment documented with the transaction set. + SEFTextSetsCode_Seg3 = '3'; // Segment name. + SEFTextSetsCode_Seg4 = '4'; // Level 1 note on segment. + SEFTextSetsCode_Seg5 = '5'; // Level 2 note on segment. + SEFTextSetsCode_Seg6 = '6'; // Segment purpose. + SEFTextSetsCode_Seg7 = '7'; // Level 3 note on segment. See * below for other levels of notes. + // Example: Transaction Set~segment ordinal number~element or composite ordinal number: 850~1~4 + SEFTextSetsCode_Elm0 = '0'; // Level 1 note on element or composite. + SEFTextSetsCode_Elm1 = '1'; // Level 2 note on element or composite. + SEFTextSetsCode_Elm2 = '2'; // Name of element or composite. + SEFTextSetsCode_Elm4 = '4'; // Level 3 note on element or composite. See * below for other levels of notes. + +type + TEDISEFComsUserAttributes = + (caPeriod, caExclamationPoint, caDollarSign, caHyphen, caAmpersand); + + TEDISEFObject = class(TEDIObject); + TEDISEFDataObject = class; + TEDISEFDataObjectGroup = class; + TEDISEFSubElement = class; + TEDISEFElement = class; + TEDISEFCompositeElement = class; + TEDISEFSegment = class; + TEDISEFLoop = class; + TEDISEFTable = class; + TEDISEFSet = class; + TEDISEFFile = class; + + TEDISEFDataObjectListItem = class; + TEDISEFDataObjectList = class; + + TEDISEFObjectParentType = + (sefNil, sefList, sefElement, sefCompositeElement, sefSegment); + + // EDI SEF Data Object + TEDISEFDataObject = class(TEDISEFObject) + private + procedure SetId(const Value: string); + protected + FState: TEDIDataObjectDataState; + FId: string; + FData: string; + FLength: Integer; + FParent: TEDISEFDataObject; + FSEFFile: TEDISEFFile; + FErrorLog: TStrings; + FOwnerItemRef: TEDISEFDataObjectListItem; + function GetData: string; + procedure SetData(const Data: string); + procedure SetParent(const Value: TEDISEFDataObject); virtual; + property OwnerItemRef: TEDISEFDataObjectListItem read FOwnerItemRef write FOwnerItemRef; + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; virtual; abstract; + procedure Disassemble; virtual; abstract; + procedure UpdateOwnerItemName; + {$IFDEF COMPILER6_UP} // Hide warnings in D5 + function Clone(NewParent: TEDISEFDataObject): TEDISEFDataObject; virtual; abstract; + {$ELSE} + function Clone(NewParent: TEDISEFDataObject): TEDISEFDataObject; virtual; + {$ENDIF COMPILER6_UP} + published + property State: TEDIDataObjectDataState read FState; + property Id: string read FId write SetId; + property Data: string read GetData write SetData; + property DataLength: Integer read FLength; + property Parent: TEDISEFDataObject read FParent write SetParent; + property SEFFile: TEDISEFFile read FSEFFile write FSEFFile; + end; + + TEDISEFDataObjectClass = class of TEDISEFDataObject; + + // EDI SEF Data Object List Item + TEDISEFDataObjectListItem = class(TEDIObjectListItem) + private + function GetEDISEFDataObject: TEDISEFDataObject; + procedure SetEDISEFDataObject(const Value: TEDISEFDataObject); + public + procedure LinkToObject; + procedure UpdateName; + function NextItem: TEDISEFDataObjectListItem; + function PriorItem: TEDISEFDataObjectListItem; + published + property EDISEFDataObject: TEDISEFDataObject read GetEDISEFDataObject write SetEDISEFDataObject; + end; + + // EDI SEF Data Object List + TEDISEFDataObjectList = class(TEDIObjectList) + private + function GetEDISEFDataObject(Index: Integer): TEDISEFDataObject; + procedure SetEDISEFDataObject(Index: Integer; const Value: TEDISEFDataObject); + public + function CreateListItem(PriorItem: TEDIObjectListItem; + EDIObject: TEDIObject = nil): TEDIObjectListItem; override; + + function First(Index: Integer = 0): TEDISEFDataObjectListItem; reintroduce; + function Next: TEDISEFDataObjectListItem; reintroduce; + function Prior: TEDISEFDataObjectListItem; reintroduce; + function Last: TEDISEFDataObjectListItem; reintroduce; + + function Add(EDISEFDataObject: TEDISEFDataObject; + Name: string = ''): TEDISEFDataObjectListItem; overload; + + function Insert(EDISEFDataObject, + BeforeEDISEFDataObject: TEDISEFDataObject): TEDISEFDataObjectListItem; overload; + + function FindItemByName(Name: string; + StartItem: TEDIObjectListItem = nil): TEDISEFDataObjectListItem; reintroduce; + function GetObjectByItemByName(Name: string): TEDISEFDataObject; + // + property EDISEFDataObject[Index: Integer]: TEDISEFDataObject read GetEDISEFDataObject + write SetEDISEFDataObject; default; + end; + + // EDI SEF Data Object Group + TEDISEFDataObjectGroup = class(TEDISEFDataObject) + private + function GetEDISEFDataObject(Index: Integer): TEDISEFDataObject; + function GetCount: Integer; + protected + FEDISEFDataObjects: TEDISEFDataObjectList; + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + + property EDISEFDataObject[Index: Integer]: TEDISEFDataObject read GetEDISEFDataObject; default; + published + property EDISEFDataObjects: TEDISEFDataObjectList read FEDISEFDataObjects; + property EDISEFDataObjectCount: Integer read GetCount; + end; + + // EDI SEF Repeating Pattern + TEDISEFRepeatingPattern = class(TEDISEFDataObjectGroup) + private + FBaseParent: TEDISEFDataObject; + FRepeatCount: Integer; + protected + procedure SetParent(const Value: TEDISEFDataObject); override; + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + function Clone(NewParent: TEDISEFDataObject): TEDISEFRepeatingPattern; reintroduce; + + function AddRepeatingPattern: TEDISEFRepeatingPattern; + function AppendRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; + function ExtractRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; + procedure DeleteRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern); + function InsertRepeatingPattern( + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; + function InsertRepeatingPattern(RepeatingPattern: TEDISEFRepeatingPattern; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; + + published + property BaseParent: TEDISEFDataObject read FBaseParent; + property RepeatCount: Integer read FRepeatCount write FRepeatCount; + end; + + // EDI SEF Text Objects + TEDISEFWhereType = (twUnknown, twSet, twSegment, twElementOrCompositeElement, twSubElement); + + TEDISEFText = class(TEDIObject) + private + FWhereLocation: TStringList; + function GetText: string; + procedure SetText(const Value: string); + function GetDescription: string; + function GetWhereLocation: TStrings; + protected + FData: string; + FEDISEFWhereType: TEDISEFWhereType; + FWhere: string; + FWhat: string; + FText: string; + function GetData: string; + procedure SetData(const Value: string); + function Assemble: string; virtual; + procedure Disassemble; virtual; + public + constructor Create; + destructor Destroy; override; + published + property Data: string read GetData write SetData; + property WhereLocation: TStrings read GetWhereLocation; + property Where: string read FWhere; + property What: string read FWhat; + property Text: string read GetText write SetText; + property Description: string read GetDescription; + end; + + TEDISEFTextSet = class(TEDISEFText) + private + FWhereSet: string; + FWhereSegment: Integer; // Ordinal + FWhereElement: Integer; // Ordinal + FWhereSubElement: Integer; // Ordinal + public + constructor Create; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + end; + + TEDISEFTextSets = class(TEDIObjectList) + public + function GetText(Code: string): string; + procedure SetText(EDISEFFile: TEDISEFFile; Location, Code, Text: string); + end; + + // EDI SEF Element + TEDISEFElement = class(TEDISEFDataObject) + protected + FUserAttribute: string; + FOrdinal: Integer; + FOutOfSequenceOrdinal: Boolean; + FElementType: string; + FMinimumLength: Integer; + FMaximumLength: Integer; + FRequirementDesignator: string; + FRepeatCount: Integer; + FEDISEFTextSets: TEDISEFTextSets; + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + procedure Assign(EDISEFElement: TEDISEFElement); + function Clone(NewParent: TEDISEFDataObject): TEDISEFElement; reintroduce; + function CloneAsSubElement(NewParent: TEDISEFDataObject): TEDISEFSubElement; + function GetTextSetsLocation: string; + procedure BindTextSets(TEXTSETS: TEDISEFTextSets); + published + property UserAttribute: string read FUserAttribute write FUserAttribute; + property Ordinal: Integer read FOrdinal write FOrdinal; + property OutOfSequenceOrdinal: Boolean read FOutOfSequenceOrdinal write FOutOfSequenceOrdinal; + property ElementId: string read FId write FId; + property ElementType: string read FElementType write FElementType; + property MinimumLength: Integer read FMinimumLength write FMinimumLength; + property MaximumLength: Integer read FMaximumLength write FMaximumLength; + property RequirementDesignator: string read FRequirementDesignator write FRequirementDesignator; + property RepeatCount: Integer read FRepeatCount write FRepeatCount; + property TextSetsLocation: string read GetTextSetsLocation; + // + property TEXTSETS: TEDISEFTextSets read FEDISEFTextSets; + end; + + TEDISEFSubElement = class(TEDISEFElement) + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + function Clone(NewParent: TEDISEFDataObject): TEDISEFSubElement; reintroduce; + end; + + TEDISEFCompositeElement = class(TEDISEFDataObjectGroup) + private + FUserAttribute: string; + FOrdinal: Integer; + FOutOfSequenceOrdinal: Boolean; + FRequirementDesignator: string; + FRepeatCount: Integer; + FExtendedData: string; + FEDISEFTextSets: TEDISEFTextSets; + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + procedure Assign(CompositeElement: TEDISEFCompositeElement); + function Clone(NewParent: TEDISEFDataObject): TEDISEFCompositeElement; reintroduce; + function GetElementObjectList: TObjectList; + procedure AssignElementOrdinals; + function GetTextSetsLocation: string; + procedure BindTextSets(TEXTSETS: TEDISEFTextSets); + + function AddSubElement: TEDISEFSubElement; + function AppendSubElement(SubElement: TEDISEFSubElement): TEDISEFSubElement; + function ExtractSubElement(SubElement: TEDISEFSubElement): TEDISEFSubElement; + procedure DeleteSubElement(SubElement: TEDISEFSubElement); + function InsertSubElement(BeforeObject: TEDISEFDataObject): TEDISEFSubElement; overload; + function InsertSubElement(SubElement: TEDISEFSubElement; + BeforeObject: TEDISEFDataObject): TEDISEFSubElement; overload; + + function AddRepeatingPattern: TEDISEFRepeatingPattern; + function AppendRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; + function ExtractRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; + procedure DeleteRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern); + function InsertRepeatingPattern( + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; + function InsertRepeatingPattern(RepeatingPattern: TEDISEFRepeatingPattern; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; + + published + property UserAttribute: string read FUserAttribute write FUserAttribute; + property Ordinal: Integer read FOrdinal write FOrdinal; + property OutOfSequenceOrdinal: Boolean read FOutOfSequenceOrdinal write FOutOfSequenceOrdinal; + property CompositeElementId: string read FId write FId; + property RequirementDesignator: string read FRequirementDesignator write FRequirementDesignator; + property RepeatCount: Integer read FRepeatCount write FRepeatCount; + property Elements: TEDISEFDataObjectList read FEDISEFDataObjects; + property TextSetsLocation: string read GetTextSetsLocation; + // + property TEXTSETS: TEDISEFTextSets read FEDISEFTextSets; + end; + + // EDI SEF Segment + TEDISEFSegment = class(TEDISEFDataObjectGroup) + private + FUserAttribute: string; + FPosition: Integer; + FPositionIncrement: Integer; + FResetPositionInc: Boolean; + FOrdinal: Integer; + FOutOfSequenceOrdinal: Boolean; + FRequirementDesignator: string; + FMaximumUse: Integer; + FOwnerLoopId: string; + FParentLoopId: string; + FParentSet: TEDISEFSet; + FParentTable: TEDISEFTable; + FEDISEFTextSets: TEDISEFTextSets; + FMaskNumber: Integer; + FMaskNumberSpecified: Boolean; + FExtendedData: string; + function GetOwnerLoopId: string; + function GetParentLoopId: string; + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + procedure Assign(Segment: TEDISEFSegment); + function Clone(NewParent: TEDISEFDataObject): TEDISEFSegment; reintroduce; + function GetElementObjectList: TObjectList; + procedure AssignElementOrdinals; + procedure BindElementTextSets; + function GetTextSetsLocation: string; + procedure BindTextSets(TEXTSETS: TEDISEFTextSets); + + function AddElement: TEDISEFElement; + function AppendElement(Element: TEDISEFElement): TEDISEFElement; + function ExtractElement(Element: TEDISEFElement): TEDISEFElement; + procedure DeleteElement(Element: TEDISEFElement); + function InsertElement(BeforeObject: TEDISEFDataObject): TEDISEFElement; overload; + function InsertElement(Element: TEDISEFElement; + BeforeObject: TEDISEFDataObject): TEDISEFElement; overload; + + function AddCompositeElement: TEDISEFCompositeElement; + function AppendCompositeElement( + CompositeElement: TEDISEFCompositeElement): TEDISEFCompositeElement; + function ExtractCompositeElement( + CompositeElement: TEDISEFCompositeElement): TEDISEFCompositeElement; + procedure DeleteCompositeElement( + CompositeElement: TEDISEFCompositeElement); + function InsertCompositeElement( + BeforeObject: TEDISEFDataObject): TEDISEFCompositeElement; overload; + function InsertCompositeElement(CompositeElement: TEDISEFCompositeElement; + BeforeObject: TEDISEFDataObject): TEDISEFCompositeElement; overload; + + function AddRepeatingPattern: TEDISEFRepeatingPattern; + function AppendRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; + function ExtractRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; + procedure DeleteRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern); + function InsertRepeatingPattern( + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; + function InsertRepeatingPattern(RepeatingPattern: TEDISEFRepeatingPattern; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; + + published + property UserAttribute: string read FUserAttribute write FUserAttribute; + property Position: Integer read FPosition write FPosition; + property PositionIncrement: Integer read FPositionIncrement write FPositionIncrement; + property ResetPositionInc: Boolean read FResetPositionInc write FResetPositionInc; + property Ordinal: Integer read FOrdinal write FOrdinal; + property OutOfSequenceOrdinal: Boolean read FOutOfSequenceOrdinal write FOutOfSequenceOrdinal; + property SegmentId: string read FId write FId; + property RequirementDesignator: string read FRequirementDesignator write FRequirementDesignator; + property MaximumUse: Integer read FMaximumUse write FMaximumUse; + property Elements: TEDISEFDataObjectList read FEDISEFDataObjects; + property OwnerLoopId: string read GetOwnerLoopId; + property ParentLoopId: string read GetParentLoopId; + property TextSetsLocation: string read GetTextSetsLocation; + property ParentSet: TEDISEFSet read FParentSet; + property ParentTable: TEDISEFTable read FParentTable; + // + property TEXTSETS: TEDISEFTextSets read FEDISEFTextSets; + end; + + // EDI SEF Loop + TEDISEFLoop = class(TEDISEFDataObjectGroup) + private + FMaximumRepeat: Integer; + function GetParentLoopId: string; + function GetParentSet: TEDISEFSet; + function GetParentTable: TEDISEFTable; + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + function Clone(NewParent: TEDISEFDataObject): TEDISEFLoop; reintroduce; + + function AddSegment: TEDISEFSegment; + function AppendSegment(Segment: TEDISEFSegment): TEDISEFSegment; + function ExtractSegment(Segment: TEDISEFSegment): TEDISEFSegment; + procedure DeleteSegment(Segment: TEDISEFSegment); + function InsertSegment(BeforeObject: TEDISEFDataObject): TEDISEFSegment; overload; + function InsertSegment(Segment: TEDISEFSegment; + BeforeObject: TEDISEFDataObject): TEDISEFSegment; overload; + + function AddLoop: TEDISEFLoop; + function AppendLoop(Loop: TEDISEFLoop): TEDISEFLoop; + function ExtractLoop(Loop: TEDISEFLoop): TEDISEFLoop; + procedure DeleteLoop(Loop: TEDISEFLoop); + function InsertLoop(BeforeObject: TEDISEFDataObject): TEDISEFLoop; overload; + function InsertLoop(Loop: TEDISEFLoop; + BeforeObject: TEDISEFDataObject): TEDISEFLoop; overload; + + published + property LoopId: string read FId write FId; + property MaximumRepeat: Integer read FMaximumRepeat write FMaximumRepeat; + property ParentLoopId: string read GetParentLoopId; + property ParentSet: TEDISEFSet read GetParentSet; + property ParentTable: TEDISEFTable read GetParentTable; + end; + + // EDI SEF Table + TEDISEFTable = class(TEDISEFDataObjectGroup) + private + function GetSEFSet: TEDISEFSet; + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + function Clone(NewParent: TEDISEFDataObject): TEDISEFTable; reintroduce; + + function AddSegment: TEDISEFSegment; + function AppendSegment(Segment: TEDISEFSegment): TEDISEFSegment; + function ExtractSegment(Segment: TEDISEFSegment): TEDISEFSegment; + procedure DeleteSegment(Segment: TEDISEFSegment); + function InsertSegment(BeforeObject: TEDISEFDataObject): TEDISEFSegment; overload; + function InsertSegment(Segment: TEDISEFSegment; + BeforeObject: TEDISEFDataObject): TEDISEFSegment; overload; + + function AddLoop: TEDISEFLoop; + function AppendLoop(Loop: TEDISEFLoop): TEDISEFLoop; + function ExtractLoop(Loop: TEDISEFLoop): TEDISEFLoop; + procedure DeleteLoop(Loop: TEDISEFLoop); + function InsertLoop(BeforeObject: TEDISEFDataObject): TEDISEFLoop; overload; + function InsertLoop(Loop: TEDISEFLoop; + BeforeObject: TEDISEFDataObject): TEDISEFLoop; overload; + + published + property SEFSet: TEDISEFSet read GetSEFSet; + end; + + // EDI SEF Set + TEDISEFSet = class(TEDISEFDataObjectGroup) + private + FEDISEFTextSets: TEDISEFTextSets; + function GetEDISEFTable(Index: Integer): TEDISEFTable; + procedure BuildSegmentObjectListFromLoop(ObjectList: TObjectList; Loop: TEDISEFLoop); + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + function Clone(NewParent: TEDISEFDataObject): TEDISEFSet; reintroduce; + function GetSegmentObjectList: TObjectList; + procedure AssignSegmentOrdinals; + procedure AssignSegmentPositions; + procedure BindSegmentTextSets; + function GetTextSetsLocation: string; + procedure BindTextSets(TEXTSETS: TEDISEFTextSets); + + function AddTable: TEDISEFTable; + function AppendTable(Table: TEDISEFTable): TEDISEFTable; + function ExtractTable(Table: TEDISEFTable): TEDISEFTable; + procedure DeleteTable(Table: TEDISEFTable); + function InsertTable(BeforeTable: TEDISEFTable): TEDISEFTable; overload; + function InsertTable(Table, BeforeTable: TEDISEFTable): TEDISEFTable; overload; + + property Table[Index: Integer]: TEDISEFTable read GetEDISEFTable; + published + property Tables: TEDISEFDataObjectList read FEDISEFDataObjects; + property TextSetsLocation: string read GetTextSetsLocation; + // + property TEXTSETS: TEDISEFTextSets read FEDISEFTextSets; + end; + + // EDI SEF File + TEDISEFFile = class(TEDISEFDataObject) + private + FFileName: string; + FEDISEFTextSets: TEDISEFTextSets; + FEDISEFCodesList: TStringList; + FEDISEFElms: TEDISEFDataObjectList; + FEDISEFComs: TEDISEFDataObjectList; + FEDISEFSegs: TEDISEFDataObjectList; + FEDISEFSets: TEDISEFDataObjectList; + FEDISEFStd: TStringList; + FEDISEFIni: TStringList; + FEDISEFVer: string; + procedure ParseTextSets; + procedure ParseCodes; + procedure ParseELMS; + procedure ParseCOMS; + procedure ParseSEGS; + procedure ParseSETS; + procedure ParseSTD; + procedure ParseINI; + procedure ParseVER; + // EDI JCL SEF Extensions + //procedure ParseELMSExt; + //procedure ParseCOMSExt; + //procedure ParseSEGSExt; + //procedure ParseSETSExt; + function GetEDISEFCodesList: TStrings; + function GetEDISEFStd: TStrings; + function GetEDISEFIni: TStrings; + public + constructor Create(Parent: TEDISEFDataObject); reintroduce; + destructor Destroy; override; + + procedure LoadFromFile; overload; + procedure LoadFromFile(const FileName: string); overload; + procedure SaveToFile; overload; + procedure SaveToFile(const FileName: string); overload; + procedure Unload; + + function Assemble: string; override; + procedure Disassemble; override; + + function Clone(NewParent: TEDISEFDataObject): TEDISEFFile; reintroduce; + published + property FileName: string read FFileName write FFileName; + property Codes: TStrings read GetEDISEFCodesList; + property ELMS: TEDISEFDataObjectList read FEDISEFElms; + property COMS: TEDISEFDataObjectList read FEDISEFComs; + property SEGS: TEDISEFDataObjectList read FEDISEFSegs; + property SETS: TEDISEFDataObjectList read FEDISEFSets; + property STD: TStrings read GetEDISEFStd; + property INI: TStrings read GetEDISEFIni; + property VER: string read FEDISEFVer write FEDISEFVer; + // + property TEXTSETS: TEDISEFTextSets read FEDISEFTextSets; + end; + +// Procedures +function GetEDISEFUserAttributeDescription( + Attribute: TEDISEFComsUserAttributes): string; overload; +function GetEDISEFUserAttributeDescription(Attribute: string): string; overload; + +procedure ParseELMSDataOfELMSDefinition(Data: string; Element: TEDISEFElement); +function CombineELMSDataOfELMSDefinition(Element: TEDISEFElement): string; +procedure ParseELMSDataOfCOMSDefinition(Data: string; Element: TEDISEFElement; + ELMSList: TEDISEFDataObjectList); +procedure ParseELMSDataOfSEGSDefinition(Data: string; Element: TEDISEFElement; + ELMSList: TEDISEFDataObjectList); +function CombineELMSDataOfCOMSorSEGSDefinition(Element: TEDISEFElement; + ELMSList: TEDISEFDataObjectList): string; + +procedure ParseCOMSDataOfCOMSDefinition(Data: string; CompositeElement: TEDISEFCompositeElement; + ELMSList: TEDISEFDataObjectList); +function CombineCOMSDataOfCOMSDefinition(CompositeElement: TEDISEFCompositeElement): string; +procedure ParseCOMSDataOfSEGSDefinition(Data: string; CompositeElement: TEDISEFCompositeElement; + COMSList: TEDISEFDataObjectList); +function CombineCOMSDataOfSEGSDefinition(CompositeElement: TEDISEFCompositeElement): string; + +procedure ParseSEGSDataOfSEGSDefinition(Data: string; Segment: TEDISEFSegment; + SEFFile: TEDISEFFile); +function CombineSEGSDataOfSEGSDefinition(Segment: TEDISEFSegment): string; +procedure ParseSEGSDataOfSETSDefinition(Data: string; Segment: TEDISEFSegment; + SEFFile: TEDISEFFile); +function CombineSEGSDataOfSETSDefinition(Segment: TEDISEFSegment): string; + +procedure ParseLoopDataOfSETSDefinition(Data: string; Loop: TEDISEFLoop; + SEFFile: TEDISEFFile); +procedure ParseTableDataOfSETSDefinition(Data: string; Table: TEDISEFTable; + SEFFile: TEDISEFFile); +procedure ParseSetsDataOfSETSDefinition(Data: string; ASet: TEDISEFSet; SEFFile: TEDISEFFile); + +procedure ExtractFromDataObjectGroup(DataObjectClass: TEDISEFDataObjectClass; + DataObjectGroup: TEDISEFDataObjectGroup; ObjectList: TObjectList); overload; + +procedure ExtractFromDataObjectGroup(DataObjectClasses: array of TEDISEFDataObjectClass; + DataObjectGroup: TEDISEFDataObjectGroup; ObjectList: TObjectList); overload; + +function AddSubElementTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFSubElement; +function AppendSubElementTo(DataObjectGroup: TEDISEFDataObjectGroup; + SubElement: TEDISEFSubElement): TEDISEFSubElement; +function ExtractSubElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + SubElement: TEDISEFSubElement): TEDISEFSubElement; +procedure DeleteSubElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + SubElement: TEDISEFSubElement); +function InsertSubElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFSubElement; overload; +function InsertSubElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + SubElement: TEDISEFSubElement; BeforeObject: TEDISEFDataObject): TEDISEFSubElement; overload; + +function AddElementTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFElement; +function AppendElementTo(DataObjectGroup: TEDISEFDataObjectGroup; + Element: TEDISEFElement): TEDISEFElement; +function ExtractElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Element: TEDISEFElement): TEDISEFElement; +procedure DeleteElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Element: TEDISEFElement); +function InsertElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFElement; overload; +function InsertElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + Element: TEDISEFElement; BeforeObject: TEDISEFDataObject): TEDISEFElement; overload; + +function AddRepeatingPatternTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFRepeatingPattern; +function AppendRepeatingPatternTo(DataObjectGroup: TEDISEFDataObjectGroup; + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +function ExtractRepeatingPatternFrom(DataObjectGroup: TEDISEFDataObjectGroup; + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +procedure DeleteRepeatingPatternFrom(DataObjectGroup: TEDISEFDataObjectGroup; + RepeatingPattern: TEDISEFRepeatingPattern); +function InsertRepeatingPatternInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; +function InsertRepeatingPatternInto(DataObjectGroup: TEDISEFDataObjectGroup; + RepeatingPattern: TEDISEFRepeatingPattern; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; + +function AddCompositeElementTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFCompositeElement; +function AppendCompositeElementTo(DataObjectGroup: TEDISEFDataObjectGroup; + CompositeElement: TEDISEFCompositeElement): TEDISEFCompositeElement; +function ExtractCompositeElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + CompositeElement: TEDISEFCompositeElement): TEDISEFCompositeElement; +procedure DeleteCompositeElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + CompositeElement: TEDISEFCompositeElement); +function InsertCompositeElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFCompositeElement; overload; +function InsertCompositeElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + CompositeElement: TEDISEFCompositeElement; + BeforeObject: TEDISEFDataObject): TEDISEFCompositeElement; overload; + +function AddSegmentTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFSegment; +function AppendSegmentTo(DataObjectGroup: TEDISEFDataObjectGroup; + Segment: TEDISEFSegment): TEDISEFSegment; +function ExtractSegmentFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Segment: TEDISEFSegment): TEDISEFSegment; +procedure DeleteSegmentFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Segment: TEDISEFSegment); +function InsertSegmentInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFSegment; overload; +function InsertSegmentInto(DataObjectGroup: TEDISEFDataObjectGroup; + Segment: TEDISEFSegment; BeforeObject: TEDISEFDataObject): TEDISEFSegment; overload; + +function AddLoopTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFLoop; +function AppendLoopTo(DataObjectGroup: TEDISEFDataObjectGroup; + Loop: TEDISEFLoop): TEDISEFLoop; +function ExtractLoopFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Loop: TEDISEFLoop): TEDISEFLoop; +procedure DeleteLoopFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Loop: TEDISEFLoop); +function InsertLoopInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFLoop; overload; +function InsertLoopInto(DataObjectGroup: TEDISEFDataObjectGroup; + Loop: TEDISEFLoop; BeforeObject: TEDISEFDataObject): TEDISEFLoop; overload; + +function AddTableTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFTable; +function AppendTableTo(DataObjectGroup: TEDISEFDataObjectGroup; + Table: TEDISEFTable): TEDISEFTable; +function ExtractTableFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Table: TEDISEFTable): TEDISEFTable; +procedure DeleteTableFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Table: TEDISEFTable); +function InsertTableInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFTable; overload; +function InsertTableInto(DataObjectGroup: TEDISEFDataObjectGroup; + Table: TEDISEFTable; BeforeObject: TEDISEFDataObject): TEDISEFTable; overload; + +implementation + +uses + JclResources, JclStrings; + +const + Value_Optional = 'O'; + Value_Conditional = 'C'; + Value_One = '1'; + Value_GreaterThanOne = '>1'; + Value_Version10 = '1.0'; + Value_QuestionMark = '?'; + + SEFDelimiter_EqualSign = '='; + SEFDelimiter_OpeningBrace = '{'; + SEFDelimiter_ClosingBrace = '}'; + SEFDelimiter_OpeningBracket = '['; + SEFDelimiter_ClosingBracket = ']'; + SEFDelimiter_AtSign = '@'; + SEFDelimiter_SemiColon = ';'; + SEFDelimiter_Colon = ':'; + SEFDelimiter_Comma = ','; + SEFDelimiter_Period = '.'; + SEFDelimiter_Caret = '^'; + SEFDelimiter_PlusSign = '+'; + SEFDelimiter_MinusSign = '-'; + SEFDelimiter_Asterisk = '*'; + +// Procedures +function GetEDISEFUserAttributeDescription(Attribute: TEDISEFComsUserAttributes): string; +begin + case Attribute of + caPeriod: + Result := EDISEFUserAttributePeriodDesc; + caExclamationPoint: + Result := EDISEFUserAttributeExclamationPointDesc; + caDollarSign: + Result := EDISEFUserAttributeDollarSignDesc; + caHyphen: + Result := EDISEFUserAttributeHyphenDesc; + caAmpersand: + Result := EDISEFUserAttributeAmpersandDesc; + else + Result := RsUnknownAttribute; + end; +end; + +function GetEDISEFUserAttributeDescription(Attribute: string): string; +begin + if Attribute = '' then + Attribute := Value_QuestionMark; + case Attribute[1] of + EDISEFUserAttributePeriod: + Result := EDISEFUserAttributePeriodDesc; + EDISEFUserAttributeExclamationPoint: + Result := EDISEFUserAttributeExclamationPointDesc; + EDISEFUserAttributeDollarSign: + Result := EDISEFUserAttributeDollarSignDesc; + EDISEFUserAttributeHyphen: + Result := EDISEFUserAttributeHyphenDesc; + EDISEFUserAttributeAmpersand: + Result := EDISEFUserAttributeAmpersandDesc; + else + Result := RsUnknownAttribute; + end; +end; + +procedure ParseELMSDataOfELMSDefinition(Data: string; Element: TEDISEFElement); +var + Temp: TStringList; +begin + // Clear any old values + Element.UserAttribute := ''; + Element.Ordinal := -1; + Element.ElementType := ''; + Element.MinimumLength := 0; + Element.MaximumLength := 0; + Element.RequirementDesignator := Value_Optional; + Element.RepeatCount := 1; + // + Temp := TStringList.Create; + try + Temp.Text := Data; + Element.Id := Temp.Names[0]; + {$IFDEF COMPILER7_UP} + Temp.CommaText := Temp.ValueFromIndex[0]; + {$ELSE} + Temp.CommaText := Temp.Values[Element.Id]; + {$ENDIF COMPILER7_UP} + if Temp.Count >= 1 then + Element.ElementType := Temp[0]; + if Temp.Count >= 2 then + Element.MinimumLength := StrToInt(Temp[1]); + if Temp.Count >= 3 then + Element.MaximumLength := StrToInt(Temp[2]); + finally + Temp.Free; + end; +end; + +function CombineELMSDataOfELMSDefinition(Element: TEDISEFElement): string; +begin + Result := Element.Id + SEFDelimiter_EqualSign + Element.ElementType + SEFDelimiter_Comma + + IntToStr(Element.MinimumLength) + SEFDelimiter_Comma + IntToStr(Element.MaximumLength); +end; + +procedure ParseELMSDataOfCOMSDefinition(Data: string; Element: TEDISEFElement; + ELMSList: TEDISEFDataObjectList); +var + I, J, K, L, M, N, O, P: Integer; + ListItem: TEDISEFDataObjectListItem; +begin + // Clear any old values + Element.UserAttribute := ''; + Element.Ordinal := -1; + Element.ElementType := ''; + Element.MinimumLength := 0; + Element.MaximumLength := 0; + Element.RequirementDesignator := Value_Optional; + Element.RepeatCount := 1; + // Parse User Attribute + if Data[1] in EDISEFUserAttributeSet then + begin + Element.UserAttribute := Data[1]; + I := 2; + end + else + I := 1; + // Get delimiter locations + J := StrSearch(SEFDelimiter_AtSign, Data, 1); + K := StrSearch(SEFDelimiter_SemiColon, Data, 1); + L := StrSearch(SEFDelimiter_Colon, Data, 1); + M := StrSearch(SEFDelimiter_Comma, Data, 1); + N := StrSearch(SEFDelimiter_Comma, Data, M + 1); + P := Length(Data) + 1; + // Parse Id using the closest delimiter + O := P; + if J <> 0 then + if O > J then + O := J; + if K <> 0 then + if O > K then + O := K; + if L <> 0 then + if O > L then + O := L; + if M <> 0 then + if O > M then + O := M; + Element.Id := Copy(Data, I, O - I); + // Get Default Values + if ELMSList <> nil then + begin + ListItem := ELMSList.FindItemByName(Element.Id); + if ListItem <> nil then + Element.Assign(TEDISEFElement(ListItem.EDISEFDataObject)); + end; + // Parse other attributes + if J <> 0 then + begin + Inc(J); + O := P; + if K <> 0 then + if O > K then + O := K; + if L <> 0 then + if O > L then + O := L; + if M <> 0 then + if O > M then + O := M; + if (O - J) > 0 then + Element.Ordinal := StrToInt(Copy(Data, J, O - J)); + end; + if K <> 0 then + begin + Inc(K); + O := P; + if L <> 0 then + if O > L then + O := L; + if M <> 0 then + if O > M then + O := M; + if (O - K) > 0 then + Element.MinimumLength := StrToInt(Copy(Data, K, O - K)); + end; + if L <> 0 then + begin + Inc(L); + O := P; + if M <> 0 then + if O > M then + O := M; + if (O - L) > 0 then + Element.MaximumLength := StrToInt(Copy(Data, L, O - L)); + end; + if M <> 0 then + begin + Inc(M); + O := P; + if N <> 0 then + if O > N then + O := N; + if (O - M) > 0 then + Element.RequirementDesignator := Copy(Data, M, O - M); + end; + if N <> 0 then + begin + Inc(N); + if (P - N) > 0 then + Element.RepeatCount := StrToInt(Copy(Data, N, 1)); + end; +end; + +function CombineELMSDataOfCOMSorSEGSDefinition(Element: TEDISEFElement; + ELMSList: TEDISEFDataObjectList): string; +var + CompareElement: TEDISEFElement; + ListItem: TEDISEFDataObjectListItem; +begin + if Element.UserAttribute <> '' then + Result := Result + Element.UserAttribute; + Result := Result + Element.Id; + if Element.OutOfSequenceOrdinal then + Result := Result + SEFDelimiter_AtSign + IntToStr(Element.Ordinal); + // Get Default Values + CompareElement := nil; + if ELMSList <> nil then + begin + ListItem := ELMSList.FindItemByName(Element.Id); + if ListItem <> nil then + CompareElement := TEDISEFElement(ListItem.EDISEFDataObject); + end; + // Test for changes in default values + if CompareElement <> nil then + begin + if (CompareElement.MinimumLength <> Element.MinimumLength) or + (CompareElement.MaximumLength <> Element.MaximumLength) then + begin + Result := Result + SEFDelimiter_SemiColon; + if CompareElement.MinimumLength <> Element.MinimumLength then + Result := Result + IntToStr(Element.MinimumLength); + Result := Result + SEFDelimiter_Colon; + if CompareElement.MaximumLength <> Element.MaximumLength then + Result := Result + IntToStr(Element.MaximumLength); + end; + end + else + begin + Result := Result + SEFDelimiter_SemiColon; + Result := Result + IntToStr(Element.MinimumLength); + Result := Result + SEFDelimiter_Colon; + Result := Result + IntToStr(Element.MaximumLength); + end; + if (Element.RequirementDesignator <> '') and + (Element.RequirementDesignator <> Value_Optional) then + Result := Result + SEFDelimiter_Comma + Element.RequirementDesignator; + if Element.RepeatCount > 1 then + begin + if (Element.RequirementDesignator = '') or + (Element.RequirementDesignator = Value_Optional) then + Result := Result + SEFDelimiter_Comma; + Result := Result + SEFDelimiter_Comma + IntToStr(Element.RepeatCount); + end; +end; + +procedure ParseELMSDataOfSEGSDefinition(Data: string; Element: TEDISEFElement; + ELMSList: TEDISEFDataObjectList); +var + I, J, K, L, M, N, O, P: Integer; + ListItem: TEDISEFDataObjectListItem; +begin + // Clear any old values + Element.UserAttribute := ''; + Element.Ordinal := -1; + Element.ElementType := ''; + Element.MinimumLength := 0; + Element.MaximumLength := 0; + Element.RequirementDesignator := Value_Optional; + Element.RepeatCount := 1; + // Parse User Attribute + if Data[1] in EDISEFUserAttributeSet then + begin + Element.UserAttribute := Data[1]; + I := 2; + end + else + I := 1; + // Get delimiter locations + J := StrSearch(SEFDelimiter_AtSign, Data, 1); + K := StrSearch(SEFDelimiter_SemiColon, Data, 1); + L := StrSearch(SEFDelimiter_Colon, Data, 1); + M := StrSearch(SEFDelimiter_Comma, Data, 1); + N := StrSearch(SEFDelimiter_Comma, Data, M + 1); + P := Length(Data) + 1; + // Parse Id + O := P; + if J <> 0 then + if O > J then + O := J; + if K <> 0 then + if O > K then + O := K; + if L <> 0 then + if O > L then + O := L; + if M <> 0 then + if O > M then + O := M; + Element.Id := Copy(Data, I, O - I); + // Get Default Values + if ELMSList <> nil then + begin + ListItem := ELMSList.FindItemByName(Element.Id); + if ListItem <> nil then + Element.Assign(TEDISEFElement(ListItem.EDISEFDataObject)); + end; + // Parse other attributes + if J <> 0 then + begin + Inc(J); + O := P; + if K <> 0 then + if O > K then + O := K; + if L <> 0 then + if O > L then + O := L; + if M <> 0 then + if O > M then + O := M; + if (O - J) > 0 then + Element.Ordinal := StrToInt(Copy(Data, J, O - J)); + end; + if K <> 0 then + begin + Inc(K); + O := P; + if L <> 0 then + if O > L then + O := L; + if M <> 0 then + if O > M then + O := M; + if (O - K) > 0 then + Element.MinimumLength := StrToInt(Copy(Data, K, O - K)); + end; + if L <> 0 then + begin + Inc(L); + O := P; + if M <> 0 then + if O > M then + O := M; + if (O - L) > 0 then + Element.MaximumLength := StrToInt(Copy(Data, L, O - L)); + end; + if M <> 0 then + begin + Inc(M); + O := P; + if N <> 0 then + if O > N then + O := N; + if (O - M) > 0 then + Element.RequirementDesignator := Copy(Data, M, O - M); + end; + if N <> 0 then + begin + Inc(N); + if (P - N) > 0 then + Element.RepeatCount := StrToInt(Copy(Data, N, 1)); + end; +end; + +// Parse TEDISEFCompositeElement or Repeating Pattern in TEDISEFCompositeElement + +procedure InternalParseCOMSDataOfCOMSDefinition(Data: string; Element: TEDISEFDataObjectGroup; + ELMSList: TEDISEFDataObjectList); +var + I, J, K, L, M, N: Integer; + RepeatCount: Integer; + RepeatData: string; + SubElement: TEDISEFSubElement; + RepeatingPattern: TEDISEFRepeatingPattern; +begin + I := StrSearch(SEFDelimiter_EqualSign, Data, 1); + if (I > 0) and (Element is TEDISEFCompositeElement) then + begin + Element.EDISEFDataObjects.Clear; + Element.Id := Copy(Data, 1, I - 1); + end; + Inc(I); + M := I; + while I > 0 do + begin + // Start search + I := StrSearch(SEFDelimiter_OpeningBracket, Data, M); + if I = 0 then + Break; + J := StrSearch(SEFDelimiter_ClosingBracket, Data, M); + K := StrSearch(SEFDelimiter_OpeningBrace, Data, M); + L := StrSearch(SEFDelimiter_ClosingBrace, Data, M); + // Determine if data block to process is a repetition + if (I < K) or (K = 0) then // Normal data block + begin + SubElement := AddSubElementTo(Element); + SubElement.Data := Copy(Data, I + 1, (J - I) - 1); + SubElement.Disassemble; + M := J + 1; + end + else // Repeating data block (K = 1 on the first pass) + begin + // Get repeat count + N := StrSearch(SEFDelimiter_OpeningBracket, Data, K); + RepeatCount := StrToInt(Copy(Data, K + 1, (N - K) - 1)); + // Correct start position + K := StrSearch(SEFDelimiter_OpeningBracket, Data, K); + // Validate end position + N := StrSearch(SEFDelimiter_OpeningBrace, Data, K + 1); + while (N <> 0) and (N < L) do // Detect nested repetition + begin + N := StrSearch(SEFDelimiter_OpeningBrace, Data, N + 1); // Search for nested repetition + L := StrSearch(SEFDelimiter_ClosingBrace, Data, L + 1); // Correct end position + end; + // Copy data for repetition + RepeatData := Copy(Data, K, L - K); + M := L + 1; + // Handle Repeating Data Block + RepeatingPattern := AddRepeatingPatternTo(Element); + RepeatingPattern.RepeatCount := RepeatCount; + RepeatingPattern.Data := RepeatData; + RepeatingPattern.Disassemble; + end; + end; + // Store Currently Unused Data + if (M <= Length(Data)) and (Element is TEDISEFCompositeElement) then + TEDISEFCompositeElement(Element).FExtendedData := Copy(Data, M, (Length(Data) - M) + 1); +end; + +procedure ParseCOMSDataOfCOMSDefinition(Data: string; CompositeElement: TEDISEFCompositeElement; + ELMSList: TEDISEFDataObjectList); +begin + InternalParseCOMSDataOfCOMSDefinition(Data, CompositeElement, ELMSList); +end; + +function CombineCOMSDataOfCOMSDefinition(CompositeElement: TEDISEFCompositeElement): string; +var + ListItem: TEDISEFDataObjectListItem; +begin + Result := CompositeElement.Id + SEFDelimiter_EqualSign; + ListItem := CompositeElement.EDISEFDataObjects.First; + while ListItem <> nil do + begin + if not (ListItem.EDIObject is TEDISEFRepeatingPattern) then + Result := Result + SEFDelimiter_OpeningBracket + ListItem.EDISEFDataObject.Assemble + + SEFDelimiter_ClosingBracket + else + Result := Result + SEFDelimiter_OpeningBrace + ListItem.EDISEFDataObject.Assemble + + SEFDelimiter_ClosingBrace; + ListItem := ListItem.NextItem; + end; + Result := Result + CompositeElement.FExtendedData; +end; + +procedure ParseCOMSDataOfSEGSDefinition(Data: string; CompositeElement: TEDISEFCompositeElement; + COMSList: TEDISEFDataObjectList); +var + Temp: TStringList; + ListItem: TEDISEFDataObjectListItem; + DefaultCompositeElement: TEDISEFCompositeElement; +begin + CompositeElement.EDISEFDataObjects.Clear; + Temp := TStringList.Create; + try + Temp.CommaText := Data; + if Temp.Count >= 1 then + CompositeElement.Id := Temp[0]; + ListItem := COMSList.FindItemByName(CompositeElement.Id); + if (ListItem <> nil) and (ListItem.EDISEFDataObject <> nil) then + begin + DefaultCompositeElement := TEDISEFCompositeElement(ListItem.EDISEFDataObject); + CompositeElement.Assign(DefaultCompositeElement); + end; + if Temp.Count >= 2 then + CompositeElement.RequirementDesignator := Temp[1]; + finally + Temp.Free; + end; +end; + +function CombineCOMSDataOfSEGSDefinition(CompositeElement: TEDISEFCompositeElement): string; +begin + if CompositeElement.UserAttribute <> '' then + Result := Result + CompositeElement.UserAttribute; + Result := Result + CompositeElement.Id; + if CompositeElement.OutOfSequenceOrdinal then + Result := Result + SEFDelimiter_AtSign + IntToStr(CompositeElement.Ordinal); + if (CompositeElement.RequirementDesignator <> '') and + (CompositeElement.RequirementDesignator <> Value_Optional) then + begin + Result := Result + SEFDelimiter_Comma + CompositeElement.RequirementDesignator; + end; +end; + +// Parse TEDISEFSegment or Repeating Pattern in TEDISEFSegment + +procedure InternalParseSEGSDataOfSEGSDefinition(Data: string; Segment: TEDISEFDataObjectGroup; + SEFFile: TEDISEFFile); +var + I, J, K, L, M, N: Integer; + ElementData: string; + RepeatCount: Integer; + RepeatData: string; + Element: TEDISEFElement; + CompositeElement: TEDISEFCompositeElement; + RepeatingPattern: TEDISEFRepeatingPattern; +begin + I := StrSearch(SEFDelimiter_EqualSign, Data, 1); + if (I > 0) and (Segment is TEDISEFSegment) then + begin + Segment.EDISEFDataObjects.Clear; + Segment.Id := Copy(Data, 1, I - 1); + TEDISEFSegment(Segment).RequirementDesignator := Value_Optional; + TEDISEFSegment(Segment).MaximumUse := 1; + end; + Inc(I); + M := I; + while I > 0 do + begin + // Start search + I := StrSearch(SEFDelimiter_OpeningBracket, Data, M); + if I = 0 then + Break; + J := StrSearch(SEFDelimiter_ClosingBracket, Data, M); + K := StrSearch(SEFDelimiter_OpeningBrace, Data, M); + L := StrSearch(SEFDelimiter_ClosingBrace, Data, M); + // Determine if data block to process is a repetition + if (I < K) or (K = 0) then // Normal data block + begin + ElementData := Copy(Data, I + 1, (J - I) - 1); + if ElementData[1] = Value_Conditional then + begin + CompositeElement := AddCompositeElementTo(Segment); + CompositeElement.SEFFile := SEFFile; + CompositeElement.Data := ElementData; + CompositeElement.Disassemble; + end + else + begin + Element := AddElementTo(Segment); + Element.SEFFile := SEFFile; + Element.Data := ElementData; + Element.Disassemble; + end; + M := J + 1; + end + else // Repeating data block (K = 1 on the first pass) + begin + // Get repeat count + N := StrSearch(SEFDelimiter_OpeningBracket, Data, K); + RepeatCount := StrToInt(Copy(Data, K + 1, (N - K) - 1)); + // Correct start position + K := StrSearch(SEFDelimiter_OpeningBracket, Data, K); + // Validate end position + N := StrSearch(SEFDelimiter_OpeningBrace, Data, K + 1); + while (N <> 0) and (N < L) do // Detect nested repetition + begin + N := StrSearch(SEFDelimiter_OpeningBrace, Data, N + 1); // Search for nested repetition + L := StrSearch(SEFDelimiter_ClosingBrace, Data, L + 1); // Correct end position + end; + // Copy data for repetition + RepeatData := Copy(Data, K, L - K); + M := L + 1; + // Handle Repeating Data Block + RepeatingPattern := AddRepeatingPatternTo(Segment); + RepeatingPattern.RepeatCount := RepeatCount; + RepeatingPattern.Data := RepeatData; + RepeatingPattern.Disassemble; + end; + end; + // Store Currently Unused Data + if (M <= Length(Data)) and (Segment is TEDISEFSegment) then + TEDISEFSegment(Segment).FExtendedData := Copy(Data, M, (Length(Data) - M) + 1); +end; + +procedure ParseSEGSDataOfSEGSDefinition(Data: string; Segment: TEDISEFSegment; + SEFFile: TEDISEFFile); +begin + InternalParseSEGSDataOfSEGSDefinition(Data, Segment, SEFFile); +end; + +function CombineSEGSDataOfSEGSDefinition(Segment: TEDISEFSegment): string; +var + ListItem: TEDISEFDataObjectListItem; +begin + Result := Segment.Id + SEFDelimiter_EqualSign; + ListItem := Segment.EDISEFDataObjects.First; + while ListItem <> nil do + begin + if not (ListItem.EDISEFDataObject is TEDISEFRepeatingPattern) then + Result := Result + SEFDelimiter_OpeningBracket + ListItem.EDISEFDataObject.Assemble + + SEFDelimiter_ClosingBracket + else + Result := Result + SEFDelimiter_OpeningBrace + ListItem.EDISEFDataObject.Assemble + + SEFDelimiter_ClosingBrace; + ListItem := ListItem.NextItem; + end; + Result := Result + Segment.FExtendedData; +end; + +procedure ParseSEGSDataOfSETSDefinition(Data: string; Segment: TEDISEFSegment; + SEFFile: TEDISEFFile); + + {$IFNDEF CLR} + function ToPChar(const S: string): PChar; + begin + Result := PChar(S); + end; + {$ELSE} + function ToPChar(const S: string): string; + var + I: Integer; + begin + for I := 1 to Length(S) do + if S[I] = #0 then + begin + Result := Copy(S, 1, I - 1); + Exit; + end; + Result := S; + end; + {$ENDIF ~CLR} + +var + Temp: TStringList; + ListItem: TEDISEFDataObjectListItem; + SegmentDef: TEDISEFSegment; + I, J, K: Integer; +begin + Segment.UserAttribute := ''; + Segment.Ordinal := -1; + Segment.RequirementDesignator := Value_Optional; + Segment.MaximumUse := 1; + Segment.EDISEFDataObjects.Clear; + Temp := TStringList.Create; + try + Temp.CommaText := Data; + if Temp.Count >= 1 then + begin + I := 1; + // Parse User Attribute + if Temp[0][1] in EDISEFUserAttributeSet then + begin + Segment.UserAttribute := Temp[0][1]; + I := 2; + end; + J := StrSearch(SEFDelimiter_Asterisk, Temp[0], 1); + K := StrSearch(SEFDelimiter_AtSign, Temp[0], 1); + // Parse Mask Number + if J <> 0 then + begin + Segment.FMaskNumberSpecified := True; + if K = 0 then + Segment.FMaskNumber := StrToInt(Copy(ToPChar(Temp[0]), J + 1, Length(ToPChar(Temp[0])) - J)) + else + Segment.FMaskNumber := StrToInt(Copy(ToPChar(Temp[0]), J + 1, (K - J) - 1)); + end; + // Parse Explicitly Assigned Ordinal + if K <> 0 then + Segment.Ordinal := StrToInt(Copy(ToPChar(Temp[0]), K + 1, Length(ToPChar(Temp[0])) - K)); + // Parse Segment Id + if (J = 0) and (K = 0) then + begin + if I = 1 then + Segment.Id := Temp[0] + else // Had to cast Temp[0] as PChar here because of a bug during runtime + Segment.Id := Copy(ToPChar(Temp[0]), I, Length(ToPChar(Temp[0])) - 1); + end + else + begin + K := Length(ToPChar(Temp[0])) - 1; + if (J < K) and (J <> 0) then + K := J; + Segment.Id := Copy(ToPChar(Temp[0]), I, K - I); + end; + end; + ListItem := SEFFile.SEGS.FindItemByName(Segment.Id); + if (ListItem <> nil) and (ListItem.EDISEFDataObject <> nil) then + begin + SegmentDef := TEDISEFSegment(ListItem.EDISEFDataObject); + Segment.Assign(SegmentDef); + end; + if Temp.Count >= 2 then + begin + if Temp[1] = '' then + Temp[1] := Value_Optional; + Segment.RequirementDesignator := Temp[1]; + end; + if Temp.Count >= 3 then + begin + if Temp[2] = Value_GreaterThanOne then + Temp[2] := IntToStr(Value_UndefinedMaximum); + Segment.MaximumUse := StrToInt(Temp[2]); + end; + finally + Temp.Free; + end; +end; + +function CombineSEGSDataOfSETSDefinition(Segment: TEDISEFSegment): string; +begin + if Segment.UserAttribute <> '' then + Result := Result + Segment.UserAttribute; + Result := Result + Segment.Id; + if Segment.FMaskNumberSpecified then + Result := Result + SEFDelimiter_Asterisk + IntToStr(Segment.FMaskNumber); + if Segment.OutOfSequenceOrdinal then + Result := Result + SEFDelimiter_AtSign + IntToStr(Segment.Ordinal); + if (Segment.RequirementDesignator <> '') and + (Segment.RequirementDesignator <> Value_Optional) then + Result := Result + SEFDelimiter_Comma + Segment.RequirementDesignator; + if Segment.MaximumUse > 1 then + begin + if (Segment.RequirementDesignator = '') or + (Segment.RequirementDesignator = Value_Optional) then + Result := Result + SEFDelimiter_Comma; + if Segment.MaximumUse >= Value_UndefinedMaximum then + Result := Result + SEFDelimiter_Comma + Value_GreaterThanOne + else + Result := Result + SEFDelimiter_Comma + IntToStr(Segment.MaximumUse); + end; +end; + +procedure ParseLoopDataOfSETSDefinition(Data: string; Loop: TEDISEFLoop; + SEFFile: TEDISEFFile); +var + I, J, K, L, M, N: Integer; + SegmentData: string; + PositionIncrement: string; + RepeatCount: Integer; + LoopId, RepeatData: string; + Segment: TEDISEFSegment; + NestedLoop: TEDISEFLoop; + ListItem: TEDISEFDataObjectListItem; +begin + Loop.EDISEFDataObjects.Clear; + I := 1; + M := I; + // Search for Loops and Segments + while I > 0 do + begin + // Start search + I := StrSearch(SEFDelimiter_OpeningBracket, Data, M); + if I = 0 then + Break; + J := StrSearch(SEFDelimiter_ClosingBracket, Data, M); + K := StrSearch(SEFDelimiter_OpeningBrace, Data, M); + L := StrSearch(SEFDelimiter_ClosingBrace, Data, M); + // Determine if data block to process is a repetition + if (I < K) or (K = 0) then // Normal data block + begin + L := M; + M := StrSearch(SEFDelimiter_PlusSign, Data, L); + N := StrSearch(SEFDelimiter_MinusSign, Data, L); + L := 0; + if (M < I) and (M <> 0) then + L := M; + if (N < I) and (N <> 0) then + L := N; + if L <> 0 then + PositionIncrement := Copy(Data, L, (I - L)); + + SegmentData := Copy(Data, I + 1, (J - I) - 1); + // + Segment := Loop.AddSegment; + Segment.SEFFile := SEFFile; + if L <> 0 then + begin + Segment.ResetPositionInc := True; + Segment.PositionIncrement := StrToInt(PositionIncrement); + end; + Segment.Data := SegmentData; + Segment.Disassemble; + if Loop.Id = '' then + Loop.Id := Segment.Id; + M := J + 1; + end + else // Repeating data block (K = 1 on the first pass) + begin + N := StrSearch(SEFDelimiter_OpeningBracket, Data, K); + J := StrSearch(SEFDelimiter_PlusSign, Data, K); + M := StrSearch(SEFDelimiter_MinusSign, Data, K); + // Adjustments + if (J < N) and (J <> 0) then + N := J; + if (M < N) and (M <> 0) then + N := M; + // Get Loop Id: :+[]..." + RepeatData := Copy(Data, K + 1, (N - K) - 1); + J := StrSearch(SEFDelimiter_Colon, RepeatData, 1); + if J = 0 then + begin + LoopId := RepeatData; + RepeatData := ''; + end + else + begin + LoopId := Copy(RepeatData, 1, J - 1); + RepeatData := Copy(RepeatData, J + 1, Length(RepeatData) - J); + end; + // Get Repeat Count + if RepeatData = Value_GreaterThanOne then + RepeatData := IntToStr(Value_UndefinedMaximum); + if RepeatData = '' then + RepeatData := Value_One; + RepeatCount := StrToInt(RepeatData); + // Correct start position + K := N; + // Validate end position + N := StrSearch(SEFDelimiter_OpeningBrace, Data, K + 1); + while (N <> 0) and (N < L) do // Detect nested repetition + begin + N := StrSearch(SEFDelimiter_OpeningBrace, Data, N + 1); // Search for nested repetition + L := StrSearch(SEFDelimiter_ClosingBrace, Data, L + 1); // Correct end position + end; + // Copy data for repetition + RepeatData := Copy(Data, K, L - K); + // + M := L + 1; + // Create Loop Object + NestedLoop := Loop.AddLoop; + NestedLoop.SEFFile := SEFFile; + NestedLoop.LoopId := LoopId; + NestedLoop.MaximumRepeat := RepeatCount; + NestedLoop.Data := RepeatData; + NestedLoop.Disassemble; + if NestedLoop.LoopId = '' then + begin + ListItem := NestedLoop.EDISEFDataObjects.First; + NestedLoop.LoopId := ListItem.EDISEFDataObject.Id; + end; + end; + end; +end; + +procedure ParseTableDataOfSETSDefinition(Data: string; Table: TEDISEFTable; + SEFFile: TEDISEFFile); +var + I, J, K, L, M, N: Integer; + SegmentData: string; + PositionIncrement: string; + RepeatCount: Integer; + LoopId, RepeatData: string; + Segment: TEDISEFSegment; + Loop: TEDISEFLoop; + ListItem: TEDISEFDataObjectListItem; +begin + Table.EDISEFDataObjects.Clear; + I := 1; + M := I; + // Search for Loops and Segments + while I > 0 do + begin + // Start search + I := StrSearch(SEFDelimiter_OpeningBracket, Data, M); + if I = 0 then + Break; + J := StrSearch(SEFDelimiter_ClosingBracket, Data, M); + K := StrSearch(SEFDelimiter_OpeningBrace, Data, M); + L := StrSearch(SEFDelimiter_ClosingBrace, Data, M); + // Determine if data block to process is a repetition + if (I < K) or (K = 0) then // Normal data block + begin + L := M; + M := StrSearch(SEFDelimiter_PlusSign, Data, L); + N := StrSearch(SEFDelimiter_MinusSign, Data, L); + L := 0; + if (M < I) and (M <> 0) then + L := M; + if (N < I) and (N <> 0) then + L := N; + if L <> 0 then + PositionIncrement := Copy(Data, L, (I - L)); + + SegmentData := Copy(Data, I + 1, (J - I) - 1); + // + Segment := Table.AddSegment; + Segment.SEFFile := SEFFile; + if L <> 0 then + begin + Segment.ResetPositionInc := True; + Segment.PositionIncrement := StrToInt(PositionIncrement); + end; + Segment.Data := SegmentData; + Segment.Disassemble; + M := J + 1; + end + else // Repeating data block (K = 1 on the first pass) + begin + N := StrSearch(SEFDelimiter_OpeningBracket, Data, K); + J := StrSearch(SEFDelimiter_PlusSign, Data, K); + M := StrSearch(SEFDelimiter_MinusSign, Data, K); + // Adjustments - N becomes the start position of RepeatData + if (J < N) and (J <> 0) then + N := J; + if (M < N) and (M <> 0) then + N := M; + // Get Loop Id: {:<+or->[]..." + RepeatData := Copy(Data, K + 1, (N - K) - 1); + J := StrSearch(SEFDelimiter_Colon, RepeatData, 1); + if J = 0 then + begin + LoopId := RepeatData; + RepeatData := ''; + end + else + begin + LoopId := Copy(RepeatData, 1, J - 1); + RepeatData := Copy(RepeatData, J + 1, Length(RepeatData) - J); + end; + // Get Repeat Count + if RepeatData = Value_GreaterThanOne then + RepeatData := IntToStr(Value_UndefinedMaximum); + if RepeatData = '' then + RepeatData := Value_One; + RepeatCount := StrToInt(RepeatData); + // Correct start position (Move to first "<+or->[]") + K := N; + // Validate end position + N := StrSearch(SEFDelimiter_OpeningBrace, Data, K + 1); + while (N <> 0) and (N < L) do // Detect nested repetition + begin + N := StrSearch(SEFDelimiter_OpeningBrace, Data, N + 1); // Search for nested repetition + L := StrSearch(SEFDelimiter_ClosingBrace, Data, L + 1); // Correct end position + end; + // Copy data for repetition + RepeatData := Copy(Data, K, L - K); + // + M := L + 1; + // Create Loop Object + Loop := Table.AddLoop; + Loop.SEFFile := SEFFile; + Loop.LoopId := LoopId; + Loop.MaximumRepeat := RepeatCount; + Loop.Data := RepeatData; + Loop.Disassemble; + if Loop.LoopId = '' then + begin + ListItem := Loop.EDISEFDataObjects.First; + Loop.LoopId := ListItem.EDISEFDataObject.Id; + end; + end; + end; +end; + +procedure ParseSetsDataOfSETSDefinition(Data: string; ASet: TEDISEFSet; SEFFile: TEDISEFFile); +var + I, J: Integer; + Table: TEDISEFTable; + TableData: string; +begin + ASet.EDISEFDataObjects.Clear; + I := StrSearch(SEFDelimiter_EqualSign, Data, 1); + ASet.Id := Copy(Data, 1, I - 1); + while I > 0 do + begin + // Start search + I := StrSearch(SEFDelimiter_Caret, Data, I); + J := StrSearch(SEFDelimiter_Caret, Data, I + 1); + if I = 0 then + begin + Table := ASet.AddTable; + Table.Data := Data; + Table.Disassemble; + end + else + begin + if J = 0 then + begin + TableData := Copy(Data, I + 1, Length(Data) - I); + I := 0; + end + else + begin + TableData := Copy(Data, I + 1, J - (I + 1)); + I := J; + end; + Table := ASet.AddTable; + Table.Data := TableData; + Table.Disassemble; + end; + end; +end; + +procedure ExtractFromDataObjectGroup(DataObjectClass: TEDISEFDataObjectClass; + DataObjectGroup: TEDISEFDataObjectGroup; ObjectList: TObjectList); +var + ListItem: TEDISEFDataObjectListItem; + RepeatingPattern: TEDISEFRepeatingPattern; +begin + ListItem := DataObjectGroup.EDISEFDataObjects.First; + while ListItem <> nil do + begin + if ListItem.EDISEFDataObject is DataObjectClass then + ObjectList.Add(ListItem.EDISEFDataObject) + else + if ListItem.EDISEFDataObject is TEDISEFRepeatingPattern then + begin + RepeatingPattern := TEDISEFRepeatingPattern(ListItem.EDISEFDataObject); + ExtractFromDataObjectGroup(DataObjectClass, RepeatingPattern, ObjectList); + end; + ListItem := ListItem.NextItem; + end; +end; + +procedure ExtractFromDataObjectGroup(DataObjectClasses: array of TEDISEFDataObjectClass; + DataObjectGroup: TEDISEFDataObjectGroup; ObjectList: TObjectList); overload; +var + ClassCount: Integer; + ListItem: TEDISEFDataObjectListItem; + J: Integer; + ClassMatch: Boolean; + RepeatingPattern: TEDISEFRepeatingPattern; +begin + ClassCount := Length(DataObjectClasses); + ListItem := DataObjectGroup.EDISEFDataObjects.First; + while ListItem <> nil do + begin + ClassMatch := False; + for J := 0 to ClassCount - 1 do + begin + if ListItem.EDISEFDataObject is DataObjectClasses[J] then + begin + ClassMatch := True; + Break; + end; + end; + if ClassMatch then + ObjectList.Add(ListItem.EDISEFDataObject) + else + if ListItem.EDISEFDataObject is TEDISEFRepeatingPattern then + begin + RepeatingPattern := TEDISEFRepeatingPattern(ListItem.EDISEFDataObject); + ExtractFromDataObjectGroup(DataObjectClasses, RepeatingPattern, ObjectList); + end; + ListItem := ListItem.NextItem; + end; +end; + +function AddSubElementTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFSubElement; +begin + Result := TEDISEFSubElement.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Add(Result); +end; + +function AppendSubElementTo(DataObjectGroup: TEDISEFDataObjectGroup; + SubElement: TEDISEFSubElement): TEDISEFSubElement; +begin + if SubElement <> nil then + begin + // Be sure the object will be managed by the current object + if (SubElement.Parent is TEDISEFDataObjectGroup) and + (SubElement.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(SubElement.Parent).EDISEFDataObjects do + begin + Extract(SubElement); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + SubElement.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Add(SubElement, SubElement.Id); + // Return appended object + Result := SubElement; + end + else // Do not allow nil item objects + Result := AddSubElementTo(DataObjectGroup); +end; + +function ExtractSubElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + SubElement: TEDISEFSubElement): TEDISEFSubElement; +begin + Result := TEDISEFSubElement(DataObjectGroup.EDISEFDataObjects.Extract(SubElement)); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +procedure DeleteSubElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + SubElement: TEDISEFSubElement); +begin + DataObjectGroup.EDISEFDataObjects.Remove(SubElement); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertSubElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFSubElement; overload; +begin + Result := TEDISEFSubElement.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Insert(Result, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertSubElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + SubElement: TEDISEFSubElement; BeforeObject: TEDISEFDataObject): TEDISEFSubElement; overload; +begin + if SubElement <> nil then + begin + // Be sure the object will be managed by the current object + if (SubElement.Parent is TEDISEFDataObjectGroup) and + (SubElement.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(SubElement.Parent).EDISEFDataObjects do + begin + Extract(SubElement); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + SubElement.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Insert(SubElement, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions + // Return appended object + Result := SubElement; + end + else // Do not allow nil item objects + Result := InsertSubElementInto(DataObjectGroup, BeforeObject); +end; + +function AddElementTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFElement; +begin + Result := TEDISEFElement.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Add(Result); +end; + +function AppendElementTo(DataObjectGroup: TEDISEFDataObjectGroup; + Element: TEDISEFElement): TEDISEFElement; +begin + if Element <> nil then + begin + // Be sure the object will be managed by the current object + if (Element.Parent is TEDISEFDataObjectGroup) and + (Element.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(Element.Parent).EDISEFDataObjects do + begin + Extract(Element); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + Element.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Add(Element, Element.Id); + // Return appended object + Result := Element; + end + else // Do not allow nil item objects + Result := AddElementTo(DataObjectGroup); +end; + +function ExtractElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Element: TEDISEFElement): TEDISEFElement; +begin + Result := TEDISEFElement(DataObjectGroup.EDISEFDataObjects.Extract(Element)); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +procedure DeleteElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Element: TEDISEFElement); +begin + DataObjectGroup.EDISEFDataObjects.Remove(Element); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFElement; overload; +begin + Result := TEDISEFElement.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Insert(Result, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + Element: TEDISEFElement; BeforeObject: TEDISEFDataObject): TEDISEFElement; overload; +begin + if Element <> nil then + begin + // Be sure the object will be managed by the current object + if (Element.Parent is TEDISEFDataObjectGroup) and + (Element.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(Element.Parent).EDISEFDataObjects do + begin + Extract(Element); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + Element.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Insert(Element, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions + // Return appended object + Result := Element; + end + else // Do not allow nil item objects + Result := InsertElementInto(DataObjectGroup, BeforeObject); +end; + +function AddRepeatingPatternTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFRepeatingPattern; +begin + Result := TEDISEFRepeatingPattern.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Add(Result); +end; + +function AppendRepeatingPatternTo(DataObjectGroup: TEDISEFDataObjectGroup; + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +begin + if RepeatingPattern <> nil then + begin + // Be sure the object will be managed by the current object + if (RepeatingPattern.Parent is TEDISEFDataObjectGroup) and + (RepeatingPattern.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(RepeatingPattern.Parent).EDISEFDataObjects do + begin + Extract(RepeatingPattern); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + RepeatingPattern.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Add(RepeatingPattern, RepeatingPattern.Id); + // Return appended object + Result := RepeatingPattern; + end + else // Do not allow nil item objects + Result := AddRepeatingPatternTo(DataObjectGroup); +end; + +function ExtractRepeatingPatternFrom(DataObjectGroup: TEDISEFDataObjectGroup; + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +begin + Result := TEDISEFRepeatingPattern(DataObjectGroup.EDISEFDataObjects.Extract(RepeatingPattern)); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +procedure DeleteRepeatingPatternFrom(DataObjectGroup: TEDISEFDataObjectGroup; + RepeatingPattern: TEDISEFRepeatingPattern); +begin + DataObjectGroup.EDISEFDataObjects.Remove(RepeatingPattern); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertRepeatingPatternInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; +begin + Result := TEDISEFRepeatingPattern.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Insert(Result, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertRepeatingPatternInto(DataObjectGroup: TEDISEFDataObjectGroup; + RepeatingPattern: TEDISEFRepeatingPattern; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; overload; +begin + if RepeatingPattern <> nil then + begin + // Be sure the object will be managed by the current object + if (RepeatingPattern.Parent is TEDISEFDataObjectGroup) and + (RepeatingPattern.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(RepeatingPattern.Parent).EDISEFDataObjects do + begin + Extract(RepeatingPattern); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + RepeatingPattern.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Insert(RepeatingPattern, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions + // Return appended object + Result := RepeatingPattern; + end + else // Do not allow nil item objects + Result := InsertRepeatingPatternInto(DataObjectGroup, BeforeObject); +end; + +function AddCompositeElementTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFCompositeElement; +begin + Result := TEDISEFCompositeElement.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Add(Result); +end; + +function AppendCompositeElementTo(DataObjectGroup: TEDISEFDataObjectGroup; + CompositeElement: TEDISEFCompositeElement): TEDISEFCompositeElement; +begin + if CompositeElement <> nil then + begin + // Be sure the object will be managed by the current object + if (CompositeElement.Parent is TEDISEFDataObjectGroup) and + (CompositeElement.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(CompositeElement.Parent).EDISEFDataObjects do + begin + Extract(CompositeElement); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + CompositeElement.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Add(CompositeElement, CompositeElement.Id); + // Return appended object + Result := CompositeElement; + end + else // Do not allow nil item objects + Result := AddCompositeElementTo(DataObjectGroup); +end; + +function ExtractCompositeElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + CompositeElement: TEDISEFCompositeElement): TEDISEFCompositeElement; +begin + Result := TEDISEFCompositeElement(DataObjectGroup.EDISEFDataObjects.Extract(CompositeElement)); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +procedure DeleteCompositeElementFrom(DataObjectGroup: TEDISEFDataObjectGroup; + CompositeElement: TEDISEFCompositeElement); +begin + DataObjectGroup.EDISEFDataObjects.Remove(CompositeElement); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertCompositeElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFCompositeElement; overload; +begin + Result := TEDISEFCompositeElement.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Insert(Result, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertCompositeElementInto(DataObjectGroup: TEDISEFDataObjectGroup; + CompositeElement: TEDISEFCompositeElement; + BeforeObject: TEDISEFDataObject): TEDISEFCompositeElement; overload; +begin + if CompositeElement <> nil then + begin + // Be sure the object will be managed by the current object + if (CompositeElement.Parent is TEDISEFDataObjectGroup) and + (CompositeElement.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(CompositeElement.Parent).EDISEFDataObjects do + begin + Extract(CompositeElement); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + CompositeElement.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Insert(CompositeElement, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions + // Return appended object + Result := CompositeElement; + end + else // Do not allow nil item objects + Result := InsertCompositeElementInto(DataObjectGroup, BeforeObject); +end; + +function AddSegmentTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFSegment; +begin + Result := TEDISEFSegment.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Add(Result); +end; + +function AppendSegmentTo(DataObjectGroup: TEDISEFDataObjectGroup; + Segment: TEDISEFSegment): TEDISEFSegment; +begin + if Segment <> nil then + begin + // Be sure the object will be managed by the current object + if (Segment.Parent is TEDISEFDataObjectGroup) and + (Segment.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(Segment.Parent).EDISEFDataObjects do + begin + Extract(Segment); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + Segment.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Add(Segment, Segment.Id); + // Return appended object + Result := Segment; + end + else // Do not allow nil item objects + Result := AddSegmentTo(DataObjectGroup); +end; + +function ExtractSegmentFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Segment: TEDISEFSegment): TEDISEFSegment; +begin + Result := TEDISEFSegment(DataObjectGroup.EDISEFDataObjects.Extract(Segment)); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +procedure DeleteSegmentFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Segment: TEDISEFSegment); +begin + DataObjectGroup.EDISEFDataObjects.Remove(Segment); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertSegmentInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFSegment; overload; +begin + Result := TEDISEFSegment.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Insert(Result, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertSegmentInto(DataObjectGroup: TEDISEFDataObjectGroup; + Segment: TEDISEFSegment; BeforeObject: TEDISEFDataObject): TEDISEFSegment; overload; +begin + if Segment <> nil then + begin + // Be sure the object will be managed by the current object + if (Segment.Parent is TEDISEFDataObjectGroup) and + (Segment.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(Segment.Parent).EDISEFDataObjects do + begin + Extract(Segment); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + Segment.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Insert(Segment, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions + // Return appended object + Result := Segment; + end + else // Do not allow nil item objects + Result := InsertSegmentInto(DataObjectGroup, BeforeObject); +end; + +function AddLoopTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFLoop; +begin + Result := TEDISEFLoop.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Add(Result); +end; + +function AppendLoopTo(DataObjectGroup: TEDISEFDataObjectGroup; + Loop: TEDISEFLoop): TEDISEFLoop; +begin + if Loop <> nil then + begin + // Be sure the object will be managed by the current object + if (Loop.Parent is TEDISEFDataObjectGroup) and + (Loop.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(Loop.Parent).EDISEFDataObjects do + begin + Extract(Loop); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + Loop.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Add(Loop, Loop.Id); + // Return appended object + Result := Loop; + end + else // Do not allow nil item objects + Result := AddLoopTo(DataObjectGroup); +end; + +function ExtractLoopFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Loop: TEDISEFLoop): TEDISEFLoop; +begin + Result := TEDISEFLoop(DataObjectGroup.EDISEFDataObjects.Extract(Loop)); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +procedure DeleteLoopFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Loop: TEDISEFLoop); +begin + DataObjectGroup.EDISEFDataObjects.Remove(Loop); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertLoopInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFLoop; overload; +begin + Result := TEDISEFLoop.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Insert(Result, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertLoopInto(DataObjectGroup: TEDISEFDataObjectGroup; + Loop: TEDISEFLoop; BeforeObject: TEDISEFDataObject): TEDISEFLoop; overload; +begin + if Loop <> nil then + begin + // Be sure the object will be managed by the current object + if (Loop.Parent is TEDISEFDataObjectGroup) and + (Loop.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(Loop.Parent).EDISEFDataObjects do + begin + Extract(Loop); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + Loop.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Insert(Loop, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions + // Return appended object + Result := Loop; + end + else // Do not allow nil item objects + Result := InsertLoopInto(DataObjectGroup, BeforeObject); +end; + +function AddTableTo(DataObjectGroup: TEDISEFDataObjectGroup): TEDISEFTable; +begin + Result := TEDISEFTable.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Add(Result); +end; + +function AppendTableTo(DataObjectGroup: TEDISEFDataObjectGroup; + Table: TEDISEFTable): TEDISEFTable; +begin + if Table <> nil then + begin + // Be sure the object will be managed by the current object + if (Table.Parent is TEDISEFDataObjectGroup) and + (Table.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(Table.Parent).EDISEFDataObjects do + begin + Extract(Table); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + Table.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Add(Table, Table.Id); + // Return appended object + Result := Table; + end + else // Do not allow nil item objects + Result := AddTableTo(DataObjectGroup); +end; + +function ExtractTableFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Table: TEDISEFTable): TEDISEFTable; +begin + Result := TEDISEFTable(DataObjectGroup.EDISEFDataObjects.Extract(Table)); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +procedure DeleteTableFrom(DataObjectGroup: TEDISEFDataObjectGroup; + Table: TEDISEFTable); +begin + DataObjectGroup.EDISEFDataObjects.Remove(Table); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertTableInto(DataObjectGroup: TEDISEFDataObjectGroup; + BeforeObject: TEDISEFDataObject): TEDISEFTable; overload; +begin + Result := TEDISEFTable.Create(DataObjectGroup); + DataObjectGroup.EDISEFDataObjects.Insert(Result, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions +end; + +function InsertTableInto(DataObjectGroup: TEDISEFDataObjectGroup; + Table: TEDISEFTable; BeforeObject: TEDISEFDataObject): TEDISEFTable; overload; +begin + if Table <> nil then + begin + // Be sure the object will be managed by the current object + if (Table.Parent is TEDISEFDataObjectGroup) and + (Table.Parent <> DataObjectGroup) then + with TEDISEFDataObjectGroup(Table.Parent).EDISEFDataObjects do + begin + Extract(Table); + UpdateIndexes(nil); // Force update all index positions + end; + // Assign the new parent + Table.Parent := DataObjectGroup; + // Add to parent + DataObjectGroup.EDISEFDataObjects.Insert(Table, BeforeObject); + DataObjectGroup.EDISEFDataObjects.UpdateIndexes(nil); // Force update all index positions + // Return appended object + Result := Table; + end + else // Do not allow nil item objects + Result := InsertTableInto(DataObjectGroup, BeforeObject); +end; + +//=== { TEDISEFDataObject } ================================================== + +constructor TEDISEFDataObject.Create(Parent: TEDISEFDataObject); +begin + inherited Create; + FId := ''; + FData := ''; + FLength := 0; + FParent := nil; + FSEFFile := nil; + FOwnerItemRef := nil; + if Assigned(Parent) then + begin + FParent := Parent; + if Parent is TEDISEFFile then + FSEFFile := TEDISEFFile(Parent) + else + FSEFFile := Parent.SEFFile; + end; +end; + +destructor TEDISEFDataObject.Destroy; +begin + FOwnerItemRef := nil; + inherited Destroy; +end; + +{$IFNDEF COMPILER6_UP} +function TEDISEFDataObject.Clone(NewParent: TEDISEFDataObject): TEDISEFDataObject; +begin + Result := nil; +end; +{$ENDIF ~COMPILER6_UP} + +function TEDISEFDataObject.GetData: string; +begin + Result := FData; +end; + +procedure TEDISEFDataObject.SetData(const Data: string); +begin + FData := Data; + FLength := Length(FData); +end; + +procedure TEDISEFDataObject.SetParent(const Value: TEDISEFDataObject); +begin + FParent := Value; + if FParent is TEDISEFFile then + FSEFFile := TEDISEFFile(FParent) + else + FSEFFile := FParent.SEFFile; +end; + +procedure TEDISEFDataObject.SetId(const Value: string); +begin + FId := Value; + UpdateOwnerItemName; +end; + +procedure TEDISEFDataObject.UpdateOwnerItemName; +begin + if FOwnerItemRef <> nil then + FOwnerItemRef.UpdateName; +end; + +//=== { TEDISEFDataObjectListItem } ========================================== + +function TEDISEFDataObjectListItem.GetEDISEFDataObject: TEDISEFDataObject; +begin + Result := TEDISEFDataObject(FEDIObject); +end; + +procedure TEDISEFDataObjectListItem.LinkToObject; +begin + if FEDIObject <> nil then + TEDISEFDataObject(FEDIObject).OwnerItemRef := Self; +end; + +function TEDISEFDataObjectListItem.NextItem: TEDISEFDataObjectListItem; +begin + Result := TEDISEFDataObjectListItem(FNextItem); +end; + +function TEDISEFDataObjectListItem.PriorItem: TEDISEFDataObjectListItem; +begin + Result := TEDISEFDataObjectListItem(FPriorItem); +end; + +procedure TEDISEFDataObjectListItem.SetEDISEFDataObject(const Value: TEDISEFDataObject); +begin + FEDIObject := Value; +end; + +procedure TEDISEFDataObjectListItem.UpdateName; +begin + if FEDIObject <> nil then + FName := TEDISEFDataObject(FEDIObject).Id; +end; + +//=== { TEDISEFDataObjectList } ============================================== + +function TEDISEFDataObjectList.Add(EDISEFDataObject: TEDISEFDataObject; + Name: string): TEDISEFDataObjectListItem; +begin + if Name = '' then + Name := EDISEFDataObject.Id; + Result := TEDISEFDataObjectListItem(inherited Add(EDISEFDataObject, Name)); + Result.LinkToObject; +end; + +function TEDISEFDataObjectList.CreateListItem(PriorItem: TEDIObjectListItem; + EDIObject: TEDIObject): TEDIObjectListItem; +begin + Result := TEDISEFDataObjectListItem.Create(Self, PriorItem, EDIObject); +end; + +function TEDISEFDataObjectList.FindItemByName(Name: string; + StartItem: TEDIObjectListItem = nil): TEDISEFDataObjectListItem; +var + ListItem: TEDIObjectListItem; +begin + ListItem := inherited FindItemByName(Name, StartItem); + Result := TEDISEFDataObjectListItem(ListItem); +end; + +function TEDISEFDataObjectList.First(Index: Integer): TEDISEFDataObjectListItem; +begin + Result := TEDISEFDataObjectListItem(inherited First(Index)); +end; + +function TEDISEFDataObjectList.GetEDISEFDataObject(Index: Integer): TEDISEFDataObject; +begin + Result := TEDISEFDataObject(GetEDIObject(Index)); +end; + +function TEDISEFDataObjectList.GetObjectByItemByName(Name: string): TEDISEFDataObject; +var + ListItem: TEDISEFDataObjectListItem; +begin + Result := nil; + ListItem := FindItemByName(Name); + if ListItem <> nil then + Result := FindItemByName(Name).EDISEFDataObject; +end; + +function TEDISEFDataObjectList.Insert( + EDISEFDataObject, BeforeEDISEFDataObject: TEDISEFDataObject): TEDISEFDataObjectListItem; +begin + Result := TEDISEFDataObjectListItem(inherited Insert(EDISEFDataObject, BeforeEDISEFDataObject)); + Result.LinkToObject; +end; + +function TEDISEFDataObjectList.Last: TEDISEFDataObjectListItem; +begin + Result := TEDISEFDataObjectListItem(inherited Last); +end; + +function TEDISEFDataObjectList.Next: TEDISEFDataObjectListItem; +begin + Result := TEDISEFDataObjectListItem(inherited Next); +end; + +function TEDISEFDataObjectList.Prior: TEDISEFDataObjectListItem; +begin + Result := TEDISEFDataObjectListItem(inherited Prior); +end; + +procedure TEDISEFDataObjectList.SetEDISEFDataObject(Index: Integer; const Value: TEDISEFDataObject); +begin + SetEDIObject(Index, Value); +end; + +//=== { TEDISEFDataObjectGroup } ============================================= + +constructor TEDISEFDataObjectGroup.Create(Parent: TEDISEFDataObject); +begin + inherited Create(Parent); + FEDISEFDataObjects := TEDISEFDataObjectList.Create; +end; + +destructor TEDISEFDataObjectGroup.Destroy; +begin + FEDISEFDataObjects.Free; + inherited Destroy; +end; + +function TEDISEFDataObjectGroup.GetCount: Integer; +begin + Result := FEDISEFDataObjects.Count; +end; + +function TEDISEFDataObjectGroup.GetEDISEFDataObject(Index: Integer): TEDISEFDataObject; +begin + Result := FEDISEFDataObjects[Index]; +end; + +//=== { TEDISEFElement } ===================================================== + +constructor TEDISEFElement.Create(Parent: TEDISEFDataObject); +begin + inherited Create(Parent); + FUserAttribute := ''; + FOrdinal := -1; + FOutOfSequenceOrdinal := False; + FElementType := ''; + FMinimumLength := 0; + FMaximumLength := 0; + FRequirementDesignator := ''; + FRepeatCount := -1; + FEDISEFTextSets := TEDISEFTextSets.Create(False); +end; + +destructor TEDISEFElement.Destroy; +begin + FEDISEFTextSets.Free; + inherited Destroy; +end; + +function TEDISEFElement.Assemble: string; +begin + Result := ''; + if FParent is TEDISEFFile then + Result := CombineELMSDataOfELMSDefinition(Self) + else + if (FParent is TEDISEFCompositeElement) or (FParent is TEDISEFSegment) then + Result := CombineELMSDataOfCOMSorSEGSDefinition(Self, FSEFFile.ELMS) + else + if FParent is TEDISEFRepeatingPattern then + begin + if (TEDISEFRepeatingPattern(FParent).BaseParent is TEDISEFCompositeElement) or + (TEDISEFRepeatingPattern(FParent).BaseParent is TEDISEFSegment) then + begin + Result := CombineELMSDataOfCOMSorSEGSDefinition(Self, FSEFFile.ELMS); + end; + end; +end; + +procedure TEDISEFElement.Assign(EDISEFElement: TEDISEFElement); +begin + // FUserAttribute := EDISEFElement.UserAttribute; + // FOrdinal := EDISEFElement.Ordinal; + FId := EDISEFElement.ElementId; + FElementType := EDISEFElement.ElementType; + FMinimumLength := EDISEFElement.MinimumLength; + FMaximumLength := EDISEFElement.MaximumLength; + FRequirementDesignator := EDISEFElement.RequirementDesignator; + FRepeatCount := EDISEFElement.RepeatCount; +end; + +function TEDISEFElement.Clone(NewParent: TEDISEFDataObject): TEDISEFElement; +begin + Result := TEDISEFElement.Create(NewParent); + Result.Data := FData; + Result.UserAttribute := FUserAttribute; + Result.ElementId := FId; + Result.Ordinal := FOrdinal; + Result.ElementType := FElementType; + Result.MinimumLength := FMinimumLength; + Result.MaximumLength := FMaximumLength; + Result.RequirementDesignator := FRequirementDesignator; +end; + +procedure TEDISEFElement.Disassemble; +begin + if FParent is TEDISEFFile then + ParseELMSDataOfELMSDefinition(FData, Self) + else + if FParent is TEDISEFCompositeElement then + ParseELMSDataOfCOMSDefinition(FData, Self, FSEFFile.ELMS) + else + if FParent is TEDISEFSegment then + ParseELMSDataOfSEGSDefinition(FData, Self, FSEFFile.ELMS) + else + if FParent is TEDISEFRepeatingPattern then + begin + if TEDISEFRepeatingPattern(FParent).BaseParent is TEDISEFCompositeElement then + ParseELMSDataOfCOMSDefinition(FData, Self, FSEFFile.ELMS) + else + if TEDISEFRepeatingPattern(FParent).BaseParent is TEDISEFSegment then + ParseELMSDataOfSEGSDefinition(FData, Self, FSEFFile.ELMS); + end; + UpdateOwnerItemName; +end; + +function TEDISEFElement.GetTextSetsLocation: string; +var + DataObject: TEDISEFDataObject; +begin + Result := ''; + if FParent is TEDISEFCompositeElement then + Result := TEDISEFCompositeElement(FParent).GetTextSetsLocation + else + if FParent is TEDISEFSegment then + Result := TEDISEFSegment(FParent).GetTextSetsLocation + else + if FParent is TEDISEFRepeatingPattern then + begin + DataObject := TEDISEFRepeatingPattern(FParent).BaseParent; + if DataObject is TEDISEFCompositeElement then + Result := TEDISEFCompositeElement(FParent).GetTextSetsLocation + else + if DataObject is TEDISEFSegment then + Result := TEDISEFSegment(DataObject).GetTextSetsLocation; + end; + if Result <> '' then + Result := Result + '~' + IntToStr(FOrdinal); +end; + +procedure TEDISEFElement.BindTextSets(TEXTSETS: TEDISEFTextSets); +begin + FEDISEFTextSets.Free; + FEDISEFTextSets := TEDISEFTextSets(TextSets.ReturnListItemsByName(GetTextSetsLocation)); +end; + +function TEDISEFElement.CloneAsSubElement(NewParent: TEDISEFDataObject): TEDISEFSubElement; +begin + Result := TEDISEFSubElement.Create(NewParent); + Result.Data := FData; + Result.UserAttribute := FUserAttribute; + Result.ElementId := FId; + Result.Ordinal := FOrdinal; + Result.ElementType := FElementType; + Result.MinimumLength := FMinimumLength; + Result.MaximumLength := FMaximumLength; + Result.RequirementDesignator := FRequirementDesignator; +end; + +//=== { TEDISEFSubElement } ================================================== + +constructor TEDISEFSubElement.Create(Parent: TEDISEFDataObject); +begin + inherited Create(Parent); +end; + +destructor TEDISEFSubElement.Destroy; +begin + inherited Destroy; +end; + +function TEDISEFSubElement.Assemble: string; +begin + Result := inherited Assemble; +end; + +function TEDISEFSubElement.Clone(NewParent: TEDISEFDataObject): TEDISEFSubElement; +begin + Result := TEDISEFSubElement.Create(NewParent); + Result.Data := FData; + Result.UserAttribute := FUserAttribute; + Result.ElementId := FId; + Result.Ordinal := FOrdinal; + Result.ElementType := FElementType; + Result.MinimumLength := FMinimumLength; + Result.MaximumLength := FMaximumLength; + Result.RequirementDesignator := FRequirementDesignator; +end; + +procedure TEDISEFSubElement.Disassemble; +begin + inherited Disassemble; +end; + +//=== { TEDISEFCompositeElement } ============================================ + +constructor TEDISEFCompositeElement.Create(Parent: TEDISEFDataObject); +begin + inherited Create(Parent); + FUserAttribute := ''; + FOrdinal := -1; + FOutOfSequenceOrdinal := False; + FRequirementDesignator := ''; + FExtendedData := ''; + FEDISEFTextSets := TEDISEFTextSets.Create(False); +end; + +destructor TEDISEFCompositeElement.Destroy; +begin + FEDISEFTextSets.Free; + inherited Destroy; +end; + +function TEDISEFCompositeElement.Assemble: string; +begin + Result := ''; + if FParent is TEDISEFFile then + Result := CombineCOMSDataOfCOMSDefinition(Self) + else + if FParent is TEDISEFSegment then + Result := CombineCOMSDataOfSEGSDefinition(Self) + else + if FParent is TEDISEFRepeatingPattern then + if TEDISEFRepeatingPattern(FParent).BaseParent is TEDISEFSegment then + Result := CombineCOMSDataOfSEGSDefinition(Self); +end; + +procedure TEDISEFCompositeElement.Assign(CompositeElement: TEDISEFCompositeElement); +var + ListItem: TEDISEFDataObjectListItem; + SubElement: TEDISEFSubElement; + RepeatingPattern: TEDISEFRepeatingPattern; +begin + FEDISEFDataObjects.Clear; + FUserAttribute := CompositeElement.UserAttribute; + FId := CompositeElement.CompositeElementId; + FOrdinal := CompositeElement.Ordinal; + ListItem := CompositeElement.Elements.First; + while ListItem <> nil do + begin + if ListItem.EDISEFDataObject <> nil then + begin + if ListItem.EDISEFDataObject is TEDISEFSubElement then + begin + SubElement := TEDISEFSubElement(ListItem.EDISEFDataObject); + SubElement := SubElement.Clone(Self); + AppendSubElement(SubElement); + end + else + if ListItem.EDISEFDataObject is TEDISEFRepeatingPattern then + begin + RepeatingPattern := TEDISEFRepeatingPattern(ListItem.EDISEFDataObject); + RepeatingPattern := RepeatingPattern.Clone(Self); + AppendRepeatingPattern(RepeatingPattern); + end; + end + else + AddSubElement; + ListItem := ListItem.NextItem; + end; +end; + +function TEDISEFCompositeElement.Clone(NewParent: TEDISEFDataObject): TEDISEFCompositeElement; +var + ListItem: TEDISEFDataObjectListItem; + SubElement: TEDISEFSubElement; + RepeatingPattern: TEDISEFRepeatingPattern; +begin + Result := TEDISEFCompositeElement.Create(NewParent); + Result.UserAttribute := FUserAttribute; + Result.CompositeElementId := FId; + Result.RequirementDesignator := FRequirementDesignator; + Result.Ordinal := FOrdinal; + ListItem := FEDISEFDataObjects.First; + while ListItem <> nil do + begin + if ListItem.EDISEFDataObject <> nil then + begin + if ListItem.EDISEFDataObject is TEDISEFSubElement then + begin + SubElement := TEDISEFSubElement(ListItem.EDISEFDataObject); + SubElement := SubElement.Clone(Result); + Result.Elements.Add(SubElement, SubElement.Id); + end + else + if ListItem.EDISEFDataObject is TEDISEFRepeatingPattern then + begin + RepeatingPattern := TEDISEFRepeatingPattern(ListItem.EDISEFDataObject); + RepeatingPattern := RepeatingPattern.Clone(Result); + Result.Elements.Add(RepeatingPattern, RepeatingPattern.Id); + end; + end + else + begin + SubElement := TEDISEFSubElement.Create(Self); + Result.Elements.Add(SubElement); + end; + ListItem := ListItem.NextItem; + end; +end; + +procedure TEDISEFCompositeElement.Disassemble; +begin + if FParent is TEDISEFFile then + ParseCOMSDataOfCOMSDefinition(FData, Self, FSEFFile.ELMS) + else + if FParent is TEDISEFSegment then + ParseCOMSDataOfSEGSDefinition(FData, Self, FSEFFile.COMS) + else + if FParent is TEDISEFRepeatingPattern then + begin + if TEDISEFRepeatingPattern(FParent).BaseParent is TEDISEFSegment then + ParseCOMSDataOfSEGSDefinition(FData, Self, FSEFFile.COMS); + end; + UpdateOwnerItemName; + AssignElementOrdinals; +end; + +function TEDISEFCompositeElement.GetTextSetsLocation: string; +begin + Result := ''; + if FParent is TEDISEFSegment then + Result := TEDISEFSegment(FParent).GetTextSetsLocation + else + if FParent is TEDISEFRepeatingPattern then + if TEDISEFRepeatingPattern(FParent).BaseParent is TEDISEFSegment then + Result := TEDISEFSegment(TEDISEFRepeatingPattern(FParent).BaseParent).GetTextSetsLocation; + if Result <> '' then + Result := Result + '~' + IntToStr(FOrdinal); +end; + +procedure TEDISEFCompositeElement.AssignElementOrdinals; +var + I: Integer; + Element: TEDISEFElement; + ElementList: TObjectList; + AssignOrdinal: Integer; +begin + ElementList := GetElementObjectList; + try + AssignOrdinal := 0; + for I := 0 to ElementList.Count - 1 do + begin + if ElementList[I] is TEDISEFElement then + begin + Element := TEDISEFElement(ElementList[I]); + if Element.Ordinal = -1 then + begin + Inc(AssignOrdinal); + Element.Ordinal := AssignOrdinal; + end + else + begin + AssignOrdinal := Element.Ordinal; + Element.OutOfSequenceOrdinal := True; + end; + end; + end; + finally + ElementList.Free; + end; +end; + +function TEDISEFCompositeElement.GetElementObjectList: TObjectList; +begin + Result := TObjectList.Create(False); + ExtractFromDataObjectGroup(TEDISEFElement, Self, Result); +end; + +procedure TEDISEFCompositeElement.BindTextSets(TEXTSETS: TEDISEFTextSets); +begin + FEDISEFTextSets.Free; + FEDISEFTextSets := TEDISEFTextSets(TextSets.ReturnListItemsByName(GetTextSetsLocation)); +end; + +function TEDISEFCompositeElement.AddSubElement: TEDISEFSubElement; +begin + Result := AddSubElementTo(Self); +end; + +function TEDISEFCompositeElement.AppendSubElement(SubElement: TEDISEFSubElement): TEDISEFSubElement; +begin + Result := AppendSubElementTo(Self, SubElement); +end; + +procedure TEDISEFCompositeElement.DeleteSubElement(SubElement: TEDISEFSubElement); +begin + DeleteSubElementFrom(Self, SubElement); +end; + +function TEDISEFCompositeElement.ExtractSubElement( + SubElement: TEDISEFSubElement): TEDISEFSubElement; +begin + Result := ExtractSubElementFrom(Self, SubElement); +end; + +function TEDISEFCompositeElement.InsertSubElement( + BeforeObject: TEDISEFDataObject): TEDISEFSubElement; +begin + Result := InsertSubElementInto(Self, BeforeObject); +end; + +function TEDISEFCompositeElement.InsertSubElement(SubElement: TEDISEFSubElement; + BeforeObject: TEDISEFDataObject): TEDISEFSubElement; +begin + Result := InsertSubElementInto(Self, SubElement, BeforeObject); +end; + +function TEDISEFCompositeElement.AddRepeatingPattern: TEDISEFRepeatingPattern; +begin + Result := AddRepeatingPatternTo(Self); +end; + +function TEDISEFCompositeElement.AppendRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +begin + Result := AppendRepeatingPatternTo(Self, RepeatingPattern); +end; + +procedure TEDISEFCompositeElement.DeleteRepeatingPattern(RepeatingPattern: TEDISEFRepeatingPattern); +begin + DeleteRepeatingPatternFrom(Self, RepeatingPattern); +end; + +function TEDISEFCompositeElement.ExtractRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +begin + Result := ExtractRepeatingPatternFrom(Self, RepeatingPattern); +end; + +function TEDISEFCompositeElement.InsertRepeatingPattern(RepeatingPattern: TEDISEFRepeatingPattern; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; +begin + Result := InsertRepeatingPatternInto(Self, RepeatingPattern, BeforeObject); +end; + +function TEDISEFCompositeElement.InsertRepeatingPattern( + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; +begin + Result := InsertRepeatingPatternInto(Self, BeforeObject); +end; + +//=== { TEDISEFSegment } ===================================================== + +constructor TEDISEFSegment.Create(Parent: TEDISEFDataObject); +begin + inherited Create(Parent); + if FParent is TEDISEFTable then + begin + FParentSet := TEDISEFSet(FParent.Parent); + FParentTable := TEDISEFTable(FParent); + end + else + if FParent is TEDISEFLoop then + begin + FParentSet := TEDISEFLoop(FParent).ParentSet; + FParentTable := TEDISEFLoop(FParent).ParentTable; + end + else + begin + FParentSet := nil; + FParentTable := nil; + end; + FOrdinal := -1; + FPosition := -1; + FPositionIncrement := 0; + FResetPositionInc := False; + FOutOfSequenceOrdinal := False; + FRequirementDesignator := ''; + FMaximumUse := 0; + FOwnerLoopId := NA_LoopId; + FParentLoopId := NA_LoopId; + FMaskNumber := -1; + FMaskNumberSpecified := False; + FExtendedData := ''; + FEDISEFTextSets := TEDISEFTextSets.Create(False); +end; + +destructor TEDISEFSegment.Destroy; +begin + inherited Destroy; +end; + +function TEDISEFSegment.Assemble: string; +begin + Result := ''; + if FParent is TEDISEFFile then + Result := CombineSEGSDataOfSEGSDefinition(Self) + else + if (FParent is TEDISEFTable) or (FParent is TEDISEFLoop) then + Result := CombineSEGSDataOfSETSDefinition(Self); +end; + +procedure TEDISEFSegment.Assign(Segment: TEDISEFSegment); +var + ListItem: TEDISEFDataObjectListItem; + EDISEFDataObject: TEDISEFDataObject; +begin + FEDISEFDataObjects.Clear; + FRequirementDesignator := Segment.RequirementDesignator; + FMaximumUse := Segment.MaximumUse; + ListItem := Segment.Elements.First; + while ListItem <> nil do + begin + EDISEFDataObject := nil; + if ListItem.EDISEFDataObject <> nil then + begin + if ListItem.EDISEFDataObject is TEDISEFElement then + EDISEFDataObject := TEDISEFElement(ListItem.EDISEFDataObject).Clone(Self) + else + if ListItem.EDISEFDataObject is TEDISEFCompositeElement then + EDISEFDataObject := TEDISEFCompositeElement(ListItem.EDISEFDataObject).Clone(Self) + else + if ListItem.EDISEFDataObject is TEDISEFRepeatingPattern then + EDISEFDataObject := TEDISEFRepeatingPattern(ListItem.EDISEFDataObject).Clone(Self); + end + else + EDISEFDataObject := TEDISEFElement.Create(Self); + FEDISEFDataObjects.Add(EDISEFDataObject, EDISEFDataObject.Id); + ListItem := ListItem.NextItem; + end; +end; + +function TEDISEFSegment.Clone(NewParent: TEDISEFDataObject): TEDISEFSegment; +var + ListItem: TEDISEFDataObjectListItem; + EDISEFDataObject: TEDISEFDataObject; +begin + Result := TEDISEFSegment.Create(NewParent); + Result.SegmentId := FId; + Result.RequirementDesignator := FRequirementDesignator; + Result.MaximumUse := FMaximumUse; + ListItem := FEDISEFDataObjects.First; + while ListItem <> nil do + begin + if ListItem.EDISEFDataObject <> nil then + begin + if ListItem.EDISEFDataObject is TEDISEFElement then + EDISEFDataObject := TEDISEFElement(ListItem.EDISEFDataObject).Clone(Result) + else + if ListItem.EDISEFDataObject is TEDISEFCompositeElement then + EDISEFDataObject := TEDISEFCompositeElement(ListItem.EDISEFDataObject).Clone(Result) + else + if ListItem.EDISEFDataObject is TEDISEFRepeatingPattern then + EDISEFDataObject := TEDISEFRepeatingPattern(ListItem.EDISEFDataObject).Clone(Result) + else + EDISEFDataObject := TEDISEFElement.Create(Result); + end + else + EDISEFDataObject := TEDISEFElement.Create(Result); + Result.EDISEFDataObjects.Add(EDISEFDataObject, EDISEFDataObject.Id); + ListItem := ListItem.NextItem; + end; +end; + +procedure TEDISEFSegment.Disassemble; +begin + if FParent is TEDISEFFile then + ParseSEGSDataOfSEGSDefinition(FData, Self, FSEFFile) + else + if (FParent is TEDISEFTable) or (FParent is TEDISEFLoop) then + ParseSEGSDataOfSETSDefinition(FData, Self, FSEFFile); + UpdateOwnerItemName; + AssignElementOrdinals; +end; + +function TEDISEFSegment.GetOwnerLoopId: string; +begin + Result := NA_LoopId; + if FParent is TEDISEFLoop then + Result := FParent.Id; +end; + +function TEDISEFSegment.GetParentLoopId: string; +begin + Result := NA_LoopId; + if FParent is TEDISEFLoop then + Result := TEDISEFLoop(FParent).ParentLoopId; +end; + +function TEDISEFSegment.GetTextSetsLocation: string; +begin + Result := ''; + if FParentSet <> nil then + Result := FParentSet.GetTextSetsLocation + '~' + IntToStr(FOrdinal); +end; + +function TEDISEFSegment.GetElementObjectList: TObjectList; +begin + Result := TObjectList.Create(False); + ExtractFromDataObjectGroup([TEDISEFElement, TEDISEFCompositeElement], Self, Result); +end; + +procedure TEDISEFSegment.AssignElementOrdinals; +var + I: Integer; + Element: TEDISEFElement; + CompositeElement: TEDISEFCompositeElement; + ElementList: TObjectList; + AssignOrdinal: Integer; +begin + ElementList := GetElementObjectList; + try + AssignOrdinal := 0; + for I := 0 to ElementList.Count - 1 do + begin + if ElementList[I] is TEDISEFElement then + begin + Element := TEDISEFElement(ElementList[I]); + if Element.Ordinal = -1 then + begin + Inc(AssignOrdinal); + Element.Ordinal := AssignOrdinal; + end + else + begin + AssignOrdinal := Element.Ordinal; + Element.OutOfSequenceOrdinal := True; + end; + end + else + if ElementList[I] is TEDISEFCompositeElement then + begin + CompositeElement := TEDISEFCompositeElement(ElementList[I]); + if CompositeElement.Ordinal = -1 then + begin + Inc(AssignOrdinal); + CompositeElement.Ordinal := AssignOrdinal; + end + else + begin + AssignOrdinal := CompositeElement.Ordinal; + CompositeElement.OutOfSequenceOrdinal := True; + end; + end; + end; + finally + ElementList.Free; + end; +end; + +procedure TEDISEFSegment.BindTextSets(TEXTSETS: TEDISEFTextSets); +begin + FEDISEFTextSets.Free; + FEDISEFTextSets := TEDISEFTextSets(TextSets.ReturnListItemsByName(GetTextSetsLocation)); +end; + +procedure TEDISEFSegment.BindElementTextSets; +var + I: Integer; + Element: TEDISEFElement; + CompositeElement: TEDISEFCompositeElement; + ElementList: TObjectList; +begin + ElementList := GetElementObjectList; + try + for I := 0 to ElementList.Count - 1 do + begin + if ElementList[I] is TEDISEFElement then + begin + Element := TEDISEFElement(ElementList[I]); + Element.BindTextSets(FSEFFile.TEXTSETS); + end + else + if ElementList[I] is TEDISEFCompositeElement then + begin + CompositeElement := TEDISEFCompositeElement(ElementList[I]); + CompositeElement.BindTextSets(FSEFFile.TEXTSETS); + end; + end; + finally + ElementList.Free; + end; +end; + +function TEDISEFSegment.AddElement: TEDISEFElement; +begin + Result := AddElementTo(Self); +end; + +function TEDISEFSegment.AppendElement(Element: TEDISEFElement): TEDISEFElement; +begin + Result := AppendElementTo(Self, Element); +end; + +procedure TEDISEFSegment.DeleteElement(Element: TEDISEFElement); +begin + DeleteElementFrom(Self, Element); +end; + +function TEDISEFSegment.ExtractElement(Element: TEDISEFElement): TEDISEFElement; +begin + Result := ExtractElementFrom(Self, Element); +end; + +function TEDISEFSegment.InsertElement(BeforeObject: TEDISEFDataObject): TEDISEFElement; +begin + Result := InsertElementInto(Self, BeforeObject); +end; + +function TEDISEFSegment.InsertElement(Element: TEDISEFElement; + BeforeObject: TEDISEFDataObject): TEDISEFElement; +begin + Result := InsertElementInto(Self, Element, BeforeObject); +end; + +function TEDISEFSegment.AddCompositeElement: TEDISEFCompositeElement; +begin + Result := AddCompositeElementTo(Self); +end; + +function TEDISEFSegment.AppendCompositeElement( + CompositeElement: TEDISEFCompositeElement): TEDISEFCompositeElement; +begin + Result := AppendCompositeElementTo(Self, CompositeElement); +end; + +procedure TEDISEFSegment.DeleteCompositeElement(CompositeElement: TEDISEFCompositeElement); +begin + DeleteCompositeElementFrom(Self, CompositeElement); +end; + +function TEDISEFSegment.ExtractCompositeElement( + CompositeElement: TEDISEFCompositeElement): TEDISEFCompositeElement; +begin + Result := ExtractCompositeElementFrom(Self, CompositeElement); +end; + +function TEDISEFSegment.InsertCompositeElement( + BeforeObject: TEDISEFDataObject): TEDISEFCompositeElement; +begin + Result := InsertCompositeElementInto(Self, BeforeObject); +end; + +function TEDISEFSegment.InsertCompositeElement(CompositeElement: TEDISEFCompositeElement; + BeforeObject: TEDISEFDataObject): TEDISEFCompositeElement; +begin + Result := InsertCompositeElementInto(Self, CompositeElement, BeforeObject); +end; + +function TEDISEFSegment.AddRepeatingPattern: TEDISEFRepeatingPattern; +begin + Result := AddRepeatingPatternTo(Self); +end; + +function TEDISEFSegment.AppendRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +begin + Result := AppendRepeatingPatternTo(Self, RepeatingPattern); +end; + +procedure TEDISEFSegment.DeleteRepeatingPattern(RepeatingPattern: TEDISEFRepeatingPattern); +begin + DeleteRepeatingPatternFrom(Self, RepeatingPattern); +end; + +function TEDISEFSegment.ExtractRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +begin + Result := ExtractRepeatingPatternFrom(Self, RepeatingPattern); +end; + +function TEDISEFSegment.InsertRepeatingPattern(RepeatingPattern: TEDISEFRepeatingPattern; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; +begin + Result := InsertRepeatingPatternInto(Self, RepeatingPattern, BeforeObject); +end; + +function TEDISEFSegment.InsertRepeatingPattern( + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; +begin + Result := InsertRepeatingPatternInto(Self, BeforeObject); +end; + +//=== { TEDISEFLoop } ======================================================== + +constructor TEDISEFLoop.Create(Parent: TEDISEFDataObject); +begin + inherited Create(Parent); + FMaximumRepeat := Value_UndefinedMaximum; +end; + +destructor TEDISEFLoop.Destroy; +begin + inherited Destroy; +end; + +function TEDISEFLoop.Assemble: string; +var + ListItem: TEDISEFDataObjectListItem; + Segment: TEDISEFSegment; +begin + Result := ''; + ListItem := FEDISEFDataObjects.First; + while ListItem <> nil do + begin + if ListItem.EDISEFDataObject is TEDISEFSegment then + begin + Segment := TEDISEFSegment(ListItem.EDISEFDataObject); + if Segment.ResetPositionInc then + begin + if Segment.PositionIncrement > 0 then + Result := Result + SEFDelimiter_PlusSign + IntToStr(Segment.PositionIncrement) + + SEFDelimiter_OpeningBracket + Segment.Assemble + SEFDelimiter_ClosingBracket + else + Result := Result + IntToStr(Segment.PositionIncrement) + SEFDelimiter_OpeningBracket + + Segment.Assemble + SEFDelimiter_ClosingBracket; + end + else + begin + Result := Result + SEFDelimiter_OpeningBracket + Segment.Assemble + + SEFDelimiter_ClosingBracket; + end; + end + else // is TEDISEFLoop + Result := Result + SEFDelimiter_OpeningBrace + ListItem.EDISEFDataObject.Assemble + + SEFDelimiter_ClosingBrace; + ListItem := ListItem.NextItem; + end; + if FEDISEFDataObjects.Count > 0 then + begin + if FEDISEFDataObjects[0].Id <> FId then + begin + if FMaximumRepeat >= Value_UndefinedMaximum then + Result := FId + SEFDelimiter_Colon + Value_GreaterThanOne + Result + else + if FMaximumRepeat > 1 then + Result := FId + SEFDelimiter_Colon + IntToStr(FMaximumRepeat) + Result + else + Result := FId + Result; + end + else + begin + if FMaximumRepeat >= Value_UndefinedMaximum then + Result := SEFDelimiter_Colon + Value_GreaterThanOne + Result + else + if FMaximumRepeat > 1 then + Result := SEFDelimiter_Colon + IntToStr(FMaximumRepeat) + Result + else + Result := FId + Result; + end; + end + else + Result := FId + SEFDelimiter_Colon + IntToStr(FMaximumRepeat) + Result; +end; + +function TEDISEFLoop.Clone(NewParent: TEDISEFDataObject): TEDISEFLoop; +begin + Result := nil; +end; + +procedure TEDISEFLoop.Disassemble; +begin + // FParent is TEDISEFTable + ParseLoopDataOfSETSDefinition(FData, Self, FSEFFile); + UpdateOwnerItemName; +end; + +function TEDISEFLoop.GetParentLoopId: string; +begin + Result := NA_LoopId; + if FParent is TEDISEFLoop then + Result := FParent.Id; +end; + +function TEDISEFLoop.GetParentSet: TEDISEFSet; +var + DataObject: TEDISEFDataObject; +begin + Result := nil; + DataObject := FParent; + while DataObject <> nil do + begin + if DataObject is TEDISEFTable then + begin + Result := TEDISEFSet(DataObject.Parent); + Break; + end + else + if DataObject is TEDISEFLoop then + DataObject := DataObject.Parent; + end; +end; + +function TEDISEFLoop.AddLoop: TEDISEFLoop; +begin + Result := AddLoopTo(Self); +end; + +function TEDISEFLoop.AddSegment: TEDISEFSegment; +begin + Result := AddSegmentTo(Self); +end; + +function TEDISEFLoop.AppendLoop(Loop: TEDISEFLoop): TEDISEFLoop; +begin + Result := AppendLoopTo(Self, Loop); +end; + +function TEDISEFLoop.AppendSegment(Segment: TEDISEFSegment): TEDISEFSegment; +begin + Result := AppendSegmentTo(Self, Segment); +end; + +procedure TEDISEFLoop.DeleteLoop(Loop: TEDISEFLoop); +begin + DeleteLoopFrom(Self, Loop); +end; + +procedure TEDISEFLoop.DeleteSegment(Segment: TEDISEFSegment); +begin + DeleteSegmentFrom(Self, Segment); +end; + +function TEDISEFLoop.ExtractLoop(Loop: TEDISEFLoop): TEDISEFLoop; +begin + Result := ExtractLoopFrom(Self, Loop); +end; + +function TEDISEFLoop.ExtractSegment(Segment: TEDISEFSegment): TEDISEFSegment; +begin + Result := ExtractSegmentFrom(Self, Segment); +end; + +function TEDISEFLoop.InsertLoop(Loop: TEDISEFLoop; BeforeObject: TEDISEFDataObject): TEDISEFLoop; +begin + Result := InsertLoopInto(Self, Loop, BeforeObject); +end; + +function TEDISEFLoop.InsertLoop(BeforeObject: TEDISEFDataObject): TEDISEFLoop; +begin + Result := InsertLoopInto(Self, BeforeObject); +end; + +function TEDISEFLoop.InsertSegment(Segment: TEDISEFSegment; + BeforeObject: TEDISEFDataObject): TEDISEFSegment; +begin + Result := InsertSegmentInto(Self, Segment, BeforeObject); +end; + +function TEDISEFLoop.InsertSegment(BeforeObject: TEDISEFDataObject): TEDISEFSegment; +begin + Result := InsertSegmentInto(Self, BeforeObject); +end; + +function TEDISEFLoop.GetParentTable: TEDISEFTable; +var + DataObject: TEDISEFDataObject; +begin + Result := nil; + DataObject := FParent; + while DataObject <> nil do + begin + if DataObject is TEDISEFTable then + begin + Result := TEDISEFTable(DataObject); + Break; + end + else + if DataObject is TEDISEFLoop then + DataObject := DataObject.Parent; + end; +end; + +//=== { TEDISEFTable } ======================================================= + +constructor TEDISEFTable.Create(Parent: TEDISEFDataObject); +begin + inherited Create(Parent); +end; + +destructor TEDISEFTable.Destroy; +begin + inherited Destroy; +end; + +function TEDISEFTable.Assemble: string; +var + ListItem: TEDISEFDataObjectListItem; + Segment: TEDISEFSegment; +begin + Result := ''; + if FEDISEFDataObjects.Count > 0 then + Result := SEFDelimiter_Caret; + ListItem := FEDISEFDataObjects.First; + while ListItem <> nil do + begin + if ListItem.EDISEFDataObject is TEDISEFSegment then + begin + Segment := TEDISEFSegment(ListItem.EDISEFDataObject); + if Segment.ResetPositionInc then + begin + if Segment.PositionIncrement > 0 then + Result := Result + SEFDelimiter_PlusSign + IntToStr(Segment.PositionIncrement) + + SEFDelimiter_OpeningBracket + Segment.Assemble + SEFDelimiter_ClosingBracket + else + Result := Result + IntToStr(Segment.PositionIncrement) + SEFDelimiter_OpeningBracket + + Segment.Assemble + SEFDelimiter_ClosingBracket; + end + else + begin + Result := Result + SEFDelimiter_OpeningBracket + Segment.Assemble + + SEFDelimiter_ClosingBracket; + end; + end + else // is TEDISEFLoop + Result := Result + SEFDelimiter_OpeningBrace + ListItem.EDISEFDataObject.Assemble + + SEFDelimiter_ClosingBrace; + ListItem := ListItem.NextItem; + end; +end; + +function TEDISEFTable.Clone(NewParent: TEDISEFDataObject): TEDISEFTable; +begin + Result := nil; +end; + +function TEDISEFTable.GetSEFSet: TEDISEFSet; +begin + Result := nil; + if FParent is TEDISEFSet then + Result := TEDISEFSet(FParent); +end; + +function TEDISEFTable.AddLoop: TEDISEFLoop; +begin + Result := AddLoopTo(Self); +end; + +function TEDISEFTable.AddSegment: TEDISEFSegment; +begin + Result := AddSegmentTo(Self); +end; + +function TEDISEFTable.AppendLoop(Loop: TEDISEFLoop): TEDISEFLoop; +begin + Result := AppendLoopTo(Self, Loop); +end; + +function TEDISEFTable.AppendSegment(Segment: TEDISEFSegment): TEDISEFSegment; +begin + Result := AppendSegmentTo(Self, Segment); +end; + +procedure TEDISEFTable.DeleteLoop(Loop: TEDISEFLoop); +begin + DeleteLoopFrom(Self, Loop); +end; + +procedure TEDISEFTable.DeleteSegment(Segment: TEDISEFSegment); +begin + DeleteSegmentFrom(Self, Segment); +end; + +function TEDISEFTable.ExtractLoop(Loop: TEDISEFLoop): TEDISEFLoop; +begin + Result := ExtractLoopFrom(Self, Loop); +end; + +function TEDISEFTable.ExtractSegment(Segment: TEDISEFSegment): TEDISEFSegment; +begin + Result := ExtractSegmentFrom(Self, Segment); +end; + +function TEDISEFTable.InsertLoop(Loop: TEDISEFLoop; BeforeObject: TEDISEFDataObject): TEDISEFLoop; +begin + Result := InsertLoopInto(Self, Loop, BeforeObject); +end; + +function TEDISEFTable.InsertLoop(BeforeObject: TEDISEFDataObject): TEDISEFLoop; +begin + Result := InsertLoopInto(Self, BeforeObject); +end; + +function TEDISEFTable.InsertSegment(Segment: TEDISEFSegment; + BeforeObject: TEDISEFDataObject): TEDISEFSegment; +begin + Result := InsertSegmentInto(Self, Segment, BeforeObject); +end; + +function TEDISEFTable.InsertSegment(BeforeObject: TEDISEFDataObject): TEDISEFSegment; +begin + Result := InsertSegmentInto(Self, BeforeObject); +end; + +//=== { TEDISEFSet } ========================================================= + +constructor TEDISEFSet.Create(Parent: TEDISEFDataObject); +begin + inherited Create(Parent); + FEDISEFTextSets := TEDISEFTextSets.Create(False); +end; + +destructor TEDISEFSet.Destroy; +begin + FEDISEFTextSets.Free; + inherited Destroy; +end; + +function TEDISEFSet.Assemble: string; +var + ListItem: TEDISEFDataObjectListItem; +begin + Result := FId + SEFDelimiter_EqualSign; + ListItem := FEDISEFDataObjects.First; + while ListItem <> nil do + begin + Result := Result + ListItem.EDISEFDataObject.Assemble; + ListItem := ListItem.NextItem; + end; +end; + +function TEDISEFSet.Clone(NewParent: TEDISEFDataObject): TEDISEFSet; +begin + Result := nil; +end; + +procedure TEDISEFSet.Disassemble; +begin + // FParent is TEDISEFFile + ParseSetsDataOfSETSDefinition(FData, Self, FSEFFile); + UpdateOwnerItemName; + // Assign segment ordinals that were not explicitly defined + AssignSegmentOrdinals; + // Assign segment positions + AssignSegmentPositions; + // Bind TEXT,SETS to segments + BindSegmentTextSets; + // Misc + if Tables.Count = 3 then + begin + // (rom) make resourcestrings? + Table[0].Id := 'Heading'; + Table[1].Id := 'Detail'; + Table[2].Id := 'Summary'; + end; +end; + +function TEDISEFSet.GetEDISEFTable(Index: Integer): TEDISEFTable; +begin + Result := TEDISEFTable(FEDISEFDataObjects[Index]) +end; + +procedure TEDISEFSet.BuildSegmentObjectListFromLoop(ObjectList: TObjectList; Loop: TEDISEFLoop); +var + ListItem: TEDISEFDataObjectListItem; + NestedLoop: TEDISEFLoop; + Segment: TEDISEFSegment; +begin + ListItem := Loop.EDISEFDataObjects.First; + while ListItem <> nil do + begin + if ListItem.EDISEFDataObject is TEDISEFSegment then + begin + Segment := TEDISEFSegment(ListItem.EDISEFDataObject); + ObjectList.Add(Segment) + end + else + if ListItem.EDISEFDataObject is TEDISEFLoop then + begin + NestedLoop := TEDISEFLoop(ListItem.EDISEFDataObject); + BuildSegmentObjectListFromLoop(ObjectList, NestedLoop); + end; + ListItem := ListItem.NextItem; + end; +end; + +function TEDISEFSet.GetSegmentObjectList: TObjectList; +var + ListItem, ListItem2: TEDISEFDataObjectListItem; + Table: TEDISEFTable; + Loop: TEDISEFLoop; +begin + Result := TObjectList.Create(False); + ListItem := FEDISEFDataObjects.First; + while ListItem <> nil do + begin + Table := TEDISEFTable(ListItem.EDISEFDataObject); + ListItem2 := Table.EDISEFDataObjects.First; + while ListItem2 <> nil do + begin + if ListItem2.EDISEFDataObject is TEDISEFSegment then + Result.Add(ListItem2.EDISEFDataObject) + else + if ListItem2.EDISEFDataObject is TEDISEFLoop then + begin + Loop := TEDISEFLoop(ListItem2.EDISEFDataObject); + BuildSegmentObjectListFromLoop(Result, Loop); + end; + ListItem2 := ListItem2.NextItem; + end; + ListItem := ListItem.NextItem; + end; +end; + +procedure TEDISEFSet.AssignSegmentOrdinals; +var + I: Integer; + Segment: TEDISEFSegment; + SegmentList: TObjectList; + AssignOrdinal: Integer; +begin + SegmentList := GetSegmentObjectList; + try + AssignOrdinal := 0; + for I := 0 to SegmentList.Count - 1 do + begin + Segment := TEDISEFSegment(SegmentList[I]); + if Segment.Ordinal = -1 then + begin + Inc(AssignOrdinal); + Segment.Ordinal := AssignOrdinal; + end + else + begin + AssignOrdinal := Segment.Ordinal; + Segment.OutOfSequenceOrdinal := True; + end; + end; + finally + SegmentList.Free; + end; +end; + +function TEDISEFSet.GetTextSetsLocation: string; +begin + Result := FId; +end; + +procedure TEDISEFSet.BindTextSets(TEXTSETS: TEDISEFTextSets); +begin + FEDISEFTextSets.Free; + FEDISEFTextSets := TEDISEFTextSets(TextSets.ReturnListItemsByName(GetTextSetsLocation)); +end; + +procedure TEDISEFSet.BindSegmentTextSets; +var + I: Integer; + Segment: TEDISEFSegment; + SegmentList: TObjectList; +begin + SegmentList := GetSegmentObjectList; + try + for I := 0 to SegmentList.Count - 1 do + begin + Segment := TEDISEFSegment(SegmentList[I]); + Segment.BindTextSets(FSEFFile.TEXTSETS); + Segment.BindElementTextSets; + end; + finally + SegmentList.Free; + end; +end; + +function TEDISEFSet.AddTable: TEDISEFTable; +begin + Result := AddTableTo(Self); +end; + +function TEDISEFSet.InsertTable(Table, BeforeTable: TEDISEFTable): TEDISEFTable; +begin + Result := InsertTableInto(Self, Table, BeforeTable); +end; + +function TEDISEFSet.InsertTable(BeforeTable: TEDISEFTable): TEDISEFTable; +begin + Result := InsertTableInto(Self, BeforeTable); +end; + +function TEDISEFSet.ExtractTable(Table: TEDISEFTable): TEDISEFTable; +begin + Result := ExtractTableFrom(Self, Table); +end; + +function TEDISEFSet.AppendTable(Table: TEDISEFTable): TEDISEFTable; +begin + Result := AppendTableTo(Self, Table); +end; + +procedure TEDISEFSet.DeleteTable(Table: TEDISEFTable); +begin + DeleteTableFrom(Self, Table); +end; + +procedure TEDISEFSet.AssignSegmentPositions; +var + SegmentList: TObjectList; + I: Integer; + Segment: TEDISEFSegment; + Table: TEDISEFTable; + AssignPosition: Integer; + PositionIncrement: Integer; +begin + SegmentList := GetSegmentObjectList; + try + Table := nil; + AssignPosition := 0; + PositionIncrement := 10; + for I := 0 to SegmentList.Count - 1 do + begin + Segment := TEDISEFSegment(SegmentList[I]); + if Table <> Segment.ParentTable then + begin + Table := Segment.ParentTable; + AssignPosition := 0; + end; + if Segment.ResetPositionInc then + PositionIncrement := Segment.PositionIncrement; + AssignPosition := AssignPosition + PositionIncrement; + Segment.Position := AssignPosition; + Segment.PositionIncrement := PositionIncrement; + end; + finally + SegmentList.Free; + end; +end; + +//=== { TEDISEFFile } ======================================================== + +constructor TEDISEFFile.Create(Parent: TEDISEFDataObject); +begin + inherited Create(nil); + FEDISEFCodesList := TStringList.Create; + FEDISEFElms := TEDISEFDataObjectList.Create; + FEDISEFComs := TEDISEFDataObjectList.Create; + FEDISEFSegs := TEDISEFDataObjectList.Create; + FEDISEFSets := TEDISEFDataObjectList.Create; + FEDISEFStd := TStringList.Create; + FEDISEFIni := TStringList.Create; + // + FEDISEFTextSets := TEDISEFTextSets.Create; +end; + +destructor TEDISEFFile.Destroy; +begin + FEDISEFIni.Free; + FEDISEFStd.Free; + FEDISEFSets.Free; + FEDISEFSegs.Free; + FEDISEFComs.Free; + FEDISEFElms.Free; + FEDISEFCodesList.Free; + FEDISEFTextSets.Free; + inherited Destroy; +end; + +function TEDISEFFile.Assemble: string; +var + I: Integer; +begin + Result := ''; + Result := Result + SectionTag_VER + AnsiSpace + FEDISEFVer + AnsiCrLf; + Result := Result + SectionTag_INI + AnsiCrLf; + Result := Result + INI.Text + AnsiCrLf; + if STD.Text <> '' then + Result := Result + SectionTag_STD + AnsiCrLf; + Result := Result + STD.Text + AnsiCrLf; + if FEDISEFSets.Count > 0 then + begin + Result := Result + SectionTag_SETS + AnsiCrLf; + for I := 0 to FEDISEFSets.Count - 1 do + Result := Result + FEDISEFSets[I].Assemble + AnsiCrLf; + end; + if FEDISEFSegs.Count > 0 then + begin + Result := Result + SectionTag_SEGS + AnsiCrLf; + for I := 0 to FEDISEFSegs.Count - 1 do + Result := Result + FEDISEFSegs[I].Assemble + AnsiCrLf; + end; + if FEDISEFComs.Count > 0 then + begin + Result := Result + SectionTag_COMS + AnsiCrLf; + for I := 0 to FEDISEFComs.Count - 1 do + Result := Result + FEDISEFComs[I].Assemble + AnsiCrLf; + end; + if FEDISEFElms.Count > 0 then + begin + Result := Result + SectionTag_ELMS + AnsiCrLf; + for I := 0 to FEDISEFElms.Count - 1 do + Result := Result + FEDISEFElms[I].Assemble + AnsiCrLf; + end; + if Codes.Text <> '' then + begin + Result := Result + SectionTag_CODES + AnsiCrLf; + Result := Result + Codes.Text + AnsiCrLf; + end; + if FEDISEFTextSets.Count > 0 then + begin + Result := Result + SectionTag_TEXTSETS + AnsiCrLf; + for I := 0 to FEDISEFTextSets.Count - 1 do + if TEDISEFText(FEDISEFTextSets[I]).Text <> '' then + Result := Result + TEDISEFText(FEDISEFTextSets[I]).Assemble + AnsiCrLf; + end; + FData := Result; +end; + +function TEDISEFFile.Clone(NewParent: TEDISEFDataObject): TEDISEFFile; +begin + Result := nil; +end; + +procedure TEDISEFFile.Disassemble; +begin + // Must parse file in reverse order to build specification from the dictionary values + // .TEXT,SETS + ParseTextSets; + // .CODES + ParseCodes; + // .ELMS + ParseELMS; + // .COMS + ParseCOMS; + // .SEGS + ParseSEGS; + // .SETS + ParseSETS; + // .STD + ParseSTD; + // .INI + ParseINI; + // .VER + ParseVER; +end; + +procedure TEDISEFFile.LoadFromFile(const FileName: string); +begin + if FileName <> '' then + FFileName := FileName; + LoadFromFile; +end; + +procedure TEDISEFFile.LoadFromFile; +var + EDIFileStream: TFileStream; +begin + FData := ''; + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmOpenRead or fmShareDenyNone); + try + SetLength(FData, EDIFileStream.Size); + EDIFileStream.Read(Pointer(FData)^, EDIFileStream.Size); + finally + EDIFileStream.Free; + end; + end + else + raise EJclEDIError.CreateRes(@RsEDIError001); +end; + +procedure TEDISEFFile.ParseTextSets; +var + TempList: TStringList; + SearchResult, SearchResult2, I: Integer; + TextSet: TEDISEFTextSet; +begin + TempList := TStringList.Create; + try + FEDISEFTextSets.Clear; + SearchResult := StrSearch(SectionTag_TEXTSETS, FData, 1); + if SearchResult > 0 then + begin + SearchResult := SearchResult + Length(SectionTag_TEXTSETS + AnsiCrLf); + SearchResult2 := StrSearch(AnsiCrLf + SEFDelimiter_Period, FData, SearchResult + 1); + if SearchResult2 <> 0 then + TempList.Text := Copy(FData, SearchResult, SearchResult2 - SearchResult) + else + TempList.Text := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1); + for I := 0 to TempList.Count - 1 do + begin + TextSet := TEDISEFTextSet.Create; + TextSet.Data := TempList[I]; + if TextSet.Data <> '' then + TextSet.Disassemble; + FEDISEFTextSets.Add(TextSet, TextSet.Where); + end; + end; + finally + TempList.Free; + end; +end; + +procedure TEDISEFFile.ParseCodes; +var + SearchResult, SearchResult2: Integer; +begin + Codes.Clear; + SearchResult := StrSearch(SectionTag_CODES, FData, 1); + if SearchResult > 0 then + begin + SearchResult := SearchResult + Length(SectionTag_CODES + AnsiCrLf); + SearchResult2 := StrSearch(AnsiCrLf + SEFDelimiter_Period, FData, SearchResult + 1); + if SearchResult2 <> 0 then + Codes.Text := Copy(FData, SearchResult, SearchResult2 - SearchResult) + else + Codes.Text := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1); + end; +end; + +procedure TEDISEFFile.ParseCOMS; +var + TempList: TStringList; + SearchResult, SearchResult2, I: Integer; + CompositeElement: TEDISEFCompositeElement; +begin + TempList := TStringList.Create; + try + FEDISEFComs.Clear; + SearchResult := StrSearch(SectionTag_COMS, FData, 1); + if SearchResult > 0 then + begin + SearchResult := SearchResult + Length(SectionTag_COMS + AnsiCrLf); + SearchResult2 := StrSearch(AnsiCrLf + SEFDelimiter_Period, FData, SearchResult + 1); + if SearchResult2 <> 0 then + TempList.Text := Copy(FData, SearchResult, SearchResult2 - SearchResult) + else + TempList.Text := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1); + for I := 0 to TempList.Count - 1 do + begin + CompositeElement := TEDISEFCompositeElement.Create(Self); + FEDISEFComs.Add(CompositeElement); + CompositeElement.Data := TempList[I]; + CompositeElement.SEFFile := Self; + if CompositeElement.Data <> '' then + CompositeElement.Disassemble; + end; + end; + finally + TempList.Free; + end; +end; + +procedure TEDISEFFile.ParseELMS; +var + TempList: TStringList; + SearchResult, SearchResult2, I: Integer; + Element: TEDISEFElement; +begin + TempList := TStringList.Create; + try + FEDISEFElms.Clear; + SearchResult := StrSearch(SectionTag_ELMS, FData, 1); + if SearchResult > 0 then + begin + SearchResult := SearchResult + Length(SectionTag_ELMS + AnsiCrLf); + SearchResult2 := StrSearch(AnsiCrLf + SEFDelimiter_Period, FData, SearchResult + 1); + if SearchResult2 <> 0 then + TempList.Text := Copy(FData, SearchResult, SearchResult2 - SearchResult) + else + TempList.Text := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1); + for I := 0 to TempList.Count - 1 do + begin + Element := TEDISEFElement.Create(Self); + FEDISEFElms.Add(Element); + Element.Data := TempList[I]; + Element.SEFFile := Self; + if Element.Data <> '' then + Element.Disassemble; + end; + end; + finally + TempList.Free; + end; +end; + +procedure TEDISEFFile.ParseINI; +var + SearchResult, SearchResult2: Integer; +begin + INI.Clear; + {$IFDEF COMPILER6_UP} + INI.Delimiter := SEFDelimiter_Comma; + {$ELSE} + // TODO : (rom) ? + {$ENDIF COMPILER6_UP} + SearchResult := StrSearch(SectionTag_INI, FData, 1); + if SearchResult > 0 then + begin + SearchResult := SearchResult + Length(SectionTag_INI + AnsiCrLf); + SearchResult2 := StrSearch(AnsiCrLf + SEFDelimiter_Period, FData, SearchResult + 1); + if SearchResult2 <> 0 then + INI.Text := Copy(FData, SearchResult, SearchResult2 - SearchResult) + else + INI.Text := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1); + end; + FId := INI.Text; +end; + +procedure TEDISEFFile.ParseSEGS; +var + TempList: TStringList; + SearchResult, SearchResult2, I: Integer; + Segment: TEDISEFSegment; +begin + TempList := TStringList.Create; + try + FEDISEFSegs.Clear; + SearchResult := StrSearch(SectionTag_SEGS, FData, 1); + if SearchResult > 0 then + begin + SearchResult := SearchResult + Length(SectionTag_SEGS + AnsiCrLf); + SearchResult2 := StrSearch(AnsiCrLf + SEFDelimiter_Period, FData, SearchResult + 1); + if SearchResult2 <> 0 then + TempList.Text := Copy(FData, SearchResult, SearchResult2 - SearchResult) + else + TempList.Text := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1); + for I := 0 to TempList.Count - 1 do + begin + Segment := TEDISEFSegment.Create(Self); + FEDISEFSegs.Add(Segment); + Segment.Data := TempList[I]; + Segment.SEFFile := Self; + if Segment.Data <> '' then + Segment.Disassemble; + end; + end; + finally + TempList.Free; + end; +end; + +procedure TEDISEFFile.ParseSETS; +var + TempList: TStringList; + SearchResult, SearchResult2, I: Integer; + TransactionSet: TEDISEFSet; +begin + TempList := TStringList.Create; + try + FEDISEFSets.Clear; + SearchResult := StrSearch(SectionTag_SETS, FData, 1); + if SearchResult > 0 then + begin + SearchResult := SearchResult + Length(SectionTag_SETS + AnsiCrLf); + SearchResult2 := StrSearch(AnsiCrLf + SEFDelimiter_Period, FData, SearchResult + 1); + if SearchResult2 <> 0 then + TempList.Text := Copy(FData, SearchResult, SearchResult2 - SearchResult) + else + TempList.Text := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1); + for I := 0 to TempList.Count - 1 do + begin + TransactionSet := TEDISEFSet.Create(Self); + FEDISEFSets.Add(TransactionSet); + TransactionSet.Data := TempList[I]; + TransactionSet.SEFFile := Self; + if TransactionSet.Data <> '' then + TransactionSet.Disassemble; + TransactionSet.BindTextSets(FEDISEFTextSets); + end; + end; + finally + TempList.Free; + end; +end; + +procedure TEDISEFFile.ParseSTD; +var + SearchResult, SearchResult2: Integer; +begin + STD.Clear; + {$IFDEF COMPILER6_UP} + STD.Delimiter := SEFDelimiter_Comma; + {$ELSE} + // TODO : (rom) ? + {$ENDIF COMPILER6_UP} + SearchResult := StrSearch(SectionTag_STD, FData, 1); + if SearchResult > 0 then + begin + SearchResult := SearchResult + Length(SectionTag_STD + AnsiCrLf); + SearchResult2 := StrSearch(AnsiCrLf + SEFDelimiter_Period, FData, SearchResult + 1); + if SearchResult2 <> 0 then + begin + {$IFDEF COMPILER6_UP} + STD.DelimitedText := Copy(FData, SearchResult, SearchResult2 - SearchResult); + {$ELSE} + STD.Text := Copy(FData, SearchResult, SearchResult2 - SearchResult); + {$ENDIF COMPILER6_UP} + end + else + begin + {$IFDEF COMPILER6_UP} + STD.DelimitedText := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1); + {$ELSE} + STD.Text := Copy(FData, SearchResult, (Length(FData) - SearchResult) + 1); + {$ENDIF COMPILER6_UP} + end; + end; +end; + +procedure TEDISEFFile.ParseVER; +var + SearchResult, SearchResult2: Integer; +begin + FEDISEFVer := ''; + SearchResult := StrSearch(SectionTag_VER, FData, 1); + if SearchResult > 0 then + begin + SearchResult := SearchResult + Length(SectionTag_VER); + SearchResult2 := StrSearch(AnsiCrLf + SEFDelimiter_Period, FData, SearchResult + 1); + if SearchResult2 <> 0 then + FEDISEFVer := Copy(FData, SearchResult + 1, (SearchResult2 - SearchResult) - 1) + else + FEDISEFVer := Copy(FData, SearchResult + 1, (Length(FData) - SearchResult) - 2); + if FEDISEFVer = '' then + FEDISEFVer := Value_Version10; + end; +end; + +procedure TEDISEFFile.SaveToFile(const FileName: string); +begin + FFileName := FileName; + SaveToFile; +end; + +procedure TEDISEFFile.SaveToFile; +var + EDIFileStream: TFileStream; +begin + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyNone); + try + EDIFileStream.Write(Pointer(FData)^, Length(FData)); + finally + EDIFileStream.Free; + end; + end + else + raise EJclEDIError.CreateRes(@RsEDIError002); +end; + +procedure TEDISEFTable.Disassemble; +begin + // FParent is TEDISEFSet + ParseTableDataOfSETSDefinition(FData, Self, FSEFFile); + UpdateOwnerItemName; +end; + +function TEDISEFFile.GetEDISEFCodesList: TStrings; +begin + Result := FEDISEFCodesList; +end; + +function TEDISEFFile.GetEDISEFStd: TStrings; +begin + Result := FEDISEFStd; +end; + +function TEDISEFFile.GetEDISEFIni: TStrings; +begin + Result := FEDISEFIni; +end; + +procedure TEDISEFFile.Unload; +begin + Codes.Clear; + FEDISEFElms.Clear; + FEDISEFComs.Clear; + FEDISEFSegs.Clear; + FEDISEFSets.Clear; + STD.Clear; + INI.Clear; + FEDISEFVer := ''; +end; + +//=== { TEDISEFRepeatingPattern } ============================================ + +constructor TEDISEFRepeatingPattern.Create(Parent: TEDISEFDataObject); +begin + inherited Create(Parent); + if Parent is TEDISEFRepeatingPattern then + FBaseParent := TEDISEFRepeatingPattern(Parent).BaseParent + else + FBaseParent := Parent; +end; + +destructor TEDISEFRepeatingPattern.Destroy; +begin + inherited Destroy; +end; + +function TEDISEFRepeatingPattern.Assemble: string; +var + ListItem: TEDISEFDataObjectListItem; +begin + Result := IntToStr(FRepeatCount); + ListItem := FEDISEFDataObjects.First; + while ListItem <> nil do + begin + if not (ListItem.EDISEFDataObject is TEDISEFRepeatingPattern) then + Result := Result + SEFDelimiter_OpeningBracket + ListItem.EDISEFDataObject.Assemble + + SEFDelimiter_ClosingBracket + else + Result := Result + SEFDelimiter_OpeningBrace + ListItem.EDISEFDataObject.Assemble + + SEFDelimiter_ClosingBrace; + ListItem := ListItem.NextItem; + end; +end; + +function TEDISEFRepeatingPattern.Clone(NewParent: TEDISEFDataObject): TEDISEFRepeatingPattern; +var + ListItem: TEDISEFDataObjectListItem; + SEFDataObject: TEDISEFDataObject; +begin + Result := TEDISEFRepeatingPattern.Create(NewParent); + Result.Id := FId; + Result.RepeatCount := FRepeatCount; + ListItem := FEDISEFDataObjects.First; + while ListItem <> nil do + begin + if ListItem.EDISEFDataObject <> nil then + begin + SEFDataObject := ListItem.EDISEFDataObject; + if ListItem.EDISEFDataObject is TEDISEFElement then + SEFDataObject := TEDISEFElement(SEFDataObject).Clone(Result) + else + if ListItem.EDISEFDataObject is TEDISEFCompositeElement then + SEFDataObject := TEDISEFCompositeElement(SEFDataObject).Clone(Result) + else + if ListItem.EDISEFDataObject is TEDISEFSegment then + SEFDataObject := TEDISEFSegment(SEFDataObject).Clone(Result) + else + if ListItem.EDISEFDataObject is TEDISEFRepeatingPattern then + SEFDataObject := TEDISEFRepeatingPattern(SEFDataObject).Clone(Result); + Result.EDISEFDataObjects.Add(SEFDataObject, SEFDataObject.Id); + end; + ListItem := ListItem.NextItem; + end; +end; + +procedure TEDISEFRepeatingPattern.Disassemble; +begin + FEDISEFDataObjects.Clear; + FId := FData; + if FParent is TEDISEFCompositeElement then + InternalParseCOMSDataOfCOMSDefinition(FData, Self, FSEFFile.ELMS) + else + if FParent is TEDISEFSegment then + InternalParseSEGSDataOfSEGSDefinition(FData, Self, FSEFFile) + else + if FParent is TEDISEFRepeatingPattern then + begin + if FBaseParent is TEDISEFCompositeElement then + InternalParseCOMSDataOfCOMSDefinition(FData, Self, FSEFFile.ELMS) + else + if FBaseParent is TEDISEFSegment then + InternalParseSEGSDataOfSEGSDefinition(FData, Self, FSEFFile); + end; + UpdateOwnerItemName; +end; + +procedure TEDISEFRepeatingPattern.SetParent(const Value: TEDISEFDataObject); +begin + inherited SetParent(Value); + if Value is TEDISEFRepeatingPattern then + FBaseParent := TEDISEFRepeatingPattern(Value).BaseParent + else + FBaseParent := Value; +end; + +function TEDISEFRepeatingPattern.AddRepeatingPattern: TEDISEFRepeatingPattern; +begin + Result := AddRepeatingPatternTo(Self); +end; + +function TEDISEFRepeatingPattern.AppendRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +begin + Result := AppendRepeatingPatternTo(Self, RepeatingPattern); +end; + +procedure TEDISEFRepeatingPattern.DeleteRepeatingPattern(RepeatingPattern: TEDISEFRepeatingPattern); +begin + DeleteRepeatingPatternFrom(Self, RepeatingPattern); +end; + +function TEDISEFRepeatingPattern.ExtractRepeatingPattern( + RepeatingPattern: TEDISEFRepeatingPattern): TEDISEFRepeatingPattern; +begin + Result := ExtractRepeatingPatternFrom(Self, RepeatingPattern); +end; + +function TEDISEFRepeatingPattern.InsertRepeatingPattern(RepeatingPattern: TEDISEFRepeatingPattern; + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; +begin + Result := InsertRepeatingPatternInto(Self, RepeatingPattern, BeforeObject); +end; + +function TEDISEFRepeatingPattern.InsertRepeatingPattern( + BeforeObject: TEDISEFDataObject): TEDISEFRepeatingPattern; +begin + Result := InsertRepeatingPatternInto(Self, BeforeObject); +end; + +//=== { TEDISEFText } ======================================================== + +constructor TEDISEFText.Create; +begin + inherited Create; + FEDISEFWhereType := twUnknown; + FData := ''; + FWhere := ''; + FWhat := ''; + FText := ''; + FWhereLocation := TStringList.Create; +end; + +destructor TEDISEFText.Destroy; +begin + FWhereLocation.Free; + inherited Destroy; +end; + +function TEDISEFText.Assemble: string; +var + I: Integer; +begin + FWhere := ''; + for I := 0 to WhereLocation.Count - 1 do + begin + if (FWhere <> '') and (WhereLocation[I] <> '') then + FWhere := FWhere + '~'; + FWhere := FWhere + WhereLocation[I]; + end; + Result := FWhere + ',' + FWhat + ',' + FText; +end; + +procedure TEDISEFText.Disassemble; +var + SearchResult, SearchResult2: Integer; +begin + FEDISEFWhereType := twUnknown; + SearchResult := StrSearch(',', FData, 1); + FWhere := Copy(FData, 1, SearchResult - 1); + WhereLocation.Text := Copy(FData, 1, SearchResult - 1); + WhereLocation.CommaText := JclEDI.StringReplace(WhereLocation.Text, '~', ',', [rfReplaceAll]); + SearchResult2 := StrSearch(',', FData, SearchResult + 1); + FWhat := Copy(FData, SearchResult + 1, (SearchResult2 - SearchResult) - 1); + if SearchResult2 > 0 then + FText := Copy(FData, SearchResult2 + 1, Length(FData) - SearchResult2); +end; + +function TEDISEFText.GetData: string; +begin + Result := FData; +end; + +function TEDISEFText.GetWhereLocation: TStrings; +begin + Result := FWhereLocation; +end; + +function TEDISEFText.GetText: string; +begin + Result := FText; + Result := JclEDI.StringReplace(Result, SEFTextCRLF, AnsiCrLf, [rfReplaceAll]); + Result := JclEDI.StringReplace(Result, SEFTextCR, AnsiCarriageReturn, [rfReplaceAll]); + Result := JclEDI.StringReplace(Result, SEFTextLF, AnsiLineFeed, [rfReplaceAll]); +end; + +function TEDISEFText.GetDescription: string; +begin + Result := ''; + case FEDISEFWhereType of + twSet: + case FWhat[1] of + SEFTextSetsCode_Set0: Result := SEFTextSetsCode_Set0_Desc; + SEFTextSetsCode_Set1: Result := SEFTextSetsCode_Set1_Desc; + SEFTextSetsCode_Set2: Result := SEFTextSetsCode_Set2_Desc; + SEFTextSetsCode_Set3: Result := SEFTextSetsCode_Set3_Desc; + SEFTextSetsCode_Set4: Result := SEFTextSetsCode_Set4_Desc; + SEFTextSetsCode_Set5: Result := SEFTextSetsCode_Set5_Desc; + end; + twSegment: + case FWhat[1] of + SEFTextSetsCode_Seg0: Result := SEFTextSetsCode_Seg0_Desc; + SEFTextSetsCode_Seg1: Result := SEFTextSetsCode_Seg1_Desc; + SEFTextSetsCode_Seg2: Result := SEFTextSetsCode_Seg2_Desc; + SEFTextSetsCode_Seg3: Result := SEFTextSetsCode_Seg3_Desc; + SEFTextSetsCode_Seg4: Result := SEFTextSetsCode_Seg4_Desc; + SEFTextSetsCode_Seg5: Result := SEFTextSetsCode_Seg5_Desc; + SEFTextSetsCode_Seg6: Result := SEFTextSetsCode_Seg6_Desc; + SEFTextSetsCode_Seg7: Result := SEFTextSetsCode_Seg7_Desc; + end; + twElementOrCompositeElement, twSubElement: + case FWhat[1] of + SEFTextSetsCode_Elm0: Result := SEFTextSetsCode_Elm0_Desc; + SEFTextSetsCode_Elm1: Result := SEFTextSetsCode_Elm1_Desc; + SEFTextSetsCode_Elm2: Result := SEFTextSetsCode_Elm2_Desc; + SEFTextSetsCode_Elm4: Result := SEFTextSetsCode_Elm4_Desc; + end; + end; +end; + +procedure TEDISEFText.SetData(const Value: string); +begin + FData := Value; +end; + +procedure TEDISEFText.SetText(const Value: string); +var + Temp: string; +begin + Temp := Value; + Temp := JclEDI.StringReplace(Temp, AnsiCrLf, SEFTextCRLF, [rfReplaceAll]); + Temp := JclEDI.StringReplace(Temp, AnsiCarriageReturn, SEFTextCR, [rfReplaceAll]); + Temp := JclEDI.StringReplace(Temp, AnsiLineFeed, SEFTextLF, [rfReplaceAll]); + FText := Temp; +end; + +//=== { TEDISEFTextSet } ===================================================== + +constructor TEDISEFTextSet.Create; +begin + inherited Create; + FWhereSet := ''; + FWhereSegment := -1; + FWhereElement := -1; + FWhereSubElement := -1; +end; + +destructor TEDISEFTextSet.Destroy; +begin + inherited Destroy; +end; + +function TEDISEFTextSet.Assemble: string; +begin + Result := inherited Assemble; +end; + +procedure TEDISEFTextSet.Disassemble; +begin + FWhereSet := ''; + FWhereSegment := -1; + FWhereElement := -1; + FWhereSubElement := -1; + inherited Disassemble; + if WhereLocation.Count >= 1 then + begin + FEDISEFWhereType := twSet; + FWhereSet := WhereLocation[0]; + end; + if WhereLocation.Count >= 2 then + begin + FEDISEFWhereType := twSegment; + FWhereSegment := StrToInt(WhereLocation[1]); + end; + if WhereLocation.Count >= 3 then + begin + FEDISEFWhereType := twElementOrCompositeElement; + try + if WhereLocation[2][1] in AnsiDecDigits then + FWhereElement := StrToInt(WhereLocation[2]); + except + // Eat this error if it occurs for now + end; + end; + if WhereLocation.Count >= 4 then + begin + FEDISEFWhereType := twSubElement; + try + if WhereLocation[3][1] in AnsiDecDigits then + FWhereSubElement := StrToInt(WhereLocation[3]); + except + // Eat this error if it occurs for now + end; + end; +end; + +//=== { TEDISEFTextSets } ==================================================== + +function TEDISEFTextSets.GetText(Code: string): string; +var + ListItem: TEDIObjectListItem; + TextSet: TEDISEFTextSet; +begin + Result := ''; + ListItem := FFirstItem; + while ListItem <> nil do + begin + TextSet := TEDISEFTextSet(ListItem.EDIObject); + if TextSet.What = Code then + begin + Result := TextSet.Text; + Break; + end; + ListItem := ListItem.NextItem; + end; +end; + +procedure TEDISEFTextSets.SetText(EDISEFFile: TEDISEFFile; Location, Code, Text: string); +var + ListItem: TEDIObjectListItem; + TextSet: TEDISEFTextSet; + Found: Boolean; +begin + Found := False; + ListItem := FFirstItem; + while ListItem <> nil do + begin + TextSet := TEDISEFTextSet(ListItem.EDIObject); + if TextSet.What = Code then + begin + TextSet.Text := Text; + Break; + end; + ListItem := ListItem.NextItem; + end; + // If the item is not found then it will be created + if (not Found) and (Text <> '') then + begin + TextSet := TEDISEFTextSet.Create; + TextSet.Data := Location + ',' + Code + ',' + Text; + TextSet.Disassemble; + Add(TextSet, TextSet.Where); + EDISEFFile.TEXTSETS.Add(TextSet, TextSet.Where); + end; +end; + +end. diff --git a/official/1.96/source/common/JclEDITranslators.pas b/official/1.96/source/common/JclEDITranslators.pas new file mode 100644 index 0000000..b8709d3 --- /dev/null +++ b/official/1.96/source/common/JclEDITranslators.pas @@ -0,0 +1,397 @@ +{**************************************************************************************************} +{ } +{ 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 JclEDITranslators.pas. } +{ } +{ The Initial Developer of the Original Code is Raymond Alexander. } +{ Portions created by Raymond Alexander are Copyright Raymond Alexander. All rights reserved. } +{ } +{ Contributor(s): } +{ Raymond Alexander, Robert Marquardt, Robert Rossmair } +{ } +{**************************************************************************************************} +{ } +{ EDI Translators Unit for classes that translate EDI objects from one format to another. } +{ } +{ This unit is still in development } +{ } +{ Unit owner: Raymond Alexander } +{ Last created: October 2, 2003 } +{ Additional Info: } +{ E-Mail at RaysDelphiBox3 att hotmail dott com } +{ For latest EDI specific demos see http://sourceforge.net/projects/edisdk } +{ See home page for latest news & events and online help. } +{ } +{**************************************************************************************************} + +// $Id: JclEDITranslators.pas,v 1.14 2005/02/24 16:34:39 marquardt Exp $ + +unit JclEDITranslators; + +{$I jcl.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$WEAKPACKAGEUNIT ON} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +interface + +uses + SysUtils, + JclEDI, JclEDI_ANSIX12, JclEDISEF; + +type + TEDISpecToSEFTranslator = class(TEDIObject) + public + constructor Create; + destructor Destroy; override; + function TranslateToSEFElement(ElementSpec: TEDIElementSpec; + Parent: TEDISEFFile): TEDISEFElement; overload; + function TranslateToSEFElement(ElementSpec: TEDIElementSpec; + Parent: TEDISEFSegment): TEDISEFElement; overload; + procedure TranslateToSEFElementTEXTSETS(ElementSpec: TEDIElementSpec; + SEFElement: TEDISEFElement); + function TranslateToSEFSegment(SegmentSpec: TEDISegmentSpec; + Parent: TEDISEFFile): TEDISEFSegment; overload; + function TranslateToSEFSegment(SegmentSpec: TEDISegmentSpec; + Parent: TEDISEFTable): TEDISEFSegment; overload; + function TranslateToSEFSegment(SegmentSpec: TEDISegmentSpec; + Parent: TEDISEFLoop): TEDISEFSegment; overload; + procedure TranslateToSEFSegmentTEXTSETS(SegmentSpec: TEDISegmentSpec; + SEFSegment: TEDISEFSegment); + function TranslateToSEFSet(TransactionSetSpec: TEDITransactionSetSpec; + Parent: TEDISEFFile): TEDISEFSet; + procedure TranslateLoopToSEFSet(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); + function TranslateToSEFFile(ICSpec: TEDIInterchangeControlSpec): TEDISEFFile; + end; + + TEDISEFToSpecTranslator = class(TEDIObject) + public + constructor Create; + destructor Destroy; override; + end; + +implementation + +uses + JclStrings; + +//=== { TEDISpecToSEFTranslator } ============================================ + +constructor TEDISpecToSEFTranslator.Create; +begin + inherited Create; +end; + +destructor TEDISpecToSEFTranslator.Destroy; +begin + inherited Destroy; +end; + +function TEDISpecToSEFTranslator.TranslateToSEFElement(ElementSpec: TEDIElementSpec; + Parent: TEDISEFFile): TEDISEFElement; +begin + Result := TEDISEFElement.Create(Parent); + Result.Id := ElementSpec.Id; + Result.ElementType := ElementSpec.ElementType; + Result.MinimumLength := ElementSpec.MinimumLength; + Result.MaximumLength := ElementSpec.MaximumLength; +end; + +function TEDISpecToSEFTranslator.TranslateToSEFElement(ElementSpec: TEDIElementSpec; + Parent: TEDISEFSegment): TEDISEFElement; +var + ListItem: TEDISEFDataObjectListItem; +begin + Result := TEDISEFElement.Create(Parent); + Result.Id := ElementSpec.Id; + ListItem := Parent.SEFFile.ELMS.FindItemByName(ElementSpec.Id); + if ListItem <> nil then + Result.Assign(TEDISEFElement(ListItem.EDISEFDataObject)) + else + begin + Result.ElementType := ElementSpec.ElementType; + Result.MinimumLength := ElementSpec.MinimumLength; + Result.MaximumLength := ElementSpec.MaximumLength; + Result.RequirementDesignator := ElementSpec.RequirementDesignator; + end; +end; + +function TEDISpecToSEFTranslator.TranslateToSEFSegment(SegmentSpec: TEDISegmentSpec; + Parent: TEDISEFFile): TEDISEFSegment; +var + E: Integer; + ElementSpec: TEDIElementSpec; + SEFElement: TEDISEFElement; +begin + Result := TEDISEFSegment.Create(Parent); + Result.Id := SegmentSpec.Id; + Result.RequirementDesignator := SegmentSpec.RequirementDesignator; + Result.MaximumUse := SegmentSpec.MaximumUsage; + for E := 0 to SegmentSpec.ElementCount - 1 do + begin + ElementSpec := TEDIElementSpec(SegmentSpec[E]); + SEFElement := TranslateToSEFElement(ElementSpec, Result); + Result.Elements.Add(SEFElement); + end; +end; + +function TEDISpecToSEFTranslator.TranslateToSEFSegment(SegmentSpec: TEDISegmentSpec; + Parent: TEDISEFTable): TEDISEFSegment; +var + ListItem: TEDISEFDataObjectListItem; +begin + Result := TEDISEFSegment.Create(Parent); + Result.Id := SegmentSpec.Id; + ListItem := Parent.SEFFile.SEGS.FindItemByName(SegmentSpec.Id); + if ListItem <> nil then + Result.Assign(TEDISEFSegment(ListItem.EDISEFDataObject)) + else + begin + Result.RequirementDesignator := SegmentSpec.RequirementDesignator; + Result.MaximumUse := SegmentSpec.MaximumUsage; + end; +end; + +function TEDISpecToSEFTranslator.TranslateToSEFSegment(SegmentSpec: TEDISegmentSpec; + Parent: TEDISEFLoop): TEDISEFSegment; +var + ListItem: TEDISEFDataObjectListItem; +begin + Result := TEDISEFSegment.Create(Parent); + Result.Id := SegmentSpec.Id; + ListItem := Parent.SEFFile.SEGS.FindItemByName(SegmentSpec.Id); + if ListItem <> nil then + Result.Assign(TEDISEFSegment(ListItem.EDISEFDataObject)) + else + begin + Result.RequirementDesignator := SegmentSpec.RequirementDesignator; + Result.MaximumUse := SegmentSpec.MaximumUsage; + end; +end; + +procedure TEDISpecToSEFTranslator.TranslateLoopToSEFSet(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); +var + SEFLoop: TEDISEFLoop; +begin + if StackRecord.EDIObject is TEDISEFDataObjectGroup then + begin + SEFLoop := TEDISEFLoop.Create(TEDISEFDataObject(StackRecord.EDIObject)); + SEFLoop.Id := SegmentId; + TEDISEFDataObjectGroup(StackRecord.EDIObject).EDISEFDataObjects.Add(SEFLoop); + EDIObject := SEFLoop; + end; +end; + +function TEDISpecToSEFTranslator.TranslateToSEFSet(TransactionSetSpec: TEDITransactionSetSpec; + Parent: TEDISEFFile): TEDISEFSet; +var + S: Integer; + SegmentSpec: TEDISegmentSpec; + PrevSegmentSpec: TEDISegmentSpec; + SEFSegment: TEDISEFSegment; + SEFTable: TEDISEFTable; + SEFLoop: TEDISEFLoop; + LS: TEDILoopStack; + LSR: TEDILoopStackRecord; +begin + Result := TEDISEFSet.Create(Parent); + Result.Id := TransactionSetSpec.Id; + + LS := TEDILoopStack.Create; + try + LS.OnAddLoop := TranslateLoopToSEFSet; + // + for S := 0 to TransactionSetSpec.SegmentCount - 1 do + begin + SegmentSpec := TEDISegmentSpec(TransactionSetSpec[S]); + if S = 0 then + begin + // Initialize the stack + SEFTable := TEDISEFTable.Create(Result); + Result.EDISEFDataObjects.Add(SEFTable); + LSR := LS.ValidateLoopStack(SegmentSpec.SegmentID, NA_LoopId, NA_LoopId, 0, SEFTable); + end + else + begin + // Check to see if the sections have changed + PrevSegmentSpec := TEDISegmentSpec(TransactionSetSpec[S-1]); + if SegmentSpec.Section <> PrevSegmentSpec.Section then + begin + // Create new table for new section + SEFTable := TEDISEFTable.Create(Result); + Result.EDISEFDataObjects.Add(SEFTable); + // Re-initialize the stack + LS.Pop(1); + LS.UpdateStackObject(SEFTable); + LSR := LS.ValidateLoopStack(SegmentSpec.SegmentID, SegmentSpec.OwnerLoopId, + SegmentSpec.ParentLoopId, 0, LSR.EDIObject); + end + else + begin + LSR := LS.ValidateLoopStack(SegmentSpec.SegmentID, SegmentSpec.OwnerLoopId, + SegmentSpec.ParentLoopId, 0, LSR.EDIObject); + end; + end; + + // Debug - Keep the following line here in case someone wants to debug what happens to the stack. + // ShowMessage('Current Spec Segment: [' + IntToStr(S) + '] ' + SegmentSpec.SegmentID + #13#10 + + // LS.Debug); + + // Add objects to proper owners + if LSR.EDIObject is TEDISEFTable then + begin + SEFTable := TEDISEFTable(LSR.EDIObject); + SEFSegment := TranslateToSEFSegment(SegmentSpec, SEFTable); + SEFTable.EDISEFDataObjects.Add(SEFSegment); + SEFSegment.ParentSet.AssignSegmentOrdinals; + TranslateToSEFSegmentTEXTSETS(SegmentSpec, SEFSegment); + end + else + if LSR.EDIObject is TEDISEFLoop then + begin + SEFLoop := TEDISEFLoop(LSR.EDIObject); + SEFSegment := TranslateToSEFSegment(SegmentSpec, SEFLoop); + SEFLoop.EDISEFDataObjects.Add(SEFSegment); + SEFSegment.ParentSet.AssignSegmentOrdinals; + TranslateToSEFSegmentTEXTSETS(SegmentSpec, SEFSegment); + end; + end; + finally + LS.Free; + end; +end; + +function TEDISpecToSEFTranslator.TranslateToSEFFile(ICSpec: TEDIInterchangeControlSpec): TEDISEFFile; +var + F, T, S, E: Integer; + ElementList: TEDIObjectList; + SegmentSpec: TEDISegmentSpec; + ElementSpec: TEDIElementSpec; + TransactionSetSpec: TEDITransactionSetSpec; +begin + Result := TEDISEFFile.Create(nil); + + ElementList := TEDIObjectList.Create(False); + try + //Fill Element Dictionary + for F := 0 to ICSpec.FunctionalGroupCount - 1 do + for T := 0 to ICSpec[F].TransactionSetCount - 1 do + for S := 0 to ICSpec[F][T].SegmentCount - 1 do + begin + SegmentSpec := TEDISegmentSpec(ICSpec[F][T][S]); + for E := 0 to SegmentSpec.ElementCount - 1 do + begin + ElementSpec := TEDIElementSpec(SegmentSpec[E]); + if Result.ELMS.FindItemByName(ElementSpec.Id) = nil then + Result.ELMS.Add(TranslateToSEFElement(ElementSpec, Result)) + else + begin + //raise Exception.Create('Element Repeated - Incompatible File'); + end; + end; + end; + //Fill Segment Dictionary + for F := 0 to ICSpec.FunctionalGroupCount - 1 do + for T := 0 to ICSpec[F].TransactionSetCount - 1 do + for S := 0 to ICSpec[F][T].SegmentCount - 1 do + begin + SegmentSpec := TEDISegmentSpec(ICSpec[F][T][S]); + if Result.SEGS.FindItemByName(SegmentSpec.Id) = nil then + Result.SEGS.Add(TranslateToSEFSegment(SegmentSpec, Result)) + else + begin + //raise Exception.Create('Segment Repeated - Incompatible File'); + end; + end; + //Fill Transaction Set Dictionary + for F := 0 to ICSpec.FunctionalGroupCount - 1 do + for T := 0 to ICSpec[F].TransactionSetCount - 1 do + for S := 0 to ICSpec[F][T].SegmentCount - 1 do + begin + TransactionSetSpec := TEDITransactionSetSpec(ICSpec[F][T]); + if Result.SETS.FindItemByName(TransactionSetSpec.Id) = nil then + Result.SETS.Add(TranslateToSEFSet(TransactionSetSpec, Result)) + else + begin + //raise Exception.Create('Segment Repeated - Incompatible File'); + end; + end; + finally + ElementList.Free; + end; +end; + +procedure TEDISpecToSEFTranslator.TranslateToSEFElementTEXTSETS(ElementSpec: TEDIElementSpec; + SEFElement: TEDISEFElement); +var + Location: string; + Data: string; +begin + Location := SEFElement.GetTextSetsLocation; + Data := ElementSpec.Notes; + Data := JclEDI.StringReplace(Data, AnsiCrLf, SEFTextCRLF, [rfReplaceAll]); + Data := JclEDI.StringReplace(Data, AnsiCarriageReturn, SEFTextCR, [rfReplaceAll]); + Data := JclEDI.StringReplace(Data, AnsiLineFeed, SEFTextLF, [rfReplaceAll]); + SEFElement.TEXTSETS.SetText(SEFElement.SEFFile, Location, SEFTextSetsCode_Elm0, Data); + Data := ElementSpec.Description; + Data := JclEDI.StringReplace(Data, AnsiCrLf, SEFTextCRLF, [rfReplaceAll]); + Data := JclEDI.StringReplace(Data, AnsiCarriageReturn, SEFTextCR, [rfReplaceAll]); + Data := JclEDI.StringReplace(Data, AnsiLineFeed, SEFTextLF, [rfReplaceAll]); + SEFElement.TEXTSETS.SetText(SEFElement.SEFFile, Location, SEFTextSetsCode_Elm2, Data); +end; + +procedure TEDISpecToSEFTranslator.TranslateToSEFSegmentTEXTSETS(SegmentSpec: TEDISegmentSpec; + SEFSegment: TEDISEFSegment); +var + Location: string; + E: Integer; + ElementSpec: TEDIElementSpec; + SEFElement: TEDISEFElement; + Data: string; +begin + Location := SEFSegment.GetTextSetsLocation; + Data := SegmentSpec.Description; + Data := JclEDI.StringReplace(Data, AnsiCrLf, SEFTextCRLF, [rfReplaceAll]); + Data := JclEDI.StringReplace(Data, AnsiCarriageReturn, SEFTextCR, [rfReplaceAll]); + Data := JclEDI.StringReplace(Data, AnsiLineFeed, SEFTextLF, [rfReplaceAll]); + SEFSegment.TEXTSETS.SetText(SEFSegment.SEFFile, Location, SEFTextSetsCode_Seg3, Data); + Data := SegmentSpec.Notes; + Data := JclEDI.StringReplace(Data, AnsiCrLf, SEFTextCRLF, [rfReplaceAll]); + Data := JclEDI.StringReplace(Data, AnsiCarriageReturn, SEFTextCR, [rfReplaceAll]); + Data := JclEDI.StringReplace(Data, AnsiLineFeed, SEFTextLF, [rfReplaceAll]); + SEFSegment.TEXTSETS.SetText(SEFSegment.SEFFile, Location, SEFTextSetsCode_Seg4, Data); + + SEFSegment.AssignElementOrdinals; + for E := 0 to SegmentSpec.ElementCount - 1 do + begin + ElementSpec := TEDIElementSpec(SegmentSpec[E]); + SEFElement := TEDISEFElement(SEFSegment[E]); + TranslateToSEFElementTEXTSETS(ElementSpec, SEFElement); + end; +end; + +//=== { TEDISEFToSpecTranslator } ============================================ + +constructor TEDISEFToSpecTranslator.Create; +begin + inherited Create; +end; + +destructor TEDISEFToSpecTranslator.Destroy; +begin + inherited Destroy; +end; + +end. diff --git a/official/1.96/source/common/JclEDIXML.pas b/official/1.96/source/common/JclEDIXML.pas new file mode 100644 index 0000000..b33ff9f --- /dev/null +++ b/official/1.96/source/common/JclEDIXML.pas @@ -0,0 +1,2673 @@ +{**************************************************************************************************} +{ } +{ 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 JclEDIXML.pas. } +{ } +{ The Initial Developer of the Original Code is Raymond Alexander. } +{ Portions created by Raymond Alexander are Copyright (C) Raymond Alexander. All rights reserved. } +{ } +{ Contributor(s): } +{ Raymond Alexander (rayspostbox3), Robert Marquardt, Robert Rossmair, Petr Vones } +{ } +{**************************************************************************************************} +{ } +{ A complementary unit to JclEDI.pas. } +{ } +{ Unit owner: Raymond Alexander } +{ Date created: March 6, 2003 } +{ Additional Info: } +{ E-Mail at RaysDelphiBox3 att hotmail dott com } +{ For latest EDI specific demos see http://sourceforge.net/projects/edisdk } +{ See home page for latest news & events and online help. } +{ } +{**************************************************************************************************} +{ } +{ 04/21/2003 (R.A.) } +{ } +{ The current status of this unit is experimental. } +{ } +{**************************************************************************************************} + +// $Id: JclEDIXML.pas,v 1.13 2005/03/08 08:33:16 marquardt Exp $ + +unit JclEDIXML; + +{$I jcl.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$WEAKPACKAGEUNIT ON} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +interface + +uses + SysUtils, Classes, + JclEDI, JclEDI_ANSIX12; + +const + XMLTag_Element = 'Element'; + XMLTag_Segment = 'Segment'; + XMLTag_TransactionSetLoop = 'Loop'; + XMLTag_TransactionSet = 'TransactionSet'; + XMLTag_FunctionalGroup = 'FunctionalGroup'; + XMLTag_InterchangeControl = 'InterchangeControl'; + XMLTag_EDIFile = 'EDIFile'; + XMLTag_ICHSegmentId = ICHSegmentId; // Interchange Control Header Segment Id + XMLTag_ICTSegmentId = ICTSegmentId; // Interchange Control Trailer Segment Id + XMLTag_FGHSegmentId = FGHSegmentId; // Functional Group Header Segment Id + XMLTag_FGTSegmentId = FGTSegmentId; // Functional Group Trailer Segment Id + XMLTag_TSHSegmentId = TSHSegmentId; // Transaction Set Header Segment Id + XMLTag_TSTSegmentId = TSTSegmentId; // Transaction Set Trailer Segment Id + XMLAttribute_Id = 'Id'; + XMLAttribute_Position = 'Position'; + XMLAttribute_Description = 'Description'; + XMLAttribute_RequirementDesignator = 'RequirementDesignator'; + XMLAttribute_Type = 'Type'; + XMLAttribute_MinimumLength = 'MinimumLength'; + XMLAttribute_MaximumLength = 'MaximumLength'; + XMLAttribute_Section = 'Section'; + XMLAttribute_MaximumUsage = 'MaximumUsage'; + XMLAttribute_OwnerLoopId = 'OwnerLoopId'; + XMLAttribute_ParentLoopId = 'ParentLoopId'; + +type + // EDI Forward Class Declarations + TEDIXMLObject = class(TEDIObject); + TEDIXMLDataObject = class; + TEDIXMLElement = class; + TEDIXMLSegment = class; + TEDIXMLTransactionSet = class; + TEDIXMLFunctionalGroup = class; + TEDIXMLInterchangeControl = class; + TEDIXMLFile = class; + + // EDI Delimiters Object + TEDIXMLDelimiters = class(TEDIXMLObject) + private + FBeginTagDelimiter: string; + FEndTagDelimiter: string; + FBeginTagLength: Integer; + FEndTagLength: Integer; + FBeginCDataDelimiter: string; + FEndCDataDelimiter: string; + FBeginCDataLength: Integer; + FEndCDataLength: Integer; + FBeginOfEndTagDelimiter: string; + FBeginOfEndTagLength: Integer; + //Special Delimiters for Attributes + FSpaceDelimiter: string; + FAssignmentDelimiter: string; + FSingleQuote: string; + FDoubleQuote: string; + procedure SetBeginTagDelimiter(const Value: string); + procedure SetEndTagDelimiter(const Value: string); + procedure SetBeginCDataDelimiter(const Value: string); + procedure SetEndCDataDelimiter(const Value: string); + procedure SetBeginOfEndTagDelimiter(const Value: string); + public + constructor Create; + published + property BTD: string read FBeginTagDelimiter write SetBeginTagDelimiter; + property ETD: string read FEndTagDelimiter write SetEndTagDelimiter; + property BTDLength: Integer read FBeginTagLength; + property ETDLength: Integer read FEndTagLength; + property BOfETD: string read FBeginOfEndTagDelimiter write SetBeginOfEndTagDelimiter; + property BOfETDLength: Integer read FBeginOfEndTagLength; + property BCDataD: string read FBeginCDataDelimiter write SetBeginCDataDelimiter; + property ECDataD: string read FEndCDataDelimiter write SetEndCDataDelimiter; + property BCDataLength: Integer read FBeginCDataLength; + property ECDataLength: Integer read FEndCDataLength; + //Special Delimiters for Attributes + property SpaceDelimiter: string read FSpaceDelimiter write FSpaceDelimiter; + property AssignmentDelimiter: string read FAssignmentDelimiter write FAssignmentDelimiter; + property SingleQuote: string read FSingleQuote write FSingleQuote; + property DoubleQuote: string read FDoubleQuote write FDoubleQuote; + end; + + // EDI XML Attributes + TEDIXMLAttributes = class(TEDIXMLObject) + private + FAttributes: TStringList; + FDelimiters: TEDIXMLDelimiters; + public + constructor Create; + destructor Destroy; override; + procedure ParseAttributes(XMLStartTag: string); + function CombineAttributes: string; + procedure SetAttribute(Name, Value: string); + function CheckAttribute(Name, Value: string): Integer; + function GetAttributeValue(Name: string): string; + function GetAttributeString(Name: string): string; + end; + + // EDI Data Object + TEDIXMLObjectArray = array of TEDIXMLObject; + + TEDIXMLDataObject = class(TEDIXMLObject) + private + procedure SetDelimiters(const Delimiters: TEDIXMLDelimiters); + protected + FEDIDOT: TEDIDataObjectType; + FState: TEDIDataObjectDataState; + FData: string; + FLength: Integer; + FParent: TEDIXMLDataObject; + FDelimiters: TEDIXMLDelimiters; + FAttributes: TEDIXMLAttributes; + FErrorLog: TStrings; + FSpecPointer: Pointer; + FCustomData1: Pointer; + FCustomData2: Pointer; + function GetData: string; + procedure SetData(const Data: string); + function Assemble: string; virtual; abstract; + procedure Disassemble; virtual; abstract; + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; + destructor Destroy; override; + property SpecPointer: Pointer read FSpecPointer write FSpecPointer; + property CustomData1: Pointer read FCustomData1 write FCustomData1; + property CustomData2: Pointer read FCustomData2 write FCustomData2; + published + property State: TEDIDataObjectDataState read FState; + property Data: string read GetData write SetData; + property DataLength: Integer read FLength; + property Parent: TEDIXMLDataObject read FParent write FParent; + property Delimiters: TEDIXMLDelimiters read FDelimiters write SetDelimiters; + property Attributes: TEDIXMLAttributes read FAttributes write FAttributes; + end; + + TEDIXMLDataObjectArray = array of TEDIXMLDataObject; + + // EDI Element + TEDIXMLElement = class(TEDIXMLDataObject) + FCData: Boolean; + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; + function InternalAssignDelimiters: TEDIXMLDelimiters; virtual; + function Assemble: string; override; + procedure Disassemble; override; + function GetIndexPositionFromParent: Integer; + published + property CData: Boolean read FCData write FCData; + end; + + TEDIXMLElementArray = array of TEDIXMLElement; + + // EDI Data Object Group + TEDIXMLDataObjectGroup = class(TEDIXMLDataObject) + protected + FEDIDataObjects: TEDIXMLDataObjectArray; + function GetEDIDataObject(Index: Integer): TEDIXMLDataObject; + procedure SetEDIDataObject(Index: Integer; EDIDataObject: TEDIXMLDataObject); + function InternalAssignDelimiters: TEDIXMLDelimiters; virtual; abstract; + function InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; virtual; abstract; + function SearchForSegmentInDataString(Id: string; StartPos: Integer): Integer; + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; + destructor Destroy; override; + // + // ToDo: More procedures and functions to manage internal structures + // + function AppendEDIDataObject(EDIDataObject: TEDIXMLDataObject): Integer; + function InsertEDIDataObject(InsertIndex: Integer; EDIDataObject: TEDIXMLDataObject): Integer; + procedure DeleteEDIDataObject(Index: Integer); overload; + procedure DeleteEDIDataObject(EDIDataObject: TEDIXMLDataObject); overload; + // + function AddSegment: Integer; + function InsertSegment(InsertIndex: Integer): Integer; + // + function AddGroup: Integer; virtual; + function InsertGroup(InsertIndex: Integer): Integer; virtual; + // + procedure DeleteEDIDataObjects; + property EDIDataObject[Index: Integer]: TEDIXMLDataObject read GetEDIDataObject + write SetEDIDataObject; default; + property EDIDataObjects: TEDIXMLDataObjectArray read FEDIDataObjects write FEDIDataObjects; + end; + + // EDI Segment Classes + TEDIXMLSegment = class(TEDIXMLDataObject) + private + FSegmentID: string; + FElements: TEDIXMLElementArray; + function GetElement(Index: Integer): TEDIXMLElement; + procedure SetElement(Index: Integer; Element: TEDIXMLElement); + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; overload; + constructor Create(Parent: TEDIXMLDataObject; ElementCount: Integer); reintroduce; overload; + destructor Destroy; override; + // + function InternalAssignDelimiters: TEDIXMLDelimiters; virtual; + function InternalCreateElement: TEDIXMLElement; virtual; + // + function AddElement: Integer; + function AppendElement(Element: TEDIXMLElement): Integer; + function InsertElement(InsertIndex: Integer): Integer; overload; + function InsertElement(InsertIndex: Integer; Element: TEDIXMLElement): Integer; overload; + procedure DeleteElement(Index: Integer); overload; + procedure DeleteElement(Element: TEDIXMLElement); overload; + // + function AddElements(Count: Integer): Integer; + function AppendElements(ElementArray: TEDIXMLElementArray): Integer; + function InsertElements(InsertIndex, Count: Integer): Integer; overload; + function InsertElements(InsertIndex: Integer; + ElementArray: TEDIXMLElementArray): Integer; overload; + procedure DeleteElements; overload; + procedure DeleteElements(Index, Count: Integer); overload; + // + function Assemble: string; override; + procedure Disassemble; override; + function GetIndexPositionFromParent: Integer; + property Element[Index: Integer]: TEDIXMLElement read GetElement write SetElement; default; + property Elements: TEDIXMLElementArray read FElements write FElements; + published + property SegmentID: string read FSegmentID write FSegmentID; + end; + + TEDIXMLSegmentArray = array of TEDIXMLSegment; + + TEDIXMLTransactionSetSegment = class(TEDIXMLSegment) + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; overload; + constructor Create(Parent: TEDIXMLDataObject; ElementCount: Integer); reintroduce; overload; + function InternalAssignDelimiters: TEDIXMLDelimiters; override; + end; + + TEDIXMLFunctionalGroupSegment = class(TEDIXMLSegment) + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; overload; + constructor Create(Parent: TEDIXMLDataObject; ElementCount: Integer); reintroduce; overload; + function InternalAssignDelimiters: TEDIXMLDelimiters; override; + end; + + TEDIXMLInterchangeControlSegment = class(TEDIXMLSegment) + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; overload; + constructor Create(Parent: TEDIXMLDataObject; ElementCount: Integer); reintroduce; overload; + function InternalAssignDelimiters: TEDIXMLDelimiters; override; + end; + + // EDI Transaction Set Loop + TEDIXMLTransactionSetLoop = class(TEDIXMLDataObjectGroup) + private + FParentTransactionSet: TEDIXMLTransactionSet; + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; + destructor Destroy; override; + function InternalAssignDelimiters: TEDIXMLDelimiters; override; + function InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; override; + function Assemble: string; override; + procedure Disassemble; override; + published + property ParentTransactionSet: TEDIXMLTransactionSet read FParentTransactionSet + write FParentTransactionSet; + end; + + // EDI Transaction Set + TEDIXMLTransactionSet = class(TEDIXMLTransactionSetLoop) + private + FSTSegment: TEDIXMLSegment; + FSESegment: TEDIXMLSegment; + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; + destructor Destroy; override; + function InternalAssignDelimiters: TEDIXMLDelimiters; override; + function InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; override; + function Assemble: string; override; + procedure Disassemble; override; + published + property SegmentST: TEDIXMLSegment read FSTSegment write FSTSegment; + property SegmentSE: TEDIXMLSegment read FSESegment write FSESegment; + end; + + // EDI Functional Group + TEDIXMLFunctionalGroup = class(TEDIXMLDataObjectGroup) + private + FGSSegment: TEDIXMLSegment; + FGESegment: TEDIXMLSegment; + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; + destructor Destroy; override; + function InternalAssignDelimiters: TEDIXMLDelimiters; override; + function InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; override; + function Assemble: string; override; + procedure Disassemble; override; + published + property SegmentGS: TEDIXMLSegment read FGSSegment write FGSSegment; + property SegmentGE: TEDIXMLSegment read FGESegment write FGESegment; + end; + + // EDI Interchange Control + TEDIXMLInterchangeControl = class(TEDIXMLDataObjectGroup) + private + FISASegment: TEDIXMLSegment; + FIEASegment: TEDIXMLSegment; + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; + destructor Destroy; override; + function InternalAssignDelimiters: TEDIXMLDelimiters; override; + function InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; override; + function Assemble: string; override; + procedure Disassemble; override; + published + property SegmentISA: TEDIXMLSegment read FISASegment write FISASegment; + property SegmentIEA: TEDIXMLSegment read FIEASegment write FIEASegment; + end; + + // EDI XML File Header + TEDIXMLNameSpaceOption = (nsNone, nsDefault, nsQualified); + + TEDIXMLFileHeader = class(TEDIXMLObject) + private + FDelimiters: TEDIXMLDelimiters; + FAttributes: TEDIXMLAttributes; + FXMLNameSpaceOption: TEDIXMLNameSpaceOption; + protected + function OutputAdditionalXMLHeaderAttributes: string; virtual; + public + constructor Create; + destructor Destroy; override; + procedure ParseXMLHeader(XMLHeader: string); + function OutputXMLHeader: string; + published + property Delimiters: TEDIXMLDelimiters read FDelimiters; + property Attributes: TEDIXMLAttributes read FAttributes; + property XMLNameSpaceOption: TEDIXMLNameSpaceOption read FXMLNameSpaceOption + write FXMLNameSpaceOption; + end; + + // EDI XML File + TEDIXMLFile = class(TEDIXMLDataObjectGroup) + private + FFileID: Integer; + FFileName: string; + FEDIXMLFileHeader: TEDIXMLFileHeader; + procedure InternalLoadFromFile; + public + constructor Create(Parent: TEDIXMLDataObject); reintroduce; + destructor Destroy; override; + + function InternalAssignDelimiters: TEDIXMLDelimiters; override; + function InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; override; + + procedure LoadFromFile(const FileName: string); + procedure ReLoadFromFile; + procedure SaveToFile; + procedure SaveAsToFile(const FileName: string); + + function Assemble: string; override; + procedure Disassemble; override; + published + property FileID: Integer read FFileID write FFileID; + property FileName: string read FFileName write FFileName; + property XMLFileHeader: TEDIXMLFileHeader read FEDIXMLFileHeader; + end; + + // EDI XML Format Translator + TEDIXMLANSIX12FormatTranslator = class(TEDIObject) + private + procedure ConvertTransactionSetLoopToXML(EDILoop: TEDITransactionSetLoop; + XMLLoop: TEDIXMLTransactionSetLoop); + procedure ConvertTransactionSetLoopToEDI(EDITransactionSet: TEDITransactionSet; + XMLLoop: TEDIXMLTransactionSetLoop); + protected + public + constructor Create; + destructor Destroy; override; + // + function ConvertToXMLSegment(EDISegment: TEDISegment): TEDIXMLSegment; + function ConvertToXMLTransaction( + EDITransactionSet: TEDITransactionSet): TEDIXMLTransactionSet; overload; + function ConvertToXMLTransaction(EDITransactionSet: TEDITransactionSet; + EDITransactionSetSpec: TEDITransactionSetSpec): TEDIXMLTransactionSet; overload; + function ConvertToEDISegment(XMLSegment: TEDIXMLSegment): TEDISegment; + function ConvertToEDITransaction( + XMLTransactionSet: TEDIXMLTransactionSet): TEDITransactionSet; + end; + +implementation + +uses + JclResources, JclStrings; + +const + EDIXML_Ampersand = '&'; + EDIXML_LessThanSign = '<'; + EDIXML_GreaterThanSign = '>'; + EDIXML_QuotationMark = '"'; + EDIXML_Apostrophe = ''''; + + EDIXML_HTMLAmpersand = '&'; + EDIXML_HTMLLessThanSign = '<'; + EDIXML_HTMLGreaterThanSign = '>'; + EDIXML_HTMLQuotationMark = '"'; + EDIXML_HTMLApostrophe = '''; + + EDIXMLDelimiter_ForwardSlash = '/'; + EDIXMLDelimiter_EqualToSign = '='; + EDIXMLDelimiter_CDATABegin = ''; + EDIXMLDelimiter_FileHeaderBegin = ''; + + EDIXMLAttributeStr_version = 'version'; + EDIXMLAttributeStr_encoding = 'encoding'; + EDIXMLAttributeStr_xmlns = 'xmlns'; + EDIXMLAttributeStr_xmlnsEDI = 'xmlns:EDI'; + + Value_xml = 'xml'; + Value_Version10 = '1.0'; + Value_Windows1252 = 'windows-1252'; + Value_EDITRANSDOC = 'EDITRANSDOC'; + +//=== { TEDIXMLDelimiters } ================================================== + +constructor TEDIXMLDelimiters.Create; +begin + inherited Create; + SetBeginTagDelimiter(EDIXML_LessThanSign); + SetBeginOfEndTagDelimiter(FBeginTagDelimiter + EDIXMLDelimiter_ForwardSlash); + SetEndTagDelimiter(EDIXML_GreaterThanSign); + FSpaceDelimiter := AnsiSpace; + FAssignmentDelimiter := EDIXMLDelimiter_EqualToSign; + FSingleQuote := EDIXML_Apostrophe; + FDoubleQuote := EDIXML_QuotationMark; + SetBeginCDataDelimiter(EDIXMLDelimiter_CDATABegin); + SetEndCDataDelimiter(EDIXMLDelimiter_CDATAEnd); +end; + +procedure TEDIXMLDelimiters.SetBeginCDataDelimiter(const Value: string); +begin + FBeginCDataDelimiter := Value; + FBeginCDataLength := Length(FBeginCDataDelimiter); +end; + +procedure TEDIXMLDelimiters.SetBeginOfEndTagDelimiter(const Value: string); +begin + FBeginOfEndTagDelimiter := Value; + FBeginOfEndTagLength := Length(FBeginOfEndTagDelimiter); +end; + +procedure TEDIXMLDelimiters.SetBeginTagDelimiter(const Value: string); +begin + FBeginTagDelimiter := Value; + FBeginTagLength := Length(FBeginTagDelimiter); +end; + +procedure TEDIXMLDelimiters.SetEndCDataDelimiter(const Value: string); +begin + FEndCDataDelimiter := Value; + FEndCDataLength := Length(FEndCDataDelimiter); +end; + +procedure TEDIXMLDelimiters.SetEndTagDelimiter(const Value: string); +begin + FEndTagDelimiter := Value; + FEndTagLength := Length(FEndTagDelimiter); +end; + +//=== { TEDIXMLAttributes } ================================================== + +constructor TEDIXMLAttributes.Create; +begin + inherited Create; + FAttributes := TStringList.Create; + FDelimiters := TEDIXMLDelimiters.Create; +end; + +destructor TEDIXMLAttributes.Destroy; +begin + FDelimiters.Free; + FAttributes.Free; + inherited Destroy; +end; + +function TEDIXMLAttributes.CheckAttribute(Name, Value: string): Integer; +begin + Result := -1; + if FAttributes.Values[Name] = Value then + Result := FAttributes.IndexOfName(Name); +end; + +function TEDIXMLAttributes.CombineAttributes: string; +var + I, J, K: Integer; + QuoteDelimiter: string; +begin + Result := ''; + for I := 0 to FAttributes.Count - 1 do + begin + {$IFDEF COMPILER7_UP} + J := StrSearch(FDelimiters.SingleQuote, FAttributes.ValueFromIndex[I]); + K := StrSearch(FDelimiters.DoubleQuote, FAttributes.ValueFromIndex[I]); + {$ELSE} + J := StrSearch(FDelimiters.SingleQuote, FAttributes.Values[FAttributes.Names[I]]); + K := StrSearch(FDelimiters.DoubleQuote, FAttributes.Values[FAttributes.Names[I]]); + {$ENDIF COMPILER7_UP} + if J > K then + QuoteDelimiter := FDelimiters.SingleQuote + else + QuoteDelimiter := FDelimiters.DoubleQuote; + if Result <> '' then + Result := Result + FDelimiters.SpaceDelimiter; + {$IFDEF COMPILER7_UP} + Result := Result + FAttributes.Names[I] + FDelimiters.AssignmentDelimiter + + QuoteDelimiter + FAttributes.ValueFromIndex[I] + QuoteDelimiter; + {$ELSE} + Result := Result + FAttributes.Names[I] + FDelimiters.AssignmentDelimiter + + QuoteDelimiter + FAttributes.Values[FAttributes.Names[I]] + QuoteDelimiter; + {$ENDIF COMPILER7_UP} + end; +end; + +function TEDIXMLAttributes.GetAttributeString(Name: string): string; +var + J, K: Integer; + QuoteDelimiter: string; +begin + Result := ''; + J := StrSearch(FDelimiters.SingleQuote, FAttributes.Values[Name]); + K := StrSearch(FDelimiters.DoubleQuote, FAttributes.Values[Name]); + if J > K then + QuoteDelimiter := FDelimiters.SingleQuote + else + QuoteDelimiter := FDelimiters.DoubleQuote; + Result := Name + FDelimiters.AssignmentDelimiter + + QuoteDelimiter + FAttributes.Values[Name] + QuoteDelimiter; +end; + +function TEDIXMLAttributes.GetAttributeValue(Name: string): string; +begin + Result := FAttributes.Values[Name]; +end; + +procedure TEDIXMLAttributes.ParseAttributes(XMLStartTag: string); +var + SearchResult: Integer; + EndDataChar: string; + Attribute, Value: string; + AttributeStart, AttributeLen: Integer; + ValueStart, ValueLen: Integer; +begin + FAttributes.Clear; + // Search for begin of attribute + SearchResult := StrSearch(FDelimiters.SpaceDelimiter, XMLStartTag, 1); + AttributeStart := SearchResult + Length(FDelimiters.SpaceDelimiter); + while SearchResult > 0 do + begin + // Get the end data delimiter + SearchResult := StrSearch(FDelimiters.AssignmentDelimiter, XMLStartTag, AttributeStart); + if SearchResult > 0 then + begin + AttributeLen := SearchResult - AttributeStart; + ValueStart := SearchResult + Length(FDelimiters.AssignmentDelimiter); + EndDataChar := Copy(XMLStartTag, ValueStart, 1); + // Search for end of data + ValueStart := ValueStart + Length(FDelimiters.AssignmentDelimiter); + SearchResult := StrSearch(EndDataChar, XMLStartTag, ValueStart); + if SearchResult > 0 then + begin + ValueLen := SearchResult - ValueStart; + Attribute := Copy(XMLStartTag, AttributeStart, AttributeLen); + Value := Copy(XMLStartTag, ValueStart, ValueLen); + FAttributes.Values[Attribute] := Value; + end; + // Search for begin of attribute + SearchResult := StrSearch(FDelimiters.SpaceDelimiter, XMLStartTag, SearchResult); + AttributeStart := SearchResult + Length(FDelimiters.SpaceDelimiter); + end; + end; +end; + +procedure TEDIXMLAttributes.SetAttribute(Name, Value: string); +begin + FAttributes.Values[Name] := Value; +end; + +//=== { TEDIXMLDataObject } ================================================== + +constructor TEDIXMLDataObject.Create(Parent: TEDIXMLDataObject); +begin + inherited Create; + FState := ediCreated; + FEDIDOT := ediUnknown; + FData := ''; + FLength := 0; + FParent := Parent; + FDelimiters := nil; + FAttributes := TEDIXMLAttributes.Create; +end; + +destructor TEDIXMLDataObject.Destroy; +begin + FAttributes.Free; + if not Assigned(FParent) then + FDelimiters.Free; + FDelimiters := nil; + inherited Destroy; +end; + +function TEDIXMLDataObject.GetData: string; +begin + Result := FData; +end; + +procedure TEDIXMLDataObject.SetData(const Data: string); +begin + FData := Data; + FLength := Length(FData); +end; + +procedure TEDIXMLDataObject.SetDelimiters(const Delimiters: TEDIXMLDelimiters); +begin + if not Assigned(FParent) then + FreeAndNil(FDelimiters); + FDelimiters := Delimiters; +end; + +//=== { TEDIXMLElement } ===================================================== + +constructor TEDIXMLElement.Create(Parent: TEDIXMLDataObject); +begin + if Assigned(Parent) and (Parent is TEDIXMLSegment) then + inherited Create(Parent) + else + inherited Create(nil); + FEDIDOT := ediElement; + FCData := False; +end; + +function TEDIXMLElement.Assemble: string; +var + AttributeString: string; + OriginalData: string; +begin + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError047); + end; + + OriginalData := FData; + // Handle Entity Reference Characters + StrReplace(OriginalData, EDIXML_Ampersand, EDIXML_HTMLAmpersand, [rfReplaceAll]); + StrReplace(OriginalData, EDIXML_LessThanSign, EDIXML_HTMLLessThanSign, [rfReplaceAll]); + StrReplace(OriginalData, EDIXML_GreaterThanSign, EDIXML_HTMLGreaterThanSign, [rfReplaceAll]); + StrReplace(OriginalData, EDIXML_QuotationMark, EDIXML_HTMLQuotationMark, [rfReplaceAll]); + StrReplace(OriginalData, EDIXML_Apostrophe, EDIXML_HTMLApostrophe, [rfReplaceAll]); + // + AttributeString := FAttributes.CombineAttributes; + if AttributeString <> '' then + FData := FDelimiters.BTD + XMLTag_Element + FDelimiters.SpaceDelimiter + + AttributeString + FDelimiters.ETD + else + FData := FDelimiters.BTD + XMLTag_Element + FDelimiters.ETD; + + if FCData then + FData := FData + FDelimiters.BCDataD + OriginalData + FDelimiters.ECDataD + else + FData := FData + OriginalData; + + FData := FData + FDelimiters.BOfETD + XMLTag_Element + FDelimiters.ETD; + + Result := FData; + FState := ediAssembled; +end; + +procedure TEDIXMLElement.Disassemble; +var + StartPos, EndPos, SearchResult: Integer; + XMLStartTag: string; +begin + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError046); + end; + // Set next start positon + StartPos := 1; + // Move past begin element tag + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_Element, FData, StartPos); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + XMLStartTag := Copy(FData, StartPos, (SearchResult + FDelimiters.ETDLength) - StartPos); + FAttributes.ParseAttributes(XMLStartTag); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError048); + // Set data start positon + StartPos := SearchResult + FDelimiters.ETDLength; + // Check for CData tag + FCData := False; + SearchResult := StrSearch(FDelimiters.BCDataD, FData, StartPos); + if SearchResult > 0 then + begin + StartPos := SearchResult + FDelimiters.BCDataLength; + FCData := True; + end; + // + SearchResult := StrSearch(FDelimiters.BOfETD + XMLTag_Element, FData, StartPos); + if SearchResult > 0 then + begin + EndPos := SearchResult; + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + if FCData then + EndPos := EndPos - FDelimiters.ECDataLength; + FData := Copy(FData, StartPos, (EndPos - StartPos)); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError050); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError049); + // Handle Entity Reference Characters + StrReplace(FData, EDIXML_HTMLLessThanSign, EDIXML_LessThanSign, [rfReplaceAll]); + StrReplace(FData, EDIXML_HTMLGreaterThanSign, EDIXML_GreaterThanSign, [rfReplaceAll]); + StrReplace(FData, EDIXML_HTMLQuotationMark, EDIXML_QuotationMark, [rfReplaceAll]); + StrReplace(FData, EDIXML_HTMLApostrophe, EDIXML_Apostrophe, [rfReplaceAll]); + StrReplace(FData, EDIXML_HTMLAmpersand, EDIXML_Ampersand, [rfReplaceAll]); + // + FState := ediDisassembled; +end; + +function TEDIXMLElement.GetIndexPositionFromParent: Integer; +var + I: Integer; +begin + Result := -1; + if Assigned(Parent) and (Parent is TEDIXMLSegment) then + for I := Low(TEDIXMLSegment(Parent).Elements) to High(TEDIXMLSegment(Parent).Elements) do + if TEDIXMLSegment(Parent).Element[I] = Self then + Result := I; +end; + +function TEDIXMLElement.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + // Get the delimiters from the parent segment + if Assigned(Parent) and (Parent is TEDIXMLSegment) then + Result := Parent.Delimiters; +end; + +//=== { TEDIXMLSegment } ===================================================== + +constructor TEDIXMLSegment.Create(Parent: TEDIXMLDataObject; ElementCount: Integer); +begin + if Assigned(Parent) and (Parent is TEDIXMLTransactionSet) then + inherited Create(Parent) + else + inherited Create(nil); + FEDIDOT := ediSegment; + SetLength(FElements, 0); + AddElements(ElementCount); +end; + +constructor TEDIXMLSegment.Create(Parent: TEDIXMLDataObject); +begin + if Assigned(Parent) and (Parent is TEDIXMLDataObjectGroup) then + inherited Create(Parent) + else + inherited Create(nil); + FEDIDOT := ediSegment; + SetLength(FElements, 0); +end; + +destructor TEDIXMLSegment.Destroy; +begin + DeleteElements; + inherited Destroy; +end; + +function TEDIXMLSegment.AddElement: Integer; +begin + SetLength(FElements, Length(FElements) + 1); + FElements[High(FElements)] := InternalCreateElement; + Result := High(FElements); // Return position of element +end; + +function TEDIXMLSegment.AddElements(Count: Integer): Integer; +var + I, J: Integer; +begin + I := Length(FElements); + Result := I; // Return position of 1st element + // Resize + SetLength(FElements, Length(FElements) + Count); + // Add + for J := I to High(FElements) do + FElements[J] := InternalCreateElement; +end; + +function TEDIXMLSegment.AppendElement(Element: TEDIXMLElement): Integer; +begin + SetLength(FElements, Length(FElements) + 1); + FElements[High(FElements)] := Element; + Element.Parent := Self; + Result := High(FElements); // Return position of element +end; + +function TEDIXMLSegment.AppendElements(ElementArray: TEDIXMLElementArray): Integer; +var + I, J, K: Integer; +begin + I := 0; + J := Length(FElements); + Result := J; // Return position of 1st element + // Resize + SetLength(FElements, Length(FElements) + Length(ElementArray)); + //Append + for K := J to High(ElementArray) do + begin + FElements[K] := ElementArray[I]; + FElements[K].Parent := Self; + Inc(I); + end; +end; + +function TEDIXMLSegment.Assemble: string; +var + I: Integer; + AttributeString: string; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError042); + end; + + AttributeString := FAttributes.CombineAttributes; + if AttributeString <> '' then + FData := FDelimiters.BTD + XMLTag_Segment + FDelimiters.SpaceDelimiter + + AttributeString + FDelimiters.ETD + else + FData := FDelimiters.BTD + XMLTag_Segment + FDelimiters.ETD; + + if Length(FElements) > 0 then + for I := Low(FElements) to High(FElements) do + if Assigned(FElements[I]) then + FData := FData + FElements[I].Assemble + else + FData := FData + FDelimiters.BTD + XMLTag_Element + FDelimiters.ETD + + FDelimiters.BOfETD + XMLTag_Element + FDelimiters.ETD; + FData := FData + FDelimiters.BOfETD + XMLTag_Segment + FDelimiters.ETD; + FLength := Length(FData); + Result := FData; // Return assembled string + + DeleteElements; + + FState := ediAssembled; +end; + +procedure TEDIXMLSegment.DeleteElement(Element: TEDIXMLElement); +var + I: Integer; +begin + for I := Low(FElements) to High(FElements) do + if FElements[I] = Element then + DeleteElement(I); +end; + +procedure TEDIXMLSegment.DeleteElement(Index: Integer); +var + I: Integer; +begin + if (Length(FElements) > 0) and (Index >= Low(FElements)) and (Index <= High(FElements)) then + begin + // Delete + FreeAndNil(FElements[Index]); + // Shift + for I := Index + 1 to High(FElements) do + FElements[I - 1] := FElements[I]; + // Resize + SetLength(FElements, High(FElements)); + end + else + raise EJclEDIError.CreateResFmt(@EDIXMLError058, [IntToStr(Index)]); +end; + +procedure TEDIXMLSegment.DeleteElements; +var + I: Integer; +begin + for I := Low(FElements) to High(FElements) do + // Delete + FreeAndNil(FElements[I]); + // Resize + SetLength(FElements, 0); +end; + +procedure TEDIXMLSegment.DeleteElements(Index, Count: Integer); +var + I: Integer; +begin + if (Length(FElements) > 0) and (Index >= Low(FElements)) and (Index <= High(FElements)) then + begin + // Delete + for I := Index to (Index + Count) - 1 do + FreeAndNil(FElements[I]); + // Shift + for I := (Index + Count) to High(FElements) do + begin + FElements[I - Count] := FElements[I]; + FElements[I] := nil; + end; + // Resize + SetLength(FElements, Length(FElements) - Count); + end + else + raise EJclEDIError.CreateResFmt(@EDIXMLError058, [IntToStr(Index)]); +end; + +procedure TEDIXMLSegment.Disassemble; +var + I, StartPos, SearchResult: Integer; + XMLStartTag: string; +begin + DeleteElements; + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError041); + end; + // Set next start positon + StartPos := 1; + // Move past begin segment tag + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_Segment, FData, StartPos); + if SearchResult > 0 then + begin + StartPos := SearchResult; + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + XMLStartTag := Copy(FData, StartPos, (SearchResult + FDelimiters.ETDLength) - StartPos); + FAttributes.ParseAttributes(XMLStartTag); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError043); + // Set next start positon + StartPos := SearchResult + FDelimiters.ETDLength; + // Search for element + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_Element, FData, StartPos); + // Search for Segments + while SearchResult > 0 do + begin + SearchResult := StrSearch(FDelimiters.BOfETD + XMLTag_Element, FData, SearchResult); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddElement; // Add Element + FElements[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + FElements[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError050); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError049); + // Set next start positon + StartPos := SearchResult + FDelimiters.ETDLength; + // Search for element + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_Element, FData, StartPos); + end; + FData := ''; + // + FState := ediDisassembled; +end; + +function TEDIXMLSegment.GetElement(Index: Integer): TEDIXMLElement; +begin + if Length(FElements) > 0 then + if Index >= Low(FElements) then + if Index <= High(FElements) then + begin + if not Assigned(FElements[Index]) then + raise EJclEDIError.CreateResFmt(@EDIXMLError057, [IntToStr(Index)]); + Result := FElements[Index]; + end + else + raise EJclEDIError.CreateResFmt(@EDIXMLError056, [IntToStr(Index)]) + else + raise EJclEDIError.CreateResFmt(@EDIXMLError055, [IntToStr(Index)]) + else + raise EJclEDIError.CreateResFmt(@EDIXMLError054, [IntToStr(Index)]); +end; + +function TEDIXMLSegment.GetIndexPositionFromParent: Integer; +var + I: Integer; +begin + Result := -1; + if Assigned(Parent) and (Parent is TEDIXMLTransactionSet) then + for I := Low(TEDIXMLTransactionSet(Parent).EDIDataObjects) to + High(TEDIXMLTransactionSet(Parent).EDIDataObjects) do + if TEDIXMLTransactionSet(Parent).EDIDataObject[I] = Self then + begin + Result := I; + Break; + end; +end; + +function TEDIXMLSegment.InsertElement(InsertIndex: Integer): Integer; +var + I: Integer; +begin + Result := InsertIndex; + if (Length(FElements) > 0) and (InsertIndex >= Low(FElements)) and + (InsertIndex <= High(FElements)) then + begin + // Resize + SetLength(FElements, Length(FElements) + 1); + // Shift + for I := High(FElements) downto InsertIndex + 1 do + FElements[I] := FElements[I - 1]; + // Insert + FElements[InsertIndex] := InternalCreateElement; + end + else + Result := AddElement; +end; + +function TEDIXMLSegment.InsertElement(InsertIndex: Integer; Element: TEDIXMLElement): Integer; +var + I: Integer; +begin + Result := InsertIndex; + if (Length(FElements) > 0) and (InsertIndex >= Low(FElements)) and + (InsertIndex <= High(FElements)) then + begin + // Resize + SetLength(FElements, Length(FElements) + 1); + // Shift + for I := High(FElements) downto InsertIndex + 1 do + FElements[I] := FElements[I - 1]; + // Insert + FElements[InsertIndex] := Element; + FElements[InsertIndex].Parent := Self; + end + else + Result := AppendElement(Element); +end; + +function TEDIXMLSegment.InsertElements(InsertIndex: Integer; + ElementArray: TEDIXMLElementArray): Integer; +var + I, J, K: Integer; +begin + Result := InsertIndex; + I := Length(ElementArray); + if (Length(FElements) > 0) and (InsertIndex >= Low(FElements)) and + (InsertIndex <= High(FElements)) then + begin + // Resize + SetLength(FElements, Length(FElements) + I); + // Shift + for J := High(FElements) downto InsertIndex + I do + begin + FElements[J] := FElements[J - I]; + FElements[J - I] := nil; + end; + // Insert + K := 0; + for J := InsertIndex to (InsertIndex + I) - 1 do + begin + FElements[J] := ElementArray[K]; + FElements[J].Parent := Self; + Inc(K); + end; + end + else + Result := AppendElements(ElementArray); +end; + +function TEDIXMLSegment.InsertElements(InsertIndex, Count: Integer): Integer; +var + I: Integer; +begin + Result := InsertIndex; + if (Length(FElements) > 0) and (InsertIndex >= Low(FElements)) and + (InsertIndex <= High(FElements)) then + begin + // Resize + SetLength(FElements, Length(FElements) + Count); + // Shift + for I := High(FElements) downto InsertIndex + Count do + begin + FElements[I] := FElements[I - Count]; + FElements[I - Count] := nil; + end; + // Insert + for I := InsertIndex to (InsertIndex + Count) - 1 do + FElements[I] := InternalCreateElement; + end + else + Result := AddElements(Count); +end; + +function TEDIXMLSegment.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := nil; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + // Get the delimiters from the transaction set loop + if Assigned(Parent) and (Parent is TEDIXMLTransactionSetLoop) then + begin + if Assigned(Parent.Delimiters) then + begin + Result := TEDIXMLTransactionSetLoop(Parent).ParentTransactionSet.Delimiters; + Exit; + end; + end; + // Get the delimiters from the transaction set + if Assigned(Parent) and (Parent is TEDIXMLTransactionSet) then + begin + if Assigned(Parent.Delimiters) then + begin + Result := Parent.Delimiters; + Exit; + end; + // Get the delimiters from the functional group + if Assigned(Parent.Parent) and (Parent.Parent is TEDIXMLFunctionalGroup) then + begin + if Assigned(Parent.Parent.Delimiters) then + begin + Result := Parent.Parent.Delimiters; + Exit; + end; + // Get the delimiters from the interchange control header + if Assigned(Parent.Parent.Parent) and + (Parent.Parent.Parent is TEDIXMLInterchangeControl) then + if Assigned(Parent.Parent.Parent.Delimiters) then + Result := Parent.Parent.Parent.Delimiters; + end; + end; + end; +end; + +function TEDIXMLSegment.InternalCreateElement: TEDIXMLElement; +begin + Result := TEDIXMLElement.Create(Self); +end; + +procedure TEDIXMLSegment.SetElement(Index: Integer; Element: TEDIXMLElement); +begin + if Length(FElements) > 0 then + if Index >= Low(FElements) then + if Index <= High(FElements) then + begin + FreeAndNil(FElements[Index]); + FElements[Index] := Element; + end + else + raise EJclEDIError.CreateResFmt(@EDIXMLError053, [IntToStr(Index)]) + else + raise EJclEDIError.CreateResFmt(@EDIXMLError052, [IntToStr(Index)]) + else + raise EJclEDIError.CreateResFmt(@EDIXMLError051, [IntToStr(Index)]); +end; + +//=== { TEDIXMLTransactionSetSegment } ======================================= + +constructor TEDIXMLTransactionSetSegment.Create(Parent: TEDIXMLDataObject); +begin + inherited Create(Parent); + if Assigned(Parent) and (Parent is TEDIXMLTransactionSet) then + FParent := Parent; +end; + +constructor TEDIXMLTransactionSetSegment.Create(Parent: TEDIXMLDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIXMLTransactionSet) then + FParent := Parent; +end; + +function TEDIXMLTransactionSetSegment.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := inherited InternalAssignDelimiters; +end; + +//=== { TEDIXMLFunctionalGroupSegment } ====================================== + +constructor TEDIXMLFunctionalGroupSegment.Create(Parent: TEDIXMLDataObject); +begin + inherited Create(Parent); + if Assigned(Parent) and (Parent is TEDIXMLFunctionalGroup) then + FParent := Parent; +end; + +constructor TEDIXMLFunctionalGroupSegment.Create(Parent: TEDIXMLDataObject; + ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIXMLFunctionalGroup) then + FParent := Parent; +end; + +function TEDIXMLFunctionalGroupSegment.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + // Get the delimiters from the functional group + if Assigned(Parent) and (Parent is TEDIXMLFunctionalGroup) then + if Assigned(Parent.Delimiters) then + Result := Parent.Delimiters + else + // Get the delimiters from the interchange control + if Assigned(Parent.Parent) and (Parent.Parent is TEDIXMLInterchangeControl) then + Result := Parent.Parent.Delimiters; +end; + +//=== { TEDIXMLInterchangeControlSegment } =================================== + +constructor TEDIXMLInterchangeControlSegment.Create(Parent: TEDIXMLDataObject); +begin + inherited Create(Parent); + if Assigned(Parent) and (Parent is TEDIXMLInterchangeControl) then + FParent := Parent; +end; + +constructor TEDIXMLInterchangeControlSegment.Create(Parent: TEDIXMLDataObject; + ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIXMLInterchangeControl) then + FParent := Parent; +end; + +function TEDIXMLInterchangeControlSegment.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + // Get the delimiters from the interchange control + if Assigned(Parent) and (Parent is TEDIXMLInterchangeControl) then + Result := Parent.Delimiters; +end; + +//=== { TEDIXMLDataObjectGroup } ============================================= + +constructor TEDIXMLDataObjectGroup.Create(Parent: TEDIXMLDataObject); +begin + inherited Create(Parent); +end; + +destructor TEDIXMLDataObjectGroup.Destroy; +begin + DeleteEDIDataObjects; + inherited Destroy; +end; + +function TEDIXMLDataObjectGroup.AddGroup: Integer; +var + EDIGroup: TEDIXMLDataObjectGroup; +begin + EDIGroup := InternalCreateDataObjectGroup; + Result := AppendEDIDataObject(EDIGroup); +end; + +function TEDIXMLDataObjectGroup.AddSegment: Integer; +var + EDISegment: TEDIXMLSegment; +begin + EDISegment := TEDIXMLSegment.Create(Self); + Result := AppendEDIDataObject(EDISegment); +end; + +function TEDIXMLDataObjectGroup.AppendEDIDataObject(EDIDataObject: TEDIXMLDataObject): Integer; +begin + SetLength(FEDIDataObjects, Length(FEDIDataObjects) + 1); + FEDIDataObjects[High(FEDIDataObjects)] := EDIDataObject; + EDIDataObject.Parent := Self; + Result := High(FEDIDataObjects); +end; + +procedure TEDIXMLDataObjectGroup.DeleteEDIDataObject(EDIDataObject: TEDIXMLDataObject); +var + I: Integer; +begin + for I := Low(FEDIDataObjects) to High(FEDIDataObjects) do + if FEDIDataObjects[I] = EDIDataObject then + DeleteEDIDataObject(I); +end; + +procedure TEDIXMLDataObjectGroup.DeleteEDIDataObject(Index: Integer); +var + I: Integer; +begin + if (Length(FEDIDataObjects) > 0) and (Index >= Low(FEDIDataObjects)) and + (Index <= High(FEDIDataObjects)) then + begin + // Delete + FreeAndNil(FEDIDataObjects[Index]); + // Shift + for I := Index + 1 to High(FEDIDataObjects) do + FEDIDataObjects[I - 1] := FEDIDataObjects[I]; + // Resize + SetLength(FEDIDataObjects, High(FEDIDataObjects)); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError040); +end; + +procedure TEDIXMLDataObjectGroup.DeleteEDIDataObjects; +var + I: Integer; +begin + for I := Low(FEDIDataObjects) to High(FEDIDataObjects) do + FreeAndNil(FEDIDataObjects[I]); + // Resize + SetLength(FEDIDataObjects, 0); +end; + +function TEDIXMLDataObjectGroup.GetEDIDataObject(Index: Integer): TEDIXMLDataObject; +begin + if Length(FEDIDataObjects) > 0 then + if Index >= Low(FEDIDataObjects) then + if Index <= High(FEDIDataObjects) then + begin + if not Assigned(FEDIDataObjects[Index]) then + raise EJclEDIError.CreateResFmt(@EDIXMLError039, [IntToStr(Index)]); + Result := FEDIDataObjects[Index]; + end + else + raise EJclEDIError.CreateResFmt(@EDIXMLError038, [IntToStr(Index)]) + else + raise EJclEDIError.CreateResFmt(@EDIXMLError037, [IntToStr(Index)]) + else + raise EJclEDIError.CreateResFmt(@EDIXMLError036, [IntToStr(Index)]); +end; + +function TEDIXMLDataObjectGroup.InsertEDIDataObject(InsertIndex: Integer; + EDIDataObject: TEDIXMLDataObject): Integer; +var + I: Integer; +begin + Result := InsertIndex; + if (Length(FEDIDataObjects) > 0) and (InsertIndex >= Low(FEDIDataObjects)) and + (InsertIndex <= High(FEDIDataObjects)) then + begin + // Resize + SetLength(FEDIDataObjects, Length(FEDIDataObjects) + 1); + // Shift + for I := High(FEDIDataObjects) downto InsertIndex + 1 do + FEDIDataObjects[I] := FEDIDataObjects[I - 1]; + // Insert + FEDIDataObjects[InsertIndex] := EDIDataObject; + FEDIDataObjects[InsertIndex].Parent := Self; + end + else + Result := AppendEDIDataObject(EDIDataObject); +end; + +function TEDIXMLDataObjectGroup.InsertGroup(InsertIndex: Integer): Integer; +var + EDIGroup: TEDIXMLDataObjectGroup; +begin + EDIGroup := InternalCreateDataObjectGroup; + Result := InsertEDIDataObject(InsertIndex, EDIGroup); +end; + +function TEDIXMLDataObjectGroup.InsertSegment(InsertIndex: Integer): Integer; +var + EDISegment: TEDIXMLSegment; +begin + EDISegment := TEDIXMLSegment.Create(Self); + Result := InsertEDIDataObject(InsertIndex, EDISegment); +end; + +function TEDIXMLDataObjectGroup.SearchForSegmentInDataString(Id: string; + StartPos: Integer): Integer; +var + SegmentTag: string; + SearchResult, SegmentTagStartPos: Integer; + EDIXMLAttributes: TEDIXMLAttributes; +begin + Result := 0; + EDIXMLAttributes := TEDIXMLAttributes.Create; + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_Segment, FData, StartPos); + SegmentTagStartPos := SearchResult; + while SearchResult > 0 do + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SegmentTagStartPos); + if SearchResult > 0 then + begin + SegmentTag := Copy(FData, SegmentTagStartPos, ((SearchResult - SegmentTagStartPos) + + FDelimiters.ETDLength)); + EDIXMLAttributes.ParseAttributes(SegmentTag); + Result := EDIXMLAttributes.CheckAttribute(XMLAttribute_Id, Id); + if Result >= 0 then + begin + Result := SegmentTagStartPos; + Break; + end; + end; + SegmentTagStartPos := SearchResult + FDelimiters.ETDLength; + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_Segment, FData, SegmentTagStartPos); + end; + EDIXMLAttributes.Free; +end; + +procedure TEDIXMLDataObjectGroup.SetEDIDataObject(Index: Integer; EDIDataObject: TEDIXMLDataObject); +begin + if Length(FEDIDataObjects) > 0 then + if Index >= Low(FEDIDataObjects) then + if Index <= High(FEDIDataObjects) then + begin + FreeAndNil(FEDIDataObjects[Index]); + FEDIDataObjects[Index] := EDIDataObject; + end + else + raise EJclEDIError.CreateResFmt(@EDIXMLError035, [IntToStr(Index)]) + else + raise EJclEDIError.CreateResFmt(@EDIXMLError034, [IntToStr(Index)]) + else + raise EJclEDIError.CreateResFmt(@EDIXMLError033, [IntToStr(Index)]); +end; + +//=== { TEDIXMLTransactionSetLoop } ========================================== + +constructor TEDIXMLTransactionSetLoop.Create(Parent: TEDIXMLDataObject); +begin + inherited Create(Parent); + if Assigned(Parent) and (Parent is TEDIXMLTransactionSet) then + FParentTransactionSet := TEDIXMLTransactionSet(Parent) + else + if Assigned(Parent) and (Parent is TEDIXMLTransactionSetLoop) then + FParentTransactionSet := TEDIXMLTransactionSetLoop(Parent).ParentTransactionSet + else + FParentTransactionSet := nil; + FEDIDOT := ediLoop; +end; + +destructor TEDIXMLTransactionSetLoop.Destroy; +begin + inherited Destroy; +end; + +function TEDIXMLTransactionSetLoop.Assemble: string; +var + I: Integer; + AttributeString: string; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError030); + end; + + AttributeString := FAttributes.CombineAttributes; + if AttributeString <> '' then + FData := FDelimiters.BTD + XMLTag_TransactionSetLoop + FDelimiters.SpaceDelimiter + + AttributeString + FDelimiters.ETD + else + FData := FDelimiters.BTD + XMLTag_TransactionSetLoop + FDelimiters.ETD; + + if Length(FEDIDataObjects) > 0 then + for I := Low(FEDIDataObjects) to High(FEDIDataObjects) do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + FData := FData + FDelimiters.BOfETD + XMLTag_TransactionSetLoop + FDelimiters.ETD; + FLength := Length(FData); + Result := FData; // Return assembled string + + DeleteEDIDataObjects; + + FState := ediAssembled; +end; + +procedure TEDIXMLTransactionSetLoop.Disassemble; +var + I, J, StartPos, SearchResult: Integer; + XMLStartTag, SearchTag: string; + NestedLoopCount: Integer; +begin + DeleteEDIDataObjects; + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError029); + end; + // Set next start positon + StartPos := 1; + // Move past begin loop tag + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_TransactionSetLoop, FData, StartPos); + if SearchResult > 0 then + begin + StartPos := SearchResult; + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + XMLStartTag := Copy(FData, StartPos, (SearchResult + FDelimiters.ETDLength) - StartPos); + FAttributes.ParseAttributes(XMLStartTag); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError031); + // Set next start positon + StartPos := SearchResult + FDelimiters.ETDLength; + // Determine the nearest tag to search for + I := StrSearch(FDelimiters.BTD + XMLTag_Segment, FData, StartPos); + J := StrSearch(FDelimiters.BTD + XMLTag_TransactionSetLoop, FData, StartPos); + if (I < J) or (J <= 0) then + begin + SearchTag := XMLTag_Segment; + SearchResult := I; + end + else + begin + SearchTag := XMLTag_TransactionSetLoop; + SearchResult := J; + end; + // Search for Segments or Loops + while SearchResult > 0 do + begin + if SearchTag = XMLTag_Segment then + begin + SearchResult := StrSearch(FDelimiters.BOfETD + SearchTag, FData, SearchResult); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddSegment; // Add Segment + EDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + EDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError045); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError044); + end + else + begin + NestedLoopCount := 0; + SearchResult := StartPos; + // Search for the proper end loop tag + repeat + I := StrSearch(FDelimiters.BOfETD + SearchTag, FData, SearchResult); //Find loop end + J := StrSearch(FDelimiters.BTD + SearchTag, FData, SearchResult); //Find loop begin + if (I < J) or (J <= 0) then + begin + Dec(NestedLoopCount); + SearchResult := I + FDelimiters.ETDLength; + end + else + if (I > J) and (J > 0) then + begin + Inc(NestedLoopCount); + SearchResult := J + FDelimiters.ETDLength; + end; + until (NestedLoopCount <= 0) or (I <= 0); + SearchResult := I; + // + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddGroup; // Add Transaction Set Loop + EDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + EDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError032); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError031); + end; + // Set next start positon + StartPos := SearchResult + FDelimiters.ETDLength; + // Determine the nearest tag to search for + I := StrSearch(FDelimiters.BTD + XMLTag_Segment, FData, StartPos); + J := StrSearch(FDelimiters.BTD + XMLTag_TransactionSetLoop, FData, StartPos); + if (I < J) or (J <= 0) then + SearchTag := XMLTag_Segment + else + SearchTag := XMLTag_TransactionSetLoop; + SearchResult := StrSearch(FDelimiters.BTD + SearchTag, FData, StartPos); + StartPos := SearchResult; + end; + FData := ''; + // + FState := ediDisassembled; +end; + +function TEDIXMLTransactionSetLoop.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := nil; + if Assigned(FParentTransactionSet) then + Result := Parent.Delimiters; +end; + +function TEDIXMLTransactionSetLoop.InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; +begin + Result := TEDIXMLTransactionSetLoop.Create(Self); +end; + +//=== { TEDIXMLTransactionSet } ============================================== + +constructor TEDIXMLTransactionSet.Create(Parent: TEDIXMLDataObject); +begin + inherited Create(Parent); + FParentTransactionSet := Self; + FEDIDOT := ediTransactionSet; +end; + +destructor TEDIXMLTransactionSet.Destroy; +begin + inherited Destroy; +end; + +function TEDIXMLTransactionSet.Assemble: string; +var + I: Integer; + AttributeString: string; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError026); + end; + + AttributeString := FAttributes.CombineAttributes; + if AttributeString <> '' then + FData := FDelimiters.BTD + XMLTag_TransactionSet + FDelimiters.SpaceDelimiter + + AttributeString + FDelimiters.ETD + else + FData := FDelimiters.BTD + XMLTag_TransactionSet + FDelimiters.ETD; + + if Length(FEDIDataObjects) > 0 then + for I := Low(FEDIDataObjects) to High(FEDIDataObjects) do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + FData := FData + FDelimiters.BOfETD + XMLTag_TransactionSet + FDelimiters.ETD; + FLength := Length(FData); + Result := FData; // Return assembled string + + DeleteEDIDataObjects; + + FState := ediAssembled; +end; + +procedure TEDIXMLTransactionSet.Disassemble; +var + I, J, StartPos, SearchResult: Integer; + SearchTag, TempData: string; + NestedLoopCount: Integer; +begin + DeleteEDIDataObjects; + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError025); + end; + // Set next start positon + StartPos := 1; + // Determine the nearest tag to search for + I := StrSearch(FDelimiters.BTD + XMLTag_Segment, FData, StartPos); + J := StrSearch(FDelimiters.BTD + XMLTag_TransactionSetLoop, FData, StartPos); + if (I < J) or (J <= 0) then + SearchTag := XMLTag_Segment + else + SearchTag := XMLTag_TransactionSetLoop; + // Search for Segments or Loops + SearchResult := StrSearch(FDelimiters.BTD + SearchTag, FData, StartPos); + StartPos := SearchResult; + while SearchResult > 0 do + begin + if SearchTag = XMLTag_Segment then + begin + SearchResult := StrSearch(FDelimiters.BOfETD + SearchTag, FData, SearchResult); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddSegment; //A dd Segment + EDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + EDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError045); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError044); + end + else + begin + NestedLoopCount := 0; + SearchResult := StartPos; + // Search for the proper end loop tag + repeat + I := StrSearch(FDelimiters.BOfETD + SearchTag, FData, SearchResult); //Find loop end + J := StrSearch(FDelimiters.BTD + SearchTag, FData, SearchResult); //Find loop begin + if (I < J) or (J <= 0) then + begin + Dec(NestedLoopCount); + SearchResult := I + FDelimiters.ETDLength; + end + else + if (I > J) and (J > 0) then + begin + Inc(NestedLoopCount); + SearchResult := J + FDelimiters.ETDLength; + end; + until (NestedLoopCount <= 0) or (I <= 0); + SearchResult := I; + // + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddGroup; // Add Transaction Set Loop + EDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + EDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError032); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError031); + end; + // Set next start positon + StartPos := SearchResult + FDelimiters.ETDLength; + // Determine the nearest tag to search for + I := StrSearch(FDelimiters.BTD + XMLTag_Segment, FData, StartPos); + J := StrSearch(FDelimiters.BTD + XMLTag_TransactionSetLoop, FData, StartPos); + if (I < J) or (J <= 0) then + SearchTag := XMLTag_Segment + else + SearchTag := XMLTag_TransactionSetLoop; + SearchResult := StrSearch(FDelimiters.BTD + SearchTag, FData, StartPos); + end; + + if Length(FEDIDataObjects) > 0 then + begin + // Search for Transaction Set Header and Trailer + FSTSegment := TEDIXMLSegment(FEDIDataObjects[0]); + FSESegment := TEDIXMLSegment(FEDIDataObjects[High(FEDIDataObjects)]); + + if FSTSegment.Attributes.GetAttributeValue(XMLAttribute_Id) = XMLTag_TSHSegmentId then + begin + TempData := FEDIDataObjects[0].Assemble; + FreeAndNil(FEDIDataObjects[0]); + // + FSTSegment := TEDIXMLTransactionSetSegment.Create(Self); + FSTSegment.Data := TempData; + FSTSegment.Disassemble; + // + FEDIDataObjects[0] := FSTSegment; + end + else + begin + FSTSegment := nil; + raise EJclEDIError.CreateRes(@EDIXMLError059); + end; + + if FSESegment.Attributes.GetAttributeValue(XMLAttribute_Id) = XMLTag_TSTSegmentId then + begin + TempData := FEDIDataObjects[High(FEDIDataObjects)].Assemble; + FreeAndNil(FEDIDataObjects[High(FEDIDataObjects)]); + // + FSESegment := TEDIXMLTransactionSetSegment.Create(Self); + FSESegment.Data := TempData; + FSESegment.Disassemble; + // + FEDIDataObjects[High(FEDIDataObjects)] := FSESegment; + end + else + begin + FSESegment := nil; + raise EJclEDIError.CreateRes(@EDIXMLError060); + end; + end + else + begin + FSTSegment := nil; + FSESegment := nil; + raise EJclEDIError.CreateRes(@EDIXMLError061); + end; + FData := ''; + // + FState := ediDisassembled; +end; + +function TEDIXMLTransactionSet.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := nil; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + if Assigned(Parent) and (Parent is TEDIXMLFunctionalGroup) then + if Assigned(Parent.Delimiters) then + Result := Parent.Delimiters + else + if Assigned(Parent.Parent) and (Parent.Parent is TEDIXMLInterchangeControl) then + Result := Parent.Parent.Delimiters; +end; + +function TEDIXMLTransactionSet.InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; +begin + Result := TEDIXMLTransactionSetLoop.Create(Self); +end; + +//=== { TEDIXMLFunctionalGroup } ============================================= + +constructor TEDIXMLFunctionalGroup.Create(Parent: TEDIXMLDataObject); +begin + inherited Create(Parent); + FEDIDOT := ediFunctionalGroup; +end; + +destructor TEDIXMLFunctionalGroup.Destroy; +begin + inherited Destroy; +end; + +function TEDIXMLFunctionalGroup.Assemble: string; +var + I: Integer; + AttributeString: string; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError016); + end; + + AttributeString := FAttributes.CombineAttributes; + if AttributeString <> '' then + FData := FDelimiters.BTD + XMLTag_FunctionalGroup + FDelimiters.SpaceDelimiter + + AttributeString + FDelimiters.ETD + else + FData := FDelimiters.BTD + XMLTag_FunctionalGroup + FDelimiters.ETD; + + if Length(FEDIDataObjects) > 0 then + for I := Low(FEDIDataObjects) to High(FEDIDataObjects) do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + FData := FData + FDelimiters.BOfETD + XMLTag_FunctionalGroup + FDelimiters.ETD; + FLength := Length(FData); + Result := FData; // Return assembled string + + DeleteEDIDataObjects; + + FState := ediAssembled; +end; + +procedure TEDIXMLFunctionalGroup.Disassemble; +var + I, StartPos, SearchResult: Integer; +begin + DeleteEDIDataObjects; + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError015); + end; + // Search for Functional Group Header + StartPos := 1; + SearchResult := SearchForSegmentInDataString(XMLTag_FGHSegmentId, StartPos); + if SearchResult > 0 then + begin + StartPos := SearchResult; + SearchResult := StrSearch(FDelimiters.BOfETD + XMLTag_Segment, FData, SearchResult); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + FGSSegment := TEDIXMLFunctionalGroupSegment.Create(nil); + AppendEDIDataObject(FGSSegment); + FGSSegment.Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + FGSSegment.Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError021); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError020); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError019); + // Set next start positon + StartPos := SearchResult + FDelimiters.ETDLength; + // Search for Transaction Set + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_TransactionSet, FData, StartPos); + while SearchResult > 0 do + begin + StartPos := SearchResult; + SearchResult := StrSearch(FDelimiters.BOfETD + XMLTag_TransactionSet, FData, SearchResult); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddGroup; // Add Transaction Set + EDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + EDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError028); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError027); + // Set next start positon + StartPos := SearchResult + FDelimiters.ETDLength; + // Search for Transaction Set + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_TransactionSet, FData, StartPos); + end; + // Search for Functional Group Trailer + SearchResult := SearchForSegmentInDataString(XMLTag_FGTSegmentId, StartPos); + if SearchResult > 0 then + begin + StartPos := SearchResult; + SearchResult := StrSearch(FDelimiters.BOfETD + XMLTag_Segment, FData, SearchResult); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + FGESegment := TEDIXMLFunctionalGroupSegment.Create(nil); + AppendEDIDataObject(FGESegment); + FGESegment.Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + FGESegment.Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError024); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError023); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError022); + FData := ''; + // + FState := ediDisassembled; +end; + +function TEDIXMLFunctionalGroup.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + if Assigned(Parent) and (Parent is TEDIXMLInterchangeControl) then + Result := Parent.Delimiters; +end; + +function TEDIXMLFunctionalGroup.InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; +begin + Result := TEDIXMLTransactionSet.Create(Self); +end; + +//=== { TEDIXMLInterchangeControl } ========================================== + +constructor TEDIXMLInterchangeControl.Create(Parent: TEDIXMLDataObject); +begin + inherited Create(Parent); + FEDIDOT := ediInterchangeControl; +end; + +destructor TEDIXMLInterchangeControl.Destroy; +begin + FreeAndNil(FDelimiters); + inherited Destroy; +end; + +function TEDIXMLInterchangeControl.Assemble: string; +var + I: Integer; + AttributeString: string; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError005); + end; + + AttributeString := FAttributes.CombineAttributes; + if AttributeString <> '' then + FData := FDelimiters.BTD + XMLTag_InterchangeControl + FDelimiters.SpaceDelimiter + + AttributeString + FDelimiters.ETD + else + FData := FDelimiters.BTD + XMLTag_InterchangeControl + FDelimiters.ETD; + + if Length(FEDIDataObjects) > 0 then + for I := Low(FEDIDataObjects) to High(FEDIDataObjects) do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + FData := FData + FDelimiters.BOfETD + XMLTag_InterchangeControl + FDelimiters.ETD; + FLength := Length(FData); + Result := FData; // Return assembled string + + DeleteEDIDataObjects; + + FState := ediAssembled; +end; + +procedure TEDIXMLInterchangeControl.Disassemble; +var + I, StartPos, SearchResult: Integer; +begin + DeleteEDIDataObjects; + // Check if delimiters are assigned + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError006); + end; + // Search for Interchange Control Header + StartPos := 1; + SearchResult := SearchForSegmentInDataString(XMLTag_ICHSegmentId, StartPos); + if SearchResult > 0 then + begin + StartPos := SearchResult; + SearchResult := StrSearch(FDelimiters.BOfETD + XMLTag_Segment, FData, SearchResult); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + FISASegment := TEDIXMLInterchangeControlSegment.Create(nil); + AppendEDIDataObject(FISASegment); + FISASegment.Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + FISASegment.Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError011); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError010); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError009); + // Set next start position. Move past the delimiter + StartPos := SearchResult + FDelimiters.ETDLength; + // Search for Functional Group + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_FunctionalGroup, FData, StartPos); + while SearchResult > 0 do + begin + StartPos := SearchResult; + SearchResult := StrSearch(FDelimiters.BOfETD + XMLTag_FunctionalGroup, FData, SearchResult); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddGroup; // Add Functional Group + EDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + EDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError018); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError017); + // Set next start positon + StartPos := SearchResult + FDelimiters.ETDLength; + // Search for Functional Group + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_FunctionalGroup, FData, StartPos); + end; + // Search for Interchange Control Trailer + SearchResult := SearchForSegmentInDataString(XMLTag_ICTSegmentId, StartPos); + if SearchResult > 0 then + begin + StartPos := SearchResult; + SearchResult := StrSearch(FDelimiters.BOfETD + XMLTag_Segment, FData, SearchResult); + if SearchResult > 0 then + begin + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + FIEASegment := TEDIXMLInterchangeControlSegment.Create(nil); + AppendEDIDataObject(FIEASegment); + FIEASegment.Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + FIEASegment.Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError014); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError013); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError012); + FData := ''; + // + FState := ediDisassembled; +end; + +function TEDIXMLInterchangeControl.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := TEDIXMLDelimiters.Create; +end; + +function TEDIXMLInterchangeControl.InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; +begin + Result := TEDIXMLFunctionalGroup.Create(Self); +end; + +//=== { TEDIXMLFile } ======================================================== + +constructor TEDIXMLFile.Create(Parent: TEDIXMLDataObject); +begin + inherited Create(Parent); + FEDIXMLFileHeader := TEDIXMLFileHeader.Create; + FEDIDOT := ediFile; +end; + +destructor TEDIXMLFile.Destroy; +begin + FEDIXMLFileHeader.Free; + inherited Destroy; +end; + +function TEDIXMLFile.Assemble: string; +var + I: Integer; + AttributeString: string; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError004); + end; + + FData := FEDIXMLFileHeader.OutputXMLHeader; + + AttributeString := FAttributes.CombineAttributes; + if AttributeString <> '' then + FData := FData + FDelimiters.BTD + XMLTag_EDIFile + FDelimiters.SpaceDelimiter + + AttributeString + FDelimiters.ETD + else + FData := FData + FDelimiters.BTD + XMLTag_EDIFile + FDelimiters.ETD; + + if Length(FEDIDataObjects) > 0 then + for I := Low(FEDIDataObjects) to High(FEDIDataObjects) do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + FData := FData + FDelimiters.BOfETD + XMLTag_EDIFile + FDelimiters.ETD; + FLength := Length(FData); + Result := FData; // Return assembled string + + DeleteEDIDataObjects; + + FState := ediAssembled; +end; + +procedure TEDIXMLFile.Disassemble; +var + I, StartPos, SearchResult: Integer; + XMLHeader: string; +begin + DeleteEDIDataObjects; + // + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@EDIXMLError003); + end; + // Search for XML file heaer + StartPos := 1; + SearchResult := StrSearch(EDIXMLDelimiter_FileHeaderBegin, FData, StartPos); + StartPos := SearchResult; + if SearchResult > 0 then + begin + SearchResult := StrSearch(EDIXMLDelimiter_FileHeaderEnd, FData, StartPos); + if SearchResult > 0 then + begin + XMLHeader := + Copy(FData, StartPos, ((SearchResult - StartPos) + Length(EDIXMLDelimiter_FileHeaderEnd))); + FEDIXMLFileHeader.ParseXMLHeader(XMLHeader); + end + else + begin + // Hey the header was not found + end; + end + else + begin + // Hey the header was not found + end; + // Search for Interchange + StartPos := 1; + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_InterchangeControl, FData, StartPos); + StartPos := SearchResult; + while SearchResult > 0 do + begin + // Search for Interchange end tag + SearchResult := StrSearch(FDelimiters.BOfETD + XMLTag_InterchangeControl, FData, SearchResult); + if SearchResult > 0 then + begin + // Search for Interchange end tag delimiter + SearchResult := StrSearch(FDelimiters.ETD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddGroup; // Add Interchange + FEDIDataObjects[I].Delimiters := TEDIXMLDelimiters.Create; + FEDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.ETDLength)); + FEDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError008); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError007); + // Set next start position. Move past the delimiter + StartPos := SearchResult + FDelimiters.ETDLength; + // Search for Interchange + SearchResult := StrSearch(FDelimiters.BTD + XMLTag_InterchangeControl, FData, StartPos); + end; + FData := ''; + + FState := ediDisassembled; +end; + +function TEDIXMLFile.InternalAssignDelimiters: TEDIXMLDelimiters; +begin + Result := TEDIXMLDelimiters.Create; +end; + +function TEDIXMLFile.InternalCreateDataObjectGroup: TEDIXMLDataObjectGroup; +begin + Result := TEDIXMLInterchangeControl.Create(Self); +end; + +procedure TEDIXMLFile.InternalLoadFromFile; +var + EDIFileStream: TFileStream; +begin + FData := ''; + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmOpenRead or fmShareDenyNone); + try + SetLength(FData, EDIFileStream.Size); + EDIFileStream.Read(Pointer(FData)^, EDIFileStream.Size); + finally + EDIFileStream.Free; + end; + FData := StringReplace(FData, AnsiCrLf, '', [rfReplaceAll, rfIgnoreCase]); + end + else + raise EJclEDIError.CreateRes(@EDIXMLError001); +end; + +procedure TEDIXMLFile.LoadFromFile(const FileName: string); +begin + FFileName := FileName; + InternalLoadFromFile; +end; + +procedure TEDIXMLFile.ReLoadFromFile; +begin + InternalLoadFromFile; +end; + +procedure TEDIXMLFile.SaveAsToFile(const FileName: string); +var + EDIFileStream: TFileStream; +begin + FFileName := FileName; + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyNone); + try + EDIFileStream.Write(Pointer(FData)^, Length(FData)); + finally + EDIFileStream.Free; + end; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError002); +end; + +procedure TEDIXMLFile.SaveToFile; +var + EDIFileStream: TFileStream; +begin + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyNone); + try + EDIFileStream.Write(Pointer(FData)^, Length(FData)); + finally + EDIFileStream.Free; + end; + end + else + raise EJclEDIError.CreateRes(@EDIXMLError002); +end; + +//=== { TEDIXMLFileHeader } ================================================== + +constructor TEDIXMLFileHeader.Create; +begin + inherited Create; + FAttributes := TEDIXMLAttributes.Create; + FDelimiters := TEDIXMLDelimiters.Create; + FAttributes.SetAttribute(EDIXMLAttributeStr_version, Value_Version10); + FAttributes.SetAttribute(EDIXMLAttributeStr_encoding, Value_Windows1252); // ISO-8859-1 + FXMLNameSpaceOption := nsNone; + FAttributes.SetAttribute(EDIXMLAttributeStr_xmlns, Value_EDITRANSDOC); + FAttributes.SetAttribute(EDIXMLAttributeStr_xmlnsEDI, Value_EDITRANSDOC); +end; + +destructor TEDIXMLFileHeader.Destroy; +begin + FDelimiters.Free; + FAttributes.Free; + inherited Destroy; +end; + +function TEDIXMLFileHeader.OutputAdditionalXMLHeaderAttributes: string; +begin + Result := ''; +end; + +function TEDIXMLFileHeader.OutputXMLHeader: string; +var + AdditionalAttributes: string; +begin + Result := EDIXMLDelimiter_FileHeaderBegin + Value_xml + Delimiters.SpaceDelimiter + + FAttributes.GetAttributeString(EDIXMLAttributeStr_version); + case FXMLNameSpaceOption of + nsNone: + Result := Result + Delimiters.SpaceDelimiter + + FAttributes.GetAttributeString(EDIXMLAttributeStr_encoding); + nsDefault: + Result := Result + + Delimiters.SpaceDelimiter + FAttributes.GetAttributeString(EDIXMLAttributeStr_encoding) + + Delimiters.SpaceDelimiter + FAttributes.GetAttributeString(EDIXMLAttributeStr_xmlns); + nsQualified: + Result := Result + + Delimiters.SpaceDelimiter + FAttributes.GetAttributeString(EDIXMLAttributeStr_encoding) + + Delimiters.SpaceDelimiter + FAttributes.GetAttributeString(EDIXMLAttributeStr_xmlnsEDI); + end; + AdditionalAttributes := OutputAdditionalXMLHeaderAttributes; + if AdditionalAttributes <> '' then + Result := Result + Delimiters.SpaceDelimiter + AdditionalAttributes; + Result := Result + EDIXMLDelimiter_FileHeaderEnd; +end; + +procedure TEDIXMLFileHeader.ParseXMLHeader(XMLHeader: string); +begin + FAttributes.ParseAttributes(XMLHeader); +end; + +//=== { TEDIXMLANSIX12FormatTranslator } ===================================== + +constructor TEDIXMLANSIX12FormatTranslator.Create; +begin + inherited Create; +end; + +destructor TEDIXMLANSIX12FormatTranslator.Destroy; +begin + inherited Destroy; +end; + +function TEDIXMLANSIX12FormatTranslator.ConvertToEDISegment( + XMLSegment: TEDIXMLSegment): TEDISegment; +var + ediE, xmlE: Integer; +begin + if XMLSegment is TEDIXMLInterchangeControlSegment then + Result := TEDIInterchangeControlSegment.Create(nil) + else + if XMLSegment is TEDIXMLFunctionalGroupSegment then + Result := TEDIFunctionalGroupSegment.Create(nil) + else + if XMLSegment is TEDIXMLTransactionSetSegment then + Result := TEDITransactionSetSegment.Create(nil) + else + Result := TEDISegment.Create(nil); + Result.SegmentID := XMLSegment.Attributes.GetAttributeValue(XMLAttribute_Id); + for ediE := Low(XMLSegment.Elements) to High(XMLSegment.Elements) do + begin + xmlE := Result.AddElement; + Result[xmlE].Data := XMLSegment[ediE].Data; + end; +end; + +function TEDIXMLANSIX12FormatTranslator.ConvertToEDITransaction( + XMLTransactionSet: TEDIXMLTransactionSet): TEDITransactionSet; +var + I: Integer; + EDISegment: TEDISegment; + XMLSegment: TEDIXMLSegment; + XMLLoop: TEDIXMLTransactionSetLoop; +begin + Result := TEDITransactionSet.Create(nil); + for I := Low(XMLTransactionSet.EDIDataObjects) to High(XMLTransactionSet.EDIDataObjects) do + begin + if XMLTransactionSet[I] is TEDIXMLSegment then + begin + XMLSegment := TEDIXMLSegment(XMLTransactionSet[I]); + if XMLSegment.Attributes.GetAttributeValue(XMLAttribute_Id) = XMLTag_TSHSegmentId then + begin + EDISegment := ConvertToEDISegment(XMLSegment); + Result.SegmentST := TEDITransactionSetSegment(EDISegment); + end + else + if XMLSegment.Attributes.GetAttributeValue(XMLAttribute_Id) = XMLTag_TSTSegmentId then + begin + EDISegment := ConvertToEDISegment(XMLSegment); + Result.SegmentSE := TEDITransactionSetSegment(EDISegment); + end + else + begin + EDISegment := ConvertToEDISegment(XMLSegment); + Result.AppendSegment(EDISegment); + end; + end + else + if XMLTransactionSet[I] is TEDIXMLTransactionSetLoop then + begin + XMLLoop := TEDIXMLTransactionSetLoop(XMLTransactionSet[I]); + ConvertTransactionSetLoopToEDI(Result, XMLLoop); + end + else + raise EJclEDIError.CreateResFmt(@EDIXMLError062, [XMLTransactionSet[I].ClassName]); + end; +end; + +function TEDIXMLANSIX12FormatTranslator.ConvertToXMLSegment( + EDISegment: TEDISegment): TEDIXMLSegment; +var + ediE, xmlE: Integer; +begin + if EDISegment is TEDIInterchangeControlSegment then + Result := TEDIXMLInterchangeControlSegment.Create(nil) + else + if EDISegment is TEDIFunctionalGroupSegment then + Result := TEDIXMLFunctionalGroupSegment.Create(nil) + else + if EDISegment is TEDITransactionSetSegment then + Result := TEDIXMLTransactionSetSegment.Create(nil) + else + Result := TEDIXMLSegment.Create(nil); + Result.Attributes.SetAttribute(XMLAttribute_Id, EDISegment.SegmentID); + for ediE := 0 to EDISegment.ElementCount - 1 do + begin + xmlE := Result.AddElement; + Result[xmlE].Data := EDISegment[ediE].Data; + end; +end; + +function TEDIXMLANSIX12FormatTranslator.ConvertToXMLTransaction( + EDITransactionSet: TEDITransactionSet; + EDITransactionSetSpec: TEDITransactionSetSpec): TEDIXMLTransactionSet; +var + EDIDoc: TEDITransactionSetDocument; + XMLSegment: TEDIXMLSegment; +begin + Result := TEDIXMLTransactionSet.Create(nil); + EDIDoc := TEDITransactionSetDocument.Create(EDITransactionSet, + EDITransactionSet, EDITransactionSetSpec); + try + EDIDoc.FormatDocument; + + XMLSegment := ConvertToXMLSegment(EDITransactionSet.SegmentST); + Result.AppendEDIDataObject(XMLSegment); + + ConvertTransactionSetLoopToXML(EDIDoc, Result); + + XMLSegment := ConvertToXMLSegment(EDITransactionSet.SegmentSE); + Result.AppendEDIDataObject(XMLSegment); + finally + EDIDoc.Free; + end; +end; + +function TEDIXMLANSIX12FormatTranslator.ConvertToXMLTransaction( + EDITransactionSet: TEDITransactionSet): TEDIXMLTransactionSet; +var + I: Integer; + XMLSegment: TEDIXMLSegment; +begin + Result := TEDIXMLTransactionSet.Create(nil); + + XMLSegment := ConvertToXMLSegment(EDITransactionSet.SegmentST); + Result.AppendEDIDataObject(XMLSegment); + + for I := 0 to EDITransactionSet.SegmentCount - 1 do + begin + XMLSegment := ConvertToXMLSegment(EDITransactionSet.Segment[I]); + Result.AppendEDIDataObject(XMLSegment); + end; + + XMLSegment := ConvertToXMLSegment(EDITransactionSet.SegmentSE); + Result.AppendEDIDataObject(XMLSegment); +end; + +procedure TEDIXMLANSIX12FormatTranslator.ConvertTransactionSetLoopToEDI( + EDITransactionSet: TEDITransactionSet; + XMLLoop: TEDIXMLTransactionSetLoop); +var + I: Integer; + EDISegment: TEDISegment; + XMLSegment: TEDIXMLSegment; + nXMLLoop: TEDIXMLTransactionSetLoop; +begin + for I := Low(XMLLoop.EDIDataObjects) to High(XMLLoop.EDIDataObjects) do + begin + if XMLLoop[I] is TEDIXMLSegment then + begin + XMLSegment := TEDIXMLSegment(XMLLoop[I]); + EDISegment := ConvertToEDISegment(XMLSegment); + EDITransactionSet.AppendSegment(EDISegment); + end + else + if XMLLoop[I] is TEDIXMLTransactionSetLoop then + begin + nXMLLoop := TEDIXMLTransactionSetLoop(XMLLoop[I]); + ConvertTransactionSetLoopToEDI(EDITransactionSet, nXMLLoop); + end + else + raise EJclEDIError.CreateResFmt(@EDIXMLError062, [XMLLoop[I].ClassName]); + end; +end; + +procedure TEDIXMLANSIX12FormatTranslator.ConvertTransactionSetLoopToXML( + EDILoop: TEDITransactionSetLoop; XMLLoop: TEDIXMLTransactionSetLoop); +var + I, xmlL: Integer; + EDISegment: TEDISegment; + XMLSegment: TEDIXMLSegment; + nEDILoop: TEDITransactionSetLoop; + nXMLLoop: TEDIXMLTransactionSetLoop; +begin + for I := 0 to EDILoop.EDIDataObjectCount - 1 do + begin + if EDILoop[I] is TEDISegment then + begin + EDISegment := TEDISegment(EDILoop[I]); + XMLSegment := ConvertToXMLSegment(EDISegment); + XMLLoop.AppendEDIDataObject(XMLSegment); + end + else + if EDILoop[I] is TEDITransactionSetLoop then + begin + nEDILoop := TEDITransactionSetLoop(EDILoop[I]); + xmlL := XMLLoop.AddGroup; + nXMLLoop := TEDIXMLTransactionSetLoop(XMLLoop[xmlL]); + nXMLLoop.Attributes.SetAttribute(XMLAttribute_Id, nEDILoop.OwnerLoopId); + ConvertTransactionSetLoopToXML(nEDILoop, nXMLLoop); + end + else + raise EJclEDIError.CreateResFmt(@EDIXMLError062, [EDILoop[I].ClassName]); + end; +end; + +end. + diff --git a/official/1.96/source/common/JclEDI_ANSIX12.pas b/official/1.96/source/common/JclEDI_ANSIX12.pas new file mode 100644 index 0000000..8127226 --- /dev/null +++ b/official/1.96/source/common/JclEDI_ANSIX12.pas @@ -0,0 +1,3258 @@ +{**************************************************************************************************} +{ } +{ 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 JclEDI_ANSIX12.pas. } +{ } +{ The Initial Developer of the Original Code is Raymond Alexander. } +{ Portions created by Raymond Alexander are Copyright Raymond Alexander. All rights reserved. } +{ } +{ Contributor(s): } +{ Raymond Alexander (rayspostbox3), Robert Marquardt, Robert Rossmair, Petr Vones } +{ } +{**************************************************************************************************} +{ } +{ Contains classes to eaisly parse EDI documents and data. Variable delimiter detection allows } +{ parsing of the file without knowledge of the standards at an Interchange level. This enables } +{ parsing and construction of EDI documents with different delimiters. } +{ } +{ Unit owner: Raymond Alexander } +{ Date created: May 22, 2003 } +{ Additional Info: } +{ E-Mail at RaysDelphiBox3 att hotmail dott com } +{ For latest EDI specific demos see http://sourceforge.net/projects/edisdk } +{ See home page for latest news & events and online help. } +{ } +{**************************************************************************************************} + +// $Id: JclEDI_ANSIX12.pas,v 1.18 2005/08/09 10:30:21 ahuser Exp $ + +unit JclEDI_ANSIX12; + +{$I jcl.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$WEAKPACKAGEUNIT ON} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +// (Default) Enable the following directive to use the optimized JclEDI.StringReplace function. +{$DEFINE OPTIMIZED_STRINGREPLACE} + +interface + +uses + SysUtils, Classes, + JclEDI; + +const + // ANSI X12 Segment Id's + ICHSegmentId = 'ISA'; // Interchange Control Header Segment Id + ICTSegmentId = 'IEA'; // Interchange Control Trailer Segment Id + FGHSegmentId = 'GS'; // Functional Group Header Segment Id + FGTSegmentId = 'GE'; // Functional Group Trailer Segment Id + TSHSegmentId = 'ST'; // Transaction Set Header Segment Id + TSTSegmentId = 'SE'; // Transaction Set Trailer Segment Id + TA1SegmentId = 'TA1'; // Interchange Acknowledgment Segment + + // Reserved Data Field Names (TStringList Values) + RDFN_Id = 'Id'; + RDFN_Position = 'Position'; + RDFN_Description = 'Description'; + RDFN_Notes = 'Notes'; + RDFN_Section = 'Section'; // For Segment Only + RDFN_RequirementDesignator = 'RequirementDesignator'; + RDFN_MaximumUsage = 'MaximumUsage'; // For Segment Only + RDFN_OwnerLoopId = 'OwnerLoopId'; // ... + RDFN_ParentLoopId = 'ParentLoopId'; // ... + RDFN_MaximumLoopRepeat = 'MaximumLoopRepeat'; // For Loop however saved in segment that begins loop + RDFN_Type = 'Type'; // For Element Only + RDFN_MinimumLength = 'MinimumLength'; // ... + RDFN_MaximumLength = 'MaximumLength'; // ... + + RDFN_TransSetId = 'TransSetId'; // For Segment ST Only + RDFN_TransSetDesc = 'TransSetDesc'; // ... + + RDFN_FunctionalGroupId = 'FunctionalGroupId'; // For Segment GS Only + RDFN_FGDescription = 'FGDescription'; // ... + RDFN_AgencyCodeId = 'AgencyCodeId'; // ... + RDFN_VersionReleaseId = 'VersionReleaseId'; // ... + + RDFN_StandardId = 'StandardId'; // For Segment ISA Only + RDFN_VersionId = 'VersionId'; // ... + RDFN_ICDescription = 'ICDescription'; // ... + +type + // EDI Forward Class Declarations + TEDIElement = class; + TEDISegment = class; + TEDITransactionSet = class; + TEDIFunctionalGroup = class; + TEDIInterchangeControl = class; + TEDIFile = class; + + // EDI Element + TEDIElement = class(TEDIDataObject) + public + constructor Create(Parent: TEDIDataObject); reintroduce; + function Assemble: string; override; + procedure Disassemble; override; + function GetIndexPositionFromParent: Integer; + end; + + TEDIElementArray = array of TEDIElement; + + // EDI Element Specification + TEDIElementSpec = class(TEDIElement) + private + FReservedData: TStringList; + FElementId: string; + FPosition: Integer; + FDescription: string; + FNotes: string; + FRequirementDesignator: string; + FType: string; + FMinimumLength: Integer; + FMaximumLength: Integer; + function GetReservedData: TStrings; + public + constructor Create(Parent: TEDIDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + published + property ReservedData: TStrings read GetReservedData; + property Id: string read FElementId write FElementId; + property ElementId: string read FElementId write FElementId; + property Position: Integer read FPosition write FPosition; + property Description: string read FDescription write FDescription; + property Notes: string read FNotes write FNotes; + property RequirementDesignator: string read FRequirementDesignator write FRequirementDesignator; + property ElementType: string read FType write FType; + property MinimumLength: Integer read FMinimumLength write FMinimumLength; + property MaximumLength: Integer read FMaximumLength write FMaximumLength; + end; + + // EDI Segment Classes + TEDISegment = class(TEDIDataObjectGroup) + private + function GetElement(Index: Integer): TEDIElement; + procedure SetElement(Index: Integer; Element: TEDIElement); + protected + FSegmentId: string; + function InternalCreateElement: TEDIElement; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + destructor Destroy; override; + // + function AddElement: Integer; + function AppendElement(Element: TEDIElement): Integer; + function InsertElement(InsertIndex: Integer): Integer; overload; + function InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; overload; + procedure DeleteElement(Index: Integer); overload; + procedure DeleteElement(Element: TEDIElement); overload; + // + function AddElements(Count: Integer): Integer; + function AppendElements(ElementArray: TEDIElementArray): Integer; + function InsertElements(InsertIndex, Count: Integer): Integer; overload; + function InsertElements(InsertIndex: Integer; + ElementArray: TEDIElementArray): Integer; overload; + procedure DeleteElements; overload; + procedure DeleteElements(Index, Count: Integer); overload; + // + function Assemble: string; override; + procedure Disassemble; override; + // + property Element[Index: Integer]: TEDIElement read GetElement write SetElement; default; + property Elements: TEDIDataObjectList read FEDIDataObjects; + published + property SegmentId: string read FSegmentId write FSegmentId; + property ElementCount: Integer read GetCount; + end; + + TEDISegmentArray = array of TEDISegment; + + TEDITransactionSetSegment = class(TEDISegment) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function InternalAssignDelimiters: TEDIDelimiters; override; + end; + + TEDIFunctionalGroupSegment = class(TEDISegment) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function InternalAssignDelimiters: TEDIDelimiters; override; + end; + + TEDIInterchangeControlSegment = class(TEDISegment) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function InternalAssignDelimiters: TEDIDelimiters; override; + end; + + // EDI Segment Specification Classes + TEDISegmentSpec = class(TEDISegment) + private + FReservedData: TStringList; + FPosition: Integer; + FDescription: string; + FNotes: string; + FSection: string; + FRequirementDesignator: string; + FMaximumUsage: Integer; + FOwnerLoopId: string; + FParentLoopId: string; + function GetReservedData: TStrings; + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + destructor Destroy; override; + procedure AssembleReservedData(ReservedData: TStrings); virtual; + procedure DisassembleReservedData(ReservedData: TStrings); virtual; + function InternalCreateElement: TEDIElement; override; + function Assemble: string; override; + procedure Disassemble; override; + procedure ValidateElementIndexPositions; + published + property ReservedData: TStrings read GetReservedData; + property Id: string read FSegmentId write FSegmentId; + property Position: Integer read FPosition write FPosition; + property Description: string read FDescription write FDescription; + property Notes: string read FNotes write FNotes; + property Section: string read FSection write FSection; + property RequirementDesignator: string read FRequirementDesignator write FRequirementDesignator; + property MaximumUsage: Integer read FMaximumUsage write FMaximumUsage; + property OwnerLoopId: string read FOwnerLoopId write FOwnerLoopId; + property ParentLoopId: string read FParentLoopId write FParentLoopId; + end; + + TEDITransactionSetSegmentSpec = class(TEDISegmentSpec) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function InternalAssignDelimiters: TEDIDelimiters; override; + end; + + TEDITransactionSetSegmentSTSpec = class(TEDITransactionSetSegmentSpec) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + procedure AssembleReservedData(ReservedData: TStrings); override; + procedure DisassembleReservedData(ReservedData: TStrings); override; + end; + + TEDIFunctionalGroupSegmentSpec = class(TEDISegmentSpec) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function InternalAssignDelimiters: TEDIDelimiters; override; + end; + + TEDIFunctionalGroupSegmentGSSpec = class(TEDIFunctionalGroupSegmentSpec) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + procedure AssembleReservedData(ReservedData: TStrings); override; + procedure DisassembleReservedData(ReservedData: TStrings); override; + end; + + TEDIInterchangeControlSegmentSpec = class(TEDISegmentSpec) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function InternalAssignDelimiters: TEDIDelimiters; override; + end; + + TEDIInterchangeControlSegmentISASpec = class(TEDIInterchangeControlSegmentSpec) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function Assemble: string; override; + procedure Disassemble; override; + procedure AssembleReservedData(ReservedData: TStrings); override; + procedure DisassembleReservedData(ReservedData: TStrings); override; + end; + + // EDI Transaction Set + TEDITransactionSet = class(TEDIDataObjectGroup) + private + FSTSegment: TEDISegment; + FSESegment: TEDISegment; + function GetSegment(Index: Integer): TEDISegment; + procedure SetSegment(Index: Integer; Segment: TEDISegment); + procedure SetSTSegment({$IFNDEF BCB6}const {$ENDIF !BCB6}STSegment: TEDISegment); + procedure SetSESegment({$IFNDEF BCB6}const {$ENDIF !BCB6}SESegment: TEDISegment); + protected + procedure InternalCreateHeaderTrailerSegments; virtual; + function InternalCreateSegment: TEDISegment; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; SegmentCount: Integer = 0); reintroduce; + destructor Destroy; override; + + function AddSegment: Integer; + function AppendSegment(Segment: TEDISegment): Integer; + function InsertSegment(InsertIndex: Integer): Integer; overload; + function InsertSegment(InsertIndex: Integer; Segment: TEDISegment): Integer; overload; + procedure DeleteSegment(Index: Integer); overload; + procedure DeleteSegment(Segment: TEDISegment); overload; + + function AddSegments(Count: Integer): Integer; + function AppendSegments(SegmentArray: TEDISegmentArray): Integer; + function InsertSegments(InsertIndex, Count: Integer): Integer; overload; + function InsertSegments(InsertIndex: Integer; + SegmentArray: TEDISegmentArray): Integer; overload; + procedure DeleteSegments; overload; + procedure DeleteSegments(Index, Count: Integer); overload; + + function Assemble: string; override; + procedure Disassemble; override; + + property Segment[Index: Integer]: TEDISegment read GetSegment write SetSegment; default; + property Segments: TEDIDataObjectList read FEDIDataObjects; + published + property SegmentST: TEDISegment read FSTSegment write SetSTSegment; + property SegmentSE: TEDISegment read FSESegment write SetSESegment; + property SegmentCount: Integer read GetCount; + end; + + TEDITransactionSetArray = array of TEDITransactionSet; + + // EDI Transaction Set Specification + TEDITransactionSetSpec = class(TEDITransactionSet) + private + FTransactionSetId: string; + FTSDescription: string; + public + procedure InternalCreateHeaderTrailerSegments; override; + function InternalCreateSegment: TEDISegment; override; + procedure ValidateSegmentIndexPositions; + published + property Id: string read FTransactionSetId write FTransactionSetId; + property TransactionSetId: string read FTransactionSetId write FTransactionSetId; + property TSDescription: string read FTSDescription write FTSDescription; + end; + + // EDI Transaction Set Loop + TEDITransactionSetLoop = class(TEDIDataObjectGroup) + protected + FOwnerLoopId: string; + FParentLoopId: string; + FParentTransactionSet: TEDITransactionSet; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + // + // ToDo: More procedures and functions to manage internal structures + // + function FindLoop(LoopId: string; var StartIndex: Integer): TEDITransactionSetLoop; + function FindSegment(SegmentId: string; var StartIndex: Integer): TEDISegment; overload; + function FindSegment(SegmentId: string; var StartIndex: Integer; + ElementConditions: TStrings): TEDISegment; overload; + // + function AddLoop(OwnerLoopId, ParentLoopId: string): Integer; + procedure AppendSegment(Segment: TEDISegment); + procedure DeleteEDIDataObjects; + published + property OwnerLoopId: string read FOwnerLoopId write FOwnerLoopId; + property ParentLoopId: string read FParentLoopId write FParentLoopId; + property ParentTransactionSet: TEDITransactionSet read FParentTransactionSet + write FParentTransactionSet; + end; + + // EDI Transaction Set Document and related types and classes + TEDITransactionSetDocumentOptions = set of (doLinkSpecToDataObject); + + TEDITransactionSetDocument = class(TEDITransactionSetLoop) + private + protected + FErrorOccured: Boolean; + FEDITSDOptions: TEDITransactionSetDocumentOptions; + FEDILoopStack: TEDILoopStack; + // References + FEDITransactionSet: TEDITransactionSet; + FEDITransactionSetSpec: TEDITransactionSetSpec; + function ValidateSegSpecIndex(DataSegmentId: string; SpecStartIndex: Integer): Integer; + function AdvanceSegSpecIndex(DataIndex, SpecStartIndex, SpecEndIndex: Integer): Integer; + procedure AddLoopToDoc(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); + procedure SetSpecificationPointers(DataSegment, SpecSegment: TEDISegment); + protected + procedure ValidateData(TSDocument: TEDITransactionSetDocument; + LoopStack: TEDILoopStack; + DataSegment, SpecSegment: TEDISegment; + var DataIndex, SpecIndex: Integer; + var ErrorOccured: Boolean); virtual; + public + constructor Create(Parent: TEDIDataObject; EDITransactionSet: TEDITransactionSet; + EDITransactionSetSpec: TEDITransactionSetSpec); reintroduce; + destructor Destroy; override; + // + // ToDo: More procedures and functions to manage internal structures + // + procedure FormatDocument; virtual; + published + property EDITSDOptions: TEDITransactionSetDocumentOptions read FEDITSDOptions + write FEDITSDOptions; + property ErrorOccured: Boolean read FErrorOccured; + end; + + TEDITransactionSetDocumentArray = array of TEDITransactionSetDocument; + + // EDI Functional Group + TEDIFunctionalGroup = class(TEDIDataObjectGroup) + private + FGSSegment: TEDISegment; + FGESegment: TEDISegment; + function GetTransactionSet(Index: Integer): TEDITransactionSet; + procedure SetTransactionSet(Index: Integer; TransactionSet: TEDITransactionSet); + procedure SetGSSegment(const GSSegment: TEDISegment); + procedure SetGESegment(const GESegment: TEDISegment); + protected + procedure InternalCreateHeaderTrailerSegments; virtual; + function InternalCreateTransactionSet: TEDITransactionSet; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; TransactionSetCount: Integer = 0); reintroduce; + destructor Destroy; override; + + function AddTransactionSet: Integer; + function AppendTransactionSet(TransactionSet: TEDITransactionSet): Integer; + function InsertTransactionSet(InsertIndex: Integer): Integer; overload; + function InsertTransactionSet(InsertIndex: Integer; + TransactionSet: TEDITransactionSet): Integer; overload; + procedure DeleteTransactionSet(Index: Integer); overload; + procedure DeleteTransactionSet(TransactionSet: TEDITransactionSet); overload; + + function AddTransactionSets(Count: Integer): Integer; + function AppendTransactionSets(TransactionSetArray: TEDITransactionSetArray): Integer; + function InsertTransactionSets(InsertIndex, Count: Integer): Integer; overload; + function InsertTransactionSets(InsertIndex: Integer; + TransactionSetArray: TEDITransactionSetArray): Integer; overload; + procedure DeleteTransactionSets; overload; + procedure DeleteTransactionSets(Index, Count: Integer); overload; + + function Assemble: string; override; + procedure Disassemble; override; + + property TransactionSet[Index: Integer]: TEDITransactionSet read GetTransactionSet + write SetTransactionSet; default; + property TransactionSets: TEDIDataObjectList read FEDIDataObjects; + published + property SegmentGS: TEDISegment read FGSSegment write SetGSSegment; + property SegmentGE: TEDISegment read FGESegment write SetGESegment; + property TransactionSetCount: Integer read GetCount; + end; + + TEDIFunctionalGroupArray = array of TEDIFunctionalGroup; + + // EDI Functional Specification + TEDIFunctionalGroupSpec = class(TEDIFunctionalGroup) + private + FFunctionalGroupId: string; + FFGDescription: string; + FAgencyCodeId: string; + FVersionReleaseId: string; + public + procedure InternalCreateHeaderTrailerSegments; override; + function InternalCreateTransactionSet: TEDITransactionSet; override; + function FindTransactionSetSpec(TransactionSetId: string): TEDITransactionSetSpec; + published + property Id: string read FFunctionalGroupId write FFunctionalGroupId; + property FunctionalGroupId: string read FFunctionalGroupId write FFunctionalGroupId; + property FGDescription: string read FFGDescription write FFGDescription; + property AgencyCodeId: string read FAgencyCodeId write FAgencyCodeId; + property VersionReleaseId: string read FVersionReleaseId write FVersionReleaseId; + end; + + // EDI Interchange Control + TEDIInterchangeControl = class(TEDIDataObjectGroup) + private + FISASegment: TEDISegment; + FIEASegment: TEDISegment; + FTA1Segments: TEDIObjectList; + function GetFunctionalGroup(Index: Integer): TEDIFunctionalGroup; + procedure SetFunctionalGroup(Index: Integer; FunctionalGroup: TEDIFunctionalGroup); + procedure SetISASegment(const ISASegment: TEDISegment); + procedure SetIEASegment(const IEASegment: TEDISegment); + protected + procedure InternalCreateHeaderTrailerSegments; virtual; + function InternalCreateFunctionalGroup: TEDIFunctionalGroup; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; FunctionalGroupCount: Integer = 0); reintroduce; + destructor Destroy; override; + + function AddFunctionalGroup: Integer; + function AppendFunctionalGroup(FunctionalGroup: TEDIFunctionalGroup): Integer; + function InsertFunctionalGroup(InsertIndex: Integer): Integer; overload; + function InsertFunctionalGroup(InsertIndex: Integer; + FunctionalGroup: TEDIFunctionalGroup): Integer; overload; + procedure DeleteFunctionalGroup(Index: Integer); overload; + procedure DeleteFunctionalGroup(FunctionalGroup: TEDIFunctionalGroup); overload; + + function AddFunctionalGroups(Count: Integer): Integer; + function AppendFunctionalGroups(FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; + function InsertFunctionalGroups(InsertIndex, Count: Integer): Integer; overload; + function InsertFunctionalGroups(InsertIndex: Integer; + FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; overload; + procedure DeleteFunctionalGroups; overload; + procedure DeleteFunctionalGroups(Index, Count: Integer); overload; + + function Assemble: string; override; + procedure Disassemble; override; + + property FunctionalGroup[Index: Integer]: TEDIFunctionalGroup read GetFunctionalGroup + write SetFunctionalGroup; default; + property FunctionalGroups: TEDIDataObjectList read FEDIDataObjects; + published + property SegmentISA: TEDISegment read FISASegment write SetISASegment; + property SegmentIEA: TEDISegment read FIEASegment write SetIEASegment; + property TA1Segments: TEDIObjectList read FTA1Segments; + property FunctionalGroupCount: Integer read GetCount; + end; + + TEDIInterchangeControlArray = array of TEDIInterchangeControl; + + // EDI Interchange Specification + TEDIInterchangeControlSpec = class(TEDIInterchangeControl) + private + FStandardId: string; + FVersionId: string; + FICDescription: string; + public + procedure InternalCreateHeaderTrailerSegments; override; + function InternalCreateFunctionalGroup: TEDIFunctionalGroup; override; + function FindFunctionalGroupSpec(FunctionalGroupId, AgencyCodeId, + VersionReleaseId: string): TEDIFunctionalGroupSpec; + function FindTransactionSetSpec(FunctionalGroupId, AgencyCodeId, VersionReleaseId, + TransactionSetId: string): TEDITransactionSetSpec; + published + property StandardId: string read FStandardId write FStandardId; + property VersionId: string read FVersionId write FVersionId; + property ICDescription: string read FICDescription write FICDescription; + end; + + // EDI File + TEDIFileOptions = set of (foVariableDelimiterDetection, foUseAltDelimiterDetection, foRemoveCrLf, + foRemoveCr, foRemoveLf, foIgnoreGarbageAtEndOfFile); + + TEDIFile = class(TEDIDataObjectGroup) + private + FFileID: Integer; + FFileName: string; + FEDIFileOptions: TEDIFileOptions; + function GetInterchangeControl(Index: Integer): TEDIInterchangeControl; + procedure SetInterchangeControl(Index: Integer; Interchange: TEDIInterchangeControl); + procedure InternalLoadFromFile; + protected + procedure InternalDelimitersDetection(StartPos: Integer); virtual; + procedure InternalAlternateDelimitersDetection(StartPos: Integer); + function InternalCreateInterchangeControl: TEDIInterchangeControl; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; InterchangeCount: Integer = 0); reintroduce; + destructor Destroy; override; + + procedure LoadFromFile(const FileName: string); + procedure ReLoadFromFile; + procedure SaveToFile; + procedure SaveAsToFile(const FileName: string); + + function AddInterchange: Integer; + function AppendInterchange(Interchange: TEDIInterchangeControl): Integer; + function InsertInterchange(InsertIndex: Integer): Integer; overload; + function InsertInterchange(InsertIndex: Integer; + Interchange: TEDIInterchangeControl): Integer; overload; + procedure DeleteInterchange(Index: Integer); overload; + procedure DeleteInterchange(Interchange: TEDIInterchangeControl); overload; + + function AddInterchanges(Count: Integer): Integer; + function AppendInterchanges( + InterchangeControlArray: TEDIInterchangeControlArray): Integer; + function InsertInterchanges(InsertIndex, Count: Integer): Integer; overload; + function InsertInterchanges(InsertIndex: Integer; + InterchangeControlArray: TEDIInterchangeControlArray): Integer; overload; + procedure DeleteInterchanges; overload; + procedure DeleteInterchanges(Index, Count: Integer); overload; + + function Assemble: string; override; + procedure Disassemble; override; + + property Interchange[Index: Integer]: TEDIInterchangeControl read GetInterchangeControl + write SetInterchangeControl; default; + property Interchanges: TEDIDataObjectList read FEDIDataObjects; + published + property FileID: Integer read FFileID write FFileID; + property FileName: string read FFileName write FFileName; + property Options: TEDIFileOptions read FEDIFileOptions write FEDIFileOptions; + property InterchangeControlCount: Integer read GetCount; + end; + + TEDIFileArray = array of TEDIFile; + + // EDI File Specification + TEDIFileSpec = class(TEDIFile) + public + constructor Create(Parent: TEDIDataObject; InterchangeCount: Integer = 0); reintroduce; + function FindTransactionSetSpec(StandardId, VersionId, FunctionalGroupId, AgencyCodeId, + VersionReleaseId, TransactionSetId: string): TEDITransactionSetSpec; + function FindFunctionalGroupSpec(StandardId, VersionId, FunctionalGroupId, AgencyCodeId, + VersionReleaseId: string): TEDIFunctionalGroupSpec; + function FindInterchangeControlSpec(StandardId, VersionId: string): TEDIInterchangeControlSpec; + procedure InternalDelimitersDetection(StartPos: Integer); override; + function InternalCreateInterchangeControl: TEDIInterchangeControl; override; + end; + +implementation + +uses + JclResources, JclStrings; + +const + { Reserved Data Field Values } + Value_Unknown = 'Unknown'; + Value_NotAssigned = 'Not Assigned'; + Value_None = 'None'; + Value_Optional = 'O'; + Value_Mandatory = 'M'; + Value_AlphaNumeric = 'AN'; + +//=== { TEDIElement } ======================================================== + +constructor TEDIElement.Create(Parent: TEDIDataObject); +begin + if Assigned(Parent) and (Parent is TEDISegment) then + inherited Create(Parent) + else + inherited Create(nil); + FEDIDOT := ediElement; +end; + +function TEDIElement.Assemble: string; +begin + Result := FData; + FState := ediAssembled; +end; + +procedure TEDIElement.Disassemble; +begin + FState := ediDisassembled; +end; + +function TEDIElement.GetIndexPositionFromParent: Integer; +var + I: Integer; +begin + Result := -1; + if Assigned(Parent) and (Parent is TEDISegment) then + for I := 0 to TEDISegment(Parent).ElementCount - 1 do + if TEDISegment(Parent).Element[I] = Self then + begin + Result := I; + Break; + end; +end; + +//=== { TEDISegment } ======================================================== + +constructor TEDISegment.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + if Assigned(Parent) and (Parent is TEDITransactionSet) then + inherited Create(Parent, ElementCount) + else + inherited Create(nil, ElementCount); + FSegmentId := ''; + FEDIDOT := ediSegment; +end; + +destructor TEDISegment.Destroy; +begin + inherited Destroy; +end; + +function TEDISegment.AddElements(Count: Integer): Integer; +begin + Result := AddEDIDataObjects(Count); +end; + +function TEDISegment.AddElement: Integer; +begin + Result := AddEDIDataObject; +end; + +function TEDISegment.AppendElement(Element: TEDIElement): Integer; +begin + Result := AppendEDIDataObject(Element); +end; + +function TEDISegment.AppendElements(ElementArray: TEDIElementArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := AppendEDIDataObjects(TEDIDataObjectArray(ElementArray)); + {$ELSE} + SetLength(HelpArray, Length(ElementArray)); + for I := 0 to High(ElementArray) do + HelpArray[I] := TEDIDataObject(ElementArray[I]); + Result := AppendEDIDataObjects(HelpArray); + {$ENDIF CLR} +end; + +function TEDISegment.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError036); + {$ELSE} + raise EJclEDIError.Create(RsEDIError036); + {$ENDIF ~CLR} + end; + + FData := FSegmentId; + if GetCount > 0 then + for I := 0 to GetCount - 1 do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FDelimiters.ED + FEDIDataObjects[I].Assemble + else + FData := FData + FDelimiters.ED; + FData := FData + FDelimiters.SD; + FLength := Length(FData); + Result := FData; // Return assembled string + + DeleteElements; + + FState := ediAssembled; +end; + +procedure TEDISegment.DeleteElement(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDISegment.DeleteElement(Element: TEDIElement); +begin + DeleteEDIDataObject(Element); +end; + +procedure TEDISegment.DeleteElements(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDISegment.DeleteElements; +begin + DeleteEDIDataObjects; +end; + +procedure TEDISegment.Disassemble; +var + I, StartPos, SearchResult: Integer; +begin + // Data Input Scenarios + // 4.) SegID*---*---~ + // Composite Element Data Input Secnarios + // 9.) SegID*---*--->---~ + FSegmentId := ''; + DeleteElements; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError035); + {$ELSE} + raise EJclEDIError.Create(RsEDIError035); + {$ENDIF ~CLR} + end; + // Continue + StartPos := 1; + SearchResult := StrSearch(FDelimiters.ED, FData, StartPos); + FSegmentId := Copy(FData, 1, SearchResult - 1); + StartPos := SearchResult + 1; + SearchResult := StrSearch(FDelimiters.ED, FData, StartPos); + while SearchResult <> 0 do + begin + I := AddElement; + if (SearchResult - StartPos) > 0 then // data exists + begin + FEDIDataObjects[I].Data := Copy(FData, ((StartPos + FDelimiters.EDLen) - 1), + (SearchResult - StartPos)); + FEDIDataObjects[I].Disassemble; + end; + StartPos := SearchResult + 1; + SearchResult := StrSearch(FDelimiters.ED, FData, StartPos); + end; + // Get last element before next segment + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + if SearchResult <> 0 then + begin + I := AddElement; + if (SearchResult - StartPos) > 0 then // data exists + begin + FEDIDataObjects[I].Data := Copy(FData, ((StartPos + FDelimiters.EDLen) - 1), + (SearchResult - StartPos)); + FEDIDataObjects[I].Disassemble; + end; + end; + FData := ''; + FState := ediDisassembled; +end; + +function TEDISegment.GetElement(Index: Integer): TEDIElement; +begin + Result := TEDIElement(GetEDIDataObject(Index)); +end; + +function TEDISegment.InsertElement(InsertIndex: Integer): Integer; +begin + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDISegment.InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, Element); +end; + +function TEDISegment.InsertElements(InsertIndex: Integer; ElementArray: TEDIElementArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(ElementArray)); + {$ELSE} + SetLength(HelpArray, Length(ElementArray)); + for I := 0 to High(ElementArray) do + HelpArray[I] := TEDIDataObject(ElementArray[I]); + Result := InsertEDIDataObjects(InsertIndex, HelpArray); + {$ENDIF CLR} +end; + +function TEDISegment.InsertElements(InsertIndex, Count: Integer): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDISegment.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + // Get the delimiters from the transaction set + if Assigned(Parent) and (Parent is TEDITransactionSet) then + begin + if Assigned(Parent.Delimiters) then + begin + Result := Parent.Delimiters; + Exit; + end; + // Get the delimiters from the functional group + if Assigned(Parent.Parent) and (Parent.Parent is TEDIFunctionalGroup) then + begin + if Assigned(Parent.Parent.Delimiters) then + begin + Result := Parent.Parent.Delimiters; + Exit; + end; + // Get the delimiters from the interchange control header + if Assigned(Parent.Parent.Parent) and (Parent.Parent.Parent is TEDIInterchangeControl) then + Result := Parent.Parent.Parent.Delimiters; + end; + end; +end; + +function TEDISegment.InternalCreateElement: TEDIElement; +begin + Result := TEDIElement.Create(Self); +end; + +procedure TEDISegment.SetElement(Index: Integer; Element: TEDIElement); +begin + SetEDIDataObject(Index, Element); +end; + +function TEDISegment.InternalCreateEDIDataObject: TEDIDataObject; +begin + Result := InternalCreateElement; +end; + +//=== { TEDITransactionSetSegment } ========================================== + +constructor TEDITransactionSetSegment.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDITransactionSet) then + FParent := Parent; +end; + +function TEDITransactionSetSegment.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := inherited InternalAssignDelimiters; +end; + +//=== { TEDIFunctionalGroupSegment } ========================================= + +constructor TEDIFunctionalGroupSegment.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then + FParent := Parent; +end; + +function TEDIFunctionalGroupSegment.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + // Get the delimiters from the functional group + if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then + begin + if Assigned(Parent.Delimiters) then + begin + Result := Parent.Delimiters; + Exit; + end; + // Get the delimiters from the interchange control + if Assigned(Parent.Parent) and (Parent.Parent is TEDIInterchangeControl) then + Result := Parent.Parent.Delimiters; + end; +end; + +//=== { TEDIInterchangeControlSegment } ===================================== + +constructor TEDIInterchangeControlSegment.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + FParent := Parent; +end; + +function TEDIInterchangeControlSegment.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + // Get the delimiters from the interchange control + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + Result := Parent.Delimiters; +end; + +//=== { TEDITransactionSet } ================================================= + +constructor TEDITransactionSet.Create(Parent: TEDIDataObject; SegmentCount: Integer); +begin + if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then + inherited Create(Parent, SegmentCount) + else + inherited Create(nil, SegmentCount); + FEDIDOT := ediTransactionSet; + InternalCreateHeaderTrailerSegments; +end; + +destructor TEDITransactionSet.Destroy; +begin + FSESegment.Free; + FSTSegment.Free; + inherited Destroy; +end; + +function TEDITransactionSet.AddSegment: Integer; +begin + Result := AddEDIDataObject; +end; + +function TEDITransactionSet.AddSegments(Count: Integer): Integer; +begin + Result := AddEDIDataObjects(Count); +end; + +function TEDITransactionSet.AppendSegment(Segment: TEDISegment): Integer; +begin + Result := AppendEDIDataObject(Segment); +end; + +function TEDITransactionSet.AppendSegments(SegmentArray: TEDISegmentArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := AppendEDIDataObjects(TEDIDataObjectArray(SegmentArray)); + {$ELSE} + SetLength(HelpArray, Length(SegmentArray)); + for I := 0 to High(SegmentArray) do + HelpArray[I] := TEDIDataObject(SegmentArray[I]); + Result := AppendEDIDataObjects(HelpArray); + {$ENDIF CLR} +end; + +function TEDITransactionSet.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError026); + {$ELSE} + raise EJclEDIError.Create(RsEDIError026); + {$ENDIF ~CLR} + end; + + FData := FSTSegment.Assemble; + FSTSegment.Data := ''; + + if GetCount > 0 then + for I := 0 to GetCount - 1 do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + + DeleteSegments; + + FData := FData + FSESegment.Assemble; + FSESegment.Data := ''; + + FLength := Length(FData); + Result := FData; + + FState := ediAssembled; +end; + +procedure TEDITransactionSet.DeleteSegment(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDITransactionSet.DeleteSegment(Segment: TEDISegment); +begin + DeleteEDIDataObject(Segment); +end; + +procedure TEDITransactionSet.DeleteSegments; +begin + DeleteEDIDataObjects; +end; + +procedure TEDITransactionSet.DeleteSegments(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDITransactionSet.Disassemble; +var + I, StartPos, SearchResult: Integer; + S, S2: string; +begin + FSTSegment.Data := ''; + FSTSegment.DeleteElements; + FSESegment.Data := ''; + FSESegment.DeleteElements; + DeleteSegments; + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError025); + {$ELSE} + raise EJclEDIError.Create(RsEDIError025); + {$ENDIF ~CLR} + end; + // Find the first segment + StartPos := 1; + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + while SearchResult <> 0 do + begin + S := Copy(FData, StartPos, Length(TSHSegmentId)); + S2 := Copy(FData, StartPos, Length(TSTSegmentId)); + if (S <> TSHSegmentId) and (S2 <> TSTSegmentId) then + begin + I := AddSegment; + if (SearchResult - StartPos) > 0 then // data exists + begin + FEDIDataObjects[I].Data := Copy(FData, StartPos, + ((SearchResult - StartPos) + FDelimiters.SDLen)); + FEDIDataObjects[I].Disassemble; + end; + end + else + if S = TSHSegmentId then + begin + if (SearchResult - StartPos) > 0 then // data exists + begin + FSTSegment.Data := Copy(FData, StartPos, + ((SearchResult - StartPos) + FDelimiters.SDLen)); + FSTSegment.Disassemble; + end; + end + else + if S2 = TSTSegmentId then + begin + if (SearchResult - StartPos) > 0 then // data exists + begin + FSESegment.Data := Copy(FData, StartPos, + ((SearchResult - StartPos) + FDelimiters.SDLen)); + FSESegment.Disassemble; + end; + end; + StartPos := SearchResult + FDelimiters.SDLen; + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + end; + FData := ''; + FState := ediDisassembled; +end; + +function TEDITransactionSet.GetSegment(Index: Integer): TEDISegment; +begin + Result := TEDISegment(GetEDIDataObject(Index)); +end; + +function TEDITransactionSet.InsertSegment(InsertIndex: Integer): Integer; +begin + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDITransactionSet.InsertSegment(InsertIndex: Integer; Segment: TEDISegment): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, Segment); +end; + +function TEDITransactionSet.InsertSegments(InsertIndex, Count: Integer): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDITransactionSet.InsertSegments(InsertIndex: Integer; + SegmentArray: TEDISegmentArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(SegmentArray)); + {$ELSE} + SetLength(HelpArray, Length(SegmentArray)); + for I := 0 to High(SegmentArray) do + HelpArray[I] := TEDIDataObject(SegmentArray[I]); + Result := InsertEDIDataObjects(InsertIndex, HelpArray); + {$ENDIF CLR} +end; + +function TEDITransactionSet.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + if FDelimiters = nil then // Attempt to assign the delimiters + if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then + begin + if Assigned(Parent.Delimiters) then + begin + Result := Parent.Delimiters; + Exit; + end; + if Assigned(Parent.Parent) and (Parent.Parent is TEDIInterchangeControl) then + Result := Parent.Parent.Delimiters; + end; +end; + +function TEDITransactionSet.InternalCreateSegment: TEDISegment; +begin + Result := TEDISegment.Create(Self); +end; + +procedure TEDITransactionSet.InternalCreateHeaderTrailerSegments; +begin + FSTSegment := TEDITransactionSetSegment.Create(Self); + FSESegment := TEDITransactionSetSegment.Create(Self); +end; + +procedure TEDITransactionSet.SetSegment(Index: Integer; Segment: TEDISegment); +begin + SetEDIDataObject(Index, Segment); +end; + +procedure TEDITransactionSet.SetSESegment({$IFNDEF BCB6}const {$ENDIF !BCB6}SESegment: TEDISegment); +begin + FreeAndNil(FSESegment); + FSESegment := SESegment; + if Assigned(FSESegment) then + FSESegment.Parent := Self; +end; + +procedure TEDITransactionSet.SetSTSegment({$IFNDEF BCB6}const {$ENDIF !BCB6}STSegment: TEDISegment); +begin + FreeAndNil(FSTSegment); + FSTSegment := STSegment; + if Assigned(FSTSegment) then + FSTSegment.Parent := Self; +end; + +function TEDITransactionSet.InternalCreateEDIDataObject: TEDIDataObject; +begin + Result := InternalCreateSegment; +end; + +//=== { TEDIFunctionalGroup } ================================================ + +constructor TEDIFunctionalGroup.Create(Parent: TEDIDataObject; TransactionSetCount: Integer); +begin + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + inherited Create(Parent, TransactionSetCount) + else + inherited Create(nil, TransactionSetCount); + FEDIDOT := ediFunctionalGroup; + InternalCreateHeaderTrailerSegments; +end; + +destructor TEDIFunctionalGroup.Destroy; +begin + FGSSegment.Free; + FGESegment.Free; + inherited Destroy; +end; + +function TEDIFunctionalGroup.AddTransactionSet: Integer; +begin + Result := AddEDIDataObject; +end; + +function TEDIFunctionalGroup.AddTransactionSets(Count: Integer): Integer; +begin + Result := AddEDIDataObjects(Count); +end; + +function TEDIFunctionalGroup.AppendTransactionSet(TransactionSet: TEDITransactionSet): Integer; +begin + Result := AppendEDIDataObject(TransactionSet); +end; + +function TEDIFunctionalGroup.AppendTransactionSets( + TransactionSetArray: TEDITransactionSetArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := AppendEDIDataObjects(TEDIDataObjectArray(TransactionSetArray)); + {$ELSE} + SetLength(HelpArray, Length(TransactionSetArray)); + for I := 0 to High(TransactionSetArray) do + HelpArray[I] := TEDIDataObject(TransactionSetArray[I]); + Result := AppendEDIDataObjects(HelpArray); + {$ENDIF CLR} +end; + +function TEDIFunctionalGroup.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError020); + {$ELSE} + raise EJclEDIError.Create(RsEDIError020); + {$ENDIF ~CLR} + end; + FData := FGSSegment.Assemble; + FGSSegment.Data := ''; + + if GetCount > 0 then + for I := 0 to GetCount - 1 do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + + DeleteTransactionSets; + + FData := FData + FGESegment.Assemble; + FGESegment.Data := ''; + + FLength := Length(FData); + Result := FData; + + FState := ediAssembled; +end; + +procedure TEDIFunctionalGroup.DeleteTransactionSet(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDIFunctionalGroup.DeleteTransactionSet(TransactionSet: TEDITransactionSet); +begin + DeleteEDIDataObject(TransactionSet); +end; + +procedure TEDIFunctionalGroup.DeleteTransactionSets; +begin + DeleteEDIDataObjects; +end; + +procedure TEDIFunctionalGroup.DeleteTransactionSets(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDIFunctionalGroup.Disassemble; +var + I, StartPos, SearchResult: Integer; +begin + FGSSegment.Data := ''; + FGSSegment.DeleteElements; + FGESegment.Data := ''; + FGESegment.DeleteElements; + DeleteTransactionSets; + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError019); + {$ELSE} + raise EJclEDIError.Create(RsEDIError019); + {$ENDIF ~CLR} + end; + // Find Functional Group Header Segment + StartPos := 1; + // Search for Functional Group Header + if FGHSegmentId + FDelimiters.ED = Copy(FData, 1, Length(FGHSegmentId + FDelimiters.ED)) then + begin + // Search for Functional Group Header Segment Terminator + SearchResult := StrSearch(FDelimiters.SD, FData, 1); + if (SearchResult - StartPos) > 0 then // data exists + begin + FGSSegment.Data := Copy(FData, 1, (SearchResult + FDelimiters.SDLen) - 1); + FGSSegment.Disassemble; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError021); + {$ELSE} + raise EJclEDIError.Create(RsEDIError021); + {$ENDIF ~CLR} + end +else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError022); + {$ELSE} + raise EJclEDIError.Create(RsEDIError022); + {$ENDIF ~CLR} + // Search for Transaction Set Header + SearchResult := StrSearch(FDelimiters.SD + TSHSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult <= 0 then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError027); + {$ELSE} + raise EJclEDIError.Create(RsEDIError027); + {$ENDIF ~CLR} + // Set next start position + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Continue + while SearchResult <> 0 do + begin + // Search for Transaction Set Trailer + SearchResult := StrSearch(FDelimiters.SD + TSTSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult <> 0 then + begin + // Set the next start position + SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Search for the end of Transaction Set Trailer + SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); + if SearchResult <> 0 then + begin + I := AddTransactionSet; + FEDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); + FEDIDataObjects[I].Disassemble; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError028); + {$ELSE} + raise EJclEDIError.Create(RsEDIError028); + {$ENDIF ~CLR} + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError029); + {$ELSE} + raise EJclEDIError.Create(RsEDIError029); + {$ENDIF ~CLR} + // Set the next start position + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // + // Verify the next record is a Transaction Set Header + if (TSHSegmentId + FDelimiters.ED) <> + Copy(FData, StartPos, (Length(TSHSegmentId) + FDelimiters.EDLen)) then + Break; + end; + // Set the next start position + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Find Functional Group Trailer Segment + if (FGTSegmentId + FDelimiters.ED) = + Copy(FData, StartPos, Length(FGTSegmentId + FDelimiters.ED)) then + begin + // Find Functional Group Trailer Segment Terminator + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos + FDelimiters.SDLen); + if (SearchResult - StartPos) > 0 then // data exists + begin + FGESegment.Data := Copy(FData, StartPos, (SearchResult + FDelimiters.SDLen)); + FGESegment.Disassemble; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError023); + {$ELSE} + raise EJclEDIError.Create(RsEDIError023); + {$ENDIF ~CLR} + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError024); + {$ELSE} + raise EJclEDIError.Create(RsEDIError024); + {$ENDIF ~CLR} + FData := ''; + FState := ediDisassembled; +end; + +function TEDIFunctionalGroup.GetTransactionSet(Index: Integer): TEDITransactionSet; +begin + Result := TEDITransactionSet(GetEDIDataObject(Index)); +end; + +function TEDIFunctionalGroup.InsertTransactionSet(InsertIndex: Integer): Integer; +begin + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDIFunctionalGroup.InsertTransactionSet(InsertIndex: Integer; + TransactionSet: TEDITransactionSet): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, TransactionSet); +end; + +function TEDIFunctionalGroup.InsertTransactionSets(InsertIndex: Integer; + TransactionSetArray: TEDITransactionSetArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(TransactionSetArray)); + {$ELSE} + SetLength(HelpArray, Length(TransactionSetArray)); + for I := 0 to High(TransactionSetArray) do + HelpArray[I] := TEDIDataObject(TransactionSetArray[I]); + Result := InsertEDIDataObjects(InsertIndex, HelpArray); + {$ENDIF CLR} +end; + +function TEDIFunctionalGroup.InsertTransactionSets(InsertIndex, Count: Integer): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDIFunctionalGroup.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + Result := Parent.Delimiters; +end; + +function TEDIFunctionalGroup.InternalCreateTransactionSet: TEDITransactionSet; +begin + Result := TEDITransactionSet.Create(Self); +end; + +procedure TEDIFunctionalGroup.InternalCreateHeaderTrailerSegments; +begin + FGSSegment := TEDIFunctionalGroupSegment.Create(Self); + FGESegment := TEDIFunctionalGroupSegment.Create(Self); +end; + +procedure TEDIFunctionalGroup.SetTransactionSet(Index: Integer; TransactionSet: TEDITransactionSet); +begin + SetEDIDataObject(Index, TransactionSet); +end; + +procedure TEDIFunctionalGroup.SetGESegment(const GESegment: TEDISegment); +begin + FreeAndNil(FGESegment); + FGESegment := GESegment; + if Assigned(FGESegment) then + FGESegment.Parent := Self; +end; + +procedure TEDIFunctionalGroup.SetGSSegment(const GSSegment: TEDISegment); +begin + FreeAndNil(FGSSegment); + FGSSegment := GSSegment; + if Assigned(FGSSegment) then + FGSSegment.Parent := Self; +end; + +function TEDIFunctionalGroup.InternalCreateEDIDataObject: TEDIDataObject; +begin + Result := InternalCreateTransactionSet; +end; + +//== { TEDIInterchangeControl } ============================================== + +constructor TEDIInterchangeControl.Create(Parent: TEDIDataObject; FunctionalGroupCount: Integer); +begin + if Assigned(Parent) and (Parent is TEDIFile) then + inherited Create(Parent, FunctionalGroupCount) + else + inherited Create(nil, FunctionalGroupCount); + FEDIDOT := ediInterchangeControl; + InternalCreateHeaderTrailerSegments; + FTA1Segments := TEDIObjectList.Create; +end; + +destructor TEDIInterchangeControl.Destroy; +begin + FTA1Segments.Clear; + FTA1Segments.Free; + FISASegment.Free; + FIEASegment.Free; + FreeAndNil(FDelimiters); + inherited Destroy; +end; + +function TEDIInterchangeControl.AddFunctionalGroup: Integer; +begin + Result := AddEDIDataObject; +end; + +function TEDIInterchangeControl.AddFunctionalGroups(Count: Integer): Integer; +begin + Result := AddEDIDataObjects(Count); +end; + +function TEDIInterchangeControl.AppendFunctionalGroup( + FunctionalGroup: TEDIFunctionalGroup): Integer; +begin + Result := AppendEDIDataObject(FunctionalGroup); +end; + +function TEDIInterchangeControl.AppendFunctionalGroups( + FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := AppendEDIDataObjects(TEDIDataObjectArray(FunctionalGroupArray)); + {$ELSE} + SetLength(HelpArray, Length(FunctionalGroupArray)); + for I := 0 to High(FunctionalGroupArray) do + HelpArray[I] := TEDIDataObject(FunctionalGroupArray[I]); + Result := AppendEDIDataObjects(HelpArray); + {$ENDIF CLR} +end; + +function TEDIInterchangeControl.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError013); + {$ELSE} + raise EJclEDIError.Create(RsEDIError013); + {$ENDIF ~CLR} + + FData := FISASegment.Assemble; + FISASegment.Data := ''; + + if GetCount > 0 then + for I := 0 to GetCount - 1 do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + + DeleteFunctionalGroups; + + FData := FData + FIEASegment.Assemble; + FIEASegment.Data := ''; + + FLength := Length(FData); + Result := FData; + + FState := ediAssembled; +end; + +procedure TEDIInterchangeControl.DeleteFunctionalGroup(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDIInterchangeControl.DeleteFunctionalGroups; +begin + DeleteEDIDataObjects; +end; + +procedure TEDIInterchangeControl.DeleteFunctionalGroups(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDIInterchangeControl.Disassemble; +var + I, StartPos, SearchResult: Integer; + ProcessTA1: Boolean; + TA1Segment: TEDIInterchangeControlSegment; +begin + ProcessTA1 := False; + FTA1Segments.Clear; + FISASegment.Data := ''; + FISASegment.DeleteElements; + FIEASegment.Data := ''; + FIEASegment.DeleteElements; + DeleteFunctionalGroups; + + if not Assigned(FDelimiters) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError012); + {$ELSE} + raise EJclEDIError.Create(RsEDIError012); + {$ENDIF ~CLR} + + StartPos := 1; + // Search for Interchange Control Header + if ICHSegmentId + FDelimiters.ED = Copy(FData, 1, Length(ICHSegmentId + FDelimiters.ED)) then + begin + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + if (SearchResult - StartPos) > 0 then // data exists + begin + FISASegment.Data := Copy(FData, 1, (SearchResult + FDelimiters.SDLen) - 1); + FISASegment.Disassemble; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError014); + {$ELSE} + raise EJclEDIError.Create(RsEDIError014); + {$ENDIF ~CLR} + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError015); + {$ELSE} + raise EJclEDIError.Create(RsEDIError015); + {$ENDIF ~CLR} + // Search for Functional Group Header + SearchResult := StrSearch(FDelimiters.SD + FGHSegmentId + FDelimiters.ED, FData, StartPos); + // Check for TA1 Segment + I := StrSearch(FDelimiters.SD + TA1SegmentId + FDelimiters.ED, FData, StartPos); + if ((I < SearchResult) or ((I > SearchResult) and (SearchResult = 0))) and (I <> 0) then + begin + ProcessTA1 := True; + SearchResult := I; + end; + if (SearchResult <= 0) and (not ProcessTA1) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError022); + {$ELSE} + raise EJclEDIError.Create(RsEDIError022); + {$ENDIF ~CLR} + // Set next start positon + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Continue + while ((StartPos + Length(FGHSegmentId)) < Length(FData)) and (SearchResult > 0) do + begin + if not ProcessTA1 then + begin + // Search for Functional Group Trailer + SearchResult := StrSearch(FDelimiters.SD + FGTSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult > 0 then + begin + // Set next start positon + SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Search for end of Functional Group Trailer Segment Terminator + SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddFunctionalGroup; + FEDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); + FEDIDataObjects[I].Disassemble; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError023); + {$ELSE} + raise EJclEDIError.Create(RsEDIError023); + {$ENDIF ~CLR} + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError024); + {$ELSE} + raise EJclEDIError.Create(RsEDIError024); + {$ENDIF ~CLR} + // Set next start positon + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Verify the next record is a Functional Group Header + if (TA1SegmentId + FDelimiters.ED) = + Copy(FData, StartPos, (Length(TA1SegmentId) + FDelimiters.EDLen)) then + ProcessTA1 := True + else + if (FGHSegmentId + FDelimiters.ED) <> + Copy(FData, StartPos, (Length(FGHSegmentId) + FDelimiters.EDLen)) then + Break; + end + else //Process TA1 Segment + begin + ProcessTA1 := False; + // Check next segment + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + // Debug + //ShowMessage('"' + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)) + '"'); + TA1Segment := TEDIInterchangeControlSegment.Create(Self); + FTA1Segments.Add(TA1Segment); + TA1Segment.Data := Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); + TA1Segment.Disassemble; + // Set next start positon + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Check next segment + if (TA1SegmentId + FDelimiters.ED) = + Copy(FData, StartPos, (Length(TA1SegmentId) + FDelimiters.EDLen)) then + ProcessTA1 := True + else + if (FGHSegmentId + FDelimiters.ED) <> + Copy(FData, StartPos, (Length(FGHSegmentId) + FDelimiters.EDLen)) then + Break; + end; + end; + // Verify the next record is a Interchange Control Trailer + if (ICTSegmentId + FDelimiters.ED) = + Copy(FData, StartPos, Length(ICTSegmentId + FDelimiters.ED)) then + begin + // Search for the end of Interchange Control Trailer Segment Terminator + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + if (SearchResult - StartPos) > 0 then // data exists + begin + FIEASegment.Data := Copy(FData, StartPos, (SearchResult + FDelimiters.SDLen)); + FIEASegment.Disassemble; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError016); + {$ELSE} + raise EJclEDIError.Create(RsEDIError016); + {$ENDIF ~CLR} + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError017); + {$ELSE} + raise EJclEDIError.Create(RsEDIError017); + {$ENDIF ~CLR} + FData := ''; + FState := ediDisassembled; +end; + +function TEDIInterchangeControl.GetFunctionalGroup(Index: Integer): TEDIFunctionalGroup; +begin + Result := TEDIFunctionalGroup(GetEDIDataObject(Index)); +end; + +function TEDIInterchangeControl.InsertFunctionalGroup(InsertIndex: Integer; + FunctionalGroup: TEDIFunctionalGroup): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, FunctionalGroup); +end; + +function TEDIInterchangeControl.InsertFunctionalGroup(InsertIndex: Integer): Integer; +begin + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDIInterchangeControl.InsertFunctionalGroups(InsertIndex, Count: Integer): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDIInterchangeControl.InsertFunctionalGroups(InsertIndex: Integer; + FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(FunctionalGroupArray)); + {$ELSE} + SetLength(HelpArray, Length(FunctionalGroupArray)); + for I := 0 to High(FunctionalGroupArray) do + HelpArray[I] := TEDIDataObject(FunctionalGroupArray[I]); + Result := InsertEDIDataObjects(InsertIndex, HelpArray); + {$ENDIF CLR} +end; + +procedure TEDIInterchangeControl.SetFunctionalGroup(Index: Integer; + FunctionalGroup: TEDIFunctionalGroup); +begin + SetEDIDataObject(Index, FunctionalGroup); +end; + +function TEDIInterchangeControl.InternalCreateFunctionalGroup: TEDIFunctionalGroup; +begin + Result := TEDIFunctionalGroup.Create(Self); +end; + +procedure TEDIInterchangeControl.InternalCreateHeaderTrailerSegments; +begin + FISASegment := TEDIInterchangeControlSegment.Create(Self); + FIEASegment := TEDIInterchangeControlSegment.Create(Self); +end; + +procedure TEDIInterchangeControl.SetIEASegment(const IEASegment: TEDISegment); +begin + FreeAndNil(FIEASegment); + FIEASegment := IEASegment; + if Assigned(FIEASegment) then + FIEASegment.Parent := Self; +end; + +procedure TEDIInterchangeControl.SetISASegment(const ISASegment: TEDISegment); +begin + FreeAndNil(FISASegment); + FISASegment := ISASegment; + if Assigned(FISASegment) then + FISASegment.Parent := Self; +end; + +procedure TEDIInterchangeControl.DeleteFunctionalGroup(FunctionalGroup: TEDIFunctionalGroup); +begin + DeleteEDIDataObject(FunctionalGroup); +end; + +function TEDIInterchangeControl.InternalCreateEDIDataObject: TEDIDataObject; +begin + Result := InternalCreateFunctionalGroup; +end; + +function TEDIInterchangeControl.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; +end; + +//=== { TEDIFile } =========================================================== + +constructor TEDIFile.Create(Parent: TEDIDataObject; InterchangeCount: Integer); +begin + inherited Create(nil, InterchangeCount); + FEDIFileOptions := [foVariableDelimiterDetection, foRemoveCrLf, foRemoveCr, foRemoveLf]; + FEDIDOT := ediFile; +end; + +destructor TEDIFile.Destroy; +begin + inherited Destroy; +end; + +function TEDIFile.AddInterchange: Integer; +begin + Result := AddEDIDataObject; +end; + +function TEDIFile.AddInterchanges(Count: Integer): Integer; +begin + Result := AddEDIDataObjects(Count); +end; + +function TEDIFile.AppendInterchange(Interchange: TEDIInterchangeControl): Integer; +begin + Result := AppendEDIDataObject(Interchange); +end; + +function TEDIFile.AppendInterchanges(InterchangeControlArray: TEDIInterchangeControlArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := AppendEDIDataObjects(TEDIDataObjectArray(InterchangeControlArray)); + {$ELSE} + SetLength(HelpArray, Length(InterchangeControlArray)); + for I := 0 to High(InterchangeControlArray) do + HelpArray[I] := TEDIDataObject(InterchangeControlArray[I]); + Result := AppendEDIDataObjects(HelpArray); + {$ENDIF CLR} +end; + +function TEDIFile.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + + if GetCount > 0 then + for I := 0 to GetCount - 1 do + begin + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + FEDIDataObjects[I].Data := ''; + end; + + FLength := Length(FData); + Result := FData; + + DeleteInterchanges; + + FState := ediAssembled; +end; + +procedure TEDIFile.DeleteInterchange(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDIFile.DeleteInterchanges(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDIFile.DeleteInterchanges; +begin + DeleteEDIDataObjects; +end; + +procedure TEDIFile.Disassemble; +var + I, StartPos, SearchResult: Integer; +begin + DeleteInterchanges; + + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + FEDIFileOptions := FEDIFileOptions + [foVariableDelimiterDetection]; + end; + + if foRemoveCrLf in FEDIFileOptions then + {$IFDEF OPTIMIZED_STRINGREPLACE} + FData := JclEDI.StringReplace(FData, AnsiCrLf, '', [rfReplaceAll]); + {$ELSE} + FData := SysUtils.StringReplace(FData, AnsiCrLf, '', [rfReplaceAll]); + {$ENDIF OPTIMIZED_STRINGREPLACE} + if foRemoveCr in FEDIFileOptions then + {$IFDEF OPTIMIZED_STRINGREPLACE} + FData := JclEDI.StringReplace(FData, AnsiCarriageReturn, '', [rfReplaceAll]); + {$ELSE} + FData := SysUtils.StringReplace(FData, AnsiCarriageReturn, '', [rfReplaceAll]); + {$ENDIF OPTIMIZED_STRINGREPLACE} + if foRemoveLf in FEDIFileOptions then + {$IFDEF OPTIMIZED_STRINGREPLACE} + FData := JclEDI.StringReplace(FData, AnsiLineFeed, '', [rfReplaceAll]); + {$ELSE} + FData := SysUtils.StringReplace(FData, AnsiLineFeed, '', [rfReplaceAll]); + {$ENDIF OPTIMIZED_STRINGREPLACE} + + StartPos := 1; + // Search for Interchange Control Header + if ICHSegmentId = Copy(FData, StartPos, Length(ICHSegmentId)) then + begin + if foVariableDelimiterDetection in FEDIFileOptions then + if foUseAltDelimiterDetection in FEDIFileOptions then + InternalAlternateDelimitersDetection(StartPos) + else + InternalDelimitersDetection(StartPos); + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError015); + {$ELSE} + raise EJclEDIError.Create(RsEDIError015); + {$ENDIF ~CLR} + // Continue + while (StartPos + Length(ICHSegmentId)) < Length(FData) do + begin + // Search for Interchange Control Trailer + SearchResult := StrSearch(FDelimiters.SD + ICTSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult > 0 then + begin + SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Search for the end of Interchange Control Trailer + SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddInterchange; + FEDIDataObjects[I].Delimiters := + TEDIDelimiters.Create(FDelimiters.SD, FDelimiters.ED, FDelimiters.SS); + FEDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); + FEDIDataObjects[I].Disassemble; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError016); + {$ELSE} + raise EJclEDIError.Create(RsEDIError016); + {$ENDIF ~CLR} + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError017); + {$ELSE} + raise EJclEDIError.Create(RsEDIError017); + {$ENDIF ~CLR} + // Set next start position, Move past the delimiter + StartPos := SearchResult + FDelimiters.SDLen; + // Verify the next record is an Interchange Control Header + if ICHSegmentId = Copy(FData, StartPos, Length(ICHSegmentId)) then + begin + if (foVariableDelimiterDetection in FEDIFileOptions) then + if foUseAltDelimiterDetection in FEDIFileOptions then + InternalAlternateDelimitersDetection(StartPos) + else + InternalDelimitersDetection(StartPos); + end + else + if (StartPos + Length(ICHSegmentId)) < Length(FData) then + begin + if foIgnoreGarbageAtEndOfFile in FEDIFileOptions then + Break + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError018); + {$ELSE} + raise EJclEDIError.Create(RsEDIError018); + {$ENDIF ~CLR} + end; + end; + FData := ''; + FState := ediDisassembled; +end; + +function TEDIFile.GetInterchangeControl(Index: Integer): TEDIInterchangeControl; +begin + Result := TEDIInterchangeControl(GetEDIDataObject(Index)); +end; + +function TEDIFile.InsertInterchange(InsertIndex: Integer; + Interchange: TEDIInterchangeControl): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, Interchange); +end; + +function TEDIFile.InsertInterchange(InsertIndex: Integer): Integer; +begin + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDIFile.InsertInterchanges(InsertIndex, Count: Integer): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDIFile.InsertInterchanges(InsertIndex: Integer; + InterchangeControlArray: TEDIInterchangeControlArray): Integer; +{$IFDEF CLR} +var + HelpArray: TEDIDataObjectArray; + I: Integer; +{$ENDIF CLR} +begin + {$IFNDEF CLR} + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(InterchangeControlArray)); + {$ELSE} + SetLength(HelpArray, Length(InterchangeControlArray)); + for I := 0 to High(InterchangeControlArray) do + HelpArray[I] := TEDIDataObject(InterchangeControlArray[I]); + Result := InsertEDIDataObjects(InsertIndex, HelpArray); + {$ENDIF CLR} +end; + +procedure TEDIFile.InternalLoadFromFile; +var + EDIFileStream: TFileStream; + {$IFDEF CLR} + Buf: TBytes; + {$ENDIF CLR} +begin + FData := ''; + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmOpenRead or fmShareDenyNone); + try + {$IFNDEF CLR} + SetLength(FData, EDIFileStream.Size); + EDIFileStream.Read(Pointer(FData)^, EDIFileStream.Size); + {$ELSE} + SetLength(Buf, EDIFileStream.Size); + EDIFileStream.Read(Buf, EDIFileStream.Size); + FData := StringOf(Buf); + {$ENDIF ~CLR} + finally + EDIFileStream.Free; + end; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError001); + {$ELSE} + raise EJclEDIError.Create(RsEDIError001); + {$ENDIF ~CLR} +end; + +procedure TEDIFile.LoadFromFile(const FileName: string); +begin + if FileName <> '' then + FFileName := FileName; + InternalLoadFromFile; +end; + +procedure TEDIFile.ReLoadFromFile; +begin + InternalLoadFromFile; +end; + +procedure TEDIFile.SaveAsToFile(const FileName: string); +var + EDIFileStream: TFileStream; +begin + FFileName := FileName; + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyNone); + try + {$IFNDEF CLR} + EDIFileStream.Write(Pointer(FData)^, Length(FData)); + {$ELSE} + EDIFileStream.Write(BytesOf(FData), Length(FData)); + {$ENDIF ~CLR} + finally + EDIFileStream.Free; + end; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError002); + {$ELSE} + raise EJclEDIError.Create(RsEDIError002); + {$ENDIF ~CLR} +end; + +procedure TEDIFile.SaveToFile; +var + EDIFileStream: TFileStream; +begin + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyNone); + try + {$IFNDEF CLR} + EDIFileStream.Write(Pointer(FData)^, Length(FData)); + {$ELSE} + EDIFileStream.Write(BytesOf(FData), Length(FData)); + {$ENDIF ~CLR} + finally + EDIFileStream.Free; + end; + end + else + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError002); + {$ELSE} + raise EJclEDIError.Create(RsEDIError002); + {$ENDIF ~CLR} +end; + +procedure TEDIFile.SetInterchangeControl(Index: Integer; Interchange: TEDIInterchangeControl); +begin + SetEDIDataObject(Index, Interchange); +end; + +procedure TEDIFile.InternalDelimitersDetection(StartPos: Integer); +var + I, SearchResult: Integer; +begin + SearchResult := 1; + FDelimiters.ED := Copy(FData, StartPos + Length(ICHSegmentId), 1); + for I := 0 to 15 do + begin + SearchResult := StrSearch(FDelimiters.ED, FData, SearchResult); + SearchResult := SearchResult + 1; + end; + FDelimiters.SS := Copy(FData, SearchResult, 1); + if Copy(FData, SearchResult + 1, 2) = AnsiCrLf then + FDelimiters.SD := Copy(FData, SearchResult + 1, 2) + else + FDelimiters.SD := Copy(FData, SearchResult + 1, 1); +end; + +procedure TEDIFile.InternalAlternateDelimitersDetection(StartPos: Integer); +var + SearchResult: Integer; +begin + SearchResult := 1; + FDelimiters.ED := Copy(FData, StartPos + Length(ICHSegmentId), 1); + SearchResult := StrSearch(FGHSegmentId + FDelimiters.ED, FData, SearchResult); + if SearchResult = 0 then + SearchResult := StrSearch(TA1SegmentId + FDelimiters.ED, FData, 1); + if Copy(FData, SearchResult - 2, 2) = AnsiCrLf then + begin + FDelimiters.SS := Copy(FData, SearchResult - 3, 1); + FDelimiters.SD := Copy(FData, SearchResult - 2, 2); + end + else + begin + FDelimiters.SS := Copy(FData, SearchResult - 2, 1); + FDelimiters.SD := Copy(FData, SearchResult - 1, 1); + end; +end; + +function TEDIFile.InternalCreateInterchangeControl: TEDIInterchangeControl; +begin + Result := TEDIInterchangeControl.Create(Self); +end; + +procedure TEDIFile.DeleteInterchange(Interchange: TEDIInterchangeControl); +begin + DeleteEDIDataObject(Interchange); +end; + +function TEDIFile.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := TEDIDelimiters.Create; +end; + +function TEDIFile.InternalCreateEDIDataObject: TEDIDataObject; +begin + Result := InternalCreateInterchangeControl; +end; + +//=== { TEDIElementSpec } ==================================================== + +constructor TEDIElementSpec.Create(Parent: TEDIDataObject); +begin + inherited Create(Parent); + FReservedData := TStringList.Create; + FElementId := ''; + FPosition := 0; + FDescription := ''; + FRequirementDesignator := ''; + FType := ''; + FMinimumLength := 1; + FMaximumLength := 1; +end; + +destructor TEDIElementSpec.Destroy; +begin + FReservedData.Free; + inherited Destroy; +end; + +function TEDIElementSpec.Assemble: string; +begin + if FElementId <> ElementSpecId_Reserved then + begin + if FElementId = '' then + FElementId := Value_NotAssigned; + ReservedData.Values[RDFN_Id] := FElementId; + ReservedData.Values[RDFN_Position] := IntToStr(FPosition); + if FDescription = '' then + FDescription := Value_None; + ReservedData.Values[RDFN_Description] := FDescription; + if FNotes = '' then + FNotes := Value_None; + ReservedData.Values[RDFN_Notes] := FNotes; + if FRequirementDesignator = '' then + FRequirementDesignator := Value_Optional; + ReservedData.Values[RDFN_RequirementDesignator] := FRequirementDesignator; + if FType = '' then + FType := Value_AlphaNumeric; + ReservedData.Values[RDFN_Type] := FType; + ReservedData.Values[RDFN_MinimumLength] := IntToStr(FMinimumLength); + ReservedData.Values[RDFN_MaximumLength] := IntToStr(FMaximumLength); + FData := ReservedData.CommaText; + end; + ReservedData.Clear; + Result := FData; + FState := ediAssembled; +end; + +procedure TEDIElementSpec.Disassemble; +begin + ReservedData.Clear; + ReservedData.CommaText := FData; + if ReservedData.Values[RDFN_Id] <> ElementSpecId_Reserved then + begin + FElementId := ReservedData.Values[RDFN_Id]; + if FElementId = '' then + FElementId := Value_NotAssigned; + FPosition := StrToInt(ReservedData.Values[RDFN_Position]); + FDescription := ReservedData.Values[RDFN_Description]; + if FDescription = '' then + FDescription := Value_None; + FNotes := ReservedData.Values[RDFN_Notes]; + if FNotes = '' then + FNotes := Value_None; + FRequirementDesignator := ReservedData.Values[RDFN_RequirementDesignator]; + if FRequirementDesignator = '' then + FRequirementDesignator := Value_Optional; + FType := ReservedData.Values[RDFN_Type]; + if FType = '' then + FType := Value_AlphaNumeric; + FMinimumLength := StrToInt(ReservedData.Values[RDFN_MinimumLength]); + FMaximumLength := StrToInt(ReservedData.Values[RDFN_MaximumLength]); + end; + FState := ediDisassembled; +end; + +function TEDIElementSpec.GetReservedData: TStrings; +begin + Result := FReservedData; +end; + +//=== { TEDISegmentSpec } ==================================================== + +constructor TEDISegmentSpec.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + FReservedData := TStringList.Create; + FSegmentId := Value_NotAssigned; + FPosition := 0; + FDescription := Value_None; + FRequirementDesignator := Value_Optional; + FSection := '?'; + FMaximumUsage := 999; + FOwnerLoopId := NA_LoopId; + FParentLoopId := NA_LoopId; +end; + +destructor TEDISegmentSpec.Destroy; +begin + FReservedData.Free; + inherited Destroy; +end; + +function TEDISegmentSpec.Assemble: string; +begin + // Insert Segment Spec as Element[0] + InsertElement(0); + TEDIElementSpec(FEDIDataObjects[0]).ElementId := ElementSpecId_Reserved; + AssembleReservedData(ReservedData); + FEDIDataObjects[0].Data := ReservedData.CommaText; + ReservedData.Clear; + // + Result := inherited Assemble; +end; + +procedure TEDISegmentSpec.AssembleReservedData(ReservedData: TStrings); +begin + with ReservedData do + begin + BeginUpdate; + try + Values[RDFN_Id] := ElementSpecId_Reserved; + Values[RDFN_Position] := IntToStr(FPosition); + Values[RDFN_Description] := FDescription; + Values[RDFN_Notes] := FNotes; + Values[RDFN_Section] := FSection; + Values[RDFN_RequirementDesignator] := FRequirementDesignator; + Values[RDFN_MaximumUsage] := IntToStr(FMaximumUsage); + if FOwnerLoopId = '' then + FOwnerLoopId := NA_LoopId; + Values[RDFN_OwnerLoopId] := FOwnerLoopId; + if FParentLoopId = '' then + FParentLoopId := NA_LoopId; + Values[RDFN_ParentLoopId] := FParentLoopId; + finally + EndUpdate; + end; + end; +end; + +procedure TEDISegmentSpec.Disassemble; +begin + inherited Disassemble; + // Element[0] is always the Segment Spec + ReservedData.Clear; + ReservedData.CommaText := FEDIDataObjects[0].Data; + DisassembleReservedData(ReservedData); + DeleteElement(0); +end; + +function TEDISegmentSpec.GetReservedData: TStrings; +begin + Result := FReservedData; +end; + +procedure TEDISegmentSpec.ValidateElementIndexPositions; +var + I: Integer; +begin + for I := 0 to GetCount - 1 do + TEDIElementSpec(FEDIDataObjects[I]).Position := I + 1; +end; + +procedure TEDISegmentSpec.DisassembleReservedData(ReservedData: TStrings); +begin + with ReservedData do + begin + // FSegmentId already set by the inherited Disassemble + FPosition := StrToInt(Values[RDFN_Position]); + FDescription := Values[RDFN_Description]; + FNotes := Values[RDFN_Notes]; + FSection := Values[RDFN_Section]; + FRequirementDesignator := Values[RDFN_RequirementDesignator]; + FMaximumUsage := StrToInt(Values[RDFN_MaximumUsage]); + FOwnerLoopId := Values[RDFN_OwnerLoopId]; + if FOwnerLoopId = '' then + FOwnerLoopId := NA_LoopId; + FParentLoopId := Values[RDFN_ParentLoopId]; + if FParentLoopId = '' then + FParentLoopId := NA_LoopId; + end; +end; + +function TEDISegmentSpec.InternalCreateElement: TEDIElement; +begin + Result := TEDIElementSpec.Create(Self); +end; + +//=== { TEDITransactionSetSegmentSpec } ====================================== + +constructor TEDITransactionSetSegmentSpec.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDITransactionSet) then + FParent := Parent; + FRequirementDesignator := Value_Mandatory; + FMaximumUsage := 1; +end; + +function TEDITransactionSetSegmentSpec.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := inherited InternalAssignDelimiters; +end; + +//=== { TEDITransactionSetSegmentSTSpec } ==================================== + +constructor TEDITransactionSetSegmentSTSpec.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + FSegmentId := TSHSegmentId; + FPosition := 0; +end; + +procedure TEDITransactionSetSegmentSTSpec.AssembleReservedData(ReservedData: TStrings); +var + Spec: TEDITransactionSetSpec; +begin + if Parent is TEDITransactionSetSpec then + begin + Spec := TEDITransactionSetSpec(Parent); + if Spec.TransactionSetId = '' then + Spec.TransactionSetId := Value_Unknown; + ReservedData.BeginUpdate; + try + ReservedData.Values[RDFN_TransSetId] := Spec.TransactionSetId; + if Spec.TSDescription = '' then + Spec.TSDescription := Value_None; + ReservedData.Values[RDFN_TransSetDesc] := Spec.TSDescription; + finally + ReservedData.EndUpdate; + end; + end; + inherited AssembleReservedData(ReservedData); +end; + +procedure TEDITransactionSetSegmentSTSpec.DisassembleReservedData(ReservedData: TStrings); +var + Spec: TEDITransactionSetSpec; +begin + inherited DisassembleReservedData(ReservedData); + if Parent is TEDITransactionSetSpec then + begin + Spec := TEDITransactionSetSpec(Parent); + Spec.TransactionSetId := ReservedData.Values[RDFN_TransSetId]; + if Spec.TransactionSetId = '' then + Spec.TransactionSetId := Value_Unknown; + Spec.TSDescription := ReservedData.Values[RDFN_TransSetDesc]; + if Spec.TSDescription = '' then + Spec.TSDescription := Value_None; + end; +end; + +//=== { TEDIFunctionalGroupSegmentSpec } ===================================== + +constructor TEDIFunctionalGroupSegmentSpec.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then + FParent := Parent; + FRequirementDesignator := Value_Mandatory; + FMaximumUsage := 1; +end; + +function TEDIFunctionalGroupSegmentSpec.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + // Get the delimiters from the functional group + if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then + begin + if Assigned(Parent.Delimiters) then + begin + Result := Parent.Delimiters; + Exit; + end; + // Get the delimiters from the interchange control + if Assigned(Parent.Parent) and (Parent.Parent is TEDIInterchangeControl) then + Result := Parent.Parent.Delimiters; + end; +end; + +//=== { TEDIFunctionalGroupSegmentGSSpec } =================================== + +constructor TEDIFunctionalGroupSegmentGSSpec.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + FSegmentId := FGHSegmentId; + FPosition := -1; +end; + +procedure TEDIFunctionalGroupSegmentGSSpec.AssembleReservedData(ReservedData: TStrings); +var + Spec: TEDIFunctionalGroupSpec; +begin + if Parent is TEDIFunctionalGroupSpec then + begin + Spec := TEDIFunctionalGroupSpec(Parent); + if Spec.FunctionalGroupId = '' then + Spec.FunctionalGroupId := Value_Unknown; + ReservedData.BeginUpdate; + try + ReservedData.Values[RDFN_FunctionalGroupId] := Spec.FunctionalGroupId; + if Spec.FGDescription = '' then + Spec.FGDescription := Value_None; + ReservedData.Values[RDFN_FGDescription] := Spec.FGDescription; + if Spec.AgencyCodeId = '' then + Spec.AgencyCodeId := Value_Unknown; + ReservedData.Values[RDFN_AgencyCodeId] := Spec.AgencyCodeId; + if Spec.VersionReleaseId = '' then + Spec.VersionReleaseId := Value_Unknown; + ReservedData.Values[RDFN_VersionReleaseId] := Spec.VersionReleaseId; + finally + ReservedData.EndUpdate; + end; + end; + inherited AssembleReservedData(ReservedData); +end; + +procedure TEDIFunctionalGroupSegmentGSSpec.DisassembleReservedData(ReservedData: TStrings); +var + Spec: TEDIFunctionalGroupSpec; +begin + inherited DisassembleReservedData(ReservedData); + + if Parent is TEDIFunctionalGroupSpec then + begin + Spec := TEDIFunctionalGroupSpec(Parent); + Spec.FunctionalGroupId := ReservedData.Values[RDFN_FunctionalGroupId]; + if Spec.FunctionalGroupId = '' then + Spec.FunctionalGroupId := Value_Unknown; + Spec.FGDescription := ReservedData.Values[RDFN_FGDescription]; + if Spec.FGDescription = '' then + Spec.FGDescription := Value_None; + Spec.AgencyCodeId := ReservedData.Values[RDFN_AgencyCodeId]; + if Spec.AgencyCodeId = '' then + Spec.AgencyCodeId := Value_Unknown; + Spec.VersionReleaseId := ReservedData.Values[RDFN_VersionReleaseId]; + if Spec.VersionReleaseId = '' then + Spec.VersionReleaseId := Value_Unknown; + end; +end; + +//=== { TEDIInterchangeControlSegmentSpec } ================================== + +constructor TEDIInterchangeControlSegmentSpec.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + FParent := Parent; + FRequirementDesignator := Value_Mandatory; + FMaximumUsage := 1; +end; + +function TEDIInterchangeControlSegmentSpec.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + // Get the delimiters from the interchange control + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + Result := Parent.Delimiters; +end; + +//=== { TEDIInterchangeControlSegmentISASpec } =============================== + +constructor TEDIInterchangeControlSegmentISASpec.Create(Parent: TEDIDataObject; + ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + FSegmentId := ICHSegmentId; + FPosition := -2; +end; + +function TEDIInterchangeControlSegmentISASpec.Assemble: string; +begin + // Because the last element carries specification data and not the subelement separator + // the subelement separator must be added as an additional element. + Result := inherited Assemble; + Result := Copy(Result, 1, Length(Result)-1) + FDelimiters.ED + FDelimiters.SS + FDelimiters.SD; +end; + +procedure TEDIInterchangeControlSegmentISASpec.AssembleReservedData(ReservedData: TStrings); +var + Spec: TEDIInterchangeControlSpec; +begin + if Parent is TEDIInterchangeControlSpec then + begin + Spec := TEDIInterchangeControlSpec(Parent); + if Spec.StandardId = '' then + Spec.StandardId := Value_Unknown; + ReservedData.BeginUpdate; + try + ReservedData.Values[RDFN_StandardId] := Spec.StandardId; + if Spec.VersionId = '' then + Spec.VersionId := Value_Unknown; + ReservedData.Values[RDFN_VersionId] := Spec.VersionId; + if Spec.ICDescription = '' then + Spec.ICDescription := Value_None; + ReservedData.Values[RDFN_ICDescription] := Spec.ICDescription; + finally + ReservedData.EndUpdate; + end; + end; + inherited AssembleReservedData(ReservedData); +end; + +procedure TEDIInterchangeControlSegmentISASpec.Disassemble; +var + SearchResult: Integer; +begin + // Because the subelement separator was added as an additional element it must now be removed. + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + {$IFNDEF CLR} + raise EJclEDIError.CreateRes(@RsEDIError035); + {$ELSE} + raise EJclEDIError.Create(RsEDIError035); + {$ENDIF ~CLR} + end; + SearchResult := StrSearch(FDelimiters.ED + FDelimiters.SS, FData, 1); + if SearchResult <> 0 then + FData := StringReplace(FData, FDelimiters.ED + FDelimiters.SS, '', [rfReplaceAll]); + inherited Disassemble; +end; + +procedure TEDIInterchangeControlSegmentISASpec.DisassembleReservedData(ReservedData: TStrings); +var + Spec: TEDIInterchangeControlSpec; +begin + inherited DisassembleReservedData(ReservedData); + if Parent is TEDIInterchangeControlSpec then + begin + Spec := TEDIInterchangeControlSpec(Parent); + Spec.StandardId := ReservedData.Values[RDFN_StandardId]; + if Spec.StandardId = '' then + Spec.StandardId := Value_Unknown; + Spec.VersionId := ReservedData.Values[RDFN_VersionId]; + if Spec.VersionId = '' then + Spec.VersionId := Value_Unknown; + Spec.ICDescription := ReservedData.Values[RDFN_ICDescription]; + if Spec.ICDescription = '' then + Spec.ICDescription := Value_None; + end; +end; + +//=== { TEDITransactionSetSpec } ============================================= + +procedure TEDITransactionSetSpec.InternalCreateHeaderTrailerSegments; +begin + FSTSegment := TEDITransactionSetSegmentSTSpec.Create(Self); + FSESegment := TEDITransactionSetSegmentSpec.Create(Self); +end; + +function TEDITransactionSetSpec.InternalCreateSegment: TEDISegment; +begin + Result := TEDISegmentSpec.Create(Self); +end; + +procedure TEDITransactionSetSpec.ValidateSegmentIndexPositions; +var + I: Integer; +begin + for I := 0 to GetCount - 1 do + begin + TEDISegmentSpec(FEDIDataObjects[I]).Position := I + 1; + TEDISegmentSpec(FEDIDataObjects[I]).ValidateElementIndexPositions; + end; +end; + +//=== { TEDIFunctionalGroupSpec } ============================================ + +procedure TEDIFunctionalGroupSpec.InternalCreateHeaderTrailerSegments; +begin + FGSSegment := TEDIFunctionalGroupSegmentGSSpec.Create(Self); + FGESegment := TEDIFunctionalGroupSegmentSpec.Create(Self); +end; + +function TEDIFunctionalGroupSpec.InternalCreateTransactionSet: TEDITransactionSet; +begin + Result := TEDITransactionSetSpec.Create(Self); +end; + +function TEDIFunctionalGroupSpec.FindTransactionSetSpec( + TransactionSetId: string): TEDITransactionSetSpec; +var + I: Integer; + EDITransactionSetSpec: TEDITransactionSetSpec; +begin + Result := nil; + for I := 0 to GetCount - 1 do + begin + EDITransactionSetSpec := TEDITransactionSetSpec(FEDIDataObjects[I]); + if TransactionSetId = EDITransactionSetSpec.TransactionSetId then + begin + Result := EDITransactionSetSpec; + Break; + end; + end; +end; + +//=== { TEDIInterchangeControlSpec } ========================================= + +procedure TEDIInterchangeControlSpec.InternalCreateHeaderTrailerSegments; +begin + FISASegment := TEDIInterchangeControlSegmentISASpec.Create(Self); + FIEASegment := TEDIInterchangeControlSegmentSpec.Create(Self); +end; + +function TEDIInterchangeControlSpec.InternalCreateFunctionalGroup: TEDIFunctionalGroup; +begin + Result := TEDIFunctionalGroupSpec.Create(Self); +end; + +function TEDIInterchangeControlSpec.FindTransactionSetSpec(FunctionalGroupId, AgencyCodeId, + VersionReleaseId, TransactionSetId: string): TEDITransactionSetSpec; +var + EDIFunctionalGroupSpec: TEDIFunctionalGroupSpec; +begin + Result := nil; + EDIFunctionalGroupSpec := FindFunctionalGroupSpec(FunctionalGroupId, AgencyCodeId, + VersionReleaseId); + if EDIFunctionalGroupSpec <> nil then + Result := EDIFunctionalGroupSpec.FindTransactionSetSpec(TransactionSetId); +end; + +function TEDIInterchangeControlSpec.FindFunctionalGroupSpec(FunctionalGroupId, AgencyCodeId, + VersionReleaseId: string): TEDIFunctionalGroupSpec; +var + F: Integer; + EDIFunctionalGroupSpec: TEDIFunctionalGroupSpec; +begin + Result := nil; + for F := 0 to GetCount - 1 do + begin + EDIFunctionalGroupSpec := TEDIFunctionalGroupSpec(FEDIDataObjects[F]); + if (FunctionalGroupId = EDIFunctionalGroupSpec.FunctionalGroupId) and + (AgencyCodeId = EDIFunctionalGroupSpec.AgencyCodeId) and + (VersionReleaseId = EDIFunctionalGroupSpec.VersionReleaseId) then + begin + Result := EDIFunctionalGroupSpec; + Exit; + end; + end; +end; + +//=== { TEDIFileSpec } ======================================================= + +constructor TEDIFileSpec.Create(Parent: TEDIDataObject; InterchangeCount: Integer); +begin + inherited Create(Parent, InterchangeCount); + FEDIFileOptions := [foVariableDelimiterDetection, foUseAltDelimiterDetection]; +end; + +procedure TEDIFileSpec.InternalDelimitersDetection(StartPos: Integer); +begin + InternalAlternateDelimitersDetection(StartPos); +end; + +function TEDIFileSpec.InternalCreateInterchangeControl: TEDIInterchangeControl; +begin + Result := TEDIInterchangeControlSpec.Create(Self); +end; + +function TEDIFileSpec.FindTransactionSetSpec(StandardId, VersionId, FunctionalGroupId, AgencyCodeId, + VersionReleaseId, TransactionSetId: string): TEDITransactionSetSpec; +var + EDIFunctionalGroupSpec: TEDIFunctionalGroupSpec; +begin + Result := nil; + EDIFunctionalGroupSpec := FindFunctionalGroupSpec(StandardId, VersionId, FunctionalGroupId, + AgencyCodeId, VersionReleaseId); + if EDIFunctionalGroupSpec <> nil then + Result := EDIFunctionalGroupSpec.FindTransactionSetSpec(TransactionSetId); +end; + +function TEDIFileSpec.FindFunctionalGroupSpec(StandardId, VersionId, FunctionalGroupId, + AgencyCodeId, VersionReleaseId: string): TEDIFunctionalGroupSpec; +var + EDIInterchangeControlSpec: TEDIInterchangeControlSpec; +begin + Result := nil; + EDIInterchangeControlSpec := FindInterchangeControlSpec(StandardId, VersionId); + if EDIInterchangeControlSpec <> nil then + Result := EDIInterchangeControlSpec.FindFunctionalGroupSpec(FunctionalGroupId, + AgencyCodeId, VersionReleaseId); +end; + +function TEDIFileSpec.FindInterchangeControlSpec(StandardId, + VersionId: string): TEDIInterchangeControlSpec; +var + I: Integer; + EDIInterchangeControlSpec: TEDIInterchangeControlSpec; +begin + Result := nil; + for I := 0 to GetCount - 1 do + begin + EDIInterchangeControlSpec := TEDIInterchangeControlSpec(FEDIDataObjects[I]); + if (EDIInterchangeControlSpec.StandardId = StandardId) and + (EDIInterchangeControlSpec.VersionId = VersionId) then + Result := EDIInterchangeControlSpec; + end; +end; + +//=== { TEDITransactionSetLoop } ============================================= + +constructor TEDITransactionSetLoop.Create(Parent: TEDIDataObject); +begin + inherited Create(Parent); + FCreateObjectType := ediLoop; + FGroupIsParent := False; + if Assigned(Parent) and (Parent is TEDITransactionSet) then + FParentTransactionSet := TEDITransactionSet(Parent) + else + if Assigned(Parent) and (Parent is TEDITransactionSetLoop) then + FParentTransactionSet := TEDITransactionSetLoop(Parent).ParentTransactionSet + else + FParentTransactionSet := nil; + FEDIDOT := ediLoop; + FEDIDataObjects.OwnsObjects := False; +end; + +destructor TEDITransactionSetLoop.Destroy; +begin + DeleteEDIDataObjects; + inherited Destroy; +end; + +function TEDITransactionSetLoop.AddLoop(OwnerLoopId, ParentLoopId: string): Integer; +var + Loop: TEDITransactionSetLoop; +begin + FCreateObjectType := ediLoop; + Loop := TEDITransactionSetLoop(InternalCreateEDIDataObject); + Loop.OwnerLoopId := OwnerLoopId; + Loop.ParentLoopId := ParentLoopId; + Loop.Parent := Self; + Result := AppendEDIDataObject(Loop); +end; + +procedure TEDITransactionSetLoop.AppendSegment(Segment: TEDISegment); +begin + AppendEDIDataObject(Segment); +end; + +function TEDITransactionSetLoop.Assemble: string; +begin + Result := ''; +end; + +procedure TEDITransactionSetLoop.DeleteEDIDataObjects; +var + I: Integer; +begin + for I := 0 to FEDIDataObjects.Count - 1 do + if Assigned(FEDIDataObjects[I]) then + try + // Delete + if FEDIDataObjects[I] is TEDITransactionSetLoop then + FEDIDataObjects.Item[I].FreeAndNilEDIDataObject + else + // Do not free segments because they are not owned by + FEDIDataObjects[I] := nil; + except + // This exception block was put here to capture the case where FEDIDataObjects[I] was + // actually destroyed prior to destroying this object. + FEDIDataObjects[I] := nil; + end; + // Resize + FEDIDataObjects.Clear; +end; + +procedure TEDITransactionSetLoop.Disassemble; +begin + // Do Nothing +end; + +function TEDITransactionSetLoop.FindLoop(LoopId: string; + var StartIndex: Integer): TEDITransactionSetLoop; +var + I, J: Integer; +begin + Result := nil; + J := StartIndex; + for I := StartIndex to GetCount {FEDIDataObjects.Count} - 1 do + begin + StartIndex := I; + if FEDIDataObjects[I] is TEDITransactionSetLoop then + begin + Result := TEDITransactionSetLoop(GetEDIDataObject(I)); + if Result.OwnerLoopId = LoopId then + begin + Inc(StartIndex); + Break; + end; + Result := nil; + end; + end; + if Result = nil then + StartIndex := J; +end; + +function TEDITransactionSetLoop.FindSegment(SegmentId: string; var StartIndex: Integer): TEDISegment; +var + I, J: Integer; +begin + Result := nil; + J := StartIndex; + for I := StartIndex to GetCount {FEDIDataObjects.Count} - 1 do + begin + StartIndex := I; + if FEDIDataObjects[I] is TEDISegment then + begin + Result := TEDISegment(GetEDIDataObject(I)); + if Result.SegmentId = SegmentId then + begin + Inc(StartIndex); + Break; + end; + Result := nil; + end; + end; + if Result = nil then + StartIndex := J; +end; + +function TEDITransactionSetLoop.FindSegment(SegmentId: string; var StartIndex: Integer; + ElementConditions: TStrings): TEDISegment; +var + I, TrueCount, ElementIndex: Integer; + Name: string; +begin + Result := FindSegment(SegmentId, StartIndex); + while Result <> nil do + begin + TrueCount := 0; + for I := 0 to ElementConditions.Count - 1 do + begin + Name := ElementConditions.Names[I]; + ElementIndex := StrToInt(Name); + if Result[ElementIndex].Data = ElementConditions.Values[Name] then + Inc(TrueCount); + end; + if TrueCount = ElementConditions.Count then + Break; + Result := FindSegment(SegmentId, StartIndex); + end; +end; + +function TEDITransactionSetLoop.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + if FDelimiters = nil then // Attempt to assign the delimiters + if Assigned(FParentTransactionSet) then + Result := FParentTransactionSet.Delimiters; +end; + +function TEDITransactionSetLoop.InternalCreateEDIDataObject: TEDIDataObject; +begin + case FCreateObjectType of + ediLoop: + begin + Result := TEDITransactionSetLoop.Create(Self); + TEDITransactionSetLoop(Result).OwnerLoopId := OwnerLoopId; + TEDITransactionSetLoop(Result).ParentLoopId := ParentLoopId; + TEDITransactionSetLoop(Result).Parent := Self; + end; + else + Result := nil; + end; +end; + +//=== { TEDITransactionSetDocument } ========================================= + +constructor TEDITransactionSetDocument.Create(Parent: TEDIDataObject; + EDITransactionSet: TEDITransactionSet; + EDITransactionSetSpec: TEDITransactionSetSpec); +begin + inherited Create(Parent); + FEDILoopStack := TEDILoopStack.Create; + FEDILoopStack.OnAddLoop := AddLoopToDoc; + FEDITransactionSet := EDITransactionSet; + FEDITransactionSetSpec := EDITransactionSetSpec; + FEDITSDOptions := []; +end; + +destructor TEDITransactionSetDocument.Destroy; +begin + FreeAndNil(FEDILoopStack); + FEDITransactionSet := nil; + FEDITransactionSetSpec := nil; + inherited Destroy; +end; + +procedure TEDITransactionSetDocument.FormatDocument; +var + I, J: Integer; + LSR: TEDILoopStackRecord; + DataSegment: TEDISegment; + SpecSegment: TEDISegmentSpec; + EDIFunctionalGroup: TEDIFunctionalGroup; + EDIFunctionalGroupSpec: TEDIFunctionalGroupSpec; + EDIInterchangeControl: TEDIInterchangeControl; + EDIInterchangeControlSpec: TEDIInterchangeControlSpec; +begin + I := 0; + J := 0; + if doLinkSpecToDataObject in FEDITSDOptions then + begin + FEDITransactionSet.SpecPointer := FEDITransactionSetSpec; + FEDITransactionSet.SegmentST.SpecPointer := FEDITransactionSetSpec.SegmentST; + SetSpecificationPointers(FEDITransactionSet.SegmentST, FEDITransactionSetSpec.SegmentST); + FEDITransactionSet.SegmentSE.SpecPointer := FEDITransactionSetSpec.SegmentSE; + SetSpecificationPointers(FEDITransactionSet.SegmentSE, FEDITransactionSetSpec.SegmentSE); + if FEDITransactionSet.Parent <> nil then + begin + EDIFunctionalGroup := TEDIFunctionalGroup(FEDITransactionSet.Parent); + EDIFunctionalGroupSpec := TEDIFunctionalGroupSpec(FEDITransactionSetSpec.Parent); + EDIFunctionalGroup.SpecPointer := EDIFunctionalGroupSpec; + EDIFunctionalGroup.SegmentGS.SpecPointer := EDIFunctionalGroupSpec.SegmentGS; + SetSpecificationPointers(EDIFunctionalGroup.SegmentGS, EDIFunctionalGroupSpec.SegmentGS); + EDIFunctionalGroup.SegmentGE.SpecPointer := EDIFunctionalGroupSpec.SegmentGE; + SetSpecificationPointers(EDIFunctionalGroup.SegmentGE, EDIFunctionalGroupSpec.SegmentGE); + if EDIFunctionalGroup.Parent <> nil then + begin + EDIInterchangeControl := TEDIInterchangeControl(EDIFunctionalGroup.Parent); + EDIInterchangeControlSpec := TEDIInterchangeControlSpec(EDIFunctionalGroupSpec.Parent); + EDIInterchangeControl.SpecPointer := EDIInterchangeControlSpec; + EDIInterchangeControl.SegmentISA.SpecPointer := EDIInterchangeControlSpec.SegmentISA; + SetSpecificationPointers(EDIInterchangeControl.SegmentISA, EDIInterchangeControlSpec.SegmentISA); + EDIInterchangeControl.SegmentIEA.SpecPointer := EDIInterchangeControlSpec.SegmentIEA; + SetSpecificationPointers(EDIInterchangeControl.SegmentIEA, EDIInterchangeControlSpec.SegmentIEA); + end; + end; + end; + // Initialize the stack + FEDILoopStack.Flags := FEDILoopStack.Flags - [ediLoopRepeated]; + LSR := FEDILoopStack.ValidateLoopStack(FEDITransactionSet.Segment[I].SegmentID, + NA_LoopId, NA_LoopId, 0, Self); + // + while (I <= FEDITransactionSet.SegmentCount - 1) and + (J <= FEDITransactionSetSpec.SegmentCount - 1) do + begin + FEDILoopStack.Flags := FEDILoopStack.Flags - [ediLoopRepeated]; + DataSegment := FEDITransactionSet.Segment[I]; + // If loop has repeated then move the spec index back + J := ValidateSegSpecIndex(DataSegment.SegmentID, J); + // Check current segment against segment spec + SpecSegment := TEDISegmentSpec(FEDITransactionSetSpec.Segment[J]); + if DataSegment.SegmentID = SpecSegment.SegmentID then + begin + // Retrieve the correct record to use from the stack + LSR := FEDILoopStack.ValidateLoopStack(SpecSegment.SegmentID, SpecSegment.OwnerLoopId, + SpecSegment.ParentLoopId, J, LSR.EDIObject); + // + // Debug - Keep the following here in case someone wants to debug what happens to the stack. + // ShowMessage('Current Data Segment: [' + IntToStr(I) + '] ' + DataSegment.SegmentID + #13#10 + + // 'Current Spec Segment: [' + IntToStr(J) + '] ' + SpecSegment.SegmentID + #13#10 + + // FEDILoopStack.Debug); + // + // Do error checking and data validation in decendent class + ValidateData(Self, FEDILoopStack, DataSegment, SpecSegment, I, J, FErrorOccured); + if FErrorOccured then + Exit; + // Process Segment Id + TEDITransactionSetLoop(LSR.EDIObject).AppendSegment(DataSegment); + // + if doLinkSpecToDataObject in FEDITSDOptions then + SetSpecificationPointers(DataSegment, SpecSegment); + // Move to the next data segment + Inc(I); + end + else + begin + // Do error checking and data validation in decendent class + ValidateData(Self, FEDILoopStack, DataSegment, SpecSegment, I, J, FErrorOccured); + if FErrorOccured then + Exit; + // + // Debug - Keep the following here in case someone wants to debug what happens to the stack. + // ShowMessage('Current Data Segment: [' + IntToStr(I) + '] ' + DataSegment.SegmentID + #13#10 + + // 'Current Spec Segment: [' + IntToStr(J) + '] ' + SpecSegment.SegmentID + #13#10 + + // FEDILoopStack.Debug); + // + // Move to the next specification segment + J := AdvanceSegSpecIndex(I, J, FEDITransactionSetSpec.SegmentCount - 1); //Inc(J); + end; + end; +end; + +procedure TEDITransactionSetDocument.ValidateData( + TSDocument: TEDITransactionSetDocument; LoopStack: TEDILoopStack; + DataSegment, SpecSegment: TEDISegment; var DataIndex, SpecIndex: Integer; + var ErrorOccured: Boolean); +begin + ErrorOccured := False; +end; + +function TEDITransactionSetDocument.AdvanceSegSpecIndex(DataIndex, SpecStartIndex, + SpecEndIndex: Integer): Integer; +var + DataSegment: TEDISegment; + TestSegment: TEDISegmentSpec; + I: Integer; +begin + Result := SpecEndIndex + 1; + DataSegment := FEDITransactionSet.Segment[DataIndex]; + for I := SpecStartIndex + 1 to SpecEndIndex do + begin + TestSegment := TEDISegmentSpec(FEDITransactionSetSpec.Segment[I]); + // Find matching segment + if ((DataSegment.SegmentID) = (TestSegment.SegmentID)) then + begin + Result := I; + Break; + end; + end; +end; + +procedure TEDITransactionSetDocument.SetSpecificationPointers(DataSegment, SpecSegment: TEDISegment); +var + I, J: Integer; +begin + DataSegment.SpecPointer := SpecSegment; + J := SpecSegment.ElementCount - 1; + for I := 0 to DataSegment.ElementCount - 1 do + begin + if I > J then + {$IFNDEF CLR} + raise EJclEDIError.CreateResFmt(@RsEDIError058, + {$ELSE} + raise EJclEDIError.CreateFmt(RsEDIError002, + {$ENDIF ~CLR} + [IntToStr(I), DataSegment.SegmentID, + IntToStr(DataSegment.GetIndexPositionFromParent)]); + DataSegment.Element[I].SpecPointer := SpecSegment.Element[I]; + end; +end; + +function TEDITransactionSetDocument.ValidateSegSpecIndex(DataSegmentId: string; + SpecStartIndex: Integer): Integer; +var + I: Integer; +begin + Result := SpecStartIndex; + // Find the segment in the stack to determine if a loop has repeated + for I := High(FEDILoopStack.Stack) downto Low(FEDILoopStack.Stack) do + begin + if (DataSegmentId = FEDILoopStack.Stack[I].SegmentId) and + (FEDILoopStack.Stack[I].OwnerLoopId <> NA_LoopId) then + begin + FEDILoopStack.Flags := FEDILoopStack.Flags + [ediLoopRepeated]; + Result := FEDILoopStack.Stack[I].SpecStartIndex; + Break; + end; + end; +end; + +procedure TEDITransactionSetDocument.AddLoopToDoc(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); +var + I: Integer; + Loop: TEDITransactionSetLoop; +begin + Loop := TEDITransactionSetLoop(StackRecord.EDIObject); + I := Loop.AddLoop(OwnerLoopId, ParentLoopId); + EDIObject := TEDITransactionSetLoop(Loop[I]); +end; + +end. diff --git a/official/1.96/source/common/JclEDI_ANSIX12_Ext.pas b/official/1.96/source/common/JclEDI_ANSIX12_Ext.pas new file mode 100644 index 0000000..48638ad --- /dev/null +++ b/official/1.96/source/common/JclEDI_ANSIX12_Ext.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 JclEDI_ANSIX12_Ext.pas. } +{ } +{ The Initial Developer of the Original Code is Raymond Alexander. } +{ Portions created by Raymond Alexander are Copyright Raymond Alexander. All rights reserved. } +{ } +{ Contributor(s): } +{ Raymond Alexander (rayspostbox3), Robert Rossmair } +{ } +{**************************************************************************************************} +{ } +{ EDI ANSI X12 - Standard Exchange Format (*.sef) File Extensions } +{ } +{ This unit is still in development } +{ } +{ Unit owner: Raymond Alexander } +{ Date created: March 1, 2004 } +{ Additional Info: } +{ E-Mail at RaysDelphiBox3 att hotmail dott com } +{ For latest EDI specific demos see http://sourceforge.net/projects/edisdk } +{ See home page for latest news & events and online help. } +{ } +{**************************************************************************************************} + +// $Id: JclEDI_ANSIX12_Ext.pas,v 1.9 2005/03/08 08:33:16 marquardt Exp $ + +unit JclEDI_ANSIX12_Ext; + +{$I jcl.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$WEAKPACKAGEUNIT ON} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +interface + +uses + SysUtils, Classes, Contnrs, JclResources, + JclEDI, JclEDI_ANSIX12, JclEDISEF; + +type + // EDI Transaction Set Document and related types and classes + TEDI_ANSIX12_Document = class(TEDITransactionSetLoop) + private + FEDISEFSet: TEDISEFSet; + protected + FErrorOccured: Boolean; + FEDITSDOptions: TEDITransactionSetDocumentOptions; + FEDILoopStack: TEDILoopStack; + // References + FEDITransactionSet: TEDITransactionSet; + FEDITransactionSetSpec: TObjectList; + function ValidateSegSpecIndex(DataSegmentId: string; SpecStartIndex: Integer): Integer; + function AdvanceSegSpecIndex(DataIndex, SpecStartIndex, SpecEndIndex: Integer): Integer; + procedure AddLoopToDoc(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); + procedure SetSpecificationPointers(DataSegment: TEDISegment; SpecSegment: TEDISEFSegment); + protected + procedure ValidateData(TSDocument: TEDI_ANSIX12_Document; + LoopStack: TEDILoopStack; + DataSegment: TEDISegment; + SpecSegment: TEDISEFSegment; + var DataIndex, SpecIndex: Integer; + var ErrorOccured: Boolean); virtual; + public + constructor Create(Parent: TEDIDataObject; TransactionSet: TEDITransactionSet; + SEFSet: TEDISEFSet); reintroduce; + destructor Destroy; override; + // + // ToDo: More procedures and functions to manage internal structures + // + procedure FormatDocument; virtual; + published + property EDITSDOptions: TEDITransactionSetDocumentOptions read FEDITSDOptions + write FEDITSDOptions; + property ErrorOccured: Boolean read FErrorOccured; + end; + +implementation + +constructor TEDI_ANSIX12_Document.Create(Parent: TEDIDataObject; + TransactionSet: TEDITransactionSet; SEFSet: TEDISEFSet); +begin + inherited Create(Parent); + FEDILoopStack := TEDILoopStack.Create; + FEDILoopStack.OnAddLoop := AddLoopToDoc; + FEDITransactionSet := TransactionSet; + FEDISEFSet := SEFSet; + FEDITransactionSetSpec := SEFSet.GetSegmentObjectList; + FEDITSDOptions := []; +end; + +destructor TEDI_ANSIX12_Document.Destroy; +begin + FreeAndNil(FEDILoopStack); + FEDITransactionSet := nil; + FEDITransactionSetSpec.Free; + inherited Destroy; +end; + +procedure TEDI_ANSIX12_Document.FormatDocument; +var + I, J: Integer; + LSR: TEDILoopStackRecord; + DataSegment: TEDISegment; + SpecSegment: TEDISEFSegment; +begin + I := 0; + J := 0; + if doLinkSpecToDataObject in FEDITSDOptions then + begin + FEDISEFSet.BindTextSets(FEDISEFSet.SEFFile.TEXTSETS); + FEDISEFSet.BindSegmentTextSets; + end; + // Initialize the stack + FEDILoopStack.Flags := FEDILoopStack.Flags - [ediLoopRepeated]; + LSR := FEDILoopStack.ValidateLoopStack(FEDITransactionSet.Segment[I].SegmentID, + NA_LoopId, NA_LoopId, 0, Self); + // + while (I <= FEDITransactionSet.SegmentCount - 1) and + (J <= FEDITransactionSetSpec.Count - 1) do + begin + FEDILoopStack.Flags := FEDILoopStack.Flags - [ediLoopRepeated]; + DataSegment := FEDITransactionSet.Segment[I]; + // If loop has repeated then move the spec index back + J := ValidateSegSpecIndex(DataSegment.SegmentID, J); + // Check current segment against segment spec + SpecSegment := TEDISEFSegment(FEDITransactionSetSpec[J]); + if DataSegment.SegmentID = SpecSegment.SegmentID then + begin + // Retrieve the correct record to use from the stack + LSR := FEDILoopStack.ValidateLoopStack(SpecSegment.SegmentID, SpecSegment.OwnerLoopId, + SpecSegment.ParentLoopId, J, LSR.EDIObject); + // + // Debug - Keep the following here in case someone wants to debug what happens to the stack. + // ShowMessage('Current Data Segment: [' + IntToStr(I) + '] ' + DataSegment.SegmentID + #13#10 + + // 'Current Spec Segment: [' + IntToStr(J) + '] ' + SpecSegment.SegmentID + #13#10 + + // FEDILoopStack.Debug); + // + // Do error checking and data validation in decendent class + ValidateData(Self, FEDILoopStack, DataSegment, SpecSegment, I, J, FErrorOccured); + if FErrorOccured then + Exit; + // Process Segment Id + TEDITransactionSetLoop(LSR.EDIObject).AppendSegment(DataSegment); + // + if doLinkSpecToDataObject in FEDITSDOptions then + begin + SpecSegment.BindTextSets(SpecSegment.SEFFile.TEXTSETS); + SpecSegment.BindElementTextSets; + SetSpecificationPointers(DataSegment, SpecSegment); + end; + // Move to the next data segment + Inc(I); + end + else + begin + // Do error checking and data validation in decendent class + ValidateData(Self, FEDILoopStack, DataSegment, SpecSegment, I, J, FErrorOccured); + if FErrorOccured then + Exit; + // + // Debug - Keep the following here in case someone wants to debug what happens to the stack. + // ShowMessage('Current Data Segment: [' + IntToStr(I) + '] ' + DataSegment.SegmentID + #13#10 + + // 'Current Spec Segment: [' + IntToStr(J) + '] ' + SpecSegment.SegmentID + #13#10 + + // FEDILoopStack.Debug); + // + // Move to the next specification segment + J := AdvanceSegSpecIndex(I, J, FEDITransactionSetSpec.Count - 1); //Inc(J); + end; + end; +end; + +procedure TEDI_ANSIX12_Document.ValidateData(TSDocument: TEDI_ANSIX12_Document; + LoopStack: TEDILoopStack; DataSegment: TEDISegment; SpecSegment: TEDISEFSegment; + var DataIndex, SpecIndex: Integer; var ErrorOccured: Boolean); +begin + ErrorOccured := False; +end; + +procedure TEDI_ANSIX12_Document.SetSpecificationPointers(DataSegment: TEDISegment; + SpecSegment: TEDISEFSegment); +var + I, J: Integer; +begin + DataSegment.SpecPointer := SpecSegment; + J := SpecSegment.Elements.Count - 1; + for I := 0 to DataSegment.ElementCount - 1 do + begin + if I > J then + raise EJclEDIError.CreateResFmt(@RsEDIError058, + [IntToStr(I), DataSegment.SegmentId, + IntToStr(DataSegment.GetIndexPositionFromParent)]); + DataSegment.Element[I].SpecPointer := SpecSegment.Elements[I]; + end; +end; + +procedure TEDI_ANSIX12_Document.AddLoopToDoc(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); +var + I: Integer; + Loop: TEDITransactionSetLoop; +begin + Loop := TEDITransactionSetLoop(StackRecord.EDIObject); + I := Loop.AddLoop(OwnerLoopId, ParentLoopId); + EDIObject := TEDITransactionSetLoop(Loop[I]); +end; + +function TEDI_ANSIX12_Document.ValidateSegSpecIndex(DataSegmentId: string; + SpecStartIndex: Integer): Integer; +var + I: Integer; +begin + Result := SpecStartIndex; + // Find the segment in the stack to determine if a loop has repeated + for I := High(FEDILoopStack.Stack) downto Low(FEDILoopStack.Stack) do + begin + if (DataSegmentId = FEDILoopStack.Stack[I].SegmentId) and + (FEDILoopStack.Stack[I].OwnerLoopId <> NA_LoopId) then + begin + FEDILoopStack.Flags := FEDILoopStack.Flags + [ediLoopRepeated]; + Result := FEDILoopStack.Stack[I].SpecStartIndex; + Break; + end; + end; +end; + +function TEDI_ANSIX12_Document.AdvanceSegSpecIndex(DataIndex, SpecStartIndex, + SpecEndIndex: Integer): Integer; +var + DataSegment: TEDISegment; + TestSegment: TEDISEFSegment; + I: Integer; +begin + Result := SpecEndIndex + 1; + DataSegment := FEDITransactionSet.Segment[DataIndex]; + for I := SpecStartIndex + 1 to SpecEndIndex do + begin + TestSegment := TEDISEFSegment(FEDITransactionSetSpec[I]); + // Find matching segment + if ((DataSegment.SegmentID) = (TestSegment.SegmentID)) then + begin + Result := I; + Break; + end; + end; +end; + +end. diff --git a/official/1.96/source/common/JclEDI_UNEDIFACT.pas b/official/1.96/source/common/JclEDI_UNEDIFACT.pas new file mode 100644 index 0000000..5e45e41 --- /dev/null +++ b/official/1.96/source/common/JclEDI_UNEDIFACT.pas @@ -0,0 +1,2313 @@ +{**************************************************************************************************} +{ } +{ 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 JclEDI_UNEDIFACT.pas. } +{ } +{ The Initial Developer of the Original Code is Raymond Alexander. } +{ Portions created by Raymond Alexander are Copyright (C) Raymond Alexander. All rights reserved. } +{ } +{ Contributor(s): } +{ Raymond Alexander (rayspostbox3), Robert Marquardt, Robert Rossmair, Petr Vones } +{ } +{**************************************************************************************************} +{ } +{ Contains classes to easily parse EDI documents and data. Variable delimiter detection allows } +{ parsing of the file without knowledge of the standards at an Interchange level. This enables } +{ parsing and construction of EDI documents with different delimiters. } +{ } +{ Unit owner: Raymond Alexander } +{ Date created: May 22, 2003 } +{ Additional Info: } +{ E-Mail at RaysDelphiBox3 att hotmail dott com } +{ For latest EDI specific demos see http://sourceforge.net/projects/edisdk } +{ See home page for latest news & events and online help. } +{ } +{**************************************************************************************************} + +// $Id: JclEDI_UNEDIFACT.pas,v 1.16 2005/03/08 16:10:08 marquardt Exp $ + +unit JclEDI_UNEDIFACT; + +{$I jcl.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} +{$WEAKPACKAGEUNIT ON} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +// (Default) Enable the following directive to use the optimized JclEDI.StringReplace function. +{$DEFINE OPTIMIZED_STRINGREPLACE} + +interface + +uses + SysUtils, Classes, + JclEDI; + +const + // UN/EDIFACT Segment Id's + UNASegmentId = 'UNA'; // Service String Advice Segment Id + UNBSegmentId = 'UNB'; // Interchange Control Header Segment Id + UNZSegmentId = 'UNZ'; // Interchange Control Trailer Segment Id + UNGSegmentId = 'UNG'; // Functional Group Header Segment Id + UNESegmentId = 'UNE'; // Functional Group Trailer Segment Id + UNHSegmentId = 'UNH'; // Message (Transaction Set) Header Segment Id + UNTSegmentId = 'UNT'; // Message (Transaction Set) Trailer Segment Id + +type + // EDI Forward Class Declarations + TEDIElement = class; + TEDICompositeElement = class; + TEDISegment = class; + TEDIMessage = class; // (Transaction Set) + TEDIFunctionalGroup = class; + TEDIInterchangeControl = class; + TEDIFile = class; + + // EDI Element + TEDIElement = class(TEDIDataObject) + public + constructor Create(Parent: TEDIDataObject); reintroduce; + function Assemble: string; override; + procedure Disassemble; override; + function GetIndexPositionFromParent: Integer; + end; + + TEDIElementArray = array of TEDIElement; + + // EDI Composite Element Classes + TEDICompositeElement = class(TEDIDataObjectGroup) + private + function GetElement(Index: Integer): TEDIElement; + procedure SetElement(Index: Integer; Element: TEDIElement); + protected + function InternalCreateElement: TEDIElement; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + destructor Destroy; override; + // + function AddElement: Integer; + function AppendElement(Element: TEDIElement): Integer; + function InsertElement(InsertIndex: Integer): Integer; overload; + function InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; overload; + procedure DeleteElement(Index: Integer); overload; + procedure DeleteElement(Element: TEDIElement); overload; + // + function AddElements(Count: Integer): Integer; + function AppendElements(ElementArray: TEDIElementArray): Integer; + function InsertElements(InsertIndex, Count: Integer): Integer; overload; + function InsertElements(InsertIndex: Integer; + ElementArray: TEDIElementArray): Integer; overload; + procedure DeleteElements; overload; + procedure DeleteElements(Index, Count: Integer); overload; + // + function Assemble: string; override; + procedure Disassemble; override; + // + property Element[Index: Integer]: TEDIElement read GetElement write SetElement; default; + property Elements: TEDIDataObjectList read FEDIDataObjects; + end; + + TEDICompositeElementArray = array of TEDICompositeElement; + + // EDI Segment Classes + TEDISegment = class(TEDIDataObjectGroup) + private + FSegmentID: string; + //FSegmentIdData: T??? // ToDo: ex: AAA:1:1:2+data1+data2' + protected + function InternalCreateElement: TEDIElement; virtual; + function InternalCreateCompositeElement: TEDICompositeElement; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + destructor Destroy; override; + // + function AddElement: Integer; + function AppendElement(Element: TEDIElement): Integer; + function InsertElement(InsertIndex: Integer): Integer; overload; + function InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; overload; + procedure DeleteElement(Index: Integer); overload; + procedure DeleteElement(Element: TEDIElement); overload; + // + function AddElements(Count: Integer): Integer; + function AppendElements(ElementArray: TEDIElementArray): Integer; + function InsertElements(InsertIndex, Count: Integer): Integer; overload; + function InsertElements(InsertIndex: Integer; + ElementArray: TEDIElementArray): Integer; overload; + procedure DeleteElements; overload; + procedure DeleteElements(Index, Count: Integer); overload; + // + function AddCompositeElement: Integer; + function AppendCompositeElement(CompositeElement: TEDICompositeElement): Integer; + function InsertCompositeElement(InsertIndex: Integer): Integer; overload; + function InsertCompositeElement(InsertIndex: Integer; + CompositeElement: TEDICompositeElement): Integer; overload; + // + function AddCompositeElements(Count: Integer): Integer; + function AppendCompositeElements(CompositeElementArray: TEDICompositeElementArray): Integer; + function InsertCompositeElements(InsertIndex, Count: Integer): Integer; overload; + function InsertCompositeElements(InsertIndex: Integer; + CompositeElementArray: TEDICompositeElementArray): Integer; overload; + // + function Assemble: string; override; + procedure Disassemble; override; + published + property SegmentID: string read FSegmentID write FSegmentID; + property ElementCount: Integer read GetCount; + end; + + TEDISegmentArray = array of TEDISegment; + + TEDIMessageSegment = class(TEDISegment) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function InternalAssignDelimiters: TEDIDelimiters; override; + end; + + TEDIFunctionalGroupSegment = class(TEDISegment) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function InternalAssignDelimiters: TEDIDelimiters; override; + end; + + TEDIInterchangeControlSegment = class(TEDISegment) + public + constructor Create(Parent: TEDIDataObject; ElementCount: Integer = 0); reintroduce; + function InternalAssignDelimiters: TEDIDelimiters; override; + end; + + // EDI Transaction Set Loop + TEDIMessageLoop = class(TEDIDataObjectGroup) + protected + FOwnerLoopId: string; + FParentLoopId: string; + FParentMessage: TEDIMessage; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject); reintroduce; + destructor Destroy; override; + function Assemble: string; override; + procedure Disassemble; override; + // + // ToDo: More procedures and functions to manage internal structures + // + function FindLoop(LoopId: string; var StartIndex: Integer): TEDIMessageLoop; + function FindSegment(SegmentId: string; var StartIndex: Integer): TEDISegment; overload; + function FindSegment(SegmentId: string; var StartIndex: Integer; + ElementConditions: TStrings): TEDISegment; overload; + // + function AddLoop(OwnerLoopId, ParentLoopId: string): Integer; + procedure AppendSegment(Segment: TEDISegment); + procedure DeleteEDIDataObjects; + published + property OwnerLoopId: string read FOwnerLoopId write FOwnerLoopId; + property ParentLoopId: string read FParentLoopId write FParentLoopId; + property ParentMessage: TEDIMessage read FParentMessage write FParentMessage; + end; + + // EDI Message (Transaction Set) + TEDIMessage = class(TEDIDataObjectGroup) + private + FUNHSegment: TEDIMessageSegment; + FUNTSegment: TEDIMessageSegment; + function GetSegment(Index: Integer): TEDISegment; + procedure SetSegment(Index: Integer; Segment: TEDISegment); + procedure SetUNHSegment(const UNHSegment: TEDIMessageSegment); + procedure SetUNTSegment(const UNTSegment: TEDIMessageSegment); + protected + procedure InternalCreateHeaderTrailerSegments; virtual; + function InternalCreateSegment: TEDISegment; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; SegmentCount: Integer = 0); reintroduce; + destructor Destroy; override; + + function AddSegment: Integer; + function AppendSegment(Segment: TEDISegment): Integer; + function InsertSegment(InsertIndex: Integer): Integer; overload; + function InsertSegment(InsertIndex: Integer; Segment: TEDISegment): Integer; overload; + procedure DeleteSegment(Index: Integer); overload; + procedure DeleteSegment(Segment: TEDISegment); overload; + + function AddSegments(Count: Integer): Integer; + function AppendSegments(SegmentArray: TEDISegmentArray): Integer; + function InsertSegments(InsertIndex, Count: Integer): Integer; overload; + function InsertSegments(InsertIndex: Integer; + SegmentArray: TEDISegmentArray): Integer; overload; + procedure DeleteSegments; overload; + procedure DeleteSegments(Index, Count: Integer); overload; + + function Assemble: string; override; + procedure Disassemble; override; + + property Segment[Index: Integer]: TEDISegment read GetSegment write SetSegment; default; + property Segments: TEDIDataObjectList read FEDIDataObjects; + published + property SegmentUNH: TEDIMessageSegment read FUNHSegment write SetUNHSegment; + property SegmentUNT: TEDIMessageSegment read FUNTSegment write SetUNTSegment; + property SegmentCount: Integer read GetCount; + end; + + TEDIMessageArray = array of TEDIMessage; + + // EDI Functional Group + TEDIFunctionalGroup = class(TEDIDataObjectGroup) + private + FUNGSegment: TEDIFunctionalGroupSegment; + FUNESegment: TEDIFunctionalGroupSegment; + function GetMessage(Index: Integer): TEDIMessage; + procedure SetMessage(Index: Integer; Message: TEDIMessage); + procedure SetUNGSegment(const UNGSegment: TEDIFunctionalGroupSegment); + procedure SetUNESegment(const UNESegment: TEDIFunctionalGroupSegment); + protected + procedure InternalCreateHeaderTrailerSegments; virtual; + function InternalCreateMessage: TEDIMessage; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; MessageCount: Integer = 0); reintroduce; + destructor Destroy; override; + + function AddMessage: Integer; + function AppendMessage(Message: TEDIMessage): Integer; + function InsertMessage(InsertIndex: Integer): Integer; overload; + function InsertMessage(InsertIndex: Integer; + Message: TEDIMessage): Integer; overload; + procedure DeleteMessage(Index: Integer); overload; + procedure DeleteMessage(Message: TEDIMessage); overload; + + function AddMessages(Count: Integer): Integer; + function AppendMessages(MessageArray: TEDIMessageArray): Integer; + function InsertMessages(InsertIndex, Count: Integer): Integer; overload; + function InsertMessages(InsertIndex: Integer; + MessageArray: TEDIMessageArray): Integer; overload; + procedure DeleteMessages; overload; + procedure DeleteMessages(Index, Count: Integer); overload; + + function Assemble: string; override; + procedure Disassemble; override; + + property Message[Index: Integer]: TEDIMessage read GetMessage + write SetMessage; default; + property Messages: TEDIDataObjectList read FEDIDataObjects; + published + property SegmentUNG: TEDIFunctionalGroupSegment read FUNGSegment write SetUNGSegment; + property SegmentUNE: TEDIFunctionalGroupSegment read FUNESegment write SetUNESegment; + property MessageCount: Integer read GetCount; + end; + + TEDIFunctionalGroupArray = array of TEDIFunctionalGroup; + + // EDI Interchange Control + TEDIInterchangeControl = class(TEDIDataObjectGroup) + private + FUNASegment: TEDIInterchangeControlSegment; + FUNBSegment: TEDIInterchangeControlSegment; + FUNZSegment: TEDIInterchangeControlSegment; + procedure SetUNBSegment(const UNBSegment: TEDIInterchangeControlSegment); + procedure SetUNZSegment(const UNZSegment: TEDIInterchangeControlSegment); + protected + FCreateObjectType: TEDIDataObjectType; + procedure InternalCreateHeaderTrailerSegments; virtual; + function InternalCreateFunctionalGroup: TEDIFunctionalGroup; virtual; + function InternalCreateMessage: TEDIMessage; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; FunctionalGroupCount: Integer = 0); reintroduce; + destructor Destroy; override; + + function AddFunctionalGroup: Integer; + function AppendFunctionalGroup(FunctionalGroup: TEDIFunctionalGroup): Integer; + function InsertFunctionalGroup(InsertIndex: Integer): Integer; overload; + function InsertFunctionalGroup(InsertIndex: Integer; + FunctionalGroup: TEDIFunctionalGroup): Integer; overload; + + function AddFunctionalGroups(Count: Integer): Integer; + function AppendFunctionalGroups(FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; + function InsertFunctionalGroups(InsertIndex, Count: Integer): Integer; overload; + function InsertFunctionalGroups(InsertIndex: Integer; + FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; overload; + + function AddMessage: Integer; + function AppendMessage(Message: TEDIMessage): Integer; + function InsertMessage(InsertIndex: Integer): Integer; overload; + function InsertMessage(InsertIndex: Integer; Message: TEDIMessage): Integer; overload; + + function AddMessages(Count: Integer): Integer; + function AppendMessages(MessageArray: TEDIMessageArray): Integer; + function InsertMessages(InsertIndex, Count: Integer): Integer; overload; + function InsertMessages(InsertIndex: Integer; MessageArray: TEDIMessageArray): Integer; overload; + + function Assemble: string; override; + procedure Disassemble; override; + published + property SegmentUNA: TEDIInterchangeControlSegment read FUNASegment; + property SegmentUNB: TEDIInterchangeControlSegment read FUNBSegment write SetUNBSegment; + property SegmentUNZ: TEDIInterchangeControlSegment read FUNZSegment write SetUNZSegment; + end; + + TEDIInterchangeControlArray = array of TEDIInterchangeControl; + + // EDI File + TEDIFileOptions = set of (foVariableDelimiterDetection, foRemoveCrLf, foRemoveCr, foRemoveLf, + foIgnoreGarbageAtEndOfFile); + + TEDIFile = class(TEDIDataObjectGroup) + private + FFileID: Integer; + FFileName: string; + FEDIFileOptions: TEDIFileOptions; + function GetInterchangeControl(Index: Integer): TEDIInterchangeControl; + procedure SetInterchangeControl(Index: Integer; Interchange: TEDIInterchangeControl); + procedure InternalLoadFromFile; + protected + procedure InternalDelimitersDetection(StartPos: Integer); virtual; + procedure InternalAlternateDelimitersDetection(StartPos: Integer); + function InternalCreateInterchangeControl: TEDIInterchangeControl; virtual; + function InternalAssignDelimiters: TEDIDelimiters; override; + function InternalCreateEDIDataObject: TEDIDataObject; override; + public + constructor Create(Parent: TEDIDataObject; InterchangeCount: Integer = 0); reintroduce; + destructor Destroy; override; + + procedure LoadFromFile(const FileName: string); + procedure ReLoadFromFile; + procedure SaveToFile; + procedure SaveAsToFile(const FileName: string); + + function AddInterchange: Integer; + function AppendInterchange(Interchange: TEDIInterchangeControl): Integer; + function InsertInterchange(InsertIndex: Integer): Integer; overload; + function InsertInterchange(InsertIndex: Integer; + Interchange: TEDIInterchangeControl): Integer; overload; + procedure DeleteInterchange(Index: Integer); overload; + procedure DeleteInterchange(Interchange: TEDIInterchangeControl); overload; + + function AddInterchanges(Count: Integer): Integer; + function AppendInterchanges( + InterchangeControlArray: TEDIInterchangeControlArray): Integer; + function InsertInterchanges(InsertIndex, Count: Integer): Integer; overload; + function InsertInterchanges(InsertIndex: Integer; + InterchangeControlArray: TEDIInterchangeControlArray): Integer; overload; + procedure DeleteInterchanges; overload; + procedure DeleteInterchanges(Index, Count: Integer); overload; + + function Assemble: string; override; + procedure Disassemble; override; + + property Interchange[Index: Integer]: TEDIInterchangeControl read GetInterchangeControl + write SetInterchangeControl; default; + property Interchanges: TEDIDataObjectList read FEDIDataObjects; + published + property FileID: Integer read FFileID write FFileID; + property FileName: string read FFileName write FFileName; + property Options: TEDIFileOptions read FEDIFileOptions write FEDIFileOptions; + property InterchangeControlCount: Integer read GetCount; + end; + + TEDIFileArray = array of TEDIFile; + +implementation + +uses + JclResources, JclStrings; + +//=== { TEDIElement } ======================================================== + +constructor TEDIElement.Create(Parent: TEDIDataObject); +begin + if Assigned(Parent) and ((Parent is TEDISegment) or (Parent is TEDICompositeElement)) then + inherited Create(Parent) + else + inherited Create(nil); + FEDIDOT := ediElement; +end; + +function TEDIElement.Assemble: string; +begin + Result := FData; + FState := ediAssembled; +end; + +procedure TEDIElement.Disassemble; +begin + FState := ediDisassembled; +end; + +function TEDIElement.GetIndexPositionFromParent: Integer; +var + I: Integer; + EDISegment: TEDISegment; + EDICompositeElement: TEDICompositeElement; +begin + Result := -1; + if Assigned(Parent) and (Parent is TEDISegment) then + begin + EDISegment := TEDISegment(Parent); + for I := 0 to EDISegment.EDIDataObjectCount - 1 do + if EDISegment.EDIDataObjects[I] = Self then + begin + Result := I; + Break; + end; + end + else + if Assigned(Parent) and (Parent is TEDICompositeElement) then + begin + EDICompositeElement := TEDICompositeElement(Parent); + for I := 0 to EDICompositeElement.EDIDataObjectCount - 1 do + if EDICompositeElement.EDIDataObjects[I] = Self then + begin + Result := I; + Break; + end; + end; +end; + +//=== { TEDISegment } ======================================================== + +constructor TEDISegment.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + if Assigned(Parent) and (Parent is TEDIMessage) then + inherited Create(Parent, ElementCount) + else + inherited Create(nil, ElementCount); + FSegmentID := ''; + FEDIDOT := ediSegment; + FCreateObjectType := ediElement; + //FSegmentIdData := T???.Create(Self); +end; + +destructor TEDISegment.Destroy; +begin + //FSegmentIdData.Free; + inherited Destroy; +end; + +function TEDISegment.AddElements(Count: Integer): Integer; +begin + FCreateObjectType := ediElement; + Result := AddEDIDataObjects(Count); +end; + +function TEDISegment.AddElement: Integer; +begin + FCreateObjectType := ediElement; + Result := AddEDIDataObject; +end; + +function TEDISegment.AppendElement(Element: TEDIElement): Integer; +begin + Result := AppendEDIDataObject(Element); +end; + +function TEDISegment.AppendElements(ElementArray: TEDIElementArray): Integer; +begin + Result := AppendEDIDataObjects(TEDIDataObjectArray(ElementArray)); +end; + +function TEDISegment.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError036); + end; + + FData := FSegmentID; + if GetCount > 0 then + for I := 0 to GetCount - 1 do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FDelimiters.ED + FEDIDataObjects[I].Assemble + else + FData := FData + FDelimiters.ED; + FData := FData + FDelimiters.SD; + FLength := Length(FData); + Result := FData; // Return assembled string + + DeleteElements; + + FState := ediAssembled; +end; + +procedure TEDISegment.DeleteElement(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDISegment.DeleteElement(Element: TEDIElement); +begin + DeleteEDIDataObject(Element); +end; + +procedure TEDISegment.DeleteElements(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDISegment.DeleteElements; +begin + DeleteEDIDataObjects; +end; + +procedure TEDISegment.Disassemble; +var + I, StartPos, SearchResult: Integer; + ElementData: string; +begin + // Data Input Scenarios + // 4.) SegID+data+data' + // Composite Element Data Input Secnarios + // 9.) SegID+data+data:data' + FSegmentID := ''; + DeleteElements; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError035); + end; + // Continue + StartPos := 1; + SearchResult := StrSearch(FDelimiters.ED, FData, StartPos); + FSegmentID := Copy(FData, 1, SearchResult - 1); + StartPos := SearchResult + 1; + SearchResult := StrSearch(FDelimiters.ED, FData, StartPos); + while SearchResult <> 0 do + begin + ElementData := Copy(FData, ((StartPos + FDelimiters.EDLen) - 1), (SearchResult - StartPos)); + if StrSearch(FDelimiters.SS, ElementData, 1) <= 0 then + I := AddElement + else + I := AddCompositeElement; + if (SearchResult - StartPos) > 0 then // data exists + begin + FEDIDataObjects[I].Data := ElementData; + FEDIDataObjects[I].Disassemble; + end; + StartPos := SearchResult + 1; + SearchResult := StrSearch(FDelimiters.ED, FData, StartPos); + end; + // Get last element before next segment + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + if SearchResult <> 0 then + if (SearchResult - StartPos) > 0 then // data exists + begin + ElementData := Copy(FData, ((StartPos + FDelimiters.EDLen) - 1), + (SearchResult - StartPos)); + if StrSearch(FDelimiters.SS, ElementData, 1) <= 0 then + I := AddElement + else + I := AddCompositeElement; + FEDIDataObjects[I].Data := ElementData; + FEDIDataObjects[I].Disassemble; + end; + FData := ''; + + FState := ediDisassembled; +end; + +function TEDISegment.InsertElement(InsertIndex: Integer): Integer; +begin + FCreateObjectType := ediElement; + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDISegment.InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, Element); +end; + +function TEDISegment.InsertElements(InsertIndex: Integer; ElementArray: TEDIElementArray): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(ElementArray)); +end; + +function TEDISegment.InsertElements(InsertIndex, Count: Integer): Integer; +begin + FCreateObjectType := ediElement; + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDISegment.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + // Get the delimiters from the Message + if Assigned(Parent) and (Parent is TEDIMessage) then + begin + if Assigned(Parent.Delimiters) then + begin + Result := Parent.Delimiters; + Exit; + end; + // Get the delimiters from the functional group + if Assigned(Parent.Parent) and (Parent.Parent is TEDIFunctionalGroup) then + begin + if Assigned(Parent.Parent.Delimiters) then + begin + Result := Parent.Parent.Delimiters; + Exit; + end; + // Get the delimiters from the interchange control header + if Assigned(Parent.Parent.Parent) and (Parent.Parent.Parent is TEDIInterchangeControl) then + Result := Parent.Parent.Parent.Delimiters; + end; + end; + end; +end; + +function TEDISegment.InternalCreateElement: TEDIElement; +begin + Result := TEDIElement.Create(Self); +end; + +function TEDISegment.InternalCreateEDIDataObject: TEDIDataObject; +begin + case FCreateObjectType of + ediElement: + Result := InternalCreateElement; + ediCompositeElement: + Result := InternalCreateCompositeElement; + else + Result := nil; + end; +end; + +function TEDISegment.InternalCreateCompositeElement: TEDICompositeElement; +begin + Result := TEDICompositeElement.Create(Self); +end; + +function TEDISegment.AddCompositeElement: Integer; +begin + FCreateObjectType := ediCompositeElement; + Result := AddEDIDataObject; +end; + +function TEDISegment.AddCompositeElements(Count: Integer): Integer; +begin + FCreateObjectType := ediCompositeElement; + Result := AddEDIDataObjects(Count); +end; + +function TEDISegment.AppendCompositeElement(CompositeElement: TEDICompositeElement): Integer; +begin + Result := AppendEDIDataObject(CompositeElement); +end; + +function TEDISegment.AppendCompositeElements( + CompositeElementArray: TEDICompositeElementArray): Integer; +begin + Result := AppendEDIDataObjects(TEDIDataObjectArray(CompositeElementArray)); +end; + +function TEDISegment.InsertCompositeElement(InsertIndex: Integer): Integer; +begin + FCreateObjectType := ediCompositeElement; + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDISegment.InsertCompositeElement(InsertIndex: Integer; + CompositeElement: TEDICompositeElement): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, CompositeElement); +end; + +function TEDISegment.InsertCompositeElements(InsertIndex, Count: Integer): Integer; +begin + FCreateObjectType := ediCompositeElement; + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDISegment.InsertCompositeElements(InsertIndex: Integer; + CompositeElementArray: TEDICompositeElementArray): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(CompositeElementArray)); +end; + +//=== { TEDIMessageSegment } ================================================= + +constructor TEDIMessageSegment.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIMessage) then + FParent := Parent; +end; + +function TEDIMessageSegment.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := inherited InternalAssignDelimiters; +end; + +//=== { TEDIFunctionalGroupSegment } ========================================= + +constructor TEDIFunctionalGroupSegment.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then + FParent := Parent; +end; + +function TEDIFunctionalGroupSegment.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + begin + // Get the delimiters from the functional group + if Assigned(Parent) and (Parent is TEDIFunctionalGroup) then + begin + if Assigned(Parent.Delimiters) then + begin + Result := Parent.Delimiters; + Exit; + end; + // Get the delimiters from the interchange control + if Assigned(Parent.Parent) and (Parent.Parent is TEDIInterchangeControl) then + Result := Parent.Parent.Delimiters; + end; + end; +end; + +//=== { TEDIInterchangeControlSegment } ====================================== + +constructor TEDIInterchangeControlSegment.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + inherited Create(Parent, ElementCount); + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + FParent := Parent; +end; + +function TEDIInterchangeControlSegment.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + // Get the delimiters from the interchange control + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + Result := Parent.Delimiters; +end; + +//=== { TEDIMessage } ======================================================== + +constructor TEDIMessage.Create(Parent: TEDIDataObject; SegmentCount: Integer); +begin + if Assigned(Parent) and + ((Parent is TEDIFunctionalGroup) or (Parent is TEDIInterchangeControl)) then + inherited Create(Parent, SegmentCount) + else + inherited Create(nil, SegmentCount); + FEDIDOT := ediMessage; + InternalCreateHeaderTrailerSegments; +end; + +destructor TEDIMessage.Destroy; +begin + FUNTSegment.Free; + FUNHSegment.Free; + inherited Destroy; +end; + +function TEDIMessage.AddSegment: Integer; +begin + Result := AddEDIDataObject; +end; + +function TEDIMessage.AddSegments(Count: Integer): Integer; +begin + Result := AddEDIDataObjects(Count); +end; + +function TEDIMessage.AppendSegment(Segment: TEDISegment): Integer; +begin + Result := AppendEDIDataObject(Segment); +end; + +function TEDIMessage.AppendSegments(SegmentArray: TEDISegmentArray): Integer; +begin + Result := AppendEDIDataObjects(TEDIDataObjectArray(SegmentArray)); +end; + +function TEDIMessage.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError031); + end; + + FData := FUNHSegment.Assemble; + FUNHSegment.Data := ''; + + if GetCount > 0 then + for I := 0 to GetCount - 1 do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + + DeleteSegments; + + FData := FData + FUNTSegment.Assemble; + FUNTSegment.Data := ''; + + FLength := Length(FData); + Result := FData; + + FState := ediAssembled; +end; + +procedure TEDIMessage.DeleteSegment(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDIMessage.DeleteSegment(Segment: TEDISegment); +begin + DeleteEDIDataObject(Segment); +end; + +procedure TEDIMessage.DeleteSegments; +begin + DeleteEDIDataObjects; +end; + +procedure TEDIMessage.DeleteSegments(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDIMessage.Disassemble; +var + I, StartPos, SearchResult: Integer; + S, S2: string; +begin + FUNHSegment.Data := ''; + FUNHSegment.DeleteElements; + FUNTSegment.Data := ''; + FUNTSegment.DeleteElements; + DeleteSegments; + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError030); + end; + // Find the first segment + StartPos := 1; + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + while SearchResult <> 0 do + begin + S := Copy(FData, StartPos, Length(UNHSegmentId)); + S2 := Copy(FData, StartPos, Length(UNTSegmentId)); + if (S <> UNHSegmentId) and (S2 <> UNTSegmentId) then + begin + I := AddSegment; + if (SearchResult - StartPos) > 0 then // data exists + begin + FEDIDataObjects[I].Data := Copy(FData, StartPos, + ((SearchResult - StartPos) + FDelimiters.SDLen)); + FEDIDataObjects[I].Disassemble; + end; + end + else + if S = UNHSegmentId then + begin + if (SearchResult - StartPos) > 0 then // data exists + begin + FUNHSegment.Data := Copy(FData, StartPos, + ((SearchResult - StartPos) + FDelimiters.SDLen)); + FUNHSegment.Disassemble; + end; + end + else + if S2 = UNTSegmentId then + begin + if (SearchResult - StartPos) > 0 then // data exists + begin + FUNTSegment.Data := Copy(FData, StartPos, + ((SearchResult - StartPos) + FDelimiters.SDLen)); + FUNTSegment.Disassemble; + end; + end; + StartPos := SearchResult + FDelimiters.SDLen; + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + end; + FData := ''; + FState := ediDisassembled; +end; + +function TEDIMessage.GetSegment(Index: Integer): TEDISegment; +begin + Result := TEDISegment(GetEDIDataObject(Index)); +end; + +function TEDIMessage.InsertSegment(InsertIndex: Integer): Integer; +begin + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDIMessage.InsertSegment(InsertIndex: Integer; Segment: TEDISegment): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, Segment); +end; + +function TEDIMessage.InsertSegments(InsertIndex, Count: Integer): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDIMessage.InsertSegments(InsertIndex: Integer; + SegmentArray: TEDISegmentArray): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(SegmentArray)); +end; + +function TEDIMessage.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + if FDelimiters = nil then // Attempt to assign the delimiters + if Assigned(Parent) and + ((Parent is TEDIFunctionalGroup) or (Parent is TEDIInterchangeControl)) then + if Assigned(Parent.Delimiters) then + Result := Parent.Delimiters + else + if Assigned(Parent.Parent) and (Parent.Parent is TEDIInterchangeControl) then + Result := Parent.Parent.Delimiters; +end; + +function TEDIMessage.InternalCreateSegment: TEDISegment; +begin + Result := TEDISegment.Create(Self); +end; + +procedure TEDIMessage.InternalCreateHeaderTrailerSegments; +begin + FUNHSegment := TEDIMessageSegment.Create(Self); + FUNTSegment := TEDIMessageSegment.Create(Self); +end; + +procedure TEDIMessage.SetSegment(Index: Integer; Segment: TEDISegment); +begin + SetEDIDataObject(Index, Segment); +end; + +procedure TEDIMessage.SetUNTSegment(const UNTSegment: TEDIMessageSegment); +begin + FreeAndNil(FUNTSegment); + FUNTSegment := UNTSegment; + if Assigned(FUNTSegment) then + FUNTSegment.Parent := Self; +end; + +procedure TEDIMessage.SetUNHSegment(const UNHSegment: TEDIMessageSegment); +begin + FreeAndNil(FUNHSegment); + FUNHSegment := UNHSegment; + if Assigned(FUNHSegment) then + FUNHSegment.Parent := Self; +end; + +function TEDIMessage.InternalCreateEDIDataObject: TEDIDataObject; +begin + Result := InternalCreateSegment; +end; + +//=== { TEDIFunctionalGroup } ================================================ + +constructor TEDIFunctionalGroup.Create(Parent: TEDIDataObject; MessageCount: Integer); +begin + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + inherited Create(Parent, MessageCount) + else + inherited Create(nil, MessageCount); + FEDIDOT := ediFunctionalGroup; + InternalCreateHeaderTrailerSegments; +end; + +destructor TEDIFunctionalGroup.Destroy; +begin + FUNGSegment.Free; + FUNESegment.Free; + inherited Destroy; +end; + +function TEDIFunctionalGroup.AddMessage: Integer; +begin + Result := AddEDIDataObject; +end; + +function TEDIFunctionalGroup.AddMessages(Count: Integer): Integer; +begin + Result := AddEDIDataObjects(Count); +end; + +function TEDIFunctionalGroup.AppendMessage(Message: TEDIMessage): Integer; +begin + Result := AppendEDIDataObject(Message); +end; + +function TEDIFunctionalGroup.AppendMessages( + MessageArray: TEDIMessageArray): Integer; +begin + Result := AppendEDIDataObjects(TEDIDataObjectArray(MessageArray)); +end; + +function TEDIFunctionalGroup.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError020); + end; + FData := FUNGSegment.Assemble; + FUNGSegment.Data := ''; + + if GetCount > 0 then + for I := 0 to GetCount - 1 do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + + DeleteMessages; + + FData := FData + FUNESegment.Assemble; + FUNESegment.Data := ''; + + FLength := Length(FData); + Result := FData; + + FState := ediAssembled; +end; + +procedure TEDIFunctionalGroup.DeleteMessage(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDIFunctionalGroup.DeleteMessage(Message: TEDIMessage); +begin + DeleteEDIDataObject(Message); +end; + +procedure TEDIFunctionalGroup.DeleteMessages; +begin + DeleteEDIDataObjects; +end; + +procedure TEDIFunctionalGroup.DeleteMessages(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDIFunctionalGroup.Disassemble; +var + I, StartPos, SearchResult: Integer; +begin + FUNGSegment.Data := ''; + FUNGSegment.DeleteElements; + FUNESegment.Data := ''; + FUNESegment.DeleteElements; + DeleteMessages; + // Check delimiter assignment + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError019); + end; + // Find Functional Group Header Segment + StartPos := 1; + // Search for Functional Group Header + if UNGSegmentId + FDelimiters.ED = Copy(FData, 1, Length(UNGSegmentId + FDelimiters.ED)) then + begin + // Search for Functional Group Header Segment Terminator + SearchResult := StrSearch(FDelimiters.SD, FData, 1); + if (SearchResult - StartPos) > 0 then // data exists + begin + FUNGSegment.Data := Copy(FData, 1, (SearchResult + FDelimiters.SDLen) - 1); + FUNGSegment.Disassemble; + end + else + raise EJclEDIError.CreateRes(@RsEDIError021); + end + else + raise EJclEDIError.CreateRes(@RsEDIError022); + // Search for Message Header + SearchResult := StrSearch(FDelimiters.SD + UNHSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult <= 0 then + raise EJclEDIError.CreateRes(@RsEDIError032); + // Set next start position + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Continue + while SearchResult <> 0 do + begin + // Search for Message Trailer + SearchResult := StrSearch(FDelimiters.SD + UNTSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult <> 0 then + begin + // Set the next start position + SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Search for the end of Message Trailer + SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); + if SearchResult <> 0 then + begin + I := AddMessage; + FEDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); + FEDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@RsEDIError033); + end + else + raise EJclEDIError.CreateRes(@RsEDIError034); + // Set the next start position + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // + // Verify the next record is a Message Header + if (UNHSegmentId + FDelimiters.ED) <> + Copy(FData, StartPos, (Length(UNHSegmentId) + FDelimiters.EDLen)) then + Break; + end; + // Set the next start position + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Find Functional Group Trailer Segment + if (UNESegmentId + FDelimiters.ED) = + Copy(FData, StartPos, Length(UNESegmentId + FDelimiters.ED)) then + begin + // Find Functional Group Trailer Segment Terminator + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos + FDelimiters.SDLen); + if (SearchResult - StartPos) > 0 then // data exists + begin + FUNESegment.Data := Copy(FData, StartPos, (SearchResult + FDelimiters.SDLen)); + FUNESegment.Disassemble; + end + else + raise EJclEDIError.CreateRes(@RsEDIError023); + end + else + raise EJclEDIError.CreateRes(@RsEDIError024); + FData := ''; + FState := ediDisassembled; +end; + +function TEDIFunctionalGroup.GetMessage(Index: Integer): TEDIMessage; +begin + Result := TEDIMessage(GetEDIDataObject(Index)); +end; + +function TEDIFunctionalGroup.InsertMessage(InsertIndex: Integer): Integer; +begin + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDIFunctionalGroup.InsertMessage(InsertIndex: Integer; + Message: TEDIMessage): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, Message); +end; + +function TEDIFunctionalGroup.InsertMessages(InsertIndex: Integer; + MessageArray: TEDIMessageArray): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(MessageArray)); +end; + +function TEDIFunctionalGroup.InsertMessages(InsertIndex, Count: Integer): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDIFunctionalGroup.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + // Attempt to assign the delimiters + if not Assigned(FDelimiters) then + if Assigned(Parent) and (Parent is TEDIInterchangeControl) then + Result := Parent.Delimiters; +end; + +function TEDIFunctionalGroup.InternalCreateMessage: TEDIMessage; +begin + Result := TEDIMessage.Create(Self); +end; + +procedure TEDIFunctionalGroup.InternalCreateHeaderTrailerSegments; +begin + FUNGSegment := TEDIFunctionalGroupSegment.Create(Self); + FUNESegment := TEDIFunctionalGroupSegment.Create(Self); +end; + +procedure TEDIFunctionalGroup.SetMessage(Index: Integer; Message: TEDIMessage); +begin + SetEDIDataObject(Index, Message); +end; + +procedure TEDIFunctionalGroup.SetUNESegment(const UNESegment: TEDIFunctionalGroupSegment); +begin + FreeAndNil(FUNESegment); + FUNESegment := UNESegment; + if Assigned(FUNESegment) then + FUNESegment.Parent := Self; +end; + +procedure TEDIFunctionalGroup.SetUNGSegment(const UNGSegment: TEDIFunctionalGroupSegment); +begin + FreeAndNil(FUNGSegment); + FUNGSegment := UNGSegment; + if Assigned(FUNGSegment) then + FUNGSegment.Parent := Self; +end; + +function TEDIFunctionalGroup.InternalCreateEDIDataObject: TEDIDataObject; +begin + Result := InternalCreateMessage; +end; + +//=== { TEDIInterchangeControl } ============================================= + +constructor TEDIInterchangeControl.Create(Parent: TEDIDataObject; FunctionalGroupCount: Integer); +begin + if Assigned(Parent) and (Parent is TEDIFile) then + inherited Create(Parent, FunctionalGroupCount) + else + inherited Create(nil, FunctionalGroupCount); + FEDIDOT := ediInterchangeControl; + InternalCreateHeaderTrailerSegments; + FCreateObjectType := ediFunctionalGroup; +end; + +destructor TEDIInterchangeControl.Destroy; +begin + FUNASegment.Free; + FUNBSegment.Free; + FUNZSegment.Free; + FreeAndNil(FDelimiters); + inherited Destroy; +end; + +function TEDIInterchangeControl.AddFunctionalGroup: Integer; +begin + FCreateObjectType := ediFunctionalGroup; + Result := AddEDIDataObject; +end; + +function TEDIInterchangeControl.AddFunctionalGroups(Count: Integer): Integer; +begin + FCreateObjectType := ediFunctionalGroup; + Result := AddEDIDataObjects(Count); +end; + +function TEDIInterchangeControl.AppendFunctionalGroup( + FunctionalGroup: TEDIFunctionalGroup): Integer; +begin + FCreateObjectType := ediFunctionalGroup; + Result := AppendEDIDataObject(FunctionalGroup); +end; + +function TEDIInterchangeControl.AppendFunctionalGroups( + FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; +begin + Result := AppendEDIDataObjects(TEDIDataObjectArray(FunctionalGroupArray)); +end; + +function TEDIInterchangeControl.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError013); + + FData := FUNBSegment.Assemble; + FUNBSegment.Data := ''; + + if GetCount > 0 then + for I := 0 to GetCount - 1 do + if Assigned(FEDIDataObjects[I]) then + FData := FData + FEDIDataObjects[I].Assemble; + + DeleteEDIDataObjects; + + FData := FData + FUNZSegment.Assemble; + FUNZSegment.Data := ''; + + FLength := Length(FData); + Result := FData; + + FState := ediAssembled; +end; + +procedure TEDIInterchangeControl.Disassemble; +var + I, StartPos, SearchResult: Integer; +begin + FUNBSegment.Data := ''; + FUNBSegment.DeleteElements; + FUNZSegment.Data := ''; + FUNZSegment.DeleteElements; + DeleteEDIDataObjects; + + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError012); + + StartPos := 1; + // Search for Interchange Control Header + if UNBSegmentId + FDelimiters.ED = Copy(FData, 1, Length(UNBSegmentId + FDelimiters.ED)) then + begin + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + if (SearchResult - StartPos) > 0 then // data exists + begin + FUNBSegment.Data := Copy(FData, 1, (SearchResult + FDelimiters.SDLen) - 1); + FUNBSegment.Disassemble; + end + else + raise EJclEDIError.CreateRes(@RsEDIError014); + end + else + raise EJclEDIError.CreateRes(@RsEDIError015); + // Search for Functional Group Header + SearchResult := StrSearch(FDelimiters.SD + UNGSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult > 0 then + begin + // Set next start positon + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Continue + while ((StartPos + Length(UNGSegmentId)) < Length(FData)) and (SearchResult > 0) do + begin + // Search for Functional Group Trailer + SearchResult := StrSearch(FDelimiters.SD + UNESegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult > 0 then + begin + // Set next start positon + SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Search for end of Functional Group Trailer Segment Terminator + SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddFunctionalGroup; + FEDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); + FEDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@RsEDIError023); + end + else + raise EJclEDIError.CreateRes(@RsEDIError024); + // Set next start positon + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Verify the next record is a Functional Group Header + if (UNGSegmentId + FDelimiters.ED) <> + Copy(FData, StartPos, (Length(UNGSegmentId) + FDelimiters.EDLen)) then + Break; + end; + end + else + begin + // Search for Message Header + SearchResult := StrSearch(FDelimiters.SD + UNHSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult <= 0 then + raise EJclEDIError.CreateRes(@RsEDIError032); + // Set next start position + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Continue + while SearchResult <> 0 do + begin + // Search for Message Trailer + SearchResult := StrSearch(FDelimiters.SD + UNTSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult <> 0 then + begin + // Set the next start position + SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Search for the end of Message Trailer + SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); + if SearchResult <> 0 then + begin + I := AddMessage; + FEDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); + FEDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@RsEDIError033); + end + else + raise EJclEDIError.CreateRes(@RsEDIError034); + // Set the next start position + StartPos := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Verify the next record is a Message Header + if (UNHSegmentId + FDelimiters.ED) <> + Copy(FData, StartPos, (Length(UNHSegmentId) + FDelimiters.EDLen)) then + Break; + end; + end; + // Verify the next record is a Interchange Control Trailer + if (UNZSegmentId + FDelimiters.ED) = + Copy(FData, StartPos, Length(UNZSegmentId + FDelimiters.ED)) then + begin + // Search for the end of Interchange Control Trailer Segment Terminator + SearchResult := StrSearch(FDelimiters.SD, FData, StartPos); + if (SearchResult - StartPos) > 0 then // data exists + begin + FUNZSegment.Data := Copy(FData, StartPos, (SearchResult + FDelimiters.SDLen)); + FUNZSegment.Disassemble; + end + else + raise EJclEDIError.CreateRes(@RsEDIError016); + end + else + raise EJclEDIError.CreateRes(@RsEDIError017); + FData := ''; + + FState := ediDisassembled; +end; + +function TEDIInterchangeControl.InsertFunctionalGroup(InsertIndex: Integer; + FunctionalGroup: TEDIFunctionalGroup): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, FunctionalGroup); +end; + +function TEDIInterchangeControl.InsertFunctionalGroup(InsertIndex: Integer): Integer; +begin + FCreateObjectType := ediFunctionalGroup; + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDIInterchangeControl.InsertFunctionalGroups(InsertIndex, Count: Integer): Integer; +begin + FCreateObjectType := ediFunctionalGroup; + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDIInterchangeControl.InsertFunctionalGroups(InsertIndex: Integer; + FunctionalGroupArray: TEDIFunctionalGroupArray): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(FunctionalGroupArray)); +end; + +function TEDIInterchangeControl.InternalCreateFunctionalGroup: TEDIFunctionalGroup; +begin + Result := TEDIFunctionalGroup.Create(Self); +end; + +procedure TEDIInterchangeControl.InternalCreateHeaderTrailerSegments; +begin + FUNASegment := TEDIInterchangeControlSegment.Create(Self); + FUNBSegment := TEDIInterchangeControlSegment.Create(Self); + FUNZSegment := TEDIInterchangeControlSegment.Create(Self); +end; + +procedure TEDIInterchangeControl.SetUNZSegment(const UNZSegment: TEDIInterchangeControlSegment); +begin + FreeAndNil(FUNZSegment); + FUNZSegment := UNZSegment; + if Assigned(FUNZSegment) then + FUNZSegment.Parent := Self; +end; + +procedure TEDIInterchangeControl.SetUNBSegment(const UNBSegment: TEDIInterchangeControlSegment); +begin + FreeAndNil(FUNBSegment); + FUNBSegment := UNBSegment; + if Assigned(FUNBSegment) then + FUNBSegment.Parent := Self; +end; + +function TEDIInterchangeControl.InternalCreateEDIDataObject: TEDIDataObject; +begin + case FCreateObjectType of + ediFunctionalGroup: + Result := InternalCreateFunctionalGroup; + ediMessage: + Result := InternalCreateMessage; + else + Result := nil; + end; +end; + +function TEDIInterchangeControl.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; +end; + +function TEDIInterchangeControl.InternalCreateMessage: TEDIMessage; +begin + Result := TEDIMessage.Create(Self); +end; + +function TEDIInterchangeControl.AddMessage: Integer; +begin + FCreateObjectType := ediMessage; + Result := AddEDIDataObject; +end; + +function TEDIInterchangeControl.AddMessages(Count: Integer): Integer; +begin + FCreateObjectType := ediMessage; + Result := AddEDIDataObjects(Count); +end; + +function TEDIInterchangeControl.AppendMessage(Message: TEDIMessage): Integer; +begin + FCreateObjectType := ediMessage; + Result := AppendEDIDataObject(Message); +end; + +function TEDIInterchangeControl.AppendMessages(MessageArray: TEDIMessageArray): Integer; +begin + Result := AppendEDIDataObjects(TEDIDataObjectArray(MessageArray)); +end; + +function TEDIInterchangeControl.InsertMessage(InsertIndex: Integer; Message: TEDIMessage): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, Message); +end; + +function TEDIInterchangeControl.InsertMessage(InsertIndex: Integer): Integer; +begin + FCreateObjectType := ediMessage; + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDIInterchangeControl.InsertMessages(InsertIndex, Count: Integer): Integer; +begin + FCreateObjectType := ediMessage; + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDIInterchangeControl.InsertMessages(InsertIndex: Integer; + MessageArray: TEDIMessageArray): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(MessageArray)); +end; + +//=== { TEDIFile } =========================================================== + +constructor TEDIFile.Create(Parent: TEDIDataObject; InterchangeCount: Integer); +begin + if Assigned(Parent) then + inherited Create(Parent, InterchangeCount) + else + inherited Create(nil, InterchangeCount); + FEDIFileOptions := [foVariableDelimiterDetection, foRemoveCrLf, foRemoveCr, foRemoveLf]; + FEDIDOT := ediFile; +end; + +destructor TEDIFile.Destroy; +begin + inherited Destroy; +end; + +function TEDIFile.AddInterchange: Integer; +begin + Result := AddEDIDataObject; +end; + +function TEDIFile.AddInterchanges(Count: Integer): Integer; +begin + Result := AddEDIDataObjects(Count); +end; + +function TEDIFile.AppendInterchange(Interchange: TEDIInterchangeControl): Integer; +begin + Result := AppendEDIDataObject(Interchange); +end; + +function TEDIFile.AppendInterchanges(InterchangeControlArray: TEDIInterchangeControlArray): Integer; +begin + Result := AppendEDIDataObjects(TEDIDataObjectArray(InterchangeControlArray)); +end; + +function TEDIFile.Assemble: string; +var + I: Integer; + EDIInterchangeControl: TEDIInterchangeControl; +begin + FData := ''; + FLength := 0; + Result := ''; + + if GetCount > 0 then + for I := 0 to GetCount - 1 do + begin + if Assigned(FEDIDataObjects[I]) then + begin + EDIInterchangeControl := TEDIInterchangeControl(FEDIDataObjects[I]); + if EDIInterchangeControl.SegmentUNA.EDIDataObjectCount > 0 then + begin + FData := FData + EDIInterchangeControl.SegmentUNA.Assemble; + EDIInterchangeControl.SegmentUNA.Data := ''; + end; + FData := FData + FEDIDataObjects[I].Assemble; + end; + FEDIDataObjects[I].Data := ''; + end; + + FLength := Length(FData); + Result := FData; + + DeleteInterchanges; + + FState := ediAssembled; +end; + +procedure TEDIFile.DeleteInterchange(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDIFile.DeleteInterchanges(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDIFile.DeleteInterchanges; +begin + DeleteEDIDataObjects; +end; + +procedure TEDIFile.Disassemble; +var + I, StartPos, SearchResult: Integer; + UNASegmentData: string; +begin + DeleteInterchanges; + + if not Assigned(FDelimiters) then + begin + FDelimiters := InternalAssignDelimiters; + FEDIFileOptions := FEDIFileOptions + [foVariableDelimiterDetection]; + end; + + if foRemoveCrLf in FEDIFileOptions then + {$IFDEF OPTIMIZED_STRINGREPLACE} + FData := JclEDI.StringReplace(FData, AnsiCrLf, '', [rfReplaceAll]); + {$ELSE} + FData := SysUtils.StringReplace(FData, AnsiCrLf, '', [rfReplaceAll]); + {$ENDIF OPTIMIZED_INTERNAL_STRUCTURE} + if foRemoveCr in FEDIFileOptions then + {$IFDEF OPTIMIZED_STRINGREPLACE} + FData := JclEDI.StringReplace(FData, AnsiCarriageReturn, '', [rfReplaceAll]); + {$ELSE} + FData := SysUtils.StringReplace(FData, AnsiCarriageReturn, '', [rfReplaceAll]); + {$ENDIF OPTIMIZED_STRINGREPLACE} + if foRemoveLf in FEDIFileOptions then + {$IFDEF OPTIMIZED_STRINGREPLACE} + FData := JclEDI.StringReplace(FData, AnsiLineFeed, '', [rfReplaceAll]); + {$ELSE} + FData := SysUtils.StringReplace(FData, AnsiLineFeed, '', [rfReplaceAll]); + {$ENDIF OPTIMIZED_STRINGREPLACE} + + StartPos := 1; + if UNASegmentId = Copy(FData, StartPos, Length(UNASegmentId)) then + begin + if foVariableDelimiterDetection in FEDIFileOptions then + InternalDelimitersDetection(StartPos); + SearchResult := StrSearch(FDelimiters.SD + UNBSegmentId + FDelimiters.ED, FData, StartPos); + UNASegmentData := Copy(FData, StartPos, (SearchResult - StartPos) + FDelimiters.SDLen); + StartPos := SearchResult + FDelimiters.SDLen; + end + else + if UNBSegmentId = Copy(FData, StartPos, Length(UNBSegmentId)) then + begin + if foVariableDelimiterDetection in FEDIFileOptions then + InternalAlternateDelimitersDetection(StartPos); + end + else + raise EJclEDIError.CreateRes(@RsEDIError015); + + // Continue + while (StartPos + Length(UNBSegmentId)) < Length(FData) do + begin + // Search for Interchange Control Trailer + SearchResult := StrSearch(FDelimiters.SD + UNZSegmentId + FDelimiters.ED, FData, StartPos); + if SearchResult > 0 then + begin + SearchResult := SearchResult + FDelimiters.SDLen; // Move past the delimiter + // Search for the end of Interchange Control Trailer + SearchResult := StrSearch(FDelimiters.SD, FData, SearchResult); + if SearchResult > 0 then + begin + I := AddInterchange; + FEDIDataObjects[I].Delimiters := + TEDIDelimiters.Create(FDelimiters.SD, FDelimiters.ED, FDelimiters.SS); + TEDIInterchangeControl(FEDIDataObjects[I]).SegmentUNA.Data := UNASegmentData; + TEDIInterchangeControl(FEDIDataObjects[I]).SegmentUNA.Disassemble; + FEDIDataObjects[I].Data := + Copy(FData, StartPos, ((SearchResult - StartPos) + FDelimiters.SDLen)); + FEDIDataObjects[I].Disassemble; + end + else + raise EJclEDIError.CreateRes(@RsEDIError016); + end + else + raise EJclEDIError.CreateRes(@RsEDIError017); + // Set next start position, Move past the delimiter + StartPos := SearchResult + FDelimiters.SDLen; + // + if UNASegmentId = Copy(FData, StartPos, Length(UNASegmentId)) then + begin + if foVariableDelimiterDetection in FEDIFileOptions then + InternalDelimitersDetection(StartPos); + SearchResult := StrSearch(FDelimiters.SD + UNBSegmentId + FDelimiters.ED, FData, StartPos); + UNASegmentData := Copy(FData, StartPos, (SearchResult - StartPos) + FDelimiters.SDLen); + StartPos := SearchResult + FDelimiters.SDLen; + end + else + if UNBSegmentId = Copy(FData, StartPos, Length(UNBSegmentId)) then + begin + if foVariableDelimiterDetection in FEDIFileOptions then + InternalAlternateDelimitersDetection(StartPos); + end + else + if (StartPos + Length(UNBSegmentId)) < Length(FData) then + begin + if foIgnoreGarbageAtEndOfFile in FEDIFileOptions then + Break + else + raise EJclEDIError.CreateRes(@RsEDIError018); + end; + end; + FData := ''; + FState := ediDisassembled; +end; + +function TEDIFile.GetInterchangeControl(Index: Integer): TEDIInterchangeControl; +begin + Result := TEDIInterchangeControl(GetEDIDataObject(Index)); +end; + +function TEDIFile.InsertInterchange(InsertIndex: Integer; + Interchange: TEDIInterchangeControl): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, Interchange); +end; + +function TEDIFile.InsertInterchange(InsertIndex: Integer): Integer; +begin + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDIFile.InsertInterchanges(InsertIndex, Count: Integer): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDIFile.InsertInterchanges(InsertIndex: Integer; + InterchangeControlArray: TEDIInterchangeControlArray): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(InterchangeControlArray)); +end; + +procedure TEDIFile.InternalLoadFromFile; +var + EDIFileStream: TFileStream; +begin + FData := ''; + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmOpenRead or fmShareDenyNone); + try + SetLength(FData, EDIFileStream.Size); + EDIFileStream.Read(Pointer(FData)^, EDIFileStream.Size); + finally + EDIFileStream.Free; + end; + end + else + raise EJclEDIError.CreateRes(@RsEDIError001); +end; + +procedure TEDIFile.LoadFromFile(const FileName: string); +begin + FFileName := FileName; + InternalLoadFromFile; +end; + +procedure TEDIFile.ReLoadFromFile; +begin + InternalLoadFromFile; +end; + +procedure TEDIFile.SaveAsToFile(const FileName: string); +var + EDIFileStream: TFileStream; +begin + FFileName := FileName; + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyNone); + try + EDIFileStream.Write(Pointer(FData)^, Length(FData)); + finally + EDIFileStream.Free; + end; + end + else + raise EJclEDIError.CreateRes(@RsEDIError002); +end; + +procedure TEDIFile.SaveToFile; +var + EDIFileStream: TFileStream; +begin + if FFileName <> '' then + begin + EDIFileStream := TFileStream.Create(FFileName, fmCreate or fmShareDenyNone); + try + EDIFileStream.Write(Pointer(FData)^, Length(FData)); + finally + EDIFileStream.Free; + end; + end + else + raise EJclEDIError.CreateRes(@RsEDIError002); +end; + +procedure TEDIFile.SetInterchangeControl(Index: Integer; Interchange: TEDIInterchangeControl); +begin + SetEDIDataObject(Index, Interchange); +end; + +procedure TEDIFile.InternalDelimitersDetection(StartPos: Integer); +begin + FDelimiters.SS := Copy(FData, StartPos + Length(UNASegmentId), 1); + FDelimiters.ED := Copy(FData, StartPos + Length(UNASegmentId) + 1, 1); + if Copy(FData, StartPos + Length(UNASegmentId) + 5, 2) = AnsiCrLf then + FDelimiters.SD := Copy(FData, StartPos + Length(UNASegmentId) + 5, 2) + else + FDelimiters.SD := Copy(FData, StartPos + Length(UNASegmentId) + 5, 1); +end; + +procedure TEDIFile.InternalAlternateDelimitersDetection(StartPos: Integer); +var + SearchResult, I: Integer; + Delimiter: string; +begin + SearchResult := 1; + FDelimiters.ED := Copy(FData, StartPos + Length(UNBSegmentId), 1); + SearchResult := StrSearch(UNGSegmentId + FDelimiters.ED, FData, SearchResult); + if SearchResult <= 0 then + SearchResult := StrSearch(UNHSegmentId + FDelimiters.ED, FData, 1); + if Copy(FData, SearchResult - 2, 2) = AnsiCrLf then + FDelimiters.SD := Copy(FData, SearchResult - 2, 2) + else + FDelimiters.SD := Copy(FData, SearchResult - 1, 1); + SearchResult := SearchResult - 2; + for I := SearchResult downto 1 do + begin + Delimiter := Copy(FData, I, 1); + if not (Delimiter[1] in + AnsiLetters + AnsiDecDigits + [FDelimiters.ED[1], FDelimiters.SD[1]]) then + begin + FDelimiters.SS := Copy(FData, I, 1); + Break; + end; + end; +end; + +function TEDIFile.InternalCreateInterchangeControl: TEDIInterchangeControl; +begin + Result := TEDIInterchangeControl.Create(Self); +end; + +procedure TEDIFile.DeleteInterchange(Interchange: TEDIInterchangeControl); +begin + DeleteEDIDataObject(Interchange); +end; + +function TEDIFile.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := TEDIDelimiters.Create('''', '+', ':'); +end; + +function TEDIFile.InternalCreateEDIDataObject: TEDIDataObject; +begin + Result := InternalCreateInterchangeControl; +end; + +//=== { TEDICompositeElement } =============================================== + +constructor TEDICompositeElement.Create(Parent: TEDIDataObject; ElementCount: Integer); +begin + if Assigned(Parent) and (Parent is TEDISegment) then + inherited Create(Parent, ElementCount) + else + inherited Create(nil, ElementCount); + FEDIDOT := ediElement; +end; + +destructor TEDICompositeElement.Destroy; +begin + inherited Destroy; +end; + +function TEDICompositeElement.AddElement: Integer; +begin + Result := AddEDIDataObject; +end; + +function TEDICompositeElement.AddElements(Count: Integer): Integer; +begin + Result := AddEDIDataObjects(Count); +end; + +function TEDICompositeElement.AppendElement(Element: TEDIElement): Integer; +begin + Result := AppendEDIDataObject(Element); +end; + +function TEDICompositeElement.AppendElements(ElementArray: TEDIElementArray): Integer; +begin + Result := AppendEDIDataObjects(TEDIDataObjectArray(ElementArray)); +end; + +function TEDICompositeElement.Assemble: string; +var + I: Integer; +begin + FData := ''; + FLength := 0; + Result := ''; + + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError038); + end; + + if GetCount > 0 then + for I := 0 to GetCount - 1 do + if Assigned(FEDIDataObjects[I]) then + begin + if FData <> '' then + FData := FData + FDelimiters.SS + FEDIDataObjects[I].Assemble + else + FData := FData + FEDIDataObjects[I].Assemble; + end + else + begin + // If I is not equal to the last item then add the subelement seperator. + if I <> GetCount - 1 then + FData := FData + FDelimiters.SS; + end; + FLength := Length(FData); + Result := FData; // Return assembled string + + DeleteElements; + + FState := ediAssembled; +end; + +procedure TEDICompositeElement.DeleteElement(Element: TEDIElement); +begin + DeleteEDIDataObject(Element); +end; + +procedure TEDICompositeElement.DeleteElement(Index: Integer); +begin + DeleteEDIDataObject(Index); +end; + +procedure TEDICompositeElement.DeleteElements; +begin + DeleteEDIDataObjects; +end; + +procedure TEDICompositeElement.DeleteElements(Index, Count: Integer); +begin + DeleteEDIDataObjects(Index, Count); +end; + +procedure TEDICompositeElement.Disassemble; +var + StartPos, SearchResult, I: Integer; +begin + DeleteElements; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + begin + FDelimiters := InternalAssignDelimiters; + if not Assigned(FDelimiters) then + raise EJclEDIError.CreateRes(@RsEDIError037); + end; + StartPos := 1; + SearchResult := StrSearch(FDelimiters.SS, FData, StartPos); + while SearchResult > 0 do + begin + I := AddElement; + if (SearchResult - StartPos) > 0 then // data exists + begin + FEDIDataObjects[I].Data := Copy(FData, StartPos, (SearchResult - StartPos)); + FEDIDataObjects[I].Disassemble; + end; + StartPos := SearchResult + 1; + SearchResult := StrSearch(FDelimiters.SS, FData, StartPos); + end; + if StartPos <= Length(FData) then + begin + I := AddElement; + FEDIDataObjects[I].Data := Copy(FData, StartPos, (Length(FData) - StartPos) + 1); + FEDIDataObjects[I].Disassemble; + end; +end; + +function TEDICompositeElement.GetElement(Index: Integer): TEDIElement; +begin + Result := TEDIElement(GetEDIDataObject(Index)); +end; + +function TEDICompositeElement.InsertElement(InsertIndex: Integer): Integer; +begin + Result := InsertEDIDataObject(InsertIndex); +end; + +function TEDICompositeElement.InsertElement(InsertIndex: Integer; Element: TEDIElement): Integer; +begin + Result := InsertEDIDataObject(InsertIndex, Element); +end; + +function TEDICompositeElement.InsertElements(InsertIndex: Integer; + ElementArray: TEDIElementArray): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, TEDIDataObjectArray(ElementArray)); +end; + +function TEDICompositeElement.InsertElements(InsertIndex, Count: Integer): Integer; +begin + Result := InsertEDIDataObjects(InsertIndex, Count); +end; + +function TEDICompositeElement.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + if not Assigned(FDelimiters) then // Attempt to assign the delimiters + // Get the delimiters from the segment + if Assigned(Parent) and (Parent is TEDISegment) then + Result := Parent.Delimiters; +end; + +function TEDICompositeElement.InternalCreateEDIDataObject: TEDIDataObject; +begin + Result := InternalCreateElement; +end; + +function TEDICompositeElement.InternalCreateElement: TEDIElement; +begin + Result := TEDIElement.Create(Self); +end; + +procedure TEDICompositeElement.SetElement(Index: Integer; Element: TEDIElement); +begin + SetEDIDataObject(Index, Element); +end; + +//=== { TEDIMessageLoop } ==================================================== + +// EDI Transaction Set Loop +constructor TEDIMessageLoop.Create(Parent: TEDIDataObject); +begin + inherited Create(Parent); + FCreateObjectType := ediLoop; + FGroupIsParent := False; + if Assigned(Parent) and (Parent is TEDIMessage) then + FParentMessage := TEDIMessage(Parent) + else + if Assigned(Parent) and (Parent is TEDIMessageLoop) then + FParentMessage := TEDIMessageLoop(Parent).ParentMessage + else + FParentMessage := nil; + FEDIDOT := ediLoop; + FEDIDataObjects.OwnsObjects := False; +end; + +destructor TEDIMessageLoop.Destroy; +begin + DeleteEDIDataObjects; + inherited Destroy; +end; + +function TEDIMessageLoop.InternalAssignDelimiters: TEDIDelimiters; +begin + Result := nil; + if FDelimiters = nil then // Attempt to assign the delimiters + if Assigned(FParentMessage) then + Result := FParentMessage.Delimiters; +end; + +function TEDIMessageLoop.InternalCreateEDIDataObject: TEDIDataObject; +begin + case FCreateObjectType of + ediLoop: + begin + Result := TEDIMessageLoop.Create(Self); + TEDIMessageLoop(Result).OwnerLoopId := OwnerLoopId; + TEDIMessageLoop(Result).ParentLoopId := ParentLoopId; + TEDIMessageLoop(Result).Parent := Self; + end; + else + Result := nil; + end; +end; + +function TEDIMessageLoop.Assemble: string; +begin + Result := ''; +end; + +procedure TEDIMessageLoop.Disassemble; +begin + // Do Nothing +end; + +function TEDIMessageLoop.AddLoop(OwnerLoopId, ParentLoopId: string): Integer; +var + Loop: TEDIMessageLoop; +begin + FCreateObjectType := ediLoop; + Loop := TEDIMessageLoop(InternalCreateEDIDataObject); + Loop.OwnerLoopId := OwnerLoopId; + Loop.ParentLoopId := ParentLoopId; + Loop.Parent := Self; + Result := AppendEDIDataObject(Loop); +end; + +procedure TEDIMessageLoop.AppendSegment(Segment: TEDISegment); +begin + AppendEDIDataObject(Segment); +end; + +procedure TEDIMessageLoop.DeleteEDIDataObjects; +var + I: Integer; +begin + for I := 0 to FEDIDataObjects.Count - 1 do + if Assigned(FEDIDataObjects[I]) then + try + // Delete + if FEDIDataObjects[I] is TEDIMessageLoop then + FEDIDataObjects.Item[I].FreeAndNilEDIDataObject + else + // Do not free segments because they are not owned by + FEDIDataObjects[I] := nil; + except + // This exception block was put here to capture the case where FEDIDataObjects[I] was + // actually destroyed prior to destroying this object. + FEDIDataObjects[I] := nil; + end; + // Resize + FEDIDataObjects.Clear; +end; + +function TEDIMessageLoop.FindLoop(LoopId: string; var StartIndex: Integer): TEDIMessageLoop; +var + I, J: Integer; +begin + Result := nil; + J := StartIndex; + for I := StartIndex to GetCount {FEDIDataObjects.Count} - 1 do + begin + StartIndex := I; + if FEDIDataObjects[I] is TEDIMessageLoop then + begin + Result := TEDIMessageLoop(GetEDIDataObject(I)); + if Result.OwnerLoopId = LoopId then + begin + Inc(StartIndex); + Break; + end; + Result := nil; + end; + end; + if Result = nil then + StartIndex := J; +end; + +function TEDIMessageLoop.FindSegment(SegmentId: string; var StartIndex: Integer): TEDISegment; +var + I, J: Integer; +begin + Result := nil; + J := StartIndex; + for I := StartIndex to GetCount {FEDIDataObjects.Count} - 1 do + begin + StartIndex := I; + if FEDIDataObjects[I] is TEDISegment then + begin + Result := TEDISegment(GetEDIDataObject(I)); + if Result.SegmentId = SegmentId then + begin + Inc(StartIndex); + Break; + end; + Result := nil; + end; + end; + if Result = nil then + StartIndex := J; +end; + +function TEDIMessageLoop.FindSegment(SegmentId: string; var StartIndex: Integer; + ElementConditions: TStrings): TEDISegment; +var + I, TrueCount, ElementIndex: Integer; + Name: string; +begin + Result := FindSegment(SegmentId, StartIndex); + while Result <> nil do + begin + TrueCount := 0; + for I := 0 to ElementConditions.Count - 1 do + begin + Name := ElementConditions.Names[I]; + ElementIndex := StrToInt(Name); + if Result[ElementIndex].Data = ElementConditions.Values[Name] then + Inc(TrueCount); + end; + if TrueCount = ElementConditions.Count then + Break; + Result := FindSegment(SegmentId, StartIndex); + end; +end; + +end. diff --git a/official/1.96/source/common/JclEDI_UNEDIFACT_Ext.pas b/official/1.96/source/common/JclEDI_UNEDIFACT_Ext.pas new file mode 100644 index 0000000..703f154 --- /dev/null +++ b/official/1.96/source/common/JclEDI_UNEDIFACT_Ext.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 JclEDI_ANSIX12_Ext.pas. } +{ } +{ The Initial Developer of the Original Code is Raymond Alexander. } +{ Portions created by Raymond Alexander are Copyright (C) Raymond Alexander. All rights reserved. } +{ } +{ Contributor(s): } +{ Raymond Alexander (rayspostbox3) } +{ } +{**************************************************************************************************} +{ } +{ EDI ANSI X12 - Standard Exchange Format (*.sef) File Extensions } +{ } +{ This unit is still in development } +{ } +{ Unit owner: Raymond Alexander } +{ Date created: March 26, 2004 } +{ Additional Info: } +{ E-Mail at RaysDelphiBox3 att hotmail dott com } +{ For latest EDI specific demos see http://sourceforge.net/projects/edisdk } +{ See home page for latest news & events and online help. } +{ } +{**************************************************************************************************} + +// $Id: JclEDI_UNEDIFACT_Ext.pas,v 1.7 2005/03/08 08:33:16 marquardt Exp $ + +unit JclEDI_UNEDIFACT_Ext; + +{$I jcl.inc} + +{$IFDEF SUPPORTS_WEAKPACKAGEUNIT} + {$WEAKPACKAGEUNIT ON} +{$ENDIF SUPPORTS_WEAKPACKAGEUNIT} + +interface + +uses + SysUtils, Classes, Contnrs, JclResources, + JclEDI, JclEDI_UNEDIFACT, JclEDISEF; + +type + +// EDI Transaction Set Document and related types and classes + TEDIMessageDocumentOptions = set of (doLinkSpecToDataObject); + + TEDI_UNEDIFACT_Document = class(TEDIMessageLoop) + private + FEDISEFSet: TEDISEFSet; + protected + FErrorOccured: Boolean; + FEDITSDOptions: TEDIMessageDocumentOptions; + FEDILoopStack: TEDILoopStack; + // References + FEDIMessage: TEDIMessage; + FEDIMessageSpec: TObjectList; + function ValidateSegSpecIndex(DataSegmentId: string; SpecStartIndex: Integer): Integer; + function AdvanceSegSpecIndex(DataIndex, SpecStartIndex, SpecEndIndex: Integer): Integer; + procedure AddLoopToDoc(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); + procedure SetSpecificationPointers(DataSegment: TEDISegment; SpecSegment: TEDISEFSegment); + protected + procedure ValidateData(TSDocument: TEDI_UNEDIFACT_Document; + LoopStack: TEDILoopStack; + DataSegment: TEDISegment; + SpecSegment: TEDISEFSegment; + var DataIndex, SpecIndex: Integer; + var ErrorOccured: Boolean); virtual; + public + constructor Create(Parent: TEDIDataObject; AEDIMessage: TEDIMessage; + SEFSet: TEDISEFSet); reintroduce; + destructor Destroy; override; + // + // ToDo: More procedures and functions to manage internal structures + // + procedure FormatDocument; virtual; + published + property EDITSDOptions: TEDIMessageDocumentOptions read FEDITSDOptions + write FEDITSDOptions; + property ErrorOccured: Boolean read FErrorOccured; + end; + +implementation + +// { TEDI_UNEDIFACT_Document } +constructor TEDI_UNEDIFACT_Document.Create(Parent: TEDIDataObject; + AEDIMessage: TEDIMessage; SEFSet: TEDISEFSet); +begin + inherited Create(Parent); + FEDILoopStack := TEDILoopStack.Create; + FEDILoopStack.OnAddLoop := AddLoopToDoc; + FEDIMessage := AEDIMessage; + FEDISEFSet := SEFSet; + FEDIMessageSpec := SEFSet.GetSegmentObjectList; + FEDITSDOptions := []; +end; + +destructor TEDI_UNEDIFACT_Document.Destroy; +begin + FreeAndNil(FEDILoopStack); + FEDIMessage := nil; + FEDIMessageSpec.Free; + inherited Destroy; +end; + +procedure TEDI_UNEDIFACT_Document.FormatDocument; +var + I, J: Integer; + LSR: TEDILoopStackRecord; + DataSegment: TEDISegment; + SpecSegment: TEDISEFSegment; +begin + I := 0; + J := 0; + if doLinkSpecToDataObject in FEDITSDOptions then + begin + FEDISEFSet.BindTextSets(FEDISEFSet.SEFFile.TEXTSETS); + FEDISEFSet.BindSegmentTextSets; + end; + // Initialize the stack + FEDILoopStack.Flags := FEDILoopStack.Flags - [ediLoopRepeated]; + LSR := FEDILoopStack.ValidateLoopStack(FEDIMessage.Segment[I].SegmentID, + NA_LoopId, NA_LoopId, 0, Self); + // + while (I <= FEDIMessage.SegmentCount - 1) and + (J <= FEDIMessageSpec.Count - 1) do + begin + FEDILoopStack.Flags := FEDILoopStack.Flags - [ediLoopRepeated]; + DataSegment := FEDIMessage.Segment[I]; + // If loop has repeated then move the spec index back + J := ValidateSegSpecIndex(DataSegment.SegmentID, J); + // Check current segment against segment spec + SpecSegment := TEDISEFSegment(FEDIMessageSpec[J]); + if DataSegment.SegmentID = SpecSegment.SegmentID then + begin + // Retrieve the correct record to use from the stack + LSR := FEDILoopStack.ValidateLoopStack(SpecSegment.SegmentID, SpecSegment.OwnerLoopId, + SpecSegment.ParentLoopId, J, LSR.EDIObject); + // + // Debug - Keep the following here in case someone wants to debug what happens to the stack. + // ShowMessage('Current Data Segment: [' + IntToStr(I) + '] ' + DataSegment.SegmentID + #13#10 + + // 'Current Spec Segment: [' + IntToStr(J) + '] ' + SpecSegment.SegmentID + #13#10 + + // FEDILoopStack.Debug); + // + // Do error checking and data validation in decendent class + ValidateData(Self, FEDILoopStack, DataSegment, SpecSegment, I, J, FErrorOccured); + if FErrorOccured then + Exit; + // Process Segment Id + TEDIMessageLoop(LSR.EDIObject).AppendSegment(DataSegment); + // + if doLinkSpecToDataObject in FEDITSDOptions then + begin + SpecSegment.BindTextSets(SpecSegment.SEFFile.TEXTSETS); + SpecSegment.BindElementTextSets; + SetSpecificationPointers(DataSegment, SpecSegment); + end; + // Move to the next data segment + Inc(I); + end + else + begin + // Do error checking and data validation in decendent class + ValidateData(Self, FEDILoopStack, DataSegment, SpecSegment, I, J, FErrorOccured); + if FErrorOccured then + Exit; + // + // Debug - Keep the following here in case someone wants to debug what happens to the stack. + // ShowMessage('Current Data Segment: [' + IntToStr(I) + '] ' + DataSegment.SegmentID + #13#10 + + // 'Current Spec Segment: [' + IntToStr(J) + '] ' + SpecSegment.SegmentID + #13#10 + + // FEDILoopStack.Debug); + // + // Move to the next specification segment + J := AdvanceSegSpecIndex(I, J, FEDIMessageSpec.Count - 1); //Inc(J); + end; + end; +end; + +procedure TEDI_UNEDIFACT_Document.ValidateData(TSDocument: TEDI_UNEDIFACT_Document; + LoopStack: TEDILoopStack; DataSegment: TEDISegment; SpecSegment: TEDISEFSegment; + var DataIndex, SpecIndex: Integer; var ErrorOccured: Boolean); +begin + ErrorOccured := False; +end; + +procedure TEDI_UNEDIFACT_Document.SetSpecificationPointers(DataSegment: TEDISegment; + SpecSegment: TEDISEFSegment); +var + I, J: Integer; +begin + DataSegment.SpecPointer := SpecSegment; + J := SpecSegment.Elements.Count - 1; + for I := 0 to DataSegment.ElementCount - 1 do + begin + if I > J then + raise EJclEDIError.CreateResFmt(@RsEDIError058, + [IntToStr(I), DataSegment.SegmentId, + IntToStr(DataSegment.GetIndexPositionFromParent)]); + DataSegment.EDIDataObject[I].SpecPointer := SpecSegment.Elements[I]; + // ToDo: Assign SubElement Specs + end; +end; + +procedure TEDI_UNEDIFACT_Document.AddLoopToDoc(StackRecord: TEDILoopStackRecord; + SegmentId, OwnerLoopId, ParentLoopId: string; var EDIObject: TEDIObject); +var + I: Integer; + Loop: TEDIMessageLoop; +begin + Loop := TEDIMessageLoop(StackRecord.EDIObject); + I := Loop.AddLoop(OwnerLoopId, ParentLoopId); + EDIObject := TEDIMessageLoop(Loop[I]); +end; + +function TEDI_UNEDIFACT_Document.ValidateSegSpecIndex(DataSegmentId: string; + SpecStartIndex: Integer): Integer; +var + I: Integer; +begin + Result := SpecStartIndex; + // Find the segment in the stack to determine if a loop has repeated + for I := High(FEDILoopStack.Stack) downto Low(FEDILoopStack.Stack) do + begin + if (DataSegmentId = FEDILoopStack.Stack[I].SegmentId) and + (FEDILoopStack.Stack[I].OwnerLoopId <> NA_LoopId) then + begin + FEDILoopStack.Flags := FEDILoopStack.Flags + [ediLoopRepeated]; + Result := FEDILoopStack.Stack[I].SpecStartIndex; + Break; + end; + end; +end; + +function TEDI_UNEDIFACT_Document.AdvanceSegSpecIndex(DataIndex, SpecStartIndex, + SpecEndIndex: Integer): Integer; +var + DataSegment: TEDISegment; + TestSegment: TEDISEFSegment; + I: Integer; +begin + Result := SpecEndIndex + 1; + DataSegment := FEDIMessage.Segment[DataIndex]; + for I := SpecStartIndex + 1 to SpecEndIndex do + begin + TestSegment := TEDISEFSegment(FEDIMessageSpec[I]); + // Find matching segment + if ((DataSegment.SegmentID) = (TestSegment.SegmentID)) then + begin + Result := I; + Break; + end; + end; +end; + +end. diff --git a/official/1.96/source/common/JclExprEval.pas b/official/1.96/source/common/JclExprEval.pas new file mode 100644 index 0000000..a837025 --- /dev/null +++ b/official/1.96/source/common/JclExprEval.pas @@ -0,0 +1,4039 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/04/12 17:04:30 $ +// For history see end of file + +unit JclExprEval; + +{$I jcl.inc} + +interface + +uses + SysUtils, Classes, + JclBase, JclSysUtils, JclStrHashMap, JclResources; + +const + cExprEvalHashSize = 127; + +type + EJclExprEvalError = class(EJclError); + +const + ExprWhiteSpace = [#1..#32]; + +type + TFloat = Double; + PFloat = ^TFloat; + + TFloat32 = Single; + PFloat32 = ^TFloat32; + + TFloat64 = Double; + PFloat64 = ^TFloat64; + + TFloat80 = Extended; + PFloat80 = ^TFloat80; + + TFloatFunc = function: TFloat; + TFloat32Func = function: TFloat32; + TFloat64Func = function: TFloat64; + TFloat80Func = function: TFloat80; + + TUnaryFunc = function(X: TFloat): TFloat; + TUnary32Func = function(X: TFloat32): TFloat32; + TUnary64Func = function(X: TFloat64): TFloat64; + TUnary80Func = function(X: TFloat80): TFloat80; + + TBinaryFunc = function(X, Y: TFloat): TFloat; + TBinary32Func = function(X, Y: TFloat32): TFloat32; + TBinary64Func = function(X, Y: TFloat64): TFloat64; + TBinary80Func = function(X, Y: TFloat80): TFloat80; + + TTernaryFunc = function(X, Y, Z: TFloat): TFloat; + TTernary32Func = function(X, Y, Z: TFloat32): TFloat32; + TTernary64Func = function(X, Y, Z: TFloat64): TFloat64; + TTernary80Func = function(X, Y, Z: TFloat80): TFloat80; + +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; + function LoadVar80(ALoc: PFloat80): TExprNode; virtual; abstract; + + function LoadConst32(AValue: TFloat32): TExprNode; virtual; abstract; + function LoadConst64(AValue: TFloat64): TExprNode; virtual; abstract; + function LoadConst80(AValue: TFloat80): TExprNode; virtual; abstract; + + function CallFloatFunc(AFunc: TFloatFunc): TExprNode; virtual; abstract; + function CallFloat32Func(AFunc: TFloat32Func): TExprNode; virtual; abstract; + function CallFloat64Func(AFunc: TFloat64Func): TExprNode; virtual; abstract; + function CallFloat80Func(AFunc: TFloat80Func): TExprNode; virtual; abstract; + 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; + function CallUnary80Func(AFunc: TUnary80Func; X: TExprNode): TExprNode; virtual; abstract; + 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; + function CallBinary80Func(AFunc: TBinary80Func; X, Y: TExprNode): TExprNode; virtual; abstract; + 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; + function CallTernary80Func(AFunc: TTernary80Func; X, Y, Z: TExprNode): TExprNode; virtual; abstract; + + 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 Negate(AValue: TExprNode): TExprNode; virtual; abstract; + + function Compare(ALeft, ARight: TExprNode): TExprNode; virtual; abstract; + + function LoadVar(ALoc: PFloat32): TExprNode; overload; + function LoadVar(ALoc: PFloat64): TExprNode; overload; + function LoadVar(ALoc: PFloat80): TExprNode; overload; + function LoadConst(AValue: TFloat32): TExprNode; overload; + function LoadConst(AValue: TFloat64): TExprNode; overload; + function LoadConst(AValue: TFloat80): TExprNode; overload; + end; + + TExprCompileParser = class(TObject) + private + FContext: TExprContext; + FLexer: TExprLexer; + FNodeFactory: TExprNodeFactory; + 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; + + // grammar starts here + + function CompileExpr(ASkip: Boolean): TExprNode; virtual; + function CompileSimpleExpr(ASkip: Boolean): TExprNode; + function CompileTerm(ASkip: Boolean): TExprNode; + function CompileSignedFactor(ASkip: Boolean): TExprNode; + function CompileFactor: TExprNode; + function CompileIdentFactor: TExprNode; + end; + + TExprEvalParser = class(TObject) + private + FContext: TExprContext; + FLexer: TExprLexer; + public + constructor Create(ALexer: TExprLexer); + function Evaluate: TFloat; virtual; + + property Lexer: TExprLexer read FLexer; + property Context: TExprContext read FContext write FContext; + + // grammar starts here + + function EvalExpr(ASkip: Boolean): TFloat; virtual; + function EvalSimpleExpr(ASkip: Boolean): TFloat; + function EvalTerm(ASkip: Boolean): TFloat; + function EvalSignedFactor(ASkip: Boolean): TFloat; + function EvalFactor: TFloat; + function EvalIdentFactor: TFloat; + 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; + function LoadVar80(ALoc: PFloat80): TExprNode; override; + function LoadConst32(AValue: TFloat32): TExprNode; override; + function LoadConst64(AValue: TFloat64): TExprNode; override; + function LoadConst80(AValue: TFloat80): TExprNode; override; + + function CallFloatFunc(AFunc: TFloatFunc): TExprNode; override; + function CallFloat32Func(AFunc: TFloat32Func): TExprNode; override; + function CallFloat64Func(AFunc: TFloat64Func): TExprNode; override; + function CallFloat80Func(AFunc: TFloat80Func): TExprNode; override; + function CallUnaryFunc(AFunc: TUnaryFunc; X: TExprNode): TExprNode; override; + function CallUnary32Func(AFunc: TUnary32Func; X: TExprNode): TExprNode; override; + function CallUnary64Func(AFunc: TUnary64Func; X: TExprNode): TExprNode; override; + function CallUnary80Func(AFunc: TUnary80Func; X: TExprNode): TExprNode; override; + 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; + function CallBinary80Func(AFunc: TBinary80Func; X, Y: TExprNode): TExprNode; override; + 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; + function CallTernary80Func(AFunc: TTernary80Func; X, Y, Z: TExprNode): TExprNode; override; + + 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 Negate(AValue: TExprNode): TExprNode; override; + function Compare(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; + + TExprConst80Sym = class(TExprSym) + private + FValue: TFloat80; + public + constructor Create(const AIdent: string; AValue: TFloat80); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + 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; + + TExprVar80Sym = class(TExprSym) + private + FLoc: PFloat80; + public + constructor Create(const AIdent: string; ALoc: PFloat80); + + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + 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; + + TExprFloat80FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TFloat80Func; + public + constructor Create(const AIdent: string; AFunc: TFloat80Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + 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; + + TExprUnary80FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TUnary80Func; + public + constructor Create(const AIdent: string; AFunc: TUnary80Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + 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; + + TExprBinary80FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TBinary80Func; + public + constructor Create(const AIdent: string; AFunc: TBinary80Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + 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; + + TExprTernary80FuncSym = class(TExprAbstractFuncSym) + private + FFunc: TTernary80Func; + public + constructor Create(const AIdent: string; AFunc: TTernary80Func); + function Evaluate: TFloat; override; + function Compile: TExprNode; override; + end; + + 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; + procedure AddVar(const AName: string; var AVar: TFloat80); overload; + + procedure AddConst(const AName: string; AConst: TFloat32); overload; + procedure AddConst(const AName: string; AConst: TFloat64); overload; + procedure AddConst(const AName: string; AConst: TFloat80); overload; + + procedure AddFunc(const AName: string; AFunc: TFloat32Func); overload; + procedure AddFunc(const AName: string; AFunc: TFloat64Func); overload; + procedure AddFunc(const AName: string; AFunc: TFloat80Func); overload; + procedure AddFunc(const AName: string; AFunc: TUnary32Func); overload; + procedure AddFunc(const AName: string; AFunc: TUnary64Func); overload; + procedure AddFunc(const AName: string; AFunc: TUnary80Func); overload; + procedure AddFunc(const AName: string; AFunc: TBinary32Func); overload; + procedure AddFunc(const AName: string; AFunc: TBinary64Func); overload; + procedure AddFunc(const AName: string; AFunc: TBinary80Func); overload; + procedure AddFunc(const AName: string; AFunc: TTernary32Func); overload; + procedure AddFunc(const AName: string; AFunc: TTernary64Func); overload; + procedure AddFunc(const AName: string; AFunc: TTernary80Func); overload; + procedure Remove(const AName: string); + + procedure Clear; + 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; + end; + +implementation + +//=== { 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 + 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 := CompileExpr(False); +end; + +function TExprCompileParser.CompileExpr(ASkip: Boolean): TExprNode; +begin + Result := CompileSimpleExpr(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: // = + begin + // need to return 1 if true, 0 if false + // compare will return 0 if true, -1 / +1 if false + // squaring will force a positive or zero value + // subtract value from 1 to get answer + // IOW: 1 - Sqr(Compare(X, Y)) + + // first, get comparison + Result := NodeFactory.Compare(Result, CompileSimpleExpr(True)); + + // next, square comparison - note that this + // forces a common sub-expression; parse tree will no longer + // be a tree, but a DAG + Result := NodeFactory.Multiply(Result, Result); + + // finally, subtract from one + Result := NodeFactory.Subtract( + NodeFactory.LoadConst32(1), + Result + ); + end; + + etNotEqual: // <> + begin + // same as above, but without the subtract + Result := NodeFactory.Compare(Result, CompileSimpleExpr(True)); + Result := NodeFactory.Multiply(Result, Result); + end; + + etLessThan: // < + begin + // have 1 for less than, 0 for equal, 0 for greater than too + // c = compare(X, Y) + // d = c * c + // if less than, d = 1, c = -1; d - c = 2 + // if greater than, d = c = 1; d - c = 0 + // if equal, d = c = 0; d - c = 0 + // IOW: (Sqr(compare(X, Y)) - compare(X, Y)) / 2 + + // get comparison + Result := NodeFactory.Compare(Result, CompileSimpleExpr(True)); + // subtract from square + Result := NodeFactory.Subtract( + NodeFactory.Multiply( + Result, + Result + ), + Result + ); + // divide by two + Result := NodeFactory.Divide(Result, NodeFactory.LoadConst32(2)); + end; + + etLessEqual: // <= + begin + // less than or equal to return 1, greater than returns 0 + // c = compare(X, Y) + // d = c * c + // < c = -1, d = 1, c + d = 0 + // = c = 0, d = 0, c + d = 0 + // > c = +1, d = 1, c + d = 2 + // then divide by two, take away from 1 + // IOW: 1 - (compare(X, Y) + Sqr(compare(X, Y))) / 2 + Result := NodeFactory.Compare(Result, CompileSimpleExpr(True)); + // now, for some fun! + Result := NodeFactory.Subtract( + NodeFactory.LoadConst32(1), + NodeFactory.Divide( + NodeFactory.Add( + Result, + NodeFactory.Multiply( + Result, + Result + ) + ), + NodeFactory.LoadConst32(2) + ) + ); + end; + + etGreaterThan: // > + begin + // same as <=, without the taking away from 1 bit + Result := NodeFactory.Compare(Result, CompileSimpleExpr(True)); + Result := NodeFactory.Divide( + NodeFactory.Add( + Result, + NodeFactory.Multiply( + Result, + Result + ) + ), + NodeFactory.LoadConst32(2) + ); + end; + + etGreaterEqual: // >= + begin + // same as less than, but subtract from one + Result := NodeFactory.Compare(Result, CompileSimpleExpr(True)); + Result := NodeFactory.Subtract( + NodeFactory.Multiply( + Result, + Result + ), + Result + ); + Result := NodeFactory.Divide(Result, NodeFactory.LoadConst32(2)); + Result := NodeFactory.Subtract(NodeFactory.LoadConst32(1), Result); + end; + else + Break; + end; +end; + +function TExprCompileParser.CompileSimpleExpr(ASkip: Boolean): TExprNode; +begin + Result := CompileTerm(ASkip); + + while True do + case Lexer.CurrTok of + etPlus: + Result := NodeFactory.Add(Result, CompileTerm(True)); + etMinus: + Result := NodeFactory.Subtract(Result, CompileTerm(True)); + else + Break; + end; +end; + +function TExprCompileParser.CompileTerm(ASkip: Boolean): TExprNode; +begin + Result := CompileSignedFactor(ASkip); + + while True do + case Lexer.CurrTok of + etAsterisk: + Result := NodeFactory.Multiply(Result, CompileSignedFactor(True)); + etForwardSlash: + Result := NodeFactory.Divide(Result, CompileSignedFactor(True)); + else + Break; + end; +end; + +function TExprCompileParser.CompileSignedFactor(ASkip: Boolean): TExprNode; +var + Neg: Boolean; +begin + if ASkip then + Lexer.NextTok; + + Neg := False; + while True do + begin + case Lexer.CurrTok of + etPlus: + { do nothing }; + etMinus: + Neg := not Neg; + else + Break; + end; + Lexer.NextTok; + end; + + Result := CompileFactor; + if Neg then + Result := NodeFactory.Negate(Result); +end; + +function TExprCompileParser.CompileFactor: TExprNode; +begin + case Lexer.CurrTok of + etNumber: + begin + Result := NodeFactory.LoadConst64(Lexer.TokenAsNumber); + Lexer.NextTok; + end; + etIdentifier: + Result := CompileIdentFactor; + etLParen: + begin + Result := CompileExpr(True); + if Lexer.CurrTok <> etRParen then + raise EJclExprEvalError.CreateRes(@RsExprEvalRParenExpected); + Lexer.NextTok; + 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 := EvalExpr(False); + + if (Lexer.CurrTok <> etEof) then + begin + raise EJclExprEvalError.CreateResFmt(@RsExprEvalUnknownSymbol, + [Lexer.TokenAsString]); + end; +end; + +function TExprEvalParser.EvalExpr(ASkip: Boolean): TFloat; +begin + Result := EvalSimpleExpr(ASkip); + + while True do + case Lexer.CurrTok of + etEqualTo: // = + if Result = EvalSimpleExpr(True) then + Result := 1.0 + else + Result := 0.0; + etNotEqual: // <> + if Result <> EvalSimpleExpr(True) then + Result := 1.0 + else + Result := 0.0; + etLessThan: // < + if Result < EvalSimpleExpr(True) then + Result := 1.0 + else + Result := 0.0; + etLessEqual: // <= + if Result <= EvalSimpleExpr(True) then + Result := 1.0 + else + Result := 0.0; + etGreaterThan: // > + if Result > EvalSimpleExpr(True) then + Result := 1.0 + else + Result := 0.0; + etGreaterEqual: // >= + if Result >= EvalSimpleExpr(True) then + Result := 1.0 + else + Result := 0.0; + else + Break; + end; +end; + +function TExprEvalParser.EvalSimpleExpr(ASkip: Boolean): TFloat; +begin + Result := EvalTerm(ASkip); + + while True do + case Lexer.CurrTok of + etPlus: + Result := Result + EvalTerm(True); + etMinus: + Result := Result - EvalTerm(True); + else + Break; + end; +end; + +function TExprEvalParser.EvalTerm(ASkip: Boolean): TFloat; +begin + Result := EvalSignedFactor(ASkip); + + while True do + case Lexer.CurrTok of + etAsterisk: + Result := Result * EvalSignedFactor(True); + etForwardSlash: + Result := Result / EvalSignedFactor(True); + else + Break; + end; +end; + +function TExprEvalParser.EvalSignedFactor(ASkip: Boolean): TFloat; +var + Neg: Boolean; +begin + if ASkip then + Lexer.NextTok; + + Neg := False; + while True do + begin + case Lexer.CurrTok of + etPlus: + { do nothing }; + etMinus: + Neg := not Neg; + else + Break; + end; + Lexer.NextTok; + end; + + Result := EvalFactor; + if Neg then + Result := -Result; +end; + +function TExprEvalParser.EvalFactor: TFloat; +begin + case Lexer.CurrTok of + etIdentifier: + begin + Result := EvalIdentFactor; + end; + + etLParen: + begin + Result := EvalExpr(True); + if Lexer.CurrTok <> etRParen then + raise EJclExprEvalError.CreateRes(@RsExprEvalRParenExpected); + Lexer.NextTok; + end; + etNumber: + begin + Result := Lexer.TokenAsNumber; + Lexer.NextTok; + 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 [Char] 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; +begin + cp := FCurrPos; + + { skip whitespace } + while cp^ in ExprWhiteSpace do + Inc(cp); + + { determine token type } + case cp^ of + #0: + FCurrTok := etEof; + 'a'..'z', 'A'..'Z', '_': + begin + start := cp; + Inc(cp); + while cp^ in ['0'..'9', 'a'..'z', 'A'..'Z', '_'] do + Inc(cp); + SetString(FTokenAsString, start, cp - start); + FCurrTok := etIdentifier; + end; + '0'..'9': + begin + start := cp; + + { read in integer part of mantissa } + while cp^ in ['0'..'9'] do + Inc(cp); + + { check for and read in fraction part of mantissa } + if (cp^ = '.') or (cp^ = DecimalSeparator) then + begin + Inc(cp); + while cp^ in ['0'..'9'] do + Inc(cp); + end; + + { check for and read in exponent } + if cp^ in ['e', 'E'] then + begin + Inc(cp); + if cp^ in ['+', '-'] then + Inc(cp); + while cp^ in ['0'..'9'] do + Inc(cp); + end; + + { evaluate number } + SetString(FTokenAsString, start, cp - start); + FTokenAsNumber := StrToFloat(FTokenAsString); + + 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 } + FCurrTok := CharToTokenMap[cp^]; + 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; + +function TExprNodeFactory.LoadVar(ALoc: PFloat80): TExprNode; +begin + Result := LoadVar80(ALoc); +end; + +function TExprNodeFactory.LoadConst(AValue: TFloat32): TExprNode; +begin + Result := LoadConst32(AValue); +end; + +function TExprNodeFactory.LoadConst(AValue: TFloat64): TExprNode; +begin + Result := LoadConst64(AValue); +end; + +function TExprNodeFactory.LoadConst(AValue: TFloat80): TExprNode; +begin + Result := LoadConst80(AValue); +end; + +//=== { 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; + + TExprVarVmOpClass = class of TExprVarVmOp; + + { the var readers } + + TExprVar32VmOp = class(TExprVarVmOp) + public + procedure Execute; override; + end; + + TExprVar64VmOp = class(TExprVarVmOp) + public + procedure Execute; override; + end; + + TExprVar80VmOp = class(TExprVarVmOp) + public + procedure Execute; override; + end; + + { 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; + + TExprCompareVmOp = class(TExprBinaryVmOp) + public + procedure Execute; override; + end; + + { the unary operators } + + TExprNegateVmOp = 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; + + TExprCallFloat80VmOp = class(TExprVirtMachOp) + private + FFunc: TFloat80Func; + public + constructor Create(AFunc: TFloat80Func); + procedure Execute; override; + end; + + 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; + + TExprCallUnary80VmOp = class(TExprVirtMachOp) + private + FFunc: TUnary80Func; + FX: PFloat; + public + constructor Create(AFunc: TUnary80Func; X: PFloat); + procedure Execute; override; + end; + + 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; + + TExprCallBinary80VmOp = class(TExprVirtMachOp) + private + FFunc: TBinary80Func; + FX, FY: PFloat; + public + constructor Create(AFunc: TBinary80Func; X, Y: PFloat); + procedure Execute; override; + end; + + 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; + + TExprCallTernary80VmOp = class(TExprVirtMachOp) + private + FFunc: TTernary80Func; + FX, FY, FZ: PFloat; + public + constructor Create(AFunc: TTernary80Func; X, Y, Z: PFloat); + procedure Execute; override; + end; + +//=== { TExprVar32VmOp } ===================================================== + +procedure TExprVar32VmOp.Execute; +begin + FOutput := PFloat32(FVarLoc)^; +end; + +//=== { TExprVar64VmOp } ===================================================== + +procedure TExprVar64VmOp.Execute; +begin + FOutput := PFloat64(FVarLoc)^; +end; + +//=== { TExprVar80VmOp } ===================================================== + +procedure TExprVar80VmOp.Execute; +begin + FOutput := PFloat80(FVarLoc)^; +end; + +//=== { 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; + +//=== { 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; + +//=== { TExprNegateVmOp } ==================================================== + +procedure TExprNegateVmOp.Execute; +begin + FOutput := - 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; + +//=== { TExprCallFloat80VmOp } =============================================== + +constructor TExprCallFloat80VmOp.Create(AFunc: TFloat80Func); +begin + inherited Create; + FFunc := AFunc; +end; + +procedure TExprCallFloat80VmOp.Execute; +begin + FOutput := FFunc; +end; + +//=== { 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; + +//=== { TExprCallUnary80VmOp } =============================================== + +constructor TExprCallUnary80VmOp.Create(AFunc: TUnary80Func; X: PFloat); +begin + inherited Create; + FFunc := AFunc; + FX := X; +end; + +procedure TExprCallUnary80VmOp.Execute; +begin + FOutput := FFunc(FX^); +end; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +{ 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^[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; + + TExprVar80VmNode = class(TExprVirtMachNode) + private + FValue: PFloat80; + public + constructor Create(AValue: PFloat80); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + 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; + + TExprCallFloat80VmNode = class(TExprVirtMachNode) + private + FFunc: TFloat80Func; + public + constructor Create(AFunc: TFloat80Func); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + 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; + + TExprCallUnary80VmNode = class(TExprVirtMachNode) + private + FFunc: TUnary80Func; + public + constructor Create(AFunc: TUnary80Func; X: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + 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; + + TExprCallBinary80VmNode = class(TExprVirtMachNode) + private + FFunc: TBinary80Func; + public + constructor Create(AFunc: TBinary80Func; X, Y: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + 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; + + TExprCallTernary80VmNode = class(TExprVirtMachNode) + private + FFunc: TTernary80Func; + public + constructor Create(AFunc: TTernary80Func; X, Y, Z: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + + TExprCompareVmNode = class(TExprVirtMachNode) + public + constructor Create(ALeft, ARight: TExprNode); + procedure GenCode(AVirtMach: TExprVirtMach); override; + end; + +//== { 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; + +//=== { 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; + +{ 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; + +function TExprVirtMachNodeFactory.LoadVar80(ALoc: PFloat80): TExprNode; +begin + Result := AddNode(TExprVar80VmNode.Create(ALoc)); +end; + +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; + +function TExprVirtMachNodeFactory.LoadConst80(AValue: TFloat80): TExprNode; +begin + Result := AddNode(TExprConstVmNode.Create(AValue)); +end; + +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.Negate(AValue: TExprNode): TExprNode; +begin + Result := AddNode(TExprUnaryVmNode.Create(TExprNegateVmOp, [AValue])); +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; + +function TExprVirtMachNodeFactory.CallFloat80Func(AFunc: TFloat80Func): TExprNode; +begin + Result := AddNode(TExprCallFloat80VmNode.Create(AFunc)); +end; + +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; + +function TExprVirtMachNodeFactory.CallUnary80Func(AFunc: TUnary80Func; X: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallUnary80VmNode.Create(AFunc, X)); +end; + +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; + +function TExprVirtMachNodeFactory.CallBinary80Func(AFunc: TBinary80Func; X, Y: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallBinary80VmNode.Create(AFunc, X, Y)); +end; + +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; + +function TExprVirtMachNodeFactory.CallTernary80Func(AFunc: TTernary80Func; X, Y, Z: TExprNode): TExprNode; +begin + Result := AddNode(TExprCallTernary80VmNode.Create(AFunc, X, Y, Z)); +end; + +function TExprVirtMachNodeFactory.Compare(ALeft, ARight: TExprNode): TExprNode; +begin + Result := AddNode(TExprCompareVmNode.Create(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; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +//=== { TExprCompareVmNode } ================================================= + +constructor TExprCompareVmNode.Create(ALeft, ARight: TExprNode); +begin + inherited Create([ALeft, ARight]); +end; + +procedure TExprCompareVmNode.GenCode(AVirtMach: TExprVirtMach); +begin + FExprVmCode := TExprCompareVmOp.Create( + VmDeps[0].ExprVmCode.OutputLoc, + VmDeps[1].ExprVmCode.OutputLoc); + AVirtMach.Add(FExprVmCode); +end; + +//=== { TExprAbstractFuncSym } =============================================== + +function TExprAbstractFuncSym.CompileFirstArg: TExprNode; +begin + if Lexer.CurrTok <> etLParen then + raise EJclExprEvalError.CreateRes(@RsExprEvalFirstArg); + Result := CompileParser.CompileExpr(True); +end; + +function TExprAbstractFuncSym.CompileNextArg: TExprNode; +begin + if Lexer.CurrTok <> etComma then + raise EJclExprEvalError.CreateRes(@RsExprEvalNextArg); + Result := CompileParser.CompileExpr(True); +end; + +function TExprAbstractFuncSym.EvalFirstArg: TFloat; +begin + if Lexer.CurrTok <> etLParen then + raise EJclExprEvalError.CreateRes(@RsExprEvalFirstArg); + Result := EvalParser.EvalExpr(True); +end; + +function TExprAbstractFuncSym.EvalNextArg: TFloat; +begin + if Lexer.CurrTok <> etComma then + raise EJclExprEvalError.CreateRes(@RsExprEvalNextArg); + Result := EvalParser.EvalExpr(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; + +//=== { 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; + +//=== { TExprUnaryFuncSym } ================================================== + +constructor TExprUnaryFuncSym.Create(const AIdent: string; AFunc: TUnaryFunc); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprUnaryFuncSym.Compile: TExprNode; +begin + Result := NodeFactory.CallUnaryFunc(FFunc, CompileFirstArg); + EndArgs; +end; + +function TExprUnaryFuncSym.Evaluate: TFloat; +begin + Result := FFunc(EvalFirstArg); + EndArgs; +end; + +//=== { TExprUnary32FuncSym } ================================================ + +constructor TExprUnary32FuncSym.Create(const AIdent: string; AFunc: TUnary32Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprUnary32FuncSym.Compile: TExprNode; +begin + Result := NodeFactory.CallUnary32Func(FFunc, CompileFirstArg); + EndArgs; +end; + +function TExprUnary32FuncSym.Evaluate: TFloat; +begin + Result := FFunc(EvalFirstArg); + EndArgs; +end; + +//=== { TExprUnary64FuncSym } ================================================ + +constructor TExprUnary64FuncSym.Create(const AIdent: string; AFunc: TUnary64Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprUnary64FuncSym.Compile: TExprNode; +begin + Result := NodeFactory.CallUnary64Func(FFunc, CompileFirstArg); + EndArgs; +end; + +function TExprUnary64FuncSym.Evaluate: TFloat; +begin + Result := FFunc(EvalFirstArg); + EndArgs; +end; + +//=== { TExprUnary80FuncSym } ================================================ + +constructor TExprUnary80FuncSym.Create(const AIdent: string; AFunc: TUnary80Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprUnary80FuncSym.Compile: TExprNode; +begin + Result := NodeFactory.CallUnary80Func(FFunc, CompileFirstArg); + EndArgs; +end; + +function TExprUnary80FuncSym.Evaluate: TFloat; +begin + Result := FFunc(EvalFirstArg); + EndArgs; +end; + +//=== { 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; + Result := FFunc(X, Y); + EndArgs; +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; + +//=== { 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; + +//=== { 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; + +//=== { TExprTernary80FuncSym } ============================================== + +constructor TExprTernary80FuncSym.Create(const AIdent: string; AFunc: TTernary80Func); +begin + Assert(Assigned(AFunc)); + inherited Create(AIdent); + FFunc := AFunc; +end; + +function TExprTernary80FuncSym.Compile: TExprNode; +begin + Result := NodeFactory.CallTernary80Func(FFunc, CompileFirstArg, + CompileNextArg, CompileNextArg); + EndArgs; +end; + +function TExprTernary80FuncSym.Evaluate: TFloat; +var + X, Y, Z: TFloat; +begin + X := EvalFirstArg; + Y := EvalNextArg; + Z := EvalNextArg; + EndArgs; + Result := FFunc(X, Y, Z); +end; + +//=== { 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; + +//=== { 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; + +//=== { 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; + +procedure TEasyEvaluator.AddConst(const AName: string; AConst: TFloat80); +begin + FOwnContext.Add(TExprConst80Sym.Create(AName, AConst)); +end; + +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; + +procedure TEasyEvaluator.AddVar(const AName: string; var AVar: TFloat80); +begin + FOwnContext.Add(TExprVar80Sym.Create(AName, @AVar)); +end; + +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; + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TFloat80Func); +begin + FOwnContext.Add(TExprFloat80FuncSym.Create(AName, AFunc)); +end; + +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; + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TUnary80Func); +begin + FOwnContext.Add(TExprUnary80FuncSym.Create(AName, AFunc)); +end; + +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; + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TBinary80Func); +begin + FOwnContext.Add(TExprBinary80FuncSym.Create(AName, AFunc)); +end; + +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; + +procedure TEasyEvaluator.AddFunc(const AName: string; AFunc: TTernary80Func); +begin + FOwnContext.Add(TExprTernary80FuncSym.Create(AName, AFunc)); +end; + +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 + 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 + 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); +end; + +// History: + +// $Log: JclExprEval.pas,v $ +// Revision 1.17 2005/04/12 17:04:30 outchy +// a semicolon at the wrong place (just before an else) +// +// Revision 1.16 2005/04/11 21:46:20 mthoma +// Fixed 0002743. +// +// Revision 1.15 2005/03/08 08:33:16 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.14 2005/02/26 23:27:25 mthoma +// Fixed #150 - a valid expression followed by Rubbish doesn't throw an exception => Now it does. +// +// Revision 1.13 2005/02/26 23:18:46 mthoma +// *** empty log message *** +// +// Revision 1.12 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.11 2005/02/02 04:43:01 rrossmair +// - issue #2522 fixed +// +// Revision 1.10 2004/10/12 17:20:50 rrossmair +// cleanup +// +// Revision 1.9 2004/08/02 15:30:16 marquardt +// hunting down (rom) comments +// +// Revision 1.8 2004/08/01 05:52:11 marquardt +// move constructors/destructors +// +// Revision 1.7 2004/07/03 03:27:48 rrossmair +// documentation extracted to ExprEval.dtx (Doc-O-Matic topic file) +// +// Revision 1.6 2004/06/02 03:23:44 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.5 2004/05/13 07:43:26 rrossmair +// reworked comments for DOM2 inclusion +// +// Revision 1.4 2004/05/05 00:04:11 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, + +end. diff --git a/official/1.96/source/common/JclFileUtils.pas b/official/1.96/source/common/JclFileUtils.pas new file mode 100644 index 0000000..9269eac --- /dev/null +++ b/official/1.96/source/common/JclFileUtils.pas @@ -0,0 +1,6026 @@ +{**************************************************************************************************} +{ } +{ 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: } +{ André Snepvangers (asnepvangers) } +{ Andreas Hausladen (ahuser) } +{ Anthony Steele } +{ Azret Botash } +{ Charlie Calvert } +{ David Hervieux } +{ Florent Ouchet (outchy) } +{ Jeff } +{ 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: 2006/01/25 20:58:24 $ +// For history see end of file + +unit JclFileUtils; + +{$I jcl.inc} +{$IFNDEF CLR} +{$I crossplatform.inc} +{$ENDIF ~CLR} + +interface + +uses + {$IFDEF HAS_UNIT_TYPES} + Types, + {$ENDIF HAS_UNIT_TYPES} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF CLR} + System.Text, System.IO, + {$ENDIF CLR} + {$IFDEF Win32API} + Windows, + {$ENDIF Win32API} + Classes, SysUtils, + JclBase; + +{$IFDEF FPC} +type + PBoolean = System.PBoolean; // as opposed to Windows.PBoolean, which is a pointer to Byte?! +{$ENDIF FPC} +{$IFDEF CLR} +const + ERROR_NO_MORE_FILES = 18; + +type + PBoolean = System.Object; + TFileTime = System.DateTime; +{$ENDIF CLR} + +// replacements for defective Libc.pas declarations +{$IFDEF KYLIX} + +function stat64(FileName: PChar; var StatBuffer: TStatBuf64): Integer; cdecl; +{$EXTERNALSYM stat64} +function fstat64(FileDes: Integer; var StatBuffer: TStatBuf64): Integer; cdecl; +{$EXTERNALSYM fstat64} +function lstat64(FileName: PChar; var StatBuffer: TStatBuf64): Integer; cdecl; +{$EXTERNALSYM lstat64} + +{$ENDIF KYLIX} + +// 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} + PathSeparator = '/'; + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + DriveLetters = ['a'..'z', 'A'..'Z']; + PathDevicePrefix = '\\.\'; + PathSeparator = '\'; + 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}; + + // outchy: why were faVolumeID commented for JCL.NET support? + faRejectedByDefault = faHidden + faSysFile + + {$IFDEF KEEP_DEPRECATED} faVolumeID + {$ENDIF KEEP_DEPRECATED} + faDirectory; + faWindowsSpecific = {$IFDEF KEEP_DEPRECATED} faVolumeID + {$ENDIF KEEP_DEPRECATED} + faArchive + faTemporary + faSparseFile + faReparsePoint + + faCompressed + faOffline + faNotContentIndexed + faEncrypted; + faUnixSpecific = faSymLink; + +type + TCompactPath = ({cpBegin, }cpCenter, cpEnd); + +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 Win32API} +function PathCompactPath(const DC: HDC; const Path: string; const Width: Integer; + CmpFmt: TCompactPath): string; +{$ENDIF Win32API} +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 Win32API} +function PathGetLongName(const Path: string): string; +function PathGetShortName(const Path: string): string; +{$ENDIF Win32API} +function PathGetRelativePath(Origin, Destination: string): string; +function PathGetTempPath: string; +function PathIsAbsolute(const Path: string): Boolean; +function PathIsChild(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; + +// 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; + +function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings): 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); +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); +{$ENDIF MSWINDOWS} +{$IFDEF Win32API} +function CloseVolume(var Volume: THandle): Boolean; +{$IFNDEF FPC} +function DeleteDirectory(const DirectoryName: string; MoveToRecycleBin: Boolean): 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 Win32API} +function DirectoryExists(const Name: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): Boolean; +{$IFDEF CLR} +function FileCreateTemp(var Prefix: string): System.IO.Stream; +{$ELSE ~CLR} +function FileCreateTemp(var Prefix: string): THandle; +{$ENDIF ~CLR} +function FileBackup(const FileName: string; Move: Boolean = False): Boolean; +function FileCopy(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; +function FileDelete(const FileName: string {$IFNDEF CLR}; MoveToRecycleBin: Boolean = False{$ENDIF}): Boolean; +function FileExists(const FileName: string): Boolean; +function FileMove(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; +function FileRestore(const FileName: string): Boolean; +function GetBackupFileName(const FileName: string): string; +function FileGetDisplayName(const FileName: string): string; +{$IFNDEF CLR} +function FileGetGroupName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; +function FileGetOwnerName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; +{$ENDIF ~CLR} +function FileGetSize(const FileName: string): Int64; +function FileGetTempName(const Prefix: string): string; +{$IFDEF Win32API} +function FileGetTypeName(const FileName: string): string; +{$ENDIF Win32API} +function FindUnusedFileName(const FileName, FileExt, Suffix: string): string; +function ForceDirectories(Name: string): Boolean; +function GetDirectorySize(const Path: string): Int64; +{$IFDEF Win32API} +function GetDriveTypeStr(const Drive: Char): string; +function GetFileAgeCoherence(const FileName: string): Boolean; +{$ENDIF Win32API} +procedure GetFileAttributeList(const Items: TStrings; const Attr: Integer); +{$IFDEF Win32API} +procedure GetFileAttributeListEx(const Items: TStrings; const Attr: Integer); +{$ENDIF Win32API} +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} +{$IFNDEF CLR} +function GetModulePath(const Module: HMODULE): string; +{$ENDIF ~CLR} +function GetSizeOfFile(const FileName: string): Int64; overload; +function GetSizeOfFile(const FileInfo: TSearchRec): Int64; overload; +{$IFDEF Win32API} +function GetSizeOfFile(Handle: THandle): Int64; overload; +function GetStandardFileInfo(const FileName: string): TWin32FileAttributeData; +{$ENDIF Win32API} +function IsDirectory(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): Boolean; +function IsRootDirectory(const CanonicFileName: string): Boolean; +{$IFDEF MSWINDOWS} +{$IFNDEF CLR} +function LockVolume(const Volume: string; var Handle: THandle): Boolean; +function OpenVolume(const Drive: Char): THandle; +{$ENDIF ~CLR} +function SetDirLastWrite(const DirName: string; const DateTime: TDateTime): Boolean; +function SetDirLastAccess(const DirName: string; const DateTime: TDateTime): Boolean; +function SetDirCreation(const DirName: string; const DateTime: TDateTime): 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); +{$IFNDEF CLR} +function UnlockVolume(var Handle: THandle): Boolean; +{$ENDIF ~CLR} +{$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; + // outchy: why were these lines commented for JCL.NET support? + {$IFDEF KEEP_DEPRECATED} + property VolumeID: TAttributeInterest index faVolumeID + read GetAttr write SetAttr stored False; + {$ENDIF KEEP_DEPRECATED} + 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) + published + property ReadOnly; + property Hidden; + property System; + property Directory; + property Normal; + {$IFDEF UNIX} + property SymLink; + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + {$IFDEF KEEP_DEPRECATED} + property VolumeID; + {$ENDIF KEEP_DEPRECATED} + property Archive; + property Temporary; + property SparseFile; + property ReparsePoint; + property Compressed; + property OffLine; + property NotContentIndexed; + property Encrypted; + {$ENDIF MSWINDOWS} + end; + +// IJclFileEnumerator / TJclFileEnumerator +// +// Interface / class for thread-based file search +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); + + IJclFileEnumerator = interface + ['{F7E747ED-1C41-441F-B25B-BB314E00C4E9}'] + // property access methods + function GetAttributeMask: TJclFileAttributeMask; + function GetCaseSensitiveSearch: Boolean; + 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 GetRunningTasks: Integer; + function GetSubDirectoryMask: string; + function GetSynchronizationMode: TFileEnumeratorSyncMode; + function GetOnEnterDirectory: TFileHandler; + function GetOnTerminateTask: TFileSearchTerminationEvent; + function GetOption(const Option: TFileSearchOption): Boolean; + function GetOptions: TFileSearchoptions; + procedure SetAttributeMask(const Value: TJclFileAttributeMask); + procedure SetCaseSensitiveSearch(const Value: Boolean); + 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); + 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 CaseSensitiveSearch: Boolean read GetCaseSensitiveSearch write SetCaseSensitiveSearch; + 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; + 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(TPersistent, IJclFileEnumerator) + private + {$IFNDEF CLR} + FOwnerInterface: IInterface; + {$ENDIF ~CLR} + FTasks: TList; + FFileMasks: TStringList; + FRootDirectory: string; + FSubDirectoryMask: string; + FOnEnterDirectory: TFileHandler; + FOnTerminateTask: TFileSearchTerminationEvent; + FNextTaskID: TFileSearchTaskID; + FAttributeMask: TJclFileAttributeMask; + FSynchronizationMode: TFileEnumeratorSyncMode; + FFileSizeMin: Int64; + FFileSizeMax: Int64; + FLastChangeBefore: TDateTime; + FLastChangeAfter: TDateTime; + FOptions: TFileSearchOptions; + FCaseSensitiveSearch: Boolean; + function IsLastChangeAfterStored: Boolean; + function IsLastChangeBeforeStored: Boolean; + function GetNextTaskID: TFileSearchTaskID; + function GetCaseSensitiveSearch: Boolean; + procedure SetCaseSensitiveSearch(const Value: Boolean); + protected + {$IFNDEF CLR} + FRefCount: Integer; + function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall; + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + {$ENDIF ~CLR} + function CreateTask: TThread; + procedure TaskTerminated(Sender: TObject); + // IJclFileEnumerator property access methods + function GetAttributeMask: TJclFileAttributeMask; + 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 GetOption(const Option: TFileSearchOption): Boolean; + function GetOptions: TFileSearchoptions; + function GetRunningTasks: Integer; + function GetSubDirectoryMask: string; + function GetSynchronizationMode: TFileEnumeratorSyncMode; + function GetOnEnterDirectory: TFileHandler; + function GetOnTerminateTask: TFileSearchTerminationEvent; + procedure SetAttributeMask(const Value: TJclFileAttributeMask); + 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); + procedure SetSynchronizationMode(const Value: TFileEnumeratorSyncMode); + procedure SetOnEnterDirectory(const Value: TFileHandler); + procedure SetOnTerminateTask(const Value: TFileSearchTerminationEvent); + property NextTaskID: TFileSearchTaskID read GetNextTaskID; + public + constructor Create; + destructor Destroy; override; + {$IFNDEF CLR} + procedure AfterConstruction; override; + {$ENDIF ~CLR} + 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 CaseSensitiveSearch: Boolean read GetCaseSensitiveSearch write SetCaseSensitiveSearch + default {$IFDEF MSWINDOWS} False {$ELSE} True {$ENDIF}; + property FileMasks: TStrings read GetFileMasks write SetFileMasks; + property RootDirectory: string read FRootDirectory write FRootDirectory; + 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]; + 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 Win32API} + +// 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: string; + 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 GetVersionKeyValue(Index: Integer): string; + public + constructor Attach(VersionInfoData: Pointer; Size: Integer); + constructor Create(const FileName: string); + destructor Destroy; override; + class function VersionLanguageId(const LangIdRec: TLangIdRec): string; + class function VersionLanguageName(const LangId: Word): string; + 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 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 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; + +{$ENDIF Win32API} + +// 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 Win32API} + +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 Win32API} + +// 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 Win32API} + + 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); + constructor Create; + public + 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; + + TJclMappedTextReaderIndex = (tiNoIndex, tiFull); + + {$IFNDEF FPC} + PPCharArray = ^TPCharArray; + TPCharArray = array [0..0] of PChar; + {$ENDIF ~FPC} + + TJclMappedTextReader = class(TPersistent) + private + FContent: PChar; + FEnd: PChar; + FIndex: PPCharArray; + FIndexOption: TJclMappedTextReaderIndex; + FFreeStream: Boolean; + FLastLineNumber: Integer; + FLastPosition: PChar; + FLineCount: Integer; + FMemoryStream: TCustomMemoryStream; + FPosition: PChar; + FSize: Integer; + function GetAsString: string; + function GetEof: Boolean; + function GetChars(Index: Integer): Char; + function GetLineCount: Integer; + function GetLines(LineNumber: Integer): string; + 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): PChar; + function StringFromPosition(var StartPos: PChar): string; + public + constructor Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean = True; + const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; + constructor Create(const FileName: string; + const AIndexOption: TJclMappedTextReaderIndex = tiNoIndex); overload; + destructor Destroy; override; + procedure GoBegin; + function Read: Char; + function ReadLn: string; + property AsString: string read GetAsString; + property Chars[Index: Integer]: Char read GetChars; + property Content: PChar read FContent; + property Eof: Boolean read GetEof; + property IndexOption: TJclMappedTextReaderIndex read FIndexOption; + property Lines[LineNumber: Integer]: string 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; + +{$ENDIF Win32API} + +{ 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} + +{$IFDEF KEEP_DEPRECATED} +// Deprecated, do not use +{$IFDEF Win32API} +function PathGetLongName2(const Path: string): string; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +{$IFNDEF FPC} +function Win32DeleteFile(const FileName: string; MoveToRecycleBin: Boolean): Boolean; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +{$ENDIF ~FPC} +function Win32MoveFileReplaceExisting(const SrcFileName, DstFileName: string): Boolean; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function Win32BackupFile(const FileName: string; Move: Boolean): Boolean; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function Win32RestoreFile(const FileName: string): Boolean; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +{$ENDIF Win32API} + +{$ENDIF KEEP_DEPRECATED} + +implementation + +uses + {$IFDEF Win32API} + ShellApi, + {$IFDEF FPC} + WinSysUt, + {$ELSE ~FPC} + ActiveX, ShlObj, JclShell, + {$ENDIF ~FPC} + JclSysInfo, JclWin32, JclSecurity, + {$ENDIF Win32API} + JclSysUtils, 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. } + +{$IFNDEF RTL140_UP} +const + MinDateTime: TDateTime = -657434.0; { 0100-01-01T00:00:00.000 } + MaxDateTime: TDateTime = 2958465.99999; { 9999-12-31T23:59:59.999 } +{$ENDIF ~RTL140_UP} + +{$IFDEF UNIX} +const + ERROR_NO_MORE_FILES = -1; + INVALID_HANDLE_VALUE = THandle(-1); +{$ENDIF UNIX} + +// replacements for defective Libc.pas declarations +{$IFDEF KYLIX} + +function fstat64(FileDes: Integer; var StatBuffer: TStatBuf64): Integer; +begin + Result := __fxstat64(_STAT_VER, FileDes, StatBuffer); +end; + +function lstat64(FileName: PChar; var StatBuffer: TStatBuf64): Integer; +begin + Result := __lxstat64(_STAT_VER, FileName, StatBuffer); +end; + +function stat64(FileName: PChar; var StatBuffer: TStatBuf64): Integer; +begin + Result := __xstat64(_STAT_VER, FileName, StatBuffer); +end; + +{$ENDIF KYLIX} + +//=== { TJclTempFileStream } ================================================= + +constructor TJclTempFileStream.Create(const Prefix: string); +{$IFNDEF CLR} +var + FileHandle: THandle; +{$ENDIF ~CLR} +begin + {$IFDEF CLR} + inherited Create(FileCreateTemp(FFileName)); + {$ELSE ~CLR} + 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); + {$ENDIF ~CLR} +end; + +destructor TJclTempFileStream.Destroy; +begin + {$IFDEF CLR} + Handle.Close; + {$ELSE ~CLR} + if THandle(Handle) <> INVALID_HANDLE_VALUE then + FileClose(Handle); + {$ENDIF ~CLR} + inherited Destroy; +end; + +//=== { TJclFileMappingView } ================================================ + +{$IFNDEF CLR} +{$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(Longint(Memory) + Longint(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(Longint(Memory) + Longint(Position))^, Count); + Position := Position + Count; + Result := Count; + end; +end; + +//=== { TJclMappedTextReader } =============================================== + +constructor TJclMappedTextReader.Create(MemoryStream: TCustomMemoryStream; FreeStream: Boolean; + const AIndexOption: TJclMappedTextReaderIndex); +begin + inherited Create; + FMemoryStream := MemoryStream; + FFreeStream := FreeStream; + FIndexOption := AIndexOption; + Init; +end; + +constructor TJclMappedTextReader.Create(const FileName: string; + const AIndexOption: TJclMappedTextReaderIndex); +begin + inherited Create; + FMemoryStream := TJclFileMappingStream.Create(FileName); + FFreeStream := True; + FIndexOption := AIndexOption; + Init; +end; + +destructor TJclMappedTextReader.Destroy; +begin + if FFreeStream then + FMemoryStream.Free; + FreeMem(FIndex); + inherited Destroy; +end; + +procedure TJclMappedTextReader.AssignTo(Dest: TPersistent); +begin + if Dest is TStrings then + begin + GoBegin; + TStrings(Dest).BeginUpdate; + try + while not Eof do + TStrings(Dest).Add(ReadLn); + finally + TStrings(Dest).EndUpdate; + end; + end + else + inherited AssignTo(Dest); +end; + +procedure TJclMappedTextReader.CreateIndex; +var + P, LastLineStart: PChar; + I: Integer; +begin + {$RANGECHECKS OFF} + P := FContent; + I := 0; + LastLineStart := P; + while P < FEnd do + begin + if P^ = AnsiLineFeed then + begin + if I and $FFFF = 0 then + ReallocMem(FIndex, (I + $10000) * SizeOf(Pointer)); + FIndex[I] := LastLineStart; + Inc(I); + LastLineStart := P + 1; + end; + 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 TJclMappedTextReader.GetEof: Boolean; +begin + Result := FPosition >= FEnd; +end; + +function TJclMappedTextReader.GetAsString: string; +begin + SetString(Result, Content, Size); +end; + +function TJclMappedTextReader.GetChars(Index: Integer): Char; +begin + if (Index < 0) or (Index >= Size) then + raise EJclError.CreateRes(@RsFileIndexOutOfRange); + Result := Char(PByte(FContent + Index)^); +end; + +function TJclMappedTextReader.GetLineCount: Integer; + + function CountLines(P: PChar; Len: Integer): Integer; + {$IFDEF PUREPASCAL} + var + I: Integer; + begin + Result := 0; + for I := 0 to Len-1 do + begin + if P^ = AnsiLineFeed then + Inc(Result); + Inc(P); + end; + end; + {$ELSE ~PUREPASCAL} + asm + PUSH EDI + MOV EDI, EAX + MOV ECX, EDX + MOV EAX, AnsiLineFeed + XOR EDX, EDX + @@1: REPNZ SCASB + INC EDX + OR ECX, ECX + JNZ @@1 + MOV EAX, EDX + POP EDI + end; + {$ENDIF ~PUREPASCAL} + +begin + if FLineCount = -1 then + FLineCount := CountLines(FContent, FSize); + Result := FLineCount; +end; + +function TJclMappedTextReader.GetLines(LineNumber: Integer): string; +var + P: PChar; +begin + P := PtrFromLine(LineNumber); + Result := StringFromPosition(P); +end; + +function TJclMappedTextReader.GetPosition: Integer; +begin + Result := FPosition - FContent; +end; + +procedure TJclMappedTextReader.GoBegin; +begin + Position := 0; +end; + +procedure TJclMappedTextReader.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 TJclMappedTextReader.GetPositionFromLine(LineNumber: Integer): Integer; +var + P: PChar; +begin + P := PtrFromLine(LineNumber); + if P = nil then + Result := -1 + else + Result := P - FContent; +end; + +function TJclMappedTextReader.PtrFromLine(LineNumber: Integer): PChar; +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 + if Result^ = AnsiLineFeed then + Dec(LineOffset); + Inc(Result); + end; + end + else + if LineOffset < 0 then + begin + Result := FLastPosition; + while (Result >= FContent) and (LineOffset < 1) do + begin + if Result^ = AnsiLineFeed then + Inc(LineOffset); + Dec(Result); + end; + Inc(Result, 2); + end; + FLastLineNumber := LineNumber; + FLastPosition := Result; + end; +end; + +function TJclMappedTextReader.Read: Char; +begin + if FPosition >= FEnd then + Result := #0 + else + begin + Result := FPosition^; + Inc(FPosition); + end; +end; + +function TJclMappedTextReader.ReadLn: string; +begin + Result := StringFromPosition(FPosition); +end; + +procedure TJclMappedTextReader.SetPosition(const Value: Integer); +begin + FPosition := FContent + Value; +end; + +function TJclMappedTextReader.StringFromPosition(var StartPos: PChar): string; +var + P, StringEnd: PChar; +begin + if (StartPos = nil) or (StartPos >= FEnd) then + Result := '' + else + begin + P := StartPos; + while (P < FEnd) and (P^ <> AnsiLineFeed) do + Inc(P); + if (P > FContent) and ((P - 1)^ = AnsiCarriageReturn) then + StringEnd := P - 1 + else + StringEnd := P; + SetString(Result, StartPos, StringEnd - StartPos); + StartPos := P + 1; + end; +end; + +{$ENDIF ~CLR} +{$ENDIF MSWINDOWS} + +//=== Path manipulation ====================================================== + +function PathAddSeparator(const Path: string): string; +begin + Result := Path; + {$IFDEF CLR} + if (Path = '') or (Path[Length(Path)] <> PathSeparator) then + {$ELSE} + if (Path = '') or (AnsiLastChar(Path) <> PathSeparator) then + {$ENDIF} + Result := Path + PathSeparator; +end; + +function PathAddExtension(const Path, Extension: string): string; +begin + Result := Path; + if (Path <> '') and (ExtractFileExt(Path) = '') and (Extension <> '') then + begin + // Note that if we get here Path is guarenteed not to end in a '.' otherwise ExtractFileExt + // would have returned '.' therefore there's no need to check it explicitly in the code below + 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] = PathSeparator; + B2 := Append[1] = PathSeparator; + if B1 and B2 then + Result := Copy(Path, 1, PathLength - 1) + Append + else + begin + if not (B1 or B2) then + Result := Path + PathSeparator + Append + else + Result := Path + Append; + end; + end; + end; +end; + +function PathBuildRoot(const Drive: Byte): string; +begin + {$IFDEF UNIX} + Result := PathSeparator; + {$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 + {$IFDEF CLR} + raise EJclPathError.CreateFmt(RsPathInvalidDrive, [IntToStr(Drive)]); + {$ELSE} + raise EJclPathError.CreateResFmt(@RsPathInvalidDrive, [IntToStr(Drive)]); + {$ENDIF} + {$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(PathSeparator, Path); + IsAbsolute := K - I = 1; + if not IsAbsolute then + K := I; + if K = 0 then + S := Path + else + S := Copy(Path, K + 1, Length(Path)); + List := TStringList.Create; + try + StrIToStrings(S, PathSeparator, List, False); + 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, PathSeparator, False); + 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; +{$IFDEF CLR} +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] in [PathSeparator, ':'] then + LastSeparator := Result; + Inc(Index1); + Inc(Index2); + end; + if (LastSeparator < Result) and (Index1 <= LenS1) then + Result := LastSeparator; + end; +end; +{$ELSE ~CLR} +var + P1, P2: PChar; + LastSeparator: Integer; +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 + P1 := @Path1[1]; + P2 := @Path2[1]; + end + else + begin + P1 := @Path2[1]; + P2 := @Path1[1]; + end; + LastSeparator := 0; + while (P1^ = P2^) and (P1^ <> #0) do + begin + Inc(Result); + if P1^ in [PathSeparator, ':'] then + LastSeparator := Result; + Inc(P1); + Inc(P2); + end; + if (LastSeparator < Result) and (P1^ <> #0) then + Result := LastSeparator; + end; +end; +{$ENDIF ~CLR} + +{$IFDEF Win32API} +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 Win32API} + +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] = PathSeparator) 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, '\', List, True); + I := Depth + 1; + if PathIsUNC(LocalPath) then + I := I + 2; + while I < List.Count do + List.Delete(I); + Result := PathAddSeparator(StringsToStr(List, '\', 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, '\', 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 Win32API} + +{$IFDEF KEEP_DEPRECATED} + +function PathGetLongName2(const Path: string): string; +begin + Result := PathGetLongName(Path); +end; + +{$ENDIF KEEP_DEPRECATED} + +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; + AnsiName: string; + WideName: array [0..MAX_PATH] of WideChar; + Eaten, Attr: ULONG; // both unused but API requires them (incorrect translation) +begin + Result := Path; + if Path <> '' then + begin + if Succeeded(SHGetDesktopFolder(Desktop)) then + begin + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(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; + 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, 'GetLongPathNameA'); + 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 Win32API} + +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] = PathSeparator); + end; + {$ELSE ~MSWINDOWS} + begin + Result := Pos(PathSeparator, Path) = 1; + end; + {$ENDIF ~MSWINDOWS} + + function Equal(const Path1, Path2: string): Boolean; + begin + {$IFDEF MSWINDOWS} // case insensitive + Result := AnsiSameText(Path1, Path2); + {$ELSE} // case sensitive + Result := Path1 = Path2; + {$ENDIF} + 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('\', Destination) = 1) then + Result := OrigDrive + Destination // prepend drive part from Origin + else + {$ENDIF MSWINDOWS} + if StartsFromRoot(Origin) and not StartsFromRoot(Destination) then + Result := StrEnsureSuffix(PathSeparator, Origin) + + StrEnsureNoPrefix(PathSeparator, 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, PathSeparator, OrigList); + StrToStrings(Destination, PathSeparator, DestList); + 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('..' + PathSeparator, OrigList.Count - DiffIndex); + Result := PathRemoveSeparator(Result); + for I := DiffIndex to DestList.Count - 1 do + begin + if Result <> '' then + Result := Result + PathSeparator; + Result := Result + DestList[i]; + end; + end; + finally + DestList.Free; + OrigList.Free; + end; + end; +end; + +function PathGetTempPath: string; +{$IFDEF CLR} +begin + Result := Path.GetTempPath; +end; +{$ELSE ~CLR} +{$IFDEF MSWINDOWS} +var + BufSize: Cardinal; +begin + BufSize := Windows.GetTempPath(0, nil); + SetLength(Result, BufSize); + { TODO : Check length (-1 or not) } + Windows.GetTempPath(BufSize, PChar(Result)); + StrResetLength(Result); +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +begin + Result := GetEnvironmentVariable('TMPDIR'); +end; +{$ENDIF UNIX} +{$ENDIF ~CLR} + +function PathIsAbsolute(const Path: string): Boolean; +{$IFDEF CLR} +begin + Result := System.IO.Path.IsPathRooted(Path); +end; +{$ELSE ~CLR} +{$IFDEF MSWINDOWS} +var + I: Integer; +{$ENDIF MSWINDOWS} +begin + Result := False; + if Path <> '' then + begin + {$IFDEF UNIX} + Result := (Path[1] = PathSeparator); + {$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 (Path[I + 1] in DriveLetters) and + (Path[I + 2] = ':') and (Path[I + 3] = PathSeparator); + end + else + Result := True; + {$ENDIF MSWINDOWS} + end; +end; +{$ENDIF ~CLR} + +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 CLR} + if System.Environment.get_OSVersion.Platform <= PlatformID.WinCE then + Result := SameText(StrLeft(P, L), B) and (P[L+1] = PathSeparator) + else + Result := (StrLeft(P, L) = B) and (P[L+1] = PathSeparator); + {$ELSE ~CLR} + {$IFDEF MSWINDOWS} + Result := AnsiSameText(StrLeft(P, L), B) and (P[L+1] = PathSeparator); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Result := AnsiSameStr(StrLeft(P, L), B) and (P[L+1] = PathSeparator); + {$ENDIF UNIX} + {$ENDIF ~CLR} +end; + +function PathIsDiskDevice(const Path: string): Boolean; +{$IFDEF UNIX} +var + FullPath: string; + F: PIOFile; + Buffer: array [0..255] of Char; + 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 PathIsUNC(const Path: string): Boolean; + +{$IFDEF MSWINDOWS} + +const + cUNCSuffix = '?\UNC'; + +var + {$IFDEF CLR} + Index, LenPath: Integer; + {$ELSE} + P: PChar; + {$ENDIF} + + function AbsorbSeparator: Boolean; + begin + {$IFDEF CLR} + Result := (Index <> 0) and (Path[Index] = PathSeparator); + if Result then + Inc(Index); + {$ELSE ~CLR} + Result := (P <> nil) and (P^ = PathSeparator); + if Result then + Inc(P); + {$ENDIF ~CLR} + 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; + {$IFDEF CLR} + while (Index <= LenPath) and (Path[Index] <> PathSeparator) do + begin + if AnsiChar(Path[Index]) in ['a'..'z', 'A'..'Z', '-', '_', '.'] then + begin + NonDigitFound := True; + Inc(Index); + end + else + if AnsiChar(Path[Index]) in AnsiDecDigits then + Inc(Index) + else + begin + Result := False; + Break; + end; + end; + {$ELSE ~CLR} + while (P^ <> #0) and (P^ <> PathSeparator) do + begin + if P^ in ['a'..'z', 'A'..'Z', '-', '_', '.'] then + begin + NonDigitFound := True; + Inc(P); + end + else + if P^ in AnsiDecDigits then + Inc(P) + else + begin + Result := False; + Break; + end; + end; + {$ENDIF ~CLR} + Result := Result and NonDigitFound; + end; + + function AbsorbShareName: Boolean; + const + InvalidCharacters = + ['<', '>', '?', '/', ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''']; + 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; + {$IFDEF CLR} + while (Index <= LenPath) and (Path[Index] <> '\') do + begin + if AnsiChar(Path[Index]) in InvalidCharacters then + begin + Result := False; + Break; + end; + Inc(Index); + end; + {$ELSE ~CLR} + while (P^ <> #0) and (P^ <> '\') do + begin + if P^ in InvalidCharacters then + begin + Result := False; + Break; + end; + Inc(P); + end; + {$ENDIF ~CLR} + end; + +begin + Result := Copy(Path, 1, Length(PathUncPrefix)) = PathUncPrefix; + if Result then + begin + {$IFDEF CLR} + Index := Length(PathUncPrefix); + if Path.StartsWith(PathUncPrefix + cUNCSuffix) then + Inc(Index, Length(cUNCSuffix)) + else + Result := AbsorbSeparator and AbsorbMachineName; + {$ELSE ~CLR} + 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; + {$ENDIF ~CLR} + 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; +{$IFNDEF CLR} +var + L: Integer; +{$ENDIF ~CLR} +begin + {$IFDEF CLR} + Result := ExcludeTrailingPathDelimiter(Path); + {$ELSE ~CLR} + L := Length(Path); + if (L <> 0) and (AnsiLastChar(Path) = PathSeparator) then + Result := Copy(Path, 1, L - 1) + else + Result := Path; + {$ENDIF ~CLR} +end; + +function PathRemoveExtension(const Path: string): string; +var + I: Integer; +begin + I := LastDelimiter(':.' + PathSeparator, Path); + if (I > 0) and (Path[I] = '.') then + Result := Copy(Path, 1, I - 1) + else + Result := Path; +end; + +//=== 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): Boolean; +var + SearchRec: TSearchRec; + R, x: Integer; + MaskList: TStringList; + Masks: string; +begin + Assert(List <> nil); + MaskList := TStringList.Create; + Result := false; + try + + {* extract the FileMasks portion out of Path *} + Masks := StrAfter(PathAddSeparator(ExtractFileDir(Path)), Path); + + {* put the Masks into TStringlist *} + StrTokenToStrings(Masks, ';', MaskList); + + {* search with every single FileMask *} + for x := 0 to MaskList.Count - 1 do + begin + R := FindFirst(PathAddSeparator(ExtractFileDir(Path)) + + Trim(MaskList[x]), Attr, SearchRec); + Result := R = 0; + List.BeginUpdate; + try + if Result then + begin + while R = 0 do + begin + if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') + and ((SearchRec.Attr and Attr) = SearchRec.Attr) then + List.Add(SearchRec.Name); + R := FindNext(SearchRec); + end; + Result := R = ERROR_NO_MORE_FILES; + end; + finally + SysUtils.FindClose(SearchRec); + List.EndUpdate; + end; + end; + finally + MaskList.Free; + end; +end; + +{$IFDEF MSWINDOWS} + +procedure CreateEmptyFile(const FileName: string); +{$IFDEF CLR} +begin + &File.CreateText(FileName).Close; +end; +{$ELSE ~CLR} +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 ~CLR} +{$ENDIF MSWINDOWS} + +{$IFDEF Win32API} + +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 +{ TODO -cHelp : Author: Jeff (but FileUtils.dtx says "Donator: Anthony Steele". Excuse me?) } + +function DeleteDirectory(const DirectoryName: string; MoveToRecycleBin: Boolean): Boolean; +begin + if MoveToRecycleBin then + Result := SHDeleteFolder(0, DirectoryName, [doSilent, doAllowUndo]) + else + Result := DelTree(DirectoryName); +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 + '\' + 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 Win32API} + +{$IFDEF CLR} +function DirectoryExists(const Name: string): Boolean; +begin + Result := System.IO.Directory.Exists(Name); +end; +{$ELSE ~CLR} +{$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} +{$ENDIF ~CLR} + +{$IFDEF Win32API} +function DiskInDrive(Drive: Char): Boolean; +var + ErrorMode: Cardinal; +begin + Result := False; + Assert(Drive in DriveLetters); + if Drive in DriveLetters then + begin + if Drive in AnsiLowercaseLetters then + Dec(Drive, $20); + { 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 Win32API} + +{$IFNDEF CLR} +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} +{$ENDIF ~CLR} +{$IFDEF CLR} +function FileCreateTemp(var Prefix: string): System.IO.Stream; +begin + Result := &File.Open(Path.GetTempFileName, FileMode.Open); +end; +{$ENDIF CLR} + +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 CLR} + Result := True; + try + &File.Copy(ExistingFileName, NewFileName, not ReplaceExisting); + except + // not the nice way + Result := False; + end; + {$ELSE ~CLR} + {$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} + {$ENDIF ~CLR} +end; + +function FileDelete(const FileName: string {$IFNDEF CLR}; MoveToRecycleBin: Boolean = False{$ENDIF}): Boolean; +{$IFDEF CLR} +begin + Result := True; + try + System.IO.&File.Delete(FileName); + except + // not the nice way + Result := False; + end +end; +{$ELSE ~CLR} +{$IFDEF MSWINDOWS} + { TODO -cHelp : Author: Jeff (but FileUtils.dtx says "Donator: Marcel van Brakel". Excuse me?) } +begin + {$IFNDEF FPC} // needs JclShell + if MoveToRecycleBin then + Result := SHDeleteFiles(0, FileName, [doSilent, doAllowUndo, doFilesOnly]) + else + {$ENDIF ~FPC} + Result := 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} +{$ENDIF ~CLR} + +function FileExists(const FileName: string): Boolean; +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} +var + Attr: Cardinal; +{$ENDIF MSWINDOWS} +{$ENDIF CLR} +begin + {$IFDEF CLR} + Result := &File.Exists(FileName); + {$ELSE ~CLR} + {$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} + // Attempt to access the file, doesn't matter how, using FileGetSize is as good as anything else. + Result := FileGetSize(FileName) <> -1; + {$ENDIF MSWINDOWS} + {$ENDIF ~CLR} +end; + +function FileMove(const ExistingFileName, NewFileName: string; ReplaceExisting: Boolean = False): Boolean; +{$IFDEF CLR} +begin + if not ReplaceExisting and &File.Exists(NewFileName) then + Result := False + else + begin + Result := True; + try + &File.Move(ExistingFileName, NewFileName); + except + // not the nice way + Result := False; + end; + end; +end; +{$ELSE ~CLR} +{$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; +{$ENDIF ~CLR} + +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 FileGetDisplayName(const FileName: string): string; +{$IFDEF Win32API} +var + FileInfo: TSHFileInfo; +begin + FillChar(FileInfo, SizeOf(FileInfo), #0); + if SHGetFileInfo(PChar(FileName), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME) <> 0 then + Result := FileInfo.szDisplayName + else + Result := FileName; +end; +{$ELSE ~Win32API} +begin + { TODO -cHelp : mention this reduced solution } + Result := FileName; +end; +{$ENDIF ~Win32API} + +{$IFNDEF CLR} +function FileGetGroupName(const FileName: string {$IFDEF UNIX}; ResolveSymLinks: Boolean = True {$ENDIF}): string; +{$IFDEF MSWINDOWS} +var + DomainName: string; + pSD: PSecurityDescriptor; + BufSize: DWORD; +begin + if IsWinNT then + begin + 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(Integer(pSD) + Integer(pSD^.Group)), Result, DomainName); + FreeMem(pSD); + Result := Trim(Result); + 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: string; + pSD: PSecurityDescriptor; + BufSize: DWORD; +begin + if IsWinNT then + begin + GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION, nil, 0, BufSize); + if BufSize > 0 then + begin + GetMem(pSD, BufSize); + GetFileSecurity(PChar(FileName), OWNER_SECURITY_INFORMATION, + pSD, BufSize, BufSize); + LookupAccountBySid(Pointer(Integer(pSD) + Integer(pSD^.Owner)), Result, DomainName); + FreeMem(pSD); + Result := Trim(Result); + 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} +{$ENDIF ~CLR} + +function FileGetSize(const FileName: string): Int64; +{$IFDEF CLR} +begin + Result := -1; + if &File.Exists(FileName) then + Result := FileInfo.Create(FileName).Length; +end; +{$ELSE ~CLR} +{$IFDEF MSWINDOWS} +var + SearchRec: TSearchRec; + OldMode: Cardinal; + Size: TULargeInteger; +begin + Result := -1; + OldMode := SetErrorMode(SEM_FAILCRITICALERRORS); + try + if FindFirst(FileName, faAnyFile, SearchRec) = 0 then + begin + Size.LowPart := SearchRec.FindData.nFileSizeLow; + Size.HighPart := SearchRec.FindData.nFileSizeHigh; + Result := Size.QuadPart; + SysUtils.FindClose(SearchRec); + 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} +{$ENDIF ~CLR} + +{$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} + +function FileGetTempName(const Prefix: string): string; +{$IFDEF CLR} +begin + Result := Path.GetTempFileName; + &File.Delete(Result); + Result := Path.GetDirectoryName(Result) + Path.PathSeparator + Prefix + Path.GetFileName(Result); +end; +{$ELSE ~CLR} +{$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} +{$ENDIF ~CLR} + +{$IFDEF Win32API} +function FileGetTypeName(const FileName: string): string; +var + FileInfo: TSHFileInfo; + RetVal: DWORD; +begin + FillChar(FileInfo, SizeOf(FileInfo), #0); + 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) + RsDefaultFileTypeName); + end; +end; +{$ENDIF Win32API} + +function FindUnusedFileName(const FileName, FileExt, Suffix: string): string; +var + I: Integer; +begin + Result := PathAddExtension(FileName, FileExt); + I := 0; + while FileExists(Result) do + begin + Inc(I); + Result := PathAddExtension(FileName + Suffix + IntToStr(I), FileExt); + end; +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 + {$IFDEF CLR} + raise EJclFileUtilsError.Create(RsCannotCreateDir); + {$ELSE} + raise EJclFileUtilsError.CreateRes(@RsCannotCreateDir); + {$ENDIF} + 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} + if ExtractPath = '' then + Result := CreateDir(Name) + else + Result := ForceDirectories(ExtractPath) and CreateDir(Name); +end; + +function GetDirectorySize(const Path: string): Int64; + + function RecurseFolder(const Path: string): Int64; + var + F: TSearchRec; + R: Integer; + {$IFNDEF CLR} + {$IFDEF MSWINDOWS} + TempSize: TULargeInteger; + {$ENDIF MSWINDOWS} + {$ENDIF ~CLR} + begin + Result := 0; + R := 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 + '\')) + else + {$IFDEF MSWINDOWS} + begin + {$IFDEF CLR} + Inc(Result, (Int64(F.FindData.nFileSizeHigh) shl 32) or F.FindData.nFileSizeLow); + {$ELSE ~CLR} + TempSize.LowPart := F.FindData.nFileSizeLow; + TempSize.HighPart := F.FindData.nFileSizeHigh; + Inc(Result, TempSize.QuadPart); + {$ENDIF ~CLR} + end; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + // SysUtils.Find* don't perceive files >= 2 GB anyway + Inc(Result, Int64(F.Size)); + {$ENDIF UNIX} + end; + R := SysUtils.FindNext(F); + end; + {$IFNDEF CLR} + if R <> ERROR_NO_MORE_FILES then + Abort; + {$ENDIF ~CLR} + finally + 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 Win32API} + +function GetDriveTypeStr(const Drive: Char): string; +var + DriveType: Integer; + DriveStr: string; +begin + if not (Drive in DriveLetters) then + raise EJclPathError.CreateResFmt(@RsPathInvalidDrive, [Drive]); + DriveStr := Drive + ':\'; + DriveType := GetDriveType(PChar(DriveStr)); + case DriveType of + DRIVE_REMOVABLE: + Result := RsRemovableDrive; + DRIVE_FIXED: + Result := RsHardDisk; + DRIVE_REMOTE: + Result := RsRemoteDrive; + DRIVE_CDROM: + Result := RsCDRomDrive; + DRIVE_RAMDISK: + Result := RsRamDisk; + else + Result := RsUnknownDrive; + end; +end; + +function GetFileAgeCoherence(const FileName: string): Boolean; +var + Handle: THandle; + FindData: TWin32FindData; +begin + Result := False; + Handle := FindFirstFile(PChar(FileName), FindData); + if Handle <> INVALID_HANDLE_VALUE then + begin + Windows.FindClose(Handle); + {$IFDEF FPC} + Result := CompareFileTime(@FindData.ftCreationTime, @FindData.ftLastWriteTime) <= 0; + {$ELSE ~FPC} + Result := CompareFileTime(FindData.ftCreationTime, FindData.ftLastWriteTime) <= 0; + {$ENDIF ~FPC} + end; +end; + +{$ENDIF Win32API} + +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(RsAttrDirectory); + if Attr and faReadOnly = faReadOnly then + Items.Add(RsAttrReadOnly); + if Attr and faSysFile = faSysFile then + Items.Add(RsAttrSystemFile); + {$IFDEF KEEP_DEPRECATED} + if Attr and faVolumeID = faVolumeID then + Items.Add(RsAttrVolumeID); + {$ENDIF KEEP_DEPRECATED} + if Attr and faArchive = faArchive then + Items.Add(RsAttrArchive); + if Attr and faAnyFile = faAnyFile then + Items.Add(RsAttrAnyFile); + if Attr and faHidden = faHidden then + Items.Add(RsAttrHidden); + finally + Items.EndUpdate; + end; +end; + +{$IFDEF Win32API} + +{ 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(RsAttrReadOnly); + if Attr and FILE_ATTRIBUTE_HIDDEN = FILE_ATTRIBUTE_HIDDEN then + Items.Add(RsAttrHidden); + if Attr and FILE_ATTRIBUTE_SYSTEM = FILE_ATTRIBUTE_SYSTEM then + Items.Add(RsAttrSystemFile); + if Attr and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then + Items.Add(RsAttrDirectory); + if Attr and FILE_ATTRIBUTE_ARCHIVE = FILE_ATTRIBUTE_ARCHIVE then + Items.Add(RsAttrArchive); + if Attr and FILE_ATTRIBUTE_NORMAL = FILE_ATTRIBUTE_NORMAL then + Items.Add(RsAttrNormal); + if Attr and FILE_ATTRIBUTE_TEMPORARY = FILE_ATTRIBUTE_TEMPORARY then + Items.Add(RsAttrTemporary); + if Attr and FILE_ATTRIBUTE_COMPRESSED = FILE_ATTRIBUTE_COMPRESSED then + Items.Add(RsAttrCompressed); + if Attr and FILE_ATTRIBUTE_OFFLINE = FILE_ATTRIBUTE_OFFLINE then + Items.Add(RsAttrOffline); + if Attr and FILE_ATTRIBUTE_ENCRYPTED = FILE_ATTRIBUTE_ENCRYPTED then + Items.Add(RsAttrEncrypted); + if Attr and FILE_ATTRIBUTE_REPARSE_POINT = FILE_ATTRIBUTE_REPARSE_POINT then + Items.Add(RsAttrReparsePoint); + if Attr and FILE_ATTRIBUTE_SPARSE_FILE = FILE_ATTRIBUTE_SPARSE_FILE then + Items.Add(RsAttrSparseFile); + finally + Items.EndUpdate; + end; +end; + +{$ENDIF Win32API} + +function GetFileInformation(const FileName: string; out FileInfo: TSearchRec): Boolean; +begin + Result := FindFirst(FileName, faAnyFile, FileInfo) = 0; + if Result then + 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 + {$IFDEF CLR} + Result := &File.GetLastWriteTimeUtc(FileName); + {$ELSE} + Result := GetFileInformation(FileName).FindData.ftLastWriteTime; + {$ENDIF} +end; + +function GetFileLastWrite(const FileName: string; out LocalTime: TDateTime): Boolean; +{$IFNDEF CLR} +var + FileInfo: TSearchRec; +{$ENDIF ~CLR} +begin + {$IFDEF CLR} + Result := &File.Exists(FileName); + if Result then + LocalTime := &File.GetLastWriteTime(FileName); + {$ELSE ~CLR} + Result := GetFileInformation(FileName, FileInfo); + if Result then + LocalTime := FileTimeToLocalDateTime(GetFileInformation(FileName).FindData.ftLastWriteTime); + {$ENDIF ~CLR} +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 + {$IFDEF CLR} + Result := &File.GetLastAccessTimeUtc(FileName); + {$ELSE} + Result := GetFileInformation(FileName).FindData.ftLastAccessTime; + {$ENDIF} +end; + +function GetFileLastAccess(const FileName: string; out LocalTime: TDateTime): Boolean; +{$IFNDEF CLR} +var + FileInfo: TSearchRec; +{$ENDIF ~CLR} +begin + {$IFDEF CLR} + Result := &File.Exists(FileName); + if Result then + LocalTime := &File.GetLastAccessTime(FileName); + {$ELSE ~CLR} + Result := GetFileInformation(FileName, FileInfo); + if Result then + LocalTime := FileTimeToLocalDateTime(GetFileInformation(FileName).FindData.ftLastAccessTime); + {$ENDIF ~CLR} +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 + {$IFDEF CLR} + Result := &File.GetCreationTimeUtc(FileName); + {$ELSE} + Result := GetFileInformation(FileName).FindData.ftCreationTime; + {$ENDIF} +end; + +function GetFileCreation(const FileName: string; out LocalTime: TDateTime): Boolean; +{$IFNDEF CLR} +var + FileInfo: TSearchRec; +{$ENDIF ~CLR} +begin + {$IFDEF CLR} + Result := &File.Exists(FileName); + if Result then + LocalTime := &File.GetCreationTime(FileName); + {$ELSE ~CLR} + Result := GetFileInformation(FileName, FileInfo); + if Result then + LocalTime := FileTimeToLocalDateTime(GetFileInformation(FileName).FindData.ftCreationTime); + {$ENDIF ~CLR} +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} + +{$IFNDEF CLR} +function GetModulePath(const Module: HMODULE): string; +var + L: Integer; +begin + L := MAX_PATH + 1; + SetLength(Result, L); +{$IFDEF MSWINDOWS} + L := Windows.GetModuleFileName(Module, Pointer(Result), L); +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} + L := GetModuleFileName(Module, Pointer(Result), L); +{$ENDIF UNIX} + SetLength(Result, L); +end; +{$ENDIF ~CLR} + +function GetSizeOfFile(const FileName: string): Int64; +{$IFDEF CLR} +begin + Result := System.IO.FileInfo.Create(FileName).Length; +end; +{$ELSE ~CLR} +{$IFDEF MSWINDOWS} +var + Handle: THandle; + FindData: TWin32FindData; + Size: TULargeInteger; +begin + Result := 0; + Handle := FindFirstFile(PChar(FileName), FindData); + if Handle <> INVALID_HANDLE_VALUE then + begin + Windows.FindClose(Handle); + Size.LowPart := FindData.nFileSizeLow; + Size.HighPart := FindData.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} +{$ENDIF ~CLR} + +{$IFDEF Win32API} +function GetSizeOfFile(Handle: THandle): Int64; overload; +var + Size: TULargeInteger; +begin + Size.LowPart := GetFileSize(Handle, @Size.HighPart); + Result := Size.QuadPart; +end; +{$ENDIF Win32API} + +function GetSizeOfFile(const FileInfo: TSearchRec): Int64; +{$IFDEF CLR} +begin + Result := (Int64(FileInfo.FindData.nFileSizeHigh) shl 32) or FileInfo.FindData.nFileSizeLow; +end; +{$ELSE ~CLR} +{$IFDEF MSWINDOWS} +begin + with Int64Rec(Result) do + begin + Lo := FileInfo.FindData.nFileSizeLow; + Hi := FileInfo.FindData.nFileSizeHigh; + end; +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} +{$ENDIF ~CLR} + +{$IFDEF Win32API} + +{$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 + 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 Win32API} + +{$IFDEF CLR} +function IsDirectory(const FileName: string): Boolean; +begin + Result := Directory.Exists(FileName); +end; +{$ELSE ~CLR} +{$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} +{$ENDIF ~CLR} + +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 = PathSeparator; +end; +{$ENDIF UNIX} + +{$IFDEF Win32API} + +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 + 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 Win32API} + +type + // indicates the file time to set, used by SetFileTimesHelper and SetDirTimesHelper + TFileTimes = (ftLastAccess, ftLastWrite {$IFDEF MSWINDOWS}, ftCreation {$ENDIF}); + +{$IFDEF CLR} +function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean; +begin + Result := &File.Exists(FileName); + if Result then + case Times of + ftLastAccess: + &File.SetLastAccessTime(FileName, DateTime); + ftLastWrite: + &File.SetLastWriteTime(FileName, DateTime); + ftCreation: + &File.SetCreationTime(FileName, DateTime); + else + Result := False; + end; +end; +{$ELSE ~CLR} +{$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); + SysUtils.DateTimeToSystemTime(DateTime, SystemTime); + if 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} +{$ENDIF ~CLR} + +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 + +{$IFNDEF CLR} +function BackupPrivilegesEnabled: Boolean; +begin + Result := IsPrivilegeEnabled(SE_BACKUP_NAME) and IsPrivilegeEnabled(SE_RESTORE_NAME); +end; +{$ENDIF ~CLR} + +function SetDirTimesHelper(const DirName: string; const DateTime: TDateTime; + Times: TFileTimes): Boolean; +{$IFDEF CLR} +begin + Result := Directory.Exists(DirName); + if Result then + case Times of + ftLastAccess: + &Directory.SetLastAccessTime(DirName, DateTime); + ftLastWrite: + &Directory.SetLastWriteTime(DirName, DateTime); + ftCreation: + &Directory.SetCreationTime(DirName, DateTime); + else + Result := False; + end; +end; +{$ELSE ~CLR} +var + Handle: THandle; + FileTime: TFileTime; + SystemTime: TSystemTime; +begin + Result := False; + if IsDirectory(DirName) and 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 + SysUtils.DateTimeToSystemTime(DateTime, SystemTime); + 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; +{$ENDIF ~CLR} + +function SetDirLastWrite(const DirName: string; const DateTime: TDateTime): Boolean; +begin + Result := SetDirTimesHelper(DirName, DateTime, ftLastWrite); +end; + +function SetDirLastAccess(const DirName: string; const DateTime: TDateTime): Boolean; +begin + Result := SetDirTimesHelper(DirName, DateTime, ftLastAccess); +end; + +function SetDirCreation(const DirName: string; const DateTime: TDateTime): Boolean; +begin + Result := SetDirTimesHelper(DirName, DateTime, ftCreation); +end; + +procedure FillByteArray(var Bytes: array of Byte; Count: Cardinal; B: Byte); +{$IFDEF CLR} +var + I: Integer; +begin + for I := 0 to Count - 1 do + Bytes[I] := B; +end; +{$ELSE ~CLR} +begin + FillMemory(@Bytes[0], Count, B); +end; +{$ENDIF ~CLR} + +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, soFromBeginning); + N := Size div BUFSIZE; + while N > 0 do + begin + Fs.Write(ContentPtr{$IFNDEF CLR}[0]{$ENDIF}, BUFSIZE); + Dec(N); + end; + N := Size mod BUFSIZE; + if N > 0 then + Fs.Write(ContentPtr{$IFNDEF CLR}[0]{$ENDIF}, N); + {$IFDEF CLR} + Fs.Handle.Flush; + {$ELSE} + FlushFileBuffers(Fs.Handle); + {$ENDIF} + Dec(Times); + end; + finally + ContentPtr := nil; + Fs.Free; + DeleteFile(FileName); + end; + end + else + DeleteFile(FileName); +end; + +{$IFNDEF CLR} +function UnlockVolume(var Handle: THandle): Boolean; +var + BytesReturned: DWORD; +begin + Result := False; + if Handle <> INVALID_HANDLE_VALUE then + begin + 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 ~CLR} + +{$IFNDEF CLR} +{$IFDEF KEEP_DEPRECATED} + +function Win32DeleteFile(const FileName: string; MoveToRecycleBin: Boolean): Boolean; +begin + Result := FileDelete(FileName, MoveToRecycleBin); +end; + +function Win32MoveFileReplaceExisting(const SrcFileName, DstFileName: string): Boolean; +begin + Result := FileMove(SrcFilename, DstFilename, True); +end; + +function Win32BackupFile(const FileName: string; Move: Boolean): Boolean; +begin + Result := FileBackup(FileName, Move); +end; + +function Win32RestoreFile(const FileName: string): Boolean; +begin + Result := FileRestore(FileName); +end; + +{$ENDIF KEEP_DEPRECATED} +{$ENDIF ~CLR} +{$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 Win32API} + +const + VerKeyNames: array [1..12] of string[17] = + ('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 := RsVosUnknown; + VOS_DOS: + Result := RsVosDos; + VOS_OS216: + Result := RsVosOS216; + VOS_OS232: + Result := RsVosOS232; + VOS_NT: + Result := RsVosNT; + VOS__WINDOWS16: + Result := RsVosWindows16; + VOS__PM16: + Result := RsVosPM16; + VOS__PM32: + Result := RsVosPM32; + VOS__WINDOWS32: + Result := RsVosWindows32; + VOS_DOS_WINDOWS16: + Result := RsVosDosWindows16; + VOS_DOS_WINDOWS32: + Result := RsVosDosWindows32; + VOS_OS216_PM16: + Result := RsVosOS216PM16; + VOS_OS232_PM32: + Result := RsVosOS232PM32; + VOS_NT_WINDOWS32: + Result := RsVosNTWindows32; + else + Result := RsVosUnknown; + end; + if Result <> RsVosUnknown then + Result := RsVosDesignedFor + Result; +end; + +function OSFileTypeToString(const OSFileType: DWORD; const OSFileSubType: DWORD): string; +begin + case OSFileType of + VFT_UNKNOWN: + Result := RsVftUnknown; + VFT_APP: + Result := RsVftApp; + VFT_DLL: + Result := RsVftDll; + VFT_DRV: + begin + case OSFileSubType of + VFT2_DRV_PRINTER: + Result := RsVft2DrvPRINTER; + VFT2_DRV_KEYBOARD: + Result := RsVft2DrvKEYBOARD; + VFT2_DRV_LANGUAGE: + Result := RsVft2DrvLANGUAGE; + VFT2_DRV_DISPLAY: + Result := RsVft2DrvDISPLAY; + VFT2_DRV_MOUSE: + Result := RsVft2DrvMOUSE; + VFT2_DRV_NETWORK: + Result := RsVft2DrvNETWORK; + VFT2_DRV_SYSTEM: + Result := RsVft2DrvSYSTEM; + VFT2_DRV_INSTALLABLE: + Result := RsVft2DrvINSTALLABLE; + VFT2_DRV_SOUND: + Result := RsVft2DrvSOUND; + VFT2_DRV_COMM: + Result := RsVft2DrvCOMM; + else + Result := ''; + end; + Result := Result + ' ' + RsVftDrv; + end; + VFT_FONT: + begin + case OSFileSubType of + VFT2_FONT_RASTER: + Result := RsVft2FontRASTER; + VFT2_FONT_VECTOR: + Result := RsVft2FontVECTOR; + VFT2_FONT_TRUETYPE: + Result := RsVft2FontTRUETYPE; + else + Result := ''; + end; + Result := Result + ' ' + RsVftFont; + end; + VFT_VXD: + Result := RsVftVxd; + VFT_STATIC_LIB: + Result := RsVftStaticLib; + else + Result := ''; + end; + Result := TrimLeft(Result); +end; + +function VersionResourceAvailable(const FileName: string): Boolean; +var + Size: DWORD; + Handle: THandle; + Buffer: string; +begin + Result := False; + Size := GetFileVersionInfoSize(PChar(FileName), Handle); + if Size > 0 then + begin + SetLength(Buffer, Size); + Result := GetFileVersionInfo(PChar(FileName), Handle, Size, PChar(Buffer)); + end; +end; + +{$ENDIF Win32API} + +// 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 Win32API} + +function FormatVersionString(const FixedInfo: TVSFixedFileInfo; VersionFormat: TFileVersionFormat): string; +begin + with FixedInfo do + case VersionFormat of + vfMajorMinor: + Result := Format('%u.%u', [HiWord(dwFileVersionMS), LoWord(dwFileVersionMS)]); + vfFull: + Result := Format('%u.%u.%u.%u', [HiWord(dwFileVersionMS), LoWord(dwFileVersionMS), + HiWord(dwFileVersionLS), LoWord(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: THandle; + Buffer: string; + FixInfoBuf: PVSFixedFileInfo; +begin + Result := False; + Size := GetFileVersionInfoSize(PChar(FileName), Handle); + if Size > 0 then + begin + SetLength(Buffer, Size); + if GetFileVersionInfo(PChar(FileName), Handle, Size, Pointer(Buffer)) and + VerQueryValue(Pointer(Buffer), '\', 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 + if VersionFixedFileInfo(FileName, FixedInfo) then + Result := FormatVersionString(FixedInfo, VersionFormat) + else + Result := NotAvailableText; +end; + +//=== { TJclFileVersionInfo } ================================================ + +constructor TJclFileVersionInfo.Attach(VersionInfoData: Pointer; Size: Integer); +begin + SetString(FBuffer, PChar(VersionInfoData), Size); + ExtractData; +end; + +constructor TJclFileVersionInfo.Create(const FileName: string); +var + Handle: THandle; + Size: DWORD; +begin + Size := GetFileVersionInfoSize(PChar(FileName), Handle); + if Size = 0 then + raise EJclFileVersionInfoError.CreateRes(@RsFileUtilsNoVersionInfo); + SetLength(FBuffer, Size); + Win32Check(GetFileVersionInfo(PChar(FileName), Handle, Size, PChar(FBuffer))); + ExtractData; +end; + +destructor TJclFileVersionInfo.Destroy; +begin + FreeAndNil(FItemList); + FreeAndNil(FItems); + inherited Destroy; +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: PChar; + Len, ValueLen, DataType: Word; + HeaderSize: Integer; + Key: string; + Error, IsUnicode: Boolean; + + procedure Padding(var DataPtr: PChar); + begin + while DWORD(DataPtr) and 3 <> 0 do + Inc(DataPtr); + end; + + procedure GetHeader; + var + P: PChar; + TempKey: PWideChar; + begin + P := Data; + Len := PWord(P)^; + if Len = 0 then + begin + Error := True; + 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 := PAnsiChar(P); + Inc(P, lstrlenA(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 Key[I] in AnsiHexDigits then + Inc(I) + else + Delete(Key, I, 1); + end; + + procedure ProcessStringInfo(Size: Integer); + var + EndPtr, EndStringPtr: PChar; + 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 + Value := ''; + 1: + if ValueLen = 0 then + Value := '' + else + if IsUnicode then + begin + Value := WideCharLenToString(PWideChar(Data), ValueLen); + StrResetLength(Value); + end + else + Value := 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(Size: Integer); + 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(DWORD(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(Len) + 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 + with FFixedInfo^ do + Result := Format('%u.%u.%u.%u', [HiWord(dwFileVersionMS), + LoWord(dwFileVersionMS), HiWord(dwFileVersionLS), LoWord(dwFileVersionLS)]); +end; + +function TJclFileVersionInfo.GetBinProductVersion: string; +begin + with FFixedInfo^ do + Result := Format('%u.%u.%u.%u', [HiWord(dwProductVersionMS), + LoWord(dwProductVersionMS), HiWord(dwProductVersionLS), + LoWord(dwProductVersionLS)]); +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.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.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 Win32API} + +//=== { TJclFileMaskComparator } ============================================= + +constructor TJclFileMaskComparator.Create; +begin + inherited Create; + FSeparator := ';'; +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; +const + WildChars = ['*', '?']; +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, WildChars, False) then + N := N or 1; + if StrContainsChars(ES, WildChars, 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 + Rslt := FindFirst(Folders[CurrentItem] + '*.*', faDirectory, 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 + PathSeparator); + + 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 + {$IFDEF CLR} + Result := StrMatches(Mask.ToUpper, FileName.ToUpper); + {$ELSE} + Result := StrMatches(AnsiUpperCase(Mask), AnsiUpperCase(FileName)); + {$ENDIF} +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('.' + PathSeparator, 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), + RsFileSearchAttrInconsistency); + + Directory := ExtractFilePath(Path); + + Attr := faAnyFile and not RejectedAttributes; + + Found := SysUtils.FindFirst(Path, Attr, FileInfo) = 0; + try + while Found do + begin + {$IFNDEF CLR} + if (Abort <> nil) and Abort^ then + Exit; + {$ENDIF ~CLR} + 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 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 := SysUtils.FindFirst(Directory + '*', Attr, DirInfo) = 0; + try + while Found do + begin + {$IFNDEF CLR} + if (Abort <> nil) and Abort^ then + Exit; + {$ENDIF ~CLR} + 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 + PathSeparator; + 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; + +//=== { TJclFileAttributeMask } ============================================== + +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; + +//=== { TEnumFileThread } ==================================================== + +type + TEnumFileThread = class(TThread) + private + FID: TFileSearchTaskID; + FFileMasks: TStringList; + FDirectory: string; + FSubDirectoryMask: string; + FOnEnterDirectory: TFileHandler; + FFileHandlerEx: TFileHandlerEx; + FFileHandler: TFileHandler; + FInternalDirHandler: TFileHandler; + FInternalFileHandler: TFileHandlerEx; + FFileInfo: TSearchRec; + FRejectedAttr: Integer; + FRequiredAttr: Integer; + FFileSizeMin: Int64; + FFileSizeMax: Int64; + FFileTimeMin: Integer; + FFileTimeMax: Integer; + 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 Directory: string; const FileInfo: TSearchRec); + procedure SyncProcessFile(const Directory: string; const FileInfo: TSearchRec); + function GetFileMasks: 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; + property Directory: string read FDirectory write FDirectory; + 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 CLR} + property Terminated; + {$ENDIF CLR} + {$IFDEF FPC} // protected property + property Terminated; + {$ENDIF FPC} + end; + +constructor TEnumFileThread.Create; +begin + inherited Create(True); + FFileMasks := TStringList.Create; + FFileTimeMin := Low(FFileInfo.Time); + FFileTimeMax := High(FFileInfo.Time); + FFileSizeMax := High(FFileSizeMax); + {$IFDEF CLR} + Priority := tpLowest; // there is no tpIdle + {$ELSE ~CLR} + {$IFDEF MSWINDOWS} + Priority := tpIdle; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Priority := 0; + {$ENDIF UNIX} + {$ENDIF ~CLR} + FreeOnTerminate := True; + FNotifyOnTermination := True; +end; + +destructor TEnumFileThread.Destroy; +begin + FFileMasks.Free; + inherited Destroy; +end; + +procedure TEnumFileThread.Execute; +begin + if SynchronizationMode = smPerDirectory then + begin + FInternalDirHandler := SyncProcessDirectory; + FInternalFileHandler := AsyncProcessFile; + end + else // SynchronizationMode = smPerFile + begin + FInternalDirHandler := AsyncProcessDirectory; + FInternalFileHandler := SyncProcessFile; + end; + + if FIncludeSubDirectories then + EnumDirectories(Directory, FInternalDirHandler, FIncludeHiddenSubDirectories, + FSubDirectoryMask, {$IFDEF CLR}TObject(Terminated){$ELSE}@Terminated{$ENDIF}) + else + FInternalDirHandler(CanonicalizedSearchPath(Directory)); +end; + +procedure TEnumFileThread.DoTerminate; +begin + if FNotifyOnTermination then + inherited DoTerminate; +end; + +procedure TEnumFileThread.EnterDirectory; +begin + FOnEnterDirectory(Directory); +end; + +procedure TEnumFileThread.ProcessDirectory; +begin + if Assigned(FOnEnterDirectory) then + EnterDirectory; + ProcessDirFiles; +end; + +procedure TEnumFileThread.AsyncProcessDirectory(const Directory: string); +begin + FDirectory := Directory; + if Assigned(FOnEnterDirectory) then + Synchronize(EnterDirectory); + ProcessDirFiles; +end; + +procedure TEnumFileThread.SyncProcessDirectory(const Directory: string); +begin + FDirectory := Directory; + Synchronize(ProcessDirectory); +end; + +procedure TEnumFileThread.ProcessDirFiles; +begin + EnumFiles(Directory + '*', FInternalFileHandler, FRejectedAttr, FRequiredAttr, + {$IFDEF CLR}TObject(Terminated){$ELSE}@Terminated{$ENDIF}); +end; + +function TEnumFileThread.FileMatch: Boolean; +var + FileSize: Int64; +begin + Result := FileNameMatchesMask and (FFileInfo.Time >= FFileTimeMin) and (FFileInfo.Time <= FFileTimeMax); + 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(Directory, FFileInfo) + else + FFileHandler(Directory + FFileInfo.Name); +end; + +procedure TEnumFileThread.AsyncProcessFile(const Directory: string; const FileInfo: TSearchRec); +begin + FFileInfo := FileInfo; + if FileMatch then + ProcessFile; +end; + +procedure TEnumFileThread.SyncProcessFile(const Directory: string; const FileInfo: TSearchRec); +begin + FFileInfo := FileInfo; + if FileMatch then + Synchronize(ProcessFile); +end; + +function TEnumFileThread.GetFileMasks: TStrings; +begin + Result := FFileMasks; +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; + FAttributeMask := TJclFileAttributeMask.Create; + FRootDirectory := '.'; + FFileMasks := TStringList.Create; + FFileMasks.Add('*'); + FSubDirectoryMask := '*'; + FOptions := [fsIncludeSubDirectories]; + FLastChangeAfter := MinDateTime; + FLastChangeBefore := MaxDateTime; + {$IFDEF UNIX} + FCaseSensitiveSearch := True; + {$ENDIF UNIX} + + {$IFNDEF CLR} + if GetOwner <> nil then + GetOwner.GetInterface(IInterface, FOwnerInterface); + {$ENDIF ~CLR} +end; + +destructor TJclFileEnumerator.Destroy; +begin + StopAllTasks(True); + FTasks.Free; + FAttributeMask.Free; + FFileMasks.Free; + inherited Destroy; +end; + +{$IFNDEF CLR} +procedure TJclFileEnumerator.AfterConstruction; +begin + inherited AfterConstruction; + if GetOwner <> nil then + GetOwner.GetInterface(IInterface, FOwnerInterface); +end; + +function TJclFileEnumerator.QueryInterface(const IID: TGUID; out Obj): HRESULT; +begin + if GetInterface(IID, Obj) then + Result := S_OK + else + Result := E_NOINTERFACE; +end; + +function TJclFileEnumerator._AddRef: Integer; +begin + if FOwnerInterface <> nil then + Result := FOwnerInterface._AddRef + else + Result := InterlockedIncrement(FRefCount); +end; + +function TJclFileEnumerator._Release: Integer; +begin + if FOwnerInterface <> nil then + Result := FOwnerInterface._Release + else + begin + Result := InterlockedDecrement(FRefCount); + if Result = 0 then + Destroy; + end; +end; +{$ENDIF ~CLR} + +procedure TJclFileEnumerator.Assign(Source: TPersistent); +var + Src: TJclFileEnumerator; +begin + if Source is TJclFileEnumerator then + begin + Src := TJclFileEnumerator(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; + SynchronizationMode := Src.SynchronizationMode; + OnEnterDirectory := Src.OnEnterDirectory; + OnTerminateTask := Src.OnTerminateTask; + end + else + 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.Directory := RootDirectory; + 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 := DateTimeToFileDate(LastChangeAfter); + if fsLastChangeBefore in Options then + Task.FFileTimeMax := DateTimeToFileDate(LastChangeBefore); + Task.SynchronizationMode := SynchronizationMode; + Task.FOnEnterDirectory := OnEnterDirectory; + Task.OnTerminate := TaskTerminated; + FTasks.Add(Task); + {$IFNDEF CLR} + if FRefCount > 0 then + _AddRef; + {$ENDIF ~CLR} + 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; + Task.Resume; +end; + +function TJclFileEnumerator.ForEach(Handler: TFileHandler): TFileSearchTaskID; +var + Task: TEnumFileThread; +begin + Task := TEnumFileThread(CreateTask); + Task.FFileHandler := Handler; + Result := Task.ID; + Task.Resume; +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 + with TEnumFileThread(FTasks[I]) do + begin + FNotifyOnTermination := not Silently; + Terminate; + end; +end; + +procedure TJclFileEnumerator.TaskTerminated(Sender: TObject); +begin + FTasks.Remove(Sender); + try + if Assigned(FOnTerminateTask) then + with TEnumFileThread(Sender) do + FOnTerminateTask(ID, Terminated); + finally + {$IFNDEF CLR} + if FRefCount > 0 then + _Release; + {$ENDIF ~CLR} + end; +end; + +function TJclFileEnumerator.GetNextTaskID: TFileSearchTaskID; +begin + Result := FNextTaskID; + Inc(FNextTaskID); +end; + +procedure TJclFileEnumerator.SetAttributeMask(const Value: TJclFileAttributeMask); +begin + FAttributeMask.Assign(Value); +end; + +function TJclFileEnumerator.GetLastChangeAfterStr: string; +begin + Result := DateTimeToStr(LastChangeAfter); +end; + +function TJclFileEnumerator.GetLastChangeBeforeStr: string; +begin + Result := DateTimeToStr(LastChangeBefore); +end; + +procedure TJclFileEnumerator.SetLastChangeAfterStr(const Value: string); +begin + if Value = '' then + LastChangeAfter := MinDateTime + else + LastChangeAfter := StrToDateTime(Value); +end; + +procedure TJclFileEnumerator.SetLastChangeBeforeStr(const Value: string); +begin + if Value = '' then + LastChangeBefore := MaxDateTime + else + LastChangeBefore := StrToDateTime(Value); +end; + +function TJclFileEnumerator.GetAttributeMask: TJclFileAttributeMask; +begin + Result := FAttributeMask; +end; + +function TJclFileEnumerator.GetCaseSensitiveSearch: Boolean; +begin + Result := FCaseSensitiveSearch; +end; + +function TJclFileEnumerator.GetRootDirectory: string; +begin + Result := FRootDirectory; +end; + +function TJclFileEnumerator.GetFileMask: string; +begin + Result := StringsToStr(FileMasks, ';', False); +end; + +function TJclFileEnumerator.GetFileMasks: TStrings; +begin + Result := FFileMasks; +end; + +function TJclFileEnumerator.GetFileSizeMax: Int64; +begin + Result := FFileSizeMax; +end; + +function TJclFileEnumerator.GetFileSizeMin: Int64; +begin + Result := FFileSizeMin; +end; + +function TJclFileEnumerator.GetIncludeHiddenSubDirectories: Boolean; +begin + Result := fsIncludeHiddenSubDirectories in Options; +end; + +function TJclFileEnumerator.GetIncludeSubDirectories: Boolean; +begin + Result := fsIncludeSubDirectories in Options; +end; + +function TJclFileEnumerator.GetLastChangeAfter: TDateTime; +begin + Result := FLastChangeAfter; +end; + +function TJclFileEnumerator.GetLastChangeBefore: TDateTime; +begin + Result := FLastChangeBefore; +end; + +function TJclFileEnumerator.GetOnEnterDirectory: TFileHandler; +begin + Result := FOnEnterDirectory; +end; + +function TJclFileEnumerator.GetOnTerminateTask: TFileSearchTerminationEvent; +begin + Result := FOnTerminateTask; +end; + +function TJclFileEnumerator.GetOption(const Option: TFileSearchOption): Boolean; +begin + Result := Option in FOptions; +end; + +function TJclFileEnumerator.GetOptions: TFileSearchOptions; +begin + Result := FOptions; +end; + +function TJclFileEnumerator.GetSubDirectoryMask: string; +begin + Result := FSubDirectoryMask; +end; + +function TJclFileEnumerator.GetSynchronizationMode: TFileEnumeratorSyncMode; +begin + Result := FSynchronizationMode; +end; + +function TJclFileEnumerator.IsLastChangeAfterStored: Boolean; +begin + Result := FLastChangeAfter <> MinDateTime; +end; + +function TJclFileEnumerator.IsLastChangeBeforeStored: Boolean; +begin + Result := FLastChangeBefore <> MaxDateTime; +end; + +procedure TJclFileEnumerator.SetCaseSensitiveSearch(const Value: Boolean); +begin + FCaseSensitiveSearch := Value; +end; + +procedure TJclFileEnumerator.SetRootDirectory(const Value: string); +begin + FRootDirectory := Value; +end; + +procedure TJclFileEnumerator.SetFileMask(const Value: string); +begin + { TODO : UNIX : ? } + StrToStrings(Value, ';', FFileMasks, False); +end; + +procedure TJclFileEnumerator.SetFileMasks(const Value: TStrings); +begin + FileMasks.Assign(Value); +end; + +procedure TJclFileEnumerator.SetFileSizeMax(const Value: Int64); +begin + FFileSizeMax := Value; +end; + +procedure TJclFileEnumerator.SetFileSizeMin(const Value: Int64); +begin + FFileSizeMin := Value; +end; + +procedure TJclFileEnumerator.SetIncludeHiddenSubDirectories( + const Value: Boolean); +begin + SetOption(fsIncludeHiddenSubDirectories, Value); +end; + +procedure TJclFileEnumerator.SetIncludeSubDirectories( + const Value: Boolean); +begin + SetOption(fsIncludeSubDirectories, Value); +end; + +procedure TJclFileEnumerator.SetLastChangeAfter(const Value: TDateTime); +begin + FLastChangeAfter := Value; +end; + +procedure TJclFileEnumerator.SetLastChangeBefore(const Value: TDateTime); +begin + FLastChangeBefore := Value; +end; + +procedure TJclFileEnumerator.SetOnEnterDirectory( + const Value: TFileHandler); +begin + FOnEnterDirectory := Value; +end; + +procedure TJclFileEnumerator.SetOnTerminateTask( + const Value: TFileSearchTerminationEvent); +begin + FOnTerminateTask := Value; +end; + +procedure TJclFileEnumerator.SetOption(const Option: TFileSearchOption; const Value: Boolean); +begin + if Value then + Include(FOptions, Option) + else + Exclude(FOptions, Option); +end; + +procedure TJclFileEnumerator.SetOptions(const Value: TFileSearchOptions); +begin + FOptions := Value; +end; + +procedure TJclFileEnumerator.SetSubDirectoryMask(const Value: string); +begin + FSubDirectoryMask := Value; +end; + +procedure TJclFileEnumerator.SetSynchronizationMode( + const Value: TFileEnumeratorSyncMode); +begin + FSynchronizationMode := Value; +end; + +function FileSearch: IJclFileEnumerator; +begin + Result := TJclFileEnumerator.Create; +end; + +// History: + +// $Log: JclFileUtils.pas,v $ +// Revision 1.57 2006/01/25 20:58:24 ahuser +// Faster FileExists for Win32 +// +// Revision 1.56 2005/12/29 10:35:54 outchy +// VolumeID is now deprecated. +// +// Revision 1.55 2005/10/30 01:57:07 rrossmair +// - introduce KEEP_DEPRECATED as alias for ~DROP_OBSOLETE_CODE +// +// Revision 1.54 2005/10/24 19:16:53 ahuser +// more .NET support +// +// Revision 1.53 2005/10/12 12:39:45 outchy +// Fixed PathIsAbsolute on UNC paths (reported by Robert Kindl) +// +// Revision 1.52 2005/09/17 23:33:13 outchy +// IT3164: multiple masks in BuildFileList +// +// Revision 1.51 2005/09/11 00:20:32 rrossmair +// - don't use unit Windows with .NET +// +// Revision 1.50 2005/09/06 19:22:37 outchy +// Minor style cleaning. +// IT3164: BuildFileList(...,faDirectory,...) finds files AND folders, fixed. +// +// Revision 1.49 2005/09/06 18:28:29 outchy +// IT3011: PathGetLongName returned empty string when long name doesn't exist on WinXP SP2. +// +// Revision 1.48 2005/08/22 02:00:54 rrossmair +// - fixed PathGetRelativePath +// - simplified some conditional compilation constructs; style adjustments +// +// Revision 1.47 2005/06/03 16:17:53 rrossmair +// - fixed issue #0003007 (FileGetSize, GetSizeOfFile: incorrect results with files > 2 GB in size) +// - improved FindUnusedFileName +// +// Revision 1.46 2005/05/05 20:08:42 ahuser +// JCL.NET support +// +// Revision 1.45 2005/04/07 00:41:35 rrossmair +// - changed for FPC 1.9.8 +// +// Revision 1.44 2005/03/22 03:40:24 rrossmair +// - tweaked PathGetRelativePath +// +// Revision 1.43 2005/03/19 02:02:59 rrossmair +// - fixed PathGetRelativePath +// +// Revision 1.42 2005/03/08 16:10:08 marquardt +// standard char sets extended and used, some optimizations for string literals +// +// Revision 1.41 2005/03/08 08:33:16 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.40 2005/03/01 20:16:17 rrossmair +// - fixed issue #0002696: GetBackupFileName() fails when used with extensionless filename +// +// Revision 1.39 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.38 2005/01/04 23:05:08 jfudickar +// ForceDirectories fixed. Now it supports ForceDirectories('VersionCheck') or ForceDirectories('a\\b\\c\\d') +// +// Revision 1.37 2004/12/23 04:31:43 rrossmair +// - check-in for JCL 1.94 RC 1 +// +// Revision 1.36 2004/12/20 05:14:24 rrossmair +// - added FileGetOwnerName, FileGetGroupName (Unix parts) +// +// Revision 1.35 2004/12/20 04:03:25 rrossmair +// - added FileGetOwnerName, FileGetGroupName functions (Windows part) +// +// Revision 1.34 2004/11/18 10:13:24 rrossmair +// - fixed for Unix +// +// Revision 1.33 2004/11/18 00:42:59 rrossmair +// - fixed mantis #1667 +// +// Revision 1.32 2004/10/17 21:40:17 rrossmair +// fixed PathGetLongName +// +// Revision 1.31 2004/10/17 17:26:57 rrossmair +// restored Unix compatibility +// +// Revision 1.30 2004/10/17 06:02:51 rrossmair +// - rewrote PathGetLongName +// - rewrote PathGetLongName2 (now mere wrapper around PathGetLongName) +// - restored FPC compatibility +// +// Revision 1.29 2004/10/15 03:54:20 rrossmair +// - added FileCreateTemp/Unix +// - added FileBackup +// - added FileCopy +// - added FileDelete +// - added FileMove +// - added FileRestore +// - added FileGetTempName/Unix +// - added PathGetTempPath +// - reworked Win32* functions as mere wrappers for corresponding File* functions +// - removed some PH contributions +// +// Revision 1.28 2004/08/03 07:22:36 marquardt +// resourcestring cleanup +// +// Revision 1.27 2004/08/02 06:34:59 marquardt +// minor string literal improvements +// +// Revision 1.26 2004/08/01 05:52:11 marquardt +// move constructors/destructors +// +// Revision 1.25 2004/07/30 07:20:25 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate +// +// Revision 1.24 2004/07/29 07:58:20 marquardt +// inc files updated +// +// Revision 1.23 2004/07/28 18:00:50 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.22 2004/06/16 07:30:27 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.21 2004/06/14 11:05:51 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.20 2004/06/14 06:24:52 marquardt +// style cleaning IFDEF +// +// Revision 1.19 2004/05/31 01:42:27 rrossmair +// Processed documentation TODOs +// +// Revision 1.18 2004/05/18 19:07:58 rrossmair +// fixed contributor information +// +// Revision 1.17 2004/05/13 07:46:05 rrossmair +// changes for FPC 1.9.3+ compatibility +// +// Revision 1.16 2004/05/09 11:19:13 rrossmair +// Contributor list update +// +// Revision 1.15 2004/05/08 19:56:55 rrossmair +// FPC-related improvements +// +// Revision 1.14 2004/05/08 08:44:17 rrossmair +// introduced & applied symbol HAS_UNIT_LIBC +// +// Revision 1.13 2004/05/06 05:09:55 rrossmair +// Changes for FPC v1.9.4 compatibility +// +// Revision 1.12 2004/05/05 00:04:11 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// + +end. diff --git a/official/1.96/source/common/JclHashMaps.pas b/official/1.96/source/common/JclHashMaps.pas new file mode 100644 index 0000000..1ed9cfb --- /dev/null +++ b/official/1.96/source/common/JclHashMaps.pas @@ -0,0 +1,2153 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/08/09 10:30:21 $ +// For history see end of file + +unit JclHashMaps; + +{$I jcl.inc} + +interface + +uses + JclBase, JclAbstractContainers, JclContainerIntf; + +type + TJclIntfIntfEntry = record + Key: IInterface; + Value: IInterface; + end; + + TJclStrIntfEntry = record + Key: string; + Value: IInterface; + end; + + TJclStrStrEntry = record + Key: string; + Value: string; + end; + + TJclStrEntry = record + Key: string; + Value: TObject; + end; + + TJclEntry = record + Key: TObject; + Value: TObject; + end; + + TJclIntfIntfEntryArray = array of TJclIntfIntfEntry; + TJclStrIntfEntryArray = array of TJclStrIntfEntry; + TJclStrStrEntryArray = array of TJclStrStrEntry; + TJclStrEntryArray = array of TJclStrEntry; + TJclEntryArray = array of TJclEntry; + + {$IFDEF CLR} + TJclIntfIntfBucket = class; + PJclIntfIntfBucket = TJclIntfIntfBucket; + TJclIntfIntfBucket = class + {$ELSE} + PJclIntfIntfBucket = ^TJclIntfIntfBucket; + TJclIntfIntfBucket = record + {$ENDIF CLR} + Count: Integer; + Entries: TJclIntfIntfEntryArray; + end; + + {$IFDEF CLR} + TJclStrIntfBucket = class; + PJclStrIntfBucket = TJclStrIntfBucket; + TJclStrIntfBucket = class + {$ELSE} + PJclStrIntfBucket = ^TJclStrIntfBucket; + TJclStrIntfBucket = record + {$ENDIF CLR} + Count: Integer; + Entries: TJclStrIntfEntryArray; + end; + + {$IFDEF CLR} + TJclStrStrBucket = class; + PJclStrStrBucket = TJclStrStrBucket; + TJclStrStrBucket = class + {$ELSE} + PJclStrStrBucket = ^TJclStrStrBucket; + TJclStrStrBucket = record + {$ENDIF CLR} + Count: Integer; + Entries: TJclStrStrEntryArray; + end; + + {$IFDEF CLR} + TJclStrBucket = class; + PJclStrBucket = TJclStrBucket; + TJclStrBucket = class + {$ELSE} + PJclStrBucket = ^TJclStrBucket; + TJclStrBucket = record + {$ENDIF CLR} + Count: Integer; + Entries: TJclStrEntryArray; + end; + + {$IFDEF CLR} + TJclBucket = class; + PJclBucket = TJclBucket; + TJclBucket = class + {$ELSE} + PJclBucket = ^TJclBucket; + TJclBucket = record + {$ENDIF CLR} + Count: Integer; + Entries: TJclEntryArray; + end; + + TJclIntfIntfBucketArray = array of TJclIntfIntfBucket; + TJclStrIntfBucketArray = array of TJclStrIntfBucket; + TJclStrStrBucketArray = array of TJclStrStrBucket; + TJclStrBucketArray = array of TJclStrBucket; + TJclBucketArray = array of TJclBucket; + + // Hash Function + TJclHashFunction = function(Key: Cardinal): Cardinal of object; + + TJclIntfIntfHashMap = class(TJclAbstractContainer, IJclIntfIntfMap, + IJclIntfCloneable) + private + FCapacity: Integer; + FCount: Integer; + FBuckets: TJclIntfIntfBucketArray; + FHashFunction: TJclHashFunction; + function HashMul(Key: Cardinal): Cardinal; + protected + procedure GrowEntries(BucketIndex: Integer); virtual; + { IJclIntfIntfMap } + procedure Clear; + function ContainsKey(Key: IInterface): Boolean; + function ContainsValue(Value: IInterface): Boolean; + function Equals(AMap: IJclIntfIntfMap): Boolean; + function GetValue(Key: IInterface): IInterface; + function IsEmpty: Boolean; + function KeySet: IJclIntfSet; + procedure PutAll(AMap: IJclIntfIntfMap); + procedure PutValue(Key, Value: IInterface); + function Remove(Key: IInterface): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + { IJclIntfCloneable } + function Clone: IInterface; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + destructor Destroy; override; + property HashFunction: TJclHashFunction read FHashFunction write + FHashFunction; + end; + + TJclStrIntfHashMap = class(TJclAbstractContainer, IJclStrIntfMap, IJclIntfCloneable) + private + FCapacity: Integer; + FCount: Integer; + FBuckets: TJclStrIntfBucketArray; + FHashFunction: TJclHashFunction; + function HashMul(Key: Cardinal): Cardinal; + function HashString(const Key: string): Cardinal; + protected + procedure GrowEntries(BucketIndex: Integer); virtual; + { IJclIntfMap } + procedure Clear; + function ContainsKey(const Key: string): Boolean; + function ContainsValue(Value: IInterface): Boolean; + function Equals(AMap: IJclStrIntfMap): Boolean; + function GetValue(const Key: string): IInterface; + function IsEmpty: Boolean; + function KeySet: IJclStrSet; + procedure PutAll(AMap: IJclStrIntfMap); + procedure PutValue(const Key: string; Value: IInterface); + function Remove(const Key: string): IInterface; + function Size: Integer; + function Values: IJclIntfCollection; + { IJclIntfCloneable } + function Clone: IInterface; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + destructor Destroy; override; + property HashFunction: TJclHashFunction read FHashFunction write + FHashFunction; + end; + + TJclStrStrHashMap = class(TJclAbstractContainer, IJclStrStrMap, IJclIntfCloneable) + private + FCapacity: Integer; + FCount: Integer; + FBuckets: TJclStrStrBucketArray; + FHashFunction: TJclHashFunction; + function HashMul(Key: Cardinal): Cardinal; + function HashString(const Key: string): Cardinal; + protected + procedure GrowEntries(BucketIndex: Integer); virtual; + { IJclStrStrMap } + procedure Clear; + function ContainsKey(const Key: string): Boolean; + function ContainsValue(const Value: string): Boolean; + function Equals(AMap: IJclStrStrMap): Boolean; + function GetValue(const Key: string): string; + function IsEmpty: Boolean; + function KeySet: IJclStrSet; + procedure PutAll(AMap: IJclStrStrMap); + procedure PutValue(const Key, Value: string); + function Remove(const Key: string): string; + function Size: Integer; + function Values: IJclStrCollection; + // Daniele Teti + function KeyOfValue(const Value: string): string; + { IJclIntfCloneable } + function Clone: IInterface; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + destructor Destroy; override; + property HashFunction: TJclHashFunction read FHashFunction write + FHashFunction; + end; + + TJclStrHashMap = class(TJclAbstractContainer, IJclStrMap, IJclCloneable) + private + FCapacity: Integer; + FCount: Integer; + FBuckets: TJclStrBucketArray; + FHashFunction: TJclHashFunction; + FOwnsObjects: Boolean; + function HashMul(Key: Cardinal): Cardinal; + function HashString(const Key: string): Cardinal; + protected + procedure GrowEntries(BucketIndex: Integer); virtual; + procedure FreeObject(var AObject: TObject); + { IJclStrMap } + procedure Clear; + function ContainsKey(const Key: string): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Equals(AMap: IJclStrMap): Boolean; + function GetValue(const Key: string): TObject; + function IsEmpty: Boolean; + function KeySet: IJclStrSet; + procedure PutAll(AMap: IJclStrMap); + procedure PutValue(const Key: string; Value: TObject); + function Remove(const Key: string): TObject; + function Size: Integer; + function Values: IJclCollection; + { IJclCloneable } + function Clone: TObject; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity; + AOwnsObjects: Boolean = True); + destructor Destroy; override; + property HashFunction: TJclHashFunction read FHashFunction write + FHashFunction; + property OwnsObjects: Boolean read FOwnsObjects; + end; + + TJclHashMap = class(TJclAbstractContainer, IJclMap, IJclCloneable) + private + FCapacity: Integer; + FCount: Integer; + FBuckets: TJclBucketArray; + FHashFunction: TJclHashFunction; + FOwnsObjects: Boolean; + function HashMul(Key: Cardinal): Cardinal; + protected + procedure GrowEntries(BucketIndex: Integer); virtual; + procedure FreeObject(var AObject: TObject); + { IJclCloneable } + function Clone: TObject; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity; + AOwnsObjects: Boolean = True); + destructor Destroy; override; + { IJclMap } + procedure Clear; + function ContainsKey(Key: TObject): Boolean; + function ContainsValue(Value: TObject): Boolean; + function Equals(AMap: IJclMap): Boolean; + function GetValue(Key: TObject): TObject; + function IsEmpty: Boolean; + function KeySet: IJclSet; + procedure PutAll(AMap: IJclMap); + procedure PutValue(Key, Value: TObject); + function Remove(Key: TObject): TObject; + function Size: Integer; + function Values: IJclCollection; + property HashFunction: TJclHashFunction read FHashFunction write FHashFunction; + property OwnsObjects: Boolean read FOwnsObjects; + end; + +implementation + +uses + SysUtils, + JclArrayLists, JclArraySets, JclResources; + +procedure MoveArray(var List: TJclIntfIntfEntryArray; FromIndex, ToIndex, Count: Integer); overload; +{$IFDEF CLR} +var + I: Integer; +begin + if FromIndex < ToIndex then + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I] + else + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; +{$ELSE} +begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + { Keep reference counting working } + if FromIndex < ToIndex then + FillChar(List[FromIndex], (ToIndex - FromIndex) * SizeOf(List[0]), 0) + else if FromIndex > ToIndex then + FillChar(List[FromIndex + Count - 1], (FromIndex - ToIndex) * SizeOf(List[0]), 0); +{$ENDIF CLR} +end; + +procedure MoveArray(var List: TJclStrIntfEntryArray; FromIndex, ToIndex, Count: Integer); overload; +{$IFDEF CLR} +var + I: Integer; +begin + if FromIndex < ToIndex then + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I] + else + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; +{$ELSE} +begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + { Keep reference counting working } + if FromIndex < ToIndex then + FillChar(List[FromIndex], (ToIndex - FromIndex) * SizeOf(List[0]), 0) + else if FromIndex > ToIndex then + FillChar(List[FromIndex + Count - 1], (FromIndex - ToIndex) * SizeOf(List[0]), 0); +{$ENDIF CLR} +end; + +procedure MoveArray(var List: TJclStrStrEntryArray; FromIndex, ToIndex, Count: Integer); overload; +{$IFDEF CLR} +var + I: Integer; +begin + if FromIndex < ToIndex then + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I] + else + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; +{$ELSE} +begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + { Keep reference counting working } + if FromIndex < ToIndex then + FillChar(List[FromIndex], (ToIndex - FromIndex) * SizeOf(List[0]), 0) + else if FromIndex > ToIndex then + FillChar(List[FromIndex + Count - 1], (FromIndex - ToIndex) * SizeOf(List[0]), 0); +{$ENDIF CLR} +end; + +procedure MoveArray(var List: TJclStrEntryArray; FromIndex, ToIndex, Count: Integer); overload; +{$IFDEF CLR} +var + I: Integer; +begin + if FromIndex < ToIndex then + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I] + else + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; +{$ELSE} +begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); + { Keep reference counting working } + if FromIndex < ToIndex then + FillChar(List[FromIndex], (ToIndex - FromIndex) * SizeOf(List[0]), 0) + else if FromIndex > ToIndex then + FillChar(List[FromIndex + Count - 1], (FromIndex - ToIndex) * SizeOf(List[0]), 0); +{$ENDIF CLR} +end; + +procedure MoveArray(var List: TJclEntryArray; FromIndex, ToIndex, Count: Integer); overload; +{$IFDEF CLR} +var + I: Integer; +begin + if FromIndex < ToIndex then + for I := 0 to Count - 1 do + List[ToIndex + I] := List[FromIndex + I] + else + for I := Count - 1 downto 0 do + List[ToIndex + I] := List[FromIndex + I]; +{$ELSE} +begin + Move(List[FromIndex], List[ToIndex], Count * SizeOf(List[0])); +{$ENDIF CLR} +end; + +//=== { TJclIntfIntfHashMap } ================================================ + +constructor TJclIntfIntfHashMap.Create(ACapacity: Integer = DefaultContainerCapacity); +var + I: Integer; +begin + inherited Create; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FBuckets, FCapacity); + for I := 0 to FCapacity - 1 do + SetLength(FBuckets[I].Entries, 1); + FHashFunction := HashMul; +end; + +destructor TJclIntfIntfHashMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclIntfIntfHashMap.Clear; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + for J := 0 to FBuckets[I].Count - 1 do + begin + FBuckets[I].Entries[J].Key := nil; + FBuckets[I].Entries[J].Value := nil; + end; + FBuckets[I].Count := 0; + end; + FCount := 0; +end; + +function TJclIntfIntfHashMap.Clone: IInterface; +var + I, J: Integer; + NewEntryArray: TJclIntfIntfEntryArray; + NewMap: TJclIntfIntfHashMap; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + NewMap := TJclIntfIntfHashMap.Create(FCapacity); + for I := 0 to FCapacity - 1 do + begin + NewEntryArray := NewMap.FBuckets[I].Entries; + SetLength(NewEntryArray, Length(FBuckets[I].Entries)); + for J := 0 to FBuckets[I].Count - 1 do + begin + NewEntryArray[J].Key := FBuckets[I].Entries[J].Key; + NewEntryArray[J].Value := FBuckets[I].Entries[J].Value; + end; + NewMap.FBuckets[I].Count := FBuckets[I].Count; + end; + Result := NewMap; +end; + +function TJclIntfIntfHashMap.ContainsKey(Key: IInterface): Boolean; +var + I: Integer; + Bucket: PJclIntfIntfBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Key = nil then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(Integer(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := True; + Break; + end; +end; + +function TJclIntfIntfHashMap.ContainsValue(Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: PJclIntfIntfBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Value = nil then + Exit; + for J := 0 to FCapacity - 1 do + begin + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[J]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Value = Value then + begin + Result := True; + Exit; + end; + end; +end; + +function TJclIntfIntfHashMap.Equals(AMap: IJclIntfIntfMap): Boolean; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FCount <> AMap.Size then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + if AMap.ContainsKey(FBuckets[I].Entries[J].Key) then + begin + if AMap.GetValue(FBuckets[I].Entries[J].Key) <> + FBuckets[I].Entries[J].Value then + begin + Result := False; + Exit; + end; + end + else + begin + Result := False; + Exit; + end; +end; + +function TJclIntfIntfHashMap.GetValue(Key: IInterface): IInterface; +var + I: Integer; + Bucket: PJclIntfIntfBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if Key = nil then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(Integer(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := Bucket.Entries[I].Value; + Break; + end; +end; + +procedure TJclIntfIntfHashMap.GrowEntries(BucketIndex: Integer); +var + Capacity: Integer; +begin + Capacity := Length(FBuckets[BucketIndex].Entries); + if Capacity > 64 then + Capacity := Capacity + Capacity div 4 + else + Capacity := Capacity * 4; + SetLength(FBuckets[BucketIndex].Entries, Capacity); +end; + +function TJclIntfIntfHashMap.HashMul(Key: Cardinal): Cardinal; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Trunc(FCapacity * (Frac(Key * A))); +end; + +function TJclIntfIntfHashMap.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclIntfIntfHashMap.KeySet: IJclIntfSet; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclIntfArraySet.Create(FCapacity); + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Key); +end; + +procedure TJclIntfIntfHashMap.PutAll(AMap: IJclIntfIntfMap); +var + It: IJclIntfIterator; + Key: IInterface; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$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; +end; + +procedure TJclIntfIntfHashMap.PutValue(Key, Value: IInterface); +var + Index: Integer; + Bucket: PJclIntfIntfBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if Key = nil then + Exit; + if Value = nil then + Exit; + Index := FHashFunction(Integer(Key)); + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[Index]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Bucket.Entries[I].Value := Value; + Exit; + end; + if Bucket.Count = Length(Bucket.Entries) then + GrowEntries(Index); + Bucket.Entries[Bucket.Count].Key := Key; + Bucket.Entries[Bucket.Count].Value := Value; + Inc(Bucket.Count); + Inc(FCount); +end; + +function TJclIntfIntfHashMap.Remove(Key: IInterface): IInterface; +var + Bucket: PJclIntfIntfBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if Key = nil then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(Integer(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := Bucket.Entries[I].Value; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Count - I); + Dec(Bucket.Count); + Dec(FCount); + Break; + end; +end; + +function TJclIntfIntfHashMap.Size: Integer; +begin + Result := FCount; +end; + +function TJclIntfIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create(FCapacity); + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Value); +end; + +//=== { TJclStrIntfHashMap } ================================================= + +constructor TJclStrIntfHashMap.Create(ACapacity: Integer = DefaultContainerCapacity); +var + I: Integer; +begin + inherited Create; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FBuckets, FCapacity); + for I := 0 to FCapacity - 1 do + SetLength(FBuckets[I].Entries, 1); + FHashFunction := HashMul; +end; + +destructor TJclStrIntfHashMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclStrIntfHashMap.Clear; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + for J := 0 to FBuckets[I].Count - 1 do + begin + FBuckets[I].Entries[J].Key := ''; + FBuckets[I].Entries[J].Value := nil; + end; + FBuckets[I].Count := 0; + end; + FCount := 0; +end; + +function TJclStrIntfHashMap.Clone: IInterface; +var + I, J: Integer; + NewEntryArray: TJclStrIntfEntryArray; + NewMap: TJclStrIntfHashMap; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + NewMap := TJclStrIntfHashMap.Create(FCapacity); + for I := 0 to FCapacity - 1 do + begin + NewEntryArray := NewMap.FBuckets[I].Entries; + SetLength(NewEntryArray, Length(FBuckets[I].Entries)); + for J := 0 to FBuckets[I].Count - 1 do + begin + NewEntryArray[J].Key := FBuckets[I].Entries[J].Key; + NewEntryArray[J].Value := FBuckets[I].Entries[J].Value; + end; + NewMap.FBuckets[I].Count := FBuckets[I].Count; + end; + Result := NewMap; +end; + +function TJclStrIntfHashMap.ContainsKey(const Key: string): Boolean; +var + I: Integer; + Bucket: PJclStrIntfBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Key = '' then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(HashString(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := True; + Break; + end; +end; + +function TJclStrIntfHashMap.ContainsValue(Value: IInterface): Boolean; +var + I, J: Integer; + Bucket: PJclStrIntfBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Value = nil then + Exit; + for J := 0 to FCapacity - 1 do + begin + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[J]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Value = Value then + begin + Result := True; + Exit; + end; + end; +end; + +function TJclStrIntfHashMap.Equals(AMap: IJclStrIntfMap): Boolean; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FCount <> AMap.Size then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + if AMap.ContainsKey(FBuckets[I].Entries[J].Key) then + begin + if AMap.GetValue(FBuckets[I].Entries[J].Key) <> + FBuckets[I].Entries[J].Value then + begin + Result := False; + Exit; + end; + end + else + begin + Result := False; + Exit; + end; +end; + +function TJclStrIntfHashMap.GetValue(const Key: string): IInterface; +var + I: Integer; + Index: Integer; + Bucket: PJclStrIntfBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if Key = '' then + Exit; + Index := FHashFunction(HashString(Key)); + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[Index]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := Bucket.Entries[I].Value; + Break; + end; +end; + +procedure TJclStrIntfHashMap.GrowEntries(BucketIndex: Integer); +var + Capacity: Integer; +begin + Capacity := Length(FBuckets[BucketIndex].Entries); + if Capacity > 64 then + Capacity := Capacity + Capacity div 4 + else + Capacity := Capacity * 4; + SetLength(FBuckets[BucketIndex].Entries, Capacity); +end; + +function TJclStrIntfHashMap.HashMul(Key: Cardinal): Cardinal; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Trunc(FCapacity * (Frac(Key * A))); +end; + +function TJclStrIntfHashMap.HashString(const Key: string): Cardinal; +var + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := 0; + for I := 1 to Length(Key) do + Result := Result + Cardinal(Ord(Key[I]) * (I - 1) * 256); +end; + +function TJclStrIntfHashMap.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclStrIntfHashMap.KeySet: IJclStrSet; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclStrArraySet.Create(FCapacity); + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Key); +end; + +procedure TJclStrIntfHashMap.PutAll(AMap: IJclStrIntfMap); +var + It: IJclStrIterator; + Key: string; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$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; +end; + +procedure TJclStrIntfHashMap.PutValue(const Key: string; Value: IInterface); +var + Index: Integer; + Bucket: PJclStrIntfBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if Key = '' then + Exit; + if Value = nil then + Exit; + Index := FHashFunction(HashString(Key)); + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[Index]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Bucket.Entries[I].Value := Value; + Exit; + end; + if Bucket.Count = Length(Bucket.Entries) then + GrowEntries(Index); + Bucket.Entries[Bucket.Count].Key := Key; + Bucket.Entries[Bucket.Count].Value := Value; + Inc(Bucket.Count); + Inc(FCount); +end; + +function TJclStrIntfHashMap.Remove(const Key: string): IInterface; +var + Bucket: PJclStrIntfBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if Key = '' then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(HashString(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := Bucket.Entries[I].Value; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Count - I); + Dec(Bucket.Count); + Dec(FCount); + Break; + end; +end; + +function TJclStrIntfHashMap.Size: Integer; +begin + Result := FCount; +end; + +function TJclStrIntfHashMap.Values: IJclIntfCollection; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclIntfArrayList.Create; + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Value); +end; + +//=== { TJclStrStrHashMap } ================================================== + +constructor TJclStrStrHashMap.Create(ACapacity: Integer = DefaultContainerCapacity); +var + I: Integer; +begin + inherited Create; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FBuckets, FCapacity); + for I := 0 to FCapacity - 1 do + SetLength(FBuckets[I].Entries, 1); + FHashFunction := HashMul; +end; + +destructor TJclStrStrHashMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclStrStrHashMap.Clear; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + for J := 0 to FBuckets[I].Count - 1 do + begin + FBuckets[I].Entries[J].Key := ''; + FBuckets[I].Entries[J].Value := ''; + end; + FBuckets[I].Count := 0; + end; + FCount := 0; +end; + +function TJclStrStrHashMap.Clone: IInterface; +var + I, J: Integer; + NewEntryArray: TJclStrStrEntryArray; + NewMap: TJclStrStrHashMap; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + NewMap := TJclStrStrHashMap.Create(FCapacity); + for I := 0 to FCapacity - 1 do + begin + NewEntryArray := NewMap.FBuckets[I].Entries; + SetLength(NewEntryArray, Length(FBuckets[I].Entries)); + for J := 0 to FBuckets[I].Count - 1 do + begin + NewEntryArray[J].Key := FBuckets[I].Entries[J].Key; + NewEntryArray[J].Value := FBuckets[I].Entries[J].Value; + end; + NewMap.FBuckets[I].Count := FBuckets[I].Count; + end; + Result := NewMap; +end; + +function TJclStrStrHashMap.ContainsKey(const Key: string): Boolean; +var + I: Integer; + Bucket: PJclStrStrBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Key = '' then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(HashString(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := True; + Break; + end; +end; + +function TJclStrStrHashMap.ContainsValue(const Value: string): Boolean; +var + I, J: Integer; + Bucket: PJclStrStrBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Value = '' then + Exit; + for J := 0 to FCapacity - 1 do + begin + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[J]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Value = Value then + begin + Result := True; + Exit; + end; + end; +end; + +function TJclStrStrHashMap.Equals(AMap: IJclStrStrMap): Boolean; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FCount <> AMap.Size then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + if AMap.ContainsKey(FBuckets[I].Entries[J].Key) then + begin + if AMap.GetValue(FBuckets[I].Entries[J].Key) <> + FBuckets[I].Entries[J].Value then + begin + Result := False; + Exit; + end; + end + else + begin + Result := False; + Exit; + end; +end; + +function TJclStrStrHashMap.GetValue(const Key: string): string; +var + I: Integer; + Bucket: PJclStrStrBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := ''; + if Key = '' then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(HashString(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := Bucket.Entries[I].Value; + Break; + end; +end; + +procedure TJclStrStrHashMap.GrowEntries(BucketIndex: Integer); +var + Capacity: Integer; +begin + Capacity := Length(FBuckets[BucketIndex].Entries); + if Capacity > 64 then + Capacity := Capacity + Capacity div 4 + else + Capacity := Capacity * 4; + SetLength(FBuckets[BucketIndex].Entries, Capacity); +end; + +function TJclStrStrHashMap.HashMul(Key: Cardinal): Cardinal; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Trunc(FCapacity * (Frac(Key * A))); +end; + +function TJclStrStrHashMap.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclStrStrHashMap.KeyOfValue(const Value: string): string; +var + I, J: Integer; + Bucket: PJclStrStrBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if Value = '' then + Exit; + for J := 0 to FCapacity - 1 do + begin + Bucket := {$IFNDEF CLR}@{$ENDIF}(FBuckets[J]); + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Value = Value then + begin + Result := Bucket.Entries[I].Key; + Exit; + end; + end; + {$IFDEF CLR} + raise EJclError.CreateFmt(RsEValueNotFound, [Value]); + {$ELSE} + raise EJclError.CreateResFmt(@RsEValueNotFound, [Value]); + {$ENDIF CLR} +end; + +function TJclStrStrHashMap.KeySet: IJclStrSet; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclStrArraySet.Create(FCapacity); + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Key); +end; + +procedure TJclStrStrHashMap.PutAll(AMap: IJclStrStrMap); +var + It: IJclStrIterator; + Key: string; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$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; +end; + +procedure TJclStrStrHashMap.PutValue(const Key, Value: string); +var + Index: Integer; + Bucket: PJclStrStrBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if Key = '' then + Exit; + if Value = '' then + Exit; + Index := FHashFunction(HashString(Key)); + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[Index]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Bucket.Entries[I].Value := Value; + Exit; + end; + if Bucket.Count = Length(Bucket.Entries) then + GrowEntries(Index); + Bucket.Entries[Bucket.Count].Key := Key; + Bucket.Entries[Bucket.Count].Value := Value; + Inc(Bucket.Count); + Inc(FCount); +end; + +function TJclStrStrHashMap.Remove(const Key: string): string; +var + Bucket: PJclStrStrBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := ''; + if Key = '' then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(HashString(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := Bucket.Entries[I].Value; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Count - I); + Dec(Bucket.Count); + Dec(FCount); + Break; + end; +end; + +function TJclStrStrHashMap.Size: Integer; +begin + Result := FCount; +end; + +function TJclStrStrHashMap.Values: IJclStrCollection; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclStrArrayList.Create(FCapacity); + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Value); +end; + +function TJclStrStrHashMap.HashString(const Key: string): Cardinal; +var + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := 0; + for I := 1 to Length(Key) do + Result := Result + Cardinal(Ord(Key[I]) * (I - 1) * 256); +end; + +//=== { TJclStrHashMap } ===================================================== + +constructor TJclStrHashMap.Create(ACapacity: Integer = DefaultContainerCapacity; + AOwnsObjects: Boolean = True); +var + I: Integer; +begin + inherited Create; + FOwnsObjects := AOwnsObjects; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FBuckets, FCapacity); + for I := 0 to FCapacity - 1 do + SetLength(FBuckets[I].Entries, 1); + FHashFunction := HashMul; +end; + +destructor TJclStrHashMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclStrHashMap.Clear; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + for J := 0 to FBuckets[I].Count - 1 do + begin + FBuckets[I].Entries[J].Key := ''; + FreeObject(FBuckets[I].Entries[J].Value); + end; + FBuckets[I].Count := 0; + end; + FCount := 0; +end; + +function TJclStrHashMap.Clone: TObject; +var + I, J: Integer; + NewEntryArray: TJclStrEntryArray; + NewMap: TJclStrHashMap; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + NewMap := TJclStrHashMap.Create(FCapacity, False); + // Only one can have FOwnsObjects = True + for I := 0 to FCapacity - 1 do + begin + NewEntryArray := NewMap.FBuckets[I].Entries; + SetLength(NewEntryArray, Length(FBuckets[I].Entries)); + for J := 0 to FBuckets[I].Count - 1 do + begin + NewEntryArray[J].Key := FBuckets[I].Entries[J].Key; + NewEntryArray[J].Value := FBuckets[I].Entries[J].Value; + end; + NewMap.FBuckets[I].Count := FBuckets[I].Count; + end; + Result := NewMap; +end; + +function TJclStrHashMap.ContainsKey(const Key: string): Boolean; +var + I: Integer; + Bucket: PJclStrBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Key = '' then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(HashString(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := True; + Break; + end; +end; + +function TJclStrHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: PJclStrBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Value = nil then + Exit; + for J := 0 to FCapacity - 1 do + begin + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[J]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Value = Value then + begin + Result := True; + Exit; + end; + end; +end; + +function TJclStrHashMap.Equals(AMap: IJclStrMap): Boolean; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FCount <> AMap.Size then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + if AMap.ContainsKey(FBuckets[I].Entries[J].Key) then + begin + if AMap.GetValue(FBuckets[I].Entries[J].Key) <> + FBuckets[I].Entries[J].Value then + begin + Result := False; + Exit; + end; + end + else + begin + Result := False; + Exit; + end; +end; + +function TJclStrHashMap.GetValue(const Key: string): TObject; +var + I: Integer; + Bucket: PJclStrBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if Key = '' then + Exit; + I := FHashFunction(HashString(Key)); + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[I]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := Bucket.Entries[I].Value; + Break; + end; +end; + +procedure TJclStrHashMap.FreeObject(var AObject: TObject); +begin + if FOwnsObjects then + begin + AObject.Free; + AObject := nil; + end; +end; + +procedure TJclStrHashMap.GrowEntries(BucketIndex: Integer); +var + Capacity: Integer; +begin + Capacity := Length(FBuckets[BucketIndex].Entries); + if Capacity > 64 then + Capacity := Capacity + Capacity div 4 + else + Capacity := Capacity * 4; + SetLength(FBuckets[BucketIndex].Entries, Capacity); +end; + +function TJclStrHashMap.HashMul(Key: Cardinal): Cardinal; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Trunc(FCapacity * (Frac(Key * A))); + //Result := LongRec(Key).Bytes[1] and $FF; +end; + +function TJclStrHashMap.HashString(const Key: string): Cardinal; +var + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := 0; + for I := 1 to Length(Key) do + Result := Result + Cardinal(Ord(Key[I]) * (I - 1) * 256); +end; + +function TJclStrHashMap.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclStrHashMap.KeySet: IJclStrSet; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclStrArraySet.Create(FCapacity); + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Key); +end; + +procedure TJclStrHashMap.PutAll(AMap: IJclStrMap); +var + It: IJclStrIterator; + Key: string; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$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; +end; + +procedure TJclStrHashMap.PutValue(const Key: string; Value: TObject); +var + Index: Integer; + Bucket: PJclStrBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if Key = '' then + Exit; + if Value = nil then + Exit; + Index := FHashFunction(HashString(Key)); + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[Index]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Bucket.Entries[I].Value := Value; + Exit; + end; + if Bucket.Count = Length(Bucket.Entries) then + GrowEntries(Index); + Bucket.Entries[Bucket.Count].Key := Key; + Bucket.Entries[Bucket.Count].Value := Value; + Inc(Bucket.Count); + Inc(FCount); +end; + +function TJclStrHashMap.Remove(const Key: string): TObject; +var + Bucket: PJclStrBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if Key = '' then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(HashString(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + if not FOwnsObjects then + Result := Bucket.Entries[I].Value + else + Bucket.Entries[I].Value.Free; + Bucket.Entries[I].Key := ''; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Count - I); + Dec(Bucket.Count); + Dec(FCount); + Break; + end; +end; + +function TJclStrHashMap.Size: Integer; +begin + Result := FCount; +end; + +function TJclStrHashMap.Values: IJclCollection; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FCapacity, False); // NEVER Owns Objects ! + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Value); +end; + +//=== { TJclHashMap } ======================================================== + +constructor TJclHashMap.Create(ACapacity: Integer = DefaultContainerCapacity; + AOwnsObjects: Boolean = True); +var + I: Integer; +begin + inherited Create; + FOwnsObjects := AOwnsObjects; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FBuckets, FCapacity); + for I := 0 to FCapacity - 1 do + SetLength(FBuckets[I].Entries, 64); + FHashFunction := HashMul; +end; + +destructor TJclHashMap.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclHashMap.Clear; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + for I := 0 to FCapacity - 1 do + begin + for J := 0 to FBuckets[I].Count - 1 do + begin + FBuckets[I].Entries[J].Key := nil; // Free key ? + FreeObject(FBuckets[I].Entries[J].Value); + end; + FBuckets[I].Count := 0; + end; + FCount := 0; +end; + +function TJclHashMap.Clone: TObject; +var + I, J: Integer; + NewEntryArray: TJclEntryArray; + NewMap: TJclHashMap; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + NewMap := TJclHashMap.Create(FCapacity, FOwnsObjects); + for I := 0 to FCapacity - 1 do + begin + NewEntryArray := NewMap.FBuckets[I].Entries; + SetLength(NewEntryArray, Length(FBuckets[I].Entries)); + for J := 0 to FBuckets[I].Count - 1 do + begin + NewEntryArray[J].Key := FBuckets[I].Entries[J].Key; + NewEntryArray[J].Value := FBuckets[I].Entries[J].Value; + end; + NewMap.FBuckets[I].Count := FBuckets[I].Count; + end; + Result := NewMap; +end; + +function TJclHashMap.ContainsKey(Key: TObject): Boolean; +var + I: Integer; + Bucket: PJclBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Key = nil then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(Integer(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := True; + Exit; + end; +end; + +function TJclHashMap.ContainsValue(Value: TObject): Boolean; +var + I, J: Integer; + Bucket: PJclBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if Value = nil then + Exit; + for J := 0 to FCapacity - 1 do + begin + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[J]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Value = Value then + begin + Result := True; + Exit; + end; + end; +end; + +function TJclHashMap.Equals(AMap: IJclMap): Boolean; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AMap = nil then + Exit; + if FCount <> AMap.Size then + Exit; + Result := True; + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + if AMap.ContainsKey(FBuckets[I].Entries[J].Key) then + begin + if AMap.GetValue(FBuckets[I].Entries[J].Key) <> + FBuckets[I].Entries[J].Value then + begin + Result := False; + Exit; + end; + end + else + begin + Result := False; + Exit; + end; +end; + +procedure TJclHashMap.FreeObject(var AObject: TObject); +begin + if FOwnsObjects then + begin + AObject.Free; + AObject := nil; + end; +end; + +function TJclHashMap.GetValue(Key: TObject): TObject; +var + I: Integer; + Bucket: PJclBucket; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if Key = nil then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(Integer(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Result := Bucket.Entries[I].Value; + Break; + end; +end; + +procedure TJclHashMap.GrowEntries(BucketIndex: Integer); +var + Capacity: Integer; +begin + Capacity := Length(FBuckets[BucketIndex].Entries); + if Capacity > 64 then + Capacity := Capacity + Capacity div 4 + else + Capacity := Capacity * 4; + SetLength(FBuckets[BucketIndex].Entries, Capacity); +end; + +function TJclHashMap.HashMul(Key: Cardinal): Cardinal; +const + A = 0.6180339887; // (sqrt(5) - 1) / 2 +begin + Result := Trunc(FCapacity * (Frac(Key * A))); + //Result := LongRec(Key).Bytes[1] and $FF; +end; + +function TJclHashMap.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclHashMap.KeySet: IJclSet; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclArraySet.Create(FCapacity, False); // NEVER Owns Objects ! + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Key); +end; + +procedure TJclHashMap.PutAll(AMap: IJclMap); +var + It: IJclIterator; + Key: TObject; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$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; +end; + +procedure TJclHashMap.PutValue(Key, Value: TObject); +var + Index: Integer; + Bucket: PJclBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if Key = nil then + Exit; + if Value = nil then + Exit; + Index := FHashFunction(Integer(Key)); + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[Index]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + Bucket.Entries[I].Value := Value; + Exit; + end; + if Bucket.Count = Length(Bucket.Entries) then + GrowEntries(Index); + begin + Bucket.Entries[Bucket.Count].Key := Key; + Bucket.Entries[Bucket.Count].Value := Value; + end; + Inc(Bucket.Count); + Inc(FCount); +end; + +function TJclHashMap.Remove(Key: TObject): TObject; +var + Bucket: PJclBucket; + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if Key = nil then + Exit; + Bucket := {$IFNDEF CLR}@{$ENDIF}FBuckets[FHashFunction(Integer(Key))]; + for I := 0 to Bucket.Count - 1 do + if Bucket.Entries[I].Key = Key then + begin + if not FOwnsObjects then + Result := Bucket.Entries[I].Value + else + Bucket.Entries[I].Value.Free; + if I < Length(Bucket.Entries) - 1 then + MoveArray(Bucket.Entries, I + 1, I, Bucket.Count - I); + Dec(Bucket.Count); + Dec(FCount); + Break; + end; +end; + +function TJclHashMap.Size: Integer; +begin + Result := FCount; +end; + +function TJclHashMap.Values: IJclCollection; +var + I, J: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := TJclArrayList.Create(FCapacity, False); // NEVER Owns Objects ! + for I := 0 to FCapacity - 1 do + for J := 0 to FBuckets[I].Count - 1 do + Result.Add(FBuckets[I].Entries[J].Value); +end; + +// History: + +// $Log: JclHashMaps.pas,v $ +// Revision 1.8 2005/08/09 10:30:21 ahuser +// JCL.NET changes +// +// Revision 1.7 2005/08/07 14:14:34 outchy +// IT3044: The Count was not decremented after the removal of an item. +// +// Revision 1.6 2005/05/05 20:08:42 ahuser +// JCL.NET support +// +// Revision 1.5 2005/04/29 15:31:56 outchy +// IT2890, a string reference was not decremented as expected. +// +// Revision 1.4 2005/03/08 08:33:16 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.3 2005/02/27 11:36:20 marquardt +// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec +// +// Revision 1.2 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclHashSets.pas b/official/1.96/source/common/JclHashSets.pas new file mode 100644 index 0000000..76732b7 --- /dev/null +++ b/official/1.96/source/common/JclHashSets.pas @@ -0,0 +1,645 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:43 $ +// For history see end of file + +unit JclHashSets; + +{$I jcl.inc} + +interface + +uses + Classes, + JclBase, JclAbstractContainers, JclContainerIntf, JclHashMaps; + +type + TJclIntfHashSet = class(TJclAbstractContainer, IJclIntfCollection, + IJclIntfSet, IJclIntfCloneable) + private + FMap: IJclIntfIntfMap; + protected + { IJclIntfCollection } + function Add(AInterface: IInterface): Boolean; + function AddAll(ACollection: IJclIntfCollection): Boolean; + procedure Clear; + function Contains(AInterface: IInterface): Boolean; + function ContainsAll(ACollection: IJclIntfCollection): Boolean; + function Equals(ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(AInterface: IInterface): Boolean; + function RemoveAll(ACollection: IJclIntfCollection): Boolean; + function RetainAll(ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + { IJclIntfSet } + procedure Intersect(ACollection: IJclIntfCollection); + procedure Subtract(ACollection: IJclIntfCollection); + procedure Union(ACollection: IJclIntfCollection); + { IJclIntfCloneable } + function Clone: IInterface; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + destructor Destroy; override; + end; + + //Daniele Teti 02/03/2005 + TJclStrHashSet = class(TJclStrCollection, IJclStrSet, IJclCloneable) + private + FMap: IJclStrMap; + protected + { IJclStrCollection } + function Add(const AString: string): Boolean; override; + function AddAll(ACollection: IJclStrCollection): Boolean; override; + procedure Clear; override; + function Contains(const AString: string): Boolean; override; + function ContainsAll(ACollection: IJclStrCollection): Boolean; override; + function Equals(ACollection: IJclStrCollection): Boolean; override; + function First: IJclStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclStrIterator; override; + function Remove(const AString: string): Boolean; override; + function RemoveAll(ACollection: IJclStrCollection): Boolean; override; + function RetainAll(ACollection: IJclStrCollection): Boolean; override; + function Size: Integer; override; + { IJclIntfSet } + procedure Intersect(ACollection: IJclStrCollection); + procedure Subtract(ACollection: IJclStrCollection); + procedure Union(ACollection: IJclStrCollection); + { IJclIntfCloneable } + function Clone: TObject; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + destructor Destroy; override; + end; + + TJclHashSet = class(TJclAbstractContainer, IJclCollection, IJclSet, IJclCloneable) + private + FMap: IJclMap; + protected + { IJclCollection } + function Add(AObject: TObject): Boolean; + function AddAll(ACollection: IJclCollection): Boolean; + procedure Clear; + function Contains(AObject: TObject): Boolean; + function ContainsAll(ACollection: IJclCollection): Boolean; + function Equals(ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; + function RemoveAll(ACollection: IJclCollection): Boolean; + function RetainAll(ACollection: IJclCollection): Boolean; + function Size: Integer; + { IJclSet } + procedure Intersect(ACollection: IJclCollection); + procedure Subtract(ACollection: IJclCollection); + procedure Union(ACollection: IJclCollection); + { IJclCloneable } + function Clone: TObject; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity; + AOwnsObject: Boolean = False); + destructor Destroy; override; + end; + +implementation + +{$IFDEF CLR} +var + GlobalRefUnique: TObject = nil; + +function RefUnique: TObject; +begin + // We keep the reference till program end. A unique memory address is not + // possible under a garbage collector. + if GlobalRefUnique = nil then + GlobalRefUnique := TObject.Create; + Result := GlobalRefUnique; +end; +{$ELSE} +var + // Here we have TObject reference that points to the data segment. A memory + // manager cannot return this address. + RefUnique: TObject {$IFNDEF FPC} = @RefUnique {$ENDIF}; +{$ENDIF CLR} + +var + IRefUnique: IInterface = nil; + +//=== { TJclIntfHashSet } ==================================================== + +constructor TJclIntfHashSet.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FMap := TJclIntfIntfHashMap.Create(ACapacity); + if IRefUnique = nil then + IRefUnique := TInterfacedObject.Create; +end; + +destructor TJclIntfHashSet.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TJclIntfHashSet.Add(AInterface: IInterface): Boolean; +begin + Result := not FMap.ContainsKey(AInterface); + if Result then + FMap.PutValue(AInterface, IRefUnique); +end; + +function TJclIntfHashSet.AddAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + Result := ACollection <> nil; + if Result then + begin + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) and Result; + end; +end; + +procedure TJclIntfHashSet.Clear; +begin + FMap.Clear; +end; + +function TJclIntfHashSet.Clone: IInterface; +var + NewSet: TJclIntfHashSet; +begin + NewSet := TJclIntfHashSet.Create; + NewSet.FMap := IJclIntfIntfMap(IJclIntfCloneable(FMap).Clone); + Result := NewSet; +end; + +function TJclIntfHashSet.Contains(AInterface: IInterface): Boolean; +begin + Result := FMap.ContainsKey(AInterface); +end; + +function TJclIntfHashSet.ContainsAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); +end; + +function TJclIntfHashSet.Equals(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + ItMap: IJclIntfIterator; +begin + Result := False; + if ACollection = nil then + Exit; + if FMap.Size <> ACollection.Size then + Exit; + It := ACollection.First; + ItMap := FMap.Values.First; + while ItMap.HasNext do + if ItMap.Next <> It.Next then + Exit; + Result := True; +end; + +function TJclIntfHashSet.First: IJclIntfIterator; +begin + Result := FMap.KeySet.First; +end; + +procedure TJclIntfHashSet.Intersect(ACollection: IJclIntfCollection); +begin + RetainAll(ACollection); +end; + +function TJclIntfHashSet.IsEmpty: Boolean; +begin + Result := FMap.IsEmpty; +end; + +function TJclIntfHashSet.Last: IJclIntfIterator; +begin + Result := FMap.KeySet.Last; +end; + +function TJclIntfHashSet.Remove(AInterface: IInterface): Boolean; +begin + Result := FMap.Remove(AInterface) = IInterface(IRefUnique); +end; + +function TJclIntfHashSet.RemoveAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclIntfHashSet.RetainAll(ACollection: IJclIntfCollection): Boolean; +var + ItMap: IJclIntfIterator; +begin + Result := False; + if ACollection = nil then + Exit; + ItMap := FMap.Values.First; + while ItMap.HasNext do + if not ACollection.Contains(ItMap.Next) then + ItMap.Remove; +end; + +function TJclIntfHashSet.Size: Integer; +begin + Result := FMap.Size; +end; + +procedure TJclIntfHashSet.Subtract(ACollection: IJclIntfCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclIntfHashSet.Union(ACollection: IJclIntfCollection); +begin + AddAll(ACollection); +end; + +//=== { TJclStrHashSet } ===================================================== + +constructor TJclStrHashSet.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FMap := TJclStrHashMap.Create(ACapacity, False); +end; + +destructor TJclStrHashSet.Destroy; +begin + Clear; + // (rom) no Free of FMap? + inherited Destroy; +end; + +function TJclStrHashSet.Add(const AString: string): Boolean; +begin + Result := not FMap.ContainsKey(AString); + if Result then + FMap.PutValue(AString, RefUnique); +end; + +function TJclStrHashSet.AddAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +begin + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; + +procedure TJclStrHashSet.Clear; +begin + FMap.Clear; +end; + +function TJclStrHashSet.Clone: TObject; +var + NewSet: TJclStrHashSet; +begin + NewSet := TJclStrHashSet.Create; + NewSet.FMap := TJclStrHashMap(IJclCloneable(FMap).Clone); + Result := NewSet; +end; + +function TJclStrHashSet.Contains(const AString: string): Boolean; +begin + Result := FMap.ContainsKey(AString); +end; + +function TJclStrHashSet.ContainsAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +begin + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); +end; + +function TJclStrHashSet.Equals(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; + ItMap: IJclStrIterator; +begin + Result := False; + if ACollection = nil then + Exit; + if FMap.Size <> ACollection.Size then + Exit; + It := ACollection.First; + ItMap := FMap.KeySet.First; + while ItMap.HasNext do + if ItMap.Next <> It.Next then + Exit; + Result := True; +end; + +function TJclStrHashSet.First: IJclStrIterator; +begin + Result := FMap.KeySet.First; +end; + +procedure TJclStrHashSet.Intersect(ACollection: IJclStrCollection); +begin + RetainAll(ACollection); +end; + +function TJclStrHashSet.IsEmpty: Boolean; +begin + Result := FMap.IsEmpty; +end; + +function TJclStrHashSet.Last: IJclStrIterator; +begin + Result := FMap.KeySet.Last; +end; + +function TJclStrHashSet.Remove(const AString: string): Boolean; +begin + Result := FMap.Remove(AString) = RefUnique; +end; + +function TJclStrHashSet.RemoveAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +begin + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclStrHashSet.RetainAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +begin + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + if not FMap.ContainsKey(It.Next) then + FMap.Remove(It.Next); +end; + +function TJclStrHashSet.Size: Integer; +begin + Result := FMap.Size; +end; + +procedure TJclStrHashSet.Subtract(ACollection: IJclStrCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclStrHashSet.Union(ACollection: IJclStrCollection); +begin + AddAll(ACollection); +end; + +//=== { TJclHashSet } ======================================================== + +constructor TJclHashSet.Create(ACapacity: Integer = DefaultContainerCapacity; + AOwnsObject: Boolean = False); +begin + inherited Create; + FMap := TJclHashMap.Create(ACapacity, AOwnsObject); +end; + +destructor TJclHashSet.Destroy; +begin + Clear; + // (rom) no Free of FMap? + inherited Destroy; +end; + +function TJclHashSet.Add(AObject: TObject): Boolean; +begin + Result := not FMap.ContainsKey(AObject); + if Result then + FMap.PutValue(AObject, RefUnique); +end; + +function TJclHashSet.AddAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; + +procedure TJclHashSet.Clear; +begin + FMap.Clear; +end; + +function TJclHashSet.Clone: TObject; +var + NewSet: TJclHashSet; +begin + NewSet := TJclHashSet.Create; + NewSet.FMap := TJclHashMap(IJclCloneable(FMap).Clone); + Result := NewSet; +end; + +function TJclHashSet.Contains(AObject: TObject): Boolean; +begin + Result := FMap.ContainsKey(AObject); +end; + +function TJclHashSet.ContainsAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); +end; + +function TJclHashSet.Equals(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + ItMap: IJclIterator; +begin + Result := False; + if ACollection = nil then + Exit; + if FMap.Size <> ACollection.Size then + Exit; + It := ACollection.First; + ItMap := FMap.Values.First; + while ItMap.HasNext do + if ItMap.Next <> It.Next then + Exit; + Result := True; +end; + +function TJclHashSet.First: IJclIterator; +begin + Result := FMap.KeySet.First; +end; + +procedure TJclHashSet.Intersect(ACollection: IJclCollection); +begin + RetainAll(ACollection); +end; + +function TJclHashSet.IsEmpty: Boolean; +begin + Result := FMap.IsEmpty; +end; + +function TJclHashSet.Last: IJclIterator; +begin + Result := FMap.KeySet.Last; +end; + +function TJclHashSet.Remove(AObject: TObject): Boolean; +begin + Result := FMap.Remove(AObject) = RefUnique; +end; + +function TJclHashSet.RemoveAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclHashSet.RetainAll(ACollection: IJclCollection): Boolean; +var + ItMap: IJclIterator; +begin + Result := False; + if ACollection = nil then + Exit; + ItMap := FMap.Values.First; + while ItMap.HasNext do + if not ACollection.Contains(ItMap.Next) then + ItMap.Remove; +end; + +function TJclHashSet.Size: Integer; +begin + Result := FMap.Size; +end; + +procedure TJclHashSet.Subtract(ACollection: IJclCollection); +begin + RemoveAll(ACollection); +end; + +procedure TJclHashSet.Union(ACollection: IJclCollection); +begin + AddAll(ACollection); +end; + +{$IFDEF FPC} +initialization + RefUnique := @RefUnique; +{$ENDIF FPC} + +// History: + +// $Log: JclHashSets.pas,v $ +// Revision 1.9 2005/05/05 20:08:43 ahuser +// JCL.NET support +// +// Revision 1.8 2005/04/17 23:00:10 rrossmair +// - changed to compile with FPC +// +// Revision 1.7 2005/03/03 08:02:57 marquardt +// various style cleanings, bugfixes and improvements +// +// Revision 1.6 2005/03/02 17:51:24 rrossmair +// - removed DCLAppendDelimited from JclAlgorithms, changed uses clauses accordingly +// +// Revision 1.5 2005/03/02 09:59:30 dade2004 +// Added +// -TJclStrCollection in JclContainerIntf +// Every common methods for IJclStrCollection are implemented here +// +// -Every class that implement IJclStrCollection now derive from TJclStrCollection instead of TJclAbstractContainer +// -Every abstract method in TJclStrCollection has been marked as "override" in descendent classes +// +// DCLAppendDelimited has been removed from JclAlgorothms, his body has been fixed for a bug and put into +// relative method in TJclStrCollection +// +// Revision 1.4 2005/02/27 11:36:20 marquardt +// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec +// +// Revision 1.3 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.2 2005/02/24 07:36:24 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclIniFiles-1.92.int b/official/1.96/source/common/JclIniFiles-1.92.int new file mode 100644 index 0000000..f041c1c --- /dev/null +++ b/official/1.96/source/common/JclIniFiles-1.92.int @@ -0,0 +1,55 @@ +unit JclIniFiles; + +{$I jcl.inc} + +interface +uses + Classes, IniFiles, SysUtils; + +//-------------------------------------------------------------------------------------------------- +// 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); + +//-------------------------------------------------------------------------------------------------- +// IniFile interface without localized texts +//-------------------------------------------------------------------------------------------------- + +type + TJclISOMemIniFile = class(TMemIniFile) + public + function ReadDate(const Section, Name: string; Default: TDateTime): TDateTime; override; + function ReadDateTime(const Section, Name: string; Default: TDateTime): TDateTime; override; + function ReadFloat(const Section, Name: string; Default: Double): Double; override; + function ReadTime(const Section, Name: string; Default: TDateTime): TDateTime; override; + procedure WriteDate(const Section, Name: string; Value: TDateTime); override; + procedure WriteDateTime(const Section, Name: string; Value: TDateTime); override; + procedure WriteFloat(const Section, Name: string; Value: Double); override; + procedure WriteTime(const Section, Name: string; Value: TDateTime); override; + end; + + TJclISOIniFile = class(TIniFile) + public + function ReadDate(const Section, Name: string; Default: TDateTime): TDateTime; override; + function ReadDateTime(const Section, Name: string; Default: TDateTime): TDateTime; override; + function ReadFloat(const Section, Name: string; Default: Double): Double; override; + function ReadTime(const Section, Name: string; Default: TDateTime): TDateTime; override; + procedure WriteDate(const Section, Name: string; Value: TDateTime); override; + procedure WriteDateTime(const Section, Name: string; Value: TDateTime); override; + procedure WriteFloat(const Section, Name: string; Value: Double); override; + procedure WriteTime(const Section, Name: string; Value: TDateTime); override; + end; + diff --git a/official/1.96/source/common/JclIniFiles.pas b/official/1.96/source/common/JclIniFiles.pas new file mode 100644 index 0000000..6668ca3 --- /dev/null +++ b/official/1.96/source/common/JclIniFiles.pas @@ -0,0 +1,200 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/05/05 20:08:43 $ +// For history see end of file + +unit JclIniFiles; + +{$I jcl.inc} + +interface + +uses + SysUtils, Classes, IniFiles; + +// 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); + +implementation + +{$IFDEF CLR} +type + TIniFile = TMemIniFile; +{$ENDIF CLR} + +// 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); + {$IFDEF CLR} + Ini.UpdateFile; + {$ENDIF CLR} + 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); + {$IFDEF CLR} + Ini.UpdateFile; + {$ENDIF CLR} + 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); + {$IFDEF CLR} + Ini.UpdateFile; + {$ENDIF CLR} + 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; + +// History: + +// $Log: JclIniFiles.pas,v $ +// Revision 1.10 2005/05/05 20:08:43 ahuser +// JCL.NET support +// +// Revision 1.9 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.8 2004/09/28 14:22:01 rrossmair +// removed PH contributions +// +// Revision 1.7 2004/07/30 07:20:25 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate +// +// Revision 1.6 2004/06/02 03:23:46 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.5 2004/05/14 15:24:46 rrossmair +// fixed header +// +// Revision 1.4 2004/05/05 00:04:11 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// + +end. diff --git a/official/1.96/source/common/JclLinkedLists.pas b/official/1.96/source/common/JclLinkedLists.pas new file mode 100644 index 0000000..244a4b9 --- /dev/null +++ b/official/1.96/source/common/JclLinkedLists.pas @@ -0,0 +1,2596 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/07 14:33:48 $ +// For history see end of file + +unit JclLinkedLists; + +{$I jcl.inc} + +interface + +uses + Classes, + JclBase, JclAbstractContainers, JclContainerIntf; + +type + {$IFDEF CLR} + TJclIntfLinkedListItem = class; + PJclIntfLinkedListItem = TJclIntfLinkedListItem; + TJclIntfLinkedListItem = class + {$ELSE} + PJclIntfLinkedListItem = ^TJclIntfLinkedListItem; + TJclIntfLinkedListItem = record + {$ENDIF CLR} + Obj: IInterface; + Next: PJclIntfLinkedListItem; + end; + + {$IFDEF CLR} + TJclStrLinkedListItem = class; + PJclStrLinkedListItem = TJclStrLinkedListItem; + TJclStrLinkedListItem = class + {$ELSE} + PJclStrLinkedListItem = ^TJclStrLinkedListItem; + TJclStrLinkedListItem = record + {$ENDIF CLR} + Str: string; + Next: PJclStrLinkedListItem; + end; + + {$IFDEF CLR} + TJclLinkedListItem = class; + PJclLinkedListItem = TJclLinkedListItem; + TJclLinkedListItem = class + {$ELSE} + PJclLinkedListItem = ^TJclLinkedListItem; + TJclLinkedListItem = record + {$ENDIF CLR} + Obj: TObject; + Next: PJclLinkedListItem; + end; + + TJclIntfLinkedList = class(TJclAbstractContainer, IJclIntfCollection, + IJclIntfList, IJclIntfCloneable) + private + FStart: PJclIntfLinkedListItem; + FEnd: PJclIntfLinkedListItem; + FSize: Integer; + protected + procedure AddFirst(AInterface: IInterface); + { IJclIntfCollection } + function Add(AInterface: IInterface): Boolean; overload; + function AddAll(ACollection: IJclIntfCollection): Boolean; overload; + procedure Clear; + function Contains(AInterface: IInterface): Boolean; + function ContainsAll(ACollection: IJclIntfCollection): Boolean; + function Equals(ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(AInterface: IInterface): Boolean; overload; + function RemoveAll(ACollection: IJclIntfCollection): Boolean; + function RetainAll(ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + { IJclIntfList } + procedure Insert(Index: Integer; AInterface: IInterface); overload; + function InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; overload; + function GetObject(Index: Integer): IInterface; + function IndexOf(AInterface: IInterface): Integer; + function LastIndexOf(AInterface: IInterface): Integer; + function Remove(Index: Integer): IInterface; overload; + procedure SetObject(Index: Integer; AInterface: IInterface); + function SubList(First, Count: Integer): IJclIntfList; + { IJclIntfCloneable } + function Clone: IInterface; + public + constructor Create(ACollection: IJclIntfCollection = nil); + destructor Destroy; override; + end; + + //Daniele Teti 02/03/2005 + TJclStrLinkedList = class(TJclStrCollection, IJclStrList, IJclCloneable) + private + FStart: PJclStrLinkedListItem; + FEnd: PJclStrLinkedListItem; + FSize: Integer; + protected + procedure AddFirst(const AString: string); + { IJclIntfCollection } + function Add(const AString: string): Boolean; overload; override; + function AddAll(ACollection: IJclStrCollection): Boolean; overload; override; + procedure Clear; override; + function Contains(const AString: string): Boolean; override; + function ContainsAll(ACollection: IJclStrCollection): Boolean; override; + function Equals(ACollection: IJclStrCollection): Boolean; override; + function First: IJclStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclStrIterator; override; + function Remove(const AString: string): Boolean; overload; override; + function RemoveAll(ACollection: IJclStrCollection): Boolean; override; + function RetainAll(ACollection: IJclStrCollection): Boolean; override; + function Size: Integer; override; + { IJclIntfList } + procedure Insert(Index: Integer; const AString: string); overload; + function InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; overload; + function GetString(Index: Integer): string; + function IndexOf(const AString: string): Integer; + function LastIndexOf(const AString: string): Integer; + function Remove(Index: Integer): string; overload; + procedure SetString(Index: Integer; const AString: string); + function SubList(First, Count: Integer): IJclStrList; + { IJclCloneable } + function Clone: TObject; + public + constructor Create(ACollection: IJclStrCollection = nil); + destructor Destroy; override; + end; + + TJclLinkedList = class(TJclAbstractContainer, IJclCollection, IJclList, + IJclCloneable) + private + FStart: PJclLinkedListItem; + FEnd: PJclLinkedListItem; + FSize: Integer; + FOwnsObjects: Boolean; + protected + procedure AddFirst(AObject: TObject); + procedure FreeObject(var AObject: TObject); + { IJclCollection } + function Add(AObject: TObject): Boolean; overload; + function AddAll(ACollection: IJclCollection): Boolean; overload; + procedure Clear; + function Contains(AObject: TObject): Boolean; + function ContainsAll(ACollection: IJclCollection): Boolean; + function Equals(ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; overload; + function RemoveAll(ACollection: IJclCollection): Boolean; + function RetainAll(ACollection: IJclCollection): Boolean; + function Size: Integer; + { IJclList } + procedure Insert(Index: Integer; AObject: TObject); overload; + function InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; overload; + function GetObject(Index: Integer): TObject; + function IndexOf(AObject: TObject): Integer; + function LastIndexOf(AObject: TObject): Integer; + function Remove(Index: Integer): TObject; overload; + procedure SetObject(Index: Integer; AObject: TObject); + function SubList(First, Count: Integer): IJclList; + { IJclCloneable } + function Clone: TObject; + public + constructor Create(ACollection: IJclCollection = nil; AOwnsObjects: Boolean = True); + destructor Destroy; override; + property OwnsObjects: Boolean read FOwnsObjects; + end; + +implementation + +uses + SysUtils, + JclResources; + +//=== { TIntfItr } =========================================================== + +type + TIntfItr = class(TJclAbstractContainer, IJclIntfIterator) + private + FCursor: PJclIntfLinkedListItem; + FOwnList: TJclIntfLinkedList; + FLastRet: PJclIntfLinkedListItem; + FSize: Integer; + protected + { IJclIterator} + procedure Add(AInterface: IInterface); + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AInterface: IInterface); + public + constructor Create(OwnList: TJclIntfLinkedList; Start: PJclIntfLinkedListItem); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TIntfItr.Create(OwnList: TJclIntfLinkedList; Start: PJclIntfLinkedListItem); +begin + inherited Create; + FCursor := Start; + FOwnList := OwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} + FLastRet := nil; + FSize := FOwnList.Size; +end; + +{$IFNDEF CLR} +destructor TIntfItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TIntfItr.Add(AInterface: IInterface); +var + NewItem: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if AInterface = nil then + Exit; + {$IFDEF CLR} + NewItem := TJclIntfLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Obj := AInterface; + if FCursor = nil then + begin + FCursor := NewItem; + NewItem.Next := nil; + end + else + begin + NewItem.Next := FCursor.Next; + FCursor.Next := NewItem; + end; + Inc(FOwnList.FSize); + Inc(FSize); +end; + +function TIntfItr.GetObject: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FCursor.Obj; +end; + +function TIntfItr.HasNext: Boolean; +begin + Result := FCursor <> nil; +end; + +function TIntfItr.HasPrevious: Boolean; +begin + // Unidirectional + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TIntfItr.Next: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + FCursor := FCursor.Next; +end; + +function TIntfItr.NextIndex: Integer; +begin + // No index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TIntfItr.Previous: IInterface; +begin + // Unidirectional + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TIntfItr.PreviousIndex: Integer; +begin + // No Index; + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +procedure TIntfItr.Remove; +var + Current: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if FCursor = nil then + Exit; + Current := FCursor; + FCursor := FCursor.Next; + if FLastRet = nil then + FOwnList.FStart := FCursor + else + FLastRet.Next := FCursor; + Current.Next := nil; + Current.Obj := nil; + {$IFDEF CLR} + Current.Free; + {$ELSE} + Dispose(Current); + {$ENDIF CLR} + Dec(FOwnList.FSize); + Dec(FSize); +end; + +procedure TIntfItr.SetObject(AInterface: IInterface); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + FCursor.Obj := AInterface; +end; + +//=== { TStrItr } ============================================================ + +type + TStrItr = class(TJclAbstractContainer, IJclStrIterator) + private + FCursor: PJclStrLinkedListItem; + FOwnList: TJclStrLinkedList; + FLastRet: PJclStrLinkedListItem; + FSize: Integer; + protected + { IJclStrIterator} + procedure Add(const AString: string); + function GetString: string; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: string; + function NextIndex: Integer; + function Previous: string; + function PreviousIndex: Integer; + procedure Remove; + procedure SetString(const AString: string); + public + constructor Create(OwnList: TJclStrLinkedList; Start: PJclStrLinkedListItem); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TStrItr.Create(OwnList: TJclStrLinkedList; Start: PJclStrLinkedListItem); +begin + inherited Create; + FCursor := Start; + FOwnList := OwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} + FLastRet := nil; + FSize := FOwnList.Size; +end; + +{$IFNDEF CLR} +destructor TStrItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TStrItr.Add(const AString: string); +var + NewItem: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if AString = '' then + Exit; + {$IFDEF CLR} + NewItem := TJclStrLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Str := AString; + if FCursor = nil then + begin + FCursor := NewItem; + NewItem.Next := nil; + end + else + begin + NewItem.Next := FCursor.Next; + FCursor.Next := NewItem; + end; + Inc(FOwnList.FSize); + Inc(FSize); +end; + +function TStrItr.GetString: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FCursor.Str; +end; + +function TStrItr.HasNext: Boolean; +begin + Result := FCursor <> nil; +end; + +function TStrItr.HasPrevious: Boolean; +begin + // Unidirectional + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TStrItr.Next: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FCursor.Str; + FLastRet := FCursor; + FCursor := FCursor.Next; +end; + +function TStrItr.NextIndex: Integer; +begin + // No index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TStrItr.Previous: string; +begin + // Unidirectional + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TStrItr.PreviousIndex: Integer; +begin + // No index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +procedure TStrItr.Remove; +var + Current: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if FCursor = nil then + Exit; + Current := FCursor; + FCursor := FCursor.Next; + if FLastRet = nil then + FOwnList.FStart := FCursor + else + FLastRet.Next := FCursor; + Current.Next := nil; + Current.Str := ''; + {$IFDEF CLR} + Current.Free; + {$ELSE} + Dispose(Current); + {$ENDIF CLR} + Dec(FOwnList.FSize); + Dec(FSize); +end; + +procedure TStrItr.SetString(const AString: string); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + FCursor.Str := AString; +end; + +//=== { TItr } =============================================================== + +type + TItr = class(TJclAbstractContainer, IJclIterator) + private + FCursor: PJclLinkedListItem; + FOwnList: TJclLinkedList; + FLastRet: PJclLinkedListItem; + FSize: Integer; + public + { IJclIterator} + procedure Add(AObject: TObject); + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AObject: TObject); + public + constructor Create(OwnList: TJclLinkedList; Start: PJclLinkedListItem); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TItr.Create(OwnList: TJclLinkedList; Start: PJclLinkedListItem); +begin + inherited Create; + FCursor := Start; + FOwnList := OwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} + FLastRet := nil; + FSize := FOwnList.Size; +end; + +{$IFNDEF CLR} +destructor TItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TItr.Add(AObject: TObject); +var + NewItem: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if AObject = nil then + Exit; + {$IFDEF CLR} + NewItem := TJclLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Obj := AObject; + if FCursor = nil then + begin + FCursor := NewItem; + NewItem.Next := nil; + end + else + begin + NewItem.Next := FCursor.Next; + FCursor.Next := NewItem; + end; + Inc(FOwnList.FSize); + Inc(FSize); +end; + +function TItr.GetObject: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FCursor.Obj; +end; + +function TItr.HasNext: Boolean; +begin + Result := FCursor <> nil; +end; + +function TItr.HasPrevious: Boolean; +begin + // Unidirectional + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TItr.Next: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := FCursor.Obj; + FLastRet := FCursor; + FCursor := FCursor.Next; +end; + +function TItr.NextIndex: Integer; +begin + // No Index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TItr.Previous: TObject; +begin + // Unidirectional + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +function TItr.PreviousIndex: Integer; +begin + // No Index + {$IFDEF CLR} + raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported); + {$ELSE} + raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported); + {$ENDIF CLR} +end; + +procedure TItr.Remove; +var + Current: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if FCursor = nil then + Exit; + Current := FCursor; + FCursor := FCursor.Next; + if FLastRet = nil then + FOwnList.FStart := FCursor + else + FLastRet.Next := FCursor; + Current.Next := nil; + if FOwnList.FOwnsObjects then + Current.Obj.Free; + Current.Obj := nil; + {$IFDEF CLR} + Current.Free; + {$ELSE} + Dispose(Current); + {$ENDIF CLR} + Dec(FOwnList.FSize); + Dec(FSize); +end; + +procedure TItr.SetObject(AObject: TObject); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + FCursor.Obj := AObject; +end; + +//=== { TJclIntfLinkedList } ================================================= + +constructor TJclIntfLinkedList.Create(ACollection: IJclIntfCollection = nil); +var + It: IJclIntfIterator; +begin + inherited Create; + FStart := nil; + FEnd := nil; + FSize := 0; + if ACollection <> nil then + begin + It := ACollection.First; + while It.HasNext do + Add(It.Next); + end; +end; + +destructor TJclIntfLinkedList.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclIntfLinkedList.Insert(Index: Integer; AInterface: IInterface); +var + I: Integer; + Current: PJclIntfLinkedListItem; + NewItem: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index > FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if AInterface = nil then + Exit; + if FStart = nil then + begin + AddFirst(AInterface); + Exit; + end; + {$IFDEF CLR} + NewItem := TJclIntfLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Obj := AInterface; + if Index = 0 then + begin + NewItem.Next := FStart; + FStart := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + I := 0; + while (Current <> nil) and (I <> Index) do + Current := Current.Next; + NewItem.Next := Current.Next; + Current.Next := NewItem; + Inc(FSize); + end; +end; + +function TJclIntfLinkedList.Add(AInterface: IInterface): Boolean; +var + NewItem: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + Result := True; + if FStart = nil then + begin + AddFirst(AInterface); + Exit; + end; + {$IFDEF CLR} + NewItem := TJclIntfLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Obj := AInterface; + NewItem.Next := nil; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); +end; + +function TJclIntfLinkedList.AddAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; + +function TJclIntfLinkedList.InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; +var + I: Integer; + It: IJclIntfIterator; + Current: PJclIntfLinkedListItem; + NewItem: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if ACollection = nil then + Exit; + It := ACollection.First; + // (rom) is this a bug? Only one element added. + if (FStart = nil) and It.HasNext then + begin + AddFirst(It.Next); + Exit; + end; + Current := FStart; + I := 0; + while (Current <> nil) and (I <> Index) do + Current := Current.Next; + while It.HasNext do + begin + {$IFDEF CLR} + NewItem := TJclIntfLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Obj := It.Next; + if Index = 0 then + begin + NewItem.Next := FStart; + FStart := NewItem; + Inc(FSize); + end + else + begin + NewItem.Next := Current.Next; + Current.Next := NewItem; + Inc(FSize); + end; + Inc(Index); + end; + Result := True; +end; + +procedure TJclIntfLinkedList.AddFirst(AInterface: IInterface); +begin + {$IFDEF CLR} + FStart := TJclIntfLinkedListItem.Create; + {$ELSE} + New(FStart); + {$ENDIF CLR} + FStart.Obj := AInterface; + FStart.Next := nil; + FEnd := FStart; + Inc(FSize); +end; + +procedure TJclIntfLinkedList.Clear; +var + I: Integer; + Old, Current: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Current := FStart; + for I := 0 to FSize - 1 do + begin + Current.Obj := nil; + //FreeObject(Current.Obj); //Daniele Teti 06 Maj 2005 // (outchy) wrong line + Old := Current; + Current := Current.Next; + {$IFDEF CLR} + Old.Free; + {$ELSE} + Dispose(Old); + {$ENDIF CLR} + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; +end; + +function TJclIntfLinkedList.Clone: IInterface; +var + NewList: IJclIntfList; +begin + NewList := TJclIntfLinkedList.Create; + NewList.AddAll(Self); + Result := NewList; +end; + +function TJclIntfLinkedList.Contains(AInterface: IInterface): Boolean; +var + I: Integer; + Current: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Obj = AInterface then + begin + Result := True; + Exit; + end; + Current := Current.Next; + end; +end; + +function TJclIntfLinkedList.ContainsAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := contains(It.Next); +end; + +function TJclIntfLinkedList.Equals(ACollection: IJclIntfCollection): Boolean; +var + It, ItSelf: IJclIntfIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if ItSelf.Next <> It.Next then + Exit; + Result := True; +end; + +function TJclIntfLinkedList.GetObject(Index: Integer): IInterface; +var + I: Integer; + Current: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := nil; + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to Index - 1 do + Current := Current.Next; + Result := Current.Obj; +end; + +function TJclIntfLinkedList.IndexOf(AInterface: IInterface): Integer; +var + I: Integer; + Current: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AInterface = nil then + Exit; + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Obj = AInterface then + begin + Result := I; + Break; + end; + Current := Current.Next; + end; +end; + +function TJclIntfLinkedList.First: IJclIntfIterator; +begin + Result := TIntfItr.Create(Self, FStart); +end; + +function TJclIntfLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclIntfLinkedList.Last: IJclIntfIterator; +begin + Result := TIntfItr.Create(Self, FStart); +end; + +function TJclIntfLinkedList.LastIndexOf(AInterface: IInterface): Integer; +var + I: Integer; + Current: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AInterface = nil then + Exit; + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Obj = AInterface then + Result := I; + Current := Current.Next; + end; +end; + +function TJclIntfLinkedList.Remove(AInterface: IInterface): Boolean; +var + I: Integer; + Old, Current: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + if FStart = nil then + Exit; + Old := nil; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Obj = AInterface then + begin + Current.Obj := nil; + if Old <> nil then + begin + Old.Next := Current.Next; + if Old.Next = nil then + FEnd := Old; + end + else + FStart := Current.Next; + {$IFDEF CLR} + Current.Free; + {$ELSE} + Dispose(Current); + {$ENDIF CLR} + Dec(FSize); + Result := True; + Exit; + end; + Old := Current; + Current := Current.Next; + end; +end; + +function TJclIntfLinkedList.Remove(Index: Integer): IInterface; +var + I: Integer; + Old, Current: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := nil; + if FStart = nil then + Exit; + Old := nil; + Current := FStart; + for I := 0 to Index - 1 do + begin + Old := Current; + Current := Current.Next; + end; + Current.Obj := nil; + if Old <> nil then + begin + Old.Next := Current.Next; + if Old.Next = nil then + FEnd := Old; + end + else + FStart := Current.Next; + {$IFDEF CLR} + Current.Free; + {$ELSE} + Dispose(Current); + {$ENDIF CLR} + Dec(FSize); +end; + +function TJclIntfLinkedList.RemoveAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclIntfLinkedList.RetainAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; +end; + +procedure TJclIntfLinkedList.SetObject(Index: Integer; AInterface: IInterface); +var + I: Integer; + Current: PJclIntfLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to Index - 1 do + Current := Current.Next; + Current.Obj := AInterface; +end; + +function TJclIntfLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclIntfLinkedList.SubList(First, Count: Integer): IJclIntfList; +var + I: Integer; + It: IJclIntfIterator; + Last: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last > FSize then + Last := FSize - 1; + Result := TJclIntfLinkedList.Create; + I := 0; + It := Self.First; + while (I < First) and It.HasNext do + begin + It.Next; + Inc(I); + end; + //I := 0; + while (I <= Last) and It.HasNext do + begin + Result.Add(It.Next); + Inc(I); + end; +end; + +//=== { TJclStrLinkedList } ================================================== + +constructor TJclStrLinkedList.Create(ACollection: IJclStrCollection = nil); +var + It: IJclStrIterator; +begin + inherited Create; + FStart := nil; + FEnd := nil; + FSize := 0; + if ACollection <> nil then + begin + It := ACollection.First; + while It.HasNext do + Add(It.Next); + end; +end; + +destructor TJclStrLinkedList.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclStrLinkedList.Insert(Index: Integer; const AString: string); +var + I: Integer; + Current: PJclStrLinkedListItem; + NewItem: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index > FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if AString = '' then + Exit; + if FStart = nil then + begin + AddFirst(AString); + Exit; + end; + {$IFDEF CLR} + NewItem := TJclStrLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Str := AString; + if Index = 0 then + begin + NewItem.Next := FStart; + FStart := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + I := 0; + while (Current <> nil) and (I <> Index) do + Current := Current.Next; + NewItem.Next := Current.Next; + Current.Next := NewItem; + Inc(FSize); + end; +end; + +function TJclStrLinkedList.Add(const AString: string): Boolean; +var + NewItem: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + Result := True; + if FStart = nil then + begin + AddFirst(AString); + Exit; + end; + {$IFDEF CLR} + NewItem := TJclStrLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Str := AString; + NewItem.Next := nil; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); +end; + +function TJclStrLinkedList.AddAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; +end; + +function TJclStrLinkedList.InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; +var + I: Integer; + It: IJclStrIterator; + Current: PJclStrLinkedListItem; + NewItem: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + + if (Index < 0) or (Index >= FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + + It := ACollection.First; + // (rom) is this a bug? Only one element added. + if (FStart = nil) and It.HasNext then + begin + AddFirst(It.Next); + //Exit; //Daniele Teti + end; + Current := FStart; + I := 0; + while (Current <> nil) and (I <> Index) do + begin + Current := Current.Next; + inc(I); + end; + while It.HasNext do + begin + {$IFDEF CLR} + NewItem := TJclStrLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Str := It.Next; + if Index = 0 then + begin + NewItem.Next := FStart; + FStart := NewItem; + Inc(FSize); + end + else + begin + NewItem.Next := Current.Next; + Current.Next := NewItem; + Inc(FSize); + end; + Inc(Index); + end; + Result := True; +end; + +procedure TJclStrLinkedList.AddFirst(const AString: string); +begin + {$IFDEF CLR} + FStart := TJclStrLinkedListItem.Create; + {$ELSE} + New(FStart); + {$ENDIF CLR} + FStart.Str := AString; + FStart.Next := nil; + FEnd := FStart; + Inc(FSize); +end; + +procedure TJclStrLinkedList.Clear; +var + I: Integer; + Old, Current: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Current := FStart; + for I := 0 to FSize - 1 do + begin + Current.Str := ''; + Old := Current; + Current := Current.Next; + {$IFDEF CLR} + Old.Free; + {$ELSE} + Dispose(Old); + {$ENDIF CLR} + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; +end; + +function TJclStrLinkedList.Clone: TObject; +var + NewList: TJclStrLinkedList; +begin + NewList := TJclStrLinkedList.Create; + NewList.AddAll(Self); + Result := NewList; +end; + +function TJclStrLinkedList.Contains(const AString: string): Boolean; +var + I: Integer; + Current: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Str = AString then + begin + Result := True; + Exit; + end; + Current := Current.Next; + end; +end; + +function TJclStrLinkedList.ContainsAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := contains(It.Next); +end; + +function TJclStrLinkedList.Equals(ACollection: IJclStrCollection): Boolean; +var + It, ItSelf: IJclStrIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if ItSelf.Next <> It.Next then + Exit; + Result := True; +end; + +function TJclStrLinkedList.First: IJclStrIterator; +begin + Result := TStrItr.Create(Self, FStart); +end; + +function TJclStrLinkedList.GetString(Index: Integer): string; +var + I: Integer; + Current: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := ''; + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to Index - 1 do + Current := Current.Next; + Result := Current.Str; +end; + +function TJclStrLinkedList.IndexOf(const AString: string): Integer; +var + I: Integer; + Current: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AString = '' then + Exit; + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Str = AString then + begin + Result := I; + Break; + end; + Current := Current.Next; + end; +end; + +function TJclStrLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclStrLinkedList.Last: IJclStrIterator; +begin + Result := TStrItr.Create(Self, FStart); +end; + +function TJclStrLinkedList.LastIndexOf(const AString: string): Integer; +var + I: Integer; + Current: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AString = '' then + Exit; + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Str = AString then + Result := I; + Current := Current.Next; + end; +end; + +function TJclStrLinkedList.Remove(Index: Integer): string; +var + I: Integer; + Old, Current: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := ''; + if FStart = nil then + Exit; + Old := nil; + Current := FStart; + for I := 0 to Index - 1 do + begin + Old := Current; + Current := Current.Next; + end; + Current.Str := ''; + if Old <> nil then + begin + Old.Next := Current.Next; + if Old.Next = nil then + FEnd := Old; + end + else + FStart := Current.Next; + {$IFDEF CLR} + Current.Free; + {$ELSE} + Dispose(Current); + {$ENDIF CLR} + Dec(FSize); +end; + +function TJclStrLinkedList.Remove(const AString: string): Boolean; +var + I: Integer; + Old, Current: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + if FStart = nil then + Exit; + Old := nil; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Str = AString then + begin + Current.Str := ''; + if Old <> nil then + begin + Old.Next := Current.Next; + if Old.Next = nil then + FEnd := Old; + end + else + FStart := Current.Next; + {$IFDEF CLR} + Current.Free; + {$ELSE} + Dispose(Current); + {$ENDIF CLR} + Dec(FSize); + Result := True; + Exit; + end; + Old := Current; + Current := Current.Next; + end; +end; + +function TJclStrLinkedList.RemoveAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclStrLinkedList.RetainAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; +end; + +procedure TJclStrLinkedList.SetString(Index: Integer; const AString: string); +var + I: Integer; + Current: PJclStrLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to Index - 1 do + Current := Current.Next; + Current.Str := AString; +end; + +function TJclStrLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclStrLinkedList.SubList(First, Count: Integer): IJclStrList; +var + I: Integer; + It: IJclStrIterator; + Last: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last > FSize then + Last := FSize - 1; + Result := TJclStrLinkedList.Create; + I := 0; + It := Self.First; + while (I < First) and It.HasNext do + begin + It.Next; + Inc(I); + end; + //I := 0; + while (I <= Last) and It.HasNext do + begin + Result.Add(It.Next); + Inc(I); + end; +end; + +//=== { TJclLinkedList } ===================================================== + +constructor TJclLinkedList.Create(ACollection: IJclCollection = nil; AOwnsObjects: Boolean = True); +var + It: IJclIterator; +begin + inherited Create; + FStart := nil; + FEnd := nil; + FSize := 0; + FOwnsObjects := AOwnsObjects; + if ACollection <> nil then + begin + It := ACollection.First; + while It.HasNext do + Add(It.Next); + end; +end; + +destructor TJclLinkedList.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclLinkedList.Insert(Index: Integer; AObject: TObject); +var + I: Integer; + Current: PJclLinkedListItem; + NewItem: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if (Index < 0) or (Index > FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if AObject = nil then + Exit; + if FStart = nil then + begin + AddFirst(AObject); + Exit; + end; + {$IFDEF CLR} + NewItem := TJclLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Obj := AObject; + if Index = 0 then + begin + NewItem.Next := FStart; + FStart := NewItem; + Inc(FSize); + end + else + begin + Current := FStart; + for I := 0 to Index - 2 do + Current := Current.Next; + NewItem.Next := Current.Next; + Current.Next := NewItem; + Inc(FSize); + end; +end; + +function TJclLinkedList.Add(AObject: TObject): Boolean; +var + NewItem: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + Result := True; + if FStart = nil then + begin + AddFirst(AObject); + Exit; + end; + {$IFDEF CLR} + NewItem := TJclLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Obj := AObject; + NewItem.Next := nil; + FEnd.Next := NewItem; + FEnd := NewItem; + Inc(FSize); +end; + +function TJclLinkedList.AddAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Add(It.Next) or Result; + Result := True; +end; + +function TJclLinkedList.InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; +var + I: Integer; + It: IJclIterator; + Current: PJclLinkedListItem; + NewItem: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if (Index < 0) or (Index > FSize) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if ACollection = nil then + Exit; + It := ACollection.First; + // (rom) is this a bug? Only one element added. + if (FStart = nil) and It.HasNext then + begin + AddFirst(It.Next); + Exit; + end; + Current := FStart; + I := 0; + while (Current <> nil) and (I <> Index) do + Current := Current.Next; + while It.HasNext do + begin + {$IFDEF CLR} + NewItem := TJclLinkedListItem.Create; + {$ELSE} + New(NewItem); + {$ENDIF CLR} + NewItem.Obj := It.Next; + if Index = 0 then + begin + NewItem.Next := FStart; + FStart := NewItem; + Inc(FSize); + end + else + begin + NewItem.Next := Current.Next; + Current.Next := NewItem; + Inc(FSize); + end; + Inc(Index); + end; + Result := True; +end; + +procedure TJclLinkedList.AddFirst(AObject: TObject); +begin + {$IFDEF CLR} + FStart := TJclLinkedListItem.Create; + {$ELSE} + New(FStart); + {$ENDIF CLR} + FStart.Obj := AObject; + FStart.Next := nil; + FEnd := FStart; + Inc(FSize); +end; + +procedure TJclLinkedList.Clear; +var + I: Integer; + Old, Current: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Current := FStart; + for I := 0 to FSize - 1 do + begin + FreeObject(Current.Obj); // (outchy) Fixed Memory Leak + //Current.Obj := nil; + Old := Current; + Current := Current.Next; + {$IFDEF CLR} + Old.Free; + {$ELSE} + Dispose(Old); + {$ENDIF CLR} + end; + FSize := 0; + + //Daniele Teti 27/12/2004 + FStart := nil; + FEnd := nil; +end; + +function TJclLinkedList.Clone: TObject; +var + NewList: TJclLinkedList; +begin + NewList := TJclLinkedList.Create; + NewList.AddAll(Self); + Result := NewList; +end; + +function TJclLinkedList.Contains(AObject: TObject): Boolean; +var + I: Integer; + Current: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Obj = AObject then + begin + Result := True; + Break; + end; + Current := Current.Next; + end; +end; + +function TJclLinkedList.ContainsAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := contains(It.Next); +end; + +function TJclLinkedList.Equals(ACollection: IJclCollection): Boolean; +var + It, ItSelf: IJclIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + if FSize <> ACollection.Size then + Exit; + It := ACollection.First; + ItSelf := First; + while ItSelf.HasNext do + if ItSelf.Next <> It.Next then + Exit; + Result := True; +end; + +procedure TJclLinkedList.FreeObject(var AObject: TObject); +begin + if FOwnsObjects then + FreeAndNil(AObject); +end; + +function TJclLinkedList.GetObject(Index: Integer): TObject; +var + I: Integer; + Current: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := nil; + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to Index - 1 do + Current := Current.Next; + Result := Current.Obj; +end; + +function TJclLinkedList.IndexOf(AObject: TObject): Integer; +var + I: Integer; + Current: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AObject = nil then + Exit; + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Obj = AObject then + begin + Result := I; + Break; + end; + Current := Current.Next; + end; +end; + +function TJclLinkedList.First: IJclIterator; +begin + Result := TItr.Create(Self, FStart); +end; + +function TJclLinkedList.IsEmpty: Boolean; +begin + Result := FSize = 0; +end; + +function TJclLinkedList.Last: IJclIterator; +begin + Result := TItr.Create(Self, FStart); +end; + +function TJclLinkedList.LastIndexOf(AObject: TObject): Integer; +var + I: Integer; + Current: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := -1; + if AObject = nil then + Exit; + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Obj = AObject then + Result := I; + Current := Current.Next; + end; +end; + +function TJclLinkedList.Remove(AObject: TObject): Boolean; +var + I: Integer; + Old, Current: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + if FStart = nil then + Exit; + Old := nil; + Current := FStart; + for I := 0 to FSize - 1 do + begin + if Current.Obj = AObject then + begin + FreeObject(Current.Obj); + if Old <> nil then + begin + Old.Next := Current.Next; + if Old.Next = nil then + FEnd := Old; + end + else + FStart := Current.Next; + {$IFDEF CLR} + Current.Free; + {$ELSE} + Dispose(Current); + {$ENDIF CLR} + Dec(FSize); + Result := True; + Exit; + end; + Old := Current; + Current := Current.Next; + end; +end; + +function TJclLinkedList.Remove(Index: Integer): TObject; +var + I: Integer; + Old, Current: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := nil; + if FStart = nil then + Exit; + Old := nil; + Current := FStart; + for I := 0 to Index - 1 do + begin + Old := Current; + Current := Current.Next; + end; + FreeObject(Current.Obj); + if Old <> nil then + begin + Old.Next := Current.Next; + if Old.Next = nil then + FEnd := Old; + end + else + FStart := Current.Next; + {$IFDEF CLR} + Current.Free; + {$ELSE} + Dispose(Current); + {$ENDIF CLR} + Dec(FSize); +end; + +function TJclLinkedList.RemoveAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Result := Remove(It.Next) and Result; +end; + +function TJclLinkedList.RetainAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Result := False; + if ACollection = nil then + Exit; + It := First; + while It.HasNext do + if not ACollection.Contains(It.Next) then + It.Remove; +end; + +procedure TJclLinkedList.SetObject(Index: Integer; AObject: TObject); +var + I: Integer; + Current: PJclLinkedListItem; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + if FStart = nil then + Exit; + Current := FStart; + for I := 0 to Index - 1 do + Current := Current.Next; + Current.Obj := AObject; +end; + +function TJclLinkedList.Size: Integer; +begin + Result := FSize; +end; + +function TJclLinkedList.SubList(First, Count: Integer): IJclList; +var + I: Integer; + It: IJclIterator; + Last: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin +{$IFDEF THREADSAFE} + CS := EnterCriticalSection; +{$ENDIF THREADSAFE} + Last := First + Count - 1; + if Last > FSize then + Last := FSize - 1; + Result := TJclLinkedList.Create; + I := 0; + It := Self.First; + while (I < First) and It.HasNext do + begin + It.Next; + Inc(I); + end; + while (I <= Last) and It.HasNext do + begin + Result.Add(It.Next); + Inc(I); + end; +end; + +{ +function TJclStrLinkedList.GetAsStrings: TStrings; +begin + Result := TStringList.Create; + try + AppendToStrings(Result); + except + Result.Free; + raise; + end; +end; + +procedure TJclStrLinkedList.LoadFromStrings(Strings: TStrings); +begin + Clear; + AppendFromStrings(Strings); +end; + +procedure TJclStrLinkedList.AppendToStrings(Strings: TStrings); +var + It: IJclStrIterator; +begin + It := First; + Strings.BeginUpdate; + try + while It.HasNext do + Strings.Add(It.Next); + finally + Strings.EndUpdate; + end; +end; + +procedure TJclStrLinkedList.SaveToStrings(Strings: TStrings); +begin + Strings.Clear; + AppendToStrings(Strings); +end; + +procedure TJclStrLinkedList.AppendFromStrings(Strings: TStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + Add(Strings[I]); +end; + +function TJclStrLinkedList.GetAsDelimited(Separator: string): string; +var + It: IJclStrIterator; +begin + It := First; + Result := ''; + if It.HasNext then + Result := It.Next; + while It.HasNext do + Result := Result + Separator + It.Next; +end; + +procedure TJclStrLinkedList.AppendDelimited(AString, Separator: string); +begin + DCLAppendDelimited(Self, AString, Separator); +end; + +procedure TJclStrLinkedList.LoadDelimited(AString, Separator: string); +begin + Clear; + AppendDelimited(AString, Separator); +end; +} +// History: + +// $Log: JclLinkedLists.pas,v $ +// Revision 1.11 2005/05/07 14:33:48 outchy +// Now compile OK, corrected TJclLinkedList.Clear, TJclIntfLinkedList.Clear and TJclLinkedList.FreeObject +// +// Revision 1.10 2005/05/06 14:24:36 dade2004 +// Fixed a memory leak in TJclLinkedList.Create +// +// Changed +// Current.Obj := nil; +// in +// FreeObject(Current.Obj); +// +// Revision 1.9 2005/05/05 20:08:43 ahuser +// JCL.NET support +// +// Revision 1.8 2005/03/08 15:14:00 dade2004 +// Fixed some bug on +// IJclStrList.InsertAll implementation +// +// Revision 1.7 2005/03/08 08:33:16 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.6 2005/03/03 08:02:57 marquardt +// various style cleanings, bugfixes and improvements +// +// Revision 1.5 2005/03/02 17:51:24 rrossmair +// - removed DCLAppendDelimited from JclAlgorithms, changed uses clauses accordingly +// +// Revision 1.4 2005/03/02 09:59:30 dade2004 +// Added +// -TJclStrCollection in JclContainerIntf +// Every common methods for IJclStrCollection are implemented here +// +// -Every class that implement IJclStrCollection now derive from TJclStrCollection instead of TJclAbstractContainer +// -Every abstract method in TJclStrCollection has been marked as "override" in descendent classes +// +// DCLAppendDelimited has been removed from JclAlgorothms, his body has been fixed for a bug and put into +// relative method in TJclStrCollection +// +// Revision 1.3 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.2 2005/02/24 07:36:24 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclLogic.pas b/official/1.96/source/common/JclLogic.pas new file mode 100644 index 0000000..d502de3 --- /dev/null +++ b/official/1.96/source/common/JclLogic.pas @@ -0,0 +1,1800 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/05/05 20:08:43 $ +// For history see end of file + +{.$DEFINE PUREPASCAL} + +unit JclLogic; + +{$I jcl.inc} +{$RANGECHECKS OFF} + +interface + +// 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: TBitRange); + +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; +{$IFNDEF CLR} +function CountBitsSet(P: Pointer; Count: Cardinal): Cardinal; overload; +{$ENDIF ~CLR} + +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 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 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; +{$IFNDEF CLR} +function ReverseBits(P: Pointer; Count: Integer): Pointer; overload; +{$ENDIF ~CLR} + +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 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: TBitRange); + +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: TBitRange): Boolean; + +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: TBitRange); + +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; +{$IFNDEF CLR} +function ReverseBytes(P: Pointer; Count: Integer): Pointer; overload; +{$ENDIF ~CLR} + +// 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); + +implementation + +uses + JclBase; + +type + PByte = ^Byte; + +// 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 +{$IFDEF CLR} +function BitsHighest(X: Cardinal): Integer; +begin + for Result := 31 downto 0 do + if X and (1 shl Result) <> 0 then + Exit; + Result := -1; +end; +{$ELSE} +function BitsHighest(X: Cardinal): Integer; assembler; +asm + MOV ECX, EAX + MOV EAX, -1 + BSR EAX, ECX +end; +{$ENDIF CLR} + +function BitsHighest(X: Integer): Integer; +begin + Result := BitsHighest(Cardinal(X)); +end; + +function BitsHighest(X: Byte): Integer; +begin + Result := BitsHighest(Cardinal(X) and ByteMask); +end; + +function BitsHighest(X: Word): Integer; +begin + Result := BitsHighest(Cardinal(X) and WordMask); +end; + +function BitsHighest(X: SmallInt): Integer; +begin + Result := BitsHighest(Word(X)); +end; + +function BitsHighest(X: ShortInt): Integer; +begin + Result := BitsHighest(Cardinal(Byte(X))); +end; + +function BitsHighest(X: Int64): Integer; +begin + {$IFDEF CLR} + for Result := 63 downto 0 do + if X and (1 shl Result) <> 0 then + Exit; + Result := -1; + {$ELSE} + if TULargeInteger(X).HighPart = 0 then + begin + if TULargeInteger(X).LowPart = 0 then + Result := -1 + else + Result := BitsHighest(TULargeInteger(X).LowPart); + end + else + Result := BitsHighest(TULargeInteger(X).HighPart) + 32; + {$ENDIF CLR} +end; + +{$IFDEF CLR} +function BitsLowest(X: Cardinal): Integer; +begin + for Result := 0 to 31 do + if X and (1 shl Result) <> 0 then + Exit; + Result := 32; +end; +{$ELSE} +function BitsLowest(X: Cardinal): Integer; assembler; +asm + MOV ECX, EAX + MOV EAX, -1 + BSF EAX, ECX +end; +{$ENDIF CLR} + +function BitsLowest(X: Byte): Integer; +begin + Result := BitsLowest(Cardinal(X) and ByteMask); +end; + +function BitsLowest(X: Shortint): Integer; +begin + Result := BitsLowest(Cardinal(X) and ShortintMask); +end; + +function BitsLowest(X: Smallint): Integer; +begin + Result := BitsLowest(Cardinal(X) and SmallintMask); +end; + +function BitsLowest(X: Word): Integer; +begin + Result := BitsLowest(Cardinal(X) and WordMask); +end; + +function BitsLowest(X: Integer): Integer; +begin + Result := BitsLowest(Cardinal(X)); +end; + +function BitsLowest(X: Int64): Integer; +begin + {$IFDEF CLR} + for Result := 0 to 31 do + if X and (1 shl Result) <> 0 then + Exit; + Result := 32; + {$ELSE} + if TULargeInteger(X).LowPart = 0 then + begin + if TULargeInteger(X).HighPart = 0 then + Result := -1 + else + Result := BitsLowest(TULargeInteger(X).HighPart) + 32; + end + else + Result := BitsLowest(TULargeInteger(X).LowPart); + {$ENDIF CLR} +end; + +function ClearBit(const Value: Byte; const Bit: TBitRange): Byte; +begin + Result := Value and not (1 shl (Bit mod BitsPerByte)); +end; + +function ClearBit(const Value: Shortint; const Bit: TBitRange): Shortint; +begin + Result := Value and not (1 shl (Bit mod BitsPerShortint)); +end; + +function ClearBit(const Value: Smallint; const Bit: TBitRange): Smallint; +begin + Result := Value and not (1 shl (Bit mod BitsPerSmallint)); +end; + +function ClearBit(const Value: Word; const Bit: TBitRange): Word; +begin + Result := Value and not (1 shl (Bit mod BitsPerWord)); +end; + +function ClearBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; +begin + Result := Value and not (1 shl (Bit mod BitsPerCardinal)); +end; + +function ClearBit(const Value: Integer; const Bit: TBitRange): Integer; +begin + Result := Value and not (1 shl (Bit mod BitsPerInteger)); +end; + +function ClearBit(const Value: Int64; const Bit: TBitRange): Int64; +begin + Result := Value and not (Int64(1) shl (Bit mod BitsPerInt64)); +end; + +procedure ClearBitBuffer(var Value; const Bit: TBitRange); +{$IFDEF CLR} +var + Bytes: array of Byte; + BitOfs: TBitRange; + Index: Integer; +begin + Bytes := GetBytesEx(Value); + Index := Bit div 8; + BitOfs := Bit mod 8; + Bytes[Index] := ClearBit(Bytes[Index], BitOfs); + SetBytesEx(Value, Bytes); +end; +{$ELSE} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + P^ := ClearBit(P^, BitOfs); +end; +{$ENDIF CLR} + +function CountBitsSet(X: Cardinal): Integer; +var + Index: Integer; +begin + Result := 0; + for Index := 1 to BitsPerCardinal do + begin + if (X and 1) = 1 then + Inc(Result); + X := X shr 1; + end; +end; + +function CountBitsSet(X: Byte): Integer; +var + Index: Integer; +begin + Result := 0; + for Index := 1 to BitsPerByte do + begin + if (X and 1) = 1 then + Inc(Result); + X := X shr 1; + end; +end; + +function CountBitsSet(X: Word): Integer; +var + Index: Integer; +begin + Result := 0; + for Index := 1 to BitsPerWord do + begin + if (X and 1) = 1 then + Inc(Result); + X := X shr 1; + end; +end; + +function CountBitsSet(X: Smallint): Integer; +begin + Result := CountBitsSet(Word(X)); +end; + +function CountBitsSet(X: ShortInt): Integer; +begin + Result := CountBitsSet(Byte(X)); +end; + +function CountBitsSet(X: Integer): Integer; +begin + Result := CountBitsSet(Cardinal(X)); +end; + +{$IFNDEF CLR} +function CountBitsSet(P: Pointer; Count: Cardinal): Cardinal; +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; +begin + Result := 0; + while Count > 0 do + begin + b := PByte(P)^; + // lower Nibble + Inc(Result, lu[b and $0F]); + // upper Nibble + Inc(Result, lu[b shr 4]); + + Dec(Count); + Inc(PByte(P)); + end; +end; +{$ENDIF ~CLR} + +function CountBitsSet(X: Int64): Integer; +begin + {$IFDEF CLR} + Result := CountBitsSet(X and $00000000FFFFFFFF) + CountBitsSet(X shr 32); + {$ELSE} + Result := CountBitsSet(TULargeInteger(X).LowPart) + CountBitsSet(TULargeInteger(X).HighPart); + {$ENDIF CLR} +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; + +{$IFDEF CLR} +function LRot(const Value: Byte; const Count: TBitRange): Byte; +var + I: Integer; +begin + Result := Value; + for I := 1 to Count do + Result := (Result shl 1) or ((Result and $80) shr 7); +end; + +function LRot(const Value: Word; const Count: TBitRange): Word; +var + I: Integer; +begin + Result := Value; + for I := 1 to Count do + Result := (Result shl 1) or ((Result and $8000) shr 7); +end; + +function LRot(const Value: Integer; const Count: TBitRange): Integer; +var + I: Integer; +begin + Result := Value; + for I := 1 to Count do + Result := (Result shl 1) or ((Result and Integer($80000000)) shr 7); +end; +{$ELSE} +function LRot(const Value: Byte; const Count: TBitRange): Byte; assembler; +asm + MOV CL, Count + ROL AL, CL +end; + +function LRot(const Value: Word; const Count: TBitRange): Word; assembler; +asm + MOV CL, Count + ROL AX, CL +end; + +function LRot(const Value: Integer; const Count: TBitRange): Integer; assembler; +asm + MOV CL, Count + ROL EAX, CL +end; +{$ENDIF CLR} + +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 + {$IFDEF CLR} + Result := (Int64(ReverseBits(Value shr 32)) shl 32) or + (ReverseBits(Value and $00000000FFFFFFFF)); + {$ELSE} + TULargeInteger(Result).LowPart := ReverseBits(TULargeInteger(Value).HighPart); + TULargeInteger(Result).HighPart := ReverseBits(TULargeInteger(Value).LowPart); + {$ENDIF CLR} +end; + +{$IFNDEF CLR} +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 := PByte(Integer(P) + Count - 1); + while Integer(P1) < Integer(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; +{$ENDIF ~CLR} + +{$IFDEF CLR} +function RRot(const Value: Byte; const Count: TBitRange): Byte; +var + I: Integer; +begin + Result := Value; + for I := 1 to Count do + Result := (Result shr 1) or ((Result and $01) shl 7); +end; + +function RRot(const Value: Word; const Count: TBitRange): Word; +var + I: Integer; +begin + Result := Value; + for I := 1 to Count do + Result := (Result shr 1) or ((Result and $0001) shl 7); +end; + +function RRot(const Value: Integer; const Count: TBitRange): Integer; +var + I: Integer; +begin + Result := Value; + for I := 1 to Count do + Result := (Result shr 1) or ((Result and $00000001) shl 7); +end; + +function Sar(const Value: Shortint; const Count: TBitRange): Shortint; +begin + Result := (Value shr Count) or (Value and $80); +end; + +function Sar(const Value: Smallint; const Count: TBitRange): Smallint; +begin + Result := (Value shr Count) or (Value and $8000); +end; + +function Sar(const Value: Integer; const Count: TBitRange): Integer; +begin + Result := (Value shr Count) or (Value and Integer($80000000)); +end; +{$ELSE} +function RRot(const Value: Byte; const Count: TBitRange): Byte; assembler; +asm + MOV CL, Count + MOV AL, Value + ROR AL, CL + MOV Result, AL +end; + +function RRot(const Value: Word; const Count: TBitRange): Word; assembler; +asm + MOV CL, Count + MOV AX, Value + ROR AX, CL + MOV Result, AX +end; + +function RRot(const Value: Integer; const Count: TBitRange): Integer; assembler; +asm + MOV CL, Count + MOV EAX, Value + ROR EAX, CL + MOV Result, EAX +end; + +function Sar(const Value: Shortint; const Count: TBitRange): Shortint; assembler; +asm + MOV CL, DL + SAR AL, CL +end; + +function Sar(const Value: Smallint; const Count: TBitRange): Smallint; assembler; +asm + MOV CL, DL + SAR AX, CL +end; + +function Sar(const Value: Integer; const Count: TBitRange): Integer; assembler; +asm + MOV CL, DL + SAR EAX, CL +end; +{$ENDIF CLR} + +function SetBit(const Value: Byte; const Bit: TBitRange): Byte; +begin + Result := Value or (1 shl (Bit mod BitsPerByte)); +end; + +function SetBit(const Value: Shortint; const Bit: TBitRange): Shortint; +begin + Result := Value or (1 shl (Bit mod BitsPerShortint)); +end; + +function SetBit(const Value: Smallint; const Bit: TBitRange): Smallint; +begin + Result := Value or (1 shl (Bit mod BitsPerSmallint)); +end; + +function SetBit(const Value: Word; const Bit: TBitRange): Word; +begin + Result := Value or (1 shl (Bit mod BitsPerWord)); +end; + +function SetBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; +begin + Result := Value or (1 shl (Bit mod BitsPerCardinal)); +end; + +function SetBit(const Value: Integer; const Bit: TBitRange): Integer; +begin + Result := Value or (1 shl (Bit mod BitsPerInteger)); +end; + +function SetBit(const Value: Int64; const Bit: TBitRange): Int64; +begin + Result := Value or (Int64(1) shl (Bit mod BitsPerInt64)); +end; + +procedure SetBitBuffer(var Value; const Bit: TBitRange); +{$IFDEF CLR} +var + Bytes: array of Byte; + BitOfs: TBitRange; + Index: Integer; +begin + Bytes := GetBytesEx(Value); + Index := Bit div 8; + BitOfs := Bit mod 8; + Bytes[Index] := SetBit(Bytes[Index], BitOfs); + SetBytesEx(Value, Bytes); +end; +{$ELSE} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + P^ := SetBit(P^, BitOfs); +end; +{$ENDIF CLR} + +function TestBit(const Value: Byte; const Bit: TBitRange): Boolean; +begin + Result := (Value and (1 shl (Bit mod BitsPerByte))) <> 0; +end; + +function TestBit(const Value: Shortint; const Bit: TBitRange): Boolean; +begin + Result := (Value and (1 shl (Bit mod BitsPerShortint))) <> 0; +end; + +function TestBit(const Value: Smallint; const Bit: TBitRange): Boolean; +begin + Result := (Value and (1 shl (Bit mod BitsPerSmallint))) <> 0; +end; + +function TestBit(const Value: Word; const Bit: TBitRange): Boolean; +begin + Result := (Value and (1 shl (Bit mod BitsPerWord))) <> 0; +end; + +function TestBit(const Value: Cardinal; const Bit: TBitRange): Boolean; +begin + Result := (Value and (1 shl (Bit mod BitsPerCardinal))) <> 0; +end; + +function TestBit(const Value: Integer; const Bit: TBitRange): Boolean; +begin + Result := (Value and (1 shl (Bit mod BitsPerInteger))) <> 0; +end; + +function TestBit(const Value: Int64; const Bit: TBitRange): Boolean; +begin + Result := (Value and (Int64(1) shl (Bit mod BitsPerInt64))) <> 0; +end; + +function TestBitBuffer(const Value; const Bit: TBitRange): Boolean; +{$IFDEF CLR} +var + Bytes: array of Byte; + BitOfs: TBitRange; +begin + Bytes := GetBytesEx(Value); + BitOfs := Bit mod 8; + Result := TestBit(Bytes[Bit div 8], BitOfs); +end; +{$ELSE} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + Result := TestBit(P^, BitOfs); +end; +{$ENDIF CLR} + +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; +begin + Result := Value xor (1 shl (Bit mod BitsPerByte)); +end; + +function ToggleBit(const Value: Shortint; const Bit: TBitRange): Shortint; +begin + Result := Value xor (1 shl (Bit mod BitsPerShortint)); +end; + +function ToggleBit(const Value: Smallint; const Bit: TBitRange): Smallint; +begin + Result := Value xor (1 shl (Bit mod BitsPerSmallint)); +end; + +function ToggleBit(const Value: Word; const Bit: TBitRange): Word; +begin + Result := Value xor (1 shl (Bit mod BitsPerWord)); +end; + +function ToggleBit(const Value: Cardinal; const Bit: TBitRange): Cardinal; +begin + Result := Value xor (1 shl (Bit mod BitsPerCardinal)); +end; + +function ToggleBit(const Value: Integer; const Bit: TBitRange): Integer; +begin + Result := Value xor (1 shl (Bit mod BitsPerInteger)); +end; + +function ToggleBit(const Value: Int64; const Bit: TBitRange): Int64; +begin + Result := Value xor (Int64(1) shl (Bit mod BitsPerInt64)); +end; + +procedure ToggleBitBuffer(var Value; const Bit: TBitRange); +{$IFDEF CLR} +var + Bytes: array of Byte; + BitOfs: TBitRange; + Index: Integer; +begin + Bytes := GetBytesEx(Value); + Index := Bit div 8; + BitOfs := Bit mod 8; + Bytes[Index] := ToggleBit(Bytes[Index], BitOfs); + SetBytesEx(Value, Bytes); +end; +{$ELSE} +var + P: PByte; + BitOfs: TBitRange; +begin + P := Addr(Value); + Inc(P, Bit div 8); + BitOfs := Bit mod 8; + P^ := ToggleBit(P^, BitOfs); +end; +{$ENDIF CLR} + +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; +begin + Result := ((Value and Word($FF00)) shr BitsPerByte) or ((Value and Word($00FF)) shl BitsPerByte); +end; + +function ReverseBytes(Value: Smallint): Smallint; +begin + Result := ((Value and Smallint($FF00)) shr BitsPerByte) or ((Value and Smallint($00FF)) shl BitsPerByte); +end; + +function ReverseBytes(Value: Integer): Integer; +var + I: Integer; +begin + Result := Value and ByteMask; + Value := Value shr BitsPerByte; + for I := 0 to SizeOf(Integer) - 2 do + begin + Result := (Result shl BitsPerByte) or (Value and ByteMask); + Value := Value shr BitsPerByte; + end; +end; + +function ReverseBytes(Value: Cardinal): Cardinal; +var + I: Integer; +begin + Result := Value and ByteMask; + Value := Value shr BitsPerByte; + for I := 0 to SizeOf(Cardinal) - 2 do + begin + Result := (Result shl BitsPerByte) or (Value and ByteMask); + Value := Value shr BitsPerByte; + end; +end; + +function ReverseBytes(Value: Int64): Int64; +var + I: Integer; +begin + Result := Value and ByteMask; + Value := Value shr BitsPerByte; + for I := 0 to SizeOf(Int64) - 2 do + begin + Result := (Result shl BitsPerByte) or (Value and ByteMask); + Value := Value shr BitsPerByte; + end; +end; + +{$IFNDEF CLR} +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 := PByte(Integer(P) + Count - 1); + while Integer(P1) < Integer(P2) do + begin + T := P1^; + P1^ := P2^; + P2^ := T; + Inc(P1); + Dec(P2); + end; + end; + Result := P; +end; +{$ENDIF ~CLR} + +// 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; + +// History: + +// $Log: JclLogic.pas,v $ +// Revision 1.15 2005/05/05 20:08:43 ahuser +// JCL.NET support +// +// Revision 1.14 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.13 2004/11/06 01:57:15 mthoma +// Added CountBitsSet (Pointer...) by Andreas Schmidt. Some minor changes. +// +// Revision 1.12 2004/10/24 01:04:42 mthoma +// Removed all contributions by you know who. +// +// Revision 1.11 2004/09/30 07:50:29 marquardt +// remove PH contributions +// +// Revision 1.10 2004/07/28 18:00:50 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.9 2004/06/14 13:05:18 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.8 2004/06/14 11:05:51 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.7 2004/05/05 00:09:59 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.6 2004/04/14 23:07:34 +// add missing types to different functions +// add pure pascal implementations +// some bugfixes, a.o. sar with Count >= bit count +// +// Revision 1.5 2004/04/06 04:53:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/common/JclMIDI.pas b/official/1.96/source/common/JclMIDI.pas new file mode 100644 index 0000000..cbeafe4 --- /dev/null +++ b/official/1.96/source/common/JclMIDI.pas @@ -0,0 +1,827 @@ +{**************************************************************************************************} +{ } +{ 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 } +{ } +{ Unit owner: Robert Rossmair } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/08/07 13:09:54 $ +// For history see end of file + +unit JclMIDI; + +{$I jcl.inc} + +interface + +uses + Classes, + 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 GetActiveNotes(Channel: TMIDIChannel): TMIDINotes; + function GetName: string; virtual; abstract; + function GetMIDIStatus: TMIDIStatusByte; + function IsRunningStatus(StatusByte: TMIDIStatusByte): Boolean; + function GetRunningStatusEnabled: Boolean; + procedure SetRunningStatusEnabled(const Value: Boolean); + procedure SendChannelMessage(Msg: TMIDIStatusByte; Channel: TMIDIChannel; + Data1, Data2: TMIDIDataByte); + procedure DoSendMessage(const Data: array of Byte); virtual; abstract; + procedure SendMessage(const Data: array of Byte); + public + destructor Destroy; override; + // 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; + +implementation + +uses + SysUtils, + {$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 (Channel < Low(TMIDIChannel)) or (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 := RsOctaveC; + 1: + Result := RsOctaveCSharp; + 2: + Result := RsOctaveD; + 3: + Result := RsOctaveDSharp; + 4: + Result := RsOctaveE; + 5: + Result := RsOctaveF; + 6: + Result := RsOctaveFSharp; + 7: + Result := RsOctaveG; + 8: + Result := RsOctaveGSharp; + 9: + Result := RsOctaveA; + 10: + Result := RsOctaveASharp; + 11: + Result := 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 := High(TuningData) - Low(TuningData) + 1; + 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} + 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; + +// History: + +// $Log: JclMIDI.pas,v $ +// Revision 1.13 2005/08/07 13:09:54 outchy +// Changed PByteArray to PJclByteArray to avoid RangeCheck exceptions. +// +// Revision 1.12 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.11 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.10 2004/10/12 18:29:52 rrossmair +// cleanup +// +// Revision 1.9 2004/08/03 07:22:37 marquardt +// resourcestring cleanup +// +// Revision 1.8 2004/07/28 18:00:50 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.7 2004/06/16 07:30:27 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.6 2004/06/07 04:27:07 rrossmair +// "Not implemented" error for Unix added as placeholder. +// +// Revision 1.5 2004/05/05 00:09:59 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// + +end. diff --git a/official/1.96/source/common/JclMath.pas b/official/1.96/source/common/JclMath.pas new file mode 100644 index 0000000..b6bb3cf --- /dev/null +++ b/official/1.96/source/common/JclMath.pas @@ -0,0 +1,4565 @@ +{**************************************************************************************************} +{ } +{ 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, generic floating point routines, hyperbolic and transcendenatal } +{ routines, NAN and INF support and more. } +{ } +{ Unit owner: Matthias Thoma } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/04 10:10:58 $ +// For history see end of file + +unit JclMath; + +{$I jcl.inc} + +interface + +uses + Classes, SysUtils, + 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.159154943091895; // 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; + EpsExtended: Extended; + Epsilon: Float; + ThreeEpsSingle: Single; + ThreeEpsDouble: Double; + ThreeEpsExtended: Extended; + ThreeEpsilon: Float; + +type + TPrimalityTestMethod = (ptTrialDivision, ptRabinMiller); + +// 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. +function DegToRad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function DegToRad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function DegToRad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$IFDEF CPU386} +procedure FastDegToRad; +{$ENDIF CPU386} + +// Converts radians to degrees. +function RadToDeg(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function RadToDeg(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function RadToDeg(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$IFDEF CPU386} +procedure FastRadToDeg; +{$ENDIF CPU386} + +// Converts grads to radians. +function GradToRad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function GradToRad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function GradToRad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$IFDEF CPU386} +procedure FastGradToRad; +{$ENDIF CPU386} + +// Converts radians to grads. +function RadToGrad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function RadToGrad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function RadToGrad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$IFDEF CPU386} +procedure FastRadToGrad; +{$ENDIF CPU386} + +// Converts degrees to grads. +function DegToGrad(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function DegToGrad(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function DegToGrad(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$IFDEF CPU386} +procedure FastDegToGrad; +{$ENDIF CPU386} + +// Converts grads to degrees. +function GradToDeg(const Value: Extended): Extended; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function GradToDeg(const Value: Double): Double; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function GradToDeg(const Value: Single): Single; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +{$IFDEF CPU386} +procedure FastGradToDeg; +{$ENDIF CPU386} + +{ 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: Float; var Sin, Cos: Float); +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 CLR}{$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}{$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; +procedure CalcMachineEpsExtended; +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; +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 CPU386} +function IsPrimeRM(N: Cardinal): Boolean; +{$ENDIF CPU386} +function IsPrimeFactor(const F, N: Cardinal): Boolean; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function PrimeFactors(N: Cardinal): TDynCardinalArray; + +var + IsPrime: function(N: Cardinal): Boolean = IsPrimeTD; + +{$IFDEF CPU386} +procedure SetPrimalityTest(const Method: TPrimalityTestMethod); +{$ENDIF CPU386} + +{$IFDEF CPU386} +{ 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 + ); + +function FloatingPointClass(const Value: Single): TFloatingPointClass; overload; +function FloatingPointClass(const Value: Double): TFloatingPointClass; overload; +function FloatingPointClass(const Value: Extended): TFloatingPointClass; overload; +{$ENDIF CPU386} + +{ NaN and INF support } + +type + TNaNTag = -$3FFFFF..$3FFFFE; + +const + Infinity = 1/0; // tricky + NaN = 0/0; // tricky + NegInfinity = -Infinity; + +function IsInfinite(const Value: Single): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function IsInfinite(const Value: Double): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function IsInfinite(const Value: Extended): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + +function IsNaN(const Value: Single): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function IsNaN(const Value: Double): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} +function IsNaN(const Value: Extended): Boolean; overload; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF} + +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; +procedure MakeQuietNaN(var X: Extended; Tag: TNaNTag = 0); overload; + +procedure MakeSignalingNaN(var X: Single; Tag: TNaNTag = 0); overload; +procedure MakeSignalingNaN(var X: Double; Tag: TNaNTag = 0); overload; +procedure MakeSignalingNaN(var X: Extended; Tag: TNaNTag = 0); overload; + +{$IFNDEF CLR} +{ 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; +{$ENDIF ~CLR} + +function GetNaNTag(const NaN: Single): TNaNTag; overload; +function GetNaNTag(const NaN: Double): TNaNTag; overload; +function GetNaNTag(const NaN: Extended): TNaNTag; overload; + +{ Set support } + +type + TJclASet = class(TObject) + {$IFDEF CLR} + public + {$ELSE} + protected + {$ENDIF} + 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 CLR} + TPointerArray = array [0..MaxLongint div 256] of Pointer; + PPointerArray = ^TPointerArray; + {$ENDIF ~CLR} + TDelphiSet = set of Byte; // 256 elements + PDelphiSet = ^TDelphiSet; + +const + EmptyDelphiSet: TDelphiSet = []; + CompleteDelphiSet: TDelphiSet = [0..255]; + +{$IFNDEF CLR} +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; +{$ENDIF ~CLR} + +{ 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); + + {$IFNDEF CLR} + EJclNaNSignal = class(EJclMathError) + private + FTag: TNaNTag; + public + constructor Create(ATag: TNaNTag); + property Tag: TNaNTag read FTag; + end; + {$ENDIF ~CLR} + +procedure DomainCheck(Err: Boolean); + +{ Checksums } + +{$IFDEF CLR} +function GetParity(Buffer: TDynByteArray; Len: Integer): Boolean; +{$ELSE} +function GetParity(Buffer: PByte; Len: Integer): Boolean; +{$ENDIF CLR} + +{ CRC } + +function Crc16_P(X: PJclByteArray; N: Integer; Crc: Word = 0): Word; +function Crc16(const X: array of Byte; N: Integer; Crc: Word = 0): Word; +function Crc16_A(const X: array of Byte; Crc: Word = 0): Word; + +function CheckCrc16_P(X: PJclByteArray; N: Integer; Crc: Word): Integer; +function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer; +function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer; + +function Crc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal; +function Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal; +function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal; + +function CheckCrc32_P(X: PJclByteArray; N: Integer; Crc: Cardinal): Integer; +function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer; +function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer; + +{$IFDEF CRCINIT} +procedure InitCrc32(Polynom, Start: Cardinal); +procedure InitCrc16(Polynom, Start: Word); +{$ENDIF CRCINIT} + +{ Complex numbers } + +type + TPolarComplex = record + Radius: Float; + Angle: Float; + end; + + TRectComplex = record + Re: Float; + Im: Float; + {$IFDEF SUPPORTS_CLASS_OPERATORS} + class operator Implicit(const Value: Float): TRectComplex; + class operator Implicit(const Value: Integer): TRectComplex; + class operator Implicit(const Value: Int64): TRectComplex; + class operator Implicit(const Z: TPolarComplex): 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; inline; + 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 function Exp(const Z: TRectComplex): TPolarComplex; static; + {$ENDIF SUPPORTS_CLASS_OPERATORS} + end; + +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; +function IsInfinite(const Z: TRectComplex): Boolean; overload; +function IsInfinite(const Z: TPolarComplex): Boolean; overload; + +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 Quotient(const Z1, Z2: TRectComplex): TRectComplex; + +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; +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; + +implementation + +uses + {$IFDEF Win32API} + Windows, + {$ENDIF Win32API} + {$IFDEF CPU386} + Jcl8087, + {$ENDIF CPU386} + JclResources; + +// Internal helper routines +// Linux: Get Global Offset Table (GOT) adress for Position Independent Code +// (PIC, used by shared objects) + +{$IFNDEF CLR} +{$IFDEF PIC} +function GetGOT: Pointer; export; +begin + asm + MOV Result, EBX + end; +end; +{$ENDIF PIC} +{$ENDIF ~CLR} + +// 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; +{$IFDEF CLR} +begin + Result := IntToHex(BitConverter.DoubleToInt64Bits(D), 16); +end; +{$ELSE} +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; +{$ENDIF CLR} + +function HexToDouble(const Hex: string): Double; +{$IFDEF CLR} +begin + if Length(Hex) <> 16 then + raise EJclMathError.Create(RsUnexpectedValue); + Result := BitConverter.Int64BitsToDouble(StrToInt64('$' + Hex)) +end; +{$ELSE} +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; +{$ENDIF CLR} + +// Converts degrees to radians. + +function DegToRad(const Value: Extended): Extended; +begin + Result := Value * RatioDegToRad; +end; + +function DegToRad(const Value: Double): Double; +begin + Result := Value * RatioDegToRad; +end; + +function DegToRad(const Value: Single): Single; +begin + Result := Value * RatioDegToRad; +end; + +{$IFDEF CPU386} +// Expects degrees in ST(0), leaves radians in ST(0) +// ST(0) := ST(0) * PI / 180 +procedure FastDegToRad; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + FLD [EAX][RatioDegToRad] + {$ELSE} + FLD [RatioDegToRad] + {$ENDIF PIC} + FMULP + FWAIT +end; +{$ENDIF CPU386} + +// Converts radians to degrees. + +function RadToDeg(const Value: Extended): Extended; +begin + Result := Value * RatioRadToDeg; +end; + +function RadToDeg(const Value: Double): Double; +begin + Result := Value * RatioRadToDeg; +end; + +function RadToDeg(const Value: Single): Single; +begin + Result := Value * RatioRadToDeg; +end; + +{$IFDEF CPU386} +// Expects radians in ST(0), leaves degrees in ST(0) +// ST(0) := ST(0) * (180 / PI); +procedure FastRadToDeg; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + FLD [EAX][RatioRadToDeg] + {$ELSE} + FLD [RatioRadToDeg] + {$ENDIF PIC} + FMULP + FWAIT +end; +{$ENDIF CPU386} + +// Converts grads to radians. + +function GradToRad(const Value: Extended): Extended; +begin + Result := Value * RatioGradToRad; +end; + +function GradToRad(const Value: Double): Double; +begin + Result := Value * RatioGradToRad; +end; + +function GradToRad(const Value: Single): Single; +begin + Result := Value * RatioGradToRad; +end; + +{$IFDEF CPU386} +// Expects grads in ST(0), leaves radians in ST(0) +// ST(0) := ST(0) * PI / 200 +procedure FastGradToRad; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + FLD [EAX][RatioGradToRad] + {$ELSE} + FLD [RatioGradToRad] + {$ENDIF PIC} + FMULP + FWAIT +end; +{$ENDIF CPU386} + +// Converts radians to grads. + +function RadToGrad(const Value: Extended): Extended; +begin + Result := Value * RatioRadToGrad; +end; + +function RadToGrad(const Value: Double): Double; +begin + Result := Value * RatioRadToGrad; +end; + +function RadToGrad(const Value: Single): Single; +begin + Result := Value * RatioRadToGrad; +end; + +{$IFDEF CPU386} +// Expects radians in ST(0), leaves grads in ST(0) +// ST(0) := ST(0) * (200 / PI); +procedure FastRadToGrad; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + FLD [EAX][RatioRadToGrad] + {$ELSE} + FLD [RatioRadToGrad] + {$ENDIF PIC} + FMULP + FWAIT +end; +{$ENDIF CPU386} + +// Converts degrees to grads. + +function DegToGrad(const Value: Extended): Extended; +begin + Result := Value * RatioDegToGrad; +end; + +function DegToGrad(const Value: Double): Double; +begin + Result := Value * RatioDegToGrad; +end; + +function DegToGrad(const Value: Single): Single; +begin + Result := Value * RatioDegToGrad; +end; + +{$IFDEF CPU386} +// Expects Degrees in ST(0), leaves grads in ST(0) +// ST(0) := ST(0) * (200 / 180); +procedure FastDegToGrad; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + FLD [EAX][RatioDegToGrad] + {$ELSE} + FLD [RatioDegToGrad] + {$ENDIF PIC} + FMULP + FWAIT +end; +{$ENDIF CPU386} + +// Converts grads to degrees. + +function GradToDeg(const Value: Extended): Extended; +begin + Result := Value * RatioGradToDeg; +end; + +function GradToDeg(const Value: Double): Double; +begin + Result := Value * RatioGradToDeg; +end; + +function GradToDeg(const Value: Single): Single; +begin + Result := Value * RatioGradToDeg; +end; + +{$IFDEF CPU386} +// Expects grads in ST(0), leaves radians in ST(0) +// ST(0) := ST(0) * PI / 200 +procedure FastGradToDeg; assembler; +asm + {$IFDEF PIC} + CALL GetGOT + FLD [EAX][RatioGradToDeg] + {$ELSE} + FLD [RatioGradToDeg] + {$ENDIF PIC} + FMULP + FWAIT +end; +{$ENDIF CPU386} + +procedure DomainCheck(Err: Boolean); +begin + if Err then + {$IFDEF CLR} + raise EJclMathError.Create(RsMathDomainError); + {$ELSE} + raise EJclMathError.CreateRes(@RsMathDomainError); + {$ENDIF CLR} +end; + +//=== Logarithmic ============================================================ + +function LogBase10(X: Float): Float; + + {$IFDEF CPU386} + function FLogBase10(X: Float): Float; assembler; + asm + FLDLG2 + FLD X + FYL2X + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(X <= 0.0); + {$IFDEF CLR} + Result := System.Math.Log10(X) + {$ELSE} + Result := FLogBase10(X); + {$ENDIF CLR} +end; + +function LogBase2(X: Float): Float; + + {$IFDEF CPU386} + function FLogBase2(X: Float): Float; assembler; + asm + FLD1 + FLD X + FYL2X + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(X <= 0.0); + {$IFDEF CLR} + Result := System.Math.Log(X, 2); + {$ELSE} + Result := FLogBase2(X); + {$ENDIF CLR} +end; + +function LogBaseN(Base, X: Float): Float; + + {$IFDEF CPU386} + function FLogBaseN(Base, X: Float): Float; assembler; + asm + FLD1 + FLD X + FYL2X + FLD1 + FLD Base + FYL2X + FDIV + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck((X <= 0.0) or (Base <= 0.0) or (Base = 1.0)); + {$IFDEF CLR} + Result := System.Math.Log(X); + {$ELSE} + Result := FLogBaseN(Base, X); + {$ENDIF CLR} +end; + +//=== Transcendental ========================================================= + +function ArcCos(X: Float): Float; + + {$IFDEF CPU386} + function FArcCos(X: Float): Float; assembler; + asm + FLD X + FLD ST(0) + FMUL ST(0), ST + FLD1 + FSUBRP ST(1), ST + FSQRT + FXCH + FPATAN + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(Abs(X) > 1.0); + {$IFDEF CLR} + Result := System.Math.Acos(X); + {$ELSE} + Result := FArcCos(X); + {$ENDIF CLR} +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; + + {$IFDEF CPU386} + function FArcTan(X: Float): Float; assembler; + asm + FLD X + FLD1 + FPATAN + FWAIT + end; + {$ENDIF CPU386} + +begin + {$IFDEF CLR} + Result := System.Math.Atan(Sqrt(X*X - 1)) + {$ELSE} + Result := FArcTan(Sqrt(X*X - 1)); + {$ENDIF CLR} +end; + +function ArcSin(X: Float): Float; + + {$IFDEF CPU386} + function FArcSin(X: Float): Float; assembler; + asm + FLD X + FLD ST(0) + FMUL ST(0), ST + FLD1 + FSUBRP ST(1), ST + FSQRT + FPATAN + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(Abs(X) > 1.0); + {$IFDEF CPU386} + Result := FArcSin(X); + {$ELSE} + Result := System.Math.Asin(X); + {$ENDIF} +end; + +function ArcTan(X: Float): Float; +{$IFDEF PUREPASCAL} +begin + Result := ArcTan2(X, 1); +end; +{$ELSE ~PUREPASCAL} +assembler; +asm + FLD X + FLD1 + FPATAN + FWAIT +end; +{$ENDIF ~PUREPASCAL} + +{$IFDEF CLR} +function ArcTan2(Y, X: Float): Float; +begin + Result := System.Math.ATan2(Y, X); +end; +{$ELSE} +function ArcTan2(Y, X: Float): Float; assembler; +asm + FLD Y + FLD X + FPATAN + FWAIT +end; +{$ENDIF CLR} + +function Cos(X: Float): Float; + + {$IFDEF CPU386} + function FCos(X: Float): Float; assembler; + asm + FLD X + FCOS + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF CLR} + Result := System.Math.Cos(X); + {$ELSE} + Result := FCos(X); + {$ENDIF CLR} +end; + +function Cot(X: Float): Float; + + {$IFDEF CPU386} + function FCot(X: Float): Float; assembler; + asm + FLD X + FPTAN + FDIVRP + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(Abs(X) > MaxAngle); + { TODO : Cot = 1 / Tan -> Tan(X) <> 0.0 } + {$IFDEF CLR} + Result := 1 / System.Math.Tan(X); + {$ELSE} + Result := FCot(X); + {$ENDIF CLR} +end; + +function Coversine(X: Float): Float; +begin + Result := 1 - Sin(X); +end; + +function Csc(X: Float): Float; +var + Y: Float; +begin + DomainCheck(Abs(X) > MaxAngle); + + Y := Sin(X); + DomainCheck(Y = 0.0); + Result := 1.0 / Y; +end; + +function Exsecans(X: Float): Float; +begin + Result := Sec(X) - 1; +end; + +function Haversine(X: Float): Float; +begin + Result := 0.5 * (1 - Cos(X)); +end; + +function Sec(X: Float): Float; + + {$IFDEF CPU386} + function FSec(X: Float): Float; assembler; + asm + FLD X + FCOS + FLD1 + FDIVRP + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(Abs(X) > MaxAngle); + { TODO : Sec = 1 / Cos -> Cos(X) <> 0! } + {$IFDEF CLR} + Result := 1 / System.Math.Cos(X); + {$ELSE} + Result := FSec(X); + {$ENDIF CLR} +end; + +function Sin(X: Float): Float; + + {$IFDEF CPU386} + function FSin(X: Float): Float; assembler; + asm + FLD X + FSIN + FWAIT + end; + {$ENDIF CPU386} + +begin + {$IFNDEF MATH_EXT_SPECIALVALUES} + DomainCheck(Abs(X) > MaxAngle); + {$ENDIF ~MATH_EXT_SPECIALVALUES} + {$IFDEF CLR} + Result := System.Math.Sin(X); + {$ELSE} + Result := FSin(X); + {$ENDIF CLR} +end; + +procedure SinCos(X: Float; var Sin, Cos: Float); + + {$IFDEF CPU386} + procedure FSinCos(X: Float; var Sin, Cos: Float); assembler; + asm + FLD X + FSINCOS + FSTP Float PTR [EDX] + FSTP Float PTR [EAX] + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF CLR} + Sin := System.Math.Sin(X); + Cos := System.Math.Cos(X); + {$ELSE} + FSinCos(X, Sin, Cos); + {$ENDIF CLR} +end; + +function Tan(X: Float): Float; + + {$IFDEF CPU386} + function FTan(X: Float): Float; assembler; + asm + FLD X + FPTAN + FSTP ST(0) + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(Abs(X) > MaxAngle); + {$IFDEF CLR} + Result := System.Math.Tan(X); + {$ELSE} + Result := FTan(X); + {$ENDIF CLR} +end; + +function Versine(X: Float): Float; +begin + Result := 1 - Cos(X); +end; + +//=== Hyperbolic ============================================================= + +function ArcCosH(X: Float): Float; + + {$IFDEF CPU386} + function FArcCosH(X: Float): Float; assembler; + asm + FLDLN2 + FLD X + FLD ST(0) + FMUL ST(0), ST + FLD1 + FSUBP ST(1), ST + FSQRT + FADDP ST(1), ST + FYL2X + end; + {$ENDIF CPU386} + +begin + DomainCheck(X < 1.0); + {$IFDEF CLR} + Result := System.Math.Log(X, 2); + {$ELSE} + Result := FArcCosH(X); + {$ENDIF CLR} +end; + +function ArcCotH(X: Float): Float; +begin + DomainCheck(Abs(X) = 1.0); + {$IFDEF CLR} + Result := 0.5 * System.Math.Log((X + 1.0) / (X - 1.0)); + {$ELSE} + Result := 0.5 * System.Ln((X + 1.0) / (X - 1.0)); + {$ENDIF CLR} +end; + +function ArcCscH(X: Float): Float; +begin + DomainCheck(X = 0); + {$IFDEF CLR} + Result := System.Math.Log((Sgn(X) * Sqrt(Sqr(X) + 1.0) + 1.0) / X); + {$ELSE} + Result := System.Ln((Sgn(X) * Sqrt(Sqr(X) + 1.0) + 1.0) / X); + {$ENDIF CLR} +end; + +function ArcSecH(X: Float): Float; +begin + DomainCheck(Abs(X) > 1.0); + {$IFDEF CLR} + Result := System.Math.Log((Sqrt(1.0 - Sqr(X)) + 1.0) / X); + {$ELSE} + Result := System.Ln((Sqrt(1.0 - Sqr(X)) + 1.0) / X); + {$ENDIF CLR} +end; + +function ArcSinH(X: Float): Float; +{$IFDEF CLR} +begin + Result := System.Math.Log(X + Sqrt(1 + X * X)); +end; +{$ELSE} +assembler; +asm + FLDLN2 + FLD X + FLD ST(0) + FMUL ST(0), ST + FLD1 + FADDP ST(1), ST + FSQRT + FADDP ST(1), ST + FYL2X +end; +{$ENDIF CLR} + +function ArcTanH(X: Float): Float; + + {$IFDEF CPU386} + function FArcTanH(X: Float): Float; assembler; + asm + FLDLN2 + FLD X + FLD ST(0) + FLD1 + FADDP ST(1), ST + FXCH + FLD1 + FSUBRP ST(1), ST + FDIVP ST(1), ST + FSQRT + FYL2X + FWAIT + end; + {$ENDIF CPU386} + +begin + DomainCheck(Abs(X) >= 1.0); + {$IFDEF CLR} + Result := System.Math.Log((1 + X) / (1 - X)) / 2; + {$ELSE} + Result := FArcTanH(X); + {$ENDIF CLR} +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; +var + ControlWW: Word; +asm + {$IFDEF PIC} + CALL GetGOT + {$ENDIF PIC} + FLD X { TODO : Legal values for X? } + FLDL2E + FMULP ST(1), ST + FSTCW ControlWW + {$IFDEF PIC} + FLDCW [EAX].RoundDown + {$ELSE} + FLDCW RoundDown + {$ENDIF PIC} + FLD ST(0) + FRNDINT + FLDCW ControlWW + FXCH + FSUB ST, ST(1) + F2XM1 + FLD1 + FADDP ST(1), ST + FSCALE + FST ST(1) + FLD1 + FDIVRP ST(1), ST + FADDP ST(1), ST + {$IFDEF PIC} + FLD [EAX].OneHalf + {$ELSE} + FLD OneHalf + {$ENDIF PIC} + FMULP ST(1), ST + FWAIT +end; +{$ENDIF ~PUREPASCAL} + +function CotH(X: Float): Float; +begin + Result := 1 / TanH(X); +end; + +function CscH(X: Float): Float; +begin + Result := Exp(X) - Exp(-X); + DomainCheck(Result = 0.0); + Result := 2.0 / Result; +end; + +function SecH(X: Float): Float; +begin + Result := Exp(X) + Exp(-X); + DomainCheck(Result = 0.0); + Result := 2.0 / Result; +end; + +function SinH(X: Float): Float; +{$IFDEF CLR} +begin + Result := System.Math.Sinh(X); +end; +{$ELSE ~CLR} +assembler; +const + RoundDown: Word = $177F; + OneHalf: Float = 0.5; +var + ControlWW: Word; +asm + {$IFDEF PIC} + CALL GetGOT + {$ENDIF PIC} + FLD X { TODO : Legal values for X? } + FLDL2E + FMULP ST(1), ST + FSTCW ControlWW + {$IFDEF PIC} + FLDCW [EAX].RoundDown + {$ELSE} + FLDCW RoundDown + {$ENDIF PIC} + FLD ST(0) + FRNDINT + FLDCW ControlWW + FXCH + FSUB ST, ST(1) + F2XM1 + FLD1 + FADDP ST(1), ST + FSCALE + FST ST(1) + FLD1 + FDIVRP ST(1), ST + FSUBP ST(1), ST + {$IFDEF PIC} + FLD [EAX].OneHalf + {$ELSE} + FLD OneHalf + {$ENDIF PIC} + FMULP ST(1), ST + FWAIT +end; +{$ENDIF ~CLR} + +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 := 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 := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Int(X); + Y := Frac(X) * 60; + Mins := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Int(Y); + Secs := Frac(Y) * 60; +end; + +//=== Exponential ============================================================ + +function Exp(const X: Float): Float; +begin + {$IFDEF MATH_EXT_EXTREMEVALUES} + if IsSpecialValue(X) then + begin + if IsNaN(X) or (X = Infinity) then + Result := X + else + Result := 0; + Exit; + end; + {$ENDIF MATH_EXT_EXTREMEVALUES} + + Result := {$IFDEF CLR}Borland.Delphi.{$ENDIF}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} + {$IFDEF CLR} + raise EJclMathError.Create(RsPowerInfinite); + {$ELSE} + raise EJclMathError.CreateRes(@RsPowerInfinite); + {$ENDIF CLR} + {$ENDIF MATH_EXT_EXTREMEVALUES} + end + else + if Base > 0.0 then + Result := Exp(Exponent * {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Ln(Base)) + else + begin + IsAnInteger := (Frac(Exponent) = 0.0); + if IsAnInteger then + begin + Result := Exp(Exponent * {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Ln(Abs(Base))); + IsOdd := Abs(Round(ModFloat(Exponent, 2))) = 1; + if IsOdd then + Result := -Result; + end + else + {$IFDEF CLR} + raise EJclMathError.Create(RsPowerComplex); + {$ELSE} + raise EJclMathError.CreateRes(@RsPowerComplex); + {$ENDIF CLR} + 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 := Exp(Y * Ln10); +end; + +function TruncPower(const Base, Exponent: Float): Float; +begin + if Base > 0 then + Result := Power(Base, Exponent) + else + Result := 0; +end; + +function TwoToY(const Y: Float): Float; +begin + if Y = 0.0 then + Result := 1.0 + else + Result := 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 := {$IFDEF CLR}Borland.Delphi.{$ENDIF}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 - {$IFDEF CLR}Borland.Delphi.{$ENDIF}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; + +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; + +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 + 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 + PUSH EBX + + MOV CX, AX // load argument + 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 + + POP EBX +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 NormalizeAngle(const Angle: Float): Float; +begin + Result := Angle; + {$IFDEF MATH_ANGLE_DEGREES} + Result := DegToRad(Result); + {$ENDIF MATH_ANGLE_DEGREES} + {$IFDEF MATH_ANGLE_GRADS} + Result := GradToRad(Result); + {$ENDIF MATH_ANGLE_GRADS} + + Result := Frac(Result * Inv2Pi); + if Result < -0.5 then + Result := Result + 1.0 + else + if Result >= 0.5 then + Result := Result - 1.0; + + Result := Result * TwoPi; + + {$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; + +{$IFNDEF CLR} +//== { 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; +{$ENDIF ~CLR} + +//=== 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 + {$IFDEF CLR} + raise EJclMathError.Create(RsUnexpectedValue); + {$ELSE} + raise EJclMathError.CreateRes(@RsUnexpectedValue); + {$ENDIF CLR} + 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 CPU386} +{ Rabin-Miller Strong Primality Test } + +function IsPrimeRM(N: Cardinal): Boolean; +asm + 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 + LEA EBP,[EAX - 1] // 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 EDX,OFFSET @@B + MOV ECX,19 +@@D: CMP AL,[EDX + ECX] + JE @@E + DEC ECX + JNL @@D +@@E: SETE AL +end; +{$ENDIF CPU386} + +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; + +{$IFNDEF CLR} +procedure SetPrimalityTest(const Method: TPrimalityTestMethod); +begin + case Method of + ptTrialDivision: + IsPrime := IsPrimeTD; + ptRabinMiller: + IsPrime := IsPrimeRM; + end; +end; +{$ENDIF ~CLR} + +{$IFDEF CPU386} +//=== Floating point value classification ==================================== + +const + fpEmpty = TFloatingPointClass(Ord(High(TFloatingPointClass))+1); + + FPClasses: array [0..6] of TFloatingPointClass = + ( + fpInvalid, + fpNaN, + fpNormal, + fpInfinite, + fpZero, + fpEmpty, // should not happen + fpDenormal + ); + +function _FPClass: TFloatingPointClass; +// In: ST(0) Value to examine +// ECX address of GOT (PIC only) +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 + {$IFDEF PIC} + MOVZX EAX, TFloatingPointClass([ECX].FPClasses[EDX]) + {$ELSE} + MOVZX EAX, TFloatingPointClass(FPClasses[EDX]) + {$ENDIF PIC} +end; + +function FloatingPointClass(const Value: Single): TFloatingPointClass; overload; +asm + {$IFDEF PIC} + CALL GetGOT + MOV ECX, EAX + {$ENDIF PIC} + FLD Value + CALL _FPClass +end; + +function FloatingPointClass(const Value: Double): TFloatingPointClass; overload; +asm + {$IFDEF PIC} + CALL GetGOT + MOV ECX, EAX + {$ENDIF PIC} + FLD Value + CALL _FPClass +end; + +function FloatingPointClass(const Value: Extended): TFloatingPointClass; overload; +asm + {$IFDEF PIC} + CALL GetGOT + MOV ECX, EAX + {$ENDIF PIC} + FLD Value + CALL _FPClass +end; +{$ENDIF CPU386} + +//=== NaN and Infinity support =============================================== + +function IsInfinite(const Value: Single): Boolean; overload; +begin + {$IFDEF CLR} + Result := System.Single.IsInfinity(Value); + {$ELSE} + Result := FloatingPointClass(Value) = fpInfinite; + {$ENDIF CLR} +end; + +function IsInfinite(const Value: Double): Boolean; overload; +begin + {$IFDEF CLR} + Result := System.Double.IsInfinity(Value); + {$ELSE} + Result := FloatingPointClass(Value) = fpInfinite; + {$ENDIF CLR} +end; + +function IsInfinite(const Value: Extended): Boolean; overload; +begin + {$IFDEF CLR} + Result := System.Double.IsInfinity(Value); + {$ELSE} + Result := FloatingPointClass(Value) = fpInfinite; + {$ENDIF CLR} +end; + +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; + + QWord = Int64; + + 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 + {$IFDEF CLR} + Result := System.Single.IsNaN(Value); + {$ELSE} + Result := FloatingPointClass(Value) = fpNaN; + {$ENDIF CLR} +end; + +function IsNaN(const Value: Double): Boolean; overload; +begin + {$IFDEF CLR} + Result := System.Double.IsNaN(Value); + {$ELSE} + Result := FloatingPointClass(Value) = fpNaN; + {$ENDIF CLR} +end; + +function IsNaN(const Value: Extended): Boolean; overload; +begin + {$IFDEF CLR} + Result := System.Double.IsNaN(Value); + {$ELSE} + Result := FloatingPointClass(Value) = fpNaN; + {$ENDIF CLR} +end; + +procedure CheckNaN(const Value: Single); overload; +{$IFDEF CLR} +begin + if not IsNaN(Value) then + raise EJclMathError.Create(RsNoNaN); +end; +{$ELSE} +var + SaveExMask: T8087Exceptions; +begin + SaveExMask := Mask8087Exceptions([emInvalidOp]); + try + if FloatingPointClass(Value) <> fpNaN then + raise EJclMathError.CreateRes(@RsNoNaN); + finally + SetMasked8087Exceptions(SaveExMask); + end; +end; +{$ENDIF CLR} + +procedure CheckNaN(const Value: Double); overload; +{$IFDEF CLR} +begin + if not IsNaN(Value) then + raise EJclMathError.Create(RsNoNaN); +end; +{$ELSE} +var + SaveExMask: T8087Exceptions; +begin + SaveExMask := Mask8087Exceptions([emInvalidOp]); + try + if FloatingPointClass(Value) <> fpNaN then + raise EJclMathError.CreateRes(@RsNoNaN); + finally + SetMasked8087Exceptions(SaveExMask); + end; +end; +{$ENDIF CLR} + +procedure CheckNaN(const Value: Extended); overload; +{$IFDEF CLR} +begin + if not IsNaN(Value) then + raise EJclMathError.Create(RsNoNaN); +end; +{$ELSE} +var + SaveExMask: T8087Exceptions; +begin + SaveExMask := Mask8087Exceptions([emInvalidOp]); + try + if FloatingPointClass(Value) <> fpNaN then + raise EJclMathError.CreateRes(@RsNoNaN); + finally + SetMasked8087Exceptions(SaveExMask); + end; +end; +{$ENDIF CLR} + +function GetNaNTag(const NaN: Single): TNaNTag; +var + Temp: Integer; + {$IFDEF CLR} + Bytes: Int32; + {$ENDIF CLR} +begin + CheckNaN(NaN); + {$IFDEF CLR} + Bytes := BitConverter.ToInt32(BitConverter.GetBytes(NaN), 0); + Temp := Bytes and NaNTagMask; + if Bytes and (1 shl sSignBit) <> 0 then + {$ELSE} + Temp := PLongint(@NaN)^ and NaNTagMask; + if sSignBit in TSingleBits(NaN) then + {$ENDIF CLR} + Result := -Temp + else + if Temp = ZeroTag then + Result := 0 + else + Result := Temp; +end; + +function GetNaNTag(const NaN: Double): TNaNTag; +var + Temp: Integer; + {$IFDEF CLR} + Bytes: Int64; + {$ENDIF CLR} +begin + CheckNaN(NaN); + {$IFDEF CLR} + Bytes := BitConverter.DoubleToInt64Bits(NaN); + Temp := (Bytes shr dNanTagShift) and NaNTagMask; + if Bytes and (1 shl dSignBit) <> 0 then + {$ELSE} + Temp := (PInt64(@NaN)^ shr dNaNTagShift) and NaNTagMask; + {$IFDEF FPC} + if Int64(NaN) < 0 then + {$ELSE} + if dSignBit in TDoubleBits(NaN) then + {$ENDIF FPC} + {$ENDIF CLR} + Result := -Temp + else + if Temp = ZeroTag then + Result := 0 + else + Result := Temp; +end; + +function GetNaNTag(const NaN: Extended): TNaNTag; +{$IFNDEF CLR} +var + Temp: Integer; +{$ENDIF ~CLR} +begin + {$IFDEF CLR} + Result := GetNaNTag(Double(NaN)); + {$ELSE} + CheckNaN(NaN); + Temp := (PExtendedRec(@NaN)^.Significand shr xNaNTagShift) and NaNTagMask; + {$IFDEF FPC} + if (TExtendedRec(NaN).Exponent and $8000) <> 0 then + {$ELSE} + if xSignBit in TExtendedBits(NaN) then + {$ENDIF FPC} + Result := -Temp + else + if Temp = ZeroTag then + Result := 0 + else + Result := Temp; + {$ENDIF CLR} +end; + +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} + +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: Boolean = False; + +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; + +{$ENDIF MSWINDOWS} + +{$IFDEF MSWINDOWS} +{$IFNDEF FPC} +procedure InitExceptObjProc; + + function IsInitialized: Boolean; + asm + MOV AL, True + LOCK XCHG AL, ExceptObjProcInitialized + end; + +begin + if not IsInitialized then + if Win32Platform = VER_PLATFORM_WIN32_NT then + PrevExceptObjProc := Pointer(InterlockedExchange(Integer(ExceptObjProc), Integer(@GetExceptionObject))); +end; +{$ENDIF ~FPC} +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +procedure CheckTag(Tag: TNaNTag); +begin + if (Tag < Low(TNaNTag)) or (Tag > High(TNaNTag)) then + {$IFDEF CLR} + raise EJclMathError.CreateFmt(RsNaNTagError, [Tag]); + {$ELSE} + raise EJclMathError.CreateResFmt(@RsNaNTagError, [Tag]); + {$ENDIF CLR} +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 + {$IFDEF CLR} + Bits := Bits or (LongWord(1) shl sSignBit); + X := BitConverter.ToSingle(BitConverter.GetBytes(Bits), 0); + {$ELSE} + Include(TSingleBits(Bits), sSignBit); + PLongWord(@X)^ := Bits; + {$ENDIF CLR} +end; + +procedure MakeQuietNaN(var X: Double; Tag: TNaNTag); +var + Bits: Int64; +begin + CheckTag(Tag); + if Tag = 0 then + Bits := ZeroTag + else + Bits := Abs(Tag); + {$IFDEF CLR} + X := BitConverter.Int64BitsToDouble((Bits shl dNaNTagShift) or dQuietNaNBits); + {$ELSE} + PInt64(@X)^ := (Bits shl dNaNTagShift) or dQuietNaNBits; + {$ENDIF CLR} + if Tag < 0 then + {$IFDEF CLR} + X := BitConverter.Int64BitsToDouble(BitConverter.DoubleToInt64Bits(X) or (Int64(1) shl dSignBit)); + {$ELSE} + {$IFDEF FPC} + QWord(X) := QWord(X) or (1 shl dSignBit); + {$ELSE} + Include(TDoubleBits(X), dSignBit); + {$ENDIF FPC} + {$ENDIF CLR} +end; + +procedure MakeQuietNaN(var X: Extended; Tag: TNaNTag); +{$IFDEF CLR} +var + d: Double; +{$ELSE} +const + QuietNaNSignificand = $C000000000000000; + QuietNaNExponent = $7FFF; +var + Bits: Int64; +{$ENDIF CLR} +begin + {$IFDEF CLR} + d := X; + MakeQuietNaN(d); + X := d; + {$ELSE} + 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} + Include(TExtendedBits(X), xSignBit); + {$ENDIF FPC} + {$ENDIF CLR} +end; + +procedure MakeSignalingNaN(var X: Single; Tag: TNaNTag); +begin + {$IFDEF ClR} + MakeQuietNaN(X, Tag); + BitConverter.ToSingle( + BitConverter.GetBytes( + BitConverter.ToInt32( + BitConverter.GetBytes(X), 0) and not (1 shl sNaNQuietFlag)), 0); + {$ELSE} + {$IFDEF MSWINDOWS} + {$IFNDEF FPC} + InitExceptObjProc; + {$ENDIF ~FPC} + {$ENDIF MSWINDOWS} + MakeQuietNaN(X, Tag); + Exclude(TSingleBits(X), sNaNQuietFlag); + {$ENDIF CLR} +end; + +procedure MakeSignalingNaN(var X: Double; Tag: TNaNTag); +begin + {$IFDEF ClR} + MakeQuietNaN(X, Tag); + BitConverter.Int64BitsToDouble( + BitConverter.DoubleToInt64Bits(X) and not (1 shl sNaNQuietFlag)); + {$ELSE} + {$IFDEF FPC} + MakeQuietNaN(X, Tag); + QWord(X) := QWord(X) and not (1 shl dNaNQuietFlag); + {$ELSE} + {$IFDEF MSWINDOWS} + InitExceptObjProc; + {$ENDIF MSWINDOWS} + MakeQuietNaN(X, Tag); + Exclude(TDoubleBits(X), dNaNQuietFlag); + {$ENDIF FPC} + {$ENDIF CLR} +end; + +procedure MakeSignalingNaN(var X: Extended; Tag: TNaNTag); +{$IFDEF CLR} +var + d: Double; +{$ENDIF CLR} +begin + {$IFDEF CLR} + d := X; + MakeSignalingNaN(d, Tag); + X := d; + {$ELSE} + {$IFDEF FPC} + MakeQuietNaN(X, Tag); + TExtendedRec(X).Significand := TExtendedRec(X).Significand and not (1 shl xNaNQuietFlag); + {$ELSE} + {$IFDEF MSWINDOWS} + //InitExceptObjProc; + {$ENDIF MSWINDOWS} + MakeQuietNaN(X, Tag); + Exclude(TExtendedBits(X), xNaNQuietFlag); + {$ENDIF FPC} + {$ENDIF CLR} +end; + +{$IFNDEF CLR} +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; +{$ENDIF ~CLR} + +function IsSpecialValue(const X: Float): Boolean; +begin + Result := IsNaN(X) or IsInfinite(X); +end; + +//=== { EJclNaNSignal } ====================================================== + +{$IFNDEF CLR} +constructor EJclNaNSignal.Create(ATag: TNaNTag); +begin + FTag := ATag; + CreateResFmt(@RsNaNSignal, [ATag]); +end; +{$ENDIF ~CLR} + +//=== { 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({$IFDEF CLR}Borland.Delphi.{$ENDIF}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 + {$IFDEF CLR} + raise EJclMathError.Create(RsInvalidRational); + {$ELSE} + raise EJclMathError.CreateRes(@RsInvalidRational); + {$ENDIF CLR} + 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 := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Abs(FT); + FN := {$IFDEF CLR}Borland.Delphi.{$ENDIF}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 + {$IFDEF CLR} + raise EJclMathError.Create(RsDivByZero); + {$ELSE} + raise EJclMathError.CreateRes(@RsDivByZero); + {$ENDIF CLR} + + FN := FN * V; + Simplify; +end; + +procedure TJclRational.Divide(const R: TJclRational); +begin + if R.FT = 0 then + {$IFDEF CLR} + raise EJclMathError.Create(RsRationalDivByZero); + {$ELSE} + raise EJclMathError.CreateRes(@RsRationalDivByZero); + {$ENDIF CLR} + + 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 + {$IFDEF CLR} + raise EJclMathError.Create(RsRationalDivByZero); + {$ELSE} + raise EJclMathError.CreateRes(@RsRationalDivByZero); + {$ENDIF CLR} + + 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({$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Sqrt(FT / FN)); +end; + +procedure TJclRational.Sqr; +begin + FT := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Sqr(FT); + FN := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Sqr(FN); +end; + +//=== Checksums ============================================================== + +// See also: CountBitsSet in JclLogic (bug fixing etc.) - similar algorithm! + +{$IFDEF CLR} +function GetParity(Buffer: TDynByteArray; Len: Integer): Boolean; +{$ELSE} +function GetParity(Buffer: PByte; Len: Integer): Boolean; +{$ENDIF CLR} +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; + {$IFDEF CLR} + Index: Cardinal; + {$ENDIF CLR} +begin + BitsSet := 0; + {$IFDEF CLR} + Index := 0; + if Len > Length(Buffer) then + Len := Length(Buffer); + {$ENDIF CLR} + while Len > 0 do + begin + {$IFDEF CLR} + b := Buffer[Index]; + {$ELSE} + b := PByte(Buffer)^; + {$ENDIF CLR} + // lower Nibble + Inc(BitsSet, lu[b and $0F]); + // upper Nibble + Inc(BitsSet, lu[b shr 4]); + + Dec(Len); + {$IFDEF CLR} + Inc(Index); + {$ELSE} + Inc(PByte(Buffer)); + {$ENDIF CLR} + end; + + Result := (BitsSet mod 2) = 0; +end; + +// CRC +{ TODO : check for the correct polynom and init, exit values } + +// CRC 16 + +{$IFDEF CRCINIT} +var +{$ELSE} +const +{$ENDIF CRCINIT} + // CRC16Polynom = $1021; + Crc16Table: array [0..255] of Word = ( + $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 + ); + Crc16Start: Cardinal = $FFFF; + +const + Crc16Bits = 16; + Crc16Bytes = 2; + Crc16HighBit = $8000; + NotCrc16HighBit = $7FFF; + +function Crc16Corr(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(X: PJclByteArray; N: Integer; Crc: Word = 0): Word; +var + I: Integer; +begin + Result := Crc16Start; + 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 CheckCrc16_P(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(X, N, Crc); + if Crc = 0 then + Result := 0 // No CRC-error + else + begin + J := Crc16Corr(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 Crc16(const X: array of Byte; N: Integer; Crc: Word = 0): Word; +begin + {$IFDEF CLR} + Result := Crc16_P(X, N, Crc); + {$ELSE} + Result := Crc16_P(@X, N, Crc); + {$ENDIF CLR} +end; + +function CheckCrc16(var X: array of Byte; N: Integer; Crc: Word): Integer; +begin + {$IFDEF CLR} + Result := CheckCRC16_P(X, N, CRC); + {$ELSE} + Result := CheckCRC16_P(@X, N, CRC); + {$ENDIF CLR} +end; + +function Crc16_A(const X: array of Byte; Crc: Word = 0): Word; +begin + {$IFDEF CLR} + Result := Crc16_P(X, Length(X), Crc); + {$ELSE} + Result := Crc16_P(@X, Length(X), Crc); + {$ENDIF CLR} +end; + +function CheckCrc16_A(var X: array of Byte; Crc: Word): Integer; +begin + {$IFDEF CLR} + Result := CheckCrc16_P(X, Length(X), Crc); + {$ELSE} + Result := CheckCrc16_P(@X, Length(X), Crc); + {$ENDIF CLR} +end; + +{$IFDEF CRCINIT} +// The CRC Table can be generated like this: +// const Crc16Start0 = 0; !! + +function Crc16_Bitwise(X: PJclByteArray; 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); +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; + Crc16Start := Start; +end; + +{$ENDIF CRCINIT} + +// CRC 32 + +{$IFDEF CRCINIT} +var +{$ELSE} +const +{$ENDIF CRCINIT} + // CRC32Polynom = $04C11DB7; + Crc32Table: array [0..255] of Cardinal = ( + $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 + ); + Crc32Start: Cardinal = $FFFFFFFF; + +const + Crc32Bits = 32; + Crc32Bytes = 4; + Crc32HighBit = $80000000; + NotCrc32HighBit = $7FFFFFFF; + +function Crc32Corr(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(X: PJclByteArray; N: Integer; Crc: Cardinal = 0): Cardinal; +var + I: Integer; +begin + Result := Crc32Start; + for I := 0 to N - 1 do // The CRC Bytes are located at the end of the information + 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 X[I]; + end; + 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 CheckCrc32_P(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(X, N, Crc); + if Crc = 0 then + Result := 0 // No CRC-error + else + begin + J := Crc32Corr(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 Crc32(const X: array of Byte; N: Integer; Crc: Cardinal = 0): Cardinal; +begin + {$IFDEF CLR} + Result := Crc32_P(X, N, Crc); + {$ELSE} + Result := Crc32_P(@X, N, Crc); + {$ENDIF CLR} +end; + +function CheckCrc32(var X: array of Byte; N: Integer; Crc: Cardinal): Integer; +begin + {$IFDEF CLR} + Result := CheckCRC32_P(X, N, CRC); + {$ELSE} + Result := CheckCRC32_P(@X, N, CRC); + {$ENDIF CLR} +end; + +function Crc32_A(const X: array of Byte; Crc: Cardinal = 0): Cardinal; +begin + {$IFDEF CLR} + Result := Crc32_P(X, Length(X), Crc); + {$ELSE} + Result := Crc32_P(@X, Length(X), Crc); + {$ENDIF CLR} +end; + +function CheckCrc32_A(var X: array of Byte; Crc: Cardinal): Integer; +begin + {$IFDEF CLR} + Result := CheckCrc32_P(X, Length(X), Crc); + {$ELSE} + Result := CheckCrc32_P(@X, Length(X), Crc); + {$ENDIF CLR} +end; + +{$IFDEF CRCINIT} +// The CRC Table can be generated like this: +// const Crc32Start0 = 0; !! + +function Crc32_Bitwise(X: PJclByteArray; 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); +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; + Crc32Start := Start; +end; + +{$ENDIF CRCINIT} + +//=== complex numbers support ================================================ + +const + RectOne: TRectComplex = (Re: 1.0; Im: 0.0); + RectZero: TRectComplex = (Re: 0.0; Im: 0.0); + //RectInfinity: TRectComplex = (Re: Infinity; Im: Infinity); + +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 + 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 + Result.Radius := Radius; + Result.Angle := Angle; +end; + +function PolarComplex(const Z: TRectComplex): TPolarComplex; +begin + Result.Radius := Sqrt(Sqr(Z.Re) + Sqr(Z.Im)); + 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 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; + +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; + +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; overload; +begin + Result.Re := Z.Re; + Result.Im := -Z.Im; +end; + +function Conjugate(const Z: TPolarComplex): TPolarComplex; overload; +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; overload; +begin + Result.Re := -Z.Re; + Result.Im := -Z.Im; +end; + +function Neg(const Z: TPolarComplex): TPolarComplex; overload; +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 := Z1.Angle + Z2.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 Ln(const Z: TPolarComplex): TRectComplex; +begin + Result.Re := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Ln(Z.Radius); + Result.Im := NormalizeAngle(Z.Angle); +end; + +function Exp(const Z: TRectComplex): TPolarComplex; +begin + Result.Radius := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Exp(Z.Re); + Result.Angle := Z.Im; +end; + +function Power(const Z: TPolarComplex; const Exponent: Float): TPolarComplex; +begin + Result.Radius := 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 := 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 + SinCos(Z.Re, ASin, ACos); + Result.Re := ACos * CosH(Z.Im); + Result.Im := -ASin * SinH(Z.Im); +end; + +function Sin(const Z: TRectComplex): TRectComplex; +var + ACos, ASin: Float; +begin + SinCos(Z.Re, ASin, ACos); + Result.Re := ASin * CosH(Z.Im); + Result.Im := ACos * SinH(Z.Im); +end; + +function Tan(const Z: TRectComplex): TRectComplex; +var + Denom: Float; + ACos, ASin: Float; +begin + SinCos(2.0 * Z.Re, ASin, ACos); + Denom := ACos + CosH(2.0 * Z.Im); + Result.Re := ASin / Denom; + Result.Im := SinH(2.0 * Z.Im) / Denom; +end; + +function Cot(const Z: TRectComplex): TRectComplex; +var + Denom: Float; + ACos, ASin: Float; +begin + SinCos(2.0 * Z.Re, ASin, ACos); + Denom := CosH(2.0 * Z.Im) - ACos; + Result.Re := ASin / Denom; + Result.Im := -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 + SinCos(Z.Im, ASin, ACos); + Result.Re := CosH(Z.Re) * ACos; + Result.Im := SinH(Z.Re) * ASin; +end; + +function SinH(const Z: TRectComplex): TRectComplex; +var + ACos, ASin: Float; +begin + SinCos(Z.Im, ASin, ACos); + Result.Re := SinH(Z.Re) * ACos; + Result.Im := CosH(Z.Re) * ASin; +end; + +function TanH(const Z: TRectComplex): TRectComplex; +var + Denom: Float; + ACos, ASin: Float; +begin + SinCos(2.0 * Z.Im, ASin, ACos); + Denom := CosH(2.0 * Z.Re) + ACos; + Result.Re := SinH(2.0 * Z.Re) / Denom; + Result.Im := ASin / Denom; +end; + +function CotH(const Z: TRectComplex): TRectComplex; +var + Denom: Float; + ACos, ASin: Float; +begin + SinCos(2.0 * Z.Im, ASin, ACos); + Denom := CosH(2.0 * Z.Re) - ACos; + Result.Re := 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} + +class operator TRectComplex.Implicit(const Value: Float): TRectComplex; +begin + Result.Re := Value; + Result.Im := 0; +end; + +class operator TRectComplex.Implicit(const Value: Integer): TRectComplex; +begin + Result.Re := Value; +end; + +class operator TRectComplex.Implicit(const Value: Int64): TRectComplex; +begin + Result.Re := Value; +end; + +class operator TRectComplex.Implicit(const Z: TPolarComplex): TRectComplex; +var + ASin, ACos: Float; +begin + SinCos(Z.Angle, ASin, ACos); + Result.Re := Z.Radius * ACos; + Result.Im := Z.Radius * ASin; +end; + +class operator TRectComplex.Equal(const Z1, Z2: TRectComplex): Boolean; +begin + Result := (Z1.Re = Z2.Re) and (Z1.Im = Z2.Im); +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.Re := Z1.Re + Z2.Re; + Result.Im := Z1.Im + Z2.Im; +end; + +class operator TRectComplex.Subtract(const Z1, Z2: TRectComplex): TRectComplex; +begin + Result.Re := Z1.Re - Z2.Re; + Result.Im := Z1.Im - Z2.Im; +end; + +class operator TRectComplex.Multiply(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; + +class operator TRectComplex.Divide(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; + +class operator TRectComplex.Negative(const Z: TRectComplex): TRectComplex; +begin + Result.Re := -Z.Re; + Result.Im := -Z.Im; +end; + +class function TRectComplex.Exp(const Z: TRectComplex): TPolarComplex; +begin + Result.Radius := {$IFDEF CLR}Borland.Delphi.{$ENDIF}System.Exp(Z.Re); + Result.Angle := Z.Im; +end; + +{$ENDIF SUPPORTS_CLASS_OPERATORS} + +// History: + +// ????-??-??: +// - Added functions: Versine, Coversine, Haversine, exsecand +// - Added TruncPower function (Truncated Power) + +// ????-??-??, Matthias Thoma: +// - D: TruncPower(Base, Exponent) Power(Base, Exponent) for Base >= 0, 0 for Base < 0 +// - Added Exp function +// - Added special value handling to sin +// - Added function IsSpecialValue +// - Added new Power function. Author: Mark Vaughan +// - Added dynamic switching of IsPrime function. The old IsPrime is now IsPrimeTD +// - Added new define: MATH_EXT_SPECIALVALUES; +// - Added new function: Ackermann +// - Added new function: Fibonacci +// - Fixed a bug: LCD throws a divby zero when result should be 0. +// - Fixed a bug: Rational.Add(TRational) was buggy and delivered wrong results. +// - Fixed a bug: Rational.Subtract(TRational) was buggy and delivered wrong results. + +// 2003-04, Robert Rossmair: +// - Made assembler code PIC-ready where necessary (Linux) +// - Fixed a bug: So-called "CotH" function was CosH +// - Added functions: CommercialRound, CotH + +// 2003-10, Matthias Thoma: +// - Added EulerMascheroni constant. +// - Added GoldenMean constant +// - Added Bernstein constant +// - Added Catalan constant + +// 2003-11, Robert Rossmair: +// - Changes to make it compile with free pascal compiler v1.9 +// - Removed "uses JclUnitConv" + +// $Log: JclMath.pas,v $ +// Revision 1.34 2005/12/04 10:10:58 obones +// Borland Developer Studio 2006 support +// +// Revision 1.33 2005/09/11 11:37:44 ahuser +// Added inline support +// +// Revision 1.32 2005/09/11 11:30:43 ahuser +// Added inline support +// +// Revision 1.30 2005/09/03 16:20:43 rrossmair +// - support for operator overloading +// +// Revision 1.28 2005/08/19 01:11:50 outchy +// Conversion functions are public and reworked. +// (Removing hints while compiling with C++Builder 5). +// +// Revision 1.27 2005/08/09 10:30:21 ahuser +// JCL.NET changes +// +// Revision 1.26 2005/08/07 13:09:54 outchy +// Changed PByteArray to PJclByteArray to avoid RangeCheck exceptions. +// +// Revision 1.25 2005/05/05 20:08:43 ahuser +// JCL.NET support +// +// Revision 1.24 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.23 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.22 2005/02/14 21:15:52 obones +// PByte is not needed after all, it is in JclBase +// +// Revision 1.21 2005/02/14 19:18:16 obones +// Added PByte definition for D5/BCB5 +// +// Revision 1.20 2005/02/13 09:40:24 mthoma +// Added Parity checksum functionality. +// +// Revision 1.19 2004/12/11 18:50:45 obones +// Added EnsureRange +// +// Revision 1.18 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.17 2004/10/12 17:23:50 rrossmair +// - added complex number support (procedural) +// +// Revision 1.16 2004/10/01 06:50:13 marquardt +// IsNan use to IsNaN +// +// Revision 1.15 2004/09/16 22:45:56 rrossmair +// - David Butler added to list of original authors +// +// Revision 1.14 2004/09/16 19:47:32 rrossmair +// check-in in preparation for release 1.92 +// +// Revision 1.13 2004/08/03 07:22:37 marquardt +// resourcestring cleanup +// +// Revision 1.12 2004/08/02 15:30:16 marquardt +// hunting down (rom) comments +// +// Revision 1.11 2004/08/01 05:52:11 marquardt +// move constructors/destructors +// +// Revision 1.10 2004/07/29 15:16:51 marquardt +// simple style cleaning +// +// Revision 1.9 2004/07/28 18:00:51 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.8 2004/06/16 07:30:27 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.7 2004/06/14 06:24:52 marquardt +// style cleaning IFDEF +// +// Revision 1.6 2004/05/13 07:31:15 rrossmair +// updated Header (IDK ("I don't know") -> unknown; J. Debord -> Jean Debord +// +// Revision 1.5 2004/05/09 11:15:42 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.4 2004/04/06 04:53:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/common/JclMime.pas b/official/1.96/source/common/JclMime.pas new file mode 100644 index 0000000..36cd920 --- /dev/null +++ b/official/1.96/source/common/JclMime.pas @@ -0,0 +1,1000 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ 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: 2005/05/05 20:08:43 $ +// For history see end of file + +unit JclMime; + +{$I jcl.inc} + +interface + +uses + {$IFDEF CLR} + System.Text, + {$ENDIF CLR} + SysUtils, Classes, + JclBase; + +function MimeEncodeString(const S: AnsiString): AnsiString; +function MimeEncodeStringNoCRLF(const S: AnsiString): AnsiString; +function MimeDecodeString(const S: AnsiString): AnsiString; +function MimeEncodedSize(const InputSize: Cardinal): Cardinal; +function MimeEncodedSizeNoCRLF(const InputSize: Cardinal): Cardinal; +function MimeDecodedSize(const InputSize: Cardinal): Cardinal; +procedure DecodeHttpBasicAuthentication(const BasicCredentials: string; + out UserId, PassWord: string); +{$IFDEF CLR} +procedure MimeEncode(const InputBuffer: TDynByteArray; InputOffset: Cardinal; + const InputByteCount: Cardinal; out OutputBuffer: TDynByteArray; OutputOffset: Cardinal = 0); overload; +procedure MimeEncodeNoCRLF(const InputBuffer: TDynByteArray; InputOffset: Cardinal; + const InputByteCount: Cardinal; out OutputBuffer: TDynByteArray; OutputOffset: Cardinal = 0); overload; +procedure MimeEncodeFullLines(const InputBuffer: TDynByteArray; InputOffset: Cardinal; + const InputByteCount: Cardinal; out OutputBuffer: TDynByteArray; OutputOffset: Cardinal = 0); overload; +function MimeDecode(const InputBuffer: TDynByteArray; InputOffset: Cardinal; + const InputByteCount: Cardinal; out OutputBuffer: TDynByteArray; OutputOffset: Cardinal = 0): Cardinal; overload; +function MimeDecodePartial(const InputBuffer: TDynByteArray; InputOffset: Cardinal; + const InputByteCount: Cardinal; out OutputBuffer: TDynByteArray; OutputOffset: Cardinal; + var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; overload; +function MimeDecodePartialEnd(out OutputBuffer: TDynByteArray; OutputOffset: Cardinal; + const ByteBuffer: Cardinal; const ByteBufferSpace: Cardinal): Cardinal; overload; + +procedure MimeEncode(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray); overload; +procedure MimeEncodeNoCRLF(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray); overload; +procedure MimeEncodeFullLines(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray); overload; +function MimeDecode(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray): Cardinal; overload; +function MimeDecodePartial(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; overload; +function MimeDecodePartialEnd(out OutputBuffer: TDynByteArray; const ByteBuffer: Cardinal; + const ByteBufferSpace: Cardinal): Cardinal; overload; + +{$ELSE} +procedure MimeEncode(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); +procedure MimeEncodeNoCRLF(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); +procedure MimeEncodeFullLines(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); +function MimeDecode(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer): Cardinal; +function MimeDecodePartial(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer; + var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; +function MimeDecodePartialEnd(out OutputBuffer; const ByteBuffer: Cardinal; + const ByteBufferSpace: Cardinal): Cardinal; +{$ENDIF CLR} +procedure MimeEncodeFile(const InputFileName, OutputFileName: AnsiString); +procedure MimeEncodeFileNoCRLF(const InputFileName, OutputFileName: AnsiString); +procedure MimeDecodeFile(const InputFileName, OutputFileName: AnsiString); +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; + +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 + BUFFER_SIZE = $3000; + EqualSign = Byte('='); + +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 Cardinal = ( + 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); + +{$IFDEF CLR} +procedure MimeEncode(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray); +begin + MimeEncode(InputBuffer, 0, InputByteCount, OutputBuffer, 0); +end; + +procedure MimeEncodeNoCRLF(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray); +begin + MimeEncodeNoCRLF(InputBuffer, 0, InputByteCount, OutputBuffer, 0); +end; + +procedure MimeEncodeFullLines(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray); +begin + MimeEncodeFullLines(InputBuffer, 0, InputByteCount, OutputBuffer, 0); +end; + +function MimeDecode(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray): Cardinal; +begin + Result := MimeDecode(InputBuffer, 0, InputByteCount, OutputBuffer, 0); +end; + +function MimeDecodePartial(const InputBuffer: TDynByteArray; const InputByteCount: Cardinal; + out OutputBuffer: TDynByteArray; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; +begin + Result := MimeDecodePartial(InputBuffer, 0, InputByteCount, OutputBuffer, 0, ByteBuffer, ByteBufferSpace); +end; + +function MimeDecodePartialEnd(out OutputBuffer: TDynByteArray; const ByteBuffer: Cardinal; + const ByteBufferSpace: Cardinal): Cardinal; +begin + Result := MimeDecodePartialEnd(OutputBuffer, 0, ByteBuffer, ByteBufferSpace); +end; +{$ELSE} +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; +{$ENDIF CLR} + +// Wrapper functions & procedures +function MimeEncodeString(const S: AnsiString): AnsiString; +var + L: Cardinal; + {$IFDEF CLR} + Bytes: TDynByteArray; + {$ENDIF CLR} +begin + if S <> '' then + begin + {$IFDEF CLR} + L := Length(S); + SetLength(Bytes, MimeEncodedSize(L)); + MimeEncode(BytesOf(S), 0, L, Bytes, 0); + Result := Bytes; + {$ELSE} + L := PCardinal(Cardinal(S) - 4)^; + SetLength(Result, MimeEncodedSize(L)); + MimeEncode(Pointer(S)^, L, Pointer(Result)^); + {$ENDIF CLR} + end + else + Result := ''; +end; + +function MimeEncodeStringNoCRLF(const S: AnsiString): AnsiString; +var + L: Cardinal; + {$IFDEF CLR} + Bytes: TDynByteArray; + {$ENDIF CLR} +begin + if S <> '' then + begin + {$IFDEF CLR} + L := Length(S); + SetLength(Bytes, MimeEncodedSizeNoCRLF(L)); + MimeEncodeNoCRLF(BytesOf(S), 0, L, Bytes, 0); + Result := Bytes; + {$ELSE} + L := PCardinal(Cardinal(S) - 4)^; + SetLength(Result, MimeEncodedSizeNoCRLF(L)); + MimeEncodeNoCRLF(Pointer(S)^, L, Pointer(Result)^); + {$ENDIF CLR} + end + else + Result := ''; +end; + +function MimeDecodeString(const S: AnsiString): AnsiString; +var + ByteBuffer, ByteBufferSpace: Cardinal; + L: Cardinal; + {$IFDEF CLR} + Bytes: TDynByteArray; + {$ENDIF CLR} +begin + if S <> '' then + begin + {$IFDEF CLR} + L := Length(S); + SetLength(Bytes, MimeEncodedSize(L)); + ByteBuffer := 0; + ByteBufferSpace := 4; + L := MimeDecodePartial(BytesOf(S), 0, L, Bytes, 0, ByteBuffer, ByteBufferSpace); + Inc(L, MimeDecodePartialEnd(Bytes, 0 + L, ByteBuffer, ByteBufferSpace)); + SetLength(Bytes, L); + Result := Bytes; + {$ELSE} + L := PCardinal(Cardinal(S) - 4)^; + SetLength(Result, MimeDecodedSize(L)); + ByteBuffer := 0; + ByteBufferSpace := 4; + L := MimeDecodePartial(Pointer(S)^, L, Pointer(Result)^, ByteBuffer, ByteBufferSpace); + Inc(L, MimeDecodePartialEnd(Pointer(Cardinal(Result) + L)^, ByteBuffer, ByteBufferSpace)); + SetLength(Result, L); + {$ENDIF CLR} + end + else + Result := ''; +end; + +procedure DecodeHttpBasicAuthentication(const BasicCredentials: string; out UserId, PassWord: string); +const + LBasic = 6; { Length ('Basic ') } +{$IFDEF CLR} +var + Index: Cardinal; + Decoded: TDynByteArray; + I, L: Cardinal; +begin + UserId := ''; + PassWord := ''; + L := Length(BasicCredentials); + if L < LBasic then // includes "L = 0" + Exit; + Dec(L, LBasic); + Index := LBasic; + + SetLength(Decoded, MimeDecodedSize(L)); + L := MimeDecode(BytesOf(BasicCredentials), Index, L, Decoded, 0); + + { Look for colon (':'). } + I := 0; + while (L > 0) and (Char(Decoded[I]) <> ':') do + begin + Inc(I); + Dec(L); + end; + + { Store UserId and Password. } + UserId := Copy(Decoded, 0, I); + if L > 1 then + PassWord := Copy(Decoded, I + 1, L - 1) + else + PassWord := ''; +end; +{$ELSE} +var + DecodedPtr, P: PAnsiChar; + I, L: Cardinal; +begin + UserId := ''; + PassWord := ''; + + P := Pointer(BasicCredentials); + if P = nil then + Exit; + + L := Cardinal(Pointer(P - 4)^); + 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; +{$ENDIF CLR} + +// Helper functions +function MimeEncodedSize(const InputSize: Cardinal): Cardinal; +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: Cardinal): Cardinal; +begin + Result := (InputSize + 2) div 3 * 4; +end; + +function MimeDecodedSize(const InputSize: Cardinal): Cardinal; +begin + Result := (InputSize + 3) div 4 * 3; +end; + + +// Primary functions & procedures +procedure MimeEncode(const InputBuffer {$IFDEF CLR}: TDynByteArray; InputOffset: Cardinal {$ENDIF CLR}; + const InputByteCount: Cardinal; + out OutputBuffer {$IFDEF CLR}: TDynByteArray; OutputOffset: Cardinal {$ENDIF CLR}); +var + IDelta, ODelta: Cardinal; +begin + {$IFDEF CLR} + MimeEncodeFullLines(InputBuffer, InputOffset, InputByteCount, OutputBuffer, OutputOffset); + {$ELSE} + MimeEncodeFullLines(InputBuffer, InputByteCount, OutputBuffer); + {$ENDIF CLR} + 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; + {$IFDEF CLR} + MimeEncodeNoCRLF(InputBuffer, InputOffset + IDelta, InputByteCount - IDelta, OutputBuffer, OutputOffset + ODelta); + {$ELSE} + MimeEncodeNoCRLF(Pointer(Cardinal(@InputBuffer) + IDelta)^, InputByteCount - IDelta, Pointer(Cardinal(@OutputBuffer) + ODelta)^); + {$ENDIF CLR} +end; + +{$IFDEF CLR} +procedure MimeEncodeFullLines(const InputBuffer: TDynByteArray; InputOffset: Cardinal; + const InputByteCount: Cardinal; out OutputBuffer: TDynByteArray; OutputOffset: Cardinal); +var + B, InnerLimit, OuterLimit: Cardinal; + InIndex: Cardinal; + OutIndex: Cardinal; +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); + { 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); + 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; +{$ELSE} +procedure MimeEncodeFullLines(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); +var + B, InnerLimit, OuterLimit: Cardinal; + 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 := Cardinal(InPtr); + Inc(InnerLimit, MIME_DECODED_LINE_BREAK); + + OuterLimit := Cardinal(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 Cardinal(InPtr) >= InnerLimit; + + { Write line break (CRLF). } + OutPtr^.B1 := 13; + OutPtr^.B2 := 10; + Inc(Cardinal(OutPtr), 2); + + Inc(InnerLimit, MIME_DECODED_LINE_BREAK); + until InnerLimit > OuterLimit; +end; +{$ENDIF CLR} + +{$IFDEF CLR} +procedure MimeEncodeNoCRLF(const InputBuffer: TDynByteArray; InputOffset: Cardinal; + const InputByteCount: Cardinal; out OutputBuffer: TDynByteArray; OutputOffset: Cardinal); +var + B, InnerLimit, OuterLimit: Cardinal; + InIndex: Cardinal; + OutIndex: Cardinal; +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); + { 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); + end; + + { End of data & padding. } + case 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; +{$ELSE} +procedure MimeEncodeNoCRLF(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer); +var + B, InnerLimit, OuterLimit: Cardinal; + InPtr: PByte3; + OutPtr: PByte4; +begin + if InputByteCount = 0 then + Exit; + + InPtr := @InputBuffer; + OutPtr := @OutputBuffer; + + OuterLimit := InputByteCount div 3 * 3; + + InnerLimit := Cardinal(InPtr); + Inc(InnerLimit, OuterLimit); + + { Last line loop. } + while Cardinal(InPtr) < 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 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; +{$ENDIF CLR} + +// Decoding Core +function MimeDecode(const InputBuffer {$IFDEF CLR}: TDynByteArray; InputOffset: Cardinal {$ENDIF CLR}; + const InputByteCount: Cardinal; out OutputBuffer {$IFDEF CLR}: TDynByteArray; OutputOffset: Cardinal {$ENDIF CLR}): Cardinal; +var + ByteBuffer, ByteBufferSpace: Cardinal; +begin + ByteBuffer := 0; + ByteBufferSpace := 4; + {$IFDEF CLR} + Result := MimeDecodePartial(InputBuffer, InputOffset, InputByteCount, OutputBuffer, OutputOffset, ByteBuffer, ByteBufferSpace); + Inc(Result, MimeDecodePartialEnd(OutputBuffer, OutputOffset + Result, ByteBuffer, ByteBufferSpace)); + {$ELSE} + Result := MimeDecodePartial(InputBuffer, InputByteCount, OutputBuffer, ByteBuffer, ByteBufferSpace); + Inc(Result, MimeDecodePartialEnd(Pointer(Cardinal(@OutputBuffer) + Result)^, ByteBuffer, ByteBufferSpace)); + {$ENDIF CLR} +end; + +{$IFDEF CLR} +function MimeDecodePartial(const InputBuffer: TDynByteArray; InputOffset: Cardinal; + const InputByteCount: Cardinal; out OutputBuffer: TDynByteArray; OutputOffset: Cardinal; + var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; +var + LByteBuffer, LByteBufferSpace, C: Cardinal; + InIndex, OuterLimit: Cardinal; + OutIndex: Cardinal; +begin + if InputByteCount > 0 then + begin + InIndex := InputOffset; + OuterLimit := InIndex + 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); + LByteBufferSpace := 4; + end; + ByteBuffer := LByteBuffer; + ByteBufferSpace := LByteBufferSpace; + Result := OutIndex - OutputOffset; + end + else + Result := 0; +end; +{$ELSE} +function MimeDecodePartial(const InputBuffer; const InputByteCount: Cardinal; out OutputBuffer; + var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; +var + LByteBuffer, LByteBufferSpace, C: Cardinal; + InPtr, OuterLimit: ^Byte; + OutPtr: PByte3; +begin + if InputByteCount > 0 then + begin + InPtr := @InputBuffer; + Cardinal(OuterLimit) := Cardinal(InPtr) + 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 := Cardinal(OutPtr) - Cardinal(@OutputBuffer); + end + else + Result := 0; +end; +{$ENDIF CLR} + +function MimeDecodePartialEnd(out OutputBuffer {$IFDEF CLR}: TDynByteArray; OutputOffset: Cardinal {$ENDIF CLR}; + const ByteBuffer: Cardinal; const ByteBufferSpace: Cardinal): Cardinal; +var + LByteBuffer: Cardinal; +begin + case ByteBufferSpace of + 1: + begin + LByteBuffer := ByteBuffer shr 2; + {$IFDEF CLR} + OutputBuffer[OutputOffset + 1] := Byte(LByteBuffer); + LByteBuffer := LByteBuffer shr 8; + OutputBuffer[OutputOffset + 0] := Byte(LByteBuffer); + {$ELSE} + PByte3(@OutputBuffer)^.B2 := Byte(LByteBuffer); + LByteBuffer := LByteBuffer shr 8; + PByte3(@OutputBuffer)^.B1 := Byte(LByteBuffer); + {$ENDIF CLR} + Result := 2; + end; + 2: + begin + LByteBuffer := ByteBuffer shr 4; + {$IFDEF CLR} + OutputBuffer[OutputOffset + 0] := Byte(LByteBuffer); + {$ELSE} + PByte3(@OutputBuffer)^.B1 := Byte(LByteBuffer); + {$ENDIF CLR} + Result := 1; + end; + else + Result := 0; + end; +end; + +// File Encoding & Decoding +procedure MimeEncodeFile(const InputFileName, OutputFileName: AnsiString); +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: AnsiString); +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: AnsiString); +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; + {$IFDEF CLR} + OutputBuffer: array of Byte; + {$ELSE} + OutputBuffer: array [0..(MIME_BUFFER_SIZE + 2) div 3 * 4 + MIME_BUFFER_SIZE div MIME_DECODED_LINE_BREAK * 2 - 1] of Byte; + {$ENDIF CLR} + BytesRead: Cardinal; + IDelta, ODelta: Cardinal; +begin + BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer)); + {$IFDEF CLR} + SetLength(OutputBuffer, (MIME_BUFFER_SIZE + 2) div 3 * 4 + MIME_BUFFER_SIZE div MIME_DECODED_LINE_BREAK * 2); + {$ENDIF CLR} + + while BytesRead = Cardinal(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; + {$IFDEF ClR} + MimeEncodeNoCRLF(InputBuffer, IDelta, BytesRead - IDelta, OutputBuffer, ODelta); + {$ELSE} + MimeEncodeNoCRLF(Pointer(Cardinal(@InputBuffer) + IDelta)^, BytesRead - IDelta, Pointer(Cardinal(@OutputBuffer) + ODelta)^); + {$ENDIF CLR} + + OutputStream.Write(OutputBuffer, MimeEncodedSize(BytesRead)); +end; + +procedure MimeEncodeStreamNoCRLF(const InputStream: TStream; const OutputStream: TStream); +var + InputBuffer: array [0..MIME_BUFFER_SIZE - 1] of Byte; + {$IFDEF CLR} + OutputBuffer: array of Byte; + {$ELSE} + OutputBuffer: array [0..((MIME_BUFFER_SIZE + 2) div 3) * 4 - 1] of Byte; + {$ENDIF CLR} + BytesRead: Cardinal; +begin + BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer)); + {$IFDEF CLR} + SetLength(OutputBuffer, ((MIME_BUFFER_SIZE + 2) div 3) * 4); + {$ENDIF CLR} + + while BytesRead = Cardinal(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; + {$IFDEF CLR} + OutputBuffer: array of Byte; + {$ELSE} + OutputBuffer: array [0..(MIME_BUFFER_SIZE + 3) div 4 * 3 - 1] of Byte; + {$ENDIF CLR} + BytesRead: Cardinal; +begin + ByteBuffer := 0; + ByteBufferSpace := 4; + BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer)); + {$IFDEF CLR} + SetLength(OutputBuffer, (MIME_BUFFER_SIZE + 3) div 4 * 3); + {$ENDIF CLR} + + 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; + +// History: + +// $Log: JclMime.pas,v $ +// Revision 1.14 2005/05/05 20:08:43 ahuser +// JCL.NET support +// +// Revision 1.13 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.12 2005/02/13 22:24:25 rrossmair +// moved PCardinal declaration from JclMime to JclBase +// +// Revision 1.11 2004/10/13 06:58:19 marquardt +// normal style cleaning +// +// Revision 1.10 2004/10/12 18:29:52 rrossmair +// cleanup +// +// Revision 1.9 2004/07/28 18:00:51 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.8 2004/07/07 22:34:25 mthoma +// Added Ralf MimeStreams and MimeFile utilities... +// +// Revision 1.7 2004/06/14 13:05:18 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.6 2004/05/05 00:09:59 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.5 2004/04/09 20:21:11 mthoma +// Updated to Ralfs latest release. That also fixed 0000406. +// + +end. diff --git a/official/1.96/source/common/JclPCRE.pas b/official/1.96/source/common/JclPCRE.pas new file mode 100644 index 0000000..0991270 --- /dev/null +++ b/official/1.96/source/common/JclPCRE.pas @@ -0,0 +1,279 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ Class wrapper for PCRE (PERL Compatible Regular Expression) } +{ } +{ Unit owner: Peter Thörnqvist } +{ Last modified: $Date: 2005/03/08 08:33:17 $ } +{ } +{**************************************************************************************************} + +unit JclPCRE; + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + Classes, SysUtils; + +type + EPCREError = class(Exception) + private + FErrorCode: Integer; + public + constructor CreateRes(ResStringRec: PResStringRec; ErrorCode: Integer); + property ErrorCode: Integer read FErrorCode; + end; + + TPCREIntArray = array [0..2999] of Integer; // 1000 subpatterns should be enough... + PPCREIntArray = ^TPCREIntArray; + + TJclAnsiRegExOption = (roIgnoreCase, roMultiLine, roDotAll, roExtended, + roAnchored, roDollarEndOnly, roExtra, roNotBOL, roNotEOL, roUnGreedy, roNotEmpty, roUTF8); + TJclAnsiRegExOptions = set of TJclAnsiRegExOption; + TJclAnsiCaptureOffset = record + FirstPos: Integer; + LastPos: Integer; + end; + + TJclAnsiRegEx = class(TObject) + private + FCode: Pointer; + FExtra: Pointer; + FOptions: TJclAnsiRegExOptions; + FSubject: AnsiString; + FErrorMessage: AnsiString; + FErrorOffset: Integer; + FVector: TPCREIntArray; + FStringCount: Integer; + FVectorSize: Integer; + FTables: PChar; + function GetCaptureCount: Integer; + function GetCaptures(Index: Integer): AnsiString; + function GetAPIOptions(RunTime: Boolean): Integer; + function GetCapturesOffset(Index: Integer): TJclAnsiCaptureOffset; + public + constructor Create; + destructor Destroy; override; + function Compile(const Pattern: AnsiString; Study, UserLocale: Boolean): Boolean; + function Match(const Subject: AnsiString; StartOffset: Cardinal = 1): Boolean; + property Options: TJclAnsiRegExOptions read FOptions write FOptions; + property CaptureCount: Integer read GetCaptureCount; + property Captures[Index: Integer]: AnsiString read GetCaptures; + property CaptureOffset[Index: Integer]: TJclAnsiCaptureOffset read GetCapturesOffset; + property ErrorMessage: AnsiString read FErrorMessage; + property ErrorOffset: Integer read FErrorOffset; + end; + +implementation + +uses + pcre, + JclResources; + +function PCRECheck(Value: Integer): Boolean; +var + PErr: PResStringRec; +begin + Result := False; + PErr := nil; + 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; + else + Result := True; + end; + if not Result then + raise EPCREError.CreateRes(PErr, Value); +end; + +//=== { TJclAnsiRegEx } ====================================================== + +constructor TJclAnsiRegEx.Create; +begin + inherited Create; + FVectorSize := SizeOf(FVector) div SizeOf(Integer); +end; + +destructor TJclAnsiRegEx.Destroy; +begin + (* + if FCode <> nil then + pcre_free(FCode); + if FExtra <> nil then + pcre_free(FExtra); + *) + inherited Destroy; +end; + +function TJclAnsiRegEx.Compile(const Pattern: AnsiString; Study, UserLocale: Boolean): Boolean; +var + ErrPtr: PChar; + ErrOffset: Integer; +begin + if UserLocale then + FTables := pcre_maketables + else + FTables := nil; + if Pattern = '' then + raise EPCREError.CreateRes(@RsErrNull, PCRE_ERROR_NULL); + FCode := pcre_compile(PChar(Pattern), GetAPIOptions(False), @ErrPtr, @ErrOffset, FTables); + FErrorMessage := ErrPtr; + FErrorOffset := ErrOffset; + Result := (FCode <> nil); + if Result and Study then + FExtra := pcre_study(FCode, 0, @ErrPtr); +end; + +function TJclAnsiRegEx.GetAPIOptions(RunTime: Boolean): Integer; +const + cDesignOptions: array [TJclAnsiRegExOption] of Integer = + (PCRE_CASELESS, PCRE_MULTILINE, PCRE_DOTALL, PCRE_EXTENDED, PCRE_ANCHORED, PCRE_DOLLAR_ENDONLY, + PCRE_EXTRA, 0, 0, PCRE_UNGREEDY, 0, PCRE_UTF8); + cRunOptions: array [TJclAnsiRegExOption] of Integer = + (0, 0, 0, 0, 0, 0, + 0, PCRE_NOTBOL, PCRE_NOTEOL, 0, PCRE_NOTEMPTY, 0); +var + I: TJclAnsiRegExOption; +begin + Result := 0; + if RunTime then + begin + for I := Low(TJclAnsiRegExOption) to High(TJclAnsiRegExOption) do + if I in Options then + Result := Result or cRunOptions[I]; + end + else + begin + for I := Low(TJclAnsiRegExOption) to High(TJclAnsiRegExOption) do + if I in Options then + Result := Result or cDesignOptions[I]; + end; +end; + +function TJclAnsiRegEx.GetCaptureCount: Integer; +begin + Result := FStringCount; + // PCRECheck(pcre_fullinfo(FCode, FExtra, PCRE_INFO_CAPTURECOUNT, @Result)); +end; + +function TJclAnsiRegEx.GetCaptures(Index: Integer): AnsiString; +var + Buffer: array [0..1024] of Char; +begin + PCRECheck(pcre_copy_substring(PChar(FSubject), @FVector, FStringCount, Index, Buffer, SizeOf(Buffer))); + Result := AnsiString(Buffer); +end; + +function TJclAnsiRegEx.GetCapturesOffset(Index: Integer): TJclAnsiCaptureOffset; +begin + if (Index < 0) or (Index >= FStringCount) then + begin + Result.FirstPos := -1; + Result.LastPos := -1; + end; + Result.FirstPos := FVector[Index * 2]; + Result.LastPos := FVector[Index * 2 + 1]; +end; + +function TJclAnsiRegEx.Match(const Subject: AnsiString; StartOffset: Cardinal = 1): Boolean; +begin + if (FCode = nil) or (Subject = '') then + begin + Result := False; + Exit; + end; + if StartOffset < 1 then + StartOffset := 1; + FSubject := Subject; + FStringCount := pcre_exec(FCode, FExtra, PChar(FSubject), Length(FSubject), + StartOffset - 1, GetAPIOptions(True), @FVector, FVectorSize); + Result := FStringCount > 0; +end; + +//=== { EPCREError } ========================================================= + +constructor EPCREError.CreateRes(ResStringRec: PResStringRec; ErrorCode: Integer); +begin + FErrorCode := ErrorCode; + inherited CreateRes(ResStringRec); +end; + +procedure LibNotLoadedHandler; cdecl; +begin + raise EPCREError.CreateRes(@RsErrLibNotLoaded, 0); +end; + +initialization + pcre.LibNotLoadedHandler := LibNotLoadedHandler; + LoadPCRE; + +finalization + UnloadPCRE; + +// History: + +// $Log: JclPCRE.pas,v $ +// Revision 1.9 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.8 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.7 2004/11/09 07:53:07 rrossmair +// - JclPCRE string extracted to JclResources +// +// Revision 1.6 2004/11/06 02:20:20 rrossmair +// - better handling of calls into DLL when it got not loaded. +// +// Revision 1.5 2004/07/28 18:00:51 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.4 2004/07/28 00:14:12 rrossmair +// fixed TJclAnsiRegEx.GetAPIOptions bug introduced in 1.3 +// +// Revision 1.3 2004/07/27 06:42:23 marquardt +// style cleaning of pcre files +// +// Revision 1.2 2004/07/26 05:13:52 rrossmair +// made it compile under Kylix (no functional tests performed yet) +// + +end. + diff --git a/official/1.96/source/common/JclQueues.pas b/official/1.96/source/common/JclQueues.pas new file mode 100644 index 0000000..950e48e --- /dev/null +++ b/official/1.96/source/common/JclQueues.pas @@ -0,0 +1,363 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:44 $ +// For history see end of file + +unit JclQueues; + +{$I jcl.inc} + +interface + +uses + JclBase, JclAbstractContainers, JclContainerIntf; + +type + TJclIntfQueue = class(TJclAbstractContainer, IJclIntfQueue) + private + FCapacity: Integer; + FElements: TDynIInterfaceArray; + FHead: Integer; + FTail: Integer; + protected + { IJclIntfQueue } + function Contains(AInterface: IInterface): Boolean; + function Dequeue: IInterface; + function Empty: Boolean; + procedure Enqueue(AInterface: IInterface); + function Size: Integer; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + end; + + TJclStrQueue = class(TJclAbstractContainer, IJclStrQueue) + private + FCapacity: Integer; + FElements: TDynStringArray; + FHead: Integer; + FTail: Integer; + protected + { IJclStrQueue } + function Contains(const AString: string): Boolean; + function Dequeue: string; + function Empty: Boolean; + procedure Enqueue(const AString: string); + function Size: Integer; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + end; + + TJclQueue = class(TJclAbstractContainer, IJclQueue) + private + FCapacity: Integer; + FElements: TDynObjectArray; + FHead: Integer; + FTail: Integer; + protected + { IJclQueue } + function Contains(AObject: TObject): Boolean; + function Dequeue: TObject; + function Empty: Boolean; + procedure Enqueue(AObject: TObject); + function Size: Integer; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + end; + +implementation + +uses + JclResources; + +//=== { TJclIntfQueue } ====================================================== + +constructor TJclIntfQueue.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FHead := 0; + FTail := 0; + if ACapacity < 1 then + {$IFDEF CLR} + raise EJclIllegalArgumentError.Create(RsEIllegalQueueCapacity); + {$ELSE} + raise EJclIllegalArgumentError.CreateRes(@RsEIllegalQueueCapacity); + {$ENDIF CLR} + FCapacity := ACapacity; + SetLength(FElements, FCapacity); +end; + +function TJclIntfQueue.Contains(AInterface: IInterface): Boolean; +var + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + I := FHead; + while I <> FTail do + begin + if FElements[I] = AInterface then + begin + Result := True; + Break; + end; + I := (I + 1) mod FCapacity; + end; +end; + +function TJclIntfQueue.Dequeue: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if FTail = FHead then + Exit; + Result := FElements[FHead]; + FElements[FHead] := nil; + FHead := (FHead + 1) mod FCapacity; +end; + +function TJclIntfQueue.Empty: Boolean; +begin + Result := FTail = FHead; +end; + +procedure TJclIntfQueue.Enqueue(AInterface: IInterface); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if AInterface = nil then + Exit; + FElements[FTail] := AInterface; + FTail := (FTail + 1) mod FCapacity; +end; + +function TJclIntfQueue.Size: Integer; +begin + Result := FTail - FHead; +end; + +//=== { TJclStrQueue } ======================================================= + +constructor TJclStrQueue.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FHead := 0; + FTail := 0; + if ACapacity < 1 then + {$IFDEF CLR} + raise EJclIllegalArgumentError.Create(RsEIllegalQueueCapacity); + {$ELSE} + raise EJclIllegalArgumentError.CreateRes(@RsEIllegalQueueCapacity); + {$ENDIF CLR} + FCapacity := ACapacity; + SetLength(FElements, FCapacity); +end; + +function TJclStrQueue.Contains(const AString: string): Boolean; +var + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + I := FHead; + while I <> FTail do + begin + if FElements[I] = AString then + begin + Result := True; + Break; + end; + I := (I + 1) mod FCapacity; + end; +end; + +function TJclStrQueue.Dequeue: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := ''; + if FTail = FHead then + Exit; + Result := FElements[FHead]; + FElements[FHead] := ''; + FHead := (FHead + 1) mod FCapacity; +end; + +function TJclStrQueue.Empty: Boolean; +begin + Result := FTail = FHead; +end; + +procedure TJclStrQueue.Enqueue(const AString: string); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if AString = '' then + Exit; + FElements[FTail] := AString; + FTail := (FTail + 1) mod FCapacity; +end; + +function TJclStrQueue.Size: Integer; +begin + Result := FTail - FHead; +end; + +//=== { TJclQueue } ========================================================== + +constructor TJclQueue.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + if ACapacity < 1 then + {$IFDEF CLR} + raise EJclIllegalArgumentError.Create(RsEIllegalQueueCapacity); + {$ELSE} + raise EJclIllegalArgumentError.CreateRes(@RsEIllegalQueueCapacity); + {$ENDIF CLR} + FCapacity := ACapacity; + SetLength(FElements, FCapacity); +end; + +function TJclQueue.Contains(AObject: TObject): Boolean; +var + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + I := FHead; + while I <> FTail do + begin + if FElements[I] = AObject then + begin + Result := True; + Break; + end; + I := (I + 1) mod FCapacity; + end; +end; + +function TJclQueue.Dequeue: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if FTail = FHead then + Exit; + Result := FElements[FHead]; + FElements[FHead] := nil; + FHead := (FHead + 1) mod FCapacity; +end; + +function TJclQueue.Empty: Boolean; +begin + Result := FTail = FHead; +end; + +procedure TJclQueue.Enqueue(AObject: TObject); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if AObject = nil then + Exit; + FElements[FTail] := AObject; + FTail := (FTail + 1) mod FCapacity; +end; + +function TJclQueue.Size: Integer; +begin + Result := FTail - FHead; +end; + +// History: + +// $Log: JclQueues.pas,v $ +// Revision 1.5 2005/05/05 20:08:44 ahuser +// JCL.NET support +// +// Revision 1.4 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.3 2005/02/27 11:36:20 marquardt +// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec +// +// Revision 1.2 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. diff --git a/official/1.96/source/common/JclRTTI.pas b/official/1.96/source/common/JclRTTI.pas new file mode 100644 index 0000000..8fd8e69 --- /dev/null +++ b/official/1.96/source/common/JclRTTI.pas @@ -0,0 +1,3082 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{ Unit owner: Marcel Bestebroer } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:44 $ +// For history see end of file + +unit JclRTTI; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNIT_TYPES} + Types, + {$IFDEF CLR} + System.Runtime.InteropServices, System.Reflection, System.ComponentModel, + Variants, + {$ELSE} + {$IFDEF SUPPORTS_INLINE} + Windows, + {$ENDIF SUPPORTS_INLINE} + {$ENDIF CLR} + {$ELSE} + Windows, + {$ENDIF HAS_UNIT_TYPES} + Classes, SysUtils, TypInfo, + 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 + function GetWrap: Integer; + procedure SetWrap(const Value: Integer); + 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; + procedure Indent; + procedure Outdent; + procedure Write(const S: string); + procedure Writeln(const S: string = ''); + + 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 + 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; + + // Ordinal types + IJclOrdinalTypeInfo = interface(IJclTypeInfo) + ['{7DAD5221-46EA-11D5-B0C0-4854E825F345}'] + 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; + + IJclEnumerationTypeInfo = interface(IJclOrdinalRangeTypeInfo) + ['{7DAD5223-46EA-11D5-B0C0-4854E825F345}'] + function GetBaseType: IJclEnumerationTypeInfo; + function GetNames(const I: Integer): string; + {$IFDEF RTL140_UP} + function GetUnitName: string; + {$ENDIF RTL140_UP} + + function IndexOfName(const Name: string): Integer; + + property BaseType: IJclEnumerationTypeInfo read GetBaseType; + property Names[const I: Integer]: string read GetNames; default; + {$IFDEF RTL140_UP} + property UnitName: string read GetUnitName; + {$ENDIF RTL140_UP} + end; + + IJclSetTypeInfo = interface(IJclOrdinalTypeInfo) + ['{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; + + // Float types + IJclFloatTypeInfo = interface(IJclTypeInfo) + ['{7DAD5225-46EA-11D5-B0C0-4854E825F345}'] + function GetFloatType: TFloatType; + + property FloatType: TFloatType read GetFloatType; + end; + + // Short string types + IJclStringTypeInfo = interface(IJclTypeInfo) + ['{7DAD5226-46EA-11D5-B0C0-4854E825F345}'] + 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 GetPropType: IJclTypeInfo; + function GetReader: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF}; + function GetWriter: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF}; + function GetStoredProc: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF}; + function GetIndex: Integer; + function GetDefault: Longint; + function GetNameIndex: Smallint; + function GetName: string; + function GetReaderType: TJclPropSpecKind; + function GetWriterType: TJclPropSpecKind; + function GetStoredType: TJclPropSpecKind; + function GetReaderValue: Integer; + function GetWriterValue: Integer; + function GetStoredValue: Integer; + + function IsStored(const AInstance: TObject): Boolean; + function HasDefault: Boolean; + function HasIndex: Boolean; + + property PropType: IJclTypeInfo read GetPropType; + property Reader: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF} read GetReader; + property Writer: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF} read GetWriter; + property StoredProc: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF} read GetStoredProc; + property ReaderType: TJclPropSpecKind read GetReaderType; + property WriterType: TJclPropSpecKind read GetWriterType; + property StoredType: TJclPropSpecKind read GetStoredType; + property ReaderValue: Integer read GetReaderValue; + property WriterValue: Integer read GetWriterValue; + property StoredValue: Integer read GetStoredValue; + property Index: Integer read GetIndex; + property Default: Longint read GetDefault; + property NameIndex: Smallint read GetNameIndex; + property Name: string read GetName; + end; + + IJclClassTypeInfo = interface(IJclTypeInfo) + ['{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; + + // Event types + IJclEventParamInfo = interface + ['{7DAD5229-46EA-11D5-B0C0-4854E825F345}'] + function GetFlags: TParamFlags; + function GetName: string; + {$IFNDEF CLR} + function GetRecSize: Integer; + {$ENDIF ~CLR} + function GetTypeName: string; + function GetParam: {$IFDEF CLR}ParameterInfo{$ELSE}Pointer{$ENDIF}; + + property Flags: TParamFlags read GetFlags; + property Name: string read GetName; + {$IFNDEF CLR} + property RecSize: Integer read GetRecSize; + {$ENDIF ~CLR} + property TypeName: string read GetTypeName; + property Param: {$IFDEF CLR}ParameterInfo{$ELSE}Pointer{$ENDIF} 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; + + // Interface types + IJclInterfaceTypeInfo = interface(IJclTypeInfo) + ['{7DAD522B-46EA-11D5-B0C0-4854E825F345}'] + function GetParent: IJclInterfaceTypeInfo; + function GetFlags: TIntfFlagsBase; + function GetGUID: TGUID; + {$IFDEF RTL140_UP} + function GetPropertyCount: Integer; + {$ENDIF RTL140_UP} + function GetUnitName: string; + + property Parent: IJclInterfaceTypeInfo read GetParent; + property Flags: TIntfFlagsBase read GetFlags; + property GUID: TGUID read GetGUID; + {$IFDEF RTL140_UP} + property PropertyCount: Integer read GetPropertyCount; + {$ENDIF RTL140_UP} + property UnitName: string read GetUnitName; + end; + + // Int64 types + IJclInt64TypeInfo = interface(IJclTypeInfo) + ['{7DAD522C-46EA-11D5-B0C0-4854E825F345}'] + function GetMinValue: Int64; + function GetMaxValue: Int64; + + property MinValue: Int64 read GetMinValue; + property MaxValue: Int64 read GetMaxValue; + end; + + {$IFDEF RTL140_UP} + // 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; + {$ENDIF RTL140_UP} + + 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; +{$IFNDEF CLR} +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; +{$ENDIF ~CLR} + +// 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; +{$IFNDEF CLR} +function JclGenerateSetType(BaseType: PTypeInfo; const TypeName: ShortString): PTypeInfo; +{$ENDIF ~CLR} + +{$IFNDEF CLR} +// User generated type info managment +procedure RemoveTypeInfo(TypeInfo: PTypeInfo); +{$ENDIF ~CLR} + +// Is/As hooking +function JclIsClass(const AnObj: TObject; const AClass: TClass): Boolean; +function JclIsClassByName(const AnObj: TObject; const AClass: TClass): Boolean; + +implementation + +uses + {$IFDEF HAS_UNIT_RTLCONSTS} + RtlConsts, + {$ENDIF HAS_UNIT_RTLCONSTS} + SysConst, + 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 +{$IFDEF CLR} + WrapChars: array[0..33] of Char = ( + #0, #1, #2, #3, #4, #5, #6, #7, #8, #9, #10, #11, #12, #13, #14, #15, + #16, #17, #18, #19, #20, #21, #22, #23, #24, #25, #26, #27, #28, #29, + #30, #31, #32, '-'); +{$ELSE} + WrapChars = [#0..' ', '-']; +{$ENDIF CLR} +var + TmpLines: TStringList; + I: Integer; + TmpLines2: TStringList; + EndedInCRLF: Boolean; + LineBreakLength: Integer; +begin + LineBreakLength := Length(AnsiLineBreak); + EndedInCRLF := Copy(CurLine, Length(CurLine) - LineBreakLength + 1, LineBreakLength) = AnsiLineBreak; + 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], + AnsiLineBreak + 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(AnsiLineBreak, 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 + AnsiLineBreak); +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 } ======================================================= + +type + TJclTypeInfo = class(TInterfacedObject, IJclTypeInfo) + private + FTypeData: PTypeData; + FTypeInfo: PTypeInfo; + protected + function GetName: string; + function GetTypeData: PTypeData; + function GetTypeInfo: PTypeInfo; + function GetTypeKind: TTypeKind; + procedure WriteTo(const Dest: IJclInfoWriter); virtual; + procedure DeclarationTo(const Dest: IJclInfoWriter); virtual; + public + constructor Create(ATypeInfo: PTypeInfo); + property Name: string read GetName; + property TypeData: PTypeData read GetTypeData; + property TypeInfo: PTypeInfo read GetTypeInfo; + property TypeKind: TTypeKind read GetTypeKind; + end; + +constructor TJclTypeInfo.Create(ATypeInfo: PTypeInfo); +begin + inherited Create; + FTypeInfo := ATypeInfo; + FTypeData := TypInfo.GetTypeData(ATypeInfo); +end; + +function TJclTypeInfo.GetName: string; +begin + Result := 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 + {$IFDEF CLR} + Dest.Writeln(RsRTTIName + Name); + Dest.Writeln(RsRTTITypeKind + JclEnumValueToIdent(Borland.Delphi.System.TypeInfo(TTypeKind), + TypeInfo.Kind)); + Dest.Writeln(Format(RsRTTITypeInfoAt, [TypeInfo])); + {$ELSE} + Dest.Writeln(LoadResString(@RsRTTIName) + Name); + Dest.Writeln(LoadResString(@RsRTTITypeKind) + JclEnumValueToIdent(System.TypeInfo(TTypeKind), + TypeInfo.Kind)); + Dest.Writeln(Format(LoadResString(@RsRTTITypeInfoAt), [TypeInfo])); + {$ENDIF CLR} +end; + +procedure TJclTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +begin + {$IFDEF CLR} + Dest.Write(Format(RsDeclarationFormat, [Name])); + {$ELSE} + Dest.Write(Format(LoadResString(@RsDeclarationFormat), [Name])); + {$ENDIF CLR} +end; + +//=== { TJclOrdinalTypeInfo } ================================================ + +type + TJclOrdinalTypeInfo = class(TJclTypeInfo, IJclOrdinalTypeInfo) + protected + function GetOrdinalType: TOrdType; + procedure WriteTo(const Dest: IJclInfoWriter); override; + public + property OrdinalType: TOrdType read GetOrdinalType; + end; + +function TJclOrdinalTypeInfo.GetOrdinalType: TOrdType; +begin + Result := TypeData.OrdType; +end; + +procedure TJclOrdinalTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + {$IFDEF CLR} + Dest.Writeln(RsRTTIOrdinalType + + JclEnumValueToIdent(Borland.Delphi.System.TypeInfo(TOrdType), TypeData.OrdType)); + {$ELSE} + Dest.Writeln(LoadResString(@RsRTTIOrdinalType) + + JclEnumValueToIdent(System.TypeInfo(TOrdType), TypeData.OrdType)); + {$ENDIF CLR} +end; + +//=== { TJclOrdinalRangeTypeInfo } =========================================== + +type + TJclOrdinalRangeTypeInfo = class(TJclOrdinalTypeInfo, IJclOrdinalRangeTypeInfo) + protected + function GetMinValue: Int64; + function GetMaxValue: Int64; + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + property MinValue: Int64 read GetMinValue; + property MaxValue: Int64 read GetMaxValue; + end; + +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); + {$IFDEF CLR} + Dest.Writeln(RsRTTIMinValue + IntToStr(MinValue)); + Dest.Writeln(RsRTTIMaxValue + IntToStr(MaxValue)); + {$ELSE} + Dest.Writeln(LoadResString(@RsRTTIMinValue) + IntToStr(MinValue)); + Dest.Writeln(LoadResString(@RsRTTIMaxValue) + IntToStr(MaxValue)); + {$ENDIF CLR} +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)); + {$IFDEF CLR} + Dest.Writeln('; // ' + JclEnumValueToIdent(Borland.Delphi.System.TypeInfo(TOrdType), TypeData.OrdType)); + {$ELSE} + Dest.Writeln('; // ' + JclEnumValueToIdent(System.TypeInfo(TOrdType), TypeData.OrdType)); + {$ENDIF CLR} +end; + +//=== { TJclEnumerationTypeInfo } ============================================ + +type + TJclEnumerationTypeInfo = class(TJclOrdinalRangeTypeInfo, IJclEnumerationTypeInfo) + protected + function GetBaseType: IJclEnumerationTypeInfo; + function GetNames(const I: Integer): string; + {$IFDEF RTL140_UP} + function GetUnitName: string; + {$ENDIF RTL140_UP} + function IndexOfName(const Name: string): Integer; + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + property BaseType: IJclEnumerationTypeInfo read GetBaseType; + property Names[const I: Integer]: string read GetNames; default; + {$IFDEF RTL140_UP} + property UnitName: string read GetUnitName; + {$ENDIF RTL140_UP} + end; + +function TJclEnumerationTypeInfo.GetBaseType: IJclEnumerationTypeInfo; +begin + {$IFDEF CLR} + if TypeData.ParentInfo = TypeInfo then + Result := Self + else + Result := TJclEnumerationTypeInfo.Create(TypeData.ParentInfo); + {$ELSE} + if TypeData.BaseType^ = TypeInfo then + Result := Self + else + Result := TJclEnumerationTypeInfo.Create(TypeData.BaseType^); + {$ENDIF CLR} +end; + +function TJclEnumerationTypeInfo.GetNames(const I: Integer): string; +var + Base: IJclEnumerationTypeInfo; + {$IFNDEF CLR} + Idx: Integer; + P: ^ShortString; + {$ENDIF ~CLR} +begin + Base := BaseType; + {$IFDEF CLR} + if (I >= 0) and (I < Length(Enum.GetNames(Base.TypeInfo))) then + Result := Enum.GetNames(Base.TypeInfo)[I] + else + Result := ''; + {$ELSE} + Idx := I; + P := @Base.TypeData.NameList; + while Idx <> 0 do + begin + Inc(Integer(P), Length(P^) + 1); + Dec(Idx); + end; + Result := P^; + {$ENDIF CLR} +end; + +{$IFDEF RTL140_UP} + +function TJclEnumerationTypeInfo.GetUnitName: string; +{$IFDEF CLR} +begin + Result := BaseType.TypeData.EnumUnitName; +end; +{$ELSE} +var + I: Integer; + P: ^ShortString; +begin + if BaseType.TypeInfo = TypeInfo then + begin + I := MaxValue - MinValue; + P := @TypeData.NameList; + while I >= 0 do + begin + Inc(Integer(P), Length(P^) + 1); + Dec(I); + end; + Result := P^; + end + else + Result := TypeData.NameList; +end; +{$ENDIF CLR} + +{$ENDIF RTL140_UP} + +function TJclEnumerationTypeInfo.IndexOfName(const Name: string): Integer; +begin + Result := MaxValue; + while (Result >= MinValue) and + {$IFDEF CLR} + not SameText(Name, Names[Result]) do + {$ELSE} + not AnsiSameText(Name, Names[Result]) do + {$ENDIF CLR} + Dec(Result); + if Result < MinValue then + Result := -1; +end; + +procedure TJclEnumerationTypeInfo.WriteTo(const Dest: IJclInfoWriter); +var + Idx: Integer; + Prefix: string; +begin + inherited WriteTo(Dest); + {$IFDEF CLR} + Dest.Writeln(RsRTTIUnitName + UnitName); + Dest.Write(RsRTTINameList); + {$ELSE} + {$IFDEF RTL140_UP} + Dest.Writeln(LoadResString(@RsRTTIUnitName) + UnitName); + {$ENDIF RTL140_UP} + Dest.Write(LoadResString(@RsRTTINameList)); + {$ENDIF CLR} + Prefix := '('; + for Idx := MinValue to MaxValue do + begin + Dest.Write(Prefix + Names[Idx]); + Prefix := ', '; + end; + Dest.Writeln(')'); +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 + {$IFDEF CLR} + Dest.Write('; // ' + JclEnumValueToIdent(Borland.Delphi.System.TypeInfo(TOrdType), TypeData.OrdType)); + {$ELSE} + Dest.Write('; // ' + JclEnumValueToIdent(System.TypeInfo(TOrdType), TypeData.OrdType)); + {$ENDIF CLR} + Dest.Writeln(''); + end; +end; + +//=== { TJclSetTypeInfo } ==================================================== + +type + TJclSetTypeInfo = class(TJclOrdinalTypeInfo, IJclSetTypeInfo) + protected + function GetBaseType: IJclOrdinalTypeInfo; + procedure GetAsList(const Value; const WantRanges: Boolean; + const Strings: TStrings); + procedure SetAsList(out Value; const Strings: TStrings); + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + property BaseType: IJclOrdinalTypeInfo read GetBaseType; + end; + +function TJclSetTypeInfo.GetBaseType: IJclOrdinalTypeInfo; +begin + {$IFDEF CLR} + Result := JclTypeInfo(TypeData.CompType) as IJclOrdinalTypeInfo; + {$ELSE} + Result := JclTypeInfo(TypeData.CompType^) as IJclOrdinalTypeInfo; + {$ENDIF CLR} +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); + {$IFDEF CLR} + // "set of" is a "array of Byte" + while ByteCount > 0 do + TDynByteArray(Value)[ByteCount - 1] := 0; + {$ELSE} + FillChar(Value, ByteCount, 0); + {$ENDIF CLR} + 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); + {$IFDEF CLR} + if FirstOrd = -1 then + raise EJclRTTIError.CreateFmt(RsRTTIUnknownIdentifier, [FirstIdent]); + if LastOrd = -1 then + raise EJclRTTIError.CreateFmt(RsRTTIUnknownIdentifier, [LastIdent]); + {$ELSE} + if FirstOrd = -1 then + raise EJclRTTIError.CreateResFmt(@RsRTTIUnknownIdentifier, [FirstIdent]); + if LastOrd = -1 then + raise EJclRTTIError.CreateResFmt(@RsRTTIUnknownIdentifier, [LastIdent]); + {$ENDIF CLR} + 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); + {$IFDEF CLR} + Dest.Writeln(RsRTTIBasedOn); + {$ELSE} + Dest.Writeln(LoadResString(@RsRTTIBasedOn)); + {$ENDIF CLR} + Dest.Indent; + try + BaseType.WriteTo(Dest); + finally + Dest.Outdent; + end; +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 + {$IFDEF CLR} + if Supports(Base, IJclEnumerationTypeInfo, BaseEnum) then + BaseEnum.DeclarationTo(Dest) + else + Dest.Write(RsRTTITypeError); + {$ELSE} + if Base.QueryInterface(IJclEnumerationTypeInfo, BaseEnum) = S_OK then + BaseEnum.DeclarationTo(Dest) + else + Dest.Write(LoadResString(@RsRTTITypeError)); + {$ENDIF CLR} + end + else + Dest.Write(Base.Name); + if Name[1] <> '.' then + begin + {$IFDEF CLR} + Dest.Write('; // ' + JclEnumValueToIdent(Borland.Delphi.System.TypeInfo(TOrdType), TypeData.OrdType)); + {$ELSE} + Dest.Write('; // ' + JclEnumValueToIdent(System.TypeInfo(TOrdType), TypeData.OrdType)); + {$ENDIF CLR} + Dest.Writeln(''); + end; +end; + +//=== { TJclFloatTypeInfo } ================================================== + +type + TJclFloatTypeInfo = class(TJclTypeInfo, IJclFloatTypeInfo) + protected + function GetFloatType: TFloatType; + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + property FloatType: TFloatType read GetFloatType; + end; + +function TJclFloatTypeInfo.GetFloatType: TFloatType; +begin + Result := TypeData.FloatType; +end; + +procedure TJclFloatTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + {$IFDEF CLR} + Dest.Writeln(RsRTTIFloatType + + JclEnumValueToIdent(Borland.Delphi.System.TypeInfo(TFloatType), TypeData.FloatType)); + {$ELSE} + Dest.Writeln(LoadResString(@RsRTTIFloatType) + + JclEnumValueToIdent(System.TypeInfo(TFloatType), TypeData.FloatType)); + {$ENDIF CLR} +end; + +procedure TJclFloatTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +var + S: string; + FT: TFloatType; +begin + FT := FloatType; + {$IFDEF CLR} + S := StrRestOf(JclEnumValueToIdent(Borland.Delphi.System.TypeInfo(TFloatType), FT), 3); + {$ELSE} + S := StrRestOf(JclEnumValueToIdent(System.TypeInfo(TFloatType), FT), 3); + {$ENDIF CLR} + Dest.Writeln(Name + ' = type ' + S + ';'); +end; + +//=== { TJclStringTypeInfo } ================================================= + +type + TJclStringTypeInfo = class(TJclTypeInfo, IJclStringTypeInfo) + protected + function GetMaxLength: Integer; + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + property MaxLength: Integer read GetMaxLength; + end; + +function TJclStringTypeInfo.GetMaxLength: Integer; +begin + Result := TypeData.MaxLength; +end; + +procedure TJclStringTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + {$IFDEF CLR} + Dest.Writeln(RsRTTIMaxLen + IntToStr(MaxLength)); + {$ELSE} + Dest.Writeln(LoadResString(@RsRTTIMaxLen) + IntToStr(MaxLength)); + {$ENDIF CLR} +end; + +procedure TJclStringTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +begin + if Name[1] <> '.' then + Dest.Write(Name + ' = '); + Dest.Write('string[' + IntToStr(MaxLength) + ']'); + if Name[1] <> '.' then + Dest.Writeln(';'); +end; + +//=== { TJclPropInfo } ======================================================= + +type + TJclPropInfo = class(TInterfacedObject, IJclPropInfo) + private + FPropInfo: PPropInfo; + protected + function GetPropInfo: PPropInfo; + function GetPropType: IJclTypeInfo; + function GetReader: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF}; + function GetWriter: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF}; + function GetStoredProc: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF}; + function GetIndex: Integer; + function GetDefault: Longint; + function GetNameIndex: Smallint; + function GetName: string; + {$IFDEF CLR} + function MethodInfoToPropSecpKind(Info: MethodInfo): TJclPropSpecKind; + {$ENDIF CLR} + function GetSpecKind(const Value: Integer): TJclPropSpecKind; + function GetSpecValue(const Value: Integer): Integer; + function GetReaderType: TJclPropSpecKind; + function GetWriterType: TJclPropSpecKind; + function GetStoredType: TJclPropSpecKind; + function GetReaderValue: Integer; + function GetWriterValue: Integer; + function GetStoredValue: Integer; + public + constructor Create(const APropInfo: PPropInfo); + function IsStored(const AInstance: TObject): Boolean; + function HasDefault: Boolean; + function HasIndex: Boolean; + + property PropInfo: PPropInfo read GetPropInfo; + property PropType: IJclTypeInfo read GetPropType; + property Reader: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF} read GetReader; + property Writer: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF} read GetWriter; + property StoredProc: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF} read GetStoredProc; + property ReaderType: TJclPropSpecKind read GetReaderType; + property WriterType: TJclPropSpecKind read GetWriterType; + property StoredType: TJclPropSpecKind read GetStoredType; + property ReaderValue: Integer read GetReaderValue; + property WriterValue: Integer read GetWriterValue; + property StoredValue: Integer read GetStoredValue; + property Index: Integer read GetIndex; + property Default: Longint read GetDefault; + property NameIndex: Smallint read GetNameIndex; + property Name: string read GetName; + end; + +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 + {$IFDEF CLR} + Result := JclTypeInfo(PropInfo.PropType); + {$ELSE} + Result := JclTypeInfo(PropInfo.PropType^); + {$ENDIF CLR} +end; + +function TJclPropInfo.GetReader: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF}; +begin + {$IFDEF CLR} + Result := (PropInfo as PropertyInfo).GetGetMethod; + {$ELSE} + Result := PropInfo.GetProc; + {$ENDIF CLR} +end; + +function TJclPropInfo.GetWriter: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF}; +begin + {$IFDEF CLR} + Result := (PropInfo as PropertyInfo).GetSetMethod; + {$ELSE} + Result := PropInfo.SetProc; + {$ENDIF CLR} +end; + +function TJclPropInfo.GetStoredProc: {$IFDEF CLR}MethodInfo{$ELSE}Pointer{$ENDIF}; +{$IFDEF CLR} +var + I: Integer; + Accessors: array of MethodInfo; + Attributes: array of Attribute; +begin + Result := nil; + Attributes := Attribute.GetCustomAttributes(PropInfo, True); + + // .NET serializing system: NonSerializedAttribute + for I := 0 to Length(Attributes) - 1 do + if Attributes[I] is NonSerializedAttribute then + Exit; + + // .NET form designer storage: DesignerSerializationVisibilityAttribute + for I := 0 to Length(Attributes) - 1 do + if Attributes[I] is DesignerSerializationVisibilityAttribute then + Exit; + + if PropInfo is PropertyInfo then + begin + Accessors := PropertyInfo(PropInfo).GetAccessors; + for I := 0 to High(Accessors) do + begin + if Accessors[I].ReturnType.Equals(TypeOf(System.Boolean)) and + Accessors[I].Name.StartsWith('stored_') then + begin + Result := Accessors[I]; + Break; + end; + end; + end; +end; +{$ELSE} +begin + Result := PropInfo.StoredProc; +end; +{$ENDIF CLR} + +function TJclPropInfo.GetIndex: Integer; +begin + {$IFDEF CLR} + Result := Integer($8000000); + {$ELSE} + Result := PropInfo.Index; + {$ENDIF CLR} +end; + +function TJclPropInfo.GetDefault: Longint; +begin + {$IFDEF CLR} + Result := GetOrdPropDefault(PropInfo); + {$ELSE} + Result := PropInfo.Default; + {$ENDIF CLR} +end; + +function TJclPropInfo.GetNameIndex: Smallint; +begin + {$IFDEF CLR} + Result := 0; + {$ELSE} + Result := PropInfo.NameIndex; + {$ENDIF CLR} +end; + +function TJclPropInfo.GetName: string; +begin + Result := PropInfo.Name; +end; + +{$IFDEF CLR} +function TJclPropInfo.MethodInfoToPropSecpKind(Info: MethodInfo): TJclPropSpecKind; +begin + if Info.IsStatic then + Result := pskStaticMethod + else + if Info.IsVirtual then + Result := pskVirtualMethod + else + Result := pskNone; +end; +{$ENDIF CLR} + +function TJclPropInfo.GetSpecKind(const Value: Integer): TJclPropSpecKind; +var + P: Integer; +begin + P := Value shr 24; + 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: Integer): Integer; +begin + case GetSpecKind(Value) of + pskStaticMethod, pskConstant: + Result := Value; + pskVirtualMethod: + Result := Smallint(Value and $0000FFFF); + pskField: + Result := Value and $00FFFFFF; + else + Result := 0; + end; +end; + +function TJclPropInfo.GetReaderType: TJclPropSpecKind; +begin + {$IFDEF CLR} + Result := MethodInfoToPropSecpKind(Reader); + {$ELSE} + Result := GetSpecKind(Integer(Reader)); + {$ENDIF CLR} +end; + +function TJclPropInfo.GetWriterType: TJclPropSpecKind; +begin + {$IFDEF CLR} + Result := MethodInfoToPropSecpKind(Writer); + {$ELSE} + Result := GetSpecKind(Integer(Writer)); + {$ENDIF CLR} +end; + +function TJclPropInfo.GetStoredType: TJclPropSpecKind; +begin + {$IFDEF CLR} + Result := MethodInfoToPropSecpKind(StoredProc); + {$ELSE} + Result := GetSpecKind(Integer(StoredProc)); + {$ENDIF CLR} +end; + +function TJclPropInfo.GetReaderValue: Integer; +begin + {$IFDEF CLR} + Result := 0; + {$ELSE} + Result := GetSpecValue(Integer(Reader)); + {$ENDIF CLR} +end; + +function TJclPropInfo.GetWriterValue: Integer; +begin + {$IFDEF CLR} + Result := 0; + {$ELSE} + Result := GetSpecValue(Integer(Writer)); + {$ENDIF CLR} +end; + +function TJclPropInfo.GetStoredValue: Integer; +begin + {$IFDEF CLR} + Result := 0; + {$ELSE} + Result := GetSpecValue(Integer(StoredProc)); + {$ENDIF CLR} +end; + +function TJclPropInfo.IsStored(const AInstance: TObject): Boolean; +begin + Result := IsStoredProp(AInstance, FPropInfo); +end; + +function TJclPropInfo.HasDefault: Boolean; +begin + Result := Longword(Default) <> $80000000; +end; + +function TJclPropInfo.HasIndex: Boolean; +begin + Result := Longword(Index) <> $80000000; +end; + +//=== { TJclClassTypeInfo } ================================================== + +type + TJclClassTypeInfo = class(TJclTypeInfo, IJclClassTypeInfo) + protected + 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; + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + 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; + +function TJclClassTypeInfo.GetClassRef: TClass; +begin + Result := TypeData.ClassType; +end; + +function TJclClassTypeInfo.GetParent: IJclClassTypeInfo; +begin + {$IFDEF CLR} + if (TypeData.ParentInfo <> nil) then + Result := JclTypeInfo(TypeData.ParentInfo) as IJclClassTypeInfo + {$ELSE} + if (TypeData.ParentInfo <> nil) and (TypeData.ParentInfo^ <> nil) then + Result := JclTypeInfo(TypeData.ParentInfo^) as IJclClassTypeInfo + {$ENDIF CLR} + else + Result := nil; +end; + +function TJclClassTypeInfo.GetTotalPropertyCount: Integer; +begin + Result := TypeData.PropCount; +end; + +function TJclClassTypeInfo.GetPropertyCount: Integer; +{$IFDEF CLR} +begin + Result := TypeData.PropCount; +end; +{$ELSE} +var + PropData: ^TPropData; +begin + PropData := @TypeData.UnitName; + Inc(Integer(PropData), 1 + Length(UnitName)); + Result := PropData.PropCount; +end; +{$ENDIF CLR} + +function TJclClassTypeInfo.GetProperties(const PropIdx: Integer): IJclPropInfo; +{$IFDEF CLR} +var + List: TPropList; +begin + if PropIdx + 1 > TypeData.PropCount then + Result := Parent.Properties[PropIdx - TypeData.PropCount] + else + begin + List := GetPropInfos(TypeInfo); + if PropIdx > 0 then + Result := TJclPropInfo.Create(List[PropIdx]) + else + Result := TJclPropInfo.Create(List[0]); + end; +end; +{$ELSE} +var + PropData: ^TPropData; + Prop: PPropInfo; + Idx: Integer; + RecSize: Integer; +begin + PropData := @TypeData.UnitName; + Inc(Integer(PropData), 1 + Length(UnitName)); + if PropIdx + 1 > PropData.PropCount then + Result := Parent.Properties[PropIdx - PropData.PropCount] + else + begin + Prop := PPropInfo(PropData); + Inc(Integer(Prop), 2); + if PropIdx > 0 then + begin + RecSize := SizeOf(TPropInfo) - SizeOf(ShortString); + Idx := PropIdx; + while Idx > 0 do + begin + Inc(Integer(Prop), RecSize); + Inc(Integer(Prop), 1 + PByte(Prop)^); + Dec(Idx); + end; + end; + Result := TJclPropInfo.Create(Prop); + end; +end; +{$ENDIF CLR} + +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 := TypeData.UnitName; +end; + +procedure TJclClassTypeInfo.WriteTo(const Dest: IJclInfoWriter); +const +{$IFDEF CLR} + cFmt1 = '[%s %d]'; + cFmt2 = '[%s %s %s]'; + cFmt3 = '[%s=%s]'; + cFmt4 = '[%s=%s %s]'; +{$ELSE} + cFmt1 = '[%s %d]'; + cFmt2 = '[%s %s $%p]'; + cFmt3 = '[%s=%s]'; + cFmt4 = '[%s=%s $%p]'; +{$ENDIF CLR} +var + I: Integer; + Prop: IJclPropInfo; +begin + inherited WriteTo(Dest); + Dest.Writeln(RsRTTIClassName + ClassRef.ClassName); + Dest.Writeln(RsRTTIParent + Parent.ClassRef.ClassName); + Dest.Writeln(RsRTTIUnitName + UnitName); + Dest.Writeln(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, [RsRTTIIndex, Prop.Index])); + if Prop.HasDefault then + Dest.Writeln(Format(cFmt1, [RsRTTIDefault, Prop.Default])); + case Prop.ReaderType of + pskStaticMethod: + Dest.Writeln(Format(cFmt2, [RsRTTIPropRead, RsRTTIStaticMethod, + {$IFDEF CLR} + Prop.Reader.ToString()])); + {$ELSE} + Pointer(Prop.ReaderValue)])); + {$ENDIF CLR} + pskField: + Dest.Writeln(Format(cFmt2, [RsRTTIPropRead, RsRTTIField, + {$IFDEF CLR} + Prop.Reader.ToString()])); + {$ELSE} + Pointer(Prop.ReaderValue)])); + {$ENDIF CLR} + pskVirtualMethod: + Dest.Writeln(Format(cFmt2, [RsRTTIPropRead, RsRTTIVirtualMethod, + {$IFDEF CLR} + Prop.Reader.ToString()])); + {$ELSE} + Pointer(Prop.ReaderValue)])); + {$ENDIF CLR} + end; + case Prop.WriterType of + pskStaticMethod: + Dest.Writeln(Format(cFmt2, [RsRTTIPropWrite, RsRTTIStaticMethod, + {$IFDEF CLR} + Prop.Writer.ToString()])); + {$ELSE} + Pointer(Prop.WriterValue)])); + {$ENDIF CLR} + pskField: + Dest.Writeln(Format(cFmt2, [RsRTTIPropWrite, RsRTTIField, + {$IFDEF CLR} + Prop.Writer.ToString()])); + {$ELSE} + Pointer(Prop.WriterValue)])); + {$ENDIF CLR} + pskVirtualMethod: + Dest.Writeln(Format(cFmt2, [RsRTTIPropWrite, RsRTTIVirtualMethod, + {$IFDEF CLR} + Prop.Writer.ToString()])); + {$ELSE} + Pointer(Prop.WriterValue)])); + {$ENDIF CLR} + end; + case Prop.StoredType of + pskConstant: + if Boolean(Prop.StoredValue) then + Dest.Writeln(Format(cFmt3, [RsRTTIPropStored, RsRTTITrue])) + else + Dest.Writeln(Format(cFmt3, [RsRTTIPropStored, RsRTTIFalse])); + pskStaticMethod: + Dest.Writeln(Format(cFmt4, [RsRTTIPropStored, RsRTTIStaticMethod, + {$IFDEF CLR} + Prop.StoredProc.ToString()])); + {$ELSE} + Pointer(Prop.StoredValue)])); + {$ENDIF CLR} + pskField: + Dest.Writeln(Format(cFmt4, [RsRTTIPropStored, RsRTTIField, + {$IFDEF CLR} + Prop.StoredProc.ToString()])); + {$ELSE} + Pointer(Prop.StoredValue)])); + {$ENDIF CLR} + pskVirtualMethod: + Dest.Writeln(Format(cFmt4, [RsRTTIPropStored, RsRTTIVirtualMethod, + {$IFDEF CLR} + Prop.StoredProc.ToString()])); + {$ELSE} + Pointer(Prop.StoredValue)])); + {$ENDIF CLR} + end; + finally + Dest.Outdent; + end; + end; + finally + Dest.Outdent; + end; +end; + +procedure TJclClassTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +var + {$IFDEF CLR} + IntfTbl: array of &Type; + {$ELSE} + IntfTbl: PInterfaceTable; + {$ENDIF CLR} + I: Integer; + Prop: IJclPropInfo; +begin + if (Parent <> nil) and + {$IFDEF CLR} + not SameText(Parent.Name, 'TObject') then + {$ELSE} + not AnsiSameText(Parent.Name, 'TObject') then + {$ENDIF CLR} + begin + Dest.Write(Name + ' = class(' + Parent.Name); + {$IFDEF CLR} + IntfTbl := ClassRef.ClassInfo.GetInterfaces; + if IntfTbl <> nil then + for I := 0 to High(IntfTbl) do + Dest.Write(', [''' + JclGUIDToString(IntfTbl[I].TypeData.Guid) + ''']'); + {$ELSE} + IntfTbl := ClassRef.GetInterfaceTable; + if IntfTbl <> nil then + for I := 0 to IntfTbl.EntryCount-1 do + Dest.Write(', [''' + JclGUIDToString(IntfTbl.Entries[I].IID) + ''']'); + {$ENDIF CLR} + Dest.Writeln(') // unit ' + UnitName); + end + else + Dest.Writeln(Name + ' = class // unit ' + UnitName); + 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 + {$IFDEF CLR} + pskStaticMethod: + Dest.Write(Format(' read [static method %s]', [Prop.Reader.ToString()])); + pskField: + Dest.Write(Format(' read [field %s]', [Prop.Reader.ToString()])); + pskVirtualMethod: + Dest.Write(Format(' read [virtual method %s]', [Prop.Reader.ToString()])); + {$ELSE} + 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)])); + {$ENDIF CLR} + end; + + case Prop.WriterType of + {$IFDEF CLR} + pskStaticMethod: + Dest.Write(Format(' write [static method %s]', [Prop.Writer.ToString()])); + pskField: + Dest.Write(Format(' write [field %s]', [Prop.Writer.ToString()])); + pskVirtualMethod: + Dest.Write(Format(' write [virtual method %s]', [Prop.Writer.ToString()])); + {$ELSE} + 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)])); + {$ENDIF CLR} + end; + + case Prop.StoredType of + pskConstant: + if Boolean(Prop.StoredValue) then + Dest.Write(' stored = True') + else + Dest.Write(' stored = False'); + {$IFDEF CLR} + pskStaticMethod: + Dest.Write(Format(' stored = [static method %s]', [Prop.StoredProc.ToString()])); + pskField: + Dest.Write(Format(' stored = [field %s]', [Prop.StoredProc.ToString()])); + pskVirtualMethod: + Dest.Write(Format(' stored = [virtual method %s]', [Prop.StoredProc.ToString()])); + {$ELSE} + 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)])); + {$ENDIF CLR} + end; + if Prop.HasDefault then + Dest.Write(' default ' + IntToStr(Prop.Default)); + Dest.Writeln(';'); + end; + finally + Dest.Outdent; + end; + end; + Dest.Writeln('end;'); +end; + +//=== { TJclEventParamInfo } ================================================= + +type + TJclEventParamInfo = class(TInterfacedObject, IJclEventParamInfo) + private + FParam: {$IFDEF CLR}ParameterInfo{$ELSE}Pointer{$ENDIF}; + protected + function GetFlags: TParamFlags; + function GetName: string; + function GetRecSize: Integer; + function GetTypeName: string; + function GetParam: {$IFDEF CLR}ParameterInfo{$ELSE}Pointer{$ENDIF}; + public + constructor Create(const AParam: {$IFDEF CLR}ParameterInfo{$ELSE}Pointer{$ENDIF}); + + property Flags: TParamFlags read GetFlags; + property Name: string read GetName; + property RecSize: Integer read GetRecSize; + property TypeName: string read GetTypeName; + property Param: {$IFDEF CLR}ParameterInfo{$ELSE}Pointer{$ENDIF} read GetParam; + end; + +constructor TJclEventParamInfo.Create(const AParam: {$IFDEF CLR}ParameterInfo{$ELSE}Pointer{$ENDIF}); +begin + inherited Create; + FParam := AParam; +end; + +function TJclEventParamInfo.GetFlags: TParamFlags; +{$IFDEF CLR} +var + Attr: Attribute; +{$ENDIF CLR} +begin + {$IFDEF CLR} + Result := []; + if FParam.IsOut then + Result := [pfOut] + else + if FParam.ParameterType.IsByRef then + Result := [pfVar] + else + if FindAttribute(FParam.ParameterType, TypeOf(TConstantParamAttribute), Attr) then + Result := [pfConst]; + + with FParam.ParameterType do + if IsArray or (IsByRef and HasElementType and GetElementType.IsArray) then + Include(Result, pfArray); + {$ELSE} + Result := TParamFlags(PByte(Param)^); + {$ENDIF CLR} +end; + +function TJclEventParamInfo.GetName: string; +{$IFDEF CLR} +begin + Result := FParam.Name; +end; +{$ELSE} +var + PName: PShortString; +begin + PName := Param; + Inc(Integer(PName)); + Result := PName^; +end; +{$ENDIF CLR} + +function TJclEventParamInfo.GetRecSize: Integer; +begin + Result := 3 + Length(Name) + Length(TypeName); +end; + +function TJclEventParamInfo.GetTypeName: string; +{$IFDEF CLR} +begin + Result := FParam.ParameterType.Name; +end; +{$ELSE} +var + PName: PShortString; +begin + PName := Param; + Inc(Integer(PName)); + Inc(Integer(PName), PByte(PName)^ + 1); + Result := PName^; +end; +{$ENDIF CLR} + +function TJclEventParamInfo.GetParam: {$IFDEF CLR}ParameterInfo{$ELSE}Pointer{$ENDIF}; +begin + Result := FParam; +end; + +//=== { TJclEventTypeInfo } ================================================== + +type + TJclEventTypeInfo = class(TJclTypeInfo, IJclEventTypeInfo) + protected + function GetMethodKind: TMethodKind; + function GetParameterCount: Integer; + function GetParameters(const ParamIdx: Integer): IJclEventParamInfo; + function GetResultTypeName: string; + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + property MethodKind: TMethodKind read GetMethodKind; + property ParameterCount: Integer read GetParameterCount; + property Parameters[const ParamIdx: Integer]: IJclEventParamInfo + read GetParameters; + property ResultTypeName: string read GetResultTypeName; + end; + +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; +{$IFNDEF CLR} +var + I: Integer; + Param: Pointer; +{$ENDIF ~CLR} +begin + Result := nil; + {$IFDEF CLR} + if ParamIdx < TypeData.ParamCount then + Result := TJclEventParamInfo.Create(TypeData.Params[ParamIdx]); + {$ELSE} + Param := @TypeData.ParamList[0]; + I := ParamIdx; + while I >= 0 do + begin + Result := TJclEventParamInfo.Create(Param); + Inc(Integer(Param), Result.RecSize); + Dec(I); + end; + {$ENDIF CLR} +end; + +function TJclEventTypeInfo.GetResultTypeName: string; +{$IFDEF CLR} +begin + Result := TypeData.ResultTypeName; +end; +{$ELSE} +var + LastParam: IJclEventParamInfo; + ResPtr: PShortString; +begin + if MethodKind = mkFunction then + begin + if ParameterCount > 0 then + begin + LastParam := Parameters[ParameterCount-1]; + ResPtr := Pointer(Longint(LastParam.Param) + LastParam.RecSize); + end + else + ResPtr := @TypeData.ParamList[0]; + Result := ResPtr^; + end + else + Result := ''; +end; +{$ENDIF CLR} + +procedure TJclEventTypeInfo.WriteTo(const Dest: IJclInfoWriter); +var + I: Integer; + Param: IJclEventParamInfo; + ParamFlags: TParamFlags; +begin + inherited WriteTo(Dest); + {$IFDEF CLR} + Dest.Writeln(RsRTTIMethodKind + + JclEnumValueToIdent(Borland.Delphi.System.TypeInfo(TMethodKind), TypeData.MethodKind)); + Dest.Writeln(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(RsRTTIName + Param.Name); + Dest.Writeln(RsRTTIType + Param.TypeName); + Dest.Writeln(RsRTTIFlags + + JclSetToStr(Borland.Delphi.System.TypeInfo(TParamFlags), ParamFlags, True, False)); + end; + finally + Dest.Outdent; + end; + if MethodKind = mkFunction then + Dest.Writeln(RsRTTIReturnType + ResultTypeName); + {$ELSE} + 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); + {$ENDIF CLR} +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]; + {$IFDEF CLR} + if pfVar in Param.Flags then + Dest.Write(RsRTTIVar) + else + if pfConst in Param.Flags then + Dest.Write(RsRTTIConst) + else + if pfOut in Param.Flags then + Dest.Write(RsRTTIOut); + {$ELSE} + 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)); + {$ENDIF CLR} + Dest.Write(Param.Name); + if Param.TypeName <> '' then + begin + Dest.Write(': '); + {$IFDEF CLR} + if pfArray in Param.Flags then + Dest.Write(RsRTTIArrayOf); + if AnsiSameText(Param.TypeName, 'TVarRec') and (pfArray in Param.Flags) then + Dest.Write(TrimRight(RsRTTIConst)) + {$ELSE} + 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))) + {$ENDIF CLR} + 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 } ============================================== + +type + TJclInterfaceTypeInfo = class(TJclTypeInfo, IJclInterfaceTypeInfo) + protected + function GetParent: IJclInterfaceTypeInfo; + function GetFlags: TIntfFlagsBase; + function GetGUID: TGUID; + {$IFDEF RTL140_UP} + function GetPropertyCount: Integer; + {$ENDIF RTL140_UP} + function GetUnitName: string; + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + property Parent: IJclInterfaceTypeInfo read GetParent; + property Flags: TIntfFlagsBase read GetFlags; + property GUID: TGUID read GetGUID; + {$IFDEF RTL140_UP} + property PropertyCount: Integer read GetPropertyCount; + {$ENDIF RTL140_UP} + property UnitName: string read GetUnitName; + end; + +function TJclInterfaceTypeInfo.GetParent: IJclInterfaceTypeInfo; +begin + {$IFDEF CLR} + if TypeInfo.BaseType <> nil then + Result := JclTypeInfo(TypeInfo.BaseType) as IJclInterfaceTypeInfo + {$ELSE} + if (TypeData.IntfParent <> nil) and (TypeData.IntfParent^ <> nil) then + Result := JclTypeInfo(TypeData.IntfParent^) as IJclInterfaceTypeInfo + {$ENDIF CLR} + else + Result := nil; +end; + +function TJclInterfaceTypeInfo.GetFlags: TIntfFlagsBase; +begin + {$IFDEF CLR} + Result := []; + {$ELSE} + Result := TypeData.IntfFlags; + {$ENDIF CLR} +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; + +{$IFDEF RTL140_UP} +function TJclInterfaceTypeInfo.GetPropertyCount: Integer; +{$IFDEF CLR} +begin + Result := TypeData.PropCount; +end; +{$ELSE} +var + PropData: ^TPropData; +begin + PropData := @TypeData.IntfUnit; + Inc(Integer(PropData), 1 + Length(UnitName)); + Result := PropData.PropCount; +end; +{$ENDIF CLR} +{$ENDIF RTL140_UP} + +function TJclInterfaceTypeInfo.GetUnitName: string; +begin + Result := TypeData.IntfUnit; +end; + +procedure TJclInterfaceTypeInfo.WriteTo(const Dest: IJclInfoWriter); +var + IntfFlags: TIntfFlagsBase; +begin + inherited WriteTo(Dest); + if ifHasGuid in Flags then + {$IFDEF CLR} + Dest.Writeln(RsRTTIGUID + JclGuidToString(GUID)); + IntfFlags := Flags; + Dest.Writeln(RsRTTIFlags + JclSetToStr(Borland.Delphi.System.TypeInfo(TIntfFlagsBase), + IntfFlags, True, False)); + Dest.Writeln(RsRTTIUnitName + UnitName); + if Parent <> nil then + Dest.Writeln(RsRTTIParent + Parent.Name); + Dest.Writeln(RsRTTIPropCount + IntToStr(PropertyCount)); + {$ELSE} + Dest.Writeln(LoadResString(@RsRTTIGUID) + JclGuidToString(GUID)); + IntfFlags := Flags; + Dest.Writeln(LoadResString(@RsRTTIFlags) + JclSetToStr(System.TypeInfo(TIntfFlagsBase), + IntfFlags, True, False)); + Dest.Writeln(LoadResString(@RsRTTIUnitName) + UnitName); + if Parent <> nil then + Dest.Writeln(LoadResString(@RsRTTIParent) + Parent.Name); + {$IFDEF RTL140_UP} + Dest.Writeln(LoadResString(@RsRTTIPropCount) + IntToStr(PropertyCount)); + {$ENDIF RTL140_UP} + {$ENDIF CLR} +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 ' + UnitName); + Dest.Indent; + try + if ifHasGuid in Flags then + Dest.Writeln('[''' + JclGuidToString(GUID) + ''']'); + finally + Dest.Outdent; + Dest.Writeln('end;'); + end; +end; + +//=== { TJclInt64TypeInfo } ================================================== + +type + TJclInt64TypeInfo = class(TJclTypeInfo, IJclInt64TypeInfo) + protected + function GetMinValue: Int64; + function GetMaxValue: Int64; + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + property MinValue: Int64 read GetMinValue; + property MaxValue: Int64 read GetMaxValue; + end; + +function TJclInt64TypeInfo.GetMinValue: Int64; +begin + Result := TypeData.MinInt64Value; +end; + +function TJclInt64TypeInfo.GetMaxValue: Int64; +begin + Result := TypeData.MaxInt64Value; +end; + +procedure TJclInt64TypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + {$IFDEF CLR} + Dest.Writeln(RsRTTIMinValue + IntToStr(MinValue)); + Dest.Writeln(RsRTTIMaxValue + IntToStr(MaxValue)); + {$ELSE} + Dest.Writeln(LoadResString(@RsRTTIMinValue) + IntToStr(MinValue)); + Dest.Writeln(LoadResString(@RsRTTIMaxValue) + IntToStr(MaxValue)); + {$ENDIF CLR} +end; + +procedure TJclInt64TypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +begin + Dest.Writeln(Name + ' = ' + IntToStr(MinValue) + ' .. ' + IntToStr(MaxValue) + ';'); +end; + +//=== { TJclDynArrayTypeInfo } =============================================== + +{$IFDEF RTL140_UP} + +type + TJclDynArrayTypeInfo = class(TJclTypeInfo, IJclDynArrayTypeInfo) + protected + function GetElementSize: Longint; + function GetElementType: IJclTypeInfo; + function GetElementsNeedCleanup: Boolean; + function GetVarType: Integer; + function GetUnitName: string; + procedure WriteTo(const Dest: IJclInfoWriter); override; + procedure DeclarationTo(const Dest: IJclInfoWriter); override; + public + 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; + +function TJclDynArrayTypeInfo.GetElementSize: Longint; +begin + {$IFDEF CLR} + Result := Marshal.SizeOf(TypeInfo.GetElementType); + {$ELSE} + Result := TypeData.elSize; + {$ENDIF CLR} +end; + +function TJclDynArrayTypeInfo.GetElementType: IJclTypeInfo; +begin + {$IFDEF CLR} + Result := JclTypeInfo(TypeInfo.GetElementType); + {$ELSE} + if TypeData.elType = nil then + begin + if TypeData.elType2 <> nil then + Result := JclTypeInfo(TypeData.elType2^) + else + Result := nil; + end + else + Result := JclTypeInfo(TypeData.elType^); + {$ENDIF CLR} +end; + +function TJclDynArrayTypeInfo.GetElementsNeedCleanup: Boolean; +begin + {$IFDEF CLR} + Result := False; + {$ELSE} + Result := TypeData.elType <> nil; + {$ENDIF CLR} +end; + +function TJclDynArrayTypeInfo.GetVarType: Integer; +begin + {$IFDEF CLR} + Result := Variant.VarType(TypeInfo); + {$ELSE} + Result := TypeData.varType; + {$ENDIF CLR} +end; + +function TJclDynArrayTypeInfo.GetUnitName: string; +begin + Result := TypeData.DynUnitName; +end; + +procedure TJclDynArrayTypeInfo.WriteTo(const Dest: IJclInfoWriter); +begin + inherited WriteTo(Dest); + Dest.Writeln(RsRTTIElSize + IntToStr(ElementSize)); + if ElementType = nil then + Dest.Writeln(RsRTTIElType + RsRTTITypeError) + else + if ElementType.Name[1] <> '.' then + Dest.Writeln(RsRTTIElType + ElementType.Name) + else + begin + Dest.Writeln(RsRTTIElType); + Dest.Indent; + try + ElementType.WriteTo(Dest); + finally + Dest.Outdent; + end; + end; + Dest.Write(RsRTTIElNeedCleanup); + if ElementsNeedCleanup then + Dest.Writeln(RsRTTITrue) + else + Dest.Writeln(RsRTTIFalse); + Dest.Writeln(RsRTTIVarType + IntToStr(VarType)); + Dest.Writeln(RsRTTIUnitName + UnitName); +end; + +procedure TJclDynArrayTypeInfo.DeclarationTo(const Dest: IJclInfoWriter); +begin + if Name[1] <> '.' then + Dest.Write(Name + ' = ' + RsRTTIArrayOf) + else + Dest.Write(RsRTTIArrayOf); + if ElementType = nil then + Dest.Write(RsRTTITypeError) + else + if ElementType.Name[1] = '.' then + ElementType.DeclarationTo(Dest) + else + Dest.Write(ElementType.Name); + if Name[1] <> '.' then + Dest.Writeln('; // Unit ' + UnitName); +end; + +{$ENDIF RTL140_UP} + +//=== 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: + Result := TJclStringTypeInfo.Create(ATypeInfo); + tkClass: + Result := TJclClassTypeInfo.Create(ATypeInfo); + tkMethod: + Result := TJclEventTypeInfo.Create(ATypeInfo); + tkInterface: + Result := TJclInterfaceTypeInfo.Create(ATypeInfo); + tkInt64: + Result := TJclInt64TypeInfo.Create(ATypeInfo); + {$IFDEF RTL140_UP} + tkDynArray: + Result := TJclDynArrayTypeInfo.Create(ATypeInfo); + {$ENDIF RTL140_UP} + else + Result := TJclTypeInfo.Create(ATypeInfo); + end; +end; + +//=== User generated type info managment ===================================== + +{$IFNDEF CLR} +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^) + else + if (TypeInfo.Kind = tkEnumeration) and (TD^.BaseType^ <> TypeInfo) then + RemoveTypeInfo(GetTypeData(TypeInfo)^.BaseType^); + 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; +{$ENDIF ~CLR} + +//=== 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 + {$IFDEf CLR} + Result := Format(RsRTTIValueOutOfRange, [RsRTTIOrdinal + IntToStr(EnumVal)]) + {$ELSE} + Result := Format(LoadResString(@RsRTTIValueOutOfRange), + [LoadResString(@RsRTTIOrdinal) + IntToStr(EnumVal)]) + {$ENDIF CLR} + else + Result := GetEnumName(TypeInfo, EnumVal); +end; + +{$IFNDEF CLR} +function JclGenerateEnumType(const TypeName: ShortString; + const Literals: array of string): PTypeInfo; +type + PInteger = ^Integer; +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 {$IFDEF RTL140_UP}+ 1{$ENDIF RTL140_UP}); + 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^ := Result; // No sub-range: basetype points to itself + CurName := @TypeData^.NameList; + for I := Low(Literals) to High(Literals) do + begin + CurName^ := Literals[I]; + Inc(Integer(CurName), Length(Literals[I])+1); + end; + {$IFDEF RTL140_UP} + CurName^ := ''; // Unit name unknown + {$ENDIF RTL140_UP} + 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 (S[1] in AnsiLowercaseLetters) 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 := TypeName; + end; + TypeData := GetTypeData(Result); + TypeData^.OrdType := GetTypeData(BaseType)^.OrdType; + TypeData^.MinValue := MinValue; + TypeData^.MaxValue := MaxValue; + TypeData^.BaseType := AllocMem(SizeOf(Pointer)); + TypeData^.BaseType^ := BaseType; + AddType(Result); + except + try + ReallocMem(Result, 0); + except + Result := nil; + end; + raise; + end; + ReferenceType(BaseType); +end; +{$ENDIF ~CLR} + +//=== 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; + HaveConversion := (@Conv <> nil) and Conv(Value, Result); + if not HaveConversion then + begin + if TypeInfo <> nil then + begin + Info := JclTypeInfo(TypeInfo); + {$IFDEF CLR} + if not Supports(Info, IJclOrdinalRangeTypeInfo, RangeInfo) then + {$ELSE} + if Info.QueryInterface(IJclOrdinalRangeTypeInfo, RangeInfo) <> S_OK then + {$ENDIF CLR} + RangeInfo := nil; + TmpVal := StrToInt64(Value); + if (RangeInfo <> nil) and ((TmpVal < RangeInfo.MinValue) or + (TmpVal > RangeInfo.MaxValue)) then + {$IFDEF CLR} + raise EConvertError.CreateFmt(SInvalidInteger, [Value]); + {$ELSE} + raise EConvertError.CreateResFmt(@SInvalidInteger, [Value]); + {$ENDIF CLR} + 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; + 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{$IFNDEF CLR}^{$ENDIF}; + EnumMin := GetTypeData(CompType).MinValue; + EnumMax := GetTypeData(CompType).MaxValue; + ResBytes := (EnumMax div 8) - (EnumMin div 8) + 1; + BitShift := EnumMin mod 8; + TmpInt64 := Longword(Value) shl BitShift; + {$IFDEF CLR} + SetVar := BitConverter.GetBytes(TmpInt64); + {$ELSE} + Move(TmpInt64, SetVar, ResBytes); + {$ENDIF CLR} +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{$IFNDEF CLR}^{$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 + {$IFDEF CLR} + raise EJclRTTIError.CreateFmt(RsRTTIValueOutOfRange, + [IntToStr(EnumMax - EnumMin) + ' ' + RsRTTIBits]); + TmpInt64 := BitConverter.ToInt64(TDynByteArray(SetVar), 0); + TmpInt64 := TmpInt64 shr BitShift; + Result := BitConverter.ToInt32(Copy(BitConverter.GetBytes(TmpInt64), 0, ResBytes), 0); + {$ELSE} + raise EJclRTTIError.CreateResFmt(@RsRTTIValueOutOfRange, + [IntToStr(EnumMax - EnumMin) + ' ' + LoadResString(@RsRTTIBits)]); + Result := 0; + TmpInt64 := 0; + Move(SetVar, TmpInt64, ResBytes + 1); + TmpInt64 := TmpInt64 shr BitShift; + Move(TmpInt64, Result, ResBytes); + {$ENDIF CLR} +end; + +{$IFNDEF CLR} +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; + TypeData^.CompType := AllocMem(SizeOf(Pointer)); + TypeData^.CompType^ := BaseType; + AddType(Result); + except + try + ReallocMem(Result, 0); + except + Result := nil; + end; + raise; + end; + ReferenceType(BaseType); +end; + +//=== Is/As hooking ========================================================== + +type + PReadLoc = ^TReadLoc; + TReadLoc = packed record + {$IFDEF OPTIMIZATION_ON} + Code: array [0..9] of Byte; + {$ELSE} + Code: array [0..17] of Byte; + {$ENDIF OPTIMIZATION_ON} + OpCode_Call: Byte; + CallOffset: Longint; + end; + + PJmp = ^TJmp; + TJmp = packed record + case OpCodeJmp: Byte of + $E9: + (JmpOffset: Longint); + $FF: + (OpCode2: Byte; + EntryOffset: Longint); + end; +{$ENDIF ~CLR} + +// Copied from System.pas (_IsClass function) + +function JclIsClass(const AnObj: TObject; const AClass: TClass): Boolean; +{$IFDEF CLR} +begin + Result := (AnObj <> nil) and (AClass.ClassInfo.IsInstanceOfType(AnObj)); +end; +{$ELSE} +asm + { -> EAX left operand (class) } + { EDX VMT of right operand } + { <- AL left is derived from right } + TEST EAX,EAX + JE @@exit +@@loop: + MOV EAX,[EAX] + CMP EAX,EDX + JE @@success + MOV EAX,[EAX].vmtParent + TEST EAX,EAX + JNE @@loop + JMP @@exit +@@success: + MOV AL,1 +@@exit: +end; +{$ENDIF ~CLR} + +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 + {$IFDEF CLR} + raise EInvalidCast.Create(SInvalidCast); + {$ELSE} + raise EInvalidCast.CreateRes(@SInvalidCast); + {$ENDIF CLR} +end; + +{$IFNDEF CLR} +initialization + TypeList := TThreadList.Create; + +finalization + ClearInfoList; + FreeAndNil(TypeList); +{$ENDIF ~CLR} + +// History: + +// $Log: JclRTTI.pas,v $ +// Revision 1.24 2005/05/05 20:08:44 ahuser +// JCL.NET support +// +// Revision 1.23 2005/03/14 08:46:53 rrossmair +// - check-in in preparation for release 1.95 +// +// Revision 1.22 2005/03/08 16:10:08 marquardt +// standard char sets extended and used, some optimizations for string literals +// +// Revision 1.21 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.20 2005/03/06 18:15:02 marquardt +// JclGUIDToString and JclStringToGUID moved to JclSysUtils.pas, CrLf replaced by AnsiLineBreak +// +// Revision 1.19 2005/03/01 00:10:26 ahuser +// Delphi 2005 inline support +// +// Revision 1.18 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.17 2004/11/15 05:25:28 mthoma +// Fixed #1055. +// +// Revision 1.16 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.15 2004/09/30 07:50:29 marquardt +// remove JclIsClass pure pascal contributions +// +// Revision 1.14 2004/08/03 07:22:37 marquardt +// resourcestring cleanup +// +// Revision 1.13 2004/08/01 05:52:11 marquardt +// move constructors/destructors +// +// Revision 1.12 2004/07/31 06:21:01 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.11 2004/07/28 18:00:51 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.10 2004/06/14 11:05:51 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.9 2004/06/11 14:08:51 twm +// Bugfix: now uses AnsiLineBreak rather than AnsiCrLf so it will work with unix systems +// +// Revision 1.8 2004/05/05 00:09:59 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.7 2004/04/23 22:08:39 mthoma +// Removed non delphi language version of JclIsClass. +// +// Revision 1.6 2004/04/15 16:19:36 +// add pure pascal implementation (JclIsClass) +// +// Revision 1.5 2004/04/06 04:53:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/common/JclResources.pas b/official/1.96/source/common/JclResources.pas new file mode 100644 index 0000000..df68b4a --- /dev/null +++ b/official/1.96/source/common/JclResources.pas @@ -0,0 +1,1818 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ Unit which provides a central place for all resource strings used in the JCL } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2006/02/02 20:33:40 $ +// For history see end of file + +unit JclResources; + +{$I jcl.inc} + +interface + +{$IFNDEF RTL140_UP} +const + sLineBreak = #13#10; +{$ENDIF RTL140_UP} + +//=== JclBase ================================================================ +resourcestring + RsWin32Prefix = 'Win32: %s (%u)'; + RsDynArrayError = 'DynArrayInitialize: ElementSize out of bounds'; + RsSysErrorMessageFmt = 'Win32 Error %d (%x)'; + +//=== JclBorlandTools ======================================================== +resourcestring + RsNotFound = '%s not found'; + RsNotABcbPackage = '%s not a C++Builder package source file'; + RsNotABcbProject = '%s not a C++Builder project source file'; + RsNotADelphiPackage = '%s not a Delphi package source file'; + RsNotADelphiProject = '%s not a Delphi project source file'; + RsIndexOufOfRange = 'Index out of range'; + RsNeedUpdate = 'You should install latest Update Pack #%d for %s'; + RsUpdatePackName = 'Update Pack #%d'; + RsDelphiName = 'Delphi'; + RsDelphiNetName = 'Delphi.net'; + RsBCBName = 'C++Builder'; + RsCSharpName = 'C#Builder'; + RsBDSName = 'Borland Developer Studio'; + {$IFDEF KYLIX} + RsKylixName = 'Kylix for %s'; + RsKylixVersionName = 'Kylix %d for %s'; + RsOpenEdition = 'Open Edition'; + RsServerDeveloper = 'Server Developer'; + RsVclIncludeDir = '/include/vcl/'; + {$ENDIF KYLIX} + {$IFDEF MSWINDOWS} + RsClientServer = 'Client/Server'; + RsStandard = 'Standard'; + RsVclIncludeDir = '\Include\Vcl\'; + {$ENDIF MSWINDOWS} + RsArchitect = 'Architect'; + RsEnterprise = 'Enterprise'; + RsPersonal = 'Personal'; + RsProfessional = 'Professional'; + + RsNoSupportedPersonality = 'No personalities supported'; + RsDualPackageNotSupported = 'This installation of %s doesn''t support dual packages'; + RsCommandLineToolMissing = 'No compiler available for %s'; + + RsUnknownProjectExtension = '%s not a known project extension'; + RsUnknownPackageExtension = '%s not a known package extension'; + RsUnknownIdePackageExtension = '%s not a known ide package extension'; + + RsCannotInstallRunOnly = 'A run-only package cannot be installed'; + RsUnknownProjectType = '%s not a known project type'; + + RsBorlandStudioProjects = 'Borland Studio Projects'; + RsCmdLineToolOutputInvalid = '%s: Output invalid, when OutputCallback assigned.'; + + 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'; + RsLinkingMap = 'Linking MAP file in %s'; + RsLinkMapOk = 'Map link success'; + RsLinkMapInfo = 'Bug unit: %s; MAP size: %d; Debug size: %d'; + RsLinkMapFailed = 'Map link failure'; + 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'; + +//=== JclCIL ================================================================= +resourcestring + RsInstructionStreamInvalid = 'Invalid IL instruction stream'; + + 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 = ''; + +//=== JclClasses ============================================================= +resourcestring + RsVMTMemoryWriteError = 'Error writing VMT memory (%s)'; + +//=== 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'; + +//=== JclConsole ============================================================= +resourcestring + RsCannotRaiseSignal = 'Cannot raise %s signal.'; + +//=== JclContainerIntf ======================================================= +resourcestring + RsEOutOfBounds = 'Out of bounds'; + //RsENoSuchElement = 'No such element'; + //RsEIllegalState = 'Illegal state'; + //RsEConcurrentModification = 'Concurrent modification'; + //RsEIllegalArgument = 'Illegal argument'; + RsEOperationNotSupported = 'Operation not supported'; + RsEValueNotFound = 'Value %s not found'; + RsENoCollection = 'Collection = nil'; + RsEIllegalQueueCapacity = 'Illegal queue capacity'; + +//=== 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 + // Diagnostics + RsDebugAssertValidPointer = 'Invalid Pointer passed to AssertValid'; + RsDebugAssertValidString = 'Invalid string passed to AssertValid'; + + // TMapFiles + RsDebugMapFileExtension = '.map'; // do not localize + RsDebugNoProcessInfo = 'Unable to obtain process information'; + RsDebugSnapshot = 'Failure creating toolhelp32 snapshot'; + +//=== JclEDI ================================================================= +resourcestring + RsEDIError001 = 'Could not open edi file. File not specified.'; + RsEDIError002 = 'Could not save edi file. File name and path not specified.'; + RsEDIError003 = 'Could not get data object from %s at index [%s],'; + RsEDIError004 = 'Could not get data object from %s at index [%s], Index too low.'; + RsEDIError005 = 'Could not get data object from %s at index [%s], Index too high.'; + RsEDIError006 = 'Could not get data object from %s at index [%s], ' + + 'There was no data object assigned.'; + RsEDIError007 = 'Could not set data object from %s at index [%s].'; + RsEDIError008 = 'Could not set data object from %s at index [%s], Index too low.'; + RsEDIError009 = 'Could not set data object from %s at index [%s], Index too high.'; + RsEDIError010 = 'Could not delete data object from %s at index [%s]'; + RsEDIError011 = 'Could not delete data objects from %s at index [%s]'; + RsEDIError012 = 'Delimiters have not been assigned to interchange. Dissassemble cancelled.'; + RsEDIError013 = 'Delimiters have not been assigned to interchange. Assemble cancelled.'; + RsEDIError014 = 'Could not find interchange control header segment terminator.'; + RsEDIError015 = 'Could not find interchange control header.'; + RsEDIError016 = 'Could not find interchange control trailer segment terminator.'; + RsEDIError017 = 'Could not find interchange control trailer.'; + RsEDIError018 = 'Could not find interchange control trailer or garbage at end of file.'; + RsEDIError019 = 'Could not assign delimiters to functional group. Dissassemble cancelled.'; + RsEDIError020 = 'Could not assign delimiters to functional group. Assemble cancelled.'; + RsEDIError021 = 'Could not find functional group header segment terminator.'; + RsEDIError022 = 'Could not find functional group header.'; //conditional for UN/EDIFACT + RsEDIError023 = 'Could not find functional group trailer segment terminator.'; + RsEDIError024 = 'Could not find functional group trailer.'; + RsEDIError025 = 'Could not assign delimiters to transaction set. Dissassemble cancelled.'; + RsEDIError026 = 'Could not assign delimiters to transaction set. Assemble cancelled.'; + RsEDIError027 = 'Could not find transaction set header.'; + RsEDIError028 = 'Could not find transaction set trailer segment terminator.'; + RsEDIError029 = 'Could not find transaction set trailer.'; + RsEDIError030 = 'Could not assign delimiters to message. Dissassemble cancelled.'; + RsEDIError031 = 'Could not assign delimiters to message. Assemble cancelled.'; + RsEDIError032 = 'Could not find message header.'; + RsEDIError033 = 'Could not find message trailer segment terminator.'; + RsEDIError034 = 'Could not find message trailer.'; + RsEDIError035 = 'Could not assign delimiters to segment. Dissassemble cancelled.'; + RsEDIError036 = 'Could not assign delimiters to segment. Assemble cancelled.'; + RsEDIError037 = 'Could not assign delimiters to composite element. Dissassemble cancelled.'; + RsEDIError038 = 'Could not assign delimiters to composite element. Assemble cancelled.'; + RsEDIError039 = 'Could not get data object in transaction set loop at index [%s], ' + + 'Data object does not exist.'; + RsEDIError040 = 'Could not get data object in transaction set loop at index [%s], ' + + 'Index too high.'; + RsEDIError041 = 'Could not get data object in transaction set loop at index [%s], Index too low.'; + RsEDIError042 = 'Could not get data object in transaction set loop at index [%s].'; + RsEDIError043 = 'Could not set data object in transaction set loop at index [%s], ' + + 'Index too high.'; + RsEDIError044 = 'Could not set data object in transaction set loop at index [%s], Index too low.'; + RsEDIError045 = 'Could not set data object in transaction set loop at index [%s].'; + RsEDIError046 = 'Could not get data object in message loop at index [%s], ' + + 'Data object does not exist.'; + RsEDIError047 = 'Could not get data object in message loop at index [%s], Index too high.'; + RsEDIError048 = 'Could not get data object in message loop at index [%s], Index too low.'; + RsEDIError049 = 'Could not get data object in message loop at index [%s].'; + RsEDIError050 = 'Could not set data object in message loop at index [%s], Index too high.'; + RsEDIError051 = 'Could not set data object in message loop at index [%s], Index too low.'; + RsEDIError052 = 'Could not set data object in message loop at index [%s].'; + RsEDIError053 = 'Loop in loop stack record at index [%s] does not exist.'; + RsEDIError054 = 'Could not get loop stack record at index [%s], Index too high.'; + RsEDIError055 = 'Could not get loop stack record at index [%s], Index too low.'; + RsEDIError056 = 'Could not get loop stack record at index [%s].'; + RsEDIError057 = 'Could not get safe loop stack index [%s].'; + RsEDIError058 = 'Could not assign element specification to element at index [%s] ' + + 'in segment [%s] at index [%s] in transaction set.'; + + RsUnknownAttribute = 'Unknown Attribute'; + +//== JclEDISEF =============================================================== +resourcestring + // Transaction Set:850 + SEFTextSetsCode_Set0_Desc = 'Transaction Set or message title.'; + SEFTextSetsCode_Set1_Desc = 'Transaction Set functional group (X12).'; + SEFTextSetsCode_Set2_Desc = 'Transaction Set or message purpose.'; + SEFTextSetsCode_Set3_Desc = 'Level 1 note on transaction set or message.'; + SEFTextSetsCode_Set4_Desc = 'Level 2 note on transaction set or message.'; + SEFTextSetsCode_Set5_Desc = 'Level 3 note on transaction set or message.'; + // Transaction Set~segment ordinal number: 850~1 + SEFTextSetsCode_Seg0_Desc = 'Segment reference notes that are part of the transaction set in X12.'; + SEFTextSetsCode_Seg1_Desc = 'Segment reference notes documented with the segment (like in VICS/UCS).'; + SEFTextSetsCode_Seg2_Desc = 'Segment reference comment documented with the transaction set.'; + SEFTextSetsCode_Seg3_Desc = 'Segment name.'; + SEFTextSetsCode_Seg4_Desc = 'Level 1 note on segment.'; + SEFTextSetsCode_Seg5_Desc = 'Level 2 note on segment.'; + SEFTextSetsCode_Seg6_Desc = 'Segment purpose.'; + SEFTextSetsCode_Seg7_Desc = 'Level 3 note on segment. See * below for other levels of notes.'; + // Transaction Set~segment ordinal number~element or composite ordinal number: 850~1~4 + SEFTextSetsCode_Elm0_Desc = 'Level 1 note on element or composite.'; + SEFTextSetsCode_Elm1_Desc = 'Level 2 note on element or composite.'; + SEFTextSetsCode_Elm2_Desc = 'Name of element or composite.'; + SEFTextSetsCode_Elm4_Desc = 'Level 3 note on element or composite.'; + +//=== JclEDIXML ============================================================== +resourcestring + EDIXMLError001 = 'Could not open edi file. File not specified.'; + EDIXMLError002 = 'Could not save edi file. File name and path not specified.'; + EDIXMLError003 = 'Could not assign delimiters to edi file. Disassemble cancelled.'; + EDIXMLError004 = 'Could not assign delimiters to edi file. Assemble cancelled.'; + EDIXMLError005 = 'Could not assign delimiters to interchange control. Disassemble cancelled.'; + EDIXMLError006 = 'Could not assign delimiters to interchange control. Assemble cancelled.'; + EDIXMLError007 = 'Could not find interchange control end tag.'; + EDIXMLError008 = 'Could not find interchange control end tag delimiter.'; + EDIXMLError009 = 'Could not find interchange control header.'; + EDIXMLError010 = 'Could not find interchange control header end tag.'; + EDIXMLError011 = 'Could not find interchange control header end tag delimiter.'; + EDIXMLError012 = 'Could not find interchange control trailer.'; + EDIXMLError013 = 'Could not find interchange control trailer end tag.'; + EDIXMLError014 = 'Could not find interchange control trailer end tag delimiter.'; + EDIXMLError015 = 'Could not assign delimiters to functional group. Disassemble cancelled.'; + EDIXMLError016 = 'Could not assign delimiters to functional group. Assemble cancelled.'; + EDIXMLError017 = 'Could not find functional group end tag.'; + EDIXMLError018 = 'Could not find functional group end tag delimiter.'; + EDIXMLError019 = 'Could not find functional group header.'; + EDIXMLError020 = 'Could not find functional group header end tag.'; + EDIXMLError021 = 'Could not find functional group header end tag delimiter.'; + EDIXMLError022 = 'Could not find functional group trailer.'; + EDIXMLError023 = 'Could not find functional group trailer end tag.'; + EDIXMLError024 = 'Could not find functional group trailer end tag delimiter.'; + EDIXMLError025 = 'Could not assign delimiters to transactoin set. Disassemble cancelled.'; + EDIXMLError026 = 'Could not assign delimiters to transactoin set. Assemble cancelled.'; + EDIXMLError027 = 'Could not find transaction set end tag.'; + EDIXMLError028 = 'Could not find transaction set end tag delimiter.'; + EDIXMLError029 = 'Could not assign delimiters to transactoin set loop. Disassemble cancelled.'; + EDIXMLError030 = 'Could not assign delimiters to transactoin set loop. Assemble cancelled.'; + EDIXMLError031 = 'Could not find loop end tag'; + EDIXMLError032 = 'Could not find loop end tag delimiter'; + EDIXMLError033 = 'Could not set data object at index [%s].'; + EDIXMLError034 = 'Could not set data object at index [%s], Index too low.'; + EDIXMLError035 = 'Could not set data object at index [%s], Index too high.'; + EDIXMLError036 = 'Could not get data object at index [%s], There was no data object to get.'; + EDIXMLError037 = 'Could not get data object at index [%s], Index too low.'; + EDIXMLError038 = 'Could not get data object at index [%s], Index too high.'; + EDIXMLError039 = 'Could not get data object at index [%s], Data object does not exist.'; + EDIXMLError040 = 'Could not delete EDI data object'; + EDIXMLError041 = 'Could not assign delimiters to segment. Disassemble cancelled.'; + EDIXMLError042 = 'Could not assign delimiters to segment. Assemble cancelled.'; + EDIXMLError043 = 'Could not find segment begin tag'; + EDIXMLError044 = 'Could not find segment end tag'; + EDIXMLError045 = 'Could not find segment end tag delimiter'; + EDIXMLError046 = 'Could not assign delimiters to element. Disassemble cancelled.'; + EDIXMLError047 = 'Could not assign delimiters to element. Assemble cancelled.'; + EDIXMLError048 = 'Could not find element tag'; + EDIXMLError049 = 'Could not find element end tag'; + EDIXMLError050 = 'Could not find element end tag delimiter'; + EDIXMLError051 = 'Could not set element at index [%s].'; + EDIXMLError052 = 'Could not set element at index [%s], Index too low.'; + EDIXMLError053 = 'Could not set element at index [%s], Index too high.'; + EDIXMLError054 = 'Could not get element at index [%s], There was no element to get.'; + EDIXMLError055 = 'Could not get element at index [%s], Index too low.'; + EDIXMLError056 = 'Could not get element at index [%s], Index too high.'; + EDIXMLError057 = 'Could not get element at index [%s], Element does not exist.'; + EDIXMLError058 = 'Could not delete element at index [%s].'; + EDIXMLError059 = 'Could not find transaction set header.'; + EDIXMLError060 = 'Could not find transaction set trailer.'; + EDIXMLError061 = 'Could not find transaction set header and trailer.'; + EDIXMLError062 = 'TEDIXMLANSIX12FormatTranslator: Unexpected object [%s] found.'; + +//=== 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!'; + + // TJclFileVersionInfo + RsFileUtilsNoVersionInfo = 'File contains no version information'; + RsFileUtilsLanguageIndex = 'Illegal language index'; + + // 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 '; + + // 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'; + +//=== JclGraphics, JclGraphUtils ============================================= +resourcestring + RsBitsPerSampleNotSupported = '%d bits per sample not supported in color space conversion'; + 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'; + + RsBitmapExtension = '.bmp'; + RsJpegExtension = '.jpg'; + +//=== 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'; + RsMapiMailBody = 'Body'; + +//=== 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'; + RsUnexpectedDataType = 'Unexpected data type'; + RsUnexpectedValue = 'Unexpected data value'; + RsRangeError = 'Cannot merge range'; + 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 + RsCreateProcOSVersionError = 'Unable to determine OS version'; + 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'; + RsMmTimerBeginPeriod = 'The supplied timer period value is out of range'; + 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'; + +//=== 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'; + RsErrLibNotLoaded = 'PCRE library not loaded'; + +//=== JclPeImage ============================================================= +resourcestring + RsPeReadOnlyStream = 'Stream is read-only'; + + // TJclPeImage + RsPeCantOpen = 'Cannot open file "%s"'; + RsPeNotPE = 'This is not a PE format'; + 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'; + + // 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_ALPHA = 'Alpha_AXP'; + RsPeMACHINE_POWERPC = 'IBM PowerPC Little-Endian'; + + // 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'; + +//=== 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'; + +//=== JclRegistry ============================================================ +resourcestring + RsUnableToOpenKeyRead = 'Unable to open key "%s" for read'; + RsUnableToOpenKeyWrite = 'Unable to open key "%s" for write'; + RsUnableToAccessValue = 'Unable to open key "%s" and access value "%s"'; + RsWrongDataType = '"%s\%s" is of wrong kind or size'; + RsInconsistentPath = '"%s" does not match RootKey'; + +//=== JclRTTI ================================================================ +resourcestring + RsRTTIValueOutOfRange = 'Value out of range (%s).'; + RsRTTIUnknownIdentifier = 'Unknown identifier ''%s''.'; + RsRTTIInvalidBaseType = 'Invalid base type (%s is of type %s).'; + + 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'; + +//=== JclStatistics ========================================================== +resourcestring + RsInvalidSampleSize = 'Invalid sample size (%d)'; + +//=== 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.'; + +//=== 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, 4Kb pages, 4-way set associative, 32 entries'; + RsIntelCacheDescr02 = 'Instruction TLB, 4Mb pages, fully associative, 2 entries'; + RsIntelCacheDescr03 = 'Data TLB, 4Kb pages, 4-way set associative, 64 entries'; + RsIntelCacheDescr04 = 'Data TLB, 4Mb pages, 4-way set associative, 8 entries'; + RsIntelCacheDescr06 = '8KB instruction cache, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr08 = '16KB instruction cache, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr0A = '8KB data cache 2-way set associative, 32 byte line size'; + RsIntelCacheDescr0C = '16KB data cache, 4-way set associative, 32 byte line size'; + RsIntelCacheDescr22 = '3° Level cache, 512 KBytes, 4-way set associative, 2 lines per sector, 128 byte sector size'; + RsIntelCacheDescr23 = '3° Level cache, 1 MBytes, 8-way set associative, 2 lines per sector, 128 byte sector size'; + RsIntelCacheDescr25 = '3° Level cache, 2 MBytes, 8-way set associative, 2 lines per sector, 128 byte line size'; + RsIntelCacheDescr29 = '3° Level cache, 4M Bytes, 8-way set associative, 2 lines per sector, 128 byte line size'; + RsIntelCacheDescr2C = '1° Level data cache: 32K Bytes, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr30 = '1° Level instruction cache: 32K Bytes, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr40 = 'No L2 cache'; + RsIntelCacheDescr41 = 'Unified cache, 32 byte cache line, 4-way set associative, 128Kb'; + RsIntelCacheDescr42 = 'Unified cache, 32 byte cache line, 4-way set associative, 256Kb'; + RsIntelCacheDescr43 = 'Unified cache, 32 byte cache line, 4-way set associative, 512Kb'; + RsIntelCacheDescr44 = 'Unified cache, 32 byte cache line, 4-way set associative, 1Mb'; + RsIntelCacheDescr45 = 'Unified cache, 32 byte cache line, 4-way set associative, 2Mb'; + RsIntelCacheDescr50 = 'Instruction TLB, 4 KBytes and 2 MBytes or 4 MBytes pages, 64 Entries'; + RsIntelCacheDescr51 = 'Instruction TLB, 4 KBytes and 2 MBytes or 4 MBytes pages, 128 Entries'; + RsIntelCacheDescr52 = 'Instruction TLB, 4 KBytes and 2 MBytes or 4 MBytes pages, 256 Entries'; + RsIntelCacheDescr5B = 'Data TLB, 4 KBytes and 4 MBytes pages, 64 Entries'; + RsIntelCacheDescr5C = 'Data TLB, 4 KBytes and 4 MBytes pages, 128 Entries'; + RsIntelCacheDescr5D = 'Data TLB, 4 KBytes and 4 MBytes pages, 256 Entries'; + RsIntelCacheDescr60 = '1° Level data cache: 16 KByte, 8-way set associative, 64 byte line size'; + RsIntelCacheDescr66 = '1° Level Data cache, 8 KBytes, 4-way set associative, 64 Bytes line size'; + RsIntelCacheDescr67 = '1° Level Data cache, 16 KBytes, 4-way set associative, 64 Bytes line size'; + RsIntelCacheDescr68 = '1° Level Data cache, 32 KBytes, 4-way set associative, 64 Bytes 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'; + RsIntelCacheDescr78 = '2° Level cache, 1 MBytes, 4-way set associative, 64 Bytes line size'; + RsIntelCacheDescr79 = '2° Level cache, 128 KBytes, 8-way set associative, dual-sectored line, 64 Bytes sector size'; + RsIntelCacheDescr7A = '2° Level cache, 256 KBytes, 8-way set associative, dual-sectored line, 64 Bytes sector size'; + RsIntelCacheDescr7B = '2° Level cache, 512 KBytes, 8-way set associative, dual-sectored line, 64 Bytes sector size'; + RsIntelCacheDescr7C = '2° Level cache, 1 MBytes, 8-way set associative, dual-sectored line, 64 Bytes sector size'; + RsIntelCacheDescr7D = '2° Level cache, 2 MByte, 8-way set associative, 64byte line size'; + RsIntelCacheDescr7F = '2° Level cache, 512 KByte, 2-way set associative, 64-byte line size'; + RsIntelCacheDescr82 = '2° Level cache, 256 KBytes, 8-way associative, 32 Bytes line size'; + RsIntelCacheDescr83 = '2° Level cache, 512 KBytes, 8-way associative, 32 Bytes line size'; + RsIntelCacheDescr84 = '2° Level cache, 1 MBytes, 8-way associative, 32 Bytes line size'; + RsIntelCacheDescr85 = '2° Level cache, 2 MBytes, 8-way associative, 32 Bytes line size'; + RsIntelCacheDescr86 = '2° Level cache, 512 KByte, 4-way set associative, 64 byte line size'; + RsIntelCacheDescr87 = '2° Level cache, 1 MByte, 8-way set associative, 64 byte line size'; + RsIntelCacheDescrB0 = 'Instruction TLB, 4 KByte Pages, 4-way set associative, 128 entries'; + RsIntelCacheDescrB3 = 'Data TLB, 4 KByte Pages, 4-way set associative, 128 entries'; + RsIntelCacheDescrF0 = '64-Byte Prefetching'; + RsIntelCacheDescrF1 = '128-Byte Prefetching'; + + 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'; + RsOSVersionWinLonghorn = 'Windows Server "Longhorn"'; + + RsProductTypeWorkStation = 'Workstation'; + RsProductTypeServer = 'Server'; + RsProductTypeAdvancedServer = 'Advanced Server'; + RsProductTypePersonal = 'Home Edition'; + RsProductTypeProfessional = 'Professional'; + RsProductTypeDatacenterServer = 'Datacenter Server'; + RsProductTypeEnterprise = 'Enterprise'; + RsProductTypeWebEdition = 'Web Edition'; + + RsOpenGLInfoError = 'Err'; + + RsEOpenGLInfo = 'GetOpenGLVersion: %s failed'; + + {$IFDEF MSWINDOWS} + RsSPInfo = 'SP%u'; + {$ENDIF MSWINDOWS} + + {$IFDEF UNIX} + RsInvalidProcessID = 'Invalid process ID %d'; + {$ENDIF UNIX} + +//=== JclSysUtils ============================================================ +resourcestring + 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).'; + +//=== JclTD32 ================================================================ +resourcestring + RsHasNotTD32Info = 'File [%s] has not TD32 debug information!'; + +//=== 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.'; + RsCasedUnicodeChar = 'cased Unicode character > $FFFF found'; + RsDecomposedUnicodeChar = 'decomposed Unicode character > $FFFF found'; + RsCombiningClassUnicodeChar = 'combining class for Unicode character > $FFFF found'; + +//=== JclUnitConv ============================================================ +resourcestring + RsTempConvTypeError = 'An invalid type has been provided for the %s parameter'; + RsConvTempBelowAbsoluteZero = 'Temperature can not be below Absolute Zero!'; + +//=== JclWideFormat ========================================================== +resourcestring + RsFormatSyntaxError = 'Syntax error at index %u'; + RsFormatNoArgument = 'No argument at index %u'; + RsFormatBadArgumentType = 'Invalid argument type (%s) at index %u. Expected [%s]'; + RsFormatBadArgumentTypeEx = 'Invalid argument type (%s) at index %u for format ''%s''. Expected [%s]'; + RsFormatNoArgumentEx = 'No argument at index %u for format ''%s'''; + +//=== JclWin32 =============================================================== +resourcestring + 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'; + +//=== JclCompression ========================================================= +resourcestring + RsCompressionOperationNotSupported = 'Operation is not supported.'; + 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.'; + 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 error'; + +implementation + +// History: + +// $Log: JclResources.pas,v $ +// Revision 1.38 2006/02/02 20:33:40 outchy +// Package cache cleaned +// +// Revision 1.37 2005/12/26 18:03:51 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.36 2005/12/04 10:10:58 obones +// Borland Developer Studio 2006 support +// +// Revision 1.35 2005/11/21 11:50:22 outchy +// Detection of Windows Vista/Longhorn/2003 R2/XP 64. +// From: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/getting_the_system_version.asp +// +// Revision 1.34 2005/03/14 08:46:53 rrossmair +// - check-in in preparation for release 1.95 +// +// Revision 1.33 2005/03/12 01:32:50 outchy +// Update of the CPUID function. New processors detection, constants reworked and specifications upgraded. +// +// Revision 1.32 2005/03/08 11:45:26 ahuser +// Fixed missing sLineBreak for Delphi5 +// +// Revision 1.31 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.30 2005/03/07 17:27:57 marquardt +// reworked for resorucestrings +// +// Revision 1.29 2005/03/06 18:15:02 marquardt +// JclGUIDToString and JclStringToGUID moved to JclSysUtils.pas, CrLf replaced by AnsiLineBreak +// +// Revision 1.28 2005/02/27 11:36:20 marquardt +// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec +// +// Revision 1.27 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.26 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.25 2004/12/19 20:16:31 rrossmair +// - added TCpuInfo improvements by Florent Ouchet +// +// Revision 1.24 2004/12/05 04:58:46 rrossmair +// added ReadKey donation by Wayne Sherman +// +// Revision 1.23 2004/11/15 04:16:06 mthoma +// JclCompression resource strings added. +// +// Revision 1.22 2004/11/09 07:53:07 rrossmair +// - JclPCRE string extracted to JclResources +// +// Revision 1.21 2004/10/25 08:51:22 marquardt +// PH cleaning +// +// Revision 1.20 2004/10/21 08:40:10 marquardt +// style cleaning +// +// Revision 1.19 2004/10/18 16:22:13 marquardt +// JclRegistry redesign to remove PH contributor +// +// Revision 1.18 2004/10/17 23:48:14 mthoma +// Added OpenGL error messages. +// +// Revision 1.17 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.16 2004/10/11 08:13:03 marquardt +// PH cleaning of JclStrings +// +// Revision 1.15 2004/09/30 13:11:27 marquardt +// remove PH contributions +// +// Revision 1.14 2004/09/30 08:09:07 marquardt +// remove JclDITs remains +// +// Revision 1.13 2004/08/23 10:13:58 scottprice +// Modified temperature routines, and added support for Rankine and Reaumur. Added some string constants to this unit related to that change. +// +// Revision 1.12 2004/08/18 17:10:27 rrossmair +// added RsInvalidSampleSize for JclStatistics +// +// Revision 1.11 2004/08/03 07:22:37 marquardt +// resourcestring cleanup +// +// Revision 1.10 2004/08/02 15:30:16 marquardt +// hunting down (rom) comments +// +// Revision 1.9 2004/07/28 18:00:51 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.8 2004/06/14 11:05:51 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.7 2004/06/02 03:23:46 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.6 2004/05/14 15:26:34 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/18 00:41:04 +// remove unneeded OpenGL error messages +// +// Revision 1.4 2004/04/06 04:38:57 +// Add resources for DIT and ZLib +// + +end. diff --git a/official/1.96/source/common/JclSchedule.pas b/official/1.96/source/common/JclSchedule.pas new file mode 100644 index 0000000..3159577 --- /dev/null +++ b/official/1.96/source/common/JclSchedule.pas @@ -0,0 +1,1604 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{ Unit owner: Marcel Bestebroer } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/03/08 08:33:17 $ +// For history see end of file + +unit JclSchedule; + +{$I jcl.inc} + +interface + +uses + SysUtils, + 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; + + ESchedule = class(EJclError); + + 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; +function NullStamp: TTimeStamp; +function CompareTimeStamps(const Stamp1, Stamp2: TTimeStamp): Int64; +function EqualTimeStamps(const Stamp1, Stamp2: TTimeStamp): Boolean; +function IsNullTimeStamp(const Stamp: TTimeStamp): Boolean; + +implementation + +uses + JclDateTime, JclResources; + +{$IFNDEF RTL140_UP} + +const + S_OK = $00000000; + E_NOINTERFACE = HRESULT($80004002); + +type + TAggregatedObject = class + private + FController: Pointer; + function GetController: IUnknown; + protected + { IUnknown } + function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + constructor Create(Controller: IUnknown); + property Controller: IUnknown read GetController; + end; + + TContainedObject = class(TAggregatedObject, IUnknown) + protected + { IUnknown } + function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; + end; + +//=== { TAggregatedObject } ================================================== + +constructor TAggregatedObject.Create(Controller: IUnknown); +begin + FController := Pointer(Controller); +end; + +function TAggregatedObject.GetController: IUnknown; +begin + Result := IUnknown(FController); +end; + +function TAggregatedObject.QueryInterface(const IID: TGUID; out Obj): HResult; +begin + Result := IUnknown(FController).QueryInterface(IID, Obj); +end; + +function TAggregatedObject._AddRef: Integer; +begin + Result := IUnknown(FController)._AddRef; +end; + +function TAggregatedObject._Release: Integer; stdcall; +begin + Result := IUnknown(FController)._Release; +end; + +//=== { TContainedObject } =================================================== + +function TContainedObject.QueryInterface(const IID: TGUID; out Obj): HResult; +begin + if GetInterface(IID, Obj) then Result := S_OK else Result := E_NOINTERFACE; +end; + +{$ENDIF ~RTL140_UP} + +// 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; + +function ISODayOfWeek(DateTime: TDateTime): Integer; +begin + Result := (DayOfWeek(DateTime - 2 + 7) mod 7) + 1; +end; + +function FirstWeekDayPrim(const Year, Month: Integer; var DOW: Integer): Integer; +begin + DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, 1)); + if DOW > 5 then + begin + Result := 9 - DOW; + DOW := 1; + end + else + Result := 1; +end; + +function LastWeekDayPrim(const Year, Month: Integer; var DOW: Integer): Integer; +begin + DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)))); + if DOW > 5 then + begin + Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - (DOW - 5); + DOW := 5; + end + else + Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)); +end; + +function FirstWeekendDayPrim(const Year, Month: Integer; var DOW: Integer): Integer; +begin + DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, 1)); + if DOW < 6 then + begin + Result := 7 - DOW; + DOW := 6; + end + else + Result := 1; +end; + +function LastWeekendDayPrim(const Year, Month: Integer; var DOW: Integer): Integer; +begin + DOW := ISODayOfWeek(JclDateTime.EncodeDate(Year, Month, DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)))); + if DOW < 6 then + begin + Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - DOW; + DOW := 7; + end + else + Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)); +end; + +function FirstWeekDay(const Year, Month: Integer): Integer; +var + Dummy: Integer; +begin + Result := FirstWeekDayPrim(Year, Month, Dummy); +end; + +function LastWeekDay(const Year, Month: Integer): Integer; +var + Dummy: Integer; +begin + Result := LastWeekDayPrim(Year, Month, Dummy); +end; + +function IndexedWeekDay(const Year, Month: Integer; Index: Integer): Integer; +var + DOW: Integer; +begin + if Index > 0 then + Result := FirstWeekDayPrim(Year, Month, DOW) + else + if Index < 0 then + Result := LastWeekDayPrim(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(JclDateTime.EncodeDate(Year, Month, 1))) then + Result := 0; +end; + +function FirstWeekendDay(const Year, Month: Integer): Integer; +var + Dummy: Integer; +begin + Result := FirstWeekendDayPrim(Year, Month, Dummy); +end; + +function LastWeekendDay(const Year, Month: Integer): Integer; +var + Dummy: Integer; +begin + Result := LastWeekendDayPrim(Year, Month, Dummy); +end; + +function IndexedWeekendDay(const Year, Month: Integer; Index: Integer): Integer; +var + DOW: Integer; +begin + if Index > 0 then + Result := FirstWeekendDayPrim(Year, Month, DOW) + else + if Index < 0 then + Result := LastWeekendDayPrim(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(JclDateTime.EncodeDate(Year, Month, 1))) then + Result := 0; +end; + +function FirstDayOfWeek(const Year, Month, DayOfWeek: Integer): Integer; +var + DOW: Integer; +begin + DOW := ISODayOfWeek(JclDateTime.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(JclDateTime.EncodeDate(Year, Month, DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)))); + if DOW > DayOfWeek then + Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - (DOW - DayOfWeek) + else + if DOW < DayOfWeek then + Result := DaysInMonth(JclDateTime.EncodeDate(Year, Month, 1)) - (7 + DayOfWeek - DOW) + else + Result := DaysInMonth(JclDateTime.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(JclDateTime.EncodeDate(Year, Month, 1))) then + Result := 0; +end; + +//=== { TScheduleAggregate } ================================================= + +type + TScheduleAggregate = 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 TScheduleAggregate.CheckInterfaceAllowed; +begin + if not InterfaceAllowed then + RunError(23); // reIntfCastError +end; + +function TScheduleAggregate.InterfaceAllowed: Boolean; +begin + Result := Schedule.RecurringType = RecurringType; +end; + +function TScheduleAggregate.Schedule: IJclSchedule; +begin + Result := Controller as IJclSchedule; +end; + +class function TScheduleAggregate.RecurringType: TScheduleRecurringKind; +begin + Result := srkOneShot; +end; + +//=== { TDailyFreq } ========================================================= + +type + TDailyFreq = class(TAggregatedObject) + 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 TDailyFreq.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FStartTime := 0; + FEndTime := HoursToMSecs(24) - 1; + FInterval := 500; +end; + +function TDailyFreq.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 TDailyFreq.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 TDailyFreq.GetStartTime: Cardinal; +begin + Result := FStartTime; +end; + +function TDailyFreq.GetEndTime: Cardinal; +begin + Result := FEndTime; +end; + +function TDailyFreq.GetInterval: Cardinal; +begin + Result := FInterval; +end; + +procedure TDailyFreq.SetStartTime(Value: Cardinal); +begin + if Value <> FStartTime then + begin + if Value >= Cardinal(HoursToMSecs(24)) then + raise ESchedule.CreateRes(@RsScheduleInvalidTime); + FStartTime := Value; + if EndTime < StartTime then + FEndTime := Value; + end; +end; + +procedure TDailyFreq.SetEndTime(Value: Cardinal); +begin + if Value <> FEndTime then + begin + if Value < FStartTime then + raise ESchedule.CreateRes(@RsScheduleEndBeforeStart); + if Value >= Cardinal(HoursToMSecs(24)) then + raise ESchedule.CreateRes(@RsScheduleInvalidTime); + FEndTime := Value; + end; +end; + +procedure TDailyFreq.SetInterval(Value: Cardinal); +begin + if Value <> FInterval then + begin + if Value >= Cardinal(HoursToMSecs(24)) then + raise ESchedule.CreateRes(@RsScheduleInvalidTime); + if Value = 0 then + begin + FEndTime := FStartTime; + FInterval := 1; + end + else + FInterval := Value; + end; +end; + +//=== { TDailySchedule } ===================================================== + +type + TDailySchedule = class(TScheduleAggregate) + 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 TDailySchedule.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FEveryWeekDay := True; + FInterval := 1; +end; + +class function TDailySchedule.RecurringType: TScheduleRecurringKind; +begin + Result := srkDaily; +end; + +function TDailySchedule.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 TDailySchedule.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 TDailySchedule.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 TDailySchedule.GetEveryWeekDay: Boolean; +begin + CheckInterfaceAllowed; + Result := FEveryWeekDay; +end; + +function TDailySchedule.GetInterval: Cardinal; +begin + CheckInterfaceAllowed; + if EveryWeekDay then + Result := 0 + else + Result := FInterval; +end; + +procedure TDailySchedule.SetEveryWeekDay(Value: Boolean); +begin + CheckInterfaceAllowed; + FEveryWeekDay := Value; +end; + +procedure TDailySchedule.SetInterval(Value: Cardinal); +begin + CheckInterfaceAllowed; + if Value = 0 then + raise ESchedule.CreateRes(@RsScheduleIntervalZero); + if FEveryWeekDay then + FEveryWeekDay := False; + if Value <> FInterval then + FInterval := Value; +end; + +//=== { TWeeklySchedule } ==================================================== + +type + TWeeklySchedule = class(TScheduleAggregate) + 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 TWeeklySchedule.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FDaysOfWeek := [swdMonday]; + FInterval := 1; +end; + +class function TWeeklySchedule.RecurringType: TScheduleRecurringKind; +begin + Result := srkWeekly; +end; + +function TWeeklySchedule.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 TWeeklySchedule.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 TWeeklySchedule.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 TWeeklySchedule.GetDaysOfWeek: TScheduleWeekDays; +begin + CheckInterfaceAllowed; + Result := FDaysOfWeek; +end; + +function TWeeklySchedule.GetInterval: Cardinal; +begin + CheckInterfaceAllowed; + Result := FInterval; +end; + +procedure TWeeklySchedule.SetDaysOfWeek(Value: TScheduleWeekDays); +begin + CheckInterfaceAllowed; + if Value = [] then + raise ESchedule.CreateRes(@RsScheduleNoDaySpecified); + FDaysOfWeek := Value; +end; + +procedure TWeeklySchedule.SetInterval(Value: Cardinal); +begin + CheckInterfaceAllowed; + if Value = 0 then + raise ESchedule.CreateRes(@RsScheduleIntervalZero); + FInterval := Value; +end; + +//=== { TMonthlySchedule } =================================================== + +type + TMonthlySchedule = class(TScheduleAggregate) + 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 TMonthlySchedule.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FIndexKind := sikNone; + FIndexValue := sivFirst; + FDay := 1; + FInterval := 1; +end; + +class function TMonthlySchedule.RecurringType: TScheduleRecurringKind; +begin + Result := srkMonthly; +end; + +function TMonthlySchedule.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 TMonthlySchedule.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 TMonthlySchedule.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 TMonthlySchedule.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 TMonthlySchedule.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 TMonthlySchedule.GetIndexKind: TScheduleIndexKind; +begin + CheckInterfaceAllowed; + Result := FIndexKind; +end; + +function TMonthlySchedule.GetIndexValue: Integer; +begin + CheckInterfaceAllowed; + if not (FIndexKind in [sikDay .. sikSunday]) then + raise ESchedule.CreateRes(@RsScheduleIndexValueSup); + Result := FIndexValue; +end; + +function TMonthlySchedule.GetDay: Cardinal; +begin + CheckInterfaceAllowed; + Result := FDay; +end; + +function TMonthlySchedule.GetInterval: Cardinal; +begin + CheckInterfaceAllowed; + Result := FInterval; +end; + +procedure TMonthlySchedule.SetIndexKind(Value: TScheduleIndexKind); +begin + CheckInterfaceAllowed; + FIndexKind := Value; +end; + +procedure TMonthlySchedule.SetIndexValue(Value: Integer); +begin + CheckInterfaceAllowed; + if not (FIndexKind in [sikDay .. sikSunday]) then + raise ESchedule.CreateRes(@RsScheduleIndexValueSup); + if Value = 0 then + raise ESchedule.CreateRes(@RsScheduleIndexValueZero); + FIndexValue := Value; +end; + +procedure TMonthlySchedule.SetDay(Value: Cardinal); +begin + CheckInterfaceAllowed; + if not (FIndexKind in [sikNone]) then + raise ESchedule.CreateRes(@RsScheduleDayNotSupported); + if (Value = 0) or (Value > 31) then + raise ESchedule.CreateRes(@RsScheduleDayInRange); + FDay := Value; +end; + +procedure TMonthlySchedule.SetInterval(Value: Cardinal); +begin + CheckInterfaceAllowed; + if Value = 0 then + raise ESchedule.CreateRes(@RsScheduleIntervalZero); + FInterval := Value; +end; + +//=== { TYearlySchedule } ==================================================== + +type + TYearlySchedule = class(TMonthlySchedule) + 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 TYearlySchedule.Create(const Controller: IUnknown); +begin + inherited Create(Controller); + FMonth := 1; +end; + +class function TYearlySchedule.RecurringType: TScheduleRecurringKind; +begin + Result := srkYearly; +end; + +function TYearlySchedule.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 TYearlySchedule.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 TYearlySchedule.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 TYearlySchedule.GetMonth: Cardinal; +begin + CheckInterfaceAllowed; + Result := FMonth; +end; + +procedure TYearlySchedule.SetMonth(Value: Cardinal); +begin + CheckInterfaceAllowed; + if (Value < 1) or (Value > 12) then + raise ESchedule.CreateRes(@RsScheduleMonthInRange); + FMonth := Value; +end; + +//=== { TSchedule } ========================================================== + +type + TSchedule = class(TInterfacedObject, IJclSchedule, IJclScheduleDayFrequency, IJclDailySchedule, + IJclWeeklySchedule, IJclMonthlySchedule, IJclYearlySchedule) + private + FStartDate: TTimeStamp; + FRecurringType: TScheduleRecurringKind; + FEndType: TScheduleEndKind; + FEndDate: TTimeStamp; + FEndCount: Cardinal; + FDailyFreq: TDailyFreq; + FDailySchedule: TDailySchedule; + FWeeklySchedule: TWeeklySchedule; + FMonthlySchedule: TMonthlySchedule; + FYearlySchedule: TYearlySchedule; + protected + FTriggerCount: Cardinal; + FDayCount: Cardinal; + FLastEvent: TTimeStamp; + + function GetNextEventStamp(const From: TTimeStamp): TTimeStamp; + + property DailyFreq: TDailyFreq read FDailyFreq implements IJclScheduleDayFrequency; + property DailySchedule: TDailySchedule read FDailySchedule implements IJclDailySchedule; + property WeeklySchedule: TWeeklySchedule read FWeeklySchedule implements IJclWeeklySchedule; + property MonthlySchedule: TMonthlySchedule read FMonthlySchedule implements IJclMonthlySchedule; + property YearlySchedule: TYearlySchedule read FYearlySchedule implements IJclYearlySchedule; + 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; + end; + +constructor TSchedule.Create; +var + InitialStamp: TTimeStamp; +begin + inherited Create; + FDailyFreq := TDailyFreq.Create(Self); + FDailySchedule := TDailySchedule.Create(Self); + FWeeklySchedule := TWeeklySchedule.Create(Self); + FMonthlySchedule := TMonthlySchedule.Create(Self); + FYearlySchedule := TYearlySchedule.Create(Self); + InitialStamp := DateTimeToTimeStamp(Now); + InitialStamp.Time := 1000 * (InitialStamp.Time div 1000); // strip of milliseconds + StartDate := InitialStamp; + EndType := sekNone; + RecurringType := srkOneShot; +end; + +destructor TSchedule.Destroy; +begin + FreeAndNil(FYearlySchedule); + FreeAndNil(FMonthlySchedule); + FreeAndNil(FWeeklySchedule); + FreeAndNil(FDailySchedule); + FreeAndNil(FDailyFreq); + inherited Destroy; +end; + +function TSchedule.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 := DailyFreq.NextValidStamp(UseFrom); + if IsNullTimeStamp(Result) then + begin + Result.Date := UseFrom.Date; + Result.Time := DailyFreq.StartTime; + Result := DailySchedule.NextValidStamp(Result); + end + else + DailySchedule.MakeValidStamp(Result); + end; + srkWeekly: + begin + Result := DailyFreq.NextValidStamp(UseFrom); + if IsNullTimeStamp(Result) then + begin + Result.Date := UseFrom.Date; + Result.Time := DailyFreq.StartTime; + Result := WeeklySchedule.NextValidStamp(Result); + end + else + WeeklySchedule.MakeValidStamp(Result); + end; + srkMonthly: + begin + Result := DailyFreq.NextValidStamp(UseFrom); + if IsNullTimeStamp(Result) then + begin + Result.Date := UseFrom.Date; + Result.Time := DailyFreq.StartTime; + Result := MonthlySchedule.NextValidStamp(Result); + end + else + MonthlySchedule.MakeValidStamp(Result); + end; + srkYearly: + begin + Result := DailyFreq.NextValidStamp(UseFrom); + if IsNullTimeStamp(Result) then + begin + Result.Date := UseFrom.Date; + Result.Time := DailyFreq.StartTime; + Result := YearlySchedule.NextValidStamp(Result); + end + else + YearlySchedule.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 TSchedule.GetStartDate: TTimeStamp; +begin + Result := FStartDate; +end; + +function TSchedule.GetRecurringType: TScheduleRecurringKind; +begin + Result := FRecurringType; +end; + +function TSchedule.GetEndType: TScheduleEndKind; +begin + Result := FEndType; +end; + +function TSchedule.GetEndDate: TTimeStamp; +begin + Result := FEndDate; +end; + +function TSchedule.GetEndCount: Cardinal; +begin + Result := FEndCount; +end; + +procedure TSchedule.SetStartDate(const Value: TTimeStamp); +begin + FStartDate := Value; +end; + +procedure TSchedule.SetRecurringType(Value: TScheduleRecurringKind); +begin + FRecurringType := Value; +end; + +procedure TSchedule.SetEndType(Value: TScheduleEndKind); +begin + FEndType := Value; +end; + +procedure TSchedule.SetEndDate(const Value: TTimeStamp); +begin + FEndDate := Value; +end; + +procedure TSchedule.SetEndCount(Value: Cardinal); +begin + FEndCount := Value; +end; + +function TSchedule.TriggerCount: Cardinal; +begin + Result := FTriggerCount; +end; + +function TSchedule.DayCount: Cardinal; +begin + Result := FDayCount; +end; + +function TSchedule.LastTriggered: TTimeStamp; +begin + Result := FLastEvent; +end; + +procedure TSchedule.InitToSavedState(const LastTriggerStamp: TTimeStamp; const LastTriggerCount, + LastDayCount: Cardinal); +begin + FLastEvent := LastTriggerStamp; + FTriggerCount := LastTriggerCount; + FDayCount := LastDayCount; +end; + +procedure TSchedule.Reset; +begin + FLastEvent := NullStamp; + FTriggerCount := 0; + FDayCount := 0; +end; + +function TSchedule.NextEvent(CountMissedEvents: Boolean = False): TTimeStamp; +begin + Result := NextEventFrom(FLastEvent, CountMissedEvents); +end; + +function TSchedule.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 TSchedule.NextEventFromNow(CountMissedEvents: Boolean = False): TTimeStamp; +begin + Result := NextEventFrom(DateTimeToTimeStamp(Now), CountMissedEvents); +end; + +function CreateSchedule: IJclSchedule; +begin + Result := TSchedule.Create; +end; + +// History: + +// $Log: JclSchedule.pas,v $ +// Revision 1.13 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.12 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.11 2004/10/17 22:30:27 mthoma +// file header update +// +// Revision 1.10 2004/10/12 18:29:52 rrossmair +// cleanup +// +// Revision 1.9 2004/08/01 05:52:12 marquardt +// move constructors/destructors +// +// Revision 1.8 2004/07/28 18:00:51 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.7 2004/06/16 07:30:28 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.6 2004/06/14 06:24:52 marquardt +// style cleaning IFDEF +// +// Revision 1.5 2004/05/05 00:09:59 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// + +end. diff --git a/official/1.96/source/common/JclStacks.pas b/official/1.96/source/common/JclStacks.pas new file mode 100644 index 0000000..8ea0216 --- /dev/null +++ b/official/1.96/source/common/JclStacks.pas @@ -0,0 +1,360 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/02/27 11:36:20 $ +// For history see end of file + +unit JclStacks; + +{$I jcl.inc} + +interface + +uses + JclBase, JclAbstractContainers, JclContainerIntf; + +type + TJclIntfStack = class(TJclAbstractContainer, IJclIntfStack) + private + FElements: TDynIInterfaceArray; + FCount: Integer; + FCapacity: Integer; + protected + procedure Grow; virtual; + { IJclIntfStack } + function Contains(AInterface: IInterface): Boolean; + function Empty: Boolean; + function Pop: IInterface; + procedure Push(AInterface: IInterface); + function Size: Integer; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + end; + + TJclStrStack = class(TJclAbstractContainer, IJclStrStack) + private + FElements: TDynStringArray; + FCount: Integer; + FCapacity: Integer; + protected + procedure Grow; virtual; + { IJclStrStack } + function Contains(const AString: string): Boolean; + function Empty: Boolean; + function Pop: string; + procedure Push(const AString: string); + function Size: Integer; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + end; + + TJclStack = class(TJclAbstractContainer, IJclStack) + private + FElements: TDynObjectArray; + FCount: Integer; + FCapacity: Integer; + protected + procedure Grow; virtual; + { IJclStack } + function Contains(AObject: TObject): Boolean; + function Empty: Boolean; + function Pop: TObject; + procedure Push(AObject: TObject); + function Size: Integer; + public + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + end; + +implementation + +//=== { TJclIntfStack } ====================================================== + +constructor TJclIntfStack.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FCount := 0; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FElements, FCapacity); +end; + +function TJclIntfStack.Contains(AInterface: IInterface): Boolean; +var + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AInterface = nil then + Exit; + for I := 0 to FCount - 1 do + if FElements[I] = AInterface then + begin + Result := True; + Break; + end; +end; + +function TJclIntfStack.Empty: Boolean; +begin + Result := FCount = 0; +end; + +procedure TJclIntfStack.Grow; +begin + if FCapacity > 64 then + FCapacity := FCapacity + FCapacity div 4 + else + FCapacity := FCapacity * 4; + SetLength(FElements, FCapacity); +end; + +function TJclIntfStack.Pop: IInterface; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if FCount = 0 then + Exit; + Dec(FCount); + Result := FElements[FCount]; +end; + +procedure TJclIntfStack.Push(AInterface: IInterface); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if AInterface = nil then + Exit; + if FCount = FCapacity then + Grow; + FElements[FCount] := AInterface; + Inc(FCount); +end; + +function TJclIntfStack.Size: Integer; +begin + Result := FCount; +end; + +//=== { TJclStrStack } ======================================================= + +constructor TJclStrStack.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FCount := 0; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FElements, FCapacity); +end; + +function TJclStrStack.Contains(const AString: string): Boolean; +var + I: Integer; +{$IFDEF THREADSAFE} + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AString = '' then + Exit; + for I := 0 to FCount - 1 do + if FElements[I] = AString then + begin + Result := True; + Exit; + end; +end; + +function TJclStrStack.Empty: Boolean; +begin + Result := FCount = 0; +end; + +procedure TJclStrStack.Grow; +begin + if FCapacity > 64 then + FCapacity := FCapacity + FCapacity div 4 + else + FCapacity := FCapacity * 4; + SetLength(FElements, FCapacity); +end; + +function TJclStrStack.Pop: string; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if FCount = 0 then + Exit; + Dec(FCount); + Result := FElements[FCount]; +end; + +procedure TJclStrStack.Push(const AString: string); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if AString = '' then + Exit; + if FCount = FCapacity then + Grow; + FElements[FCount] := AString; + Inc(FCount); +end; + +function TJclStrStack.Size: Integer; +begin + Result := FCount; +end; + +//=== { TJclStack } ========================================================== + +constructor TJclStack.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FCount := 0; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FElements, FCapacity); +end; + +function TJclStack.Contains(AObject: TObject): Boolean; +var + I: Integer; + {$IFDEF THREADSAFE} + CS: IInterface; + {$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := False; + if AObject = nil then + Exit; + for I := 0 to FCount - 1 do + if FElements[I] = AObject then + begin + Result := True; + Break; + end; +end; + +function TJclStack.Empty: Boolean; +begin + Result := FCount = 0; +end; + +procedure TJclStack.Grow; +begin + if FCapacity > 64 then + FCapacity := FCapacity + FCapacity div 4 + else + FCapacity := FCapacity * 4; + SetLength(FElements, FCapacity); +end; + +function TJclStack.Pop: TObject; +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + Result := nil; + if FCount = 0 then + Exit; + Dec(FCount); + Result := FElements[FCount]; +end; + +procedure TJclStack.Push(AObject: TObject); +{$IFDEF THREADSAFE} +var + CS: IInterface; +{$ENDIF THREADSAFE} +begin + {$IFDEF THREADSAFE} + CS := EnterCriticalSection; + {$ENDIF THREADSAFE} + if AObject = nil then + Exit; + if FCount = FCapacity then + Grow; + FElements[FCount] := AObject; + Inc(FCount); +end; + +function TJclStack.Size: Integer; +begin + Result := FCount; +end; + +// History: + +// $Log: JclStacks.pas,v $ +// Revision 1.3 2005/02/27 11:36:20 marquardt +// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec +// +// Revision 1.2 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. diff --git a/official/1.96/source/common/JclStatistics.pas b/official/1.96/source/common/JclStatistics.pas new file mode 100644 index 0000000..6f768ea --- /dev/null +++ b/official/1.96/source/common/JclStatistics.pas @@ -0,0 +1,550 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/05/05 20:08:44 $ +// For history see end of file + +{ TODO : Test cases! } + +unit JclStatistics; + +{$I jcl.inc} + +interface + +uses + 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; +{$IFNDEF CLR} +function MedianUnsorted(const X: TDynFloatArray): Float; +{$ENDIF ~CLR} +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; + +implementation + +uses + JclLogic, + {$IFNDEF CLR} + JclSysUtils, + {$ENDIF ~CLR} + 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 + {$IFDEF CLR} + raise EJclMathError.Create(RsEmptyArray); + {$ELSE} + raise EJclMathError.CreateRes(@RsEmptyArray); + {$ENDIF CLR} +end; + +procedure InvalidSampleSize(SampleSize: Integer); +begin + {$IFDEF CLR} + raise EJclStatisticsError.CreateFmt(RsInvalidSampleSize, [SampleSize]); + {$ELSE} + raise EJclStatisticsError.CreateResFmt(@RsInvalidSampleSize, [SampleSize]); + {$ENDIF CLR} +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 + {$IFDEF CLR} + raise EJclMathError.Create(RsNonPositiveArray); + {$ELSE} + raise EJclMathError.CreateRes(@RsNonPositiveArray); + {$ENDIF CLR} + 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 + {$IFDEF CLR} + raise EJclMathError.Create(RsNonPositiveArray); + {$ELSE} + raise EJclMathError.CreateRes(@RsNonPositiveArray); + {$ENDIF CLR} + 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; + +{$IFNDEF CLR} +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; +{$ENDIF ~CLR} + +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; + +// History: + +// $Log: JclStatistics.pas,v $ +// Revision 1.16 2005/05/05 20:08:44 ahuser +// JCL.NET support +// +// Revision 1.15 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.14 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.13 2004/12/17 05:33:02 marquardt +// updates for DCL +// +// Revision 1.12 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.11 2004/09/16 19:47:32 rrossmair +// check-in in preparation for release 1.92 +// +// Revision 1.10 2004/08/18 19:06:15 rrossmair +// - got rid of warning +// - renamed local variables "L" to "N" (as commonly used to denote sample size) +// +// Revision 1.9 2004/08/18 17:08:59 rrossmair +// - mantis #2019 & #2021 handled, improved error reports +// +// Revision 1.8 2004/07/29 15:16:51 marquardt +// simple style cleaning +// +// Revision 1.7 2004/05/05 07:18:31 rrossmair +// MedianUnsorted: type cast for FPC compatibility +// +// Revision 1.6 2004/05/05 00:09:59 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.5 2004/04/08 17:14:46 mthoma +// no message +// +// Revision 1.4 2004/04/08 16:57:21 mthoma +// Fixed #1268. Introduced new function MedianUnsorted +// +// Revision 1.3 2004/04/06 04:53:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/common/JclStrHashMap.pas b/official/1.96/source/common/JclStrHashMap.pas new file mode 100644 index 0000000..6bbbb7e --- /dev/null +++ b/official/1.96/source/common/JclStrHashMap.pas @@ -0,0 +1,902 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/08/09 10:30:21 $ +// For history see end of file + +unit JclStrHashMap; + +{$I jcl.inc} + +interface + +uses + SysUtils, + 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 + {$IFDEF CLR} + PUserData = TObject; + PData = TObject; + + TIterateFunc = function(AUserData: PUserData; const AStr: string; var APtr): Boolean; + TIterateMethod = function(AUserData: PUserData; const AStr: string; var APtr): Boolean of object; + {$ELSE} + 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; + {$ENDIF CLR} + + {$IFDEF CLR} + THashNode = class; + PHashNode = THashNode; + PPHashNode = PHashNode; + THashNode = class + Str: string; + Ptr: TObject; + Left: PHashNode; + Right: PHashNode; + end; + + { Internal iterate function pointer type used by the protected + TStringHashMap.NodeIterate method. } + TNodeIterateFunc = procedure(AUserData: TObject; ANode: PPHashNode); + + THashArray = array of PHashNode; + PHashArray = THashArray; + {$ELSE} + 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; + {$ENDIF CLR} + + + 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 StrHash(const S: string): THashValue; +function TextHash(const S: string): THashValue; +function DataHash(var AValue; ASize: Cardinal): THashValue; +function Iterate_FreeObjects(AUserData: PUserData; const AStr: string; var AData {$IFNDEF CLR}: PData{$ENDIF}): Boolean; +function Iterate_Dispose(AUserData: PUserData; const AStr: string; var AData {$IFNDEF CLR}: PData{$ENDIF}): Boolean; +function Iterate_FreeMem(AUserData: PUserData; const AStr: string; var AData {$IFNDEF CLR}: PData{$ENDIF}): 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; + +implementation + +// 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 := StrHash(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 := TextHash(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 {$IFNDEF CLR}: PData{$ENDIF}): Boolean; +begin + TObject(AData).Free; + AData := nil; + Result := True; +end; + +function Iterate_Dispose(AUserData: PUserData; const AStr: string; var AData {$IFNDEF CLR}: PData{$ENDIF}): Boolean; +begin + {$IFDEF CLR} + TObject(AData).Free; + {$ELSE} + Dispose(AData); + {$ENDIF CLR} + AData := nil; + Result := True; +end; + +function Iterate_FreeMem(AUserData: PUserData; const AStr: string; var AData {$IFNDEF CLR}: PData{$ENDIF}): Boolean; +begin + {$IFDEF CLR} + TObject(AData).Free; + {$ELSE} + FreeMem(AData); + {$ENDIF CLR} + AData := nil; + Result := True; +end; + +function StrHash(const S: string): Cardinal; +{$IFDEF CLR} +begin + Result := 0; + if S <> nil then + Result := S.GetHashCode +end; +{$ELSE} +const + cLongBits = 32; + cOneEight = 4; + cThreeFourths = 24; + cHighBits = $F0000000; +var + I: Integer; + P: PChar; + Temp: Cardinal; +begin + { TODO : I should really be processing 4 bytes at once... } + Result := 0; + P := PChar(S); + + I := Length(S); + while I > 0 do + begin + Result := (Result shl cOneEight) + Ord(P^); + Temp := Result and cHighBits; + if Temp <> 0 then + Result := (Result xor (Temp shr cThreeFourths)) and (not cHighBits); + Dec(I); + Inc(P); + end; +end; +{$ENDIF CLR} + +function TextHash(const S: string): Cardinal; +{$IFDEF CLR} +begin + Result := 0; + if S <> nil then + Result := S.GetHashCode +end; +{$ELSE} +const + cLongBits = 32; + cOneEight = 4; + cThreeFourths = 24; + cHighBits = $F0000000; +var + I: Integer; + P: PChar; + Temp: Cardinal; +begin + { TODO : I should really be processing 4 bytes at once... } + Result := 0; + P := PChar(S); + + I := Length(S); + while I > 0 do + begin + Result := (Result shl cOneEight) + Ord(UpCase(P^)); + Temp := Result and cHighBits; + if Temp <> 0 then + Result := (Result xor (Temp shr cThreeFourths)) and (not cHighBits); + Dec(I); + Inc(P); + end; +end; +{$ENDIF CLR} + +function DataHash(var AValue; ASize: Cardinal): THashValue; +{$IFDEF CLR} +begin + Result := 0; + if TObject(AValue) <> nil then + Result := TObject(AValue).GetHashCode +end; +{$ELSE} +const + cLongBits = 32; + cOneEight = 4; + cThreeFourths = 24; + cHighBits = $F0000000; +var + P: PChar; + Temp: Cardinal; +begin + { TODO : I should really be processing 4 bytes at once... } + Result := 0; + P := @AValue; + + while ASize > 0 do + begin + Result := (Result shl cOneEight) + Ord(P^); + Temp := Result and cHighBits; + if Temp <> 0 then + Result := (Result xor (Temp shr cThreeFourths)) and (not cHighBits); + Dec(ASize); + Inc(P); + end; +end; +{$ENDIF CLR} + +//=== { TStringHashMap } ===================================================== + +constructor TStringHashMap.Create(ATraits: TStringHashMapTraits; AHashSize: Cardinal); +begin + inherited Create; + {$IFDEF CLR} + Assert(ATraits <> nil, RsStringHashMapNoTraits); + {$ELSE} + Assert(ATraits <> nil, LoadResString(@RsStringHashMapNoTraits)); + {$ENDIF CLR} + SetHashSize(AHashSize); + FTraits := ATraits; +end; + +destructor TStringHashMap.Destroy; +begin + Clear; + SetHashSize(0); + inherited Destroy; +end; + +type + {$IFDEF CLR} + TCollectNodeNode = class; + PCollectNodeNode = TCollectNodeNode; + TCollectNodeNode = class + Next: PCollectNodeNode; + Str: string; + Ptr: TObject; + end; + {$ELSE} + PPCollectNodeNode = ^PCollectNodeNode; + PCollectNodeNode = ^TCollectNodeNode; + TCollectNodeNode = record + Next: PCollectNodeNode; + Str: string; + Ptr: Pointer; + end; + {$ENDIF CLR} + + +{$IFNDEF CLR} +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; +{$ENDIF ~CLR} + +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 + +finalization + FreeAndNil(GlobalCaseInsensitiveTraits); + FreeAndNil(GlobalCaseSensitiveTraits); + +// History: + +// $Log: JclStrHashMap.pas,v $ +// Revision 1.15 2005/08/09 10:30:21 ahuser +// JCL.NET changes +// +// Revision 1.14 2005/05/05 20:08:44 ahuser +// JCL.NET support +// +// Revision 1.13 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.12 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.11 2004/10/13 06:58:20 marquardt +// normal style cleaning +// +// Revision 1.10 2004/10/12 18:29:52 rrossmair +// cleanup +// +// Revision 1.9 2004/09/16 19:47:32 rrossmair +// check-in in preparation for release 1.92 +// +// Revision 1.8 2004/08/03 07:22:37 marquardt +// resourcestring cleanup +// +// Revision 1.7 2004/07/31 06:21:01 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.6 2004/07/28 18:00:51 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.5 2004/05/18 18:58:04 rrossmair +// documentation extracted to StrHashMap.dtx +// +// Revision 1.4 2004/05/05 00:11:24 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// + +end. + diff --git a/official/1.96/source/common/JclStrings.pas b/official/1.96/source/common/JclStrings.pas new file mode 100644 index 0000000..15b28b5 --- /dev/null +++ b/official/1.96/source/common/JclStrings.pas @@ -0,0 +1,4345 @@ +{**************************************************************************************************} +{ } +{ 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 } +{ Anthony Steele } +{ Azret Botash } +{ Barry Kelly } +{ Huanlin Tsai } +{ Jack N.A. Bakker } +{ Jean-Fabien Connault } +{ John C Molyneux } +{ Leonard Wennekers } +{ Martin Kimmings } +{ Martin Kubecka } +{ Massimo Maria Ghisalberti } +{ Matthias Thoma (mthoma) } +{ Michael Winter } +{ Nick Hodges } +{ Olivier Sannier } +{ Pelle F. S. Liljendal } +{ Petr Vones } +{ Rik Barker (rikbarker) } +{ Robert Lee } +{ Robert Marquardt } +{ Robert Rossmair (rrossmair) } +{ } +{**************************************************************************************************} +{ } +{ Various character and string routines (searching, testing and transforming) } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2006/01/15 19:10:44 $ +// For history see end of file + +unit JclStrings; + +{$I jcl.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + {$IFDEF CLR} + System.Text, + {$ELSE} + JclWideStrings, + {$ENDIF CLR} + JclBase; + +// Character constants and sets + +const + // Misc. often used character definitions + AnsiNull = Char(#0); + AnsiSoh = Char(#1); + AnsiStx = Char(#2); + AnsiEtx = Char(#3); + AnsiEot = Char(#4); + AnsiEnq = Char(#5); + AnsiAck = Char(#6); + AnsiBell = Char(#7); + AnsiBackspace = Char(#8); + AnsiTab = Char(#9); + AnsiLineFeed = JclBase.AnsiLineFeed; + AnsiVerticalTab = Char(#11); + AnsiFormFeed = Char(#12); + AnsiCarriageReturn = JclBase.AnsiCarriageReturn; + AnsiCrLf = JclBase.AnsiCrLf; + AnsiSo = Char(#14); + AnsiSi = Char(#15); + AnsiDle = Char(#16); + AnsiDc1 = Char(#17); + AnsiDc2 = Char(#18); + AnsiDc3 = Char(#19); + AnsiDc4 = Char(#20); + AnsiNak = Char(#21); + AnsiSyn = Char(#22); + AnsiEtb = Char(#23); + AnsiCan = Char(#24); + AnsiEm = Char(#25); + AnsiEndOfFile = Char(#26); + AnsiEscape = Char(#27); + AnsiFs = Char(#28); + AnsiGs = Char(#29); + AnsiRs = Char(#30); + AnsiUs = Char(#31); + AnsiSpace = Char(' '); + AnsiComma = Char(','); + AnsiBackslash = Char('\'); + AnsiForwardSlash = Char('/'); + + AnsiDoubleQuote = Char('"'); + AnsiSingleQuote = Char(''''); + + AnsiLineBreak = JclBase.AnsiLineBreak; + +// Misc. character sets + + AnsiWhiteSpace = [AnsiTab, AnsiLineFeed, AnsiVerticalTab, + AnsiFormFeed, AnsiCarriageReturn, AnsiSpace]; + AnsiSigns = ['-', '+']; + AnsiUppercaseLetters = JclBase.AnsiUppercaseLetters; + AnsiLowercaseLetters = JclBase.AnsiLowercaseLetters; + AnsiLetters = JclBase.AnsiLetters; + AnsiDecDigits = JclBase.AnsiDecDigits; + AnsiOctDigits = JclBase.AnsiOctDigits; + AnsiHexDigits = JclBase.AnsiHexDigits; + AnsiValidIdentifierLetters = JclBase.AnsiValidIdentifierLetters; + +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: string): Boolean; +function StrIsAlphaNum(const S: string): Boolean; +function StrIsAlphaNumUnderscore(const S: string): Boolean; +function StrContainsChars(const S: string; Chars: TSysCharSet; CheckAll: Boolean): Boolean; +function StrConsistsOfNumberChars(const S: string): Boolean; +function StrIsDigit(const S: string): Boolean; +function StrIsSubset(const S: string; const ValidChars: TSysCharSet): Boolean; +function StrSame(const S1, S2: string): Boolean; + +// String Transformation Routines +function StrCenter(const S: string; L: Integer; C: Char = ' '): string; +function StrCharPosLower(const S: string; CharPos: Integer): string; +function StrCharPosUpper(const S: string; CharPos: Integer): 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); +{$IFNDEF CLR} +procedure StrLowerBuff(S: PChar); +{$ENDIF ~CLR} +procedure StrMove(var Dest: string; const Source: string; const ToIndex, + FromIndex, Count: Integer); +function StrPadLeft(const S: string; Len: Integer; C: Char = AnsiSpace ): string; +function StrPadRight(const S: string; Len: Integer; C: Char = AnsiSpace ): string; +function StrProper(const S: string): string; +{$IFNDEF CLR} +procedure StrProperBuff(S: PChar); +{$ENDIF ~CLR} +function StrQuote(const S: string; C: Char): string; +function StrRemoveChars(const S: string; const Chars: TSysCharSet): string; +function StrKeepChars(const S: string; const Chars: TSysCharSet): string; +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: TSysCharSet; Replace: Char): string; +function StrReplaceButChars(const S: string; const Chars: TSysCharSet; Replace: Char): string; +function StrRepeat(const S: string; Count: Integer): string; +function StrRepeatLength(const S: string; L: Integer): string; +function StrReverse(const S: string): string; +procedure StrReverseInPlace(var S: string); +function StrSingleQuote(const S: string): string; +function StrSmartCase(const S: string; Delimiters: TSysCharSet): string; +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: TSysCharSet): string; +function StrTrimCharRight(const S: string; C: Char): string; +function StrTrimCharsRight(const S: string; const Chars: TSysCharSet): string; +function StrTrimQuotes(const S: string): string; +function StrUpper(const S: string): string; +procedure StrUpperInPlace(var S: string); +{$IFNDEF CLR} +procedure StrUpperBuff(S: PChar); +{$ENDIF ~CLR} +{$IFDEF WIN32} +function StrOemToAnsi(const S: string): string; +function StrAnsiToOem(const S: string): string; +{$ENDIF WIN32} + +{$IFNDEF CLR} +// String Management +procedure StrAddRef(var S: string); +function StrAllocSize(const S: string): Longint; +procedure StrDecRef(var S: string); +function StrLen(S: PChar): Integer; +function StrLength(const S: string): Longint; +function StrRefCount(const S: string): Longint; +{$ENDIF ~CLR} +procedure StrResetLength(var S: string); overload; +{$IFDEF CLR} +procedure StrResetLength(S: StringBuilder); overload; +{$ENDIF CLR} + +// String Search and Replace Routines +function StrCharCount(const S: string; C: Char): Integer; +function StrCharsCount(const S: string; Chars: TSysCharSet): Integer; +function StrStrCount(const S, SubS: string): Integer; +function StrCompare(const S1, S2: string): Integer; +function StrCompareRange(const S1, S2: string; const Index, Count: Integer): Integer; +function StrFillChar(const C: Char; Count: Integer): string; +function StrFind(const Substr, S: string; const Index: Integer = 1): Integer; +function StrHasPrefix(const S: string; const Prefixes: array of string): Boolean; +function StrIndex(const S: string; const List: array of string): Integer; +function StrILastPos(const SubStr, S: string): Integer; +function StrIPos(const SubStr, S: string): Integer; +function StrIsOneOf(const S: string; const List: array of string): Boolean; +function StrLastPos(const SubStr, S: string): Integer; +function StrMatch(const Substr, S: string; const Index: Integer = 1): Integer; +function StrMatches(const Substr, S: string; const Index: Integer = 1): Boolean; +function StrNIPos(const S, SubStr: string; N: Integer): Integer; +function StrNPos(const S, SubStr: string; N: Integer): Integer; +function StrPrefixIndex(const S: string; const Prefixes: array of string): Integer; +function StrSearch(const Substr, S: string; const Index: Integer = 1): Integer; + +// String Extraction +function StrAfter(const SubStr, S: string): string; +function StrBefore(const SubStr, S: string): string; +function StrBetween(const S: string; const Start, Stop: Char): string; +function StrChopRight(const S: string; N: Integer): string; +function StrLeft(const S: string; Count: Integer): string; +function StrMid(const S: string; Start, Count: Integer): string; +function StrRestOf(const S: string; N: Integer): string; +function StrRight(const S: string; Count: Integer): string; + +// Character Test Routines +function CharEqualNoCase(const C1, C2: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsAlpha(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsAlphaNum(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsBlank(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsControl(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsDelete(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsDigit(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsLower(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsNumberChar(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsPrintable(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsPunctuation(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsReturn(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsSpace(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsUpper(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +function CharIsWhiteSpace(const C: Char): Boolean; {$IFDEF CLR} inline; {$ENDIF} +{$IFNDEF CLR} +function CharType(const C: Char): Word; +{$ENDIF ~CLR} + +// Character Transformation Routines +function CharHex(const C: Char): Byte; +function CharLower(const C: Char): Char; {$IFDEF CLR} inline; {$ENDIF} +function CharUpper(const C: Char): Char; {$IFDEF CLR} inline; {$ENDIF} +function CharToggleCase(const C: Char): Char; + +// Character Search and Replace +function CharPos(const S: string; const C: Char; const Index: Integer = 1): Integer; +function CharLastPos(const S: string; const C: Char; const Index: Integer = 1): Integer; +function CharIPos(const S: string; C: Char; const Index: Integer = 1 ): Integer; +function CharReplace(var S: string; const Search, Replace: Char): Integer; + +{$IFNDEF CLR} +// PCharVector +type + PCharVector = ^PChar; + +function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector; +function PCharVectorCount(Source: PCharVector): Integer; +procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector); +procedure FreePCharVector(var Dest: PCharVector); + +// MultiSz Routines +type + PMultiSz = PChar; + PWideMultiSz = PWideChar; + +function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz; +procedure MultiSzToStrings(const Dest: TStrings; const Source: PMultiSz); +function MultiSzLength(const Source: PMultiSz): Integer; +procedure AllocateMultiSz(var Dest: PMultiSz; Len: Integer); +procedure FreeMultiSz(var Dest: PMultiSz); +function MultiSzDup(const Source: PMultiSz): PMultiSz; + +function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): PWideMultiSz; +procedure WideMultiSzToWideStrings(const Dest: TWideStrings; const Source: PWideMultiSz); +function WideMultiSzLength(const Source: PWideMultiSz): Integer; +procedure AllocateWideMultiSz(var Dest: PWideMultiSz; Len: Integer); +procedure FreeWideMultiSz(var Dest: PWideMultiSz); +function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz; +{$ENDIF ~CLR} + +// 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; +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 +function BooleanToStr(B: Boolean): string; +function FileToString(const FileName: string): AnsiString; +procedure StringToFile(const FileName: string; const Contents: AnsiString); +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); +{$IFDEF CLR} +function StrWord(const S: string; var Index: Integer; out Word: string): Boolean; +{$ELSE} +function StrWord(var S: PChar; out Word: string): Boolean; +{$ENDIF CLR} +function StrToFloatSafe(const S: string): Float; +function StrToIntSafe(const S: string): Integer; +procedure StrNormIndex(const StrLen: Integer; var Index: Integer; var Count: Integer); overload; + +{$IFDEF CLR} +function ArrayOf(List: TStrings): TDynStringArray; overload; +{$ENDIF CLR} + +{$IFDEF COMPILER5} // missing Delphi 5 functions +function TryStrToInt(const S: string; out Value: Integer): Boolean; +function TryStrToInt64(const S: string; out Value: Int64): Boolean; +function TryStrToFloat(const S: string; out Value: Extended): Boolean; overload; +function TryStrToFloat(const S: string; out Value: Double): Boolean; overload; +function TryStrToFloat(const S: string; out Value: Single): Boolean; overload; +function TryStrToCurr(const S: string; out Value: Currency): Boolean; +{$ENDIF COMPILER5} + +// Exceptions +type + EJclStringError = EJclError; + +implementation + +uses + {$IFDEF CLR} + System.Globalization, + {$ENDIF CLR} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + JclLogic, JclResources; + +//=== Internal =============================================================== + +{$IFNDEF CLR} +type + TAnsiStrRec = packed record + AllocSize: Longint; + RefCount: Longint; + Length: Longint; + end; + +const + AnsiStrRecSize = SizeOf(TAnsiStrRec); // size of the string header rec + AnsiCharCount = Ord(High(Char)) + 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 + AnsiAlOffset = 12; // offset to AllocSize in StrRec + AnsiRfOffset = 8; // offset to RefCount in StrRec + AnsiLnOffset = 4; // offset to Length in StrRec + AnsiCaseMapSize = AnsiCharCount * 3; // # of chars is a table + +var + AnsiCaseMap: array [0..AnsiCaseMapSize - 1] of Char; // case mappings + AnsiCaseMapReady: Boolean = False; // true if case map exists + AnsiCharTypes: array [Char] of Word; + +procedure LoadCharTypes; +var + CurrChar: Char; + CurrType: Word; + {$IFDEF CLR} + Category: System.Globalization.UnicodeCategory; + {$ENDIF CLR} +begin + for CurrChar := Low(Char) to High(Char) do + begin + {$IFDEF MSWINDOWS} + GetStringTypeExA(LOCALE_USER_DEFAULT, CT_CTYPE1, @CurrChar, SizeOf(Char), 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: Char; +begin + if not AnsiCaseMapReady then + begin + for CurrChar := Low(Char) to High(Char) do + begin + {$IFDEF MSWINDOWS} + LoCaseChar := CurrChar; + UpCaseChar := CurrChar; + Windows.CharLowerBuff(@LoCaseChar, 1); + 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; + AnsiCaseMap[Ord(CurrChar) + AnsiLoOffset] := LoCaseChar; + AnsiCaseMap[Ord(CurrChar) + AnsiUpOffset] := UpCaseChar; + AnsiCaseMap[Ord(CurrChar) + AnsiReOffset] := ReCaseChar; + end; + AnsiCaseMapReady := True; + end; +end; +{$ENDIF ~CLR} + +// Uppercases or Lowercases a give string depending on the +// passed offset. (UpOffset or LoOffset) + +{$IFDEF CLR} +const + AnsiLoOffset = 0; + AnsiUpOffset = 1; + +procedure StrCase(var Str: string; const Offset: Integer); +begin + if Offset = AnsiUpOffset then + Str := Str.ToUpper + else + Str := Str.ToLower; +end; +{$ELSE} +procedure StrCase(var Str: string; const Offset: Integer); register; assembler; +asm + // make sure that the string is not null + + TEST EAX, EAX + JZ @@StrIsNull + + // create unique string if this one is ref-counted + + PUSH EDX + CALL UniqueString + POP EDX + + // make sure that the new string is not null + + TEST EAX, EAX + JZ @@StrIsNull + + // get the length, and prepare the counter + + MOV ECX, [EAX - AnsiStrRecSize].TAnsiStrRec.Length + DEC ECX + JS @@StrIsNull + + // ebx will hold the case map, esi pointer to Str + + PUSH EBX + PUSH ESI + PUSH EDI + + // load case map and prepare variables } + + {$IFDEF PIC} + LEA EBX, [EBX][AnsiCaseMap + EDX] + {$ELSE} + LEA EBX, [AnsiCaseMap + EDX] + {$ENDIF PIC} + MOV ESI, EAX + XOR EDX, EDX + XOR EAX, EAX + +@@NextChar: + // get current char from the string + + MOV DL, [ESI] + + // get corresponding char from the case map + + MOV AL, [EBX + EDX] + + // store it back in the string + + MOV [ESI], AL + + // update the loop counter and check the end of stirng + + DEC ECX + JL @@Done + + // do the same thing with next 3 chars + + MOV DL, [ESI + 1] + MOV AL, [EBX + EDX] + MOV [ESI + 1], AL + + DEC ECX + JL @@Done + MOV DL, [ESI + 2] + MOV AL, [EBX+EDX] + MOV [ESI + 2], AL + + DEC ECX + JL @@Done + MOV DL, [ESI + 3] + MOV AL, [EBX + EDX] + MOV [ESI + 3], AL + + // point string to next 4 chars + + ADD ESI, 4 + + // update the loop counter and check the end of stirng + + DEC ECX + JGE @@NextChar + +@@Done: + POP EDI + POP ESI + POP EBX + +@@StrIsNull: +end; +{$ENDIF CLR} + +{$IFNDEF CLR} +// 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: Integer); register; assembler; +asm + // make sure the string is not null + + TEST EAX, EAX + JZ @@StrIsNull + + // ebx will hold the case map, esi pointer to Str + + PUSH EBX + PUSH ESI + + // load case map and prepare variables + + {$IFDEF PIC} + LEA EBX, [EBX][AnsiCaseMap + EDX] + {$ELSE} + LEA EBX, [AnsiCaseMap + EDX] + {$ENDIF PIC} + MOV ESI, EAX + XOR EDX, EDX + XOR EAX, EAX + +@@NextChar: + // get current char from the string + + MOV DL, [ESI] + + // check for null char + + TEST DL, DL + JZ @@Done + + // get corresponding char from the case map + + MOV AL, [EBX + EDX] + + // store it back in the string + + MOV [ESI], AL + + // do the same thing with next 3 chars + + MOV DL, [ESI + 1] + TEST DL, DL + JZ @@Done + MOV AL, [EBX+EDX] + MOV [ESI + 1], AL + + MOV DL, [ESI + 2] + TEST DL, DL + JZ @@Done + MOV AL, [EBX+EDX] + MOV [ESI + 2], AL + + MOV DL, [ESI + 3] + TEST DL, DL + JZ @@Done + MOV AL, [EBX+EDX] + MOV [ESI + 3], AL + + // point string to next 4 chars + + ADD ESI, 4 + JMP @@NextChar + +@@Done: + POP ESI + POP EBX + +@@StrIsNull: +end; + +function StrEndW(Str: PWideChar): PWideChar; assembler; +// returns a pointer to the end of a null terminated string +// stolen from JclUnicode +asm + MOV EDX, EDI + MOV EDI, EAX + MOV ECX, 0FFFFFFFFH + XOR AX, AX + REPNE SCASW + LEA EAX, [EDI - 2] + MOV EDI, EDX +end; +{$ENDIF ~CLR} + +// String Test Routines +function StrIsAlpha(const S: string): Boolean; +var + I: Integer; +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: Integer; +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: Integer; +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; Chars: TSysCharSet; CheckAll: Boolean): Boolean; +var + I: Integer; + C: Char; +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 - [AnsiChar(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: string): Boolean; +var + I: Integer; + 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 := True and (Length(S) > 0); +end; + +function StrIsDigit(const S: string): Boolean; +var + I: Integer; +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: TSysCharSet): Boolean; +var + I: Integer; +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: string): Boolean; +begin + Result := StrCompare(S1, S2) = 0; +end; + +//=== String Transformation Routines ========================================= + +function StrCenter(const S: string; L: Integer; 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: Integer): string; +begin + Result := S; + if (CharPos > 0) and (CharPos <= Length(S)) then + Result[CharPos] := CharLower(Result[CharPos]); +end; + +function StrCharPosUpper(const S: string; CharPos: Integer): 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 := AnsiDoubleQuote + S + AnsiDoubleQuote; +end; + +function StrEnsureNoPrefix(const Prefix, Text: string): string; +var + PrefixLen : Integer; +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 : Integer; + StrLength : Integer; +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: Integer; +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: Integer; +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; +var + I, Len, N, Val: Integer; + + procedure HandleHexEscapeSeq; + const + HexDigits = string('0123456789abcdefABCDEF'); + begin + N := Pos(S[I + 1], HexDigits) - 1; + if N < 0 then + // '\x' without hex digit following is not escape sequence + Result := Result + '\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 > 255 then + {$IFDEF CLR} + raise EJclStringError.Create(RsNumericConstantTooLarge); + {$ELSE} + raise EJclStringError.CreateRes(@RsNumericConstantTooLarge); + {$ENDIF CLR} + + Result := Result + Chr(Val); + end; + end; + + procedure HandleOctEscapeSeq; + const + OctDigits = string('01234567'); + begin + // 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 > 255 then + {$IFDEF CLR} + raise EJclStringError.Create(RsNumericConstantTooLarge); + {$ELSE} + raise EJclStringError.CreateRes(@RsNumericConstantTooLarge); + {$ENDIF CLR} + + Result := Result + Chr(Val); + end; + +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 + else + // '\x' at end of string is not escape sequence + Result := Result + '\x'; + '0'..'7': + // start of octal escape sequence + HandleOctEscapeSeq; + 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 PIC} +begin + StrCase(S, AnsiLoOffset); +end; +{$ELSE} +assembler; +asm + // StrCase(S, AnsiLoOffset) + + XOR EDX, EDX // MOV EDX, LoOffset + JMP StrCase +end; +{$ENDIF PIC} + +{$IFNDEF CLR} +procedure StrLowerBuff(S: PChar); +{$IFDEF PIC} +begin + StrCaseBuff(S, AnsiLoOffset); +end; +{$ELSE} +assembler; +asm + // StrCaseBuff(S, LoOffset) + XOR EDX, EDX // MOV EDX, LoOffset + JMP StrCaseBuff +end; +{$ENDIF PIC} +{$ENDIF ~CLR} + +{$IFDEF CLR} +procedure MoveString(const Source: string; SrcIndex: Integer; + var Dest: string; DstIndex, Count: Integer); +begin + Dec(SrcIndex); + Dec(DstIndex); + Dest := Dest.Remove(DstIndex, Count).Insert(DstIndex, Source.Substring(SrcIndex, Count)); +end; +{$ENDIF CLR} + +procedure StrMove(var Dest: string; const Source: string; + const ToIndex, FromIndex, Count: Integer); +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 + {$IFDEF CLR} + MoveString(Source, FromIndex, Dest, ToIndex, Count); + {$ELSE} + Move(Source[FromIndex], Dest[ToIndex], Count); + {$ENDIF CLR} +end; + +function StrPadLeft(const S: string; Len: Integer; C: Char): string; +var + L: Integer; +begin + L := Length(S); + if L < Len then + Result := StringOfChar(C, Len - L) + S + else + Result := S; +end; + +function StrPadRight(const S: string; Len: Integer; C: Char): string; +var + L: Integer; +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 + {$IFDEF CLR} + Result := S.ToLower; + {$ELSE} + Result := StrLower(S); + {$ENDIF CLR} + if Result <> '' then + Result[1] := UpCase(Result[1]); +end; + +{$IFNDEF CLR} +procedure StrProperBuff(S: PChar); +begin + if (S <> nil) and (S^ <> #0) then + begin + StrLowerBuff(S); + S^ := CharUpper(S^); + end; +end; +{$ENDIF ~CLR} + +function StrQuote(const S: string; C: Char): string; +var + L: Integer; +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: TSysCharSet): string; +{$IFDEF CLR} +var + I: Integer; + sb: StringBuilder; +begin + sb := StringBuilder.Create(Length(S)); + for I := 0 to S.Length - 1 do + if not (AnsiChar(S[I]) in Chars) then + sb.Append(S[I]); + Result := sb.ToString(); +end; +{$ELSE} +var + Source, Dest: PChar; + Len, Index: Integer; +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 (Source^ in Chars) then + begin + Dest^ := Source^; + Inc(Dest,SizeOf(Char)); + end; + Inc(Source,SizeOf(Char)); + end; + SetLength(Result, (Longint(Dest) - Longint(PChar(Result))) div SizeOf(Char)); +end; +{$ENDIF CLR} + +function StrKeepChars(const S: string; const Chars: TSysCharSet): string; +{$IFDEF CLR} +var + I: Integer; + sb: StringBuilder; +begin + sb := StringBuilder.Create(Length(S)); + for I := 0 to S.Length - 1 do + if AnsiChar(S[I]) in Chars then + sb.Append(S[I]); + Result := sb.ToString(); +end; +{$ELSE} +var + Source, Dest: PChar; + Len, Index: Integer; +begin + Len := Length(S); + SetLength(Result, Len); + UniqueString(Result); + Source := PChar(S); + Dest := PChar(Result); + for Index := 0 to Len-1 do + begin + if Source^ in Chars then + begin + Dest^ := Source^; + Inc(Dest,SizeOf(Char)); + end; + Inc(Source,SizeOf(Char)); + end; + SetLength(Result, (Longint(Dest) - Longint(PChar(Result))) div SizeOf(Char)); +end; +{$ENDIF CLR} + +function StrRepeat(const S: string; Count: Integer): string; +{$IFDEF CLR} +var + I, Len: Integer; + sb: StringBuilder; +begin + Len := Length(S); + if Len * Count > 0 then + begin + sb := StringBuilder.Create(Len * Count); + for I := Count - 1 downto 0 do + sb.Append(S); + Result := sb.ToString(); + end + else + Result := ''; +end; +{$ELSE} +var + Len, Index: Integer; + 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*SizeOf(Char)); + end; +end; +{$ENDIF CLR} + +function StrRepeatLength(const S: string; L: Integer): string; +{$IFDEF CLR} +var + Count: Integer; + LenS, Index: Integer; +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); + Index := 1; + while Count > 0 do + begin + MoveString(S, 1, Result, Index, LenS); + Inc(Index, LenS); + Dec(Count); + end; + if Length(S) > L then + SetLength(Result, L); + end; +end; +{$ELSE} +var + Len: Integer; + 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; +{$ENDIF CLR} + +procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags); +{$IFDEF CLR} +begin + S := StringReplace(S, Search, Replace, Flags); // !!! Convertion to System.String +end; +{$ELSE} +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: Integer; { length of result string } + C: Char; { first character of search string } + IgnoreCase: Boolean; +begin + if Search = '' then + if S = '' then + begin + S := Replace; + Exit; + end + else + raise EJclStringError.CreateRes(@RsBlankSearchString); + + if S <> '' then + begin + IgnoreCase := rfIgnoreCase in Flags; + if IgnoreCase then + SearchStr := AnsiUpperCase(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); + 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; +{$ENDIF CLR} + +function StrReplaceChar(const S: string; const Source, Replace: Char): string; +{$IFNDEF CLR} +var + I: Integer; +{$ENDIF ~CLR} +begin + {$IFDEF CLR} + Result := S.Replace(Source, Replace); + {$ELSE} + Result := S; + for I := 1 to Length(S) do + if Result[I] = Source then + Result[I] := Replace; + {$ENDIF CLR} +end; + +function StrReplaceChars(const S: string; const Chars: TSysCharSet; Replace: Char): string; +var + I: Integer; + {$IFDEF CLR} + sb: StringBuilder; + {$ENDIF CLR} +begin + {$IFDEF CLR} + sb := StringBuilder.Create(S); + for I := 0 to sb.Length - 1 do + if AnsiChar(sb[I]) in Chars then + sb[I] := Replace; + Result := sb.ToString(); + {$ELSE} + Result := S; + for I := 1 to Length(S) do + if Result[I] in Chars then + Result[I] := Replace; + {$ENDIF CLR} +end; + +function StrReplaceButChars(const S: string; const Chars: TSysCharSet; + Replace: Char): string; +var + I: Integer; + {$IFDEF CLR} + sb: StringBuilder; + {$ENDIF CLR} +begin + {$IFDEF CLR} + sb := StringBuilder.Create(S); + for I := 0 to sb.Length - 1 do + if not (AnsiChar(sb[I]) in Chars) then + sb[I] := Replace; + Result := sb.ToString(); + {$ELSE} + Result := S; + for I := 1 to Length(S) do + if not (Result[I] in Chars) then + Result[I] := Replace; + {$ENDIF CLR} +end; + +function StrReverse(const S: string): string; +begin + Result := S; + StrReverseInplace(Result); +end; + +procedure StrReverseInPlace(var S: string); +{$IFDEF CLR} +var + I, LenS: Integer; + sb: StringBuilder; +begin + LenS := Length(S); + sb := StringBuilder.Create(LenS); + sb.Length := LenS; + for I := 0 to LenS - 1 do + sb[I] := S[LenS - I - 1]; + S := sb.ToString(); +end; +{$ELSE} +var + P1, P2: PChar; + C: Char; +begin + UniqueString(S); + P1 := PChar(S); + P2 := P1 + SizeOf(Char) * (Length(S) - 1); + while P1 < P2 do + begin + C := P1^; + P1^ := P2^; + P2^ := C; + Inc(P1); + Dec(P2); + end; +end; +{$ENDIF CLR} + +function StrSingleQuote(const S: string): string; +begin + Result := AnsiSingleQuote + S + AnsiSingleQuote; +end; + +function StrSmartCase(const S: string; Delimiters: TSysCharSet): string; +var + {$IFDEF CLR} + Index: Integer; + LenS: Integer; + sb: StringBuilder; + {$ELSE} + Source, Dest: PChar; + Index, Len: Integer; + {$ENDIF CLR} +begin + Result := ''; + if Delimiters = [] then + Include(Delimiters, AnsiSpace); + + if S <> '' then + begin + Result := S; + {$IFDEF CLR} + sb := StringBuilder.Create(S); + LenS := Length(S); + Index := 0; + while Index < LenS do + begin + if (AnsiChar(sb[Index]) in Delimiters) and (Index + 1 < LenS) and + not (AnsiChar(sb[Index + 1]) in Delimiters) then + sb[Index + 1] := CharUpper(sb[Index + 1]); + Inc(Index); + end; + sb[0] := CharUpper(sb[0]); + Result := sb.ToString(); + {$ELSE} + UniqueString(Result); + + Len := Length(S); + Source := PChar(S); + Dest := PChar(Result); + Inc(Dest); + + for Index := 2 to Len do + begin + if (Source^ in Delimiters) and not (Dest^ in Delimiters) then + Dest^ := CharUpper(Dest^); + Inc(Dest); + Inc(Source); + end; + Result[1] := CharUpper(Result[1]); + {$ENDIF CLR} + end; +end; + +function StrStringToEscaped(const S: string): string; +var + I: Integer; +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 + Format('\x%.2x',[Integer(S[I])]) + else + Result := Result + S[I]; + end; + end; +end; + +function StrStripNonNumberChars(const S: string): string; +var + I: Integer; + 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: Integer; + C, L, N: Integer; + BL, BH: Byte; + S: string; + {$IFDEF CLR} + sb: StringBuilder; + {$ENDIF CLR} +begin + {$IFDEF CLR} + sb := StringBuilder.Create; + {$ELSE} + Result := ''; + {$ENDIF CLR} + if Source <> '' then + begin + S := Source; + L := Length(S); + if Odd(L) then + begin + S := '0' + S; + Inc(L); + end; + Index := 1; + {$IFDEF CLR} + sb.Length := L div 2; + {$ELSE} + SetLength(Result, L div 2); + {$ENDIF CLR} + 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; + {$IFDEF CLR} + sb[N] := + {$ELSE} + Result[N] := + {$ENDIF CLR} + Char((BH shl 4) + BL); + Inc(N); + end; + end; + {$IFDEF CLR} + Result := sb.ToString(); + {$ENDIF CLR} +end; + +function StrTrimCharLeft(const S: string; C: Char): string; +var + I, L: Integer; +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: TSysCharSet): string; +var + I, L: Integer; +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: string; const Chars: TSysCharSet): string; +var + I: Integer; +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: string; C: Char): string; +var + I: Integer; +begin + I := Length(S); + while (I >= 1) and (S[I] = C) do Dec(I); + Result := Copy(S, 1, I); +end; + +function StrTrimQuotes(const S: string): string; +var + First, Last: Char; + L: Integer; +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 StrUpper(const S: string): string; +begin + Result := S; + StrUpperInPlace(Result); +end; + +procedure StrUpperInPlace(var S: string); +{$IFDEF PIC} +begin + StrCase(S, AnsiUpOffset); +end; +{$ELSE} +asm + // StrCase(Str, AnsiUpOffset) + MOV EDX, AnsiUpOffset + JMP StrCase +end; +{$ENDIF PIC} + +{$IFNDEF CLR} +procedure StrUpperBuff(S: PChar); +{$IFDEF PIC} +begin + StrCaseBuff(S, AnsiUpOffset); +end; +{$ELSE} +asm + // StrCaseBuff(S, UpOffset) + MOV EDX, AnsiUpOffset + JMP StrCaseBuff +end; +{$ENDIF PIC} +{$ENDIF ~CLR} + +{$IFDEF WIN32} +function StrOemToAnsi(const S: string): string; +begin + SetLength(Result, Length(S)); + if S <> '' then + OemToAnsiBuff(@S[1], @Result[1], Length(S)); +end; +{$ENDIF WIN32} + +{$IFDEF WIN32} +function StrAnsiToOem(const S: string): string; +begin + SetLength(Result, Length(S)); + if S <> '' then + AnsiToOemBuff(@S[1], @Result[1], Length(S)); +end; +{$ENDIF WIN32} + + +{$IFNDEF CLR} +//=== String Management ====================================================== + +procedure StrAddRef(var S: string); +var + Foo: string; +begin + if StrRefCount(S) = -1 then + UniqueString(S) + else + begin + Foo := S; + Pointer(Foo) := nil; + end; +end; + +function StrAllocSize(const S: string): Longint; +var + P: Pointer; +begin + Result := 0; + if Pointer(S) <> nil then + begin + P := Pointer(Integer(Pointer(S)) - AnsiRfOffset); + if Integer(P^) <> -1 then + begin + P := Pointer(Integer(Pointer(S)) - AnsiAlOffset); + Result := Integer(P^); + end; + end; +end; + +procedure StrDecRef(var S: string); +var + Foo: string; +begin + case StrRefCount(S) of + -1, 0: { nothing } ; + 1: + begin + Finalize(S); + Pointer(S) := nil; + end; + else + Pointer(Foo) := Pointer(S); + end; +end; + +function StrLen(S: PChar): Integer; assembler; +asm + TEST EAX, EAX + JZ @@EXIT + + PUSH EBX + MOV EDX, EAX // save pointer +@L1: MOV EBX, [EAX] // read 4 bytes + ADD EAX, 4 // increment pointer + LEA ECX, [EBX-$01010101] // subtract 1 from each byte + NOT EBX // invert all bytes + AND ECX, EBX // and these two + AND ECX, $80808080 // test all sign bits + JZ @L1 // no zero bytes, continue loop + TEST ECX, $00008080 // test first two bytes + JZ @L2 + SHL ECX, 16 // not in the first 2 bytes + SUB EAX, 2 +@L2: SHL ECX, 9 // use carry flag to avoid a branch + SBB EAX, EDX // compute length + POP EBX + + JZ @@EXIT // Az: SBB sets zero flag + DEC EAX // do not include null terminator +@@EXIT: +end; + +function StrLength(const S: string): Longint; +var + P: Pointer; +begin + Result := 0; + if Pointer(S) <> nil then + begin + P := Pointer(Integer(Pointer(S)) - AnsiLnOffset); + Result := Integer(P^) and (not $80000000 shr 1); + end; +end; + +function StrRefCount(const S: string): Longint; +var + P: Pointer; +begin + Result := 0; + if Pointer(S) <> nil then + begin + P := Pointer(Integer(Pointer(S)) - AnsiRfOffset); + Result := Integer(P^); + end; +end; +{$ENDIF ~CLR} + +procedure StrResetLength(var S: string); +{$IFDEF CLR} +var + I: Integer; +{$ENDIF CLR} +begin + {$IFDEF CLR} + for I := 1 to Length(S) do + if S[I] = #0 then + begin + SetLength(S, I); + Exit; + end; + {$ELSE} + SetLength(S, StrLen(PChar(S))); + {$ENDIF CLR} +end; + +{$IFDEF CLR} +procedure StrResetLength(S: StringBuilder); +var + I: Integer; +begin + for I := 0 to S.Length - 1 do + if S[I] = #0 then + begin + S.Length := I + 1; + Exit; + end; +end; +{$ENDIF CLR} + +//=== String Search and Replace Routines ===================================== + +function StrCharCount(const S: string; C: Char): Integer; +var + I: Integer; +begin + Result := 0; + for I := 1 to Length(S) do + if S[I] = C then + Inc(Result); +end; + +function StrCharsCount(const S: string; Chars: TSysCharSet): Integer; +var + I: Integer; +begin + Result := 0; + for I := 1 to Length(S) do + if S[I] in Chars then + Inc(Result); +end; + +function StrStrCount(const S, SubS: string): Integer; +var + I: Integer; +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; + +{$IFDEF CLR} +function StrCompare(const S1, S2: string): Integer; +begin + Result := S1.CompareTo(S2); +end; +{$ELSE} +{$IFDEF PIC} +function _StrCompare(const S1, S2: string): Integer; forward; + +function StrCompare(const S1, S2: string): Integer; +begin + Result := _StrCompare(S1, S2); +end; + +function _StrCompare(const S1, S2: string): Integer; assembler; +{$ELSE} +function StrCompare(const S1, S2: string): Integer; assembler; +{$ENDIF PIC} +asm + // check if pointers are equal + + CMP EAX, EDX + JE @@Equal + + // if S1 is nil return - Length(S2) + + TEST EAX, EAX + JZ @@Str1Null + + // if S2 is nil return Length(S1) + + TEST EDX, EDX + JZ @@Str2Null + + // EBX will hold case map, ESI S1, EDI S2 + + PUSH EBX + PUSH ESI + PUSH EDI + + // move string pointers + + MOV ESI, EAX + MOV EDI, EDX + + // get the length of strings + + MOV EAX, [ESI-AnsiStrRecSize].TAnsiStrRec.Length + MOV EDX, [EDI-AnsiStrRecSize].TAnsiStrRec.Length + + // exit if Length(S1) <> Length(S2) + + CMP EAX, EDX + JNE @@MissMatch + + // check the length just in case + + DEC EDX + JS @@InvalidStr + + DEC EAX + JS @@InvalidStr + + // load case map + + LEA EBX, AnsiCaseMap + + // make ECX our loop counter + + MOV ECX, EAX + + // clear working regs + + XOR EAX, EAX + XOR EDX, EDX + + // get last chars + + MOV AL, [ESI+ECX] + MOV DL, [EDI+ECX] + + // lower case them + + MOV AL, [EBX+EAX] + MOV DL, [EBX+EDX] + + // compare them + + CMP AL, DL + JNE @@MissMatch + + // if there was only 1 char then exit + + JECXZ @@Match + +@@NextChar: + // case sensitive compare of strings + + REPE CMPSB + JE @@Match + + // if there was a missmatch try case insensitive compare, get the chars + + MOV AL, [ESI-1] + MOV DL, [EDI-1] + + // lowercase and compare them, if equal then continue + + MOV AL, [EBX+EAX] + MOV DL, [EBX+EDX] + CMP AL, DL + JE @@NextChar + + // if we make it here then strings don't match, return the difference + +@@MissMatch: + SUB EAX, EDX + POP EDI + POP ESI + POP EBX + RET + +@@Match: + // match, return 0 + + XOR EAX, EAX + POP EDI + POP ESI + POP EBX + RET + +@@InvalidStr: + XOR EAX, EAX + DEC EAX + POP EDI + POP ESI + POP EBX + RET + +@@Str1Null: + // return = - Length(Str2); + + MOV EDX, [EDX-AnsiStrRecSize].TAnsiStrRec.Length + SUB EAX, EDX + RET + +@@Str2Null: + // return = Length(Str2); + + MOV EAX, [EAX-AnsiStrRecSize].TAnsiStrRec.Length + RET + +@@Equal: + XOR EAX, EAX +end; +{$ENDIF CLR} + +{$IFDEF CLR} +function StrCompareRange(const S1, S2: string; const Index, Count: Integer): Integer; +begin + Result := System.String.Compare(S1, Index - 1, S2, Index - 1, Count, False); +end; +{$ELSE} +function StrCompareRange(const S1, S2: string; const Index, Count: Integer): Integer; assembler; +asm + TEST EAX, EAX + JZ @@Str1Null + + TEST EDX, EDX + JZ @@StrNull + + DEC ECX + JS @@StrNull + + PUSH EBX + PUSH ESI + PUSH EDI + + MOV EBX, Count + DEC EBX + JS @@NoWork + + MOV ESI, EAX + MOV EDI, EDX + + MOV EDX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length + + // # of chars in S1 - (Index - 1) + SUB EDX, ECX + JLE @@NoWork + + // # of chars in S1 - (Count - 1) + SUB EDX, EBX + JLE @@NoWork + + // move to index'th char + ADD ESI, ECX + + MOV ECX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length + DEC ECX + JS @@NoWork + + // if Length(S2) > Count then ECX := Count else ECX := Length(S2) + + CMP ECX, EBX + JLE @@Skip1 + MOV ECX, EBX + +@@Skip1: + XOR EAX, EAX + XOR EDX, EDX + +@@Loop: + MOV AL, [ESI] + INC ESI + MOV DL, [EDI] + INC EDI + + CMP AL, DL + JNE @@MisMatch + + DEC ECX + JGE @@Loop + +@@Match: + XOR EAX, EAX + POP EDI + POP ESI + POP EBX + JMP @@Exit + +@@MisMatch: + SUB EAX, EDX + POP EDI + POP ESI + POP EBX + JMP @@Exit + +@@NoWork: + MOV EAX, -2 + POP EDI + POP ESI + POP EBX + JMP @@Exit + +@@Str1Null: + MOV EAX, 0 + TEST EDX, EDX + JZ @@Exit + +@@StrNull: + MOV EAX, -1 + +@@Exit: +end; +{$ENDIF CLR} + +function StrFillChar(const C: Char; Count: Integer): string; +{$IFDEF CLR} +var + sb: StringBuilder; +begin + sb := StringBuilder.Create(Count); + while Count > 0 do + begin + sb.Append(C); + Dec(Count); + end; + Result := sb.ToString(); +end; +{$ELSE} +begin + SetLength(Result, Count); + if (Count > 0) then + FillChar(Result[1], Count, Ord(C)); +end; +{$ENDIF CLR} + +{$IFDEF CLR} +function StrFind(const Substr, S: string; const Index: Integer): Integer; +begin + Result := System.String(S).ToLower().IndexOf(System.String(SubStr).ToLower(), Index - 1) + 1; +end; +{$ELSE} +function StrFind(const Substr, S: string; const Index: Integer): Integer; assembler; +const + SearchChar: Byte = 0; + NumberOfChars: Integer = 0; +asm + // if SubStr = '' then Return := 0; + + TEST EAX, EAX + JZ @@SubstrIsNull + + // if Str = '' then Return := 0; + + TEST EDX, EDX + JZ @@StrIsNull + + // Index := Index - 1; if Index < 0 then Return := 0; + + DEC ECX + JL @@IndexIsSmall + + // EBX will hold the case table, ESI pointer to Str, EDI pointer + // to Substr and - # of chars in Substr to compare + + PUSH EBX + PUSH ESI + PUSH EDI + + // set the string pointers + + MOV ESI, EDX + MOV EDI, EAX + + // save the Index in EDX + + MOV EDX, ECX + + // temporary get the length of Substr and Str + + MOV EBX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length + MOV ECX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length + + // save the address of Str to compute the result + + PUSH ESI + + // dec the length of Substr because the first char is brought out of it + + DEC EBX + JS @@NotFound + + // #positions in Str to look at = Length(Str) - Length(Substr) - Index - 2 + + SUB ECX, EBX + JLE @@NotFound + + SUB ECX, EDX + JLE @@NotFound + + // # of chars in Substr to compare + + MOV NumberOfChars, EBX + + // point Str to Index'th char + + ADD ESI, EDX + + // load case map into EBX, and clear EAX + + LEA EBX, AnsiCaseMap + XOR EAX, EAX + XOR EDX, EDX + + // bring the first char out of the Substr and point Substr to the next char + + MOV DL, [EDI] + INC EDI + + // lower case it + + MOV DL, [EBX + EDX] + MOV SearchChar, DL + + JMP @@Find + +@@FindNext: + + // update the loop counter and check the end of string. + // if we reached the end, Substr was not found. + + DEC ECX + JL @@NotFound + +@@Find: + + // get current char from the string, and point Str to the next one + + MOV AL, [ESI] + INC ESI + + + // lower case current char + + MOV AL, [EBX + EAX] + + // does current char match primary search char? if not, go back to the main loop + + CMP AL, SearchChar + JNE @@FindNext + +@@Compare: + + // # of chars in Substr to compare + + MOV EDX, NumberOfChars + +@@CompareNext: + + // dec loop counter and check if we reached the end. If yes then we found it + + DEC EDX + JL @@Found + + // get the chars from Str and Substr, if they are equal then continue comparing + + MOV AL, [ESI + EDX] + CMP AL, [EDI + EDX] + JE @@CompareNext + + // otherwise try the reverse case. If they still don't match go back to the Find loop + + MOV AL, [EBX + EAX + AnsiReOffset] + CMP AL, [EDI + EDX] + JNE @@FindNext + + // if they matched, continue comparing + + JMP @@CompareNext + +@@Found: + // we found it, calculate the result + + MOV EAX, ESI + POP ESI + SUB EAX, ESI + + POP EDI + POP ESI + POP EBX + RET + +@@NotFound: + + // not found it, clear the result + + XOR EAX, EAX + POP ESI + POP EDI + POP ESI + POP EBX + RET + +@@IndexIsSmall: +@@StrIsNull: + + // clear the result + + XOR EAX, EAX + +@@SubstrIsNull: +@@Exit: +end; +{$ENDIF CLR} + +function StrHasPrefix(const S: string; const Prefixes: array of string): Boolean; +begin + Result := StrPrefixIndex(S, Prefixes) > -1; +end; + +function StrIndex(const S: string; const List: array of string): Integer; +var + I: Integer; +begin + Result := -1; + for I := Low(List) to High(List) do + begin + {$IFDEF CLR} + if SameText(S, List[I]) then + {$ELSE} + if AnsiSameText(S, List[I]) then + {$ENDIF CLR} + begin + Result := I; + Break; + end; + end; +end; + +function StrILastPos(const SubStr, S: string): Integer; +begin + Result := StrLastPos(StrUpper(SubStr), StrUpper(S)); +end; + +function StrIPos(const SubStr, S: string): Integer; +begin + {$IFDEF CLR} + Result := Pos(SubStr.ToUpper, S.ToUpper); + {$ELSE} + Result := Pos(AnsiUpperCase(SubStr), AnsiUpperCase(S)); + {$ENDIF CLR} +end; + +function StrIsOneOf(const S: string; const List: array of string): Boolean; +begin + Result := StrIndex(S, List) > -1; +end; + +function StrLastPos(const SubStr, S: string): Integer; +{$IFDEF CLR} +begin + Result := System.String(S).LastIndexOf(SubStr) + 1; +end; +{$ELSE} +var + Last, Current: PChar; +begin + Result := 0; + Last := nil; + Current := PChar(S); + + while (Current <> nil) and (Current^ <> #0) do + begin + Current := AnsiStrPos(PChar(Current), PChar(SubStr)); + if Current <> nil then + begin + Last := Current; + Inc(Current); + end; + end; + if Last <> nil then + Result := Abs((Longint(PChar(S)) - Longint(Last)) div SizeOf(Char)) + 1; +end; +{$ENDIF CLR} + +// IMPORTANT NOTE: The StrMatch function does currently not work with the Asterix (*) + +function StrMatch(const Substr, S: string; const Index: Integer): Integer; +{$IFDEF CLR} +begin + { TODO : StrMatch } + Result := 0; +end; +{$ELSE} +assembler; +asm + // make sure that strings are not null + + TEST EAX, EAX + JZ @@SubstrIsNull + + TEST EDX, EDX + JZ @@StrIsNull + + // limit index to satisfy 1 <= index, and dec it + + DEC ECX + JL @@IndexIsSmall + + // EBX will hold the case table, ESI pointer to Str, EDI pointer + // to Substr and EBP # of chars in Substr to compare + + PUSH EBX + PUSH ESI + PUSH EDI + PUSH EBP + + // set the string pointers + + MOV ESI, EDX + MOV EDI, EAX + + // save the Index in EDX + + MOV EDX, ECX + + // save the address of Str to compute the result + + PUSH ESI + + // temporary get the length of Substr and Str + + MOV EBX, [EDI - AnsiStrRecSize].TAnsiStrRec.Length + MOV ECX, [ESI - AnsiStrRecSize].TAnsiStrRec.Length + + // dec the length of Substr because the first char is brought out of it + + DEC EBX + JS @@NotFound + + // #positions in Str to look at = Length(Str) - Length(Substr) - Index - 2 + + SUB ECX, EBX + JLE @@NotFound + + SUB ECX, EDX + JLE @@NotFound + + // # of chars in Substr to compare + + MOV EBP, EBX + + // point Str to Index'th char + + ADD ESI, EDX + + // load case map into EBX, and clear EAX & ECX + + LEA EBX, AnsiCaseMap + XOR EAX, EAX + XOR ECX, ECX + + // bring the first char out of the Substr and point Substr to the next char + + MOV CL, [EDI] + INC EDI + + // lower case it + + MOV CL, [EBX + ECX] + +@@FindNext: + + // get the current char from Str into al + + MOV AL, [ESI] + INC ESI + + // check the end of string + + TEST AL, AL + JZ @@NotFound + + + CMP CL, '*' // Wild Card? + JE @@Compare + + CMP CL, '?' // Wild Card? + JE @@Compare + + // lower case current char + + MOV AL, [EBX + EAX] + + // check if the current char matches the primary search char, + // if not continue searching + + CMP AL, CL + JNE @@FindNext + +@@Compare: + + // # of chars in Substr to compare } + + MOV EDX, EBP + +@@CompareNext: + + // dec loop counter and check if we reached the end. If yes then we found it + + DEC EDX + JL @@Found + + // get the chars from Str and Substr, if they are equal then continue comparing + + MOV AL, [EDI + EDX] // char from Substr + + CMP AL, '*' // wild card? + JE @@CompareNext + + CMP AL, '?' // wild card? + JE @@CompareNext + + CMP AL, [ESI + EDX] // equal to PChar(Str)^ ? + JE @@CompareNext + + MOV AL, [EBX + EAX + AnsiReOffset] // reverse case? + CMP AL, [ESI + EDX] + JNE @@FindNext // if still no, go back to the main loop + + // if they matched, continue comparing + + JMP @@CompareNext + +@@Found: + // we found it, calculate the result + + MOV EAX, ESI + POP ESI + SUB EAX, ESI + + POP EBP + POP EDI + POP ESI + POP EBX + RET + +@@NotFound: + + // not found it, clear the result + + XOR EAX, EAX + POP ESI + POP EBP + POP EDI + POP ESI + POP EBX + RET + +@@IndexIsSmall: +@@StrIsNull: + + // clear the result + + XOR EAX, EAX + +@@SubstrIsNull: +@@Exit: +end; +{$ENDIF CLR} + +// Derived from "Like" by Michael Winter +function StrMatches(const Substr, S: string; const Index: Integer): Boolean; +{$IFDEF CLR} +begin + Result := Substr = S; + { TODO : StrMatches } +end; +{$ELSE} +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; + + 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; +{$ENDIF CLR} + +function StrNPos(const S, SubStr: string; N: Integer): Integer; +var + I, P: Integer; +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: Integer): Integer; +var + I, P: Integer; +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): Integer; +var + I: Integer; + Test: string; +begin + Result := -1; + for I := Low(Prefixes) to High(Prefixes) do + begin + Test := StrLeft(S, Length(Prefixes[I])); + {$IFDEF CLR} + if SameText(Test, Prefixes[I]) then + {$ELSE} + if AnsiSameText(Test, Prefixes[I]) then + {$ENDIF CLR} + begin + Result := I; + Break; + end; + end; +end; + +{$IFDEF CLR} +function StrSearch(const Substr, S: string; const Index: Integer): Integer; +begin + Result := System.String(S).IndexOf(SubStr, Index - 1) + 1; +end; +{$ELSE} +function StrSearch(const Substr, S: string; const Index: Integer): Integer; assembler; +asm + // make sure that strings are not null + + TEST EAX, EAX + JZ @@SubstrIsNull + + TEST EDX, EDX + JZ @@StrIsNull + + // limit index to satisfy 1 <= index, and dec it + + DEC ECX + JL @@IndexIsSmall + + // ebp will hold # of chars in Substr to compare, esi pointer to Str, + // edi pointer to Substr, ebx primary search char + + PUSH EBX + PUSH ESI + PUSH EDI + PUSH EBP + + // set the string pointers + + MOV ESI, EDX + MOV EDI, EAX + + // save the (Index - 1) in edx + + MOV EDX, ECX + + // save the address of Str to compute the result + + PUSH ESI + + // temporary get the length of Substr and Str + + MOV EBX, [EDI-AnsiStrRecSize].TAnsiStrRec.Length + MOV ECX, [ESI-AnsiStrRecSize].TAnsiStrRec.Length + + // dec the length of Substr because the first char is brought out of it + + DEC EBX + JS @@NotFound + + // # of positions in Str to look at = Length(Str) - Length(Substr) - Index - 2 + + SUB ECX, EBX + JLE @@NotFound + + SUB ECX, EDX + JLE @@NotFound + + // point Str to Index'th char + + ADD ESI, EDX + + // # of chars in Substr to compare + + MOV EBP, EBX + + // clear EAX & ECX (working regs) + + XOR EAX, EAX + XOR EBX, EBX + + // bring the first char out of the Substr, and + // point Substr to the next char + + MOV BL, [EDI] + INC EDI + + // jump into the loop + + JMP @@Find + +@@FindNext: + + // update the loop counter and check the end of string. + // if we reached the end, Substr was not found. + + DEC ECX + JL @@NotFound + +@@Find: + + // get current char from the string, and /point Str to the next one. + MOV AL, [ESI] + INC ESI + + // does current char match primary search char? if not, go back to the main loop + + CMP AL, BL + JNE @@FindNext + + // otherwise compare SubStr + +@@Compare: + + // move # of char to compare into edx, edx will be our compare loop counter. + + MOV EDX, EBP + +@@CompareNext: + + // check if we reached the end of Substr. If yes we found it. + + DEC EDX + JL @@Found + + // get last chars from Str and SubStr and compare them, + // if they don't match go back to out main loop. + + MOV AL, [EDI+EDX] + CMP AL, [ESI+EDX] + JNE @@FindNext + + // if they matched, continue comparing + + JMP @@CompareNext + +@@Found: + // we found it, calculate the result and exit. + + MOV EAX, ESI + POP ESI + SUB EAX, ESI + + POP EBP + POP EDI + POP ESI + POP EBX + RET + +@@NotFound: + // not found it, clear result and exit. + + XOR EAX, EAX + POP ESI + POP EBP + POP EDI + POP ESI + POP EBX + RET + +@@IndexIsSmall: +@@StrIsNull: + // clear result and exit. + + XOR EAX, EAX + +@@SubstrIsNull: +@@Exit: +end; +{$ENDIF CLR} + +//=== String Extraction ====================================================== + +function StrAfter(const SubStr, S: string): string; +var + P: Integer; +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: Integer; +begin + P := StrFind(SubStr, S, 1); + if P <= 0 then + Result := S + else + Result := StrLeft(S, P - 1); +end; + + +function StrBetween(const S: string; const Start, Stop: Char): string; +var + PosStart, PosEnd: Integer; + L: Integer; +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: Integer): string; +begin + Result := Copy(S, 1, Length(S) - N); +end; + +function StrLeft(const S: string; Count: Integer): string; +begin + Result := Copy(S, 1, Count); +end; + +function StrMid(const S: string; Start, Count: Integer): string; +begin + Result := Copy(S, Start, Count); +end; + +function StrRestOf(const S: string; N: Integer ): string; +begin + Result := Copy(S, N, (Length(S) - N + 1)); +end; + +function StrRight(const S: string; Count: Integer): 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 CLR} + Result := System.Char.IsLetter(C); + {$ELSE} + Result := (AnsiCharTypes[C] and C1_ALPHA) <> 0; + {$ENDIF CLR} +end; + +function CharIsAlphaNum(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsLetterOrDigit(C); + {$ELSE} + Result := ((AnsiCharTypes[C] and C1_ALPHA) <> 0) or + ((AnsiCharTypes[C] and C1_DIGIT) <> 0); + {$ENDIF CLR} +end; + +function CharIsBlank(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsSurrogate(C); + {$ELSE} + Result := ((AnsiCharTypes[C] and C1_BLANK) <> 0); + {$ENDIF CLR} +end; + +function CharIsControl(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsControl(C); + {$ELSE} + Result := (AnsiCharTypes[C] and C1_CNTRL) <> 0; + {$ENDIF CLR} +end; + +function CharIsDelete(const C: Char): Boolean; +begin + Result := (C = #8); +end; + +function CharIsDigit(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsDigit(C); + {$ELSE} + Result := (AnsiCharTypes[C] and C1_DIGIT) <> 0; + {$ENDIF CLR} +end; + +function CharIsLower(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsLower(C); + {$ELSE} + Result := (AnsiCharTypes[C] and C1_LOWER) <> 0; + {$ENDIF CLR} +end; + +function CharIsNumberChar(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsDigit(C) or + {$ELSE} + Result := ((AnsiCharTypes[C] and C1_DIGIT) <> 0) or + {$ENDIF CLR} + (C in AnsiSigns) or (C = DecimalSeparator); +end; + +function CharIsPrintable(const C: Char): Boolean; +begin + Result := not CharIsControl(C); +end; + +function CharIsPunctuation(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsPunctuation(C); + {$ELSE} + Result := ((AnsiCharTypes[C] and C1_PUNCT) <> 0); + {$ENDIF CLR} +end; + +function CharIsReturn(const C: Char): Boolean; +begin + Result := (C = AnsiLineFeed) or (C = AnsiCarriageReturn); +end; + +function CharIsSpace(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsSeparator(C); + {$ELSE} + Result := (AnsiCharTypes[C] and C1_SPACE) <> 0; + {$ENDIF CLR} +end; + +function CharIsUpper(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsUpper(C); + {$ELSE} + Result := (AnsiCharTypes[C] and C1_UPPER) <> 0; + {$ENDIF CLR} +end; + +function CharIsWhiteSpace(const C: Char): Boolean; +begin + {$IFDEF CLR} + Result := System.Char.IsWhiteSpace(C); + {$ELSE} + Result := C in AnsiWhiteSpace; + {$ENDIF CLR} +end; + +{$IFNDEF CLR} +function CharType(const C: Char): Word; +begin + Result := AnsiCharTypes[C]; +end; + +//=== PCharVector ============================================================ + +function StringsToPCharVector(var Dest: PCharVector; const Source: TStrings): PCharVector; +var + I: Integer; + 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): Integer; +var + P: PChar; +begin + Result := 0; + if Source <> nil then + begin + P := Source^; + while P <> nil do + begin + Inc(Result); + P := PCharVector(Longint(Source) + (SizeOf(PChar) * Result))^; + end; + end; +end; + +procedure PCharVectorToStrings(const Dest: TStrings; Source: PCharVector); +var + I, Count: Integer; + 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: Integer; + 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; +{$ENDIF ~CLR} + +//=== Character Transformation Routines ====================================== + +function CharHex(const C: Char): Byte; +begin + Result := $FF; + if C in AnsiDecDigits then + Result := Ord(CharUpper(C)) - Ord('0') + else + begin + if C in AnsiHexDigits then + Result := Ord(CharUpper(C)) - (Ord('A')) + 10; + end; +end; + +function CharLower(const C: Char): Char; +begin + {$IFDEF CLR} + Result := System.Char.ToLower(C); + {$ELSE} + Result := AnsiCaseMap[Ord(C) + AnsiLoOffset]; + {$ENDIF CLR} +end; + +function CharToggleCase(const C: Char): Char; +begin + {$IFDEF CLR} + if System.Char.IsUpper(C) then + Result := System.Char.ToLower(C) + else + if System.Char.IsLower(C) then + Result := System.Char.ToUpper(C) + else + Result := C; + {$ELSE} + Result := AnsiCaseMap[Ord(C) + AnsiReOffset]; + {$ENDIF CLR} +end; + +function CharUpper(const C: Char): Char; +begin + {$IFDEF CLR} + Result := System.Char.ToUpper(C); + {$ELSE} + Result := AnsiCaseMap[Ord(C) + AnsiUpOffset]; + {$ENDIF CLR} +end; + +//=== Character Search and Replace =========================================== + +function CharLastPos(const S: string; const C: Char; const Index: Integer): Integer; +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: Integer): Integer; +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: Integer): Integer; +begin + if (Index > 0) and (Index <= Length(S)) then + begin + C := CharUpper(C); + for Result := Index to Length(S) do + {$IFDEF CLR} + if System.Char.ToUpper(S[Result]) = C then + {$ELSE} + if AnsiCaseMap[Ord(S[Result]) + AnsiUpOffset] = C then + {$ENDIF CLR} + Exit; + end; + Result := 0; +end; + +function CharReplace(var S: string; const Search, Replace: Char): Integer; +{$IFDEF CLR} +var + I: Integer; +begin + Result := 0; + for I := 1 to Length(S) do + if S[I] = Search then + Inc(Result); + S := S.Replace(Search, Replace); +end; +{$ELSE} +var + P: PChar; + Index, Len: Integer; +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; +{$ENDIF CLR} + +{$IFNDEF CLR} +//=== MultiSz ================================================================ + +function StringsToMultiSz(var Dest: PMultiSz; const Source: TStrings): PMultiSz; +var + I, TotalLength: Integer; + 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): Integer; +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: Integer); +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: Integer; +begin + if Source <> nil then + begin + Len := MultiSzLength(Source); + AllocateMultiSz(Result, Len); + Move(Source^, Result^, Len * SizeOf(Char)); + end + else + Result := nil; +end; + +function WideStringsToWideMultiSz(var Dest: PWideMultiSz; const Source: TWideStrings): 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 EJclStringError.CreateRes(@RsInvalidEmptyStringItem) + else + Inc(TotalLength, StrLenW(PWideChar(Source[I])) + 1); + AllocateWideMultiSz(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 WideMultiSzToWideStrings(const Dest: TWideStrings; 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 WideMultiSzLength(const Source: PWideMultiSz): Integer; +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 AllocateWideMultiSz(var Dest: PWideMultiSz; Len: Integer); +begin + if Len > 0 then + GetMem(Dest, Len * SizeOf(WideChar)) + else + Dest := nil; +end; + +procedure FreeWideMultiSz(var Dest: PWideMultiSz); +begin + if Dest <> nil then + FreeMem(Dest); + Dest := nil; +end; + +function WideMultiSzDup(const Source: PWideMultiSz): PWideMultiSz; +var + Len: Integer; +begin + if Source <> nil then + begin + Len := WideMultiSzLength(Source); + AllocateWideMultiSz(Result, Len); + Move(Source^, Result^, Len * SizeOf(WideChar)); + end + else + Result := nil; +end; +{$ENDIF ~CLR} + +//=== TStrings Manipulation ================================================== + +procedure StrToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); +var + I, L: Integer; + 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 <> '' then + List.Add(S); // Ignore empty strings at the end. + finally + List.EndUpdate; + end; +end; + +procedure StrIToStrings(S, Sep: string; const List: TStrings; const AllowEmptyString: Boolean = True); +var + I, L: Integer; + 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 <> '' then + List.Add(S); // Ignore empty strings at the end. + finally + List.EndUpdate; + end; +end; + +function StringsToStr(const List: TStrings; const Sep: string; const AllowEmptyString: Boolean): string; +var + I, L: Integer; +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: TStrings; DeleteIfEmpty: Boolean); +var + I: Integer; +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: Integer; +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: Integer; +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 BooleanToStr(B: Boolean): string; +const + Bools: array [Boolean] of string = ('False', 'True'); +begin + Result := Bools[B]; +end; + +function FileToString(const FileName: string): AnsiString; +var + fs: TFileStream; + Len: Integer; + {$IFDEF CLR} + Buf: array of Byte; + {$ENDIF CLR} +begin + fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + Len := fs.Size; + SetLength(Result, Len); + if Len > 0 then + {$IFDEF CLR} + begin + SetLength(Buf, Len); + fs.ReadBuffer(Buf, Len); + Result := Buf; + end; + {$ELSE} + fs.ReadBuffer(Result[1], Len); + {$ENDIF CLR} + finally + fs.Free; + end; +end; + +procedure StringToFile(const FileName: string; const Contents: AnsiString); +var + fs: TFileStream; + Len: Integer; +begin + fs := TFileStream.Create(FileName, fmCreate); + try + Len := Length(Contents); + if Len > 0 then + {$IFDEF CLR} + fs.WriteBuffer(BytesOf(Contents), Len); + {$ELSE} + fs.WriteBuffer(Contents[1], Len); + {$ENDIF CLR} + finally + fs.Free; + end; +end; + +function StrToken(var S: string; Separator: Char): string; +var + I: Integer; +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; + +{$IFDEF CLR} +procedure StrTokens(const S: string; const List: TStrings); +var + Start: Integer; + Token: string; + Done: Boolean; +begin + Assert(List <> nil); + if List = nil then + Exit; + + List.BeginUpdate; + try + List.Clear; + Start := 0; + repeat + Done := StrWord(S, Start, Token); + if Token <> '' then + List.Add(Token); + until Done; + finally + List.EndUpdate; + end; +end; + +function StrWord(const S: string; var Index: Integer; out Word: string): Boolean; +var + Start: Integer; +begin + Word := ''; + if (S = nil) or (S = '') then + begin + Result := True; + Exit; + end; + Start := Index; + Result := False; + while True do + begin + case S[Index] of + #0: + begin + if Start <> 0 then + Word := S.Substring(Start, Index - Start); + Result := True; + Exit; + end; + AnsiSpace, AnsiLineFeed, AnsiCarriageReturn: + begin + if Start <> 0 then + begin + Word := S.Substring(Start, Index - Start); + Exit; + end + else + while (S[Index] in [AnsiSpace, AnsiLineFeed, AnsiCarriageReturn]) do + Inc(Index); + end; + else + if Start = 0 then + Start := Index; + Inc(Index); + end; + end; +end; + +{$ELSE} + +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 := StrWord(Start, Token); + if Token <> '' then + List.Add(Token); + until Done; + finally + List.EndUpdate; + 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; + AnsiSpace, AnsiLineFeed, AnsiCarriageReturn: + begin + if Start <> nil then + begin + SetString(Word, Start, S - Start); + Exit; + end + else + while (S^ in [AnsiSpace, AnsiLineFeed, AnsiCarriageReturn]) do + Inc(S); + end; + else + if Start = nil then + Start := S; + Inc(S); + end; + end; +end; +{$ENDIF ~CLR} + +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: Integer; + SwapSeparators, IsNegative: Boolean; + DecSep: Char; + ThouSep: Char; + {$IFDEF CLR} + sb: StringBuilder; + {$ENDIF CLR} +begin + {$IFDEF CLR} + DecSep := Char(DecimalSeparator[1]); + ThouSep := Char(ThousandSeparator[1]); + {$ELSE} + DecSep := DecimalSeparator; + ThouSep := ThousandSeparator; + {$ENDIF CLR} + 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 + {$IFDEF CLR} + sb := StringBuilder.Create(Temp); + for I := 0 to sb.Length - 1 do + if sb[I] = DecimalSeparator then + sb[I] := ThouSep + else + if sb[I] = ThousandSeparator then + sb[I] := DecSep; + Temp := sb.ToString; + {$ELSE} + for I := 1 to Length(Temp) do + if Temp[I] = DecSep then + Temp[I] := ThouSep + else + if Temp[I] = ThouSep then + Temp[I] := DecSep; + {$ENDIF CLR} + end; + + Temp := StrKeepChars(Temp, AnsiDecDigits + [AnsiChar(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(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: Integer; var Index: Integer; var Count: Integer); overload; +begin + Index := Max(1, Min(Index, StrLen+1)); + Count := Max(0, Min(Count, StrLen+1 - Index)); +end; + +{$IFDEF CLR} +function ArrayOf(List: TStrings): TDynStringArray; +var + I: Integer; +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; +{$ENDIF CLR} + +{$IFDEF COMPILER5} // missing Delphi 5 functions +function TryStrToInt(const S: string; out Value: Integer): Boolean; +var + Err: Integer; +begin + Val(S, Value, Err); + Result := Err = 0; +end; + +function TryStrToInt64(const S: string; out Value: Int64): Boolean; +var + Err: Integer; +begin + Val(S, Value, Err); + Result := Err = 0; +end; + +function TryStrToFloat(const S: string; out Value: Extended): Boolean; +begin + Result := TextToFloat(PChar(S), Value, fvExtended); +end; + +function TryStrToFloat(const S: string; out Value: Double): Boolean; +var + F: Extended; +begin + Result := TryStrToFloat(S, F); + if Result then + Value := F; +end; + +function TryStrToFloat(const S: string; out Value: Single): Boolean; +var + F: Extended; +begin + Result := TryStrToFloat(S, F); + if Result then + Value := F; +end; + +function TryStrToCurr(const S: string; out Value: Currency): Boolean; +begin + Result := TextToFloat(PChar(S), Value, fvCurrency); +end; +{$ENDIF COMPILER5} + + +{$IFNDEF CLR} +initialization + LoadCharTypes; // this table first + LoadCaseMap; // or this function does not work +{$ENDIF ~CLR} + +// History: + +// MT: + +// - StrIToStrings default parameter now true +// - StrToStrings default parameter now true +// - Rewrote StrSmartCase to fix a bug. +// - Fixed a bug in StrIsAlphaNumUnderscore +// - Fixed a bug in StrIsSubset +// - Simplified StrLower +// - Fixed a bug in StrRepeatLength +// - Fixed a bug in StrLastPos +// - Added function StrTrimCharsRight (Leonard Wennekers) +// - Added function StrTrimCharsLeft (Leonard Wennekers) +// - Added StrNormIndex function (Alexander Radchenko) +// - Changed Assert in StrTokens/ to If List <> nil +// - Deleted an commented out version of StrReplace. If anyone ever want to finish the old +// version please go the archive version 0.39 +// - Modified StrFillChar a little bit (added an if for count > 0) +// - StrCharPosLower (Jean-Fabien Connault) +// - StrCharPosUpper (Jean-Fabien Connault) +// - Changed to 100 chars per line style +// - Note to Marcel: Have a look at StrToStrings and StrItoStrings. They are untested but +// should work more or less equal to the BreakApart functions by JFC. +// - Changed StrNPos for special case +// - Changed StrIPos for special case +// - Fixed a bug in CharPos : didn'T work if index = length(s) +// - Fixed a bug in CharIPos : didn'T work if index = length(s) + +// 2003-02-25, Robert Rossmair +// - Linux port (implemented LoadCharTypes & LoadCaseMap) + +// 2002-01-20, Marcel van Brakel +// - added StrIToStrings to interface section +// - added AllowEmptyString parameter to StringsToStr function +// - added AddStringToStrings() by Jeff + +// $Log: JclStrings.pas,v $ +// Revision 1.46 2006/01/15 19:10:44 ahuser +// Added RegRead*Ex functions +// RegRead*Def functions do not raise exceptions anymore (makes debugging easier) +// +// Revision 1.45 2005/11/22 07:02:37 marquardt +// Fixed StrSmartCase uppercasing delimiters if they happen to be letters +// +// Revision 1.44 2005/10/25 12:52:23 outchy +// First corrections of IT#3259. +// StrReplace, StrLastPos, StrMatches are NOT fixed. +// +// Revision 1.43 2005/10/24 19:16:53 ahuser +// more .NET support +// +// Revision 1.42 2005/10/17 09:16:59 rikbarker +// Fixed range check crashes in StrOemToAnsi and StrAnsiToOem when passed an empty string. Both could probably do with rewriting to use non-obsoleted functions CharToOemBuff and OemToCharBuff, long term. +// +// Revision 1.41 2005/08/11 18:11:25 ahuser +// Added MoveChar function +// +// Revision 1.40 2005/08/09 10:30:21 ahuser +// JCL.NET changes +// +// Revision 1.39 2005/05/05 20:08:44 ahuser +// JCL.NET support +// +// Revision 1.37 2005/03/08 16:10:08 marquardt +// standard char sets extended and used, some optimizations for string literals +// +// Revision 1.36 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.35 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.34 2005/02/05 03:45:35 rrossmair +// - fixed issue #0002455 (Calculation of ResultLength inappropriate in StrReplace) +// +// Revision 1.33 2005/01/06 18:48:31 marquardt +// AnsiLineBreak, AnsiLineFeed, AnsiCarriageReturn, AnsiCrLf moved to JclBase JclStrings now reexports the names +// +// Revision 1.32 2004/12/23 04:31:43 rrossmair +// - check-in for JCL 1.94 RC 1 +// +// Revision 1.31 2004/10/18 04:54:42 marquardt +// remove PH contributor +// +// Revision 1.30 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.29 2004/10/11 14:54:38 marquardt +// MultiSz finetuning +// +// Revision 1.28 2004/10/11 08:13:03 marquardt +// cleaning of JclStrings +// +// Revision 1.27 2004/10/10 12:52:12 marquardt +// DestroyEnvironmentBlock introduced +// +// Revision 1.26 2004/09/30 13:11:27 marquardt +// remove contributions +// +// Revision 1.25 2004/09/30 07:50:29 marquardt +// remove contributions +// +// Revision 1.24 2004/08/03 07:22:37 marquardt +// resourcestring cleanup +// +// Revision 1.23 2004/07/30 07:20:25 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate +// +// Revision 1.22 2004/06/14 06:24:52 marquardt +// style cleaning IFDEF +// +// Revision 1.21 2004/05/30 23:54:42 rrossmair +// Processed documentation TODOs +// +// Revision 1.20 2004/05/08 08:44:17 rrossmair +// introduced & applied symbol HAS_UNIT_LIBC +// +// Revision 1.19 2004/05/06 16:22:27 rrossmair +// fixed LoadCaseMap for Kylix +// +// Revision 1.18 2004/05/06 05:09:55 rrossmair +// Changes for FPC v1.9.4 compatibility +// +// Revision 1.17 2004/05/05 00:11:24 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.16 2004/04/19 06:12:34 rrossmair +// AddStringToStrings help TODO done +// +// Revision 1.15 2004/04/14 20:39:59 mthoma +// Reintroduced StrIsNumber as StrConsistsofNumberChars, copied local function StrEndW from JclUnicode to get rid of that dependency. +// +// Revision 1.14 2004/04/12 22:07:45 +// Bugfix: StringsToMultiString, MultiStringToStrings, +// empty list entries are not allowed +// Add: StringsToMultiWideString, MultiWideStringToStrings +// +// Revision 1.13 2004/04/11 15:58:25 mthoma +// Fixed #1119. Removed StrIsNumber (see bugnote), renamed CharIsNumber to CharisNumberChar. Changed some Strings to string (unit now compiles also in H- mode). +// +// Revision 1.12 2004/04/09 20:35:14 mthoma +// Added StrLastPos. changed $Data$ to $Date: 2006/01/15 19:10:44 $ +// +// Revision 1.11 2004/04/08 19:40:26 mthoma +// Fixed 0000947, 0001060 (StrBetween with same start/end symbol problem). Added a note to the docs. +// +// Revision 1.10 2004/04/06 04:31:32 +// Add functions for String <--> MultiString conversion +// +end. diff --git a/official/1.96/source/common/JclSysInfo.fpc b/official/1.96/source/common/JclSysInfo.fpc new file mode 100644 index 0000000..0b9a26c --- /dev/null +++ b/official/1.96/source/common/JclSysInfo.fpc @@ -0,0 +1,95 @@ +// Include file for Free Pascal Compiler +// contains missing declaration from units JclShell & ShlObj + +const + shell32 = 'shell32.dll'; + + CSIDL_DESKTOP = $0000; + CSIDL_INTERNET = $0001; + CSIDL_PROGRAMS = $0002; + CSIDL_CONTROLS = $0003; + CSIDL_PRINTERS = $0004; + CSIDL_PERSONAL = $0005; + CSIDL_FAVORITES = $0006; + CSIDL_STARTUP = $0007; + CSIDL_RECENT = $0008; + CSIDL_SENDTO = $0009; + CSIDL_BITBUCKET = $000a; + CSIDL_STARTMENU = $000b; + CSIDL_DESKTOPDIRECTORY = $0010; + CSIDL_DRIVES = $0011; + CSIDL_NETWORK = $0012; + CSIDL_NETHOOD = $0013; + CSIDL_FONTS = $0014; + CSIDL_TEMPLATES = $0015; + CSIDL_COMMON_STARTMENU = $0016; + CSIDL_COMMON_PROGRAMS = $0017; + CSIDL_COMMON_STARTUP = $0018; + CSIDL_COMMON_DESKTOPDIRECTORY = $0019; + CSIDL_APPDATA = $001a; + CSIDL_PRINTHOOD = $001b; + CSIDL_ALTSTARTUP = $001d; // DBCS + CSIDL_COMMON_ALTSTARTUP = $001e; // DBCS + CSIDL_COMMON_FAVORITES = $001f; + CSIDL_INTERNET_CACHE = $0020; + CSIDL_COOKIES = $0021; + CSIDL_HISTORY = $0022; + +function SHGetMalloc(var ppMalloc: IMalloc): HResult; stdcall; + external shell32 name 'SHGetMalloc'; + +function SHGetSpecialFolderLocation(hwndOwner: HWND; nFolder: Integer; + var ppidl: PItemIDList): HResult; stdcall; + external shell32 name 'SHGetSpecialFolderLocation'; + +function SHGetPathFromIDList(pidl: PItemIDList; pszPath: PChar): BOOL; stdcall; + external shell32 name 'SHGetPathFromIDListA'; + +//-------------------------------------------------------------------------------------------------- + +function PidlFree(var IdList: PItemIdList): Boolean; +var + Malloc: IMalloc; +begin + Result := False; + if IdList = nil then + Result := True + else + begin + if Succeeded(SHGetMalloc(Malloc)) and (Malloc.DidAlloc(IdList) > 0) then + begin + Malloc.Free(IdList); + IdList := nil; + Result := True; + end; + end; +end; + +//-------------------------------------------------------------------------------------------------- + +function PidlToPath(IdList: PItemIdList): string; +begin + SetLength(Result, MAX_PATH); + if SHGetPathFromIdList(IdList, PChar(Result)) then + StrResetLength(Result) + else + Result := ''; +end; + +//-------------------------------------------------------------------------------------------------- + +function GetSpecialFolderLocation(const Folder: Integer): string; +var + FolderPidl: PItemIdList; +begin + if Succeeded(SHGetSpecialFolderLocation(0, Folder, FolderPidl)) then + begin + Result := PidlToPath(FolderPidl); + PidlFree(FolderPidl); + end + else + Result := ''; +end; + +//-------------------------------------------------------------------------------------------------- + diff --git a/official/1.96/source/common/JclSysInfo.pas b/official/1.96/source/common/JclSysInfo.pas new file mode 100644 index 0000000..080a8fd --- /dev/null +++ b/official/1.96/source/common/JclSysInfo.pas @@ -0,0 +1,5435 @@ +{**************************************************************************************************} +{ } +{ 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 JclSysInfo.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: } +{ Alexander Radchenko } +{ André Snepvangers (asnepvangers) } +{ Azret Botash } +{ Bryan Coutch } +{ Carl Clark } +{ Eric S. Fisher } +{ Florent Ouchet (outchy) } +{ James Azarja } +{ Jean-Fabien Connault } +{ John C Molyneux } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Mike Lischke } +{ Nick Hodges } +{ Olivier Sannier (obones) } +{ Peter Friese } +{ Peter Thörnquist (peter3) } +{ Petr Vones (pvones) } +{ Rik Barker } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Scott Price } +{ Tom Hahn (tomhahn) } +{ Wim de Cleen } +{ } +{**************************************************************************************************} +{ } +{ This unit contains routines and classes to retrieve various pieces of system information. } +{ Examples are the location of standard folders, settings of environment variables, processor } +{ details and the Windows version. } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/12 21:54:09 $ +// For history see end of file + +// Windows NT 4 and earlier do not support GetSystemPowerStatus (while introduced +// in NT4 - it is a stub there - implemented in Windows 2000 and later. + + +unit JclSysInfo; + +{$I jcl.inc} + +interface + +uses + {$IFDEF HAS_UNIT_TYPES} + Types, + {$ENDIF HAS_UNIT_TYPES} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + {$IFDEF CLR} + System.IO, System.Configuration, System.Diagnostics, System.Collections, + System.Net, System.ComponentModel, + {$ELSE ~CLR} + {$IFDEF MSWINDOWS} + Windows, + {$IFNDEF FPC} + ShlObj, + {$ENDIF ~FPC} + {$ENDIF MSWINDOWS} + {$ENDIF ~CLR} + Classes, + JclResources; + +// Environment Variables +{$IFDEF MSWINDOWS} +type + TEnvironmentOption = (eoLocalMachine, eoCurrentUser, eoAdditional); + TEnvironmentOptions = set of TEnvironmentOption; +{$ENDIF MSWINDOWS} +{$IFDEF CLR} +type + DWORD = LongWord; +{$ENDIF CLR} + +function DelEnvironmentVar(const Name: string): Boolean; +function ExpandEnvironmentVar(var Value: string): Boolean; +function GetEnvironmentVar(const Name: string; var Value: string): Boolean; overload; +function GetEnvironmentVar(const Name: string; var Value: string; Expand: Boolean): Boolean; overload; +function GetEnvironmentVars(const Vars: TStrings): Boolean; overload; +function GetEnvironmentVars(const Vars: TStrings; Expand: Boolean): Boolean; overload; +function SetEnvironmentVar(const Name, Value: string): Boolean; +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} +function CreateEnvironmentBlock(const Options: TEnvironmentOptions; const AdditionalVars: TStrings): PChar; +procedure DestroyEnvironmentBlock(var Env: PChar); +procedure SetGlobalEnvironmentVariable(VariableName, VariableContent: string); +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +// Common Folder Locations +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} +function GetCommonFilesFolder: string; +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} +function GetCurrentFolder: string; +{$IFDEF MSWINDOWS} +function GetProgramFilesFolder: string; +{$IFNDEF CLR} +function GetWindowsFolder: string; +{$ENDIF ~CLR} +function GetWindowsSystemFolder: string; +function GetWindowsTempFolder: string; + +function GetDesktopFolder: string; +function GetProgramsFolder: string; +{$ENDIF MSWINDOWS} +function GetPersonalFolder: string; +{$IFDEF MSWINDOWS} +function GetFavoritesFolder: string; +function GetStartupFolder: string; +function GetRecentFolder: string; +function GetSendToFolder: string; +function GetStartmenuFolder: string; +function GetDesktopDirectoryFolder: string; +{$IFNDEF CLR} +function GetNethoodFolder: string; +function GetFontsFolder: string; +function GetCommonStartmenuFolder: string; +function GetCommonStartupFolder: string; +function GetPrinthoodFolder: string; +function GetProfileFolder: string; +{$ENDIF ~CLR} +function GetCommonProgramsFolder: string; +function GetCommonDesktopdirectoryFolder: string; +function GetCommonAppdataFolder: string; +function GetAppdataFolder: string; +function GetCommonFavoritesFolder: string; +function GetTemplatesFolder: string; +function GetInternetCacheFolder: string; +function GetCookiesFolder: string; +function GetHistoryFolder: string; + +{$IFNDEF CLR} +// Advanced Power Management (APM) +type + TAPMLineStatus = (alsOffline, alsOnline, alsUnknown); + TAPMBatteryFlag = (abfHigh, abfLow, abfCritical, abfCharging, abfNoBattery, abfUnknown); + TAPMBatteryFlags = set of TAPMBatteryFlag; + +function GetAPMLineStatus: TAPMLineStatus; +function GetAPMBatteryFlag: TAPMBatteryFlag; +function GetAPMBatteryFlags: TAPMBatteryFlags; +function GetAPMBatteryLifePercent: Integer; +function GetAPMBatteryLifeTime: DWORD; +function GetAPMBatteryFullLifeTime: DWORD; + +// Identification +type + TFileSystemFlag = + ( + fsCaseSensitive, // The file system supports case-sensitive file names. + fsCasePreservedNames, // The file system preserves the case of file names when it places a name on disk. + fsSupportsUnicodeOnDisk, // The file system supports Unicode in file names as they appear on disk. + fsPersistentACLs, // The file system preserves and enforces ACLs. For example, NTFS preserves and enforces ACLs, and FAT does not. + fsSupportsFileCompression, // The file system supports file-based compression. + fsSupportsVolumeQuotas, // The file system supports disk quotas. + fsSupportsSparseFiles, // The file system supports sparse files. + fsSupportsReparsePoints, // The file system supports reparse points. + fsSupportsRemoteStorage, // ? + fsVolumeIsCompressed, // The specified volume is a compressed volume; for example, a DoubleSpace volume. + fsSupportsObjectIds, // The file system supports object identifiers. + fsSupportsEncryption, // The file system supports the Encrypted File System (EFS). + fsSupportsNamedStreams, // The file system supports named streams. + fsVolumeIsReadOnly // The specified volume is read-only. + // Windows 2000/NT and Windows Me/98/95: This value is not supported. + ); + + TFileSystemFlags = set of TFileSystemFlag; + +function GetVolumeName(const Drive: string): string; +function GetVolumeSerialNumber(const Drive: string): string; +function GetVolumeFileSystem(const Drive: string): string; +function GetVolumeFileSystemFlags(const Volume: string): TFileSystemFlags; +{$ENDIF ~CLR} +{$ENDIF MSWINDOWS} +function GetIPAddress(const HostName: string): string; +{$IFDEF UNIX} +procedure GetIpAddresses(Results: TStrings); +{$ENDIF UNIX} +function GetLocalComputerName: string; +{$IFNDEF CLR} +function GetLocalUserName: string; +{$IFDEF MSWINDOWS} +function GetUserDomainName(const CurUser: string): string; +{$ENDIF MSWINDOWS} +function GetDomainName: string; +{$IFDEF MSWINDOWS} +function GetRegisteredCompany: string; +function GetRegisteredOwner: string; +function GetBIOSName: string; +function GetBIOSCopyright: string; +function GetBIOSExtendedInfo: string; +function GetBIOSDate: TDateTime; +{$ENDIF MSWINDOWS} + +// Processes, Tasks and Modules +type + TJclTerminateAppResult = (taError, taClean, taKill); +{$ENDIF ~CLR} + +function RunningProcessesList(const List: TStrings; FullPath: Boolean = True): Boolean; + +{$IFDEF MSWINDOWS} +{$IFNDEF CLR} +function LoadedModulesList(const List: TStrings; ProcessID: DWORD; HandlesOnly: Boolean = False): Boolean; +function GetTasksList(const List: TStrings): Boolean; + +function ModuleFromAddr(const Addr: Pointer): HMODULE; +{$IFNDEF FPC} +function IsSystemModule(const Module: HMODULE): Boolean; +{$ENDIF ~FPC} + +function IsMainAppWindow(Wnd: THandle): Boolean; +function IsWindowResponding(Wnd: THandle; Timeout: Integer): Boolean; + +function GetWindowIcon(Wnd: THandle; LargeIcon: Boolean): HICON; +function GetWindowCaption(Wnd: THandle): string; +function TerminateTask(Wnd: THandle; Timeout: Integer): TJclTerminateAppResult; +function TerminateApp(ProcessID: DWORD; Timeout: Integer): TJclTerminateAppResult; +{$ENDIF ~CLR} +{$ENDIF MSWINDOWS} + +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} +{.$IFNDEF FPC} +function GetPidFromProcessName(const ProcessName: string): DWORD; +function GetProcessNameFromWnd(Wnd: THandle): string; +function GetProcessNameFromPid(PID: DWORD): string; +function GetMainAppWndFromPid(PID: DWORD): THandle; +{.$ENDIF ~FPC} + +function GetShellProcessName: string; +{.$IFNDEF FPC} +function GetShellProcessHandle: THandle; +{.$ENDIF ~FPC} + +// Version Information +type + TWindowsVersion = + (wvUnknown, wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME, + wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4, wvWin2000, wvWinXP, + wvWin2003, wvWinXP64, wvWin2003R2, wvWinVista, wvWinLonghorn); + TNtProductType = + (ptUnknown, ptWorkStation, ptServer, ptAdvancedServer, + ptPersonal, ptProfessional, ptDatacenterServer, ptEnterprise, ptWebEdition); + TProcessorArchitecture = + (paUnknown, // unknown processor + pax8632, // x86 32 bit processors (some P4, Celeron, Athlon and older) + pax8664, // x86 64 bit processors (latest P4, Celeron and Athlon64) + paIA64); // Itanium processors + +var + { in case of additions, don't forget to update initialization section! } + IsWin95: Boolean = False; + IsWin95OSR2: Boolean = False; + IsWin98: Boolean = False; + IsWin98SE: Boolean = False; + IsWinME: Boolean = False; + IsWinNT: Boolean = False; + IsWinNT3: Boolean = False; + IsWinNT31: Boolean = False; + IsWinNT35: Boolean = False; + IsWinNT351: Boolean = False; + IsWinNT4: Boolean = False; + IsWin2K: Boolean = False; + IsWinXP: Boolean = False; + IsWin2003: Boolean = False; + IsWinXP64: Boolean = False; + IsWin2003R2: Boolean = False; + IsWinVista: Boolean = False; + IsWinLonghorn: Boolean = False; + +const + PROCESSOR_ARCHITECTURE_INTEL = 0; + {$EXTERNALSYM PROCESSOR_ARCHITECTURE_INTEL} + PROCESSOR_ARCHITECTURE_AMD64 = 9; + {$EXTERNALSYM PROCESSOR_ARCHITECTURE_AMD64} + PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 = 10; + {$EXTERNALSYM PROCESSOR_ARCHITECTURE_IA32_ON_WIN64} + PROCESSOR_ARCHITECTURE_IA64 = 6; + {$EXTERNALSYM PROCESSOR_ARCHITECTURE_IA64} + +function GetWindowsVersion: TWindowsVersion; +function NtProductType: TNtProductType; +function GetWindowsVersionString: string; +function NtProductTypeString: string; +function GetWindowsServicePackVersion: Integer; +function GetWindowsServicePackVersionString: string; +function GetOpenGLVersion(const Win: THandle; out Version, Vendor: AnsiString): Boolean; +function GetNativeSystemInfo(var SystemInfo: TSystemInfo): Boolean; +function GetProcessorArchitecture: TProcessorArchitecture; +function IsWindows64: Boolean; +{$ENDIF MSWINDOWS} + +function GetOSVersionString: string; + +// Hardware +{$IFDEF MSWINDOWS} +function GetMacAddresses(const Machine: string; const Addresses: TStrings): Integer; +{$ENDIF MSWINDOWS} +function ReadTimeStampCounter: Int64; + +type + TTLBInformation = (tiEntries, tiAssociativity); + TCacheInformation = (ciLineSize {in Bytes}, ciLinesPerTag, ciAssociativity, ciSize); + + TIntelSpecific = record + L2Cache: Cardinal; + CacheDescriptors: array [0..15] of Byte; + BrandID: Byte; + ExFeatures: Cardinal; + Ex64Features: Cardinal; + end; + + TCyrixSpecific = record + L1CacheInfo: array [0..3] of Byte; + TLBInfo: array [0..3] of Byte; + end; + + TAMDSpecific = record + ExFeatures: Cardinal; + MByteDataTLB: array [TTLBInformation] of Byte; + MByteInstructionTLB: array [TTLBInformation] of Byte; + KByteDataTLB: array [TTLBInformation] of Byte; + KByteInstructionTLB: array [TTLBInformation] of Byte; + L1DataCache: array [TCacheInformation] of Byte; + L1InstructionCache: array [TCacheInformation] of Byte; + L2MByteDataTLB: array [TTLBInformation] of Byte; // L2 TLB for 2-MByte and 4-MByte pages + L2MByteInstructionTLB: array [TTLBInformation] of Byte; // L2 TLB for 2-MByte and 4-MByte pages + L2KByteDataTLB: array [TTLBInformation] of Byte; // L2 TLB for 4-KByte pages + L2KByteInstructionTLB: array [TTLBInformation] of Byte; // L2 TLB for 4-KByte pages + L2Cache: Cardinal; + AdvancedPowerManagement: Cardinal; + PhysicalAddressSize: Byte; + VirtualAddressSize: Byte; + end; + + TVIASpecific = record + ExFeatures: Cardinal; + DataTLB: array [TTLBInformation] of Byte; + InstructionTLB: array [TTLBInformation] of Byte; + L1DataCache: array [TCacheInformation] of Byte; + L1InstructionCache: array [TCacheInformation] of Byte; + L2DataCache: Cardinal; + end; + + TTransmetaSpecific = record + ExFeatures: Cardinal; + DataTLB: array [TTLBInformation] of Byte; + CodeTLB: array [TTLBInformation] of Byte; + L1DataCache: array [TCacheInformation] of Byte; + L1CodeCache: array [TCacheInformation] of Byte; + L2Cache: Cardinal; + RevisionABCD: Cardinal; + RevisionXXXX: Cardinal; + Frequency: Cardinal; + CodeMorphingABCD: Cardinal; + CodeMorphingXXXX: Cardinal; + TransmetaFeatures: Cardinal; + TransmetaInformations: array [0..64] of Char; + CurrentVoltage: Cardinal; + CurrentFrequency: Cardinal; + CurrentPerformance: Cardinal; + end; + + TCacheFamily = ( + cfInstructionTLB, cfDataTLB, + cfL1InstructionCache, cfL1DataCache, + cfL2Cache, cfL3Cache, cfTrace, cfOther); + + TCacheInfo = record + D: Byte; + Family: TCacheFamily; + Size: Cardinal; + WaysOfAssoc: Byte; + LineSize: Byte; // for Normal Cache + LinePerSector: Byte; // for L3 Normal Cache + Entries: Cardinal; // for TLB + I: string; + end; + + TFreqInfo = record + RawFreq: Cardinal; + NormFreq: Cardinal; + InCycles: Cardinal; + ExTicks: Cardinal; + end; + +const + CPU_TYPE_INTEL = 1; + CPU_TYPE_CYRIX = 2; + CPU_TYPE_AMD = 3; + CPU_TYPE_TRANSMETA = 4; + CPU_TYPE_VIA = 5; + +type + TCpuInfo = record + HasInstruction: Boolean; + MMX: Boolean; + ExMMX: Boolean; + _3DNow: Boolean; + Ex3DNow: Boolean; + SSE: Byte; // SSE version 0 = no SSE, 1 = SSE, 2 = SSE2, 3 = SSE3 + IsFDIVOK: Boolean; + Is64Bits: Boolean; + HasCacheInfo: Boolean; + HasExtendedInfo: Boolean; + PType: Byte; + Family: Byte; + ExtendedFamily: Byte; + Model: Byte; + ExtendedModel: Byte; + Stepping: Byte; + Features: Cardinal; + FrequencyInfo: TFreqInfo; + VendorIDString: array [0..11] of Char; + Manufacturer: array [0..9] of Char; + CpuName: array [0..47] of Char; + L1DataCacheSize: Cardinal; // in kByte + L1DataCacheLineSize: Byte; // in Byte + L1DataCacheAssociativity: Byte; + L1InstructionCacheSize: Cardinal; // in kByte + L1InstructionCacheLineSize: Byte; // in Byte + L1InstructionCacheAssociativity: Byte; + L2CacheSize: Cardinal; // in kByte + L2CacheLineSize: Byte; // in Byte + L2CacheAssociativity: Byte; + L3CacheSize: Cardinal; // in kByte + L3CacheLineSize: Byte; // in Byte + L3CacheAssociativity: Byte; + L3LinesPerSector: Byte; + // todo: TLB + case CpuType: Byte of + CPU_TYPE_INTEL: (IntelSpecific: TIntelSpecific;); + CPU_TYPE_CYRIX: (CyrixSpecific: TCyrixSpecific;); + CPU_TYPE_AMD: (AMDSpecific: TAMDSpecific;); + CPU_TYPE_TRANSMETA: (TransmetaSpecific: TTransmetaSpecific;); + CPU_TYPE_VIA: (ViaSpecific: TViaSpecific;); + end; + +const + VendorIDIntel: array [0..11] of Char = 'GenuineIntel'; + VendorIDCyrix: array [0..11] of Char = 'CyrixInstead'; + VendorIDAMD: array [0..11] of Char = 'AuthenticAMD'; + VendorIDTransmeta: array [0..11] of Char = 'GenuineTMx86'; + VendorIDVIA: array [0..11] of Char = 'CentaurHauls'; + +// Constants to be used with Feature Flag set of a CPU +// eg. IF (Features and FPU_FLAG = FPU_FLAG) THEN CPU has Floating-Point unit on +// chip. However, Intel claims that in future models, a zero in the feature +// flags will mean that the chip has that feature, however, the following flags +// will work for any production 80x86 chip or clone. +// eg. IF (Features and FPU_FLAG = 0) then CPU has Floating-Point unit on chip. + +const + { 32 bits in a DWord Value } + BIT_0 = $00000001; + BIT_1 = $00000002; + BIT_2 = $00000004; + BIT_3 = $00000008; + BIT_4 = $00000010; + BIT_5 = $00000020; + BIT_6 = $00000040; + BIT_7 = $00000080; + BIT_8 = $00000100; + BIT_9 = $00000200; + BIT_10 = $00000400; + BIT_11 = $00000800; + BIT_12 = $00001000; + BIT_13 = $00002000; + BIT_14 = $00004000; + BIT_15 = $00008000; + BIT_16 = $00010000; + BIT_17 = $00020000; + BIT_18 = $00040000; + BIT_19 = $00080000; + BIT_20 = $00100000; + BIT_21 = $00200000; + BIT_22 = $00400000; + BIT_23 = $00800000; + BIT_24 = $01000000; + BIT_25 = $02000000; + BIT_26 = $04000000; + BIT_27 = $08000000; + BIT_28 = $10000000; + BIT_29 = $20000000; + BIT_30 = $40000000; + BIT_31 = DWORD($80000000); + + { Standard Feature Flags } + FPU_FLAG = BIT_0; // Floating-Point unit on chip + VME_FLAG = BIT_1; // Virtual Mode Extention + DE_FLAG = BIT_2; // Debugging Extention + PSE_FLAG = BIT_3; // Page Size Extention + TSC_FLAG = BIT_4; // Time Stamp Counter + MSR_FLAG = BIT_5; // Model Specific Registers + PAE_FLAG = BIT_6; // Physical Address Extention + MCE_FLAG = BIT_7; // Machine Check Exception + CX8_FLAG = BIT_8; // CMPXCHG8 Instruction + APIC_FLAG = BIT_9; // Software-accessible local APIC on Chip + BIT_10_FLAG = BIT_10; // Reserved, do not count on value + SEP_FLAG = BIT_11; // Fast System Call + MTRR_FLAG = BIT_12; // Memory Type Range Registers + PGE_FLAG = BIT_13; // Page Global Enable + MCA_FLAG = BIT_14; // Machine Check Architecture + CMOV_FLAG = BIT_15; // Conditional Move Instruction + PAT_FLAG = BIT_16; // Page Attribute Table + PSE36_FLAG = BIT_17; // 36-bit Page Size Extention + PSN_FLAG = BIT_18; // Processor serial number is present and enabled + CLFLSH_FLAG = BIT_19; // CLFLUSH intruction + BIT_20_FLAG = BIT_20; // Reserved, do not count on value + DS_FLAG = BIT_21; // Debug store + ACPI_FLAG = BIT_22; // Thermal monitor and clock control + MMX_FLAG = BIT_23; // MMX technology + FXSR_FLAG = BIT_24; // Fast Floating Point Save and Restore + SSE_FLAG = BIT_25; // Streaming SIMD Extensions + SSE2_FLAG = BIT_26; // Streaming SIMD Extensions 2 + SS_FLAG = BIT_27; // Self snoop + HTT_FLAG = BIT_28; // Hyper-threading technology + TM_FLAG = BIT_29; // Thermal monitor + BIT_30_FLAG = BIT_30; // Reserved, do not count on value + PBE_FLAG = BIT_31; // Pending Break Enable + + { Standard Intel Feature Flags } + INTEL_FPU = BIT_0; // Floating-Point unit on chip + INTEL_VME = BIT_1; // Virtual Mode Extention + INTEL_DE = BIT_2; // Debugging Extention + INTEL_PSE = BIT_3; // Page Size Extention + INTEL_TSC = BIT_4; // Time Stamp Counter + INTEL_MSR = BIT_5; // Model Specific Registers + INTEL_PAE = BIT_6; // Physical Address Extention + INTEL_MCE = BIT_7; // Machine Check Exception + INTEL_CX8 = BIT_8; // CMPXCHG8 Instruction + INTEL_APIC = BIT_9; // Software-accessible local APIC on Chip + INTEL_BIT_10 = BIT_10; // Reserved, do not count on value + INTEL_SEP = BIT_11; // Fast System Call + INTEL_MTRR = BIT_12; // Memory Type Range Registers + INTEL_PGE = BIT_13; // Page Global Enable + INTEL_MCA = BIT_14; // Machine Check Architecture + INTEL_CMOV = BIT_15; // Conditional Move Instruction + INTEL_PAT = BIT_16; // Page Attribute Table + INTEL_PSE36 = BIT_17; // 36-bit Page Size Extention + INTEL_PSN = BIT_18; // Processor serial number is present and enabled + INTEL_CLFLSH = BIT_19; // CLFLUSH intruction + INTEL_BIT_20 = BIT_20; // Reserved, do not count on value + INTEL_DS = BIT_21; // Debug store + INTEL_ACPI = BIT_22; // Thermal monitor and clock control + INTEL_MMX = BIT_23; // MMX technology + INTEL_FXSR = BIT_24; // Fast Floating Point Save and Restore + INTEL_SSE = BIT_25; // Streaming SIMD Extensions + INTEL_SSE2 = BIT_26; // Streaming SIMD Extensions 2 + INTEL_SS = BIT_27; // Self snoop + INTEL_HTT = BIT_28; // Hyper-threading technology + INTEL_TM = BIT_29; // Thermal monitor + INTEL_BIT_30 = BIT_30; // Reserved, do not count on value + INTEL_PBE = BIT_31; // Pending Break Enable + + { Extended Intel Feature Flags } + EINTEL_SSE3 = BIT_0; // Streaming SIMD Extensions 3 + EINTEL_BIT_1 = BIT_1; // Reserved, do not count on value + EINTEL_BIT_2 = BIT_2; // Reserved, do not count on value + EINTEL_MONITOR = BIT_3; // Monitor/MWAIT + EINTEL_DSCPL = BIT_4; // CPL Qualified debug Store + EINTEL_BIT_5 = BIT_5; // Reserved, do not count on value + EINTEL_BIT_6 = BIT_6; // Reserved, do not count on value + EINTEL_EST = BIT_7; // Enhanced Intel Speedstep technology + EINTEL_TM2 = BIT_8; // Thermal monitor 2 + EINTEL_BIT_9 = BIT_9; // Reserved, do not count on value + EINTEL_CNXTID = BIT_10; // L1 Context ID + EINTEL_BIT_11 = BIT_11; // Reserved, do not count on value + EINTEL_BIT_12 = BIT_12; // Reserved, do not count on value + EINTEL_BIT_13 = BIT_13; // Reserved, do not count on value + EINTEL_XTPR = BIT_14; // Send Task Priority messages + EINTEL_BIT_15 = BIT_15; // Reserved, do not count on value + EINTEL_BIT_16 = BIT_16; // Reserved, do not count on value + EINTEL_BIT_17 = BIT_17; // Reserved, do not count on value + EINTEL_BIT_18 = BIT_18; // Reserved, do not count on value + EINTEL_BIT_19 = BIT_19; // Reserved, do not count on value + EINTEL_BIT_20 = BIT_20; // Reserved, do not count on value + EINTEL_BIT_21 = BIT_21; // Reserved, do not count on value + EINTEL_BIT_22 = BIT_22; // Reserved, do not count on value + EINTEL_BIT_23 = BIT_23; // Reserved, do not count on value + EINTEL_BIT_24 = BIT_24; // Reserved, do not count on value + EINTEL_BIT_25 = BIT_25; // Reserved, do not count on value + EINTEL_BIT_26 = BIT_26; // Reserved, do not count on value + EINTEL_BIT_27 = BIT_27; // Reserved, do not count on value + EINTEL_BIT_28 = BIT_28; // Reserved, do not count on value + EINTEL_BIT_29 = BIT_29; // Reserved, do not count on value + EINTEL_BIT_30 = BIT_30; // Reserved, do not count on value + EINTEL_BIT_31 = BIT_31; // Reserved, do not count on value + + { Extended Intel 64 Bits Feature Flags } + EINTEL64_BIT_0 = BIT_0; // Reserved, do not count on value + EINTEL64_BIT_1 = BIT_1; // Reserved, do not count on value + EINTEL64_BIT_2 = BIT_2; // Reserved, do not count on value + EINTEL64_BIT_3 = BIT_3; // Reserved, do not count on value + EINTEL64_BIT_4 = BIT_4; // Reserved, do not count on value + EINTEL64_BIT_5 = BIT_5; // Reserved, do not count on value + EINTEL64_BIT_6 = BIT_6; // Reserved, do not count on value + EINTEL64_BIT_7 = BIT_7; // Reserved, do not count on value + EINTEL64_BIT_8 = BIT_8; // Reserved, do not count on value + EINTEL64_BIT_9 = BIT_9; // Reserved, do not count on value + EINTEL64_BIT_10 = BIT_10; // Reserved, do not count on value + EINTEL64_SYS = BIT_11; // 64 Bit - SYSCALL SYSRET + EINTEL64_BIT_12 = BIT_12; // Reserved, do not count on value + EINTEL64_BIT_13 = BIT_13; // Reserved, do not count on value + EINTEL64_BIT_14 = BIT_14; // Reserved, do not count on value + EINTEL64_BIT_15 = BIT_15; // Reserved, do not count on value + EINTEL64_BIT_16 = BIT_16; // Reserved, do not count on value + EINTEL64_BIT_17 = BIT_17; // Reserved, do not count on value + EINTEL64_BIT_18 = BIT_18; // Reserved, do not count on value + EINTEL64_BIT_19 = BIT_19; // Reserved, do not count on value + EINTEL64_BIT_20 = BIT_20; // Reserved, do not count on value + EINTEL64_BIT_21 = BIT_21; // Reserved, do not count on value + EINTEL64_BIT_22 = BIT_22; // Reserved, do not count on value + EINTEL64_BIT_23 = BIT_23; // Reserved, do not count on value + EINTEL64_BIT_24 = BIT_24; // Reserved, do not count on value + EINTEL64_BIT_25 = BIT_25; // Reserved, do not count on value + EINTEL64_BIT_26 = BIT_26; // Reserved, do not count on value + EINTEL64_BIT_27 = BIT_27; // Reserved, do not count on value + EINTEL64_BIT_28 = BIT_28; // Reserved, do not count on value + EINTEL64_EM64T = BIT_29; // Intel® Extended Memory 64 Technology + EINTEL64_BIT_30 = BIT_30; // Reserved, do not count on value + EINTEL64_BIT_31 = BIT_31; // Reserved, do not count on value + + { AMD Standard Feature Flags } + AMD_FPU = BIT_0; // Floating-Point unit on chip + AMD_VME = BIT_1; // Virtual Mode Extention + AMD_DE = BIT_2; // Debugging Extention + AMD_PSE = BIT_3; // Page Size Extention + AMD_TSC = BIT_4; // Time Stamp Counter + AMD_MSR = BIT_5; // Model Specific Registers + AMD_PAE = BIT_6; // Physical address Extensions + AMD_MCE = BIT_7; // Machine Check Exception + AMD_CX8 = BIT_8; // CMPXCHG8 Instruction + AMD_APIC = BIT_9; // Software-accessible local APIC on Chip + AMD_BIT_10 = BIT_10; // Reserved, do not count on value + AMD_SEP_BIT = BIT_11; // SYSENTER and SYSEXIT instructions + AMD_MTRR = BIT_12; // Memory Type Range Registers + AMD_PGE = BIT_13; // Page Global Enable + AMD_MCA = BIT_14; // Machine Check Architecture + AMD_CMOV = BIT_15; // Conditional Move Instruction + AMD_PAT = BIT_16; // Page Attribute Table + AMD_PSE2 = BIT_17; // Page Size Extensions + AMD_BIT_18 = BIT_18; // Reserved, do not count on value + AMD_CLFLSH = BIT_19; // CLFLUSH instruction + AMD_BIT_20 = BIT_20; // Reserved, do not count on value + AMD_BIT_21 = BIT_21; // Reserved, do not count on value + AMD_BIT_22 = BIT_22; // Reserved, do not count on value + AMD_MMX = BIT_23; // MMX technology + AMD_FX = BIT_24; // FXSAVE and FXSTORE instructions + AMD_SSE = BIT_25; // SSE Extensions + AMD_SSE2 = BIT_26; // SSE2 Extensions + AMD_BIT_27 = BIT_27; // Reserved, do not count on value + AMD_BIT_28 = BIT_28; // Reserved, do not count on value + AMD_BIT_29 = BIT_29; // Reserved, do not count on value + AMD_BIT_30 = BIT_30; // Reserved, do not count on value + AMD_BIT_31 = BIT_31; // Reserved, do not count on value + + { AMD Enhanced Feature Flags } + EAMD_FPU = BIT_0; // Floating-Point unit on chip + EAMD_VME = BIT_1; // Virtual Mode Extention + EAMD_DE = BIT_2; // Debugging Extention + EAMD_PSE = BIT_3; // Page Size Extention + EAMD_TSC = BIT_4; // Time Stamp Counter + EAMD_MSR = BIT_5; // Model Specific Registers + EAMD_PAE = BIT_6; // Physical-address extensions + EAMD_MCE = BIT_7; // Machine Check Exception + EAMD_CX8 = BIT_8; // CMPXCHG8 Instruction + EAMD_APIC = BIT_9; // Advanced Programmable Interrupt Controler + EAMD_BIT_10 = BIT_10; // Reserved, do not count on value + EAMD_SEP = BIT_11; // Fast System Call + EAMD_MTRR = BIT_12; // Memory-Type Range Registers + EAMD_PGE = BIT_13; // Page Global Enable + EAMD_MCA = BIT_14; // Machine Check Architecture + EAMD_CMOV = BIT_15; // Conditional Move Intructions + EAMD_PAT = BIT_16; // Page Attributes Table + EAMD_PSE2 = BIT_17; // Page Size Extensions + EAMD_BIT_18 = BIT_18; // Reserved, do not count on value + EAMD_BIT_19 = BIT_19; // Reserved, do not count on value + EAMD_NEPP = BIT_20; // No-Execute Page Protection + EAMD_BIT_21 = BIT_21; // Reserved, do not count on value + EAMD_EXMMX = BIT_22; // AMD Extensions to MMX technology + EAMD_MMX = BIT_23; // MMX technology + EAMD_FX = BIT_24; // FXSAVE and FXSTORE instructions + EAMD_FFX = BIT_25; // Fast FXSAVE and FXSTORE instructions + EAMD_BIT_26 = BIT_26; // Reserved, do not count on value + EAMD_BIT_27 = BIT_27; // Reserved, do not count on value + EAMD_BIT_28 = BIT_28; // Reserved, do not count on value + EAMD_LONG = BIT_29; // Long Mode (64-bit Core) + EAMD_EX3DNOW = BIT_30; // AMD Extensions to 3DNow! intructions + EAMD_3DNOW = BIT_31; // AMD 3DNOW! Technology + + { AMD Power Management Features Flags } + PAMD_TEMPSENSOR = $00000001; // Temperature Sensor + PAMD_FREQUENCYID = $00000002; // Frequency ID Control + PAMD_VOLTAGEID = $00000004; // Voltage ID Control + PAMD_THERMALTRIP = $00000008; // Thermal Trip + PAMD_THERMALMONITOR = $00000010; // Thermal Monitoring + PAMD_SOFTTHERMCONTROL = $00000020; // Software Thermal Control + + { AMD TLB and L1 Associativity constants } + AMD_ASSOC_RESERVED = 0; + AMD_ASSOC_DIRECT = 1; + // 2 to 254 = direct value to the associativity + AMD_ASSOC_FULLY = 255; + + { AMD L2 Cache Associativity constants } + AMD_L2_ASSOC_DISABLED = 0; + AMD_L2_ASSOC_DIRECT = 1; + AMD_L2_ASSOC_2WAY = 2; + AMD_L2_ASSOC_4WAY = 4; + AMD_L2_ASSOC_8WAY = 6; + AMD_L2_ASSOC_16WAY = 8; + AMD_L2_ASSOC_FULLY = 15; + + { VIA Standard Feature Flags } + VIA_FPU = BIT_0; // FPU present + VIA_VME = BIT_1; // Virtual Mode Extension + VIA_DE = BIT_2; // Debugging extensions + VIA_PSE = BIT_3; // Page Size Extensions (4MB) + VIA_TSC = BIT_4; // Time Stamp Counter + VIA_MSR = BIT_5; // Model Specific Registers + VIA_PAE = BIT_6; // Physical Address Extension + VIA_MCE = BIT_7; // Machine Check Exception + VIA_CX8 = BIT_8; // CMPXCHG8B instruction + VIA_APIC = BIT_9; // APIC supported + VIA_BIT_10 = BIT_10; // Reserved, do not count on value + VIA_SEP = BIT_11; // Fast System Call + VIA_MTRR = BIT_12; // Memory Range Registers + VIA_PTE = BIT_13; // PTE Global Bit + VIA_MCA = BIT_14; // Machine Check Architecture + VIA_CMOVE = BIT_15; // Conditional Move + VIA_PAT = BIT_16; // Page Attribute Table + VIA_PSE2 = BIT_17; // 36-bit Page Size Extension + VIA_SNUM = BIT_18; // Processor serial number + VIA_BIT_19 = BIT_19; // Reserved, do not count on value + VIA_BIT_20 = BIT_20; // Reserved, do not count on value + VIA_BIT_21 = BIT_21; // Reserved, do not count on value + VIA_BIT_22 = BIT_22; // Reserved, do not count on value + VIA_MMX = BIT_23; // MMX + VIA_FX = BIT_24; // FXSAVE and FXSTORE instructions + VIA_SSE = BIT_25; // Streaming SIMD Extension + VIA_BIT_26 = BIT_26; // Reserved, do not count on value + VIA_BIT_27 = BIT_27; // Reserved, do not count on value + VIA_BIT_28 = BIT_28; // Reserved, do not count on value + VIA_BIT_29 = BIT_29; // Reserved, do not count on value + VIA_BIT_30 = BIT_30; // Reserved, do not count on value + VIA_3DNOW = BIT_31; // 3DNow! Technology + + { VIA Extended Feature Flags } + EVIA_AIS = BIT_0; // Alternate Instruction Set + EVIA_AISE = BIT_1; // Alternate Instruction Set Enabled + EVIA_NO_RNG = BIT_2; // NO Random Number Generator + EVIA_RNGE = BIT_3; // Random Number Generator Enabled + EVIA_MSR = BIT_4; // Longhaul MSR 0x110A available + EVIA_FEMMS = BIT_5; // FEMMS instruction Present + EVIA_NO_ACE = BIT_6; // Advanced Cryptography Engine NOT Present + EVIA_ACEE = BIT_7; // ACE Enabled + EVIA_BIT_8 = BIT_8; // Reserved, do not count on value + EVIA_BIT_9 = BIT_9; // Reserved, do not count on value + EVIA_BIT_10 = BIT_10; // Reserved, do not count on value + EVIA_BIT_11 = BIT_11; // Reserved, do not count on value + EVIA_BIT_12 = BIT_12; // Reserved, do not count on value + EVIA_BIT_13 = BIT_13; // Reserved, do not count on value + EVIA_BIT_14 = BIT_14; // Reserved, do not count on value + EVIA_BIT_15 = BIT_15; // Reserved, do not count on value + EVIA_BIT_16 = BIT_16; // Reserved, do not count on value + EVIA_BIT_17 = BIT_17; // Reserved, do not count on value + EVIA_BIT_18 = BIT_18; // Reserved, do not count on value + EVIA_BIT_19 = BIT_19; // Reserved, do not count on value + EVIA_BIT_20 = BIT_20; // Reserved, do not count on value + EVIA_BIT_21 = BIT_21; // Reserved, do not count on value + EVIA_BIT_22 = BIT_22; // Reserved, do not count on value + EVIA_BIT_23 = BIT_23; // Reserved, do not count on value + EVIA_BIT_24 = BIT_24; // Reserved, do not count on value + EVIA_BIT_25 = BIT_25; // Reserved, do not count on value + EVIA_BIT_26 = BIT_26; // Reserved, do not count on value + EVIA_BIT_27 = BIT_27; // Reserved, do not count on value + EVIA_BIT_28 = BIT_28; // Reserved, do not count on value + EVIA_BIT_29 = BIT_29; // Reserved, do not count on value + EVIA_BIT_30 = BIT_30; // Reserved, do not count on value + EVIA_BIT_31 = BIT_31; // Reserved, do not count on value + + { Cyrix Standard Feature Flags } + CYRIX_FPU = BIT_0; // Floating-Point unit on chip + CYRIX_VME = BIT_1; // Virtual Mode Extention + CYRIX_DE = BIT_2; // Debugging Extention + CYRIX_PSE = BIT_3; // Page Size Extention + CYRIX_TSC = BIT_4; // Time Stamp Counter + CYRIX_MSR = BIT_5; // Model Specific Registers + CYRIX_PAE = BIT_6; // Physical Address Extention + CYRIX_MCE = BIT_7; // Machine Check Exception + CYRIX_CX8 = BIT_8; // CMPXCHG8 Instruction + CYRIX_APIC = BIT_9; // Software-accessible local APIC on Chip + CYRIX_BIT_10 = BIT_10; // Reserved, do not count on value + CYRIX_BIT_11 = BIT_11; // Reserved, do not count on value + CYRIX_MTRR = BIT_12; // Memory Type Range Registers + CYRIX_PGE = BIT_13; // Page Global Enable + CYRIX_MCA = BIT_14; // Machine Check Architecture + CYRIX_CMOV = BIT_15; // Conditional Move Instruction + CYRIX_BIT_16 = BIT_16; // Reserved, do not count on value + CYRIX_BIT_17 = BIT_17; // Reserved, do not count on value + CYRIX_BIT_18 = BIT_18; // Reserved, do not count on value + CYRIX_BIT_19 = BIT_19; // Reserved, do not count on value + CYRIX_BIT_20 = BIT_20; // Reserved, do not count on value + CYRIX_BIT_21 = BIT_21; // Reserved, do not count on value + CYRIX_BIT_22 = BIT_22; // Reserved, do not count on value + CYRIX_MMX = BIT_23; // MMX technology + CYRIX_BIT_24 = BIT_24; // Reserved, do not count on value + CYRIX_BIT_25 = BIT_25; // Reserved, do not count on value + CYRIX_BIT_26 = BIT_26; // Reserved, do not count on value + CYRIX_BIT_27 = BIT_27; // Reserved, do not count on value + CYRIX_BIT_28 = BIT_28; // Reserved, do not count on value + CYRIX_BIT_29 = BIT_29; // Reserved, do not count on value + CYRIX_BIT_30 = BIT_30; // Reserved, do not count on value + CYRIX_BIT_31 = BIT_31; // Reserved, do not count on value + + { Cyrix Enhanced Feature Flags } + ECYRIX_FPU = BIT_0; // Floating-Point unit on chip + ECYRIX_VME = BIT_1; // Virtual Mode Extention + ECYRIX_DE = BIT_2; // Debugging Extention + ECYRIX_PSE = BIT_3; // Page Size Extention + ECYRIX_TSC = BIT_4; // Time Stamp Counter + ECYRIX_MSR = BIT_5; // Model Specific Registers + ECYRIX_PAE = BIT_6; // Physical Address Extention + ECYRIX_MCE = BIT_7; // Machine Check Exception + ECYRIX_CX8 = BIT_8; // CMPXCHG8 Instruction + ECYRIX_APIC = BIT_9; // Software-accessible local APIC on Chip + ECYRIX_SEP = BIT_10; // Fast System Call + ECYRIX_BIT_11 = BIT_11; // Reserved, do not count on value + ECYRIX_MTRR = BIT_12; // Memory Type Range Registers + ECYRIX_PGE = BIT_13; // Page Global Enable + ECYRIX_MCA = BIT_14; // Machine Check Architecture + ECYRIX_ICMOV = BIT_15; // Integer Conditional Move Instruction + ECYRIX_FCMOV = BIT_16; // Floating Point Conditional Move Instruction + ECYRIX_BIT_17 = BIT_17; // Reserved, do not count on value + ECYRIX_BIT_18 = BIT_18; // Reserved, do not count on value + ECYRIX_BIT_19 = BIT_19; // Reserved, do not count on value + ECYRIX_BIT_20 = BIT_20; // Reserved, do not count on value + ECYRIX_BIT_21 = BIT_21; // Reserved, do not count on value + ECYRIX_BIT_22 = BIT_22; // Reserved, do not count on value + ECYRIX_MMX = BIT_23; // MMX technology + ECYRIX_EMMX = BIT_24; // Extended MMX Technology + ECYRIX_BIT_25 = BIT_25; // Reserved, do not count on value + ECYRIX_BIT_26 = BIT_26; // Reserved, do not count on value + ECYRIX_BIT_27 = BIT_27; // Reserved, do not count on value + ECYRIX_BIT_28 = BIT_28; // Reserved, do not count on value + ECYRIX_BIT_29 = BIT_29; // Reserved, do not count on value + ECYRIX_BIT_30 = BIT_30; // Reserved, do not count on value + ECYRIX_BIT_31 = BIT_31; // Reserved, do not count on value + + { Transmeta Features } + TRANSMETA_FPU = BIT_0; // Floating-Point unit on chip + TRANSMETA_VME = BIT_1; // Virtual Mode Extention + TRANSMETA_DE = BIT_2; // Debugging Extention + TRANSMETA_PSE = BIT_3; // Page Size Extention + TRANSMETA_TSC = BIT_4; // Time Stamp Counter + TRANSMETA_MSR = BIT_5; // Model Specific Registers + TRANSMETA_BIT_6 = BIT_6; // Reserved, do not count on value + TRANSMETA_BIT_7 = BIT_7; // Reserved, do not count on value + TRANSMETA_CX8 = BIT_8; // CMPXCHG8 Instruction + TRANSMETA_BIT_9 = BIT_9; // Reserved, do not count on value + TRANSMETA_BIT_10 = BIT_10; // Reserved, do not count on value + TRANSMETA_SEP = BIT_11; // Fast system Call Extensions + TRANSMETA_BIT_12 = BIT_12; // Reserved, do not count on value + TRANSMETA_BIT_13 = BIT_13; // Reserved, do not count on value + TRANSMETA_BIT_14 = BIT_14; // Reserved, do not count on value + TRANSMETA_CMOV = BIT_15; // Conditional Move Instruction + TRANSMETA_BIT_16 = BIT_16; // Reserved, do not count on value + TRANSMETA_BIT_17 = BIT_17; // Reserved, do not count on value + TRANSMETA_PSN = BIT_18; // Processor Serial Number + TRANSMETA_BIT_19 = BIT_19; // Reserved, do not count on value + TRANSMETA_BIT_20 = BIT_20; // Reserved, do not count on value + TRANSMETA_BIT_21 = BIT_21; // Reserved, do not count on value + TRANSMETA_BIT_22 = BIT_22; // Reserved, do not count on value + TRANSMETA_MMX = BIT_23; // MMX technology + TRANSMETA_BIT_24 = BIT_24; // Reserved, do not count on value + TRANSMETA_BIT_25 = BIT_25; // Reserved, do not count on value + TRANSMETA_BIT_26 = BIT_26; // Reserved, do not count on value + TRANSMETA_BIT_27 = BIT_27; // Reserved, do not count on value + TRANSMETA_BIT_28 = BIT_28; // Reserved, do not count on value + TRANSMETA_BIT_29 = BIT_29; // Reserved, do not count on value + TRANSMETA_BIT_30 = BIT_30; // Reserved, do not count on value + TRANSMETA_BIT_31 = BIT_31; // Reserved, do not count on value + + { Extended Transmeta Features } + ETRANSMETA_FPU = BIT_0; // Floating-Point unit on chip + ETRANSMETA_VME = BIT_1; // Virtual Mode Extention + ETRANSMETA_DE = BIT_2; // Debugging Extention + ETRANSMETA_PSE = BIT_3; // Page Size Extention + ETRANSMETA_TSC = BIT_4; // Time Stamp Counter + ETRANSMETA_MSR = BIT_5; // Model Specific Registers + ETRANSMETA_BIT_6 = BIT_6; // Reserved, do not count on value + ETRANSMETA_BIT_7 = BIT_7; // Reserved, do not count on value + ETRANSMETA_CX8 = BIT_8; // CMPXCHG8 Instruction + ETRANSMETA_BIT_9 = BIT_9; // Reserved, do not count on value + ETRANSMETA_BIT_10 = BIT_10; // Reserved, do not count on value + ETRANSMETA_BIT_11 = BIT_11; // Reserved, do not count on value + ETRANSMETA_BIT_12 = BIT_12; // Reserved, do not count on value + ETRANSMETA_BIT_13 = BIT_13; // Reserved, do not count on value + ETRANSMETA_BIT_14 = BIT_14; // Reserved, do not count on value + ETRANSMETA_CMOV = BIT_15; // Conditional Move Instruction + ETRANSMETA_FCMOV = BIT_16; // Float Conditional Move Instruction + ETRANSMETA_BIT_17 = BIT_17; // Reserved, do not count on value + ETRANSMETA_BIT_18 = BIT_18; // Reserved, do not count on value + ETRANSMETA_BIT_19 = BIT_19; // Reserved, do not count on value + ETRANSMETA_BIT_20 = BIT_20; // Reserved, do not count on value + ETRANSMETA_BIT_21 = BIT_21; // Reserved, do not count on value + ETRANSMETA_BIT_22 = BIT_22; // Reserved, do not count on value + ETRANSMETA_MMX = BIT_23; // MMX technology + ETRANSMETA_BIT_24 = BIT_24; // Reserved, do not count on value + ETRANSMETA_BIT_25 = BIT_25; // Reserved, do not count on value + ETRANSMETA_BIT_26 = BIT_26; // Reserved, do not count on value + ETRANSMETA_BIT_27 = BIT_27; // Reserved, do not count on value + ETRANSMETA_BIT_28 = BIT_28; // Reserved, do not count on value + ETRANSMETA_BIT_29 = BIT_29; // Reserved, do not count on value + ETRANSMETA_BIT_30 = BIT_30; // Reserved, do not count on value + ETRANSMETA_BIT_31 = BIT_31; // Reserved, do not count on value + + { Transmeta Specific Features } + STRANSMETA_RECOVERY = BIT_0; // Recovery Mode + STRANSMETA_LONGRUN = BIT_1; // Long Run + STRANSMETA_BIT_2 = BIT_2; // Debugging Extention + STRANSMETA_LRTI = BIT_3; // Long Run Table Interface + STRANSMETA_BIT_4 = BIT_4; // Reserved, do not count on value + STRANSMETA_BIT_5 = BIT_5; // Reserved, do not count on value + STRANSMETA_BIT_6 = BIT_6; // Reserved, do not count on value + STRANSMETA_PTTI1 = BIT_7; // Persistent Translation Technology 1.x + STRANSMETA_PTTI2 = BIT_8; // Persistent Translation Technology 2.0 + STRANSMETA_BIT_9 = BIT_9; // Reserved, do not count on value + STRANSMETA_BIT_10 = BIT_10; // Reserved, do not count on value + STRANSMETA_BIT_11 = BIT_11; // Reserved, do not count on value + STRANSMETA_BIT_12 = BIT_12; // Reserved, do not count on value + STRANSMETA_BIT_13 = BIT_13; // Reserved, do not count on value + STRANSMETA_BIT_14 = BIT_14; // Reserved, do not count on value + STRANSMETA_BIT_15 = BIT_15; // Reserved, do not count on value + STRANSMETA_BIT_16 = BIT_16; // Reserved, do not count on value + STRANSMETA_BIT_17 = BIT_17; // Reserved, do not count on value + STRANSMETA_BIT_18 = BIT_18; // Reserved, do not count on value + STRANSMETA_BIT_19 = BIT_19; // Reserved, do not count on value + STRANSMETA_BIT_20 = BIT_20; // Reserved, do not count on value + STRANSMETA_BIT_21 = BIT_21; // Reserved, do not count on value + STRANSMETA_BIT_22 = BIT_22; // Reserved, do not count on value + STRANSMETA_BIT_23 = BIT_23; // Reserved, do not count on value + STRANSMETA_BIT_24 = BIT_24; // Reserved, do not count on value + STRANSMETA_BIT_25 = BIT_25; // Reserved, do not count on value + STRANSMETA_BIT_26 = BIT_26; // Reserved, do not count on value + STRANSMETA_BIT_27 = BIT_27; // Reserved, do not count on value + STRANSMETA_BIT_28 = BIT_28; // Reserved, do not count on value + STRANSMETA_BIT_29 = BIT_29; // Reserved, do not count on value + STRANSMETA_BIT_30 = BIT_30; // Reserved, do not count on value + STRANSMETA_BIT_31 = BIT_31; // Reserved, do not count on value + + { Constants of bits of the MXCSR register - Intel and AMD processors that support SSE instructions} + MXCSR_IE = BIT_0; // Invalid Operation flag + MXCSR_DE = BIT_1; // Denormal flag + MXCSR_ZE = BIT_2; // Divide by Zero flag + MXCSR_OE = BIT_3; // Overflow flag + MXCSR_UE = BIT_4; // Underflow flag + MXCSR_PE = BIT_5; // Precision flag + MXCSR_DAZ = BIT_6; // Denormal are Zero flag + MXCSR_IM = BIT_7; // Invalid Operation mask + MXCSR_DM = BIT_8; // Denormal mask + MXCSR_ZM = BIT_9; // Divide by Zero mask + MXCSR_OM = BIT_10; // Overflow mask + MXCSR_UM = BIT_11; // Underflow mask + MXCSR_PM = BIT_12; // Precision mask + MXCSR_RC1 = BIT_13; // Rounding control, bit 1 + MXCSR_RC2 = BIT_14; // Rounding control, bit 2 + MXCSR_RC = MXCSR_RC1 or MXCSR_RC2; // Rounding control + MXCSR_FZ = BIT_15; // Flush to Zero + +const + IntelCacheDescription: array [0..50] of TCacheInfo = ( + (D: $00; Family: cfOther; I: RsIntelCacheDescr00), + (D: $01; Family: cfInstructionTLB; Size: 4; WaysOfAssoc: 4; Entries: 32; I: RsIntelCacheDescr01), // Instruction TLB: 4 KByte Pages, 4-way set associative, 32 entries + (D: $02; Family: cfInstructionTLB; Size: 4096; WaysOfAssoc: 4; Entries: 2; I: RsIntelCacheDescr02), // Instruction TLB: 4 MByte Pages, 4-way set associative, 2 entries + (D: $03; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 64; I: RsIntelCacheDescr03), // Data TLB: 4KByte Pages, 4-way set associative, 64 entries + (D: $04; Family: cfDataTLB; Size: 4096; WaysOfAssoc: 4; Entries: 8; I: RsIntelCacheDescr04), // Data TLB: 4MByte Pages, 4-way set associative, 8 entries + (D: $06; Family: cfL1InstructionCache; Size: 8; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr06), // 1st-level instruction cache: 8 KBytes, 4-way set associative, 32 byte line size + (D: $08; Family: cfL1InstructionCache; Size: 16; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr08), // 1st-level instruction cache: 16 KBytes, 4-way set associative, 32 byte line size + (D: $0A; Family: cfL1DataCache; Size: 8; WaysOfAssoc: 2; LineSize: 32; I: RsIntelCacheDescr0A), // 1st-level data cache: 8 KBytes, 2-way set associative, 32 byte line size + (D: $0C; Family: cfL1DataCache; Size: 16; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr0C), // 1st-level data cache: 16 KBytes, 4-way set associative, 32 byte line size + (D: $22; Family: cfL3Cache; Size: 512; WaysOfAssoc: 4; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr22), // 3rd-level cache: 512 KBytes, 4-way set associative, 64 byte line size, 2 lines per sector + (D: $23; Family: cfL3Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr23), // 3rd-level cache: 1 MBytes, 8-way set associative, 64 byte line size, 2 lines per sector + (D: $25; Family: cfL3Cache; Size: 2048; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr25), // 3rd-level cache: 2 MBytes, 8-way set associative, 64 byte line size, 2 lines per sector + (D: $29; Family: cfL3Cache; Size: 4096; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr29), // 3rd-level cache: 4M Bytes, 8-way set associative, 64 byte line size, 2 lines per sector + (D: $2C; Family: cfL1DataCache; Size: 32; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr2C), // 1st-level data cache: 32K Bytes, 8-way set associative, 64 byte line size + (D: $30; Family: cfL1InstructionCache; Size: 32; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr30), // 1st-level instruction cache: 32K Bytes, 8-way set associative, 64 byte line size + (D: $40; Family: cfOther; I: RsIntelCacheDescr40), // No 2nd-level cache or, if processor contains a valid 2nd-level cache, no 3rd-level cache + (D: $41; Family: cfL2Cache; Size: 128; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr41), // 2nd-level cache: 128 KBytes, 4-way set associative, 32 byte line size + (D: $42; Family: cfL2Cache; Size: 256; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr42), // 2nd-level cache: 256 KBytes, 4-way set associative, 32 byte line size + (D: $43; Family: cfL2Cache; Size: 512; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr43), // 2nd-level cache: 512 KBytes, 4-way set associative, 32 byte line size + (D: $44; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr44), // 2nd-level cache: 1 MByte, 4-way set associative, 32 byte line size + (D: $45; Family: cfL2Cache; Size: 2048; WaysOfAssoc: 4; LineSize: 32; I: RsIntelCacheDescr45), // 2nd-level cache: 2 MByte, 4-way set associative, 32 byte line size + (D: $50; Family: cfInstructionTLB; Size: 4096; Entries: 64; I: RsIntelCacheDescr50), // Instruction TLB: 4 KByte and 2-MByte or 4-MByte pages, 64 entries + (D: $51; Family: cfInstructionTLB; Size: 4096; Entries: 128; I: RsIntelCacheDescr51), // Instruction TLB: 4 KByte and 2-MByte or 4-MByte pages, 128 entries + (D: $52; Family: cfInstructionTLB; Size: 4096; Entries: 256; I: RsIntelCacheDescr52), // Instruction TLB: 4 KByte and 2-MByte or 4-MByte pages, 256 entries + (D: $5B; Family: cfDataTLB; Size: 4096; Entries: 64; I: RsIntelCacheDescr5B), // Data TLB: 4 KByte and 4 MByte pages, 64 entries + (D: $5C; Family: cfDataTLB; Size: 4096; Entries: 128; I: RsIntelCacheDescr5C), // Data TLB: 4 KByte and 4 MByte pages,128 entries + (D: $5D; Family: cfDataTLB; Size: 4096; Entries: 256; I: RsIntelCacheDescr5D), // Data TLB: 4 KByte and 4 MByte pages,256 entries + (D: $60; Family: cfL1DataCache; Size: 16; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr60), // 1st-level data cache: 16 KByte, 8-way set associative, 64 byte line size + (D: $66; Family: cfL1DataCache; Size: 8; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr66), // 1st-level data cache: 8 KByte, 4-way set associative, 64 byte line size + (D: $67; Family: cfL1DataCache; Size: 16; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr67), // 1st-level data cache: 16 KByte, 4-way set associative, 64 byte line size + (D: $68; Family: cfL1DataCache; Size: 32; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr68), // 1st-level data cache: 32 KByte, 4-way set associative, 64 byte line size + (D: $70; Family: cfTrace; Size: 12; WaysOfAssoc: 8; I: RsIntelCacheDescr70), // Trace cache: 12 K-µop, 8-way set associative + (D: $71; Family: cfTrace; Size: 16; WaysOfAssoc: 8; I: RsIntelCacheDescr71), // Trace cache: 16 K-µop, 8-way set associative + (D: $72; Family: cfTrace; Size: 32; WaysOfAssoc: 8; I: RsIntelCacheDescr72), // Trace cache: 32 K-µop, 8-way set associative + (D: $78; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr78), // 2nd-level cache: 1 MByte, 4-way set associative, 64byte line size + (D: $79; Family: cfL2Cache; Size: 128; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr79), // 2nd-level cache: 128 KByte, 8-way set associative, 64 byte line size, 2 lines per sector + (D: $7A; Family: cfL2Cache; Size: 256; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr7A), // 2nd-level cache: 256 KByte, 8-way set associative, 64 byte line size, 2 lines per sector + (D: $7B; Family: cfL2Cache; Size: 512; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr7B), // 2nd-level cache: 512 KByte, 8-way set associative, 64 byte line size, 2 lines per sector + (D: $7C; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 64; LinePerSector: 2; I: RsIntelCacheDescr7C), // 2nd-level cache: 1 MByte, 8-way set associative, 64 byte line size, 2 lines per sector + (D: $7D; Family: cfL2Cache; Size: 2048; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr7D), // 2nd-level cache: 2 MByte, 8-way set associative, 64byte line size + (D: $7F; Family: cfL2Cache; Size: 512; WaysOfAssoc: 2; LineSize: 64; I: RsIntelCacheDescr7F), // 2nd-level cache: 512 KByte, 2-way set associative, 64-byte line size + (D: $82; Family: cfL2Cache; Size: 256; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr82), // 2nd-level cache: 256 KByte, 8-way set associative, 32 byte line size + (D: $83; Family: cfL2Cache; Size: 512; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr83), // 2nd-level cache: 512 KByte, 8-way set associative, 32 byte line size + (D: $84; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr84), // 2nd-level cache: 1 MByte, 8-way set associative, 32 byte line size + (D: $85; Family: cfL2Cache; Size: 2048; WaysOfAssoc: 8; LineSize: 32; I: RsIntelCacheDescr85), // 2nd-level cache: 2 MByte, 8-way set associative, 32 byte line size + (D: $86; Family: cfL2Cache; Size: 512; WaysOfAssoc: 4; LineSize: 64; I: RsIntelCacheDescr86), // 2nd-level cache: 512 KByte, 4-way set associative, 64 byte line size + (D: $87; Family: cfL2Cache; Size: 1024; WaysOfAssoc: 8; LineSize: 64; I: RsIntelCacheDescr87), // 2nd-level cache: 1 MByte, 8-way set associative, 64 byte line size + (D: $B0; Family: cfInstructionTLB; Size: 4; WaysOfAssoc: 4; Entries: 128; I: RsIntelCacheDescrB0), // Instruction TLB: 4 KByte Pages, 4-way set associative, 128 entries + (D: $B3; Family: cfDataTLB; Size: 4; WaysOfAssoc: 4; Entries: 128; I: RsIntelCacheDescrB3), // Data TLB: 4 KByte Pages, 4-way set associative, 128 entries + (D: $F0; Family: cfOther; I: RsIntelCacheDescrF0), // 64-Byte Prefetching + (D: $F1; Family: cfOther; I: RsIntelCacheDescrF1) // 128-Byte Prefetching + ); + +procedure GetCpuInfo(var CpuInfo: TCpuInfo); + +function GetIntelCacheDescription(const D: Byte): string; +function RoundFrequency(const Frequency: Integer): Integer; +{$IFDEF MSWINDOWS} +function GetCPUSpeed(var CpuSpeed: TFreqInfo): Boolean; +{$ENDIF MSWINDOWS} +function CPUID: TCpuInfo; +function TestFDIVInstruction: Boolean; + +// Memory Information +{$IFDEF MSWINDOWS} +function GetMaxAppAddress: Cardinal; +function GetMinAppAddress: Cardinal; +{$ENDIF MSWINDOWS} +function GetMemoryLoad: Byte; +function GetSwapFileSize: Cardinal; +function GetSwapFileUsage: Byte; +function GetTotalPhysicalMemory: Cardinal; +function GetFreePhysicalMemory: Cardinal; +{$IFDEF MSWINDOWS} +function GetTotalPageFileMemory: Cardinal; +function GetFreePageFileMemory: Cardinal; +function GetTotalVirtualMemory: Cardinal; +function GetFreeVirtualMemory: Cardinal; +{$ENDIF MSWINDOWS} + +// Alloc granularity +procedure RoundToAllocGranularity64(var Value: Int64; Up: Boolean); +procedure RoundToAllocGranularityPtr(var Value: Pointer; Up: Boolean); + +{$IFDEF MSWINDOWS} +// Keyboard Information +function GetKeyState(const VirtualKey: Cardinal): Boolean; +function GetNumLockKeyState: Boolean; +function GetScrollLockKeyState: Boolean; +function GetCapsLockKeyState: Boolean; + +// Windows 95/98/Me system resources information +type + TFreeSysResKind = (rtSystem, rtGdi, rtUser); + TFreeSystemResources = record + SystemRes: Integer; + GdiRes: Integer; + UserRes: Integer; + end; + +function IsSystemResourcesMeterPresent: Boolean; + +function GetFreeSystemResources(const ResourceType: TFreeSysResKind): Integer; overload; +function GetFreeSystemResources: TFreeSystemResources; overload; +{$ENDIF MSWINDOWS} + +// Public global variables +var + ProcessorCount: Cardinal = 0; + AllocGranularity: Cardinal = 0; + PageSize: Cardinal = 0; +{$ENDIF ~CLR} + +implementation + +uses + SysUtils, + {$IFNDEF CLR} + {$IFDEF MSWINDOWS} + Messages, Winsock, Snmp, + {$IFDEF FPC} + ActiveX, JwaTlHelp32, JwaPsApi, + {$ELSE ~FPC} + TLHelp32, PsApi, + JclShell, + {$ENDIF ~FPC} + JclRegistry, JclWin32, + {$ENDIF MSWINDOWS} + Jcl8087, JclIniFiles, + {$ENDIF ~CLR} + JclBase, JclFileUtils, JclStrings; + +{$IFDEF FPC} +{$I JclSysInfo.fpc} +{$ENDIF FPC} + +//=== Environment ============================================================ + +function DelEnvironmentVar(const Name: string): Boolean; +begin + {$IFDEF CLR} + System.Environment.GetEnvironmentVariables.Remove(Name); + Result := True; + {$ELSE ~CLR} + {$IFDEF UNIX} + UnSetEnv(PChar(Name)); + Result := True; + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + Result := SetEnvironmentVariable(PChar(Name), nil); + {$ENDIF MSWINDOWS} + {$ENDIF ~CLR} +end; + +function ExpandEnvironmentVar(var Value: string): Boolean; +{$IFDEF CLR} +begin + Value := System.Environment.ExpandEnvironmentVariables(Value); + Result := True; +end; +{$ELSE ~CLR} +{$IFDEF UNIX} +begin + Result := True; +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +var + R: Integer; + Expanded: string; +begin + SetLength(Expanded, 1); + R := ExpandEnvironmentStrings(PChar(Value), PChar(Expanded), 0); + SetLength(Expanded, R); + Result := ExpandEnvironmentStrings(PChar(Value), PChar(Expanded), R) <> 0; + if Result then + begin + StrResetLength(Expanded); + Value := Expanded; + end; +end; +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +{$IFDEF UNIX} + +function GetEnvironmentVar(const Name: string; var Value: string): Boolean; +begin + Value := getenv(PChar(Name)); + Result := Value <> ''; +end; + +function GetEnvironmentVar(const Name: string; var Value: string; Expand: Boolean): Boolean; +begin + Result := GetEnvironmentVar(Name, Value); // Expand is there just for x-platform compatibility +end; + +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} + +function GetEnvironmentVar(const Name: string; var Value: string): Boolean; +begin + {$IFDEF CLR} + Value := System.Environment.GetEnvironmentVariable(Name); + Result := TObject(Value) <> nil; + {$ELSE ~CLR} + Result := GetEnvironmentVar(Name, Value, True); + {$ENDIF ~CLR} +end; + +function GetEnvironmentVar(const Name: string; var Value: string; Expand: Boolean): Boolean; +{$IFDEF CLR} +begin + Result := GetEnvironmentVar(Name, Value); + if Expand then + ExpandEnvironmentVar(Value); +end; +{$ELSE ~CLR} +var + R: DWORD; +begin + R := Windows.GetEnvironmentVariable(PChar(Name), nil, 0); + SetLength(Value, R); + R := Windows.GetEnvironmentVariable(PChar(Name), PChar(Value), R); + Result := R <> 0; + if not Result then + Value := '' + else + begin + SetLength(Value, R); + if Expand then + ExpandEnvironmentVar(Value); + end; +end; +{$ENDIF ~CLR} + +{$ENDIF MSWINDOWS} + +{$IFDEF KYLIX} +function GetEnvironmentVars(const Vars: TStrings): Boolean; +var + P: PPChar; +begin + Vars.BeginUpdate; + try + Vars.Clear; + P := System.envp; + Result := P <> nil; + while (P <> nil) and (P^ <> nil) do + begin + Vars.Add(P^); + Inc(P); + end; + finally + Vars.EndUpdate; + end; +end; +{$ENDIF KYLIX} +{$IFDEF UNIX} +function GetEnvironmentVars(const Vars: TStrings; Expand: Boolean): Boolean; +begin + Result := GetEnvironmentVars(Vars); // Expand is there just for x-platform compatibility +end; +{$ENDIF UNIX} + +{$IFDEF MSWINDOWS} + +function GetEnvironmentVars(const Vars: TStrings): Boolean; +begin + Result := GetEnvironmentVars(Vars, True); +end; + +function GetEnvironmentVars(const Vars: TStrings; Expand: Boolean): Boolean; +{$IFDEF CLR} +var + Dic: IDictionaryEnumerator; +begin + Vars.BeginUpdate; + try + Vars.Clear; + for Dic in System.Environment.GetEnvironmentVariables do + Vars.Add(string(Dic.Key) + '=' + string(Dic.Value)); + finally + Vars.EndUpdate; + end; + Result := True; +end; +{$ELSE ~CLR} +var + Raw: PChar; + Expanded: string; + I: Integer; +begin + Vars.BeginUpdate; + try + Vars.Clear; + Raw := GetEnvironmentStrings; + try + MultiSzToStrings(Vars, Raw); + Result := True; + finally + FreeEnvironmentStrings(Raw); + end; + if Expand then + begin + for I := 0 to Vars.Count - 1 do + begin + Expanded := Vars[I]; + if ExpandEnvironmentVar(Expanded) then + Vars[I] := Expanded; + end; + end; + finally + Vars.EndUpdate; + end; +end; +{$ENDIF ~CLR} + +{$ENDIF MSWINDOWS} + +function SetEnvironmentVar(const Name, Value: string): Boolean; +begin + {$IFDEF CLR} + if System.Environment.GetEnvironmentVariables.Contains(Name) then + System.Environment.GetEnvironmentVariables.Item[Name] := Value + else + System.Environment.GetEnvironmentVariables.Add(Name, Value); + Result := True; + {$ELSE ~CLR} + {$IFDEF UNIX} + SetEnv(PChar(Name), PChar(Value), 1); + Result := True; + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + Result := SetEnvironmentVariable(PChar(Name), PChar(Value)); + {$ENDIF MSWINDOWS} + {$ENDIF ~CLR} +end; + +{$IFNDEF CLR} +{$IFDEF MSWINDOWS} + +function CreateEnvironmentBlock(const Options: TEnvironmentOptions; const AdditionalVars: TStrings): PChar; +const + RegLocalEnvironment = 'SYSTEM\CurrentControlSet\Control\Session Manager\Environment'; + RegUserEnvironment = '\Environment\'; +var + KeyNames, TempList: TStrings; + Temp, Name, Value: string; + I: Integer; +begin + TempList := TStringList.Create; + try + // add additional environment variables + if eoAdditional in Options then + for I := 0 to AdditionalVars.Count - 1 do + begin + Temp := AdditionalVars[I]; + ExpandEnvironmentVar(Temp); + TempList.Add(Temp); + end; + // get environment strings from local machine + if eoLocalMachine in Options then + begin + KeyNames := TStringList.Create; + try + if RegGetValueNames(HKEY_LOCAL_MACHINE, RegLocalEnvironment, KeyNames) then + begin + for I := 0 to KeyNames.Count - 1 do + begin + Name := KeyNames[I]; + Value := RegReadString(HKEY_LOCAL_MACHINE, RegLocalEnvironment, Name); + ExpandEnvironmentVar(Value); + TempList.Add(Name + '=' + Value); + end; + end; + finally + FreeAndNil(KeyNames); + end; + end; + // get environment strings from current user + if eoCurrentUser in Options then + begin + KeyNames := TStringLIst.Create; + try + if RegGetValueNames(HKEY_CURRENT_USER, RegUserEnvironment, KeyNames) then + begin + for I := 0 to KeyNames.Count - 1 do + begin + Name := KeyNames[I]; + Value := RegReadString(HKEY_CURRENT_USER, RegUserEnvironment, Name); + ExpandEnvironmentVar(Value); + TempList.Add(Name + '=' + Value); + end; + end; + finally + KeyNames.Free; + end; + end; + // transform stringlist into multi-PChar + StringsToMultiSz(Result, TempList); + finally + FreeAndNil(TempList); + end; +end; + +// frees an environment block allocated by CreateEnvironmentBlock and +// sets Env to nil + +procedure DestroyEnvironmentBlock(var Env: PChar); +begin + FreeMultiSz(Env); +end; + +procedure SetGlobalEnvironmentVariable(VariableName, VariableContent: string); +const + cEnvironment = 'Environment'; +begin + if VariableName = '' then + Exit; + if VariableContent = '' then + begin + RegDeleteEntry(HKEY_CURRENT_USER, cEnvironment, VariableName); + SetEnvironmentVariable(PChar(VariableName), nil); + end + else + begin + RegWriteAnsiString(HKEY_CURRENT_USER, cEnvironment, VariableName, VariableContent); + SetEnvironmentVariable(PChar(VariableName), PChar(VariableContent)); + end; + SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LPARAM(PChar(cEnvironment))); +end; + +//=== Common Folders ========================================================= + +// Utility function which returns the Windows independent CurrentVersion key +// inside HKEY_LOCAL_MACHINE + +const + HKLM_CURRENT_VERSION_WINDOWS = 'SOFTWARE\Microsoft\Windows\CurrentVersion'; + HKLM_CURRENT_VERSION_NT = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion'; + +function REG_CURRENT_VERSION: string; +begin + if IsWinNT then + Result := HKLM_CURRENT_VERSION_NT + else + Result := HKLM_CURRENT_VERSION_WINDOWS; +end; + +{ TODO : Check for documented solution } +function GetCommonFilesFolder: string; +begin + Result := RegReadStringDef(HKEY_LOCAL_MACHINE, HKLM_CURRENT_VERSION_WINDOWS, + 'CommonFilesDir', ''); +end; + +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +function GetCurrentFolder: string; +{$IFDEF CLR} +begin + Result := System.Environment.CurrentDirectory; +end; +{$ELSE ~CLR} +{$IFDEF UNIX} +const + InitialSize = 64; +var + Size: Integer; +begin + Size := InitialSize; + while True do + begin + SetLength(Result, Size); + if getcwd(PChar(Result), Size) <> nil then + begin + StrResetLength(Result); + Exit; + end; + if GetLastError <> ERANGE then + RaiseLastOSError; + Size := Size * 2; + end; +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +var + Required: Cardinal; +begin + Result := ''; + Required := GetCurrentDirectory(0, nil); + if Required <> 0 then + begin + SetLength(Result, Required); + GetCurrentDirectory(Required, PChar(Result)); + StrResetLength(Result); + end; +end; +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +{$IFDEF MSWINDOWS} +{ TODO : Check for documented solution } +function GetProgramFilesFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles); + {$ELSE ~CLR} + Result := RegReadStringDef(HKEY_LOCAL_MACHINE, HKLM_CURRENT_VERSION_WINDOWS, 'ProgramFilesDir', ''); + {$ENDIF ~CLR} +end; + +{$IFNDEF CLR} +{ TODO : Check for documented solution } +function GetWindowsFolder: string; +var + Required: Cardinal; +begin + Result := ''; + Required := GetWindowsDirectory(nil, 0); + if Required <> 0 then + begin + SetLength(Result, Required); + GetWindowsDirectory(PChar(Result), Required); + StrResetLength(Result); + end; +end; +{$ENDIF ~CLR} + +{ TODO : Check for documented solution } +function GetWindowsSystemFolder: string; +{$IFDEF CLR} +begin + Result := System.Environment.SystemDirectory; +end; +{$ELSE ~CLR} +var + Required: Cardinal; +begin + Result := ''; + Required := GetSystemDirectory(nil, 0); + if Required <> 0 then + begin + SetLength(Result, Required); + GetSystemDirectory(PChar(Result), Required); + StrResetLength(Result); + end; +end; +{$ENDIF ~CLR} + +function GetWindowsTempFolder: string; +{$IFDEF CLR} +begin + Result := Path.GetTempPath; +end; +{$ELSE ~CLR} +var + Required: Cardinal; +begin + Result := ''; + Required := GetTempPath(0, nil); + if Required <> 0 then + begin + SetLength(Result, Required); + GetTempPath(Required, PChar(Result)); + StrResetLength(Result); + Result := PathRemoveSeparator(Result); + end; +end; +{$ENDIF ~CLR} + +function GetDesktopFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.Desktop); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_DESKTOP); + {$ENDIF ~CLR} +end; + +{ TODO : Check GetProgramsFolder = GetProgramFilesFolder } +function GetProgramsFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.Programs); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_PROGRAMS); + {$ENDIF ~CLR} +end; + +{$ENDIF MSWINDOWS} +function GetPersonalFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.Personal); + {$ELSE ~CLR} + {$IFDEF UNIX} + Result := GetEnvironmentVariable('HOME'); + {$ENDIF UNIX} + {$IFDEF MSWINDOWS} + Result := GetSpecialFolderLocation(CSIDL_PERSONAL); + {$ENDIF MSWINDOWS} + {$ENDIF ~CLR} +end; + +{$IFDEF MSWINDOWS} +function GetFavoritesFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.Favorites); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_FAVORITES); + {$ENDIF ~CLR} +end; + +function GetStartupFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.Startup); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_STARTUP); + {$ENDIF ~CLR} +end; + +function GetRecentFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.Recent); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_RECENT); + {$ENDIF ~CLR} +end; + +function GetSendToFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.SendTo); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_SENDTO); + {$ENDIF ~CLR} +end; + +function GetStartmenuFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.StartMenu); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_STARTMENU); + {$ENDIF ~CLR} +end; + +function GetDesktopDirectoryFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_DESKTOPDIRECTORY); + {$ENDIF ~CLR} +end; + +{$IFNDEF CLR} +function GetNethoodFolder: string; +begin + Result := GetSpecialFolderLocation(CSIDL_NETHOOD); +end; +{$ENDIF ~CLR} + +{$IFNDEF CLR} +function GetFontsFolder: string; +begin + Result := GetSpecialFolderLocation(CSIDL_FONTS); +end; + +function GetCommonStartmenuFolder: string; +begin + Result := GetSpecialFolderLocation(CSIDL_COMMON_STARTMENU); +end; +{$ENDIF ~CLR} + +function GetCommonProgramsFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.CommonProgramFiles); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_COMMON_PROGRAMS); + {$ENDIF ~CLR} +end; + +{$IFNDEF CLR} +function GetCommonStartupFolder: string; +begin + Result := GetSpecialFolderLocation(CSIDL_COMMON_STARTUP); +end; +{$ENDIF ~CLR} + +function GetCommonDesktopdirectoryFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_COMMON_DESKTOPDIRECTORY); + {$ENDIF ~CLR} +end; + +function GetCommonAppdataFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_COMMON_APPDATA); + {$ENDIF ~CLR} +end; + +function GetAppdataFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_APPDATA); + {$ENDIF ~CLR} +end; + +{$IFNDEF CLR} +function GetPrinthoodFolder: string; +begin + Result := GetSpecialFolderLocation(CSIDL_PRINTHOOD); +end; +{$ENDIF ~CLR} + +function GetCommonFavoritesFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.Favorites); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_COMMON_FAVORITES); + {$ENDIF ~CLR} +end; + +function GetTemplatesFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.Templates); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_TEMPLATES); + {$ENDIF ~CLR} +end; + +function GetInternetCacheFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.InternetCache); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_INTERNET_CACHE); + {$ENDIF ~CLR} +end; + +function GetCookiesFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.Cookies); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_COOKIES); + {$ENDIF ~CLR} +end; + +function GetHistoryFolder: string; +begin + {$IFDEF CLR} + Result := System.Environment.GetFolderPath(Environment.SpecialFolder.History); + {$ELSE ~CLR} + Result := GetSpecialFolderLocation(CSIDL_HISTORY); + {$ENDIF ~CLR} +end; + +{$IFNDEF CLR} +function GetProfileFolder: string; +begin + Result := GetSpecialFolderLocation(CSIDL_PROFILE); +end; +{$ENDIF ~CLR} + +// the following special folders are pure virtual and cannot be +// mapped to a directory path: +// CSIDL_INTERNET +// CSIDL_CONTROLS +// CSIDL_PRINTERS +// CSIDL_BITBUCKET +// CSIDL_DRIVES +// CSIDL_NETWORK +// CSIDL_ALTSTARTUP +// CSIDL_COMMON_ALTSTARTUP + +{$IFNDEF CLR} +// Identification +type + TVolumeInfoKind = (vikName, vikSerial, vikFileSystem); + +function GetVolumeInfoHelper(const Drive: string; InfoKind: TVolumeInfoKind): string; +var + VolumeSerialNumber: DWORD; + MaximumComponentLength: DWORD; + Flags: DWORD; + Name: array [0..MAX_PATH] of Char; + FileSystem: array [0..15] of Char; + ErrorMode: Cardinal; + DriveStr: string; +begin + { TODO : Change to RootPath } + { TODO : Perform better checking of Drive param or document that no checking + is performed. RM Suggested: + DriveStr := Drive; + if (Length(Drive) < 2) or (Drive[2] <> ':') then + DriveStr := GetCurrentFolder; + DriveStr := DriveStr[1] + ':\'; } + Result := ''; + DriveStr := Drive + ':\'; + ErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS); + try + if GetVolumeInformation(PChar(DriveStr), Name, SizeOf(Name), @VolumeSerialNumber, + MaximumComponentLength, Flags, FileSystem, SizeOf(FileSystem)) then + case InfoKind of + vikName: + Result := StrPas(Name); + vikSerial: + begin + Result := IntToHex(HiWord(VolumeSerialNumber), 4) + '-' + + IntToHex(LoWord(VolumeSerialNumber), 4); + end; + vikFileSystem: + Result := StrPas(FileSystem); + end; + finally + SetErrorMode(ErrorMode); + end; +end; + +function GetVolumeName(const Drive: string): string; +begin + Result := GetVolumeInfoHelper(Drive, vikName); +end; + +function GetVolumeSerialNumber(const Drive: string): string; +begin + Result := GetVolumeInfoHelper(Drive, vikSerial); +end; + +function GetVolumeFileSystem(const Drive: string): string; +begin + Result := GetVolumeInfoHelper(Drive, vikFileSystem); +end; + +{ TODO -cHelp : Donator (incl. TFileSystemFlag[s]): Robert Rossmair } + +function GetVolumeFileSystemFlags(const Volume: string): TFileSystemFlags; +var + MaximumComponentLength, Flags: Cardinal; + Flag: TFileSystemFlag; +begin + if not GetVolumeInformation(PChar(PathAddSeparator(Volume)), nil, 0, nil, + MaximumComponentLength, Flags, nil, 0) then + RaiseLastOSError; + Result := []; + for Flag := Low(TFileSystemFlag) to High(TFileSystemFlag) do + if (Flags and Ord(Flag)) <> 0 then + Include(Result, Flag); +end; + +{$ENDIF ~CLR} +{$ENDIF MSWINDOWS} + +{ TODO -cDoc: Contributor: twm } + +function GetIPAddress(const HostName: string): string; +{$IFDEF CLR} +var + Host: IPHostEntry; +begin + Host := System.Net.Dns.Resolve(HostName); + if (Host <> nil) and (Length(Host.AddressList) > 0) then + Result := Host.AddressList[0].ToString() + else + Result := ''; +end; +{$ELSE ~CLR} +var + {$IFDEF MSWINDOWS} + R: Integer; + WSAData: TWSAData; + {$ENDIF MSWINDOWS} + HostEnt: PHostEnt; + Host: string; + SockAddr: TSockAddrIn; +begin + Result := ''; + {$IFDEF MSWINDOWS} + R := WSAStartup(MakeWord(1, 1), WSAData); + if R = 0 then + try + {$ENDIF MSWINDOWS} + Host := HostName; + if Host = '' then + begin + SetLength(Host, MAX_PATH); + GetHostName(PChar(Host), MAX_PATH); + end; + HostEnt := GetHostByName(PChar(Host)); + if HostEnt <> nil then + begin + SockAddr.sin_addr.S_addr := Longint(PLongint(HostEnt^.h_addr_list^)^); + Result := inet_ntoa(SockAddr.sin_addr); + end; + {$IFDEF MSWINDOWS} + finally + WSACleanup; + end; + {$ENDIF MSWINDOWS} +end; +{$ENDIF ~CLR} + +{$IFDEF UNIX} + +{ TODO -cDoc: Donator: twm, Contributor rrossmair } + +// Returns all IP addresses of the local machine in the form +// = (which allows for access to the interface names +// by means of Results.Names and the addresses through Results.Values) +// +// Example: +// +// lo=127.0.0.1 +// eth0=10.10.10.1 +// ppp0=217.82.187.130 +// +// note that this will append to Results! +// + +procedure GetIpAddresses(Results: TStrings); +var + Sock: Integer; + IfReq: TIfReq; + SockAddrPtr: PSockAddrIn; + ListSave, IfList: PIfNameIndex; +begin + //need a socket for ioctl() + Sock := socket(AF_INET, SOCK_STREAM, 0); + if Sock < 0 then + RaiseLastOSError; + + try + //returns pointer to dynamically allocated list of structs + ListSave := if_nameindex(); + try + IfList := ListSave; + //walk thru the array returned and query for each + //interface's address + while IfList^.if_index <> 0 do + begin + //copy in the interface name to look up address of + strncpy(IfReq.ifrn_name, IfList^.if_name, IFNAMSIZ); + //get the address for this interface + if ioctl(Sock, SIOCGIFADDR, @IfReq) <> 0 then + RaiseLastOSError; + //print out the address + SockAddrPtr := PSockAddrIn(@IfReq.ifru_addr); + Results.Add(Format('%s=%s', [IfReq.ifrn_name, inet_ntoa(SockAddrPtr^.sin_addr)])); + Inc(IfList); + end; + finally + //free the dynamic memory kernel allocated for us + if_freenameindex(ListSave); + end; + finally + Libc.__close(Sock) + end; +end; + +{$ENDIF UNIX} + +function GetLocalComputerName: string; +{$IFDEF CLR} +begin + Result := System.Environment.MachineName; +end; +{$ELSE ~CLR} +// (rom) UNIX or LINUX? +{$IFDEF LINUX} +var + MachineInfo: utsname; +begin + uname(MachineInfo); + Result := MachineInfo.nodename; +end; +{$ENDIF LINUX} +{$IFDEF MSWINDOWS} +var + Count: DWORD; +begin + Count := MAX_COMPUTERNAME_LENGTH + 1; + // set buffer size to MAX_COMPUTERNAME_LENGTH + 2 characters for safety + { TODO : Win2k solution } + SetLength(Result, Count); + if GetComputerName(PChar(Result), Count) then + StrResetLength(Result) + else + Result := ''; +end; +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +{$IFNDEF CLR} + +function GetLocalUserName: string; +{$IFDEF UNIX} +begin + Result := GetEnv('USER'); +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +var + Count: DWORD; +begin + Count := 256 + 1; // UNLEN + 1 + // set buffer size to 256 + 2 characters + { TODO : Win2k solution } + SetLength(Result, Count); + if GetUserName(PChar(Result), Count) then + StrResetLength(Result) + else + Result := ''; +end; +{$ENDIF MSWINDOWS} + +{$IFDEF MSWINDOWS} +function GetRegisteredCompany: string; +begin + { TODO : check for MSDN documentation } + Result := RegReadStringDef(HKEY_LOCAL_MACHINE, REG_CURRENT_VERSION, 'RegisteredOrganization', ''); +end; + +function GetRegisteredOwner: string; +begin + { TODO : check for MSDN documentation } + Result := RegReadStringDef(HKEY_LOCAL_MACHINE, REG_CURRENT_VERSION, 'RegisteredOwner', ''); +end; + +{ TODO: Check supported platforms, maybe complete rewrite } + +function GetUserDomainName(const CurUser: string): string; +var + Count1, Count2: DWORD; + Sd: PSID; // PSecurityDescriptor; // FPC requires PSID + Snu: SID_Name_Use; +begin + Count1 := 0; + Count2 := 0; + Sd := nil; + Snu := SIDTypeUser; + LookUpAccountName(nil, PChar(CurUser), Sd, Count1, PChar(Result), Count2, Snu); + // set buffer size to Count2 + 2 characters for safety + SetLength(Result, Count2 + 1); + Sd := AllocMem(Count1); + try + if LookUpAccountName(nil, PChar(CurUser), Sd, Count1, PChar(Result), Count2, Snu) then + StrResetLength(Result) + else + Result := EmptyStr; + finally + FreeMem(Sd); + end; +end; + +{$ENDIF MSWINDOWS} +function GetDomainName: string; +{$IFDEF UNIX} +var + MachineInfo: utsname; +begin + uname(MachineInfo); + Result := MachineInfo.domainname; +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +begin + Result := GetUserDomainName(GetLocalUserName); +end; +{$ENDIF MSWINDOWS} + +{$IFDEF MSWINDOWS} +// Reference: How to Obtain BIOS Information from the Registry +// http://support.microsoft.com/default.aspx?scid=kb;en-us;q195268 + +function GetBIOSName: string; +const + Win9xBIOSInfoKey = 'Enum\Root\*PNP0C01\0000'; +begin + if IsWinNT then + Result := '' + else + Result := RegReadStringDef(HKEY_LOCAL_MACHINE, Win9xBIOSInfoKey, 'BIOSName', ''); +end; + +function GetBIOSCopyright: string; +const + ADR_BIOSCOPYRIGHT = $FE091; +begin + Result := ''; + if not IsWinNT and not IsBadReadPtr(Pointer(ADR_BIOSCOPYRIGHT), 2) then + try + Result := PChar(ADR_BIOSCOPYRIGHT); + except + Result := ''; + end; +end; + +function GetBIOSExtendedInfo: string; +const + ADR_BIOSEXTENDEDINFO = $FEC71; +begin + Result := ''; + if not IsWinNT and not IsBadReadPtr(Pointer(ADR_BIOSEXTENDEDINFO), 2) then + try + Result := PChar(ADR_BIOSEXTENDEDINFO); + except + Result := ''; + end; +end; + +// Reference: How to Obtain BIOS Information from the Registry +// http://support.microsoft.com/default.aspx?scid=kb;en-us;q195268 + +{ TODO : the date string can be e.g. 00/00/00 } +function GetBIOSDate: TDateTime; +const + WinNT_REG_PATH = 'HARDWARE\DESCRIPTION\System'; + WinNT_REG_KEY = 'SystemBiosDate'; + Win9x_REG_PATH = 'Enum\Root\*PNP0C01\0000'; + Win9x_REG_KEY = 'BiosDate'; +var + RegStr: string; + {$IFDEF RTL150_UP} + FormatSettings: TFormatSettings; + {$ELSE RTL150_UP} + RegFormat: string; + RegSeparator: Char; + {$ENDIF RTL150_UP} +begin + if IsWinNT then + RegStr := RegReadString(HKEY_LOCAL_MACHINE, WinNT_REG_PATH, WinNT_REG_KEY) + else + RegStr := RegReadString(HKEY_LOCAL_MACHINE, Win9x_REG_PATH, Win9x_REG_KEY); + {$IFDEF RTL150_UP} + FillChar(FormatSettings, SizeOf(FormatSettings), 0); + FormatSettings.DateSeparator := '/'; + FormatSettings.ShortDateFormat := 'm/d/y'; + if not TryStrToDate(RegStr, Result, FormatSettings) then + begin + FormatSettings.ShortDateFormat := 'y/m/d'; + if not TryStrToDate(RegStr, Result, FormatSettings) then + Result := 0; + end; + {$ELSE RTL150_UP} + Result := 0; + { TODO : change to a threadsafe solution } + RegFormat := ShortDateFormat; + RegSeparator := DateSeparator; + try + DateSeparator := '/'; + try + ShortDateFormat := 'm/d/y'; + Result := StrToDate(RegStr); + except + try + ShortDateFormat := 'y/m/d'; + Result := StrToDate(RegStr); + except + end; + end; + finally + ShortDateFormat := RegFormat; + DateSeparator := RegSeparator; + end; + {$ENDIF RTL150_UP} +end; + +{$ENDIF MSWINDOWS} + +//=== Processes, Tasks and Modules =========================================== + +{$IFDEF UNIX} +const + CommLen = 16; // synchronize with size of comm in struct task_struct in + // /usr/include/linux/sched.h + SProcDirectory = '/proc'; + +function RunningProcessesList(const List: TStrings; FullPath: Boolean): Boolean; +var + ProcDir: PDirectoryStream; + PtrDirEnt: PDirEnt; + Scratch: TDirEnt; + ProcID: __pid_t; + E: Integer; + FileName: string; + F: PIOFile; +begin + Result := False; + ProcDir := opendir(SProcDirectory); + if ProcDir <> nil then + begin + PtrDirEnt := nil; + if readdir_r(ProcDir, @Scratch, PtrDirEnt) <> 0 then + Exit; + List.BeginUpdate; + try + while PtrDirEnt <> nil do + begin + Val(PtrDirEnt^.d_name, ProcID, E); + if E = 0 then // name was process id + begin + FileName := ''; + + if FullPath then + FileName := SymbolicLinkTarget(Format('/proc/%s/exe', [PtrDirEnt^.d_name])); + + if FileName = '' then // usually due to insufficient access rights + begin + // read stat + FileName := Format('/proc/%s/stat', [PtrDirEnt^.d_name]); + F := fopen(PChar(FileName), 'r'); + if F = nil then + raise EJclError.CreateResFmt(@RsInvalidProcessID, [ProcID]); + try + SetLength(FileName, CommLen); + if fscanf(F, PChar(Format('%%*d (%%%d[^)])', [CommLen])), PChar(FileName)) <> 1 then + RaiseLastOSError; + StrResetLength(FileName); + finally + fclose(F); + end; + end; + + List.AddObject(FileName, Pointer(ProcID)); + end; + if readdir_r(ProcDir, @Scratch, PtrDirEnt) <> 0 then + Break; + end; + finally + List.EndUpdate; + end; + end; +end; + +{$ENDIF UNIX} +{$ENDIF ~CLR} + +{$IFDEF MSWINDOWS} + +function RunningProcessesList(const List: TStrings; FullPath: Boolean): Boolean; +{$IFDEF CLR} +var + Processes: array of Process; + I: Integer; + HasModules: Boolean; +begin + Result := True; + Processes := Process.GetProcesses; + for I := 0 to High(Processes) do + begin + try + HasModules := Processes[I].Modules.Count > 0; + except + on Win32Exception do + HasModules := False; + end; + if not HasModules then + List.Add(Processes[I].ProcessName) + else + if FullPath then + List.Add(Processes[I].MainModule.FileName) + else + List.Add(Processes[I].MainModule.ModuleName); + end; +end; +{$ELSE ~CLR} + + // This function always returns an empty string on Win9x + function ProcessFileName(PID: DWORD): string; + var + Handle: THandle; + begin + Result := ''; + Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID); + if Handle <> 0 then + try + SetLength(Result, MAX_PATH); + if FullPath then + begin + if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then + StrResetLength(Result) + else + Result := ''; + end + else + begin + if GetModuleBaseNameA(Handle, 0, PChar(Result), MAX_PATH) > 0 then + StrResetLength(Result) + else + Result := ''; + end; + finally + CloseHandle(Handle); + end; + end; + + { TODO: Check return value of CreateToolhelp32Snapshot on Windows NT (0?) } + function BuildListTH: Boolean; + var + SnapProcHandle: THandle; + ProcEntry: TProcessEntry32; + NextProc: Boolean; + FileName: string; + begin + SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); + Result := (SnapProcHandle <> INVALID_HANDLE_VALUE); + if Result then + try + ProcEntry.dwSize := SizeOf(ProcEntry); + NextProc := Process32First(SnapProcHandle, ProcEntry); + while NextProc do + begin + if ProcEntry.th32ProcessID = 0 then + begin + // PID 0 is always the "System Idle Process" but this name cannot be + // retrieved from the system and has to be fabricated. + FileName := RsSystemIdleProcess; + end + else + begin + if IsWin2k or IsWinXP or IsWin2003 or IsWin2003R2 or IsWinXP64 + or IsWinVista or IsWinLonghorn then + begin + FileName := ProcessFileName(ProcEntry.th32ProcessID); + if FileName = '' then + FileName := ProcEntry.szExeFile; + end + else + begin + FileName := ProcEntry.szExeFile; + if not FullPath then + FileName := ExtractFileName(FileName); + end; + end; + List.AddObject(FileName, Pointer(ProcEntry.th32ProcessID)); + NextProc := Process32Next(SnapProcHandle, ProcEntry); + end; + finally + CloseHandle(SnapProcHandle); + end; + end; + + function BuildListPS: Boolean; + var + PIDs: array [0..1024] of DWORD; + Needed: DWORD; + I: Integer; + FileName: string; + begin + Result := EnumProcesses(@PIDs, SizeOf(PIDs), Needed); + if Result then + begin + for I := 0 to (Needed div SizeOf(DWORD)) - 1 do + begin + case PIDs[I] of + 0: + // PID 0 is always the "System Idle Process" but this name cannot be + // retrieved from the system and has to be fabricated. + FileName := RsSystemIdleProcess; + 2: + // On NT 4 PID 2 is the "System Process" but this name cannot be + // retrieved from the system and has to be fabricated. + if IsWinNT4 then + FileName := RsSystemProcess + else + FileName := ProcessFileName(PIDs[I]); + 8: + // On Win2K PID 8 is the "System Process" but this name cannot be + // retrieved from the system and has to be fabricated. + if IsWin2k or IsWinXP then + FileName := RsSystemProcess + else + FileName := ProcessFileName(PIDs[I]); + else + FileName := ProcessFileName(PIDs[I]); + end; + if FileName <> '' then + List.AddObject(FileName, Pointer(PIDs[I])); + end; + end; + end; + +begin + { TODO : safer solution? } + List.BeginUpdate; + try + if GetWindowsVersion in [wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4] then + Result := BuildListPS + else + Result := BuildListTH; + finally + List.EndUpdate; + end; +end; +{$ENDIF ~CLR} + +{$IFNDEF CLR} + +{ TODO Windows 9x ? } + +function LoadedModulesList(const List: TStrings; ProcessID: DWORD; HandlesOnly: Boolean): Boolean; + + procedure AddToList(ProcessHandle: THandle; Module: HMODULE); + var + FileName: array [0..MAX_PATH] of Char; + ModuleInfo: TModuleInfo; + begin + {$IFDEF FPC} + if GetModuleInformation(ProcessHandle, Module, ModuleInfo, SizeOf(ModuleInfo)) then + {$ELSE ~FPC} + if GetModuleInformation(ProcessHandle, Module, @ModuleInfo, SizeOf(ModuleInfo)) then + {$ENDIF ~FPC} + begin + if HandlesOnly then + List.AddObject('', Pointer(ModuleInfo.lpBaseOfDll)) + else + if GetModuleFileNameEx(ProcessHandle, Module, Filename, SizeOf(Filename)) > 0 then + List.AddObject(FileName, Pointer(ModuleInfo.lpBaseOfDll)); + end; + end; + + function EnumModulesVQ(ProcessHandle: THandle): Boolean; + var + MemInfo: TMemoryBasicInformation; + Base: PChar; + LastAllocBase: Pointer; + Res: DWORD; + begin + Base := nil; + LastAllocBase := nil; + FillChar(MemInfo, SizeOf(MemInfo), #0); + Res := VirtualQueryEx(ProcessHandle, Base, MemInfo, SizeOf(MemInfo)); + Result := (Res = SizeOf(MemInfo)); + while Res = SizeOf(MemInfo) do + begin + if MemInfo.AllocationBase <> LastAllocBase then + begin + {$IFDEF FPC} + if MemInfo._Type = MEM_IMAGE then + {$ELSE ~FPC} + if MemInfo.Type_9 = MEM_IMAGE then + {$ENDIF ~FPC} + AddToList(ProcessHandle, HMODULE(MemInfo.AllocationBase)); + LastAllocBase := MemInfo.AllocationBase; + end; + Inc(Base, MemInfo.RegionSize); + Res := VirtualQueryEx(ProcessHandle, Base, MemInfo, SizeOf(MemInfo)); + end; + end; + + function EnumModulesPS: Boolean; + var + ProcessHandle: THandle; + Needed: DWORD; + Modules: array of THandle; + I, Cnt: Integer; + begin + Result := False; + ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID); + if ProcessHandle <> 0 then + try + Result := EnumProcessModules(ProcessHandle, nil, 0, Needed); + if Result then + begin + Cnt := Needed div SizeOf(HMODULE); + SetLength(Modules, Cnt); + if EnumProcessModules(ProcessHandle, @Modules[0], Needed, Needed) then + for I := 0 to Cnt - 1 do + AddToList(ProcessHandle, Modules[I]); + end + else + Result := EnumModulesVQ(ProcessHandle); + finally + CloseHandle(ProcessHandle); + end; + end; + + { TODO: Check return value of CreateToolhelp32Snapshot on Windows NT (0?) } + + function EnumModulesTH: Boolean; + var + SnapProcHandle: THandle; + Module: TModuleEntry32; + Next: Boolean; + begin + SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcessID); + Result := (SnapProcHandle <> INVALID_HANDLE_VALUE); + if Result then + try + FillChar(Module, SizeOf(Module), #0); + Module.dwSize := SizeOf(Module); + Next := Module32First(SnapProcHandle, Module); + while Next do + begin + if HandlesOnly then + List.AddObject('', Pointer(Module.hModule)) + else + List.AddObject(Module.szExePath, Pointer(Module.hModule)); + Next := Module32Next(SnapProcHandle, Module); + end; + finally + CloseHandle(SnapProcHandle); + end; + end; + +begin + List.BeginUpdate; + try + if IsWinNT then + Result := EnumModulesPS + else + Result := EnumModulesTH; + finally + List.EndUpdate; + end; +end; + +function GetTasksList(const List: TStrings): Boolean; + + function EnumWindowsProc(Wnd: THandle; List: TStrings): Boolean; stdcall; + var + Caption: array [0..1024] of Char; + begin + if IsMainAppWindow(Wnd) and (GetWindowText(Wnd, Caption, SizeOf(Caption)) > 0) then + List.AddObject(Caption, Pointer(Wnd)); + Result := True; + end; + +begin + List.BeginUpdate; + try + Result := EnumWindows(@EnumWindowsProc, Integer(List)); + finally + List.EndUpdate; + end; +end; + +function ModuleFromAddr(const Addr: Pointer): HMODULE; +var + MI: TMemoryBasicInformation; +begin + VirtualQuery(Addr, MI, SizeOf(MI)); + if MI.State <> MEM_COMMIT then + Result := 0 + else + Result := HMODULE(MI.AllocationBase); +end; + +{$IFNDEF FPC} +function IsSystemModule(const Module: HMODULE): Boolean; +var + CurModule: PLibModule; +begin + Result := False; + if Module <> 0 then + begin + CurModule := LibModuleList; + while CurModule <> nil do + begin + if CurModule.Instance = Module then + begin + Result := True; + Break; + end; + CurModule := CurModule.Next; + end; + end; +end; +{$ENDIF ~FPC} + +// Reference: http://msdn.microsoft.com/library/periodic/period97/win321197.htm +{ TODO : wrong link } + +function IsMainAppWindow(Wnd: THandle): Boolean; +var + ParentWnd: THandle; + ExStyle: DWORD; +begin + if IsWindowVisible(Wnd) then + begin + ParentWnd := GetWindowLong(Wnd, GWL_HWNDPARENT); + ExStyle := GetWindowLong(Wnd, GWL_EXSTYLE); + Result := ((ParentWnd = 0) or (ParentWnd = GetDesktopWindow)) and + ((ExStyle and WS_EX_TOOLWINDOW = 0) or (ExStyle and WS_EX_APPWINDOW <> 0)); + end + else + Result := False; +end; + +function IsWindowResponding(Wnd: THandle; Timeout: Integer): Boolean; +var + Res: DWORD; +begin + Result := SendMessageTimeout(Wnd, WM_NULL, 0, 0, SMTO_ABORTIFHUNG, Timeout, Res) <> 0; +end; + +function GetWindowIcon(Wnd: THandle; LargeIcon: Boolean): HICON; +var + Width, Height: Integer; + TempIcon: HICON; + IconType: DWORD; +begin + if LargeIcon then + begin + Width := GetSystemMetrics(SM_CXICON); + Height := GetSystemMetrics(SM_CYICON); + IconType := ICON_BIG; + TempIcon := GetClassLong(Wnd, GCL_HICON); + end + else + begin + Width := GetSystemMetrics(SM_CXSMICON); + Height := GetSystemMetrics(SM_CYSMICON); + IconType := ICON_SMALL; + TempIcon := GetClassLong(Wnd, GCL_HICONSM); + end; + if TempIcon = 0 then + TempIcon := SendMessage(Wnd, WM_GETICON, IconType, 0); + if (TempIcon = 0) and not LargeIcon then + TempIcon := SendMessage(Wnd, WM_GETICON, ICON_BIG, 0); + Result := CopyImage(TempIcon, IMAGE_ICON, Width, Height, 0); +end; + +function GetWindowCaption(Wnd: THandle): string; +const + BufferAllocStep = 256; +var + Buffer: PChar; + Size, TextLen: Integer; +begin + { TODO : use string } + Result := ''; + Buffer := nil; + try + Size := GetWindowTextLength(Wnd) + 2 - BufferAllocStep; + repeat + Inc(Size, BufferAllocStep); + ReallocMem(Buffer, Size); + TextLen := GetWindowText(Wnd, Buffer, Size); + until TextLen < Size - 1; + if TextLen > 0 then + Result := Buffer; + finally + FreeMem(Buffer); + end; +end; + +// Q178893 +// http://support.microsoft.com/default.aspx?scid=kb;en-us;178893 + +function TerminateApp(ProcessID: DWORD; Timeout: Integer): TJclTerminateAppResult; +var + ProcessHandle: THandle; + + function EnumWindowsProc(Wnd: THandle; ProcessID: DWORD): Boolean; stdcall; + var + PID: DWORD; + begin + GetWindowThreadProcessId(Wnd, @PID); + if ProcessID = PID then + PostMessage(Wnd, WM_CLOSE, 0, 0); + Result := True; + end; + +begin + Result := taError; + if ProcessID <> GetCurrentProcessId then + begin + ProcessHandle := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, ProcessID); + if ProcessHandle <> 0 then + try + EnumWindows(@EnumWindowsProc, LPARAM(ProcessID)); + if WaitForSingleObject(ProcessHandle, Timeout) = WAIT_OBJECT_0 then + Result := taClean + else + if TerminateProcess(ProcessHandle, 0) then + Result := taKill; + finally + CloseHandle(ProcessHandle); + end; + end; +end; + +function TerminateTask(Wnd: THandle; Timeout: Integer): TJclTerminateAppResult; +var + PID: DWORD; +begin + if GetWindowThreadProcessId(Wnd, @PID) <> 0 then + Result := TerminateApp(PID, Timeout) + else + Result := taError; +end; + +function GetProcessNameFromWnd(Wnd: THandle): string; +var + List: TStringList; + PID: DWORD; + I: Integer; +begin + Result := ''; + if IsWindow(Wnd) then + begin + PID := INVALID_HANDLE_VALUE; + GetWindowThreadProcessId(Wnd, @PID); + List := TStringList.Create; + try + if RunningProcessesList(List, True) then + begin + I := List.IndexOfObject(Pointer(PID)); + if I > -1 then + Result := List[I]; + end; + finally + List.Free; + end; + end; +end; + +function GetPidFromProcessName(const ProcessName: string): DWORD; +var + List: TStringList; + I: Integer; + HasFullPath: Boolean; +begin + Result := INVALID_HANDLE_VALUE; + List := TStringList.Create; + try + HasFullPath := ExtractFilePath(ProcessName) <> ''; + if RunningProcessesList(List, HasFullPath) then + begin + I := List.IndexOf(ProcessName); + if I > -1 then + Result := DWORD(List.Objects[I]); + end; + finally + List.Free; + end; +end; + +function GetProcessNameFromPid(PID: DWORD): string; +var + List: TStringList; + I: Integer; +begin + // Note: there are other ways to retrieve the name of the process given it's + // PID but this implementation seems to work best without making assumptions + // although it may not be the most efficient implementation. + Result := ''; + List := TStringList.Create; + try + if RunningProcessesList(List, True) then + begin + I := List.IndexOfObject(Pointer(PID)); + if I > -1 then + Result := List[I]; + end; + finally + List.Free; + end; +end; + +function GetMainAppWndFromPid(PID: DWORD): THandle; +type + PSearch = ^TSearch; + TSearch = record + PID: DWORD; + Wnd: THandle; + end; +var + SearchRec: TSearch; + + function EnumWindowsProc(Wnd: THandle; Res: PSearch): Boolean; stdcall; + var + WindowPid: DWORD; + begin + WindowPid := 0; + GetWindowThreadProcessId(Wnd, @WindowPid); + if (WindowPid = Res^.PID) and IsMainAppWindow(Wnd) then + begin + Res^.Wnd := Wnd; + Result := False; + end + else + Result := True; + end; + +begin + SearchRec.PID := PID; + SearchRec.Wnd := 0; + EnumWindows(@EnumWindowsProc, Integer(@SearchRec)); + Result := SearchRec.Wnd; +end; + +function GetShellProcessName: string; +const + cShellKey = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\WinLogon'; + cShellValue = 'Shell'; + cShellDefault = 'explorer.exe'; + cShellSystemIniFileName = 'system.ini'; + cShellBootSection = 'boot'; +begin + if IsWinNT then + Result := RegReadStringDef(HKEY_LOCAL_MACHINE, cShellKey, cShellValue, '') + else + Result := IniReadString(PathAddSeparator(GetWindowsFolder) + cShellSystemIniFileName, cShellBootSection, cShellValue); + if Result = '' then + Result := cShellDefault; +end; + +function GetShellProcessHandle: THandle; +var + Pid: Longword; +begin + Pid := GetPidFromProcessName(GetShellProcessName); + Result := OpenProcess(PROCESS_ALL_ACCESS, False, Pid); + if Result = 0 then + RaiseLastOSError; +end; + +//=== Version Information ==================================================== + +{ Q159/238 + + Windows 95 retail, OEM 4.00.950 7/11/95 + Windows 95 retail SP1 4.00.950A 7/11/95-12/31/95 + OEM Service Release 2 4.00.1111* (4.00.950B) 8/24/96 + OEM Service Release 2.1 4.03.1212-1214* (4.00.950B) 8/24/96-8/27/97 + OEM Service Release 2.5 4.03.1214* (4.00.950C) 8/24/96-11/18/97 + Windows 98 retail, OEM 4.10.1998 5/11/98 + Windows 98 Second Edition 4.10.2222A 4/23/99 + Windows Millennium 4.90.3000 +} +{ TODO : Distinquish between all these different releases? } + +var + KernelVersionHi: DWORD; + +function GetWindowsVersion: TWindowsVersion; +var + TrimmedWin32CSDVersion: string; + SystemInfo: TSystemInfo; + OSVersionInfoEx: TOSVersionInfoEx; +const + SM_SERVERR2 = 89; +begin + Result := wvUnknown; + TrimmedWin32CSDVersion := Trim(Win32CSDVersion); + case Win32Platform of + VER_PLATFORM_WIN32_WINDOWS: + case Win32MinorVersion of + 0..9: + if (TrimmedWin32CSDVersion = 'B') or (TrimmedWin32CSDVersion = 'C') then + Result := wvWin95OSR2 + else + Result := wvWin95; + 10..89: + // On Windows ME Win32MinorVersion can be 10 (indicating Windows 98 + // under certain circumstances (image name is setup.exe). Checking + // the kernel version is one way of working around that. + if KernelVersionHi = $0004005A then // 4.90.x.x + Result := wvWinME + else + if TrimmedWin32CSDVersion = 'A' then + Result := wvWin98SE + else + Result := wvWin98; + 90: + Result := wvWinME; + end; + VER_PLATFORM_WIN32_NT: + case Win32MajorVersion of + 3: + case Win32MinorVersion of + 1: + Result := wvWinNT31; + 5: + Result := wvWinNT35; + 51: + Result := wvWinNT351; + end; + 4: + Result := wvWinNT4; + 5: + case Win32MinorVersion of + 0: + Result := wvWin2000; + 1: + Result := wvWinXP; + 2: + begin + OSVersionInfoEx.dwOSVersionInfoSize := SizeOf(OSVersionInfoEx); + GetNativeSystemInfo(SystemInfo); + if GetSystemMetrics(SM_SERVERR2) <> 0 then + Result := wvWin2003R2 + else if (SystemInfo.wProcessorArchitecture <> PROCESSOR_ARCHITECTURE_INTEL) + and GetVersionEx(OSVersionInfoEx) and (OSVersionInfoEx.wProductType = VER_NT_WORKSTATION) then + Result := wvWinXP64 + else + Result := wvWin2003; + end; + end; + 6: + if Win32MinorVersion = 0 then + begin + OSVersionInfoEx.dwOSVersionInfoSize := SizeOf(OSVersionInfoEx); + if GetVersionEx(OSVersionInfoEx) and (OSVersionInfoEx.wProductType = VER_NT_WORKSTATION) then + Result := wvWinVista + else + Result := wvWinLonghorn; + end; + end; + end; +end; + +function NtProductType: TNtProductType; +const + ProductType = 'SYSTEM\CurrentControlSet\Control\ProductOptions'; +var + Product: string; + OSVersionInfo: TOSVersionInfoEx; + SystemInfo: TSystemInfo; +begin + Result := ptUnknown; + FillChar(OSVersionInfo, SizeOf(OSVersionInfo), 0); + FillChar(SystemInfo, SizeOf(SystemInfo), 0); + OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo); + GetNativeSystemInfo(SystemInfo); + + // Favor documented API over registry + if IsWinNT4 and (GetWindowsServicePackVersion >= 6) then + begin + if GetVersionEx(OSVersionInfo) then + begin + if (OSVersionInfo.wProductType = VER_NT_WORKSTATION) then + Result := ptWorkstation + else if (OSVersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then + Result := ptEnterprise + else + Result := ptServer; + end; + end + else + if IsWin2K then + begin + if GetVersionEx(OSVersionInfo) then + begin + if OSVersionInfo.wProductType in [VER_NT_SERVER,VER_NT_DOMAIN_CONTROLLER] then + begin + if (OSVersionInfo.wSuiteMask and VER_SUITE_DATACENTER) <> 0 then + Result := ptDatacenterServer + else if (OSVersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE) <> 0 then + Result := ptAdvancedServer + else + Result := ptServer; + end + else + Result := ptProfessional; + end; + end + else + if IsWinXP64 or IsWin2003 or IsWin2003R2 then // all (5.2) + begin + if GetVersionEx(OSVersionInfo) then + begin + if OSVersionInfo.wProductType in [VER_NT_SERVER,VER_NT_DOMAIN_CONTROLLER] then + begin + if (OSVersionInfo.wSuiteMask and VER_SUITE_DATACENTER) = VER_SUITE_DATACENTER then + Result := ptDatacenterServer + else + if (OSVersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then + Result := ptEnterprise + else if (OSVersionInfo.wSuiteMask = VER_SUITE_BLADE) then + Result := ptWebEdition + else + Result := ptServer; + end + else + if (OSVersionInfo.wProductType = VER_NT_WORKSTATION) then + Result := ptProfessional; + end; + end + else + if IsWinXP or IsWinVista or IsWinLonghorn then // workstation + begin + if GetVersionEx(OSVersionInfo) then + begin + if OSVersionInfo.wProductType = VER_NT_WORKSTATION then + begin + if (OSVersionInfo.wSuiteMask and VER_SUITE_PERSONAL) = VER_SUITE_PERSONAL then + Result := ptPersonal + else + Result := ptProfessional; + end; + end; + end; + + if Result = ptUnknown then + begin + // Non Windows 2000/XP system or the above method failed, try registry + Product := RegReadStringDef(HKEY_LOCAL_MACHINE, ProductType, 'ProductType', ''); + if CompareText(Product, 'WINNT') = 0 then + Result := ptWorkStation + else + if CompareText(Product, 'SERVERNT') = 0 then + Result := {ptServer} ptAdvancedServer + else + if CompareText(Product, 'LANMANNT') = 0 then + Result := {ptAdvancedServer} ptServer + else + Result := ptUnknown; + end; +end; + +function GetWindowsVersionString: string; +begin + case GetWindowsVersion of + wvWin95: + Result := RsOSVersionWin95; + wvWin95OSR2: + Result := RsOSVersionWin95OSR2; + wvWin98: + Result := RsOSVersionWin98; + wvWin98SE: + Result := RsOSVersionWin98SE; + wvWinME: + Result := RsOSVersionWinME; + wvWinNT31, wvWinNT35, wvWinNT351: + Result := Format(RsOSVersionWinNT3, [Win32MinorVersion]); + wvWinNT4: + Result := Format(RsOSVersionWinNT4, [Win32MinorVersion]); + wvWin2000: + Result := RsOSVersionWin2000; + wvWinXP: + Result := RsOSVersionWinXP; + wvWin2003: + Result := RsOSVersionWin2003; + wvWin2003R2: + Result := RsOSVersionWin2003R2; + wvWinXP64: + Result := RsOSVersionWinXP64; + wvWinLonghorn: + Result := RsOSVersionWinLonghorn; + wvWinVista: + Result := RsOSVersionWinVista; + else + Result := ''; + end; +end; + +function NtProductTypeString: string; +begin + case NtProductType of + ptWorkStation: + Result := RsProductTypeWorkStation; + ptServer: + Result := RsProductTypeServer; + ptAdvancedServer: + Result := RsProductTypeAdvancedServer; + ptPersonal: + Result := RsProductTypePersonal; + ptProfessional: + Result := RsProductTypeProfessional; + ptDatacenterServer: + Result := RsProductTypeDatacenterServer; + ptEnterprise: + Result := RsProductTypeEnterprise; + ptWebEdition: + Result := RsProductTypeWebEdition; + else + Result := ''; + end; +end; + +function GetWindowsServicePackVersion: Integer; +const + RegWindowsControl = 'SYSTEM\CurrentControlSet\Control\Windows'; +var + SP: Integer; + VersionInfo: TOSVersionInfoEx; +begin + Result := 0; + if IsWin2K or IsWinXP or IsWin2003 or IsWinXP64 or IsWin2003R2 or IsWinVista + or IsWinLonghorn then + begin + FillChar(VersionInfo, SizeOf(VersionInfo), 0); + VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo); + if GetVersionEx(VersionInfo) then + Result := VersionInfo.wServicePackMajor; + end + else + begin + SP := RegReadIntegerDef(HKEY_LOCAL_MACHINE, RegWindowsControl, 'CSDVersion', 0); + Result := StrToInt(IntToHex(SP, 4)) div 100; + end; +end; + +function GetWindowsServicePackVersionString: string; +var + SP: Integer; +begin + SP := GetWindowsServicePackVersion; + if SP > 0 then + Result := Format(RsSPInfo, [SP]) + else + Result := ''; +end; + +// Imports copied from OpenGL unit. Direct using of OpenGL unit might cause unexpected problems due +// setting 8087CW in the intialization section +function glGetString(name: Cardinal): PChar; stdcall; external opengl32; +function glGetError: Cardinal; stdcall; external opengl32; +function gluErrorString(errCode: Cardinal): PChar; stdcall; external 'glu32.dll'; + +function GetOpenGLVersion(const Win: THandle; out Version, Vendor: AnsiString): Boolean; +const + GL_NO_ERROR = 0; + GL_VENDOR = $1F00; + GL_VERSION = $1F02; +var + pfd: TPixelFormatDescriptor; + iFormatIndex: Integer; + hGLContext: HGLRC; + hGLDC: HDC; + pcTemp: PChar; + glErr: Cardinal; + bError: Boolean; + sOpenGLVersion, sOpenGLVendor: string; + Save8087CW: Word; + + procedure FunctionFailedError(Name: string); + begin + raise EJclError.CreateResFmt(@RsEOpenGLInfo, [Name]); + end; + +begin + { To call for the version information string we must first have an active + context established for use. We can, of course, close this after use } + Save8087CW := Get8087ControlWord; + try + Set8087CW($133F); + hGLContext := 0; + Result := False; + bError := False; + + if Win = 0 then + begin + Result := False; + Vendor := RsOpenGLInfoError; + Version := RsOpenGLInfoError; + Exit; + end; + + FillChar(pfd, SizeOf(pfd), 0); + with pfd do + begin + nSize := SizeOf(pfd); + nVersion := 1; { The Current Version of the descriptor is 1 } + dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL; + iPixelType := PFD_TYPE_RGBA; + cColorBits := 24; { support 24-bit colour } + cDepthBits := 32; { Depth of the z-buffer } + iLayerType := PFD_MAIN_PLANE; + end; + + hGLDC := GetDC(Win); + try + iFormatIndex := ChoosePixelFormat(hGLDC, @pfd); + if iFormatIndex = 0 then + FunctionFailedError('ChoosePixelFormat'); + + if not SetPixelFormat(hGLDC, iFormatIndex, @pfd) then + FunctionFailedError('SetPixelFormat'); + + hGLContext := wglCreateContext(hGLDC); + if hGLContext = 0 then + FunctionFailedError('wglCreateContext'); + + if not wglMakeCurrent(hGLDC, hGLContext) then + FunctionFailedError('wglMakeCurrent'); + + { TODO : Review the following. Not sure I am 100% happy with this code + in its current structure. } + pcTemp := glGetString(GL_VERSION); + if pcTemp <> nil then + begin + { TODO : Store this information in a Global Variable, and return that?? + This would save this work being performed again with later calls } + sOpenGLVersion := StrPas(pcTemp); + end + else + begin + bError := True; + glErr := glGetError; + if glErr <> GL_NO_ERROR then + begin + sOpenGLVersion := gluErrorString(glErr); + sOpenGLVendor := ''; + end; + end; + + pcTemp := glGetString(GL_VENDOR); + if pcTemp <> nil then + begin + { TODO : Store this information in a Global Variable, and return that?? + This would save this work being performed again with later calls } + sOpenGLVendor := StrPas(pcTemp); + end + else + begin + bError := True; + glErr := glGetError; + if glErr <> GL_NO_ERROR then + begin + sOpenGLVendor := gluErrorString(glErr); + Exit; + end; + end; + + Result := (not bError); + Version := sOpenGLVersion; + Vendor := sOpenGLVendor; + finally + { Close all resources } + wglMakeCurrent(hGLDC, 0); + if hGLContext <> 0 then + wglDeleteContext(hGLContext); + end; + finally + Set8087CW(Save8087CW); + end; +end; + +function GetNativeSystemInfo(var SystemInfo: TSystemInfo): Boolean; +type + TGetNativeSystemInfo = procedure (var SystemInfo: TSystemInfo) stdcall; +var + LibraryHandle: HMODULE; + _GetNativeSystemInfo: TGetNativeSystemInfo; +begin + Result := False; + LibraryHandle := LoadLibrary('kernel32.dll'); + + if LibraryHandle <> 0 then + begin + try + _GetNativeSystemInfo := GetProcAddress(LibraryHandle,'GetNativeSystemInfo'); + if Assigned(_GetNativeSystemInfo) then + begin + _GetNativeSystemInfo(SystemInfo); + Result := True; + end + else + GetSystemInfo(SystemInfo); + finally + FreeLibrary(LibraryHandle); + end; + end + else + GetSystemInfo(SystemInfo); +end; + +function GetProcessorArchitecture: TProcessorArchitecture; +var + ASystemInfo: TSystemInfo; +begin + GetNativeSystemInfo(ASystemInfo); + case ASystemInfo.wProcessorArchitecture of + PROCESSOR_ARCHITECTURE_INTEL: + Result := pax8632; + PROCESSOR_ARCHITECTURE_IA64: + Result := paIA64; + PROCESSOR_ARCHITECTURE_AMD64: + Result := pax8664; + else + Result := paUnknown; + end; +end; + +function IsWindows64: Boolean; +var + ASystemInfo: TSystemInfo; +begin + GetNativeSystemInfo(ASystemInfo); + Result := ASystemInfo.wProcessorArchitecture in [PROCESSOR_ARCHITECTURE_IA64,PROCESSOR_ARCHITECTURE_AMD64]; +end; + +{$ENDIF ~CLR} +{$ENDIF MSWINDOWS} +{$IFNDEF CLR} + +function GetOSVersionString: string; +{$IFDEF UNIX} +var + MachineInfo: utsname; +begin + uname(MachineInfo); + Result := Format('%s %s', [MachineInfo.sysname, MachineInfo.release]); +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +begin + Result := Format('%s %s', [GetWindowsVersionString, GetWindowsServicePackVersionString]); +end; +{$ENDIF MSWINDOWS} + +//=== Hardware =============================================================== + +// Helper function for GetMacAddress() +// Converts the adapter_address array to a string + +function AdapterToString(Adapter: PJclByteArray): string; +begin + Result := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x', + [Integer(Adapter[0]), Integer(Adapter[1]), + Integer(Adapter[2]), Integer(Adapter[3]), + Integer(Adapter[4]), Integer(Adapter[5])]); +end; + +{ TODO: RTLD version of NetBios } +{$IFDEF MSWINDOWS} +type + TNetBios = function(P: PNCB): Byte; stdcall; + +var + NetBiosLib: HINST = 0; + _NetBios: TNetBios; + {$IFDEF FPC} + NullAdapterAddress: array [0..5] of Byte = ($00, $00, $00, $00, $00, $00); + OID_ipMACEntAddr: array [0..9] of UINT = (1, 3, 6, 1, 2, 1, 2, 2, 1, 6); + OID_ifEntryType: array [0..9] of UINT = (1, 3, 6, 1, 2, 1, 2, 2, 1, 3); + OID_ifEntryNum: array [0..7] of UINT = (1, 3, 6, 1, 2, 1, 2, 1); + {$ENDIF FPC} + +function GetMacAddresses(const Machine: string; const Addresses: TStrings): Integer; + + procedure ExitNetbios; + begin + if NetBiosLib <> 0 then + begin + FreeLibrary(NetBiosLib); + NetBiosLib := 0; + end; + end; + + function InitNetbios: Boolean; + begin + Result := True; + if NetBiosLib = 0 then + begin + NetBiosLib := LoadLibrary(PChar('netapi32.dll')); + Result := NetBiosLib <> 0; + if Result then + begin + @_NetBios := GetProcAddress(NetBiosLib, PChar('Netbios')); + Result := @_NetBios <> nil; + if not Result then + ExitNetbios; + end; + end; + end; + + function NetBios(P: PNCB): Byte; + begin + if InitNetbios then + Result := _NetBios(P) + else + Result := 1; // anything other than NRC_GOODRET will do + end; + + procedure GetMacAddressesNetBios; + // Platform SDK + // http://msdn.microsoft.com/library/default.asp?url=/library/en-us/netbios/netbios_1l82.asp + + // Microsoft Knowledge Base Article - 118623 + // HOWTO: Get the MAC Address for an Ethernet Adapter + // http://support.microsoft.com/default.aspx?scid=kb;en-us;118623 + type + AStat = packed record + adapt: TAdapterStatus; + NameBuff: array [0..29] of TNameBuffer; + end; + var + NCB: TNCB; + Enum: TLanaEnum; + I, L, NameLen: Integer; + Adapter: AStat; + MachineName: string; + begin + MachineName := UpperCase(Machine); + if MachineName = '' then + MachineName := '*'; + NameLen := Length(MachineName); + L := NCBNAMSZ - NameLen; + if L > 0 then + begin + SetLength(MachineName, NCBNAMSZ); + FillChar(MachineName[NameLen + 1], L, ' '); + end; + FillChar(NCB, SizeOf(NCB), #0); + NCB.ncb_command := NCBENUM; + NCB.ncb_buffer := Pointer(@Enum); + NCB.ncb_length := SizeOf(Enum); + if NetBios(@NCB) = NRC_GOODRET then + begin + Result := Enum.Length; + for I := 0 to Ord(Enum.Length) - 1 do + begin + FillChar(NCB, SizeOf(NCB), #0); + NCB.ncb_command := NCBRESET; + NCB.ncb_lana_num := Enum.lana[I]; + if NetBios(@NCB) = NRC_GOODRET then + begin + FillChar(NCB, SizeOf(NCB), #0); + NCB.ncb_command := NCBASTAT; + NCB.ncb_lana_num := Enum.lana[I]; + Move(MachineName[1], NCB.ncb_callname, SizeOf(NCB.ncb_callname)); + NCB.ncb_buffer := PChar(@Adapter); + NCB.ncb_length := SizeOf(Adapter); + if NetBios(@NCB) = NRC_GOODRET then + Addresses.Add(AdapterToString(@Adapter.adapt)); + end; + end; + end; + end; + + procedure GetMacAddressesSnmp; + const + InetMib1 = 'inetmib1.dll'; + DunAdapterAddress: array [0..4] of Byte = ($44, $45, $53, $54, $00); + {$IFNDEF FPC // can't resolve address of const } + NullAdapterAddress: array [0..5] of Byte = ($00, $00, $00, $00, $00, $00); + OID_ipMACEntAddr: array [0..9] of UINT = (1, 3, 6, 1, 2, 1, 2, 2, 1, 6); + OID_ifEntryType: array [0..9] of UINT = (1, 3, 6, 1, 2, 1, 2, 2, 1, 3); + OID_ifEntryNum: array [0..7] of UINT = (1, 3, 6, 1, 2, 1, 2, 1); + {$ENDIF ~FPC} + var + PollForTrapEvent: THandle; + SupportedView: PAsnObjectIdentifier; + MIB_ifMACEntAddr: TAsnObjectIdentifier; + MIB_ifEntryType: TAsnObjectIdentifier; + MIB_ifEntryNum: TAsnObjectIdentifier; + VarBindList: TSnmpVarBindList; + VarBind: array [0..1] of TSnmpVarBind; + ErrorStatus, ErrorIndex: TAsnInteger32; + DTmp: Integer; + Ret: Boolean; + MAC: PJclByteArray; + begin + if LoadSnmp then + try + if LoadSnmpExtension(InetMib1) then + try + MIB_ifMACEntAddr.idLength := Length(OID_ipMACEntAddr); + MIB_ifMACEntAddr.ids := @OID_ipMACEntAddr; + MIB_ifEntryType.idLength := Length(OID_ifEntryType); + MIB_ifEntryType.ids := @OID_ifEntryType; + MIB_ifEntryNum.idLength := Length(OID_ifEntryNum); + MIB_ifEntryNum.ids := @OID_ifEntryNum; + if SnmpExtensionInit(GetTickCount, PollForTrapEvent, SupportedView) then + begin + VarBindList.list := @VarBind[0]; + VarBind[0].name := DEFINE_NULLOID; + VarBind[1].name := DEFINE_NULLOID; + VarBindList.len := 1; + SnmpUtilOidCpy(@VarBind[0].name, @MIB_ifEntryNum); + Ret := SnmpExtensionQuery(SNMP_PDU_GETNEXT, VarBindList, ErrorStatus, ErrorIndex); + if Ret then + begin + Result := VarBind[0].value.number; + VarBindList.len := 2; + SnmpUtilOidCpy(@VarBind[0].name, @MIB_ifEntryType); + SnmpUtilOidCpy(@VarBind[1].name, @MIB_ifMACEntAddr); + while Ret do + begin + Ret := SnmpExtensionQuery(SNMP_PDU_GETNEXT, VarBindList, ErrorStatus, ErrorIndex); + if Ret then + begin + Ret := SnmpUtilOidNCmp(@VarBind[0].name, @MIB_ifEntryType, MIB_ifEntryType.idLength) = SNMP_ERRORSTATUS_NOERROR; + if Ret then + begin + DTmp := VarBind[0].value.number; + if DTmp = 6 then + begin + Ret := SnmpUtilOidNCmp(@VarBind[1].name, @MIB_ifMACEntAddr, MIB_ifMACEntAddr.idLength) = SNMP_ERRORSTATUS_NOERROR; + if Ret and (VarBind[1].value.address.stream <> nil) then + begin + MAC := PJclByteArray(VarBind[1].value.address.stream); + if not CompareMem(MAC, @NullAdapterAddress, SizeOf(NullAdapterAddress)) then + Addresses.Add(AdapterToString(MAC)); + end; + end; + end; + end; + end; + end; + SnmpUtilVarBindFree(@VarBind[0]); + SnmpUtilVarBindFree(@VarBind[1]); + end; + finally + UnloadSnmpExtension; + end; + finally + UnloadSnmp; + end; + end; + +begin + Result := -1; + Addresses.BeginUpdate; + try + Addresses.Clear; + GetMacAddressesNetBios; + if (Result <= 0) and (Machine = '') then + GetMacAddressesSnmp; + finally + Addresses.EndUpdate; + end; +end; +{$ENDIF MSWINDOWS} +function ReadTimeStampCounter: Int64; assembler; +asm + DW $310F +end; + +function GetIntelCacheDescription(const D: Byte): string; +var + I: Integer; +begin + Result := ''; + if D <> 0 then + for I := Low(IntelCacheDescription) to High(IntelCacheDescription) do + if IntelCacheDescription[I].D = D then + begin + Result := IntelCacheDescription[I].I; + Break; + end; + // (outchy) added a return value for unknow D value + if Result = '' then + Result := Format(RsIntelUnknownCache,[D]); +end; + +procedure GetCpuInfo(var CpuInfo: TCpuInfo); +begin + CpuInfo := CPUID; + CpuInfo.IsFDIVOK := TestFDIVInstruction; + if CpuInfo.HasInstruction then + begin + {$IFDEF MSWINDOWS} + if (CpuInfo.Features and TSC_FLAG) = TSC_FLAG then + GetCpuSpeed(CpuInfo.FrequencyInfo); + {$ENDIF MSWINDOWS} + end; +end; + +function RoundFrequency(const Frequency: Integer): Integer; +const + NF: array [0..8] of Integer = (0, 20, 33, 50, 60, 66, 80, 90, 100); +var + Freq, RF: Integer; + I: Byte; + Hi, Lo: Byte; +begin + RF := 0; + Freq := Frequency mod 100; + for I := 0 to 8 do + begin + if Freq < NF[I] then + begin + Hi := I; + Lo := I - 1; + if (NF[Hi] - Freq) > (Freq - NF[Lo]) then + RF := NF[Lo] - Freq + else + RF := NF[Hi] - Freq; + Break; + end; + end; + Result := Frequency + RF; +end; + +function GetCPUSpeed(var CpuSpeed: TFreqInfo): Boolean; +{$IFDEF UNIX} +begin + { TODO : GetCPUSpeed: Solution for Linux } + Result := False; +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +var + T0, T1: Int64; + CountFreq: Int64; + Freq, Freq2, Freq3, Total: Int64; + TotalCycles, Cycles: Int64; + Stamp0, Stamp1: Int64; + TotalTicks, Ticks: Double; + Tries, Priority: Integer; + Thread: THandle; +begin + Stamp0 := 0; + Stamp1 := 0; + Freq := 0; + Freq2 := 0; + Freq3 := 0; + Tries := 0; + TotalCycles := 0; + TotalTicks := 0; + Total := 0; + + Thread := GetCurrentThread(); + Result := QueryPerformanceFrequency(CountFreq); + if Result then + begin + while ((Tries < 3) or ((Tries < 20) and ((Abs(3 * Freq - Total) > 3) or + (Abs(3 * Freq2 - Total) > 3) or (Abs(3 * Freq3 - Total) > 3)))) do + begin + Inc(Tries); + Freq3 := Freq2; + Freq2 := Freq; + QueryPerformanceCounter(T0); + T1 := T0; + + Priority := GetThreadPriority(Thread); + if Priority <> THREAD_PRIORITY_ERROR_RETURN then + SetThreadPriority(Thread, THREAD_PRIORITY_TIME_CRITICAL); + try + while T1 - T0 < 50 do + begin + QueryPerformanceCounter(T1); + Stamp0 := ReadTimeStampCounter; + end; + T0 := T1; + + while T1 - T0 < 1000 do + begin + QueryPerformanceCounter(T1); + Stamp1 := ReadTimeStampCounter; + end; + finally + if Priority <> THREAD_PRIORITY_ERROR_RETURN then + SetThreadPriority(Thread, Priority); + end; + + Cycles := Stamp1 - Stamp0; + Ticks := T1 - T0; + Ticks := Ticks * 100000; + + // avoid division by zero + if CountFreq = 0 then + Ticks := High(Int64) + else + Ticks := Ticks / (CountFreq / 10); + + TotalTicks := TotalTicks + Ticks; + TotalCycles := TotalCycles + Cycles; + + // avoid division by zero + if Ticks = 0 then + Freq := High(Freq) + else + Freq := Round(Cycles / Ticks); + + Total := Freq + Freq2 + Freq3; + end; + + // avoid division by zero + if TotalTicks = 0 then + begin + Freq3 := High(Freq3); + Freq2 := High(Freq2); + CpuSpeed.RawFreq := High(CpuSpeed.RawFreq); + end + else + begin + Freq3 := Round((TotalCycles * 10) / TotalTicks); // freq. in multiples of 10^5 Hz + Freq2 := Round((TotalCycles * 100) / TotalTicks); // freq. in multiples of 10^4 Hz + CpuSpeed.RawFreq := Round(TotalCycles / TotalTicks); + end; + + CpuSpeed.NormFreq := CpuSpeed.RawFreq; + + if Freq2 - (Freq3 * 10) >= 6 then + Inc(Freq3); + + + Freq := CpuSpeed.RawFreq * 10; + if (Freq3 - Freq) >= 6 then + Inc(CpuSpeed.NormFreq); + + CpuSpeed.ExTicks := Round(TotalTicks); + CpuSpeed.InCycles := TotalCycles; + + CpuSpeed.NormFreq := RoundFrequency(CpuSpeed.NormFreq); + Result := True; + end; +end; +{$ENDIF MSWINDOWS} + +// Helper function for CPUID. Initializes Intel specific fields. + +procedure IntelSpecific(var CpuInfo: TCpuInfo); +var + I, J: Integer; +begin + with CpuInfo do + begin + Manufacturer := 'Intel'; + if HasCacheInfo then + begin + if (IntelSpecific.L2Cache <> 0) then + begin + L2CacheSize := IntelSpecific.L2Cache shr 16; + L2CacheLineSize := IntelSpecific.L2Cache and $FF; + L2CacheAssociativity := (IntelSpecific.L2Cache shr 12) and $F; + end; + for I := Low(IntelSpecific.CacheDescriptors) to High(IntelSpecific.CacheDescriptors) do + if IntelSpecific.CacheDescriptors[I]<>0 then + for J := Low(IntelCacheDescription) to High(IntelCacheDescription) do + if IntelCacheDescription[J].D = IntelSpecific.CacheDescriptors[I] then + with IntelCacheDescription[J] do + case Family of + //cfInstructionTLB : + //cfDataTLB : + cfL1InstructionCache : + begin + Inc(L1InstructionCacheSize,Size); + L1InstructionCacheLineSize := LineSize; + L1InstructionCacheAssociativity := WaysOfAssoc; + end; + cfL1DataCache : + begin + Inc(L1DataCacheSize,Size); + L1DataCacheLineSize := LineSize; + L1DataCacheAssociativity := WaysOfAssoc; + end; + cfL2Cache : + if (IntelSpecific.L2Cache = 0) then + begin + Inc(L2CacheSize,Size); + L2CacheLineSize := LineSize; + L2CacheAssociativity := WaysOfAssoc; + end; + cfL3Cache : + begin + Inc(L3CacheSize,Size); + L3CacheLineSize := LineSize; + L3CacheAssociativity := WaysOfAssoc; + L3LinesPerSector := LinePerSector; + end; + //cfTrace : // no numeric informations + //cfOther : + end; + end; + if not HasExtendedInfo then + begin + case Family of + 4: + case Model of + 1: + CpuName := 'Intel 486DX Processor'; + 2: + CpuName := 'Intel 486SX Processor'; + 3: + CpuName := 'Intel DX2 Processor'; + 4: + CpuName := 'Intel 486 Processor'; + 5: + CpuName := 'Intel SX2 Processor'; + 7: + CpuName := 'Write-Back Enhanced Intel DX2 Processor'; + 8: + CpuName := 'Intel DX4 Processor'; + else + CpuName := 'Intel 486 Processor'; + end; + 5: + CpuName := 'Pentium'; + 6: + case Model of + 1: + CpuName := 'Pentium Pro'; + 3: + CpuName := 'Pentium II'; + 5: + case L2CacheSize of + 0: + CpuName := 'Celeron'; + 1024: + CpuName := 'Pentium II Xeon'; + 2048: + CpuName := 'Pentium II Xeon'; + else + CpuName := 'Pentium II'; + end; + 6: + case L2CacheSize of + 0: + CpuName := 'Celeron'; + 128: + CpuName := 'Celeron'; + else + CpuName := 'Pentium II'; + end; + 7: + case L2CacheSize of + 1024: + CpuName := 'Pentium III Xeon'; + 2048: + CpuName := 'Pentium III Xeon'; + else + CpuName := 'Pentium III'; + end; + 8: + case IntelSpecific.BrandID of + 1: + CpuName := 'Celeron'; + 2: + CpuName := 'Pentium III'; + 3: + CpuName := 'Pentium III Xeon'; + 4: + CpuName := 'Pentium III'; + else + CpuName := 'Pentium III'; + end; + 10: + CpuName := 'Pentium III Xeon'; + 11: + CpuName := 'Pentium III'; + else + StrPCopy(CpuName, Format('P6 (Model %d)', [Model])); + end; + 15: + case IntelSpecific.BrandID of + 1: + CpuName := 'Celeron'; + 8: + CpuName := 'Pentium 4'; + 14: + CpuName := 'Xeon'; + else + CpuName := 'Pentium 4'; + end; + else + StrPCopy(CpuName, Format('P%d', [Family])); + end; + end; + + MMX := (Features and MMX_FLAG) <> 0; + if (Features and SSE_FLAG) <> 0 then + if (Features and SSE2_FLAG) <> 0 then + if (IntelSpecific.ExFeatures and EINTEL_SSE3) <> 0 then + SSE := 3 + else + SSE := 2 + else + SSE := 1 + else + SSE := 0; + Is64Bits := HasExtendedInfo and ((IntelSpecific.Ex64Features and EINTEL64_EM64T)<>0); + end; +end; + +// Helper function for CPUID. Initializes Cyrix specific fields. + +procedure CyrixSpecific(var CpuInfo: TCpuInfo); +begin + with CpuInfo do + begin + Manufacturer := 'Cyrix'; + if not HasExtendedInfo then + begin + case Family of + 4: + CpuName := 'Cyrix MediaGX'; + 5: + case Model of + 2: + CpuName := 'Cyrix 6x86'; + 4: + CpuName := 'Cyrix GXm'; + end; + 6: + CpuName := '6x86MX'; + else + StrPCopy(CpuName, Format('%dx86', [Family])); + end; + end; + end; +end; + +// Helper function for CPUID. Initializes AMD specific fields. + +resourcestring + RsUnknownAMDModel = 'Unknown AMD (Model %d)'; + +procedure AMDSpecific(var CpuInfo: TCpuInfo); +begin + with CpuInfo do + begin + Manufacturer := 'AMD'; + if not HasExtendedInfo then + begin + case Family of + 4: + CpuName := 'Am486(R) or Am5x86'; + 5: + case Model of + 0: + CpuName := 'AMD-K5 (Model 0)'; + 1: + CpuName := 'AMD-K5 (Model 1)'; + 2: + CpuName := 'AMD-K5 (Model 2)'; + 3: + CpuName := 'AMD-K5 (Model 3)'; + 6: + CpuName := 'AMD-K6® (Model 6)'; + 7: + CpuName := 'AMD-K6® (Model 7)'; + 8: + CpuName := 'AMD-K6®-2 (Model 8)'; + 9: + CpuName := 'AMD-K6®-III (Model 9)'; + else + StrFmt(CpuName,PChar(RsUnknownAMDModel),[Model]); + end; + 6: + case Model of + 1: + CpuName := 'AMD Athlon™ (Model 1)'; + 2: + CpuName := 'AMD Athlon™ (Model 2)'; + 3: + CpuName := 'AMD Duron™ (Model 3)'; + 4: + CpuName := 'AMD Athlon™ (Model 4)'; + 6: + CpuName := 'AMD Athlon™ XP (Model 6)'; + 7: + CpuName := 'AMD Duron™ (Model 7)'; + 8: + CpuName := 'AMD Athlon™ XP (Model 8)'; + 10: + CpuName := 'AMD Athlon™ XP (Model 10)'; + else + StrFmt(CpuName,PChar(RsUnknownAMDModel),[Model]); + end; + 8: + + else + CpuName := 'Unknown AMD Chip'; + end; + end; + if (HasCacheInfo) then + begin + L1DataCacheSize := AMDSpecific.L1DataCache[ciSize]; + L1DataCacheLineSize := AMDSpecific.L1DataCache[ciLineSize]; + L1DataCacheAssociativity := AMDSpecific.L1DataCache[ciAssociativity]; + L1InstructionCacheSize := AMDSpecific.L1InstructionCache[ciSize]; + L1InstructionCacheLineSize := AMDSpecific.L1InstructionCache[ciLineSize]; + L1InstructionCacheAssociativity := AMDSpecific.L1InstructionCache[ciAssociativity]; + L2CacheLineSize := AMDSpecific.L2Cache and $FF; + L2CacheAssociativity := (AMDSpecific.L2Cache shr 12) and $F; + L2CacheSize := AMDSpecific.L2Cache shr 16; + end; + MMX := (Features and AMD_MMX) <> 0; + ExMMX := HasExtendedInfo and ((AMDSpecific.ExFeatures and EAMD_EXMMX) <> 0); + _3DNow := HasExtendedInfo and ((AMDSpecific.ExFeatures and EAMD_3DNOW) <> 0); + Ex3DNow := HasExtendedInfo and ((AMDSpecific.ExFeatures and EAMD_EX3DNOW) <> 0); + if (Features and AMD_SSE) <> 0 then + if (Features and AMD_SSE2) <> 0 then + SSE := 2 + else + SSE := 1 + else + SSE := 0; + Is64Bits := HasExtendedInfo and ((AMDSpecific.ExFeatures and EAMD_LONG) <> 0); + end; +end; + +// Helper function for CPUID. Initializes Transmeta specific fields. + +procedure TransmetaSpecific(var CpuInfo: TCpuInfo); +begin + with CpuInfo do + begin + Manufacturer := 'Transmeta'; + if not HasExtendedInfo then + CpuName := 'Crusoe'; + if HasCacheInfo then + begin + L1DataCacheSize := TransmetaSpecific.L1DataCache[ciSize]; + L1DataCacheLineSize := TransmetaSpecific.L1DataCache[ciLineSize]; + L1DataCacheAssociativity := TransmetaSpecific.L1DataCache[ciAssociativity]; + L1InstructionCacheSize := TransmetaSpecific.L1CodeCache[ciSize]; + L1InstructionCacheLineSize := TransmetaSpecific.L1CodeCache[ciLineSize]; + L1InstructionCacheAssociativity := TransmetaSpecific.L1CodeCache[ciAssociativity]; + L2CacheLineSize := TransmetaSpecific.L2Cache and $FF; + L2CacheAssociativity := (TransmetaSpecific.L2Cache shr 12) and $F; + L2CacheSize := TransmetaSpecific.L2Cache shr 16; + end; + MMX := (Features and TRANSMETA_MMX) <> 0; + end; +end; + +// Helper function for CPUID. Initializes Via specific fields. + +procedure ViaSpecific(var CpuInfo: TCpuInfo); +begin + with CpuInfo do + begin + Manufacturer := 'Via'; + if not HasExtendedInfo then + CpuName := 'C3'; + if HasCacheInfo then + begin + L1DataCacheSize := VIASpecific.L1DataCache[ciSize]; + L1DataCacheLineSize := VIASpecific.L1DataCache[ciLineSize]; + L1DataCacheAssociativity := VIASpecific.L1DataCache[ciAssociativity]; + L1InstructionCacheSize := VIASpecific.L1InstructionCache[ciSize]; + L1InstructionCacheLineSize := VIASpecific.L1InstructionCache[ciLineSize]; + L1InstructionCacheAssociativity := VIASpecific.L1InstructionCache[ciAssociativity]; + L2CacheLineSize := VIASpecific.L2DataCache and $FF; + L2CacheAssociativity := (VIASpecific.L2DataCache shr 12) and $F; + L2CacheSize := VIASpecific.L2DataCache shr 16; + end; + MMX := (Features and VIA_MMX) <> 0; + if (Features and VIA_SSE) <> 0 + then SSE := 1 + else SSE := 0; + _3DNow := (Features and VIA_3DNOW) <> 0; + end; +end; + +function CPUID: TCpuInfo; +var + CPUInfo: TCpuInfo; + HiVal: Cardinal; + ExHiVal: Cardinal; + TimesToExecute, CurrentLoop: Byte; +begin + FillChar(CPUInfo, sizeof(CPUInfo), 0); + asm + PUSH EAX + PUSH EBP + PUSH EBX + PUSH ECX + PUSH EDI + PUSH EDX + PUSH ESI +{$IFDEF PIC} // position independent code for linux + MOV ESI, EBX // get the GOT placed in ebx +{$ELSE} // PIC + XOR ESI, ESI +{$ENDIF} // PIC + + @@Check80486: + MOV [CPUInfo.Family], 4 + PUSHFD + POP EAX + MOV ECX, EAX + XOR EAX, 200000H + PUSH EAX + POPFD + PUSHFD + POP EAX + XOR EAX, ECX + JE @@DoneCpuType + + @@HasCPUIDInstruction: + MOV [CPUInfo.HasInstruction], 1 + MOV EAX, 0 + DB 0FH + DB 0A2H + + MOV HiVal, EAX + MOV DWORD PTR [CPUInfo.VendorIDString], EBX + MOV DWORD PTR [CPUInfo.VendorIDString + 4], EDX + MOV DWORD PTR [CPUInfo.VendorIDString + 8], ECX + + @@CheckIntel: + CMP DWORD PTR [ESI].VendorIDIntel, EBX //'uneG' + JNE @@CheckAMD + CMP DWORD PTR [ESI+4].VendorIDIntel, EDX //'Ieni' + JNE @@CheckAMD + CMP DWORD PTR [ESI+8].VendorIDIntel, ECX //'letn' + JNE @@CheckAMD + MOV [CPUInfo.CpuType], CPU_TYPE_INTEL + JMP @@CheckIntelExtended + + @@CheckAMD: + CMP DWORD PTR [ESI].VendorIDAMD, EBX //'htuA' + JNE @@CheckCyrix + CMP DWORD PTR [ESI+4].VendorIDAMD, EDX //'itne' + JNE @@CheckCyrix + CMP DWORD PTR [ESI+8].VendorIDAMD, ECX //'DMAc' + JNE @@CheckCyrix + MOV [CPUInfo.CpuType], CPU_TYPE_AMD + JMP @@CheckAMDExtended + + @@CheckCyrix: + CMP DWORD PTR [ESI].VendorIDCyrix, EBX //'iryC' + JNE @@CheckVIA + CMP DWORD PTR [ESI+4].VendorIDCyrix, EDX //'snIx' + JNE @@CheckVIA + CMP DWORD PTR [ESI+8].VendorIDCyrix, ECX //'daet' + JNE @@CheckVIA + MOV [CPUInfo.CpuType], CPU_TYPE_CYRIX + JMP @@CheckCyrixExtended + + @@CheckVIA: + CMP DWORD PTR [ESI].VendorIDVIA, EBX //'tneC' + JNE @@CheckTransmeta + CMP DWORD PTR [ESI+4].VendorIDVIA, EDX //'Hrua' + JNE @@CheckTransmeta + CMP DWORD PTR [ESI+8].VendorIDVIA, ECX //'slua' + JNE @@CheckTransmeta + MOV [CPUInfo.CpuType], CPU_TYPE_VIA + JMP @@CheckVIAExtended + + @@CheckTransmeta: + CMP DWORD PTR [ESI].VendorIDTransmeta, EBX //'uneG' + JNE @@StandardFunctions + CMP DWORD PTR [ESI+4].VendorIDTransmeta, EDX //'Teni' + JNE @@StandardFunctions + CMP DWORD PTR [ESI+8].VendorIDTransmeta, ECX //'68xM' + JNE @@StandardFunctions + MOV [CPUInfo.CpuType], CPU_TYPE_TRANSMETA + JMP @@CheckTransmetaExtended + + @@CheckIntelExtended: + MOV EAX, 80000000h + DB 0Fh + DB 0A2h + TEST EAX, 80000000h + JZ @@StandardFunctions + JMP @@IntelOnly + + @@CheckAMDExtended: + MOV EAX, 1 + CMP HiVal, 1 + JL @@StandardFunctions + DB 0Fh + DB 0A2h + MOV [CpuInfo.Features], EDX + MOV EAX, 80000000h + DB 0Fh + DB 0A2h + CMP EAX, 0 + JE @@StandardFunctions + JMP @@AMDOnly + + @@CheckCyrixExtended: + MOV EAX, 80000000h + DB 0Fh + DB 0A2h + CMP EAX, 0 + JE @@StandardFunctions + JMP @@CyrixOnly + + @@CheckVIAExtended: + MOV EAX, 80000000h + DB 0Fh + DB 0A2h + CMP EAX, 0 + JE @@StandardFunctions + JMP @@VIAOnly + + @@CheckTransmetaExtended: + JMP @@TransmetaOnly + + @@StandardFunctions: + CMP HiVal, 1 + JL @@DoneCPUType + MOV EAX, 1 + DB 0FH + DB 0A2H + MOV [CPUInfo.Features], EDX + MOV [CPUInfo.IntelSpecific.BrandID], BL + MOV EBX, EAX + AND EAX, 3000H + SHR EAX, 12 + MOV [CPUInfo.PType], AL + MOV EAX, EBX + AND EAX, 0F00H + SHR EAX, 8 + MOV [CPUInfo.Family], AL + MOV EAX, EBX + AND EAX, 00F0H + SHR EAX, 4 + MOV [CPUInfo.MODEL], AL + MOV EAX, EBX + AND EAX, 000FH + MOV [CPUInfo.Stepping], AL + CMP [CpuInfo.CpuType], CPU_TYPE_INTEL + JNE @@DoneCPUType + MOV [CPUInfo.IntelSpecific.ExFeatures], ECX // (outchy) added extended features for intel processors + + @@IntelStandard: + CMP HiVal, 2 + JL @@DoneCPUType + MOV CurrentLoop, 0 + MOV [CPUInfo.HasCacheInfo], 1 + PUSH ECX + + @@RepeatCacheQuery: + POP ECX + MOV EAX, 2 + DB 0FH + DB 0A2H + INC CurrentLoop + CMP CurrentLoop, 1 + JNE @@DoneCacheQuery + MOV TimesToExecute, AL + CMP AL, 0 + JE @@DoneCPUType + + @@DoneCacheQuery: + PUSH ECX + MOV CL, CurrentLoop + SUB CL, TimesToExecute + JNZ @@RepeatCacheQuery + POP ECX + MOV DWORD PTR [CPUInfo.IntelSpecific.CacheDescriptors], EAX + MOV DWORD PTR [CPUInfo.IntelSpecific.CacheDescriptors + 4], EBX + MOV DWORD PTR [CPUInfo.IntelSpecific.CacheDescriptors + 8], ECX + MOV DWORD PTR [CPUInfo.IntelSpecific.CacheDescriptors + 12], EDX + JMP @@DoneCPUType + + @@IntelOnly: + MOV ExHiVal, EAX + + MOV EAX, 80000001h + CMP ExHiVal, EAX + JL @@StandardFunctions + MOV [CPUInfo.HasExtendedInfo], 1 + DB 0Fh + DB 0A2h + MOV [CPUInfo.IntelSpecific.Ex64Features], EDX + + MOV EAX, 80000002h + CMP ExHiVal, EAX + JL @@StandardFunctions + MOV [CPUInfo.HasExtendedInfo], 1 + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName], EAX + MOV DWORD PTR [CPUInfo.CpuName + 4], EBX + MOV DWORD PTR [CPUInfo.CpuName + 8], ECX + MOV DWORD PTR [CPUInfo.CpuName + 12], EDX + + MOV EAX, 80000003h + CMP ExHiVal, EAX + JL @@StandardFunctions + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 16], EAX + MOV DWORD PTR [CPUInfo.CpuName + 20], EBX + MOV DWORD PTR [CPUInfo.CpuName + 24], ECX + MOV DWORD PTR [CPUInfo.CpuName + 28], EDX + + MOV EAX, 80000004h + CMP ExHiVal, EAX + JL @@StandardFunctions + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 32], EAX + MOV DWORD PTR [CPUInfo.CpuName + 36], EBX + MOV DWORD PTR [CPUInfo.CpuName + 40], ECX + MOV DWORD PTR [CPUInfo.CpuName + 44], EDX + + MOV EAX, 80000006h + CMP ExHiVal, EAX + JL @@StandardFunctions + DB 0Fh + DB 0A2h + MOV [CPUInfo.IntelSpecific.L2Cache], EDX + JMP @@StandardFunctions + + @@AMDOnly: + MOV ExHiVal, EAX + MOV EAX, 80000001h + CMP ExHiVal, EAX + JL @@DoneCPUType + MOV [CPUInfo.HasExtendedInfo], 1 + DB 0Fh + DB 0A2h + MOV ECX, EAX + //AND EAX, 0F000H + //SHR EAX, 12 + //MOV [CPUInfo.PType], AL // (outchy) AMD processors don't support ProcessorType + //MOV EAX, ECX + AND EAX, 00000F00h + SHR EAX, 8 + MOV [CPUInfo.Family], AL + MOV EAX, ECX + AND EAX, 0FF00000h + SHR EAX, 20 + MOV [CpuInfo.ExtendedFamily], AL + MOV EAX, ECX + AND EAX, 000000F0h + SHR EAX, 4 + MOV [CPUInfo.Model], AL + MOV EAX, ECX + AND EAX, 000F0000h + SHR EAX, 16 + MOV [CpuInfo.ExtendedModel], AL + MOV EAX, ECX + AND EAX, 000FH + MOV [CPUInfo.Stepping], AL + MOV [CPUInfo.AMDSpecific.ExFeatures], EDX + + MOV EAX, 80000002h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName], EAX + MOV DWORD PTR [CPUInfo.CpuName + 4], EBX + MOV DWORD PTR [CPUInfo.CpuName + 8], ECX + MOV DWORD PTR [CPUInfo.CpuName + 12], EDX + + MOV EAX, 80000003h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 16], EAX + MOV DWORD PTR [CPUInfo.CpuName + 20], EBX + MOV DWORD PTR [CPUInfo.CpuName + 24], ECX + MOV DWORD PTR [CPUInfo.CpuName + 28], EDX + + MOV EAX, 80000004h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 32], EAX + MOV DWORD PTR [CPUInfo.CpuName + 36], EBX + MOV DWORD PTR [CPUInfo.CpuName + 40], ECX + MOV DWORD PTR [CPUInfo.CpuName + 44], EDX + + MOV EAX, 80000005h + CMP ExHiVal, EAX + JL @@DoneCPUType + MOV [CPUInfo.HasCacheInfo], 1 + DB 0Fh + DB 0A2h + MOV [CPUInfo.AMDSpecific.MByteInstructionTLB], AX + SHR EAX, 16 + MOV [CPUInfo.AMDSpecific.MByteDataTLB], AX + MOV [CPUInfo.AMDSpecific.KByteInstructionTLB], BX + SHR EBX, 16 + MOV [CPUInfo.AMDSpecific.KByteDataTLB], BX + MOV [CPUInfo.AMDSpecific.L1DataCache], ECX + MOV [CPUInfo.AMDSpecific.L1InstructionCache], EDX + + MOV EAX, 80000006h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV [CpuInfo.AMDSpecific.L2MByteInstructionTLB], AX + SHR EAX, 16 + MOV [CpuInfo.AMDSpecific.L2MByteDataTLB], AX + MOV [CpuInfo.AMDSpecific.L2KByteInstructionTLB], BX + SHR EBX, 16 + MOV [CpuInfo.AMDSpecific.L2KByteDataTLB], BX + MOV [CpuInfo.AMDSpecific.L2Cache], ECX + + MOV EAX, 80000007h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV [CpuInfo.AMDSpecific.AdvancedPowerManagement], EDX + + MOV EAX, 80000008h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV [CPUInfo.AMDSpecific.PhysicalAddressSize], AL + MOV [CPUInfo.AMDSpecific.VirtualAddressSize], AH + JMP @@DoneCPUType + + @@CyrixOnly: + MOV ExHiVal, EAX + MOV EAX, 80000001h + CMP ExHiVal, EAX + JL @@DoneCPUType + MOV [CPUInfo.HasExtendedInfo], 1 + DB 0Fh + DB 0A2h + MOV ECX, EAX + AND EAX, 0F000H + SHR EAX, 12 + MOV [CPUInfo.PType], AL + MOV EAX, ECX + AND EAX, 0F00H + SHR EAX, 8 + MOV [CPUInfo.Family], AL + MOV EAX, ECX + AND EAX, 00F0H + SHR EAX, 4 + MOV [CPUInfo.Model], AL + MOV EAX, ECX + AND EAX, 000FH + MOV [CPUInfo.Stepping], AL + MOV [CPUInfo.Features], EDX + + MOV EAX, 80000002h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName], EAX + MOV DWORD PTR [CPUInfo.CpuName + 4], EBX + MOV DWORD PTR [CPUInfo.CpuName + 8], ECX + MOV DWORD PTR [CPUInfo.CpuName + 12], EDX + + MOV EAX, 80000003h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 16], EAX + MOV DWORD PTR [CPUInfo.CpuName + 20], EBX + MOV DWORD PTR [CPUInfo.CpuName + 24], ECX + MOV DWORD PTR [CPUInfo.CpuName + 28], EDX + + MOV EAX, 80000004h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 32], EAX + MOV DWORD PTR [CPUInfo.CpuName + 36], EBX + MOV DWORD PTR [CPUInfo.CpuName + 40], ECX + MOV DWORD PTR [CPUInfo.CpuName + 44], EDX + + MOV EAX, 80000005h + CMP ExHiVal, EAX + JL @@DoneCPUType + MOV [CPUInfo.HasCacheInfo], 1 + DB 0Fh + DB 0A2h + MOV [CPUInfo.CyrixSpecific.TLBInfo], EBX + MOV [CPUInfo.CyrixSpecific.L1CacheInfo], ECX + JMP @@DoneCPUType + + @@VIAOnly: + MOV ExHiVal, EAX + MOV EAX, 80000001h + CMP ExHiVal, EAX + JL @@VIAExtended + MOV [CPUInfo.HasExtendedInfo], 1 + DB 0Fh + DB 0A2h + MOV [CpuInfo.Features], EDX + MOV ECX, EAX + AND EAX, 000Fh + MOV [CpuInfo.Stepping], AL + MOV EAX, ECX + AND EAX, 00F0h + MOV [CpuInfo.Model], AL + MOV EAX, ECX + AND EAX, 0F00h + MOV [CpuInfo.Family], AL + MOV EAX, ECX + AND EAX, 3000h + MOV [CpuInfo.Stepping], AL + + MOV EAX, 80000002h + CMP ExHiVal, EAX + JL @@VIAExtended + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName], EAX + MOV DWORD PTR [CPUInfo.CpuName + 4], EBX + MOV DWORD PTR [CPUInfo.CpuName + 8], ECX + MOV DWORD PTR [CPUInfo.CpuName + 12], EDX + + MOV EAX, 80000003h + CMP ExHiVal, EAX + JL @@VIAExtended + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 16], EAX + MOV DWORD PTR [CPUInfo.CpuName + 20], EBX + MOV DWORD PTR [CPUInfo.CpuName + 24], ECX + MOV DWORD PTR [CPUInfo.CpuName + 28], EDX + + MOV EAX, 80000004h + CMP ExHiVal, EAX + JL @@VIAExtended + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 32], EAX + MOV DWORD PTR [CPUInfo.CpuName + 36], EBX + MOV DWORD PTR [CPUInfo.CpuName + 40], ECX + MOV DWORD PTR [CPUInfo.CpuName + 44], EDX + + MOV EAX, 80000005h + CMP ExHiVal, EAX + JL @@VIAExtended + DB 0Fh + DB 0A2h + + MOV [CPUInfo.VIASpecific.InstructionTLB], BX + SHR EBX, 16 + MOV [CPUInfo.VIASpecific.DataTLB], BX + MOV [CPUInfo.VIASpecific.L1DataCache], ECX + MOV [CPUInfo.VIASpecific.L1InstructionCache], EDX + MOV [CPUInfo.HasCacheInfo], 1 + + MOV EAX, 80000006h + CMP ExHiVal, EAX + JL @@VIAExtended + DB 0Fh + DB 0A2h + MOV [CPUInfo.VIASpecific.L2DataCache], ECX + + @@VIAExtended: + MOV EAX, 0C0000000h + DB 0Fh + DB 0A2h + CMP EAX, 0 + JE @@DoneCpuType + MOV ExHiVal, EAX + + MOV EAX, 0C0000001h + CMP ExHiVal, EAX + JL @@DoneCpuType + DB 0Fh + DB 0A2h + MOV [CPUInfo.VIASpecific.ExFeatures], EDX + JMP @@DoneCpuType + + @@TransmetaOnly: + MOV EAX, 1 + CMP HiVal, EAX + JL @@TransmetaExtended1 + DB 0Fh + DB 0A2h + MOV [CpuInfo.Features], EDX + MOV EBX, EAX + AND EAX, 3000H + SHR EAX, 12 + MOV [CPUInfo.PType], AL + MOV EAX, EBX + AND EAX, 0F00H + SHR EAX, 8 + MOV [CPUInfo.Family], AL + MOV EAX, EBX + AND EAX, 00F0H + SHR EAX, 4 + MOV [CPUInfo.MODEL], AL + MOV EAX, EBX + AND EAX, 000FH + MOV [CPUInfo.Stepping], AL + // no information when eax is 2 + // eax is 3 means Serial Number, not detected there + @@TransmetaExtended1: + MOV EAX, 80000000h + DB 0Fh + DB 0A2h + CMP EAX, 0 + JE @@TransmetaExtended2 + MOV ExHiVal, EAX + MOV [CPUInfo.HasExtendedInfo], 1 + MOV DWORD PTR [CPUInfo.CpuName], EBX // small CPU description, overriden if ExHiVal >=80000004 + MOV DWORD PTR [CPUInfo.CpuName + 4], EDX + MOV DWORD PTR [CPUInfo.CpuName + 8], ECX + + MOV EAX, 80000001h + CMP ExHiVal, EAX + JL @@TransmetaExtended2 + DB 0Fh + DB 0A2h + MOV [CPUInfo.TransmetaSpecific.ExFeatures], EDX + + MOV EAX, 80000002h + CMP ExHiVal, EAX + JL @@TransmetaExtended2 + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName], EAX // large CPU description + MOV DWORD PTR [CPUInfo.CpuName + 4], EBX + MOV DWORD PTR [CPUInfo.CpuName + 8], ECX + MOV DWORD PTR [CPUInfo.CpuName + 12], EDX + + MOV EAX, 80000003h + CMP ExHiVal, EAX + JL @@TransmetaExtended2 + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 16], EAX + MOV DWORD PTR [CPUInfo.CpuName + 20], EBX + MOV DWORD PTR [CPUInfo.CpuName + 24], ECX + MOV DWORD PTR [CPUInfo.CpuName + 28], EDX + + MOV EAX, 80000004h + CMP ExHiVal, EAX + JL @@TransmetaExtended2 + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.CpuName + 32], EAX + MOV DWORD PTR [CPUInfo.CpuName + 36], EBX + MOV DWORD PTR [CPUInfo.CpuName + 40], ECX + MOV DWORD PTR [CPUInfo.CpuName + 44], EDX + + MOV EAX, 80000005h + CMP ExHiVal, EAX + JL @@TransmetaExtended2 + DB 0Fh + DB 0A2h + MOV [CPUInfo.HasCacheInfo], 1 + MOV [CPUInfo.TransmetaSpecific.CodeTLB], BX + SHR EBX, 16 + MOV [CPUInfo.TransmetaSpecific.DataTLB], BX + MOV [CPUInfo.TransmetaSpecific.L1DataCache], ECX + MOV [CPUInfo.TransmetaSpecific.L1CodeCache], EDX + + MOV EAX, 80000006h + CMP ExHiVal, EAX + JL @@TransmetaExtended2 + DB 0Fh + DB 0A2h + MOV [CPUInfo.TransmetaSpecific.L2Cache], ECX + + @@TransmetaExtended2: + MOV EAX, 80860000h + DB 0Fh + DB 0A2h + CMP EAX, 0 + JE @@DoneCPUType + MOV ExHiVal, EAX + + MOV EAX, 80860001h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV [CPUInfo.TransmetaSpecific.RevisionABCD], EBX + MOV [CPUInfo.TransmetaSpecific.RevisionXXXX], ECX + MOV [CPUInfo.TransmetaSpecific.TransmetaFeatures], EDX + + MOV EAX, 80860002h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV [CPUInfo.TransmetaSpecific.CodeMorphingABCD], EBX + MOV [CPUInfo.TransmetaSpecific.CodeMorphingXXXX], ECX + + MOV EAX, 80860003h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations], EAX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 4], EBX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 8], ECX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 12], EDX + + MOV EAX, 80860004h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 16], EAX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 20], EBX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 24], ECX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 28], EDX + + MOV EAX, 80860005h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 32], EAX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 36], EBX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 40], ECX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 44], EDX + + MOV EAX, 80860006h + CMP ExHiVal, EAX + JL @@DoneCPUType + DB 0Fh + DB 0A2h + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 48], EAX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 52], EBX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 56], ECX + MOV DWORD PTR [CPUInfo.TransmetaSpecific.TransmetaInformations + 60], EDX + + MOV EAX, 80860007h + CMP ExHiVal, EAX + JL @@DoneCPUType + MOV EBX, [CPUInfo.TransmetaSpecific.TransmetaFeatures] + TEST EBX, STRANSMETA_LONGRUN + JZ @@DoneCPUType + DB 0Fh + DB 0A2h + MOV [CPUInfo.TransmetaSpecific.CurrentFrequency], EAX + MOV [CPUInfo.TransmetaSpecific.CurrentVoltage], EBX + MOV [CPUInfo.TransmetaSpecific.CurrentPerformance], ECX + + @@DoneCpuType: + POP ESI + POP EDX + POP EDI + POP ECX + POP EBX + POP EBP + POP EAX + end; + + case CPUInfo.CpuType of + CPU_TYPE_INTEL : IntelSpecific(CpuInfo); + CPU_TYPE_CYRIX : CyrixSpecific(CpuInfo); + CPU_TYPE_AMD : AMDSpecific(CpuInfo); + CPU_TYPE_TRANSMETA : TransmetaSpecific(CpuInfo); + CPU_TYPE_VIA : ViaSpecific(CpuInfo); + else begin + CpuInfo.Manufacturer := 'Unknown'; + CpuInfo.CpuName := 'Unknown'; + end; + end; + Result := CPUInfo; +end; + +function TestFDIVInstruction: Boolean; +var + TopNum: Double; + BottomNum: Double; + One: Double; + ISOK: Boolean; +begin + // The following code was found in Borlands fdiv.asm file in the + // Delphi 3\Source\RTL\SYS directory, (I made some minor modifications) + // therefore I cannot take credit for it. + TopNum := 2658955; + BottomNum := PI; + One := 1; + asm + PUSH EAX + FLD [TopNum] + FDIV [BottomNum] + FMUL [BottomNum] + FSUBR [TopNum] + FCOMP [One] + FSTSW AX + SHR EAX, 8 + AND EAX, 01H + MOV ISOK, AL + POP EAX + end; + Result := ISOK; +end; + +//=== Alloc granularity ====================================================== + +procedure RoundToAllocGranularity64(var Value: Int64; Up: Boolean); +begin + if (Value mod AllocGranularity) <> 0 then + if Up then + Value := ((Value div AllocGranularity) + 1) * AllocGranularity + else + Value := (Value div AllocGranularity) * AllocGranularity; +end; + +procedure RoundToAllocGranularityPtr(var Value: Pointer; Up: Boolean); +begin + if (Cardinal(Value) mod AllocGranularity) <> 0 then + if Up then + Value := Pointer(((Cardinal(Value) div AllocGranularity) + 1) * AllocGranularity) + else + Value := Pointer((Cardinal(Value) div AllocGranularity) * AllocGranularity); +end; + +//=== Advanced Power Management (APM) ======================================== + +{$IFDEF MSWINDOWS} +function GetAPMLineStatus: TAPMLineStatus; +var + SystemPowerStatus: TSystemPowerStatus; +begin + Result := alsUnknown; + + if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion < 5) then // Windows NT doesn't support GetSystemPowerStatus + Exit; // so we return alsUnknown + + if not GetSystemPowerStatus(SystemPowerStatus) then + RaiseLastOSError + else + begin + case SystemPowerStatus.ACLineStatus of + 0: + Result := alsOffline; + 1: + Result := alsOnline; + 255: + Result := alsUnknown; + end; + end; +end; + +function GetAPMBatteryFlag: TAPMBatteryFlag; +var + SystemPowerStatus: TSystemPowerStatus; +begin + Result := abfUnknown; + + if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion < 5) then // Windows NT doesn't support GetSystemPowerStatus + Exit; // so we return abfUnknown + + if not GetSystemPowerStatus(SystemPowerStatus) then + RaiseLastOSError + else + begin + case SystemPowerStatus.BatteryFlag of + 1: + Result := abfHigh; + 2: + Result := abfLow; + 4: + Result := abfCritical; + 8: + Result := abfCharging; + 128: + Result := abfNoBattery; + 255: + Result := abfUnknown; + end; + end; +end; + + +function GetAPMBatteryFlags: TAPMBatteryFlags; +var + SystemPowerStatus: TSystemPowerStatus; +begin + Result := []; + + if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion < 5) then // Windows NT doesn't support GetSystemPowerStatus + begin + Result := [abfUnknown]; + Exit; // so we return [abfUnknown] + end; + + if not GetSystemPowerStatus(SystemPowerStatus) then + RaiseLastOSError + else + begin + if (SystemPowerStatus.BatteryFlag and 1) <> 0 then + Result := Result + [abfHigh]; + if (SystemPowerStatus.BatteryFlag and 2) <> 0 then + Result := Result + [abfLow]; + if (SystemPowerStatus.BatteryFlag and 4) <> 0 then + Result := Result + [abfCritical]; + if (SystemPowerStatus.BatteryFlag and 8) <> 0 then + Result := Result + [abfCharging]; + if (SystemPowerStatus.BatteryFlag and 128) <> 0 then + Result := Result + [abfNoBattery]; + if SystemPowerStatus.BatteryFlag = 255 then + Result := Result + [abfUnknown]; + end; +end; + +function GetAPMBatteryLifePercent: Integer; +var + SystemPowerStatus: TSystemPowerStatus; +begin + Result := 0; + + if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion < 5) then // Windows NT doesn't support GetSystemPowerStatus + Exit; + + if not GetSystemPowerStatus(SystemPowerStatus) then + RaiseLastOSError + else + Result := SystemPowerStatus.BatteryLifePercent; +end; + +function GetAPMBatteryLifeTime: DWORD; +var + SystemPowerStatus: TSystemPowerStatus; +begin + Result := 0; + + if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion < 5) then // Windows NT doesn't support GetSystemPowerStatus + Exit; + + if not GetSystemPowerStatus(SystemPowerStatus) then + RaiseLastOSError + else + Result := SystemPowerStatus.BatteryLifeTime; +end; + +function GetAPMBatteryFullLifeTime: DWORD; +var + SystemPowerStatus: TSystemPowerStatus; +begin + Result := 0; + + if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion < 5) then // Windows NT doesn't support GetSystemPowerStatus + Exit; + + if not GetSystemPowerStatus(SystemPowerStatus) then + RaiseLastOSError + else + Result := SystemPowerStatus.BatteryFullLifeTime; +end; + +//=== Memory Information ===================================================== + +function GetMaxAppAddress: Cardinal; +var + SystemInfo: TSystemInfo; +begin + FillChar(SystemInfo, SizeOf(SystemInfo), #0); + GetSystemInfo(SystemInfo); + Result := Integer(SystemInfo.lpMaximumApplicationAddress); +end; + +function GetMinAppAddress: Cardinal; +var + SystemInfo: TSystemInfo; +begin + FillChar(SystemInfo, SizeOf(SystemInfo), #0); + GetSystemInfo(SystemInfo); + Result := Integer(SystemInfo.lpMinimumApplicationAddress); +end; +{$ENDIF MSWINDOWS} + +function GetMemoryLoad: Byte; +{$IFDEF UNIX} +var + SystemInf: TSysInfo ; +begin + SysInfo(SystemInf); + with SystemInf do + Result := 100 - Round(100 * freeram / totalram); +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +var + MemoryStatus: TMemoryStatus; +begin + FillChar(MemoryStatus, SizeOf(MemoryStatus), 0); + MemoryStatus.dwLength := SizeOf(MemoryStatus); + GlobalMemoryStatus(MemoryStatus); + Result := MemoryStatus.dwMemoryLoad; +end; +{$ENDIF MSWINDOWS} + +function GetSwapFileSize: Cardinal; +{$IFDEF UNIX} +var + SystemInf: TSysInfo; +begin + SysInfo(SystemInf); + Result := SystemInf.totalswap; +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +var + MemoryStatus: TMemoryStatus; +begin + FillChar(MemoryStatus, SizeOf(MemoryStatus), 0); + MemoryStatus.dwLength := SizeOf(MemoryStatus); + GlobalMemoryStatus(MemoryStatus); + with MemoryStatus do + Result := dwTotalPageFile - dwAvailPageFile; +end; +{$ENDIF MSWINDOWS} + +function GetSwapFileUsage: Byte; +{$IFDEF UNIX} +var + SystemInf: TSysInfo; +begin + SysInfo(SystemInf); + with SystemInf do + Result := 100 - Trunc(100 * FreeSwap / TotalSwap); +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +var + MemoryStatus: TMemoryStatus; +begin + FillChar(MemoryStatus, SizeOf(MemoryStatus), 0); + MemoryStatus.dwLength := SizeOf(MemoryStatus); + GlobalMemoryStatus(MemoryStatus); + with MemoryStatus do + if dwTotalPageFile > 0 then + Result := 100 - Trunc(dwAvailPageFile / dwTotalPageFile * 100) + else + Result := 0; +end; +{$ENDIF MSWINDOWS} + +function GetTotalPhysicalMemory: Cardinal; +{$IFDEF UNIX} +var + SystemInf: TSysInfo; +begin + SysInfo(SystemInf); + Result := SystemInf.totalram; +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +var + MemoryStatus: TMemoryStatus; +begin + FillChar(MemoryStatus, SizeOf(MemoryStatus), 0); + MemoryStatus.dwLength := SizeOf(MemoryStatus); + GlobalMemoryStatus(MemoryStatus); + Result := MemoryStatus.dwTotalPhys; +end; +{$ENDIF MSWINDOWS} + +function GetFreePhysicalMemory: Cardinal; +{$IFDEF UNIX} +var + SystemInf: TSysInfo; +begin + SysInfo(SystemInf); + Result := SystemInf.freeram; +end; +{$ENDIF UNIX} +{$IFDEF MSWINDOWS} +var + MemoryStatus: TMemoryStatus; +begin + FillChar(MemoryStatus, SizeOf(MemoryStatus), 0); + MemoryStatus.dwLength := SizeOf(MemoryStatus); + GlobalMemoryStatus(MemoryStatus); + Result := MemoryStatus.dwAvailPhys; +end; + +function GetTotalPageFileMemory: Cardinal; +var + MemoryStatus: TMemoryStatus; +begin + FillChar(MemoryStatus, SizeOf(MemoryStatus), 0); + MemoryStatus.dwLength := SizeOf(MemoryStatus); + GlobalMemoryStatus(MemoryStatus); + Result := MemoryStatus.dwTotalPageFile; +end; + +function GetFreePageFileMemory: Cardinal; +var + MemoryStatus: TMemoryStatus; +begin + FillChar(MemoryStatus, SizeOf(MemoryStatus), 0); + MemoryStatus.dwLength := SizeOf(MemoryStatus); + GlobalMemoryStatus(MemoryStatus); + Result := MemoryStatus.dwAvailPageFile; +end; + +function GetTotalVirtualMemory: Cardinal; +var + MemoryStatus: TMemoryStatus; +begin + FillChar(MemoryStatus, SizeOf(MemoryStatus), 0); + MemoryStatus.dwLength := SizeOf(MemoryStatus); + GlobalMemoryStatus(MemoryStatus); + Result := MemoryStatus.dwTotalVirtual; +end; + +function GetFreeVirtualMemory: Cardinal; +var + MemoryStatus: TMemoryStatus; +begin + FillChar(MemoryStatus, SizeOf(MemoryStatus), 0); + MemoryStatus.dwLength := SizeOf(MemoryStatus); + GlobalMemoryStatus(MemoryStatus); + Result := MemoryStatus.dwAvailVirtual; +end; + +//=== Keyboard Information =================================================== + +function GetKeybStateHelper(VirtualKey: Cardinal; Mask: Byte): Boolean; +var + Keys: TKeyboardState; +begin + Result := GetKeyBoardState(Keys) and (Keys[VirtualKey] and Mask <> 0); +end; + +function GetKeyState(const VirtualKey: Cardinal): Boolean; +begin + Result := GetKeybStateHelper(VirtualKey, $80); +end; + +function GetNumLockKeyState: Boolean; +begin + Result := GetKeybStateHelper(VK_NUMLOCK, $01); +end; + +function GetScrollLockKeyState: Boolean; +begin + Result := GetKeybStateHelper(VK_SCROLL, $01); +end; + +function GetCapsLockKeyState: Boolean; +begin + Result := GetKeybStateHelper(VK_CAPITAL, $01); +end; + +//=== Windows 95/98/ME system resources information ========================== + +{ TODO -oPJH : compare to Win9xFreeSysResources } +var + ResmeterLibHandle: THandle; + MyGetFreeSystemResources: function(ResType: UINT): UINT; stdcall; + +procedure UnloadSystemResourcesMeterLib; +begin + if ResmeterLibHandle <> 0 then + begin + FreeLibrary(ResmeterLibHandle); + ResmeterLibHandle := 0; + @MyGetFreeSystemResources := nil; + end; +end; + +function IsSystemResourcesMeterPresent: Boolean; + + procedure LoadResmeter; + var + OldErrorMode: UINT; + begin + OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS); + try + ResmeterLibHandle := LoadLibrary('rsrc32.dll'); + finally + SetErrorMode(OldErrorMode); + end; + if ResmeterLibHandle <> 0 then + begin + @MyGetFreeSystemResources := GetProcAddress(ResmeterLibHandle, '_MyGetFreeSystemResources32@4'); + if not Assigned(MyGetFreeSystemResources) then + UnloadSystemResourcesMeterLib; + end; + end; + +begin + if not IsWinNT and (ResmeterLibHandle = 0) then + LoadResmeter; + Result := (ResmeterLibHandle <> 0); +end; + +function GetFreeSystemResources(const ResourceType: TFreeSysResKind): Integer; +const + ParamValues: array [TFreeSysResKind] of UINT = (0, 1, 2); +begin + if IsSystemResourcesMeterPresent then + Result := MyGetFreeSystemResources(ParamValues[ResourceType]) + else + Result := -1; +end; + +function GetFreeSystemResources: TFreeSystemResources; +begin + with Result do + begin + SystemRes := GetFreeSystemResources(rtSystem); + GdiRes := GetFreeSystemResources(rtGdi); + UserRes := GetFreeSystemResources(rtUser); + end; +end; + +//=== Initialization/Finalization ============================================ + +procedure InitSysInfo; +var + SystemInfo: TSystemInfo; + Kernel32FileName: string; + VerFixedFileInfo: TVSFixedFileInfo; +begin + { processor information related initialization } + + FillChar(SystemInfo, SizeOf(SystemInfo), 0); + GetSystemInfo(SystemInfo); + ProcessorCount := SystemInfo.dwNumberOfProcessors; + AllocGranularity := SystemInfo.dwAllocationGranularity; + PageSize := SystemInfo.dwPageSize; + + { Windows version information } + + IsWinNT := Win32Platform = VER_PLATFORM_WIN32_NT; + + Kernel32FileName := GetModulePath(GetModuleHandle(kernel32)); + if (not IsWinNT) and VersionFixedFileInfo(Kernel32FileName, VerFixedFileInfo) then + KernelVersionHi := VerFixedFileInfo.dwProductVersionMS + else + KernelVersionHi := 0; + + case GetWindowsVersion of + wvUnknown: + ; + wvWin95: + IsWin95 := True; + wvWin95OSR2: + IsWin95OSR2 := True; + wvWin98: + IsWin98 := True; + wvWin98SE: + IsWin98SE := True; + wvWinME: + IsWinME := True; + wvWinNT31: + begin + IsWinNT3 := True; + IsWinNT31 := True; + end; + wvWinNT35: + begin + IsWinNT3 := True; + IsWinNT35 := True; + end; + wvWinNT351: + begin + IsWinNT3 := True; + IsWinNT35 := True; + IsWinNT351 := True; + end; + wvWinNT4: + IsWinNT4 := True; + wvWin2000: + IsWin2K := True; + wvWinXP: + IsWinXP := True; + wvWin2003: + IsWin2003 := True; + wvWinXP64: + IsWinXP64 := True; + wvWin2003R2: + IsWin2003R2 := True; + wvWinVista: + IsWinVista := True; + wvWinLonghorn: + IsWinLonghorn := True; + end; +end; + +procedure FinalizeSysInfo; +begin + UnloadSystemResourcesMeterLib; +end; + +initialization + InitSysInfo; + +finalization + FinalizeSysInfo; + +{$ENDIF MSWINDOWS} +{$ENDIF ~CLR} + +// History: + +// $Log: JclSysInfo.pas,v $ +// Revision 1.56 2005/12/12 21:54:09 outchy +// HWND changed to THandle (linking problems with BCB). +// +// Revision 1.55 2005/11/22 08:37:59 obones +// Added missing EXTERNALSYM declarations +// +// Revision 1.54 2005/11/21 11:50:22 outchy +// Detection of Windows Vista/Longhorn/2003 R2/XP 64. +// From: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/getting_the_system_version.asp +// +// Revision 1.53 2005/10/30 01:51:27 rrossmair +// - introduce KEEP_DEPRECATED as alias for ~DROP_OBSOLETE_CODE +// - some style cleaning +// +// Revision 1.52 2005/09/28 23:27:50 outchy +// Added constant of bits of the MXCSR register. +// +// Revision 1.51 2005/08/09 10:30:22 ahuser +// JCL.NET changes +// +// Revision 1.50 2005/08/09 07:39:28 marquardt +// forgot to compile last (bad) changes +// +// Revision 1.49 2005/08/09 07:35:42 marquardt +// minor style fix +// +// Revision 1.48 2005/08/08 07:02:56 marquardt +// minor style fix +// +// Revision 1.47 2005/08/07 13:09:55 outchy +// Changed PByteArray to PJclByteArray to avoid RangeCheck exceptions. +// +// Revision 1.46 2005/07/03 19:29:27 ahuser +// Fixed another CLR IFDEFs bug +// +// Revision 1.45 2005/07/02 18:40:19 ahuser +// Fixed IFDEFs +// +// Revision 1.44 2005/05/23 19:19:17 outchy +// IT2974: Memory sizes should be cardinal values (not Integer values). +// +// Revision 1.43 2005/05/05 20:08:45 ahuser +// JCL.NET support +// +// Revision 1.42 2005/04/07 00:41:35 rrossmair +// - changed for FPC 1.9.8 +// +// Revision 1.41 2005/03/12 01:32:50 outchy +// Update of the CPUID function. New processors detection, constants reworked and specifications upgraded. +// +// Revision 1.40 2005/03/08 08:33:17 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.39 2005/03/03 15:35:59 rikbarker +// Windows 2003 Fix for NTProductType and GetWindowsServicePackVersion +// +// Revision 1.38 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.37 2005/02/24 07:36:24 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.36 2005/02/20 04:37:09 rrossmair +// - added GetIPAddress() and GetIPAddresses() for Unix +// +// Revision 1.35 2004/12/19 20:16:31 rrossmair +// - added TCpuInfo improvements by Florent Ouchet +// +// Revision 1.34 2004/12/07 02:40:07 rrossmair +// - added GetVolumeFileSystemFlags function +// +// Revision 1.33 2004/10/21 08:40:10 marquardt +// style cleaning +// +// Revision 1.32 2004/10/17 23:48:22 mthoma +// Removed contributions... Reintroduced orignal GetOpenGLVersion. +// +// Revision 1.31 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.30 2004/10/10 12:52:12 marquardt +// DestroyEnvironmentBlock introduced +// +// Revision 1.29 2004/08/04 09:05:51 marquardt +// forgot to export SetGlobalEnvironmentVariable +// +// Revision 1.28 2004/08/04 06:11:49 marquardt +// added SetGlobalEnvironmentVariable +// +// Revision 1.27 2004/08/03 07:22:37 marquardt +// resourcestring cleanup +// +// Revision 1.26 2004/07/31 06:21:01 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.25 2004/07/28 18:00:51 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.24 2004/07/16 04:11:46 rrossmair +// fixed RunningProcessesList for Win2003 +// +// Revision 1.23 2004/06/16 07:30:28 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.22 2004/06/14 13:05:18 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.21 2004/06/14 06:24:52 marquardt +// style cleaning IFDEF +// +// Revision 1.20 2004/06/02 03:23:46 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.19 2004/05/08 08:44:17 rrossmair +// introduced & applied symbol HAS_UNIT_LIBC +// +// Revision 1.18 2004/05/05 07:12:03 rrossmair +// changes for FPC compatibility +// +// Revision 1.17 2004/05/05 00:15:12 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Windows NT 4 and earlier do not support GetSystemPowerStatus. Modified the APM function accordingly. +// +// Revision 1.16 2004/04/19 06:14:43 rrossmair +// Help TODOs done +// +// Revision 1.15 2004/04/18 19:57:29 +// - rename one of the GetOpenGLVersion to GetOpenGLVersionBitmapRendering +// - delete pre-loading of Glu32Handle +// - move the OpenGl32Handle call to directly before ChoosePixelFormat +// +// Revision 1.14 2004/04/18 05:14:11 rrossmair +// fixed GetOpenGLVersion (draw to bitmap overload); removed VCL dependency ("uses Graphics") +// +// Revision 1.13 2004/04/18 00:43:19 +// modify und bugfix GetOpenGLVersion, add second function for bitmap rendering +// +// Revision 1.12 2004/04/09 15:05:09 mthoma +// Added new function GetAPMBatteryFlags. +// +// Revision 1.11 2004/04/07 13:55:09 peter3 +// - var params cannot be passed by adress +// +// Revision 1.10 2004/04/07 07:33:39 marquardt +// fixes for GetVersionEx +// +// Revision 1.9 2004/04/06 04:53:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/common/JclSysUtils.pas b/official/1.96/source/common/JclSysUtils.pas new file mode 100644 index 0000000..dacff83 --- /dev/null +++ b/official/1.96/source/common/JclSysUtils.pas @@ -0,0 +1,2461 @@ +{**************************************************************************************************} +{ } +{ 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 JclSysUtils.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: } +{ Alexander Radchenko, } +{ Andreas Hausladen (ahuser) } +{ Anthony Steele } +{ Bernhard Berger } +{ Heri Bender } +{ Jeff } +{ Jeroen Speldekamp } +{ Marcel van Brakel } +{ Peter Friese } +{ Petr Vones (pvones) } +{ Python } +{ Robert Marquardt (marquardt) } +{ Robert R. Marsh } +{ Robert Rossmair (rrossmair) } +{ Rudy Velthuis } +{ Uwe Schuster (uschuster) } +{ Wayne Sherman } +{ } +{**************************************************************************************************} +{ } +{ Description: Various pointer and class related routines. } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/26 20:30:07 $ +// For history see end of file + +unit JclSysUtils; + +{$I jcl.inc} + +interface + +uses + {$IFDEF CLR} + Variants, + {$ELSE} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$ENDIF CLR} + Classes, TypInfo, + JclBase; + +{$IFNDEF CLR} +// Pointer manipulation +procedure GetAndFillMem(var P: Pointer; const Size: Integer; const Value: Byte); +procedure FreeMemAndNil(var P: Pointer); +function PCharOrNil(const S: string): PChar; +function PAnsiCharOrNil(const S: AnsiString): PAnsiChar; +{$IFDEF SUPPORTS_WIDESTRING} +function PWideCharOrNil(const W: WideString): PWideChar; +{$ENDIF SUPPORTS_WIDESTRING} + +function SizeOfMem(const APointer: Pointer): Integer; + +function WriteProtectedMemory(BaseAddress, Buffer: Pointer; Size: Cardinal; + out WrittenBytes: Cardinal): Boolean; + +// Guards +type + ISafeGuard = interface + function ReleaseItem: Pointer; + function GetItem: Pointer; + procedure FreeItem; + property Item: Pointer read GetItem; + end; + + IMultiSafeGuard = interface (IInterface) + function AddItem(Item: Pointer): Pointer; + procedure FreeItem(Index: Integer); + function GetCount: Integer; + function GetItem(Index: Integer): Pointer; + function ReleaseItem(Index: Integer): Pointer; + property Count: Integer read GetCount; + property Items[Index: Integer]: Pointer read GetItem; + end; + +function Guard(Mem: Pointer; out SafeGuard: ISafeGuard): Pointer; overload; +function Guard(Obj: TObject; out SafeGuard: ISafeGuard): TObject; overload; + +function Guard(Mem: Pointer; var SafeGuard: IMultiSafeGuard): Pointer; overload; +function Guard(Obj: TObject; var SafeGuard: IMultiSafeGuard): TObject; overload; + +function GuardGetMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer; +function GuardAllocMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer; + +// Binary search +function SearchSortedList(List: TList; SortFunc: TListSortCompare; Item: Pointer; + Nearest: Boolean = False): Integer; + +type + TUntypedSearchCompare = function(Param: Pointer; ItemIndex: Integer; const Value): Integer; + +function SearchSortedUntyped(Param: Pointer; ItemCount: Integer; SearchFunc: TUntypedSearchCompare; + const Value; Nearest: Boolean = False): Integer; + +// Dynamic array sort and search routines +type + TDynArraySortCompare = function (Item1, Item2: Pointer): Integer; + +procedure SortDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare); +// Usage: SortDynArray(Array, SizeOf(Array[0]), SortFunction); +function SearchDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare; + ValuePtr: Pointer; Nearest: Boolean = False): Integer; +// Usage: SearchDynArray(Array, SizeOf(Array[0]), SortFunction, @SearchedValue); + +{ Various compare functions for basic types } + +function DynArrayCompareByte(Item1, Item2: Pointer): Integer; +function DynArrayCompareShortInt(Item1, Item2: Pointer): Integer; +function DynArrayCompareWord(Item1, Item2: Pointer): Integer; +function DynArrayCompareSmallInt(Item1, Item2: Pointer): Integer; +function DynArrayCompareInteger(Item1, Item2: Pointer): Integer; +function DynArrayCompareCardinal(Item1, Item2: Pointer): Integer; +function DynArrayCompareInt64(Item1, Item2: Pointer): Integer; + +function DynArrayCompareSingle(Item1, Item2: Pointer): Integer; +function DynArrayCompareDouble(Item1, Item2: Pointer): Integer; +function DynArrayCompareExtended(Item1, Item2: Pointer): Integer; +function DynArrayCompareFloat(Item1, Item2: Pointer): Integer; + +function DynArrayCompareAnsiString(Item1, Item2: Pointer): Integer; +function DynArrayCompareAnsiText(Item1, Item2: Pointer): Integer; +function DynArrayCompareString(Item1, Item2: Pointer): Integer; +function DynArrayCompareText(Item1, Item2: Pointer): Integer; +{$ENDIF ~CLR} + +// Object lists +procedure ClearObjectList(List: TList); +procedure FreeObjectList(var List: TList); + +{$IFNDEF CLR} +// Reference memory stream +type + TJclReferenceMemoryStream = class(TCustomMemoryStream) + public + constructor Create(const Ptr: Pointer; Size: Longint); + function Write(const Buffer; Count: Longint): Longint; override; + end; +{$ENDIF ~CLR} + +// Replacement for the C ternary conditional operator ? : +function Iff(const Condition: Boolean; const TruePart, FalsePart: string): string; overload; +function Iff(const Condition: Boolean; const TruePart, FalsePart: Char): Char; overload; +function Iff(const Condition: Boolean; const TruePart, FalsePart: Byte): Byte; overload; +function Iff(const Condition: Boolean; const TruePart, FalsePart: Integer): Integer; overload; +function Iff(const Condition: Boolean; const TruePart, FalsePart: Cardinal): Cardinal; overload; +function Iff(const Condition: Boolean; const TruePart, FalsePart: Float): Float; overload; +function Iff(const Condition: Boolean; const TruePart, FalsePart: Boolean): Boolean; overload; +{$IFNDEF CLR} +function Iff(const Condition: Boolean; const TruePart, FalsePart: Pointer): Pointer; overload; +{$ENDIF ~CLR} +function Iff(const Condition: Boolean; const TruePart, FalsePart: Int64): Int64; overload; +{$IFDEF SUPPORTS_VARIANT} +{$IFDEF COMPILER6_UP} { TODO -cFPC : Check FPC } +// because Compiler 5 can not differentiate between Variant and Byte, Integer, ... in case of overload +function Iff(const Condition: Boolean; const TruePart, FalsePart: Variant): Variant; overload; +{$ENDIF COMPILER6_UP} +{$ENDIF SUPPORTS_VARIANT} + +{$IFNDEF CLR} +// Classes information and manipulation +type + EJclVMTError = class(EJclError); + +// Virtual Methods +{$IFNDEF FPC} +function GetVirtualMethodCount(AClass: TClass): Integer; +{$ENDIF ~FPC} +function GetVirtualMethod(AClass: TClass; const Index: Integer): Pointer; +procedure SetVirtualMethod(AClass: TClass; const Index: Integer; const Method: Pointer); + +// Dynamic Methods +type + TDynamicIndexList = array [0..MaxInt div 16] of Word; + PDynamicIndexList = ^TDynamicIndexList; + TDynamicAddressList = array [0..MaxInt div 16] of Pointer; + PDynamicAddressList = ^TDynamicAddressList; + +function GetDynamicMethodCount(AClass: TClass): Integer; +function GetDynamicIndexList(AClass: TClass): PDynamicIndexList; +function GetDynamicAddressList(AClass: TClass): PDynamicAddressList; +function HasDynamicMethod(AClass: TClass; Index: Integer): Boolean; +{$IFNDEF FPC} +function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer; +{$ENDIF ~FPC} + +{ init table methods } + +function GetInitTable(AClass: TClass): PTypeInfo; + +{ field table methods } + +type + PFieldEntry = ^TFieldEntry; + TFieldEntry = packed record + OffSet: Integer; + IDX: Word; + Name: ShortString; + end; + + PFieldClassTable = ^TFieldClassTable; + TFieldClassTable = packed record + Count: Smallint; + Classes: array [0..8191] of ^TPersistentClass; + end; + + PFieldTable = ^TFieldTable; + TFieldTable = packed record + EntryCount: Word; + FieldClassTable: PFieldClassTable; + FirstEntry: TFieldEntry; + {Entries: array [1..65534] of TFieldEntry;} + end; + +function GetFieldTable(AClass: TClass): PFieldTable; + +{ method table } + +type + PMethodEntry = ^TMethodEntry; + TMethodEntry = packed record + EntrySize: Word; + Address: Pointer; + Name: ShortString; + end; + + PMethodTable = ^TMethodTable; + TMethodTable = packed record + Count: Word; + FirstEntry: TMethodEntry; + {Entries: array [1..65534] of TMethodEntry;} + end; + +function GetMethodTable(AClass: TClass): PMethodTable; +function GetMethodEntry(MethodTable: PMethodTable; Index: Integer): PMethodEntry; + +// Class Parent +procedure SetClassParent(AClass: TClass; NewClassParent: TClass); +function GetClassParent(AClass: TClass): TClass; + +{$IFNDEF FPC} +function IsClass(Address: Pointer): Boolean; +function IsObject(Address: Pointer): Boolean; +{$ENDIF ~FPC} + +// Interface information +function GetImplementorOfInterface(const I: IInterface): TObject; +{$ENDIF ~CLR} + +// Numeric formatting routines +type + TDigitCount = 0..255; + TDigitValue = -1..35; // invalid, '0'..'9', 'A'..'Z' + TNumericSystemBase = 2..Succ(High(TDigitValue)); + + TJclNumericFormat = class(TObject) + private + FWantedPrecision: TDigitCount; + FPrecision: TDigitCount; + FNumberOfFractionalDigits: TDigitCount; + FExpDivision: Integer; + FDigitBlockSize: TDigitCount; + FWidth: TDigitCount; + FSignChars: array [Boolean] of Char; + FBase: TNumericSystemBase; + FFractionalPartSeparator: Char; + FDigitBlockSeparator: Char; + FShowPositiveSign: Boolean; + FPaddingChar: Char; + FMultiplier: string; + function GetDigitValue(Digit: Char): Integer; + function GetNegativeSign: Char; + function GetPositiveSign: Char; + procedure InvalidDigit(Digit: Char); + procedure SetPrecision(const Value: TDigitCount); + procedure SetBase(const Value: TNumericSystemBase); + procedure SetNegativeSign(const Value: Char); + procedure SetPositiveSign(const Value: Char); + procedure SetExpDivision(const Value: Integer); + protected + function IntToStr(const Value: Int64; out FirstDigitPos: Integer): string; overload; + function ShowSign(const Value: Float): Boolean; overload; + function ShowSign(const Value: Int64): Boolean; overload; + function SignChar(const Value: Float): Char; overload; + function SignChar(const Value: Int64): Char; overload; + property WantedPrecision: TDigitCount read FWantedPrecision; + public + constructor Create; + function Digit(DigitValue: TDigitValue): Char; + function DigitValue(Digit: Char): TDigitValue; + function IsDigit(Value: Char): Boolean; + function Sign(Value: Char): Integer; + procedure GetMantissaExp(const Value: Float; out Mantissa: string; out Exponent: Integer); + function FloatToHTML(const Value: Float): string; + function IntToStr(const Value: Int64): string; overload; + function FloatToStr(const Value: Float): string; overload; + function StrToInt(const Value: string): Int64; + property Base: TNumericSystemBase read FBase write SetBase; + property Precision: TDigitCount read FPrecision write SetPrecision; + property NumberOfFractionalDigits: TDigitCount read FNumberOfFractionalDigits write FNumberOfFractionalDigits; + property ExponentDivision: Integer read FExpDivision write SetExpDivision; + property DigitBlockSize: TDigitCount read FDigitBlockSize write FDigitBlockSize; + property DigitBlockSeparator: Char read FDigitBlockSeparator write FDigitBlockSeparator; + property FractionalPartSeparator: Char read FFractionalPartSeparator write FFractionalPartSeparator; + property Multiplier: string read FMultiplier write FMultiplier; + property PaddingChar: Char read FPaddingChar write FPaddingChar; + property ShowPositiveSign: Boolean read FShowPositiveSign write FShowPositiveSign; + property Width: TDigitCount read FWidth write FWidth; + property NegativeSign: Char read GetNegativeSign write SetNegativeSign; + property PositiveSign: Char read GetPositiveSign write SetPositiveSign; + end; + +function IntToStrZeroPad(Value, Count: Integer): AnsiString; + +// Child processes +type + // e.g. TStrings.Append + TTextHandler = procedure(const Text: string) of object; + {$IFDEF FPC} + PBoolean = System.PBoolean; // as opposed to Windows.PBoolean, which is a pointer to Byte?! + {$ENDIF FPC} + +{$IFNDEF CLR} +const + ABORT_EXIT_CODE = {$IFDEF MSWINDOWS} ERROR_CANCELLED {$ELSE} 1223 {$ENDIF}; + +function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; RawOutput: Boolean = False; + AbortPtr: PBoolean = nil): Cardinal; overload; +function Execute(const CommandLine: string; var Output: string; RawOutput: Boolean = False; + AbortPtr: PBoolean = nil): Cardinal; overload; + +// Console Utilities +function ReadKey: Char; + +// Loading of modules (DLLs) +type +{$IFDEF MSWINDOWS} + TModuleHandle = HINST; +{$ENDIF MSWINDOWS} +{$IFDEF LINUX} + TModuleHandle = Pointer; +{$ENDIF LINUX} + +const + INVALID_MODULEHANDLE_VALUE = TModuleHandle(0); + +function LoadModule(var Module: TModuleHandle; FileName: string): Boolean; +function LoadModuleEx(var Module: TModuleHandle; FileName: string; Flags: Cardinal): Boolean; +procedure UnloadModule(var Module: TModuleHandle); +function GetModuleSymbol(Module: TModuleHandle; SymbolName: string): Pointer; +function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: string; var Accu: Boolean): Pointer; +function ReadModuleData(Module: TModuleHandle; SymbolName: string; var Buffer; Size: Cardinal): Boolean; +function WriteModuleData(Module: TModuleHandle; SymbolName: string; var Buffer; Size: Cardinal): Boolean; +{$ENDIF ~CLR} + +// Conversion Utilities +type + EJclConversionError = class(EJclError); + +function StrToBoolean(const S: string): Boolean; +function IntToBool(I: Integer): Boolean; +function BoolToInt(B: Boolean): Integer; + +// RTL package information +{$IFNDEF CLR} +{$IFNDEF FPC} +function SystemTObjectInstance: LongWord; +function IsCompiledWithPackages: Boolean; +{$ENDIF ~FPC} +{$ENDIF ~CLR} + +// GUID +function JclGUIDToString(const GUID: TGUID): string; +function JclStringToGUID(const S: string): TGUID; + +implementation + +uses + {$IFDEF HAS_UNIT_TYPES} + Types, + {$ENDIF HAS_UNIT_TYPES} + {$IFDEF UNIX} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ELSE ~HAS_UNIT_LIBC} + dl, + {$ENDIF ~HAS_UNIT_LIBC} + {$ENDIF UNIX} + {$IFDEF CLR} + System.Text, + {$ELSE} + {$IFDEF MSWINDOWS} + JclConsole, + {$ENDIF MSWINDOWS} + {$ENDIF CLR} + SysUtils, Contnrs, + JclResources, JclStrings, JclMath; + +{$IFNDEF CLR} +// Pointer manipulation +procedure GetAndFillMem(var P: Pointer; const Size: Integer; const Value: Byte); +begin + GetMem(P, Size); + FillChar(P^, Size, Value); +end; + +procedure FreeMemAndNil(var P: Pointer); +var + Q: Pointer; +begin + Q := P; + P := nil; + FreeMem(Q); +end; + +function PCharOrNil(const S: string): PChar; +begin + Result := Pointer(S); +end; + +function PAnsiCharOrNil(const S: AnsiString): PAnsiChar; +begin + Result := Pointer(S); +end; + +{$IFDEF SUPPORTS_WIDESTRING} + +function PWideCharOrNil(const W: WideString): PWideChar; +begin + Result := Pointer(W); +end; + +{$ENDIF SUPPORTS_WIDESTRING} + +{$IFDEF MSWINDOWS} +type + PUsed = ^TUsed; + TUsed = record + SizeFlags: Integer; + end; + +const + cThisUsedFlag = 2; + cPrevFreeFlag = 1; + cFillerFlag = Integer($80000000); + cFlags = cThisUsedFlag or cPrevFreeFlag or cFillerFlag; + +function SizeOfMem(const APointer: Pointer): Integer; +var + U: PUsed; +begin + if IsMemoryManagerSet then + Result:= -1 + else + begin + Result := 0; + if APointer <> nil then + begin + U := APointer; + U := PUsed(PChar(U) - SizeOf(TUsed)); + if (U.SizeFlags and cThisUsedFlag) <> 0 then + Result := (U.SizeFlags) and (not cFlags - SizeOf(TUsed)); + end; + end; +end; +{$ENDIF MSWINDOWS} + +{$IFDEF LINUX} +function SizeOfMem(const APointer: Pointer): Integer; +begin + if IsMemoryManagerSet then + Result:= -1 + else + begin + if APointer <> nil then + Result := malloc_usable_size(APointer) + else + Result := 0; + end; +end; +{$ENDIF LINUX} + +function WriteProtectedMemory(BaseAddress, Buffer: Pointer; + Size: Cardinal; out WrittenBytes: Cardinal): Boolean; +{$IFDEF MSWINDOWS} +begin + Result := WriteProcessMemory(GetCurrentProcess, BaseAddress, Buffer, Size, WrittenBytes); +end; +{$ENDIF MSWINDOWS} +{$IFDEF LINUX} +{ TODO -cHelp : Author: Andreas Hausladen } +{ TODO : Works so far, but causes app to hang on termination } +var + AlignedAddress: Cardinal; + PageSize, ProtectSize: Cardinal; +begin + Result := False; + WrittenBytes := 0; + + PageSize := Cardinal(getpagesize); + AlignedAddress := Cardinal(BaseAddress) and not (PageSize - 1); // start memory page + // get the number of needed memory pages + ProtectSize := PageSize; + while Cardinal(BaseAddress) + Size > AlignedAddress + ProtectSize do + Inc(ProtectSize, PageSize); + + if mprotect(Pointer(AlignedAddress), ProtectSize, + PROT_READ or PROT_WRITE or PROT_EXEC) = 0 then // obtain write access + begin + try + Move(Buffer^, BaseAddress^, Size); // replace code + Result := True; + WrittenBytes := Size; + finally + // Is there any function that returns the current page protection? +// mprotect(p, ProtectSize, PROT_READ or PROT_EXEC); // lock memory page + end; + end; +end; + +procedure FlushInstructionCache; +{ TODO -cHelp : Author: Andreas Hausladen } +begin + // do nothing +end; + +{$ENDIF LINUX} + +// Guards +type + TSafeGuard = class(TInterfacedObject, ISafeGuard) + private + FItem: Pointer; + public + constructor Create(Mem: Pointer); + destructor Destroy; override; + function ReleaseItem: Pointer; + function GetItem: Pointer; + procedure FreeItem; virtual; + end; + + TObjSafeGuard = class(TSafeGuard, ISafeGuard) + public + constructor Create(Obj: TObject); + procedure FreeItem; override; + end; + + TMultiSafeGuard = class(TInterfacedObject, IMultiSafeGuard) + private + FItems: TList; + public + constructor Create; + destructor Destroy; override; + function AddItem(Mem: Pointer): Pointer; + procedure FreeItem(Index: Integer); virtual; + function GetCount: Integer; + function GetItem(Index: Integer): Pointer; + function ReleaseItem(Index: Integer): Pointer; + end; + + TObjMultiSafeGuard = class(TMultiSafeGuard, IMultiSafeGuard) + public + procedure FreeItem(Index: Integer); override; + end; + +//=== { TSafeGuard } ========================================================= + +constructor TSafeGuard.Create(Mem: Pointer); +begin + inherited Create; + FItem := Mem; +end; + +destructor TSafeGuard.Destroy; +begin + FreeItem; + inherited Destroy; +end; + +function TSafeGuard.ReleaseItem: Pointer; +begin + Result := FItem; + FItem := nil; +end; + +function TSafeGuard.GetItem: Pointer; +begin + Result := FItem; +end; + +procedure TSafeGuard.FreeItem; +begin + if FItem <> nil then + FreeMem(FItem); + FItem := nil; +end; + +//=== { TObjSafeGuard } ====================================================== + +constructor TObjSafeGuard.Create(Obj: TObject); +begin + inherited Create(Pointer(Obj)); +end; + +procedure TObjSafeGuard.FreeItem; +begin + if FItem <> nil then + begin + TObject(FItem).Free; + FItem := nil; + end; +end; + +//=== { TMultiSafeGuard } ==================================================== + +constructor TMultiSafeGuard.Create; +begin + inherited Create; + FItems := TList.Create; +end; + +destructor TMultiSafeGuard.Destroy; +var + I: Integer; +begin + for I := FItems.Count - 1 downto 0 do FreeItem(I); + FItems.Free; + inherited Destroy; +end; + +function TMultiSafeGuard.AddItem(Mem: Pointer): Pointer; +begin + Result := Mem; + FItems.Add(Mem); +end; + +procedure TMultiSafeGuard.FreeItem(Index: Integer); +begin + FreeMem(FItems[Index]); + FItems.Delete(Index); +end; + +function TMultiSafeGuard.GetCount: Integer; +begin + Result := FItems.Count; +end; + +function TMultiSafeGuard.GetItem(Index: Integer): Pointer; +begin + Result := FItems[Index]; +end; + +function TMultiSafeGuard.ReleaseItem(Index: Integer): Pointer; +begin + Result := FItems[Index]; + FItems.Delete(Index); +end; + +function Guard(Mem: Pointer; var SafeGuard: IMultiSafeGuard): Pointer; overload; +begin + if SafeGuard = nil then + SafeGuard := TMultiSafeGuard.Create; + Result := SafeGuard.AddItem(Mem); +end; + +//=== { TObjMultiSafeGuard } ================================================= + +procedure TObjMultiSafeGuard.FreeItem(Index: Integer); +begin + TObject(FItems[Index]).Free; + FItems.Delete(Index); +end; + +function Guard(Obj: TObject; var SafeGuard: IMultiSafeGuard): TObject; overload; +begin + if SafeGuard = nil then + SafeGuard := TObjMultiSafeGuard.Create; + Result := SafeGuard.AddItem(Obj); +end; + +function Guard(Mem: Pointer; out SafeGuard: ISafeGuard): Pointer; overload; +begin + Result := Mem; + SafeGuard := TSafeGuard.Create(Mem); +end; + +function Guard(Obj: TObject; out SafeGuard: ISafeGuard): TObject; overload; +begin + Result := Obj; + SafeGuard := TObjSafeGuard.Create(Obj); +end; + +function GuardGetMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer; +begin + GetMem(Result, Size); + Guard(Result, SafeGuard); +end; + +function GuardAllocMem(Size: Cardinal; out SafeGuard: ISafeGuard): Pointer; +begin + Result := AllocMem(Size); + Guard(Result, SafeGuard); +end; + +//=== Binary search ========================================================== + +function SearchSortedList(List: TList; SortFunc: TListSortCompare; Item: Pointer; Nearest: Boolean): Integer; +var + L, H, I, C: Integer; + B: Boolean; +begin + Result := -1; + if List <> nil then + begin + L := 0; + H := List.Count - 1; + B := False; + while L <= H do + begin + I := (L + H) shr 1; + C := SortFunc(List.List^[I], Item); + if C < 0 then + L := I + 1 + else + begin + H := I - 1; + if C = 0 then + begin + B := True; + L := I; + end; + end; + end; + if B then + Result := L + else + if Nearest and (H >= 0) then + Result := H; + end; +end; + +function SearchSortedUntyped(Param: Pointer; ItemCount: Integer; SearchFunc: TUntypedSearchCompare; + const Value; Nearest: Boolean): Integer; +var + L, H, I, C: Integer; + B: Boolean; +begin + Result := -1; + if ItemCount > 0 then + begin + L := 0; + H := ItemCount - 1; + B := False; + while L <= H do + begin + I := (L + H) shr 1; + C := SearchFunc(Param, I, Value); + if C < 0 then + L := I + 1 + else + begin + H := I - 1; + if C = 0 then + begin + B := True; + L := I; + end; + end; + end; + if B then + Result := L + else + if Nearest and (H >= 0) then + Result := H; + end; +end; + +//=== Dynamic array sort and search routines ================================= + +procedure SortDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare); +var + TempBuf: TDynByteArray; + + function ArrayItemPointer(Item: Integer): Pointer; + begin + Result := Pointer(Cardinal(ArrayPtr) + (Cardinal(Item) * ElementSize)); + end; + + procedure QuickSort(L, R: Integer); + var + I, J, T: Integer; + P, IPtr, JPtr: Pointer; + begin + repeat + I := L; + J := R; + P := ArrayItemPointer((L + R) shr 1); + repeat + while SortFunc(ArrayItemPointer(I), P) < 0 do + Inc(I); + while SortFunc(ArrayItemPointer(J), P) > 0 do + Dec(J); + if I <= J then + begin + IPtr := ArrayItemPointer(I); + JPtr := ArrayItemPointer(J); + case ElementSize of + SizeOf(Byte): + begin + T := PByte(IPtr)^; + PByte(IPtr)^ := PByte(JPtr)^; + PByte(JPtr)^ := T; + end; + SizeOf(Word): + begin + T := PWord(IPtr)^; + PWord(IPtr)^ := PWord(JPtr)^; + PWord(JPtr)^ := T; + end; + SizeOf(Integer): + begin + T := PInteger(IPtr)^; + PInteger(IPtr)^ := PInteger(JPtr)^; + PInteger(JPtr)^ := T; + end; + else + Move(IPtr^, TempBuf[0], ElementSize); + Move(JPtr^, IPtr^, ElementSize); + Move(TempBuf[0], JPtr^, ElementSize); + end; + if P = IPtr then + P := JPtr + else + if P = JPtr then + P := IPtr; + Inc(I); + Dec(J); + end; + until I > J; + if L < J then + QuickSort(L, J); + L := I; + until I >= R; + end; + +begin + if ArrayPtr <> nil then + begin + SetLength(TempBuf, ElementSize); + QuickSort(0, PInteger(Cardinal(ArrayPtr) - 4)^ - 1); + end; +end; + +function SearchDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc: TDynArraySortCompare; + ValuePtr: Pointer; Nearest: Boolean): Integer; +var + L, H, I, C: Integer; + B: Boolean; +begin + Result := -1; + if ArrayPtr <> nil then + begin + L := 0; + H := PInteger(Cardinal(ArrayPtr) - 4)^ - 1; + B := False; + while L <= H do + begin + I := (L + H) shr 1; + C := SortFunc(Pointer(Cardinal(ArrayPtr) + (Cardinal(I) * ElementSize)), ValuePtr); + if C < 0 then + L := I + 1 + else + begin + H := I - 1; + if C = 0 then + begin + B := True; + L := I; + end; + end; + end; + if B then + Result := L + else + if Nearest and (H >= 0) then + Result := H; + end; +end; + +{ Various compare functions for basic types } + +function DynArrayCompareByte(Item1, Item2: Pointer): Integer; +begin + Result := PByte(Item1)^ - PByte(Item2)^; +end; + +function DynArrayCompareShortInt(Item1, Item2: Pointer): Integer; +begin + Result := PShortInt(Item1)^ - PShortInt(Item2)^; +end; + +function DynArrayCompareWord(Item1, Item2: Pointer): Integer; +begin + Result := PWord(Item1)^ - PWord(Item2)^; +end; + +function DynArrayCompareSmallInt(Item1, Item2: Pointer): Integer; +begin + Result := PSmallInt(Item1)^ - PSmallInt(Item2)^; +end; + +function DynArrayCompareInteger(Item1, Item2: Pointer): Integer; +begin + Result := PInteger(Item1)^ - PInteger(Item2)^; +end; + +function DynArrayCompareCardinal(Item1, Item2: Pointer): Integer; +begin + Result := PInteger(Item1)^ - PInteger(Item2)^; +end; + +function DynArrayCompareInt64(Item1, Item2: Pointer): Integer; +begin + Result := PInt64(Item1)^ - PInt64(Item2)^; +end; + +function DynArrayCompareSingle(Item1, Item2: Pointer): Integer; +begin + if PSingle(Item1)^ < PSingle(Item2)^ then + Result := -1 + else + if PSingle(Item1)^ > PSingle(Item2)^ then + Result := 1 + else + Result := 0; +end; + +function DynArrayCompareDouble(Item1, Item2: Pointer): Integer; +begin + if PDouble(Item1)^ < PDouble(Item2)^ then + Result := -1 + else + if PDouble(Item1)^ > PDouble(Item2)^ then + Result := 1 + else + Result := 0; +end; + +function DynArrayCompareExtended(Item1, Item2: Pointer): Integer; +begin + if PExtended(Item1)^ < PExtended(Item2)^ then + Result := -1 + else + if PExtended(Item1)^ > PExtended(Item2)^ then + Result := 1 + else + Result := 0; +end; + +function DynArrayCompareFloat(Item1, Item2: Pointer): Integer; +begin + if PFloat(Item1)^ < PFloat(Item2)^ then + Result := -1 + else + if PFloat(Item1)^ > PFloat(Item2)^ then + Result := 1 + else + Result := 0; +end; + +function DynArrayCompareAnsiString(Item1, Item2: Pointer): Integer; +begin + Result := AnsiCompareStr(PAnsiString(Item1)^, PAnsiString(Item2)^); +end; + +function DynArrayCompareAnsiText(Item1, Item2: Pointer): Integer; +begin + Result := AnsiCompareText(PAnsiString(Item1)^, PAnsiString(Item2)^); +end; + +function DynArrayCompareString(Item1, Item2: Pointer): Integer; +begin + Result := CompareStr(PAnsiString(Item1)^, PAnsiString(Item2)^); +end; + +function DynArrayCompareText(Item1, Item2: Pointer): Integer; +begin + Result := CompareText(PAnsiString(Item1)^, PAnsiString(Item2)^); +end; +{$ENDIF ~CLR} + +//=== Object lists =========================================================== + +procedure ClearObjectList(List: TList); +var + I: Integer; +begin + if List <> nil then + begin + for I := List.Count - 1 downto 0 do + begin + if List[I] <> nil then + begin + if TObject(List[I]) is TList then + begin + // recursively delete TList sublists + ClearObjectList(TList(List[I])); + end; + TObject(List[I]).Free; + if (not (List is TComponentList)) + and ((not(List is TObjectList)) or not TObjectList(List).OwnsObjects) then + List[I] := nil; + end; + end; + List.Clear; + end; +end; + +procedure FreeObjectList(var List: TList); +begin + if List <> nil then + begin + ClearObjectList(List); + FreeAndNil(List); + end; +end; + +{$IFNDEF CLR} +//=== { TJclReferenceMemoryStream } ========================================== + +constructor TJclReferenceMemoryStream.Create(const Ptr: Pointer; Size: Longint); +begin + {$IFDEF MSWINDOWS} + Assert(not IsBadReadPtr(Ptr, Size)); + {$ENDIF MSWINDOWS} + inherited Create; + SetPointer(Ptr, Size); +end; + +function TJclReferenceMemoryStream.Write(const Buffer; Count: Longint): Longint; +begin + raise EJclError.CreateRes(@RsCannotWriteRefStream); +end; +{$ENDIF ~CLR} + +//=== replacement for the C distfix operator ? : ============================= + +function Iff(const Condition: Boolean; const TruePart, FalsePart: string): string; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; + +function Iff(const Condition: Boolean; const TruePart, FalsePart: Char): Char; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; + +function Iff(const Condition: Boolean; const TruePart, FalsePart: Byte): Byte; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; + +function Iff(const Condition: Boolean; const TruePart, FalsePart: Integer): Integer; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; + +function Iff(const Condition: Boolean; const TruePart, FalsePart: Cardinal): Cardinal; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; + +function Iff(const Condition: Boolean; const TruePart, FalsePart: Float): Float; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; + +function Iff(const Condition: Boolean; const TruePart, FalsePart: Boolean): Boolean; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; + +{$IFNDEF CLR} +function Iff(const Condition: Boolean; const TruePart, FalsePart: Pointer): Pointer; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; +{$ENDIF ~CLR} + +function Iff(const Condition: Boolean; const TruePart, FalsePart: Int64): Int64; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; + +{$IFDEF SUPPORTS_VARIANT} +{$IFDEF COMPILER6_UP} +function Iff(const Condition: Boolean; const TruePart, FalsePart: Variant): Variant; overload; +begin + if Condition then + Result := TruePart + else + Result := FalsePart; +end; +{$ENDIF COMPILER6_UP} +{$ENDIF SUPPORTS_VARIANT} + +{$IFNDEF CLR} +//=== Classes information and manipulation =================================== +// Virtual Methods +// Helper method + +procedure SetVMTPointer(AClass: TClass; Offset: Integer; Value: Pointer); +var + WrittenBytes: DWORD; + PatchAddress: PPointer; +begin + PatchAddress := Pointer(Integer(AClass) + Offset); + //! StH: WriteProcessMemory IMO is not exactly the politically correct approach; + // better VirtualProtect, direct patch, VirtualProtect + if not WriteProtectedMemory(PatchAddress, @Value, SizeOf(Value), WrittenBytes) then + raise EJclVMTError.CreateResFmt(@RsVMTMemoryWriteError, [SysErrorMessage(GetLastError)]); + + if WrittenBytes <> SizeOf(Pointer) then + raise EJclVMTError.CreateResFmt(@RsVMTMemoryWriteError, [IntToStr(WrittenBytes)]); + + // make sure that everything keeps working in a dual processor setting + FlushInstructionCache{$IFDEF MSWINDOWS}(GetCurrentProcess, PatchAddress, SizeOf(Pointer)){$ENDIF}; +end; + +{$IFNDEF FPC} +function GetVirtualMethodCount(AClass: TClass): Integer; +var + BeginVMT: Longint; + EndVMT: Longint; + TablePointer: Longint; + I: Integer; +begin + BeginVMT := Longint(AClass); + + // Scan the offset entries in the class table for the various fields, + // namely vmtIntfTable, vmtAutoTable, ..., vmtDynamicTable + // The last entry is always the vmtClassName, so stop once we got there + // After the last virtual method there is one of these entries. + + EndVMT := PLongint(Longint(AClass) + vmtClassName)^; + // Set iterator to first item behind VMT table pointer + I := vmtSelfPtr + SizeOf(Pointer); + repeat + TablePointer := PLongint(Longint(AClass) + I)^; + if (TablePointer <> 0) and (TablePointer >= BeginVMT) and + (TablePointer < EndVMT) then + EndVMT := Longint(TablePointer); + Inc(I, SizeOf(Pointer)); + until I >= vmtClassName; + + Result := (EndVMT - BeginVMT) div SizeOf(Pointer); +end; +{$ENDIF ~FPC} + +function GetVirtualMethod(AClass: TClass; const Index: Integer): Pointer; +begin + Result := PPointer(Integer(AClass) + Index * SizeOf(Pointer))^; +end; + +procedure SetVirtualMethod(AClass: TClass; const Index: Integer; const Method: Pointer); +begin + SetVMTPointer(AClass, Index * SizeOf(Pointer), Method); +end; + +// Dynamic Methods +type + TvmtDynamicTable = packed record + Count: Word; + {IndexList: array [1..Count] of Word; + AddressList: array [1..Count] of Pointer;} + end; + +function GetDynamicMethodCount(AClass: TClass): Integer; assembler; +asm + MOV EAX, [EAX].vmtDynamicTable + TEST EAX, EAX + JE @@Exit + MOVZX EAX, WORD PTR [EAX] +@@Exit: +end; + +function GetDynamicIndexList(AClass: TClass): PDynamicIndexList; assembler; +asm + MOV EAX, [EAX].vmtDynamicTable + ADD EAX, 2 +end; + +function GetDynamicAddressList(AClass: TClass): PDynamicAddressList; assembler; +asm + MOV EAX, [EAX].vmtDynamicTable + MOVZX EDX, Word ptr [EAX] + ADD EAX, EDX + ADD EAX, EDX + ADD EAX, 2 +end; + +function HasDynamicMethod(AClass: TClass; Index: Integer): Boolean; assembler; +// Mainly copied from System.GetDynaMethod +asm + { -> EAX vmt of class } + { DX dynamic method index } + + PUSH EDI + XCHG EAX, EDX + JMP @@HaveVMT +@@OuterLoop: + MOV EDX, [EDX] +@@HaveVMT: + MOV EDI, [EDX].vmtDynamicTable + TEST EDI, EDI + JE @@Parent + MOVZX ECX, WORD PTR [EDI] + PUSH ECX + ADD EDI,2 + REPNE SCASW + JE @@Found + POP ECX +@@Parent: + MOV EDX,[EDX].vmtParent + TEST EDX,EDX + JNE @@OuterLoop + MOV EAX, 0 + JMP @@Exit +@@Found: + POP EAX + MOV EAX, 1 +@@Exit: + POP EDI +end; + +{$IFNDEF FPC} +function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer; assembler; +asm + CALL System.@FindDynaClass +end; +{$ENDIF ~FPC} + +//=== Interface Table ======================================================== + +function GetInitTable(AClass: TClass): PTypeInfo; assembler; +asm + MOV EAX, [EAX].vmtInitTable +end; + +function GetFieldTable(AClass: TClass): PFieldTable; assembler; +asm + MOV EAX, [EAX].vmtFieldTable +end; + +function GetMethodTable(AClass: TClass): PMethodTable; assembler; +asm + MOV EAX, [EAX].vmtMethodTable +end; + +function GetMethodEntry(MethodTable: PMethodTable; Index: Integer): PMethodEntry; +begin + Result := Pointer(Cardinal(MethodTable) + 2); + for Index := Index downto 1 do + Inc(Cardinal(Result), Result^.EntrySize); +end; + +//=== Class Parent methods =================================================== + +procedure SetClassParent(AClass: TClass; NewClassParent: TClass); +var + WrittenBytes: DWORD; + PatchAddress: Pointer; +begin + PatchAddress := PPointer(Integer(AClass) + vmtParent)^; + //! StH: WriteProcessMemory IMO is not exactly the politically correct approach; + // better VirtualProtect, direct patch, VirtualProtect + if not WriteProtectedMemory(PatchAddress, @NewClassParent, SizeOf(Pointer), WrittenBytes) then + raise EJclVMTError.CreateResFmt(@RsVMTMemoryWriteError, [SysErrorMessage(GetLastError)]); + if WrittenBytes <> SizeOf(Pointer) then + raise EJclVMTError.CreateResFmt(@RsVMTMemoryWriteError, [IntToStr(WrittenBytes)]); + // make sure that everything keeps working in a dual processor setting + FlushInstructionCache{$IFDEF MSWINDOWS}(GetCurrentProcess, PatchAddress, SizeOf(Pointer)){$ENDIF}; +end; + +function GetClassParent(AClass: TClass): TClass; assembler; +asm + MOV EAX, [EAX].vmtParent + TEST EAX, EAX + JE @@Exit + MOV EAX, [EAX] +@@Exit: +end; + +{$IFNDEF FPC} +function IsClass(Address: Pointer): Boolean; assembler; +asm + CMP Address, Address.vmtSelfPtr + JNZ @False + MOV Result, True + JMP @Exit +@False: + MOV Result, False +@Exit: +end; +{$ENDIF ~FPC} + +{$IFNDEF FPC} +function IsObject(Address: Pointer): Boolean; assembler; +asm +// or IsClass(Pointer(Address^)); + MOV EAX, [Address] + CMP EAX, EAX.vmtSelfPtr + JNZ @False + MOV Result, True + JMP @Exit +@False: + MOV Result, False +@Exit: +end; +{$ENDIF ~FPC} + +//=== Interface information ================================================== + +function GetImplementorOfInterface(const I: IInterface): TObject; +{ TODO -cDOC : Original code by Hallvard Vassbotn } +{ TODO -cTesting : Check the implemetation for any further version of compiler } +const + AddByte = $04244483; // opcode for ADD DWORD PTR [ESP+4], Shortint + AddLong = $04244481; // opcode for ADD DWORD PTR [ESP+4], Longint +type + PAdjustSelfThunk = ^TAdjustSelfThunk; + TAdjustSelfThunk = packed record + case AddInstruction: Longint of + AddByte: (AdjustmentByte: ShortInt); + AddLong: (AdjustmentLong: Longint); + end; + PInterfaceMT = ^TInterfaceMT; + TInterfaceMT = packed record + QueryInterfaceThunk: PAdjustSelfThunk; + end; + TInterfaceRef = ^PInterfaceMT; +var + QueryInterfaceThunk: PAdjustSelfThunk; +begin + try + Result := Pointer(I); + if Assigned(Result) then + begin + QueryInterfaceThunk := TInterfaceRef(I)^.QueryInterfaceThunk; + case QueryInterfaceThunk.AddInstruction of + AddByte: + Inc(PChar(Result), QueryInterfaceThunk.AdjustmentByte); + AddLong: + Inc(PChar(Result), QueryInterfaceThunk.AdjustmentLong); + else + Result := nil; + end; + end; + except + Result := nil; + end; +end; +{$ENDIF ~CLR} + +//=== Numeric formatting routines ============================================ + +function IntToStrZeroPad(Value, Count: Integer): AnsiString; +begin + Result := IntToStr(Value); + if Length(Result) < Count then + Result := StrFillChar('0', Count - Length(Result)) + Result; +end; + +//=== { TJclNumericFormat } ================================================== + +{ TODO -cHelp : Author: Robert Rossmair } +{ Digit: converts a digit value (number) to a digit (char) + DigitValue: converts a digit (char) into a number (digit value) + IntToStr, + FloatToStr, + FloatToHTML: converts a numeric value to a base numeric representation with formating options + StrToIn: converts a base numeric representation into an integer, if possible + GetMantisseExponent: similar to AsString, but returns the Exponent separately as an integer +} +const +{$IFDEF MATH_EXTENDED_PRECISION} + BinaryPrecision = 64; +{$ENDIF MATH_EXTENDED_PRECISION} +{$IFDEF MATH_DOUBLE_PRECISION} + BinaryPrecision = 53; +{$ENDIF MATH_DOUBLE_PRECISION} +{$IFDEF MATH_SINGLE_PRECISION} + BinaryPrecision = 24; +{$ENDIF MATH_SINGLE_PRECISION} + +constructor TJclNumericFormat.Create; +begin + inherited Create; + { TODO : Initialize, when possible, from locale info } + FBase := 10; + FExpDivision := 1; + SetPrecision(6); + FNumberOfFractionalDigits := BinaryPrecision; + FSignChars[False] := '-'; + FSignChars[True] := '+'; + FPaddingChar := ' '; + FMultiplier := '×'; + FFractionalPartSeparator := DecimalSeparator{$IFDEF CLR}[1]{$ENDIF}; + FDigitBlockSeparator := ThousandSeparator{$IFDEF CLR}[1]{$ENDIF}; +end; + +procedure TJclNumericFormat.InvalidDigit(Digit: Char); +begin + {$IFDEF CLR} + raise EConvertError.CreateFmt(RsInvalidDigit, [Base, Digit]); + {$ELSE} + raise EConvertError.CreateResFmt(@RsInvalidDigit, [Base, Digit]); + {$ENDIF CLR} +end; + +function TJclNumericFormat.Digit(DigitValue: TDigitValue): Char; +begin + Assert(DigitValue < Base, Format(RsInvalidDigitValue, [Base, DigitValue])); + if DigitValue > 9 then + Result := Chr(Ord('A') + DigitValue - 10) + else + Result := Chr(Ord('0') + DigitValue); +end; + +function TJclNumericFormat.GetDigitValue(Digit: Char): Integer; +begin + Result := -1; + if Digit in AnsiDecDigits then + Result := Ord(Digit) - Ord('0') + else + begin + Digit := UpCase(Digit); + if Digit in AnsiUppercaseLetters then + Result := Ord(Digit) - Ord('A') + 10; + end; + if Result >= Base then + Result := -1; +end; + +function TJclNumericFormat.DigitValue(Digit: Char): TDigitValue; +begin + Result := GetDigitValue(Digit); + if Result = -1 then + InvalidDigit(Digit); +end; + +function TJclNumericFormat.IsDigit(Value: Char): Boolean; +begin + Result := GetDigitValue(Value) <> -1; +end; + +function TJclNumericFormat.FloatToHTML(const Value: Float): string; +var + Mantissa: string; + Exponent: Integer; +begin + GetMantissaExp(Value, Mantissa, Exponent); + Result := Format('%s %s %d%d', [Mantissa, Multiplier, Base, Exponent]); +end; + +procedure TJclNumericFormat.GetMantissaExp(const Value: Float; + out Mantissa: string; out Exponent: Integer); +const + {$IFDEF FPC} + InfMantissa: array [Boolean] of string[4] = ('inf', '-inf'); + {$ElSE} + InfMantissa: array [Boolean] of string = ('inf', '-inf'); + {$ENDIF FPC} +var + BlockDigits: TDigitCount; + IntDigits, FracDigits: Integer; + FirstDigitPos, Prec: Integer; + I, J, N: Integer; + K: Int64; + X: Extended; + HighDigit: Char; + {$IFDEF CLR} + sb: StringBuilder; + {$ENDIF CLR} + + function GetDigit(X: Extended): Char; + var + N: Integer; + begin + N := Trunc(X); + if N > 9 then + Result := Chr(Ord('A') + N - 10) + else + Result := Chr(Ord('0') + N); + end; + +begin + X := Abs(Value); + + if X > MaxFloatingPoint then + begin + Mantissa := InfMantissa[Value < 0]; + Exponent := 1; + Exit; + end + else + if X < MinFloatingPoint then + begin + Mantissa := Format('%.*f', [Precision, 0.0]); + Exponent := 1; + Exit; + end; + + IntDigits := 1; + Prec := Precision; + + Exponent := Trunc(LogBaseN(Base, X)); + if FExpDivision > 1 then + begin + N := Exponent mod FExpDivision; + Dec(Exponent, N); + Inc(IntDigits, N); + end; + X := X / Power(Base, Exponent); + + if X < 1.0 then + begin + Dec(Exponent, FExpDivision); + X := X * PowerInt(Base, FExpDivision); + Inc(IntDigits, FExpDivision - 1); + end; + +{ TODO : Here's a problem if X > High(Int64). +It *seems* to surface only if ExponentDivision > 12, but it +has not been investigated if ExponentDivision <= 12 is safe. } + K := Trunc(X); + if Value < 0 then + K := -K; + + {$IFDEF CLR} + sb := StringBuilder.Create(IntToStr(K, FirstDigitPos));; + {$ELSE} + Mantissa := IntToStr(K, FirstDigitPos); + {$ENDIF CLR} + + FracDigits := Prec - IntDigits; + if FracDigits > NumberOfFractionalDigits then + FracDigits := NumberOfFractionalDigits; + + if FracDigits > 0 then + begin + {$IFDEF CLR} + J := sb.Length + 1; + // allocate sufficient space for point + digits + digit block separators + sb.Length := FracDigits * 2 + J; + sb[J - 1] := FractionalPartSeparator; + {$ELSE} + J := Length(Mantissa) + 1; + // allocate sufficient space for point + digits + digit block separators + SetLength(Mantissa, FracDigits * 2 + J); + Mantissa[J] := FractionalPartSeparator; + {$ENDIF CLR} + I := J + 1; + BlockDigits := 0; + while FracDigits > 0 do + begin + if (BlockDigits > 0) and (BlockDigits = DigitBlockSize) then + begin + {$IFDEF CLR} + sb[I - 1] := DigitBlockSeparator; + {$ELSE} + Mantissa[I] := DigitBlockSeparator; + {$ENDIF CLR} + Inc(I); + BlockDigits := 0; + end; + X := Frac(X) * Base; + {$IFDEF CLR} + sb[I - 1] := GetDigit(X); + {$ELSE} + Mantissa[I] := GetDigit(X); + {$ENDIF CLR} + Inc(I); + Inc(BlockDigits); + Dec(FracDigits); + end; + {$IFDEF CLR} + sb[I - 1] := #0; + StrResetLength(sb); + {$ELSE} + Mantissa[I] := #0; + StrResetLength(Mantissa); + {$ENDIF CLR} + end; + + if Frac(X) >= 0.5 then + // round up + begin + HighDigit := Digit(Base - 1); + {$IFDEF CLR} + for I := sb.Length downto 1 do + begin + if sb[I - 1] = HighDigit then + if (I = FirstDigitPos) then + begin + sb[I - 1] := '1'; + Inc(Exponent); + Break; + end + else + sb[I - 1] := '0' + else + if AnsiChar(sb[I - 1]) in [AnsiChar(DigitBlockSeparator), AnsiChar(FractionalPartSeparator)] then + Continue + else + begin + if sb[I - 1] = '9' then + sb[I - 1] := 'A' + else + sb[I - 1] := Succ(sb[I - 1]); + Break; + end; + end; + {$ELSE} + for I := Length(Mantissa) downto 1 do + begin + if Mantissa[I] = HighDigit then + if (I = FirstDigitPos) then + begin + Mantissa[I] := '1'; + Inc(Exponent); + Break; + end + else + Mantissa[I] := '0' + else + if Mantissa[I] in [AnsiChar(DigitBlockSeparator), AnsiChar(FractionalPartSeparator)] then + Continue + else + begin + if Mantissa[I] = '9' then + Mantissa[I] := 'A' + else + Mantissa[I] := Succ(Mantissa[I]); + Break; + end; + end; + {$ENDIF CLR} + end; + {$IFDEF CLR} + Mantissa := sb.ToString(); + {$ENDIF CLR} +end; + +function TJclNumericFormat.FloatToStr(const Value: Float): string; +var + Mantissa: string; + Exponent: Integer; +begin + GetMantissaExp(Value, Mantissa, Exponent); + Result := Format('%s %s %d^%d', [Mantissa, Multiplier, Base, Exponent]); +end; + +function TJclNumericFormat.IntToStr(const Value: Int64): string; +var + FirstDigitPos: Integer; +begin + Result := IntToStr(Value, FirstDigitPos); +end; + +function TJclNumericFormat.IntToStr(const Value: Int64; out FirstDigitPos: Integer): string; +const + MaxResultLen = 64 + 63 + 1; // max. digits + max. group separators + sign +var + Remainder: Int64; + I, N: Integer; + Chars, Digits: Cardinal; + LoopFinished, HasSign, SpacePadding: Boolean; +begin + SpacePadding := PaddingChar = ' '; + HasSign := ShowSign(Value); + Chars := MaxResultLen; + if Width > Chars then + Chars := Width; + {$IFDEF CLR} + Result := StrFillChar(' ', Chars); + {$ELSE} + SetLength(Result, Chars); + FillChar(Result[1], Chars, ' '); + {$ENDIF CLR} + + Remainder := Abs(Value); + Digits := 0; + + Chars := 0; + if HasSign then + Chars := 1; + + I := MaxResultLen; + + while True do + begin + N := Remainder mod Base; + Remainder := Remainder div Base; + if N > 9 then + Result[I] := Chr(Ord('A') + N - 10) + else + Result[I] := Chr(Ord('0') + N); + Dec(I); + Inc(Digits); + Inc(Chars); + if (Remainder = 0) and (SpacePadding or (Chars >= Width)) then Break; + if (Digits = DigitBlockSize) then + begin + Inc(Chars); + LoopFinished := (Remainder = 0) and (Chars = Width); + if LoopFinished then + Result[I] := ' ' + else + Result[I] := DigitBlockSeparator; + Dec(I); + if LoopFinished then + Break; + Digits := 0; + end; + end; + + FirstDigitPos := I + 1; + + if HasSign then + Result[I] := SignChar(Value) + else + Inc(I); + N := MaxResultLen - Width + 1; + if N < I then + I := N; + Result := Copy(Result, I, MaxResultLen); + Dec(FirstDigitPos, I - 1); +end; + +procedure TJclNumericFormat.SetBase(const Value: TNumericSystemBase); +begin + FBase := Value; + SetPrecision(FWantedPrecision); +end; + +procedure TJclNumericFormat.SetExpDivision(const Value: Integer); +begin + if Value <= 1 then + FExpDivision := 1 + else + // see TODO in GetMantissaExp + if Value > 12 then + FExpDivision := 12 + else + FExpDivision := Value; +end; + +procedure TJclNumericFormat.SetPrecision(const Value: TDigitCount); +begin + FWantedPrecision := Value; + // Do not display more digits than Float precision justifies + if Base = 2 then + FPrecision := BinaryPrecision + else + FPrecision := Trunc(BinaryPrecision / LogBase2(Base)); + if Value < FPrecision then + FPrecision := Value; +end; + +function TJclNumericFormat.Sign(Value: Char): Integer; +begin + Result := 0; + if Value = FSignChars[False] then + Result := -1; + if Value = FSignChars[True] then + Result := +1; +end; + +function TJclNumericFormat.StrToInt(const Value: string): Int64; +var + I, N: Integer; + C: Char; +begin + Result := 0; + N := 0; + I := 1; + if Value[I] in AnsiSigns then + Inc(I); + for I := I to Length(Value) do + begin + C := Value[I]; + if C in AnsiDecDigits then + N := Ord(C) - Ord('0') + else + begin + C := UpCase(C); + if C in AnsiUppercaseLetters then + begin + N := Ord(C) - Ord('A') + 10; + if N >= Base then + InvalidDigit(C); + end + else + if C = DigitBlockSeparator then + Continue + else + InvalidDigit(C); + end; + Result := Result * Base + N; + end; + if Value[1] = '-' then + Result := -Result; +end; + +function TJclNumericFormat.ShowSign(const Value: Float): Boolean; +begin + Result := FShowPositiveSign or (Value < 0); +end; + +function TJclNumericFormat.ShowSign(const Value: Int64): Boolean; +begin + Result := FShowPositiveSign or (Value < 0); +end; + +function TJclNumericFormat.SignChar(const Value: Float): Char; +begin + Result := FSignChars[Value >= 0]; +end; + +function TJclNumericFormat.SignChar(const Value: Int64): Char; +begin + Result := FSignChars[Value >= 0]; +end; + +function TJclNumericFormat.GetNegativeSign: Char; +begin + Result := FSignChars[False]; +end; + +function TJclNumericFormat.GetPositiveSign: Char; +begin + Result := FSignChars[True]; +end; + +procedure TJclNumericFormat.SetNegativeSign(const Value: Char); +begin + FSignChars[False] := Value; +end; + +procedure TJclNumericFormat.SetPositiveSign(const Value: Char); +begin + FSignChars[True] := Value; +end; + +{$IFNDEF CLR} +//=== Child processes ======================================================== + +// MuteCRTerminatedLines was "outsourced" from Win32ExecAndRedirectOutput + +function MuteCRTerminatedLines(const RawOutput: string): string; +const + Delta = 1024; +var + BufPos, OutPos, LfPos, EndPos: Integer; + C: Char; +begin + SetLength(Result, Length(RawOutput)); + OutPos := 1; + LfPos := OutPos; + EndPos := OutPos; + for BufPos := 1 to Length(RawOutput) do + begin + if OutPos >= Length(Result)-2 then + SetLength(Result, Length(Result) + Delta); + C := RawOutput[BufPos]; + case C of + AnsiCarriageReturn: + OutPos := LfPos; + AnsiLineFeed: + begin + OutPos := EndPos; + Result[OutPos] := AnsiCarriageReturn; + Inc(OutPos); + Result[OutPos] := C; + Inc(OutPos); + EndPos := OutPos; + LfPos := OutPos; + end; + else + Result[OutPos] := C; + Inc(OutPos); + EndPos := OutPos; + end; + end; + SetLength(Result, OutPos - 1); +end; + +function InternalExecute(const CommandLine: string; var Output: string; OutputLineCallback: TTextHandler; + RawOutput: Boolean; AbortPtr: PBoolean): Cardinal; +const + BufferSize = 255; +var + Buffer: array [0..BufferSize] of Char; + TempOutput: string; + PipeBytesRead: Cardinal; + + procedure ProcessLine(LineEnd: Integer); + begin + if RawOutput or (TempOutput[LineEnd] <> AnsiCarriageReturn) then + begin + while (LineEnd > 0) and (TempOutput[LineEnd] in [AnsiLineFeed, AnsiCarriageReturn]) do + Dec(LineEnd); + OutputLineCallback(Copy(TempOutput, 1, LineEnd)); + end; + end; + + procedure ProcessBuffer; + var + CR, LF: Integer; + begin + Buffer[PipeBytesRead] := #0; + TempOutput := TempOutput + Buffer; + if Assigned(OutputLineCallback) then + repeat + CR := Pos(AnsiCarriageReturn, TempOutput); + if CR = Length(TempOutput) then + CR := 0; // line feed at CR + 1 might be missing + LF := Pos(AnsiLineFeed, TempOutput); + if (CR > 0) and ((LF > CR + 1) or (LF = 0)) then + LF := CR; // accept CR as line end + if LF > 0 then + begin + ProcessLine(LF); + Delete(TempOutput, 1, LF); + end; + until LF = 0; + end; + +{$IFDEF MSWINDOWS} +// "outsourced" from Win32ExecAndRedirectOutput +var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; + SecurityAttr: TSecurityAttributes; + PipeRead, PipeWrite: THandle; +begin + Result := $FFFFFFFF; + SecurityAttr.nLength := SizeOf(SecurityAttr); + SecurityAttr.lpSecurityDescriptor := nil; + SecurityAttr.bInheritHandle := True; + if not CreatePipe(PipeRead, PipeWrite, @SecurityAttr, 0) then + begin + Result := GetLastError; + Exit; + end; + FillChar(StartupInfo, SizeOf(TStartupInfo), #0); + StartupInfo.cb := SizeOf(TStartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; + StartupInfo.wShowWindow := SW_HIDE; + StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE); + StartupInfo.hStdOutput := PipeWrite; + StartupInfo.hStdError := PipeWrite; + if CreateProcess(nil, PChar(CommandLine), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, + ProcessInfo) then + begin + CloseHandle(PipeWrite); + if AbortPtr <> nil then + AbortPtr^ := False; + while ((AbortPtr = nil) or not AbortPtr^) and ReadFile(PipeRead, Buffer, BufferSize, PipeBytesRead, nil) and (PipeBytesRead > 0) do + ProcessBuffer; + if (AbortPtr <> nil) and AbortPtr^ then + TerminateProcess(ProcessInfo.hProcess, Cardinal(ABORT_EXIT_CODE)); + if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0) and + not GetExitCodeProcess(ProcessInfo.hProcess, Result) then + Result := $FFFFFFFF; + CloseHandle(ProcessInfo.hThread); + CloseHandle(ProcessInfo.hProcess); + end + else + CloseHandle(PipeWrite); + CloseHandle(PipeRead); +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +var + Pipe: PIOFile; + Cmd: string; +begin + Cmd := Format('%s 2>&1', [CommandLine]); + Pipe := Libc.popen(PChar(Cmd), 'r'); + { TODO : handle Abort } + repeat + PipeBytesRead := fread_unlocked(@Buffer, 1, BufferSize, Pipe); + if PipeBytesRead > 0 then + ProcessBuffer; + until PipeBytesRead = 0; + Result := pclose(Pipe); + wait(nil); +{$ENDIF UNIX} + if TempOutput <> '' then + if Assigned(OutputLineCallback) then + // output wasn't terminated by a line feed... + // (shouldn't happen, but you never know) + ProcessLine(Length(TempOutput)) + else + if RawOutput then + Output := Output + TempOutput + else + Output := Output + MuteCRTerminatedLines(TempOutput); +end; + +{ TODO -cHelp : +RawOutput: Do not process isolated carriage returns (#13). +That is, for RawOutput = False, lines not terminated by a line feed (#10) are deleted from Output. } + +function Execute(const CommandLine: string; var Output: string; RawOutput: Boolean = False; + AbortPtr: PBoolean = nil): Cardinal; +begin + Result := InternalExecute(CommandLine, Output, nil, RawOutput, AbortPtr); +end; + +{ TODO -cHelp : +Author: Robert Rossmair +OutputLineCallback called once per line of output. } + +function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; RawOutput: Boolean = False; + AbortPtr: PBoolean = nil): Cardinal; overload; +var + Dummy: string; +begin + Result := InternalExecute(CommandLine, Dummy, OutputLineCallback, RawOutput, AbortPtr); +end; + +//=== Console Utilities ====================================================== + +function ReadKey: Char; +{$IFDEF MSWINDOWS} +{ TODO -cHelp : Contributor: Robert Rossmair } +var + Console: TJclConsole; + InputMode: TJclConsoleInputModes; +begin + Console := TJclConsole.Default; + InputMode := Console.Input.Mode; + Console.Input.Mode := [imProcessed]; + Console.Input.Clear; + Result := Console.Input.GetEvent.Event.KeyEvent.AsciiChar; + Console.Input.Mode := InputMode; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +{ TODO -cHelp : Donator: Wayne Sherman } +var + ReadFileDescriptor: TFDSet; + TimeVal: TTimeVal; + SaveTerminalSettings: TTermIos; + RawTerminalSettings: TTermIos; +begin + Result := #0; + + //Save Original Terminal Settings + tcgetattr(stdin, SaveTerminalSettings); + tcgetattr(stdin, RawTerminalSettings); + + //Put Terminal in RAW mode + cfmakeraw(RawTerminalSettings); + tcsetattr(stdin, TCSANOW, RawTerminalSettings); + try + //Setup file I/O descriptor for STDIN + FD_ZERO(ReadFileDescriptor); + FD_SET(stdin, ReadFileDescriptor); + TimeVal.tv_sec := High(LongInt); //wait forever + TimeVal.tv_usec := 0; + + //clear keyboard buffer first + TCFlush(stdin, TCIFLUSH); + + //wait for a key to be pressed + if select(1, @ReadFileDescriptor, nil, nil, @TimeVal) > 0 then + begin + //Now read the character + Result := Char(getchar); + end + else + raise EJclError.CreateRes(@RsReadKeyError); + finally + //Restore Original Terminal Settings + tcsetattr(stdin, TCSANOW, SaveTerminalSettings); + end; +end; +{$ENDIF UNIX} +{$ENDIF ~CLR} + +{$IFNDEF CLR} +//=== Loading of modules (DLLs) ============================================== + +function LoadModule(var Module: TModuleHandle; FileName: string): Boolean; +{$IFDEF MSWINDOWS} +begin + if Module = INVALID_MODULEHANDLE_VALUE then + Module := LoadLibrary(PChar(FileName)); + Result := Module <> INVALID_MODULEHANDLE_VALUE; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +begin + if Module = INVALID_MODULEHANDLE_VALUE then + Module := dlopen(PChar(FileName), RTLD_NOW); Result := Module <> INVALID_MODULEHANDLE_VALUE; +end; +{$ENDIF UNIX} + +function LoadModuleEx(var Module: TModuleHandle; FileName: string; Flags: Cardinal): Boolean; +{$IFDEF MSWINDOWS} +begin + if Module = INVALID_MODULEHANDLE_VALUE then + Module := LoadLibraryEx(PChar(FileName), 0, Flags); + Result := Module <> INVALID_MODULEHANDLE_VALUE; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +begin + if Module = INVALID_MODULEHANDLE_VALUE then + Module := dlopen(PChar(FileName), Flags); Result := Module <> INVALID_MODULEHANDLE_VALUE; +end; +{$ENDIF UNIX} + +procedure UnloadModule(var Module: TModuleHandle); +{$IFDEF MSWINDOWS} +begin + if Module <> INVALID_MODULEHANDLE_VALUE then + FreeLibrary(Module); + Module := INVALID_MODULEHANDLE_VALUE; +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +begin + if Module <> INVALID_MODULEHANDLE_VALUE then + dlclose(Pointer(Module)); Module := INVALID_MODULEHANDLE_VALUE; +end; +{$ENDIF UNIX} + +function GetModuleSymbol(Module: TModuleHandle; SymbolName: string): Pointer; +{$IFDEF MSWINDOWS} +begin + Result := nil; + if Module <> INVALID_MODULEHANDLE_VALUE then + Result := GetProcAddress(Module, PChar(SymbolName)); +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +begin + Result := nil; + if Module <> INVALID_MODULEHANDLE_VALUE then + Result := dlsym(Module, PChar(SymbolName)); +end; +{$ENDIF UNIX} + +function GetModuleSymbolEx(Module: TModuleHandle; SymbolName: string; var Accu: Boolean): Pointer; +{$IFDEF MSWINDOWS} +begin + Result := nil; + if Module <> INVALID_MODULEHANDLE_VALUE then + Result := GetProcAddress(Module, PChar(SymbolName)); + Accu := Accu and (Result <> nil); +end; +{$ENDIF MSWINDOWS} +{$IFDEF UNIX} +begin + Result := nil; + if Module <> INVALID_MODULEHANDLE_VALUE then + Result := dlsym(Module, PChar(SymbolName)); Accu := Accu and (Result <> nil); +end; +{$ENDIF UNIX} + +function ReadModuleData(Module: TModuleHandle; SymbolName: string; var Buffer; Size: Cardinal): Boolean; +var + Sym: Pointer; +begin + Result := True; + Sym := GetModuleSymbolEx(Module, SymbolName, Result); + if Result then + Move(Sym^, Buffer, Size); +end; + +function WriteModuleData(Module: TModuleHandle; SymbolName: string; var Buffer; Size: Cardinal): Boolean; +var + Sym: Pointer; +begin + Result := True; + Sym := GetModuleSymbolEx(Module, SymbolName, Result); + if Result then + Move(Buffer, Sym^, Size); +end; +{$ENDIF ~CLR} + +//=== Conversion Utilities =================================================== + +{ TODO -cHelp : StrToBoolean, IntToBool, BoolToInt } +{ Author: Jeff + + StrToBoolean: converts a string S to a boolean. S may be 'Yes/No', 'True/False' or '0/1' or 'T/F' or 'Y/N'. + raises an EJclConversionError exception on failure. + IntToBool: converts an integer to a boolean where 0 means false and anything else is tue. + BoolToInt: converts a boolean to an integer: True=>1 and False=>0 +} + +const + DefaultTrueBoolStr = 'True'; // DO NOT LOCALIZE + DefaultFalseBoolStr = 'False'; // DO NOT LOCALIZE + + DefaultYesBoolStr = 'Yes'; // DO NOT LOCALIZE + DefaultNoBoolStr = 'No'; // DO NOT LOCALIZE + +function StrToBoolean(const S: string): Boolean; +var + LowerCasedText: string; +begin + { TODO : Possibility to add localized strings, like in Delphi 7 } + { TODO : Lower case constants } + LowerCasedText := LowerCase(S); + Result := ((S = '1') or + (LowerCasedText = LowerCase(DefaultTrueBoolStr)) or (LowerCasedText = LowerCase(DefaultYesBoolStr))) or + (LowerCasedText = LowerCase(DefaultTrueBoolStr[1])) or (LowerCasedText = LowerCase(DefaultYesBoolStr[1])); + if not Result then + begin + Result := not ((S = '0') or + (LowerCasedText = LowerCase(DefaultFalseBoolStr)) or (LowerCasedText = LowerCase(DefaultNoBoolStr)) or + (LowerCasedText = LowerCase(DefaultFalseBoolStr[1])) or (LowerCasedText = LowerCase(DefaultNoBoolStr[1]))); + if Result then + {$IFDEF CLR} + raise EJclConversionError.CreateFmt(RsStringToBoolean, [S]); + {$ELSE} + raise EJclConversionError.CreateResFmt(@RsStringToBoolean, [S]); + {$ENDIF CLR} + end; +end; + +function IntToBool(I: Integer): Boolean; +begin + Result := I <> 0; +end; + +function BoolToInt(B: Boolean): Integer; +begin + Result := Ord(B); +end; + +//=== RTL package information ================================================ + +{$IFNDEF CLR} +{$IFNDEF FPC} + +function SystemTObjectInstance: LongWord; +begin + Result := FindClassHInstance(System.TObject); +end; + +function IsCompiledWithPackages: Boolean; +begin + Result := SystemTObjectInstance <> HInstance; +end; + +{$ENDIF ~FPC} +{$ENDIF ~CLR} + +//=== GUID =================================================================== + +function JclGUIDToString(const GUID: TGUID): string; +begin + {$IFDEf CLR} + Result := GUID.ToString(); + {$ELSE} + Result := Format('{%.8x-%.4x-%.4x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x}', + [GUID.D1, GUID.D2, GUID.D3, GUID.D4[0], GUID.D4[1], GUID.D4[2], + GUID.D4[3], GUID.D4[4], GUID.D4[5], GUID.D4[6], GUID.D4[7]]); + {$ENDIF CLR} +end; + +function JclStringToGUID(const S: string): TGUID; +begin + if (Length(S) <> 38) or (S[1] <> '{') or (S[10] <> '-') or (S[15] <> '-') or + (S[20] <> '-') or (S[25] <> '-') or (S[38] <> '}') then + {$IFDEF CLR} + raise EJclConversionError.CreateFmt(RsInvalidGUIDString, [S]); + {$ELSE} + raise EJclConversionError.CreateResFmt(@RsInvalidGUIDString, [S]); + {$ENDIF CLR} + + {$IFDEF CLR} + Result := System.GUID.Create( + Integer(StrToInt('$' + Copy(S, 2, 8))), + Smallint(StrToInt('$' + Copy(S, 11, 4))), + Smallint(StrToInt('$' + Copy(S, 16, 4))), + Byte(StrToInt('$' + Copy(S, 21, 2))), + Byte(StrToInt('$' + Copy(S, 23, 2))), + Byte(StrToInt('$' + Copy(S, 26, 2))), + Byte(StrToInt('$' + Copy(S, 28, 2))), + Byte(StrToInt('$' + Copy(S, 30, 2))), + Byte(StrToInt('$' + Copy(S, 32, 2))), + Byte(StrToInt('$' + Copy(S, 34, 2))), + Byte(StrToInt('$' + Copy(S, 36, 2)))); + {$ELSE} + Result.D1 := StrToInt('$' + Copy(S, 2, 8)); + Result.D2 := StrToInt('$' + Copy(S, 11, 4)); + Result.D3 := StrToInt('$' + Copy(S, 16, 4)); + Result.D4[0] := StrToInt('$' + Copy(S, 21, 2)); + Result.D4[1] := StrToInt('$' + Copy(S, 23, 2)); + Result.D4[2] := StrToInt('$' + Copy(S, 26, 2)); + Result.D4[3] := StrToInt('$' + Copy(S, 28, 2)); + Result.D4[4] := StrToInt('$' + Copy(S, 30, 2)); + Result.D4[5] := StrToInt('$' + Copy(S, 32, 2)); + Result.D4[6] := StrToInt('$' + Copy(S, 34, 2)); + Result.D4[7] := StrToInt('$' + Copy(S, 36, 2)); + {$ENDIF CLR} +end; + +// History: + +// $Log: JclSysUtils.pas,v $ +// Revision 1.38 2005/12/26 20:30:07 outchy +// IT2772: ClearObjectList behaviour with TComponentList and TObjectList +// +// Revision 1.37 2005/05/05 20:08:45 ahuser +// JCL.NET support +// +// Revision 1.36 2005/04/07 00:41:35 rrossmair +// - changed for FPC 1.9.8 +// +// Revision 1.35 2005/03/08 16:10:08 marquardt +// standard char sets extended and used, some optimizations for string literals +// +// Revision 1.34 2005/03/08 08:33:18 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.33 2005/03/06 18:15:03 marquardt +// JclGUIDToString and JclStringToGUID moved to JclSysUtils.pas, CrLf replaced by AnsiLineBreak +// +// Revision 1.32 2005/03/02 17:51:24 rrossmair +// - removed DCLAppendDelimited from JclAlgorithms, changed uses clauses accordingly +// +// Revision 1.31 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.30 2004/12/27 17:11:57 rrossmair +// - fixed Mantis #2433 +// +// Revision 1.29 2004/12/05 17:08:59 rrossmair +// - fixed call to EJclError.CreateResRec in ReadKey function +// +// Revision 1.28 2004/12/05 04:58:47 rrossmair +// added ReadKey donation by Wayne Sherman +// +// Revision 1.27 2004/11/28 16:37:26 uschuster +// added possibility to abort Execute +// +// Revision 1.26 2004/11/18 00:46:49 rrossmair +// - Execute() fixed +// +// Revision 1.25 2004/10/25 06:58:44 rrossmair +// - fixed bug #0002065 +// - outsourced JclMiscel.Win32ExecAndRedirectOutput() + JclBorlandTools.ExecAndRedirectOutput() code into JclSysUtils.Execute() +// - refactored this code +// - added overload to supply callback capability per line of output +// +// Revision 1.24 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.23 2004/09/30 07:50:29 marquardt +// remove FillRemainBytes, CopyMemE contributions +// +// Revision 1.22 2004/08/01 05:52:12 marquardt +// move constructors/destructors +// +// Revision 1.21 2004/07/28 18:00:52 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.20 2004/06/14 11:05:51 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.19 2004/05/27 20:27:26 ahuser +// Updated Linux code +// +// Revision 1.18 2004/05/14 15:28:06 rrossmair +// removed duplicate entry in Contributors list +// +// Revision 1.17 2004/05/09 11:17:49 rrossmair +// Contributor list update +// +// Revision 1.16 2004/05/09 03:22:15 rrossmair +// fix: missing {$IFDEF Unix} around "uses dl" added +// +// Revision 1.15 2004/05/09 03:01:57 rrossmair +// module loader code made FPC compatible +// +// Revision 1.14 2004/05/08 22:06:30 rrossmair +// revert mistaken removal of COMPILER6_UP condition (v. 1.12) +// +// Revision 1.13 2004/05/08 08:44:17 rrossmair +// introduced & applied symbol HAS_UNIT_LIBC +// +// Revision 1.12 2004/05/05 07:06:48 rrossmair +// corrected typo ('\\' instead of '}'); removed COMPILER6_UP symbol. +// +// Revision 1.11 2004/05/05 00:15:47 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.10 2004/04/19 06:16:38 rrossmair +// fixed for FPC, which doesn't like the assembler key word showing up in the interface section +// +// Revision 1.9 2004/04/06 04:30:21 +// Add FillRemainBytes, CopyMemE +// + +end. diff --git a/official/1.96/source/common/JclUnitConv.pas b/official/1.96/source/common/JclUnitConv.pas new file mode 100644 index 0000000..df88156 --- /dev/null +++ b/official/1.96/source/common/JclUnitConv.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 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: $Data$ +// For history see end of file + +unit JclUnitConv; + +{$I jcl.inc} + +interface + +uses + SysUtils, + 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(Exception); + + 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; + +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 + {$IFDEF CLR} + raise ETemperatureConversionError.Create(RsConvTempBelowAbsoluteZero); + {$ELSE} + raise ETemperatureConversionError.CreateRes(@RsConvTempBelowAbsoluteZero); + {$ENDIF CLR} +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; +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 + {$IFDEF CLR} + raise EInvalidOp.CreateFmt(RsTempConvTypeError, ['ToType']); + {$ELSE} + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, ['ToType']); + {$ENDIF CLR} + 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 + {$IFDEF CLR} + raise EInvalidOp.CreateFmt(RsTempConvTypeError, ['ToType']); + {$ELSE} + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, ['ToType']); + {$ENDIF CLR} + 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 + {$IFDEF CLR} + raise EInvalidOp.CreateFmt(RsTempConvTypeError, ['ToType']); + {$ELSE} + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, ['ToType']); + {$ENDIF CLR} + 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 + {$IFDEF CLR} + raise EInvalidOp.CreateFmt(RsTempConvTypeError, ['ToType']); + {$ELSE} + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, ['ToType']); + {$ENDIF CLR} + 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 + {$IFDEF CLR} + raise EInvalidOp.CreateFmt(RsTempConvTypeError, ['ToType']); + {$ELSE} + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, ['ToType']); + {$ENDIF CLR} + end; + end; + else + {$IFDEF CLR} + raise EInvalidOp.CreateFmt(RsTempConvTypeError, ['FromType']); + {$ELSE} + raise EInvalidOp.CreateResFmt(@RsTempConvTypeError, ['FromType']); + {$ENDIF CLR} + 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; + +// History: + +// $Log: JclUnitConv.pas,v $ +// Revision 1.11 2005/05/05 20:08:46 ahuser +// JCL.NET support +// +// Revision 1.10 2005/03/08 08:33:18 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.9 2005/03/07 17:28:59 marquardt +// raise was missing from several exceptions +// +// Revision 1.8 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.7 2004/10/17 20:25:21 mthoma +// style cleaning, adjusting contributors +// +// Revision 1.6 2004/08/23 10:14:50 scottprice +// Modified temperature routines, and added support for Rankine and Reaumur. +// Added some string constants to this unit related to that change. +// +// Revision 1.5 2004/05/05 00:11:24 mthoma +// Updated headers: Added donors as contributors, adjusted the initial authors, +// added cvs names when they were not obvious. Changed $data to $date where necessary, +// +// Revision 1.4 2004/04/06 04:53:19 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/common/JclUnitVersioning.pas b/official/1.96/source/common/JclUnitVersioning.pas new file mode 100644 index 0000000..e013edd --- /dev/null +++ b/official/1.96/source/common/JclUnitVersioning.pas @@ -0,0 +1,838 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/03/18 19:16:21 $ +// For history see end of file + +unit JclUnitVersioning; + +{$I jcl.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + {$IFDEF HAS_UNIT_LIBC} + Libc, + {$ENDIF HAS_UNIT_LIBC} + SysUtils, Contnrs; + +type + PUnitVersionInfo = ^TUnitVersionInfo; + TUnitVersionInfo = record + RCSfile: string; // $'RCSfile$ + Revision: string; // $'Revision$ + Date: string; // $'Date$ in UTC (GMT) + LogPath: string; // logical file path + Extra: string; // 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; + 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 GetItems(Index: Integer): TUnitVersion; + function GetCount: Integer; + function GetModuleCount: Integer; + function GetModules(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 GetModules; + + // all units + property Count: Integer read GetCount; + property Items[Index: Integer]: TUnitVersion read GetItems; default; + end; + +procedure RegisterUnitVersion(Instance: THandle; const Info: TUnitVersionInfo); +procedure UnregisterUnitVersion(Instance: THandle); + +function GetUnitVersioning: TUnitVersioning; + +implementation + +// 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: 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; +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; + +//=== { 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; +begin + for Result := 0 to FItems.Count - 1 do + if CompareFilenames(Items[Result].RCSfile, RCSfile) = 0 then + if LogPath = '*' then + Exit + else + if CompareFilenames(LogPath, Trim(Items[Result].LogPath)) = 0 then + Exit; + 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 + if Modules[I].Instance = Instance then + begin + if Modules[I].IndexOfInfo(Info) = -1 then + Modules[I].Add(Info); + Exit; + 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.GetItems(Index: Integer): TUnitVersion; +var + Cnt, I: Integer; +begin + Result := nil; + ValidateModules; + Cnt := 0; + for I := 0 to FModules.Count - 1 do + begin + if Index < Cnt + Modules[I].Count then + begin + Result := Modules[I].Items[Index - Cnt]; + Break; + end; + Inc(Cnt, Modules[I].Count); + end; +end; + +function TUnitVersioning.GetModuleCount: Integer; +begin + ValidateModules; + Result := FModules.Count; +end; + +function TUnitVersioning.GetModules(Index: Integer): TUnitVersioningModule; +begin + Result := TUnitVersioningModule(FModules[Index]); +end; + +procedure TUnitVersioning.ValidateModules; +var + I: Integer; + Buffer: string; +begin + for I := FModules.Count - 1 downto 0 do + begin + SetLength(Buffer, 1024); + if GetModuleFileName(Modules[I].Instance, PChar(Buffer), 1024) = 0 then + // This module is no more in memory but has not unregistered itself so + // unregister it here. + UnregisterModule(Modules[I]); + 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; +begin + Result := -1; + Cnt := 0; + for I := 0 to FModules.Count - 1 do + begin + Index := Modules[I].IndexOf(RCSfile, LogPath); + if Index <> -1 then + begin + Result := Cnt + Index; + Break; + end; + Inc(Cnt, Modules[I].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; + +function GetNamedProcessAddress(const Id: ShortString; out RefCount: Integer): Pointer; forward; + // Returns a 3820 Bytes large block [= 4096 - 276 = 4096 - (8+256+4+8)] + // max 20 blocks can be allocated +function ReleaseNamedProcessAddress(P: Pointer): Integer; forward; + +// (rom) PAGE_OFFSET is clearly Linux specific +{$IFDEF LINUX} +const + PAGE_OFFSET = $C0000000; // from linux/include/asm-i386/page.h +{$ENDIF LINUX} + +const + Signature1 = $ABCDEF0123456789; + Signature2 = $9876543210FEDCBA; + +type + PNPARecord = ^TNPARecord; + TNPARecord = record + Signature1: Int64; + Id: ShortString; + RefCount: Integer; + Signature2: Int64; + Data: record end; + end; + +function GetNamedProcessAddress(const Id: ShortString; out RefCount: Integer): Pointer; +const + MaxPages = 20; +var + {$IFDEF MSWINDOWS} + SysInfo: TSystemInfo; + MemInfo: TMemoryBasicInformation; + pid: THandle; + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + pid: __pid_t; + {$ENDIF LINUX} + Requested, Allocated: PNPARecord; + Pages: Integer; + PageSize: Cardinal; + MaximumApplicationAddress: Pointer; +begin + RefCount := 0; + {$IFDEF MSWINDOWS} + GetSystemInfo(SysInfo); + PageSize := SysInfo.dwPageSize; + pid := GetCurrentProcessId; + MaximumApplicationAddress := SysInfo.lpMaximumApplicationAddress; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + PageSize := getpagesize; + pid := getpid; + MaximumApplicationAddress := Pointer(PAGE_OFFSET - 1); + {$ENDIF UNIX} + Pages := 0; + repeat + Requested := MaximumApplicationAddress; + Requested := Pointer((Cardinal(Requested) div $10000) * $10000); + Dec(Cardinal(Requested), Pages * $10000); + Requested := Pointer((Cardinal(Requested) div PageSize) * PageSize); + {$IFDEF MSWINDOWS} + Allocated := VirtualAlloc(Requested, PageSize, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE); + if Assigned(Allocated) and (Requested <> Allocated) then + begin + // We got relocated (should not happen at all) + VirtualFree(Allocated, 0, MEM_RELEASE); + Inc(Pages); + Continue; + end; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + // Do not use MAP_FIXED because it replaces the already allocated map by a + // new map. + Allocated := mmap(Requested, PageSize, PROT_READ or PROT_WRITE, + MAP_PRIVATE or MAP_ANONYMOUS, 0, 0); + if Allocated = MAP_FAILED then + begin + // Prevent SEGV by signature-test code and try the next memory page. + Inc(Pages); + Continue; + end + else + if Allocated <> Requested then + begin + // It was relocated, means the requested address is already allocated + munmap(Allocated, PageSize); + Allocated := nil; + end; + {$ENDIF UNIX} + + if Assigned(Allocated) then + Break // new block allocated + else + begin + {$IFDEF MSWINDOWS} + VirtualQuery(Requested, MemInfo, SizeOf(MemInfo)); + if (MemInfo.RegionSize >= SizeOf(TNPARecord)) and + (MemInfo.Protect and PAGE_READWRITE = PAGE_READWRITE) then + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + try + {$ENDIF UNIX} + if (Requested.Signature1 = Signature1 xor pid) and + (Requested.Signature2 = Signature2 xor pid) and + (Requested.Id = Id) then + Break; // Found correct, already existing block. + {$IFDEF UNIX} + except + // ignore + end; + {$ENDIF UNIX} + end; + + Inc(Pages); + Requested := nil; + until Pages > MaxPages; + + Result := nil; + if Allocated <> nil then + begin + if Requested = Allocated then + begin + // initialize the block + Requested.Signature1 := Signature1 xor pid; + Requested.Id := Id; + Requested.Signature2 := Signature2 xor pid; + Requested.RefCount := 1; + Result := @Requested.Data; + RefCount := 1; + end; + end + else + if Requested <> nil then + begin + Inc(Requested.RefCount); + Result := @Requested.Data; + RefCount := Requested.RefCount; + end; +end; + +function ReleaseNamedProcessAddress(P: Pointer): Integer; +var + Requested: PNPARecord; +begin + Result := 0; + if P <> nil then + begin + Requested := PNPARecord(Cardinal(P) - SizeOf(TNPARecord)); + Dec(Requested.RefCount); + Result := Requested.RefCount; + if Requested.RefCount = 0 then + {$IFDEF MSWINDOWS} + VirtualFree(Requested, 0, MEM_RELEASE); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + munmap(Requested, getpagesize); + {$ENDIF UNIX} + end; +end; + +type + PUnitVersioning = ^TUnitVersioning; + +var + UnitVersioningOwner: Boolean = False; + GlobalUnitVersioning: TUnitVersioning = nil; + UnitVersioningNPA: PUnitVersioning = nil; + +function GetUnitVersioning: TUnitVersioning; +var + RefCount: Integer; +begin + if GlobalUnitVersioning = nil then + begin + UnitVersioningNPA := GetNamedProcessAddress('UnitVersioning', RefCount); + if UnitVersioningNPA <> nil then + begin + GlobalUnitVersioning := UnitVersioningNPA^; + if (GlobalUnitVersioning = nil) or (RefCount = 1) then + begin + GlobalUnitVersioning := TUnitVersioning.Create; + UnitVersioningNPA^ := GlobalUnitVersioning; + UnitVersioningOwner := True; + end; + end + else + begin + GlobalUnitVersioning := TUnitVersioning.Create; + UnitVersioningOwner := True; + end; + end + else + if UnitVersioningNPA <> nil then + GlobalUnitVersioning := UnitVersioningNPA^; // update (maybe the owner has destroyed the instance) + Result := GlobalUnitVersioning; +end; + +procedure FinalizeUnitVersioning; +var + RefCount: Integer; +begin + try + if GlobalUnitVersioning <> nil then + begin + RefCount := ReleaseNamedProcessAddress(UnitVersioningNPA); + if UnitVersioningOwner then + begin + if RefCount > 0 then + UnitVersioningNPA^ := nil; + GlobalUnitVersioning.Free; + end; + GlobalUnitVersioning := nil; + end; + except + // ignore - should never happen + end; +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; + +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$RCSfile: JclUnitVersioning.pas,v $'; + Revision: '$Revision: 1.11 $'; + Date: '$Date: 2005/03/18 19:16:21 $'; + LogPath: 'JCL\common'; + ); + +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + FinalizeUnitVersioning; + +// History: + +// $Log: JclUnitVersioning.pas,v $ +// Revision 1.11 2005/03/18 19:16:21 ahuser +// process ID type bug fix +// +// Revision 1.10 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.9 2005/02/22 07:28:08 uschuster +// added unit versioning provider solution from donations\source\common +// +// (donations) Revision 1.2 2005/01/31 06:47:33 marquardt +// cleanup and simplifications +// +// (donations) Revision 1.1 2005/01/30 13:51:02 uschuster +// initial checkin (modified JclUnitVersioning 1.8) +// +// Revision 1.8 2004/10/28 22:42:33 ahuser +// Fixed Mantis 2270 and 2260 (Access Violation with activated UnitVersioning) +// +// Revision 1.7 2004/10/27 15:54:47 ahuser +// Update +// +// Revision 1.6 2004/10/17 11:01:03 ahuser +// Fixed memory leak +// +// Revision 1.5 2004/09/05 12:46:02 uschuster +// fixed TUnitVersioning.IndexOf +// changed the module handle parameter name in (Un)registerUnitVersion to Instance to avoid scope confusion +// +// Revision 1.4 2004/09/02 16:16:13 marquardt +// fixed a bug from style cleaning +// +// Revision 1.3 2004/09/02 06:16:09 marquardt +// style cleaning +// +// Revision 1.2 2004/09/01 23:24:53 ahuser +// Replaced single linked list by TObjectList +// New methods FindUnit, IndexOf +// TUnitVersionInfo is now a record that is completly hidden by TUnitVersion class +// +// Revision 1.1 2004/09/01 14:56:16 ahuser +// Added common/JclUnitVersioning.pas +// + +end. + diff --git a/official/1.96/source/common/JclUnitVersioningProviders.pas b/official/1.96/source/common/JclUnitVersioningProviders.pas new file mode 100644 index 0000000..fd34326 --- /dev/null +++ b/official/1.96/source/common/JclUnitVersioningProviders.pas @@ -0,0 +1,413 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/02/24 16:34:40 $ +// For history see end of file + +unit JclUnitVersioningProviders; + +{$I jcl.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + JclPeImage, + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + Types, + {$ENDIF LINUX} + SysUtils, Classes, Contnrs, + 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} + +implementation + +const + JclUnitVersioningDataResName = 'JCLUV'; + +type + PJclUnitVersioningHeader = ^TJclUnitVersioningHeader; + 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); +var + UnitVersionInfoPtr: PUnitVersionInfo; +begin + New(UnitVersionInfoPtr); + UnitVersionInfoPtr^ := Info; + FItems.Add(UnitVersionInfoPtr); +end; + +procedure TJclUnitVersioningList.Clear; +var + I: Integer; +begin + for I := FItems.Count - 1 downto 0 do + Dispose(FItems[I]); + 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: string): Boolean; +var + StringLength: Integer; +begin + Result := False; + AString := ''; + if Assigned(AStream) then + begin + if AStream.Size - AStream.Position >= SizeOf(StringLength) then + begin + AStream.Read(StringLength, SizeOf(StringLength)); + if StringLength <= AStream.Size - AStream.Position then + begin + if StringLength > 0 then + begin + SetLength(AString, StringLength); + AStream.Read(PChar(AString)^, StringLength); + end; + Result := True; + end; + end; + end; +end; + +function ReadUnitVersionInfo(AStream: TStream; var AVersionInfo: TUnitVersionInfo): Boolean; +begin + Result := True; + with AVersionInfo do + begin + Result := Result and ReadStringFromStream(AStream, RCSfile); + Result := Result and ReadStringFromStream(AStream, Revision); + Result := Result and ReadStringFromStream(AStream, Date); + Result := Result and ReadStringFromStream(AStream, LogPath); + Result := Result and ReadStringFromStream(AStream, Extra); + Data := nil; + end; +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 PeMapImgFindSection(PeMapImgNtHeaders(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; + AStream.Read(Header, SizeOf(Header)); + UnitsToRead := Header.UnitCount; + LastReadOkay := True; + while (UnitsToRead > 0) and LastReadOkay do + begin + New(UnitVersionInfoPtr); + LastReadOkay := ReadUnitVersionInfo(AStream, UnitVersionInfoPtr^); + if not LastReadOkay then + Dispose(UnitVersionInfoPtr) + else + 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; + +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$RCSfile: JclUnitVersioningProviders.pas,v $'; + Revision: '$Revision: 1.2 $'; + Date: '$Date: 2005/02/24 16:34:40 $'; + LogPath: 'JCL\common'; + ); + +initialization + RegisterUnitVersion(HInstance, UnitVersioning); + +finalization + UnregisterUnitVersion(HInstance); + +// History: + +// $Log: JclUnitVersioningProviders.pas,v $ +// Revision 1.2 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.1 2005/02/22 07:31:38 uschuster +// new unit +// + +end. diff --git a/official/1.96/source/common/JclValidation.pas b/official/1.96/source/common/JclValidation.pas new file mode 100644 index 0000000..149dfc1 --- /dev/null +++ b/official/1.96/source/common/JclValidation.pas @@ -0,0 +1,140 @@ +{**************************************************************************************************} +{ } +{ 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): } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:46 $ +// For history see end of file + +unit JclValidation; + +{$I jcl.inc} + +interface + +// ISBN: International Standard Book Number +function IsValidISBN(const ISBN: string): Boolean; + +implementation + +{ 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; + ISBNDigits = ['0'..'9']; + ISBNSpecialDigits = ['x', 'X']; + ISBNSeparators = [#32, '-']; + ISBNCharacters = ISBNDigits + ISBNSpecialDigits + ISBNSeparators; +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; + {$IFNDEF CLR} + FillChar(PartSizes[Low(PartSizes)], SizeOf(PartSizes), 0); + {$ENDIF ~CLR} + + while CurPtr <= EndPtr do + begin + if ISBN[CurPtr] in ISBNCharacters then + begin + if ISBN[CurPtr] in ISBNSeparators 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 ISBN[CurPtr] in ISBNSpecialDigits 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 (ISBN[CurPtr] in ISBNSpecialDigits) 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; + +// History: + +// $Log: JclValidation.pas,v $ +// Revision 1.2 2005/05/05 20:08:46 ahuser +// JCL.NET support +// +// Revision 1.1 2004/08/19 00:42:02 rrossmair +// initial check-in +// + +end. diff --git a/official/1.96/source/common/JclVectors.pas b/official/1.96/source/common/JclVectors.pas new file mode 100644 index 0000000..ea2a8f6 --- /dev/null +++ b/official/1.96/source/common/JclVectors.pas @@ -0,0 +1,1533 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ The Delphi Container Library } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:46 $ +// For history see end of file + +unit JclVectors; + +{$I jcl.inc} + +interface + +uses + Classes, + JclBase, JclAbstractContainers, JclContainerIntf; + +type + TJclIntfVector = class(TJclAbstractContainer, IJclIntfCollection, IJclIntfList, + IJclIntfArray, IJclIntfCloneable) + private + FCount: Integer; + FCapacity: Integer; + FItems: TDynIInterfaceArray; + protected + procedure Grow; virtual; + { IJclCloneable } + function Clone: IInterface; + public + { IJclIntfCollection } + function Add(AInterface: IInterface): Boolean; overload; + function AddAll(ACollection: IJclIntfCollection): Boolean; overload; + procedure Clear; + function Contains(AInterface: IInterface): Boolean; + function ContainsAll(ACollection: IJclIntfCollection): Boolean; + function Equals(ACollection: IJclIntfCollection): Boolean; + function First: IJclIntfIterator; + function IsEmpty: Boolean; + function Last: IJclIntfIterator; + function Remove(AInterface: IInterface): Boolean; overload; + function RemoveAll(ACollection: IJclIntfCollection): Boolean; + function RetainAll(ACollection: IJclIntfCollection): Boolean; + function Size: Integer; + { IJclIntfList } + procedure Insert(Index: Integer; AInterface: IInterface); overload; + function InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; overload; + function GetObject(Index: Integer): IInterface; + function IndexOf(AInterface: IInterface): Integer; + function LastIndexOf(AInterface: IInterface): Integer; + function Remove(Index: Integer): IInterface; overload; + procedure SetObject(Index: Integer; AInterface: IInterface); + function SubList(First, Count: Integer): IJclIntfList; + + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + destructor Destroy; override; + {$IFNDEF CLR} + procedure AfterConstruction; override; + // Do not decrement RefCount because iterator inc/dec it. + procedure BeforeDestruction; override; + {$ENDIF ~CLR} + property Items: TDynIInterfaceArray read FItems; + end; + + //Daniele Teti 02/03/2005 + TJclStrVector = class(TJclStrCollection, IJclStrList, IJclStrArray, IJclCloneable) + private + FCount: Integer; + FCapacity: Integer; + FItems: TDynStringArray; + protected + procedure Grow; virtual; + { IJclCloneable } + function Clone: TObject; + public + { IJclStrCollection } + function Add(const AString: string): Boolean; overload; override; + function AddAll(ACollection: IJclStrCollection): Boolean; overload; override; + procedure Clear; override; + function Contains(const AString: string): Boolean; override; + function ContainsAll(ACollection: IJclStrCollection): Boolean; override; + function Equals(ACollection: IJclStrCollection): Boolean; override; + function First: IJclStrIterator; override; + function IsEmpty: Boolean; override; + function Last: IJclStrIterator; override; + function Remove(const AString: string): Boolean; overload; override; + function RemoveAll(ACollection: IJclStrCollection): Boolean; override; + function RetainAll(ACollection: IJclStrCollection): Boolean; override; + function Size: Integer; override; + { IJclStrList } + procedure Insert(Index: Integer; const AString: string); overload; + function InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; overload; + function GetString(Index: Integer): string; + function IndexOf(const AString: string): Integer; + function LastIndexOf(const AString: string): Integer; + function Remove(Index: Integer): string; overload; + procedure SetString(Index: Integer; const AString: string); + function SubList(First, Count: Integer): IJclStrList; + + constructor Create(ACapacity: Integer = DefaultContainerCapacity); + destructor Destroy; override; + {$IFNDEF CLR} + procedure AfterConstruction; override; + // Do not decrement RefCount because iterator inc/dec it. + procedure BeforeDestruction; override; + {$ENDIF ~CLR} + property Items: TDynStringArray read FItems; + end; + + TJclVector = class(TJclAbstractContainer, IJclCollection, IJclList, IJclArray, + IJclCloneable) + private + FCount: Integer; + FCapacity: Integer; + FOwnsObjects: Boolean; + FItems: TDynObjectArray; + protected + procedure Grow; virtual; + procedure FreeObject(var AObject: TObject); + public + { IJclCollection } + function Add(AObject: TObject): Boolean; overload; + function AddAll(ACollection: IJclCollection): Boolean; overload; + procedure Clear; + function Contains(AObject: TObject): Boolean; + function ContainsAll(ACollection: IJclCollection): Boolean; + function Equals(ACollection: IJclCollection): Boolean; + function First: IJclIterator; + function IsEmpty: Boolean; + function Last: IJclIterator; + function Remove(AObject: TObject): Boolean; overload; + function RemoveAll(ACollection: IJclCollection): Boolean; + function RetainAll(ACollection: IJclCollection): Boolean; + function Size: Integer; + { IJclList } + procedure Insert(Index: Integer; AObject: TObject); overload; + function InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; overload; + function GetObject(Index: Integer): TObject; + function IndexOf(AObject: TObject): Integer; + function LastIndexOf(AObject: TObject): Integer; + function Remove(Index: Integer): TObject; overload; + procedure SetObject(Index: Integer; AObject: TObject); + function SubList(First, Count: Integer): IJclList; + { IJclCloneable } + function Clone: TObject; + + constructor Create(ACapacity: Integer = DefaultContainerCapacity; AOwnsObjects: Boolean = True); + destructor Destroy; override; + {$IFNDEF CLR} + procedure AfterConstruction; override; + // Do not decrement RefCount because iterator inc/dec it. + procedure BeforeDestruction; override; + {$ENDIF ~CLR} + property Items: TDynObjectArray read FItems; + property OwnsObjects: Boolean read FOwnsObjects; + end; + +implementation + +uses + JclResources; + +//=== { TIntfItr } =========================================================== + +type + TIntfItr = class(TJclAbstractContainer, IJclIntfIterator) + private + FCursor: Integer; + FOwnList: TJclIntfVector; + FLastRet: Integer; + FSize: Integer; + protected + { IJclIntfIterator} + procedure Add(AInterface: IInterface); + function GetObject: IInterface; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: IInterface; + function NextIndex: Integer; + function Previous: IInterface; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AInterface: IInterface); + public + constructor Create(OwnList: TJclIntfVector); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TIntfItr.Create(OwnList: TJclIntfVector); +begin + inherited Create; + FCursor := 0; + FOwnList := OwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} + FLastRet := -1; + FSize := FOwnList.Size; +end; + +{$IFNDEF CLR} +destructor TIntfItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TIntfItr.Add(AInterface: IInterface); +begin + FOwnList.Insert(FCursor, AInterface); + Inc(FSize); + Inc(FCursor); + FLastRet := -1; +end; + +function TIntfItr.GetObject: IInterface; +begin + Result := FOwnList.Items[FCursor]; +end; + +function TIntfItr.HasNext: Boolean; +begin + Result := FCursor <> FSize; +end; + +function TIntfItr.HasPrevious: Boolean; +begin + Result := FCursor > 0; +end; + +function TIntfItr.Next: IInterface; +begin + Result := FOwnList.Items[FCursor]; + FLastRet := FCursor; + Inc(FCursor); +end; + +function TIntfItr.NextIndex: Integer; +begin + Result := FCursor; +end; + +function TIntfItr.Previous: IInterface; +begin + Dec(FCursor); + FLastRet := FCursor; + Result := FOwnList.Items[FCursor]; +end; + +function TIntfItr.PreviousIndex: Integer; +begin + Result := FCursor - 1; +end; + +procedure TIntfItr.Remove; +begin + with FOwnList do + begin + FItems[FCursor] := nil; // Force Release + MoveArray(FItems, FCursor + 1, FCursor, FSize - FCursor); + end; + Dec(FOwnList.FCount); + Dec(FSize); +end; + +procedure TIntfItr.SetObject(AInterface: IInterface); +begin + FOwnList.Items[FCursor] := AInterface; +end; + +//=== { TStrItr } ============================================================ + +type + TStrItr = class(TJclAbstractContainer, IJclStrIterator) + private + FCursor: Integer; + FOwnList: TJclStrVector; + FLastRet: Integer; + FSize: Integer; + protected + { IJclStrIterator} + procedure Add(const AString: string); + function GetString: string; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: string; + function NextIndex: Integer; + function Previous: string; + function PreviousIndex: Integer; + procedure Remove; + procedure SetString(const AString: string); + public + constructor Create(OwnList: TJclStrVector); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TStrItr.Create(OwnList: TJclStrVector); +begin + inherited Create; + FCursor := 0; + FOwnList := OwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} + FLastRet := -1; + FSize := FOwnList.Size; +end; + +{$IFNDEF CLR} +destructor TStrItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TStrItr.Add(const AString: string); +begin + FOwnList.Insert(FCursor, AString); + Inc(FSize); + Inc(FCursor); + FLastRet := -1; +end; + +function TStrItr.GetString: string; +begin + Result := FOwnList.Items[FCursor]; +end; + +function TStrItr.HasNext: Boolean; +begin + Result := FCursor < FSize; +end; + +function TStrItr.HasPrevious: Boolean; +begin + Result := FCursor > 0; +end; + +function TStrItr.Next: string; +begin + Result := FOwnList.Items[FCursor]; + FLastRet := FCursor; + Inc(FCursor); +end; + +function TStrItr.NextIndex: Integer; +begin + Result := FCursor; +end; + +function TStrItr.Previous: string; +begin + Dec(FCursor); + FLastRet := FCursor; + Result := FOwnList.Items[FCursor]; +end; + +function TStrItr.PreviousIndex: Integer; +begin + Result := FCursor - 1; +end; + +procedure TStrItr.Remove; +begin + with FOwnList do + begin + FItems[FCursor] := ''; // Force Release + MoveArray(FItems, FCursor + 1, FCursor, FSize - FCursor); + end; + Dec(FOwnList.FCount); + Dec(FSize); +end; + +procedure TStrItr.SetString(const AString: string); +begin + { + if FLastRet = -1 then + raise EJclIllegalState.Create(SIllegalState); + } + FOwnList.Items[FCursor] := AString; +end; + +//=== { TItr } =============================================================== + +type + TItr = class(TJclAbstractContainer, IJclIterator) + private + FCursor: Integer; + FOwnList: TJclVector; + FLastRet: Integer; + FSize: Integer; + protected + { IJclIterator} + procedure Add(AObject: TObject); + function GetObject: TObject; + function HasNext: Boolean; + function HasPrevious: Boolean; + function Next: TObject; + function NextIndex: Integer; + function Previous: TObject; + function PreviousIndex: Integer; + procedure Remove; + procedure SetObject(AObject: TObject); + public + constructor Create(OwnList: TJclVector); + {$IFNDEF CLR} + destructor Destroy; override; + {$ENDIF ~CLR} + end; + +constructor TItr.Create(OwnList: TJclVector); +begin + inherited Create; + FCursor := 0; + FOwnList := OwnList; + {$IFNDEF CLR} + FOwnList._AddRef; // Add a ref because FOwnList is not an interface ! + {$ENDIF ~CLR} + FLastRet := -1; + FSize := FOwnList.Size; +end; + +{$IFNDEF CLR} +destructor TItr.Destroy; +begin + FOwnList._Release; + inherited Destroy; +end; +{$ENDIF ~CLR} + +procedure TItr.Add(AObject: TObject); +begin + FOwnList.Insert(FCursor, AObject); + Inc(FSize); + Inc(FCursor); + FLastRet := -1; +end; + +function TItr.GetObject: TObject; +begin + Result := FOwnList.Items[FCursor]; +end; + +function TItr.HasNext: Boolean; +begin + Result := FCursor <> FSize; +end; + +function TItr.HasPrevious: Boolean; +begin + Result := FCursor > 0; +end; + +function TItr.Next: TObject; +begin + Result := FOwnList.Items[FCursor]; + FLastRet := FCursor; + Inc(FCursor); +end; + +function TItr.NextIndex: Integer; +begin + Result := FCursor; +end; + +function TItr.Previous: TObject; +begin + Dec(FCursor); + FLastRet := FCursor; + Result := FOwnList.Items[FCursor]; +end; + +function TItr.PreviousIndex: Integer; +begin + Result := FCursor - 1; +end; + +procedure TItr.Remove; +begin + with FOwnList do + begin + FreeObject(FItems[FCursor]); + MoveArray(FItems, FCursor + 1, FCursor, FSize - FCursor); + end; + Dec(FOwnList.FCount); + Dec(FSize); +end; + +procedure TItr.SetObject(AObject: TObject); +begin + { + if FLastRet = -1 then + raise EJclIllegalState.Create(SIllegalState); + } + FOwnList.Items[FCursor] := AObject; +end; + +//=== { TJclIntfVector } ===================================================== + +constructor TJclIntfVector.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FCount := 0; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FItems, FCapacity); +end; + +destructor TJclIntfVector.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclIntfVector.Insert(Index: Integer; AInterface: IInterface); +begin + if (Index < 0) or (Index > FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if FCount = FCapacity then + Grow; + MoveArray(FItems, Index, Index + 1, FCount - Index); + FItems[Index] := AInterface; + Inc(FCount); +end; + +function TJclIntfVector.Add(AInterface: IInterface): Boolean; +begin + if FCount = FCapacity then + Grow; + FItems[FCount] := AInterface; + Inc(FCount); + Result := True; +end; + +function TJclIntfVector.InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; + Size: Integer; +begin + Result := False; + if (Index < 0) or (Index >= FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if ACollection = nil then + Exit; + Size := ACollection.Size; + if Size <> 0 then + begin + Inc(FCapacity, Size); + SetLength(FItems, FCapacity); + Inc(FCount, Size); + MoveArray(FItems, Index, Index + Size, Size); + It := ACollection.First; + while It.HasNext do + begin + FItems[Index] := It.Next; + Inc(Index); + end; + end; + Result := True; +end; + +function TJclIntfVector.AddAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Add(It.Next); + Result := True; +end; + +procedure TJclIntfVector.Clear; +var + I: Integer; +begin + for I := 0 to FCount - 1 do + FItems[I] := nil; + FCount := 0; +end; + +function TJclIntfVector.Clone: IInterface; +var + NewList: IJclIntfList; +begin + NewList := TJclIntfVector.Create(FCapacity); + NewList.AddAll(Self); + Result := NewList; +end; + +function TJclIntfVector.Contains(AInterface: IInterface): Boolean; +var + I: Integer; +begin + Result := False; + if AInterface = nil then + Exit; + for I := 0 to FCount - 1 do + if Items[I] = AInterface then + begin + Result := True; + Break; + end; +end; + +function TJclIntfVector.ContainsAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); +end; + +function TJclIntfVector.Equals(ACollection: IJclIntfCollection): Boolean; +var + I: Integer; + It: IJclIntfIterator; +begin + Result := False; + if ACollection = nil then + Exit; + if FCount <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCount - 1 do + if Items[I] <> It.Next then + Exit; + Result := True; +end; + +function TJclIntfVector.GetObject(Index: Integer): IInterface; +begin + if (Index < 0) or (Index >= FCount) then + begin + Result := nil; + Exit; + end; + Result := Items[Index]; +end; + +procedure TJclIntfVector.Grow; +begin + if FCapacity > 64 then + FCapacity := FCapacity + FCapacity div 4 + else + if FCapacity = 0 then + FCapacity := 64 + else + FCapacity := FCapacity * 4; + SetLength(FItems, FCapacity); +end; + +function TJclIntfVector.IndexOf(AInterface: IInterface): Integer; +var + I: Integer; +begin + Result := -1; + if AInterface = nil then + Exit; + for I := 0 to FCount - 1 do + if Items[I] = AInterface then + begin + Result := I; + Break; + end; +end; + +function TJclIntfVector.First: IJclIntfIterator; +begin + Result := TIntfItr.Create(Self); +end; + +function TJclIntfVector.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclIntfVector.Last: IJclIntfIterator; +var + NewIterator: TIntfItr; +begin + NewIterator := TIntfItr.Create(Self); + NewIterator.FCursor := NewIterator.FOwnList.FCount; + NewIterator.FSize := NewIterator.FOwnList.FCount; + Result := NewIterator; +end; + +function TJclIntfVector.LastIndexOf(AInterface: IInterface): Integer; +var + I: Integer; +begin + Result := -1; + if AInterface = nil then + Exit; + for I := FCount - 1 downto 0 do + if Items[I] = AInterface then + begin + Result := I; + Break; + end; +end; + +function TJclIntfVector.Remove(Index: Integer): IInterface; +begin + if (Index < 0) or (Index >= FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + Result := FItems[Index]; + FItems[Index] := nil; + MoveArray(FItems, Index + 1, Index, FCount - Index); + Dec(FCount); +end; + +function TJclIntfVector.Remove(AInterface: IInterface): Boolean; +var + I: Integer; +begin + Result := False; + if AInterface = nil then + Exit; + for I := FCount - 1 downto 0 do + if FItems[I] = AInterface then // Removes all AInterface + begin + FItems[I] := nil; // Force Release + MoveArray(FItems, I + 1, I, FCount - I); + Dec(FCount); + Result := True; + end; +end; + +function TJclIntfVector.RemoveAll(ACollection: IJclIntfCollection): Boolean; +var + It: IJclIntfIterator; +begin + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Remove(It.Next); +end; + +function TJclIntfVector.RetainAll(ACollection: IJclIntfCollection): Boolean; +var + I: Integer; +begin + Result := False; + if ACollection = nil then + Exit; + for I := FCount - 1 downto 0 do + if not ACollection.Contains(Items[I]) then + Remove(I); +end; + +procedure TJclIntfVector.SetObject(Index: Integer; AInterface: IInterface); +begin + if (Index < 0) or (Index >= FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + FItems[Index] := AInterface; +end; + +function TJclIntfVector.Size: Integer; +begin + Result := FCount; +end; + +function TJclIntfVector.SubList(First, Count: Integer): IJclIntfList; +var + I: Integer; + Last: Integer; +begin + Last := First + Count - 1; + if Last >= FCount then + Last := FCount - 1; + Result := TJclIntfVector.Create(Count); + for I := First to Last do + Result.Add(Items[I]); +end; + +{$IFNDEF CLR} +procedure TJclIntfVector.AfterConstruction; +begin +end; + +procedure TJclIntfVector.BeforeDestruction; +begin +end; +{$ENDIF ~CLR} + +//=== { TJclStrVector } ====================================================== + +constructor TJclStrVector.Create(ACapacity: Integer = DefaultContainerCapacity); +begin + inherited Create; + FCount := 0; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FItems, FCapacity); +end; + +destructor TJclStrVector.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclStrVector.Insert(Index: Integer; const AString: string); +begin + if (Index < 0) or (Index > FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if FCount = FCapacity then + Grow; + MoveArray(FItems, Index, Index + 1, FCount - Index); + FItems[Index] := AString; + Inc(FCount); +end; + +function TJclStrVector.Add(const AString: string): Boolean; +begin + if FCount = FCapacity then + Grow; + FItems[FCount] := AString; + Inc(FCount); + Result := True; +end; + +function TJclStrVector.AddAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +begin + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Add(It.Next); + Result := True; +end; + +function TJclStrVector.InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; + Size: Integer; +begin + Result := False; + if (Index < 0) or (Index >= FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if ACollection = nil then + Exit; + Size := ACollection.Size; + if Size <> 0 then + begin + Inc(FCapacity, Size); + SetLength(FItems, FCapacity); + Inc(FCount, Size); + MoveArray(FItems, Index, Index + Size, Size); + It := ACollection.First; + while It.HasNext do + begin + FItems[Index] := It.Next; + Inc(Index); + end; + end; + Result := True; +end; + +{$IFNDEF CLR} +procedure TJclStrVector.AfterConstruction; +begin +end; + +procedure TJclStrVector.BeforeDestruction; +begin +end; +{$ENDIF ~CLR} + +procedure TJclStrVector.Clear; +var + I: Integer; +begin + for I := 0 to FCount - 1 do + FItems[I] := ''; + FCount := 0; +end; + +function TJclStrVector.Clone: TObject; +var + NewList: TJclStrVector; +begin + NewList := TJclStrVector.Create(FCapacity); + NewList.AddAll(Self); + Result := NewList; +end; + +function TJclStrVector.Contains(const AString: string): Boolean; +var + I: Integer; +begin + Result := False; + if AString = '' then + Exit; + for I := 0 to FCount - 1 do + if Items[I] = AString then + begin + Result := True; + Break; + end; +end; + +function TJclStrVector.ContainsAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +begin + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); +end; + +function TJclStrVector.Equals(ACollection: IJclStrCollection): Boolean; +var + I: Integer; + It: IJclStrIterator; +begin + Result := False; + if ACollection = nil then + Exit; + if FCount <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCount - 1 do + if Items[I] <> It.Next then + Exit; + Result := True; +end; + +function TJclStrVector.First: IJclStrIterator; +begin + Result := TStrItr.Create(Self); +end; + +function TJclStrVector.GetString(Index: Integer): string; +begin + if (Index < 0) or (Index >= FCount) then + begin + Result := ''; + Exit; + end; + Result := FItems[Index]; +end; + +procedure TJclStrVector.Grow; +begin + if FCapacity > 64 then + FCapacity := FCapacity + FCapacity div 4 + else + if FCapacity = 0 then + FCapacity := 64 + else + FCapacity := FCapacity * 4; + SetLength(FItems, FCapacity); +end; + +function TJclStrVector.IndexOf(const AString: string): Integer; +var + I: Integer; +begin + Result := -1; + if AString = '' then + Exit; + for I := 0 to FCount - 1 do + if Items[I] = AString then + begin + Result := I; + Exit; + end; +end; + +function TJclStrVector.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclStrVector.Last: IJclStrIterator; +var + NewIterator: TStrItr; +begin + NewIterator := TStrItr.Create(Self); + NewIterator.FCursor := NewIterator.FOwnList.FCount; + NewIterator.FSize := NewIterator.FOwnList.FCount; + Result := NewIterator; +end; + +function TJclStrVector.LastIndexOf(const AString: string): Integer; +var + I: Integer; +begin + Result := -1; + if AString = '' then + Exit; + for I := FCount - 1 downto 0 do + if Items[I] = AString then + begin + Result := I; + Break; + end; +end; + +function TJclStrVector.Remove(const AString: string): Boolean; +var + I: Integer; +begin + Result := False; + if AString = '' then + Exit; + for I := FCount - 1 downto 0 do + if FItems[I] = AString then // Removes all AString + begin + FItems[I] := ''; // Force Release + MoveArray(FItems, I + 1, I, FCount - I); + Dec(FCount); + Result := True; + end; +end; + +function TJclStrVector.Remove(Index: Integer): string; +begin + if (Index < 0) or (Index >= FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + Result := FItems[Index]; + FItems[Index] := ''; + MoveArray(FItems, Index + 1, Index, FCount - Index); + Dec(FCount); +end; + +function TJclStrVector.RemoveAll(ACollection: IJclStrCollection): Boolean; +var + It: IJclStrIterator; +begin + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Remove(It.Next); +end; + +function TJclStrVector.RetainAll(ACollection: IJclStrCollection): Boolean; +var + I: Integer; +begin + Result := False; + if ACollection = nil then + Exit; + for I := FCount - 1 downto 0 do + if not ACollection.Contains(Items[I]) then + Remove(I); +end; + +procedure TJclStrVector.SetString(Index: Integer; const AString: string); +begin + if (Index < 0) or (Index >= FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + FItems[Index] := AString; +end; + +function TJclStrVector.Size: Integer; +begin + Result := FCount; +end; + +function TJclStrVector.SubList(First, Count: Integer): IJclStrList; +var + I: Integer; + Last: Integer; +begin + Last := First + Count - 1; + if Last >= FCount then + Last := FCount - 1; + Result := TJclStrVector.Create(Count); + for I := First to Last do + Result.Add(Items[I]); +end; + +//=== { TJclVector } ========================================================= + +constructor TJclVector.Create(ACapacity: Integer = DefaultContainerCapacity; + AOwnsObjects: Boolean = True); +begin + inherited Create; + FCount := 0; + FOwnsObjects := AOwnsObjects; + if ACapacity < 0 then + FCapacity := 0 + else + FCapacity := ACapacity; + SetLength(FItems, FCapacity); +end; + +destructor TJclVector.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJclVector.Insert(Index: Integer; AObject: TObject); +begin + if (Index < 0) or (Index > FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if FCount = FCapacity then + Grow; + MoveArray(FItems, Index, Index + 1, FCount - Index); + FItems[Index] := AObject; + Inc(FCount); +end; + +function TJclVector.Add(AObject: TObject): Boolean; +begin + if FCount = FCapacity then + Grow; + FItems[FCount] := AObject; + Inc(FCount); + Result := True; +end; + +function TJclVector.InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; +var + It: IJclIterator; + Size: Integer; +begin + Result := False; + if (Index < 0) or (Index >= FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + if ACollection = nil then + Exit; + Size := ACollection.Size; + if Size <> 0 then + begin + Inc(FCapacity, Size); + SetLength(FItems, FCapacity); + Inc(FCount, Size); + MoveArray(FItems, Index, Index + Size, Size); + It := ACollection.First; + while It.HasNext do + begin + FItems[Index] := It.Next; + Inc(Index); + end; + end; + Result := True; +end; + +function TJclVector.AddAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Add(It.Next); + Result := True; +end; + +procedure TJclVector.Clear; +var + I: Integer; +begin + for I := 0 to FCount - 1 do + FreeObject(FItems[I]); + FCount := 0; +end; + +function TJclVector.Clone: TObject; +var + NewList: TJclVector; +begin + NewList := TJclVector.Create(FCapacity, False); // Only one can have FOwnsObject = True + NewList.AddAll(Self); + Result := NewList; +end; + +function TJclVector.Contains(AObject: TObject): Boolean; +var + I: Integer; +begin + Result := False; + if AObject = nil then + Exit; + for I := 0 to FCount - 1 do + if Items[I] = AObject then + begin + Result := True; + Break; + end; +end; + +function TJclVector.ContainsAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + Result := True; + if ACollection = nil then + Exit; + It := ACollection.First; + while Result and It.HasNext do + Result := Contains(It.Next); +end; + +function TJclVector.Equals(ACollection: IJclCollection): Boolean; +var + I: Integer; + It: IJclIterator; +begin + Result := False; + if ACollection = nil then + Exit; + if FCount <> ACollection.Size then + Exit; + It := ACollection.First; + for I := 0 to FCount - 1 do + if Items[I] <> It.Next then + Exit; + Result := True; +end; + +procedure TJclVector.FreeObject(var AObject: TObject); +begin + if FOwnsObjects then + begin + AObject.Free; + AObject := nil; + end; +end; + +function TJclVector.GetObject(Index: Integer): TObject; +begin + if (Index < 0) or (Index >= FCount) then + begin + Result := nil; + Exit; + end; + Result := Items[Index]; +end; + +procedure TJclVector.Grow; +begin + if FCapacity > 64 then + FCapacity := FCapacity + FCapacity div 4 + else + if FCapacity = 0 then + FCapacity := 64 + else + FCapacity := FCapacity * 4; + SetLength(FItems, FCapacity); +end; + +function TJclVector.IndexOf(AObject: TObject): Integer; +var + I: Integer; +begin + Result := -1; + if AObject = nil then + Exit; + for I := 0 to FCount - 1 do + if Items[I] = AObject then + begin + Result := I; + Break; + end; +end; + +function TJclVector.First: IJclIterator; +begin + Result := TItr.Create(Self); +end; + +function TJclVector.IsEmpty: Boolean; +begin + Result := FCount = 0; +end; + +function TJclVector.Last: IJclIterator; +var + NewIterator: TItr; +begin + NewIterator := TItr.Create(Self); + NewIterator.FCursor := NewIterator.FOwnList.FCount; + NewIterator.FSize := NewIterator.FOwnList.FCount; + Result := NewIterator; +end; + +function TJclVector.LastIndexOf(AObject: TObject): Integer; +var + I: Integer; +begin + Result := -1; + if AObject = nil then + Exit; + for I := FCount - 1 downto 0 do + if Items[I] = AObject then + begin + Result := I; + Break; + end; +end; + +function TJclVector.Remove(AObject: TObject): Boolean; +var + I: Integer; +begin + Result := False; + if AObject = nil then + Exit; + for I := FCount - 1 downto 0 do + if FItems[I] = AObject then // Removes all AObject + begin + FreeObject(FItems[I]); + MoveArray(FItems, I + 1, I, FCount - I); + Dec(FCount); + Result := True; + end; +end; + +function TJclVector.Remove(Index: Integer): TObject; +begin + if (Index < 0) or (Index >= FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + Result := FItems[Index]; + FreeObject(FItems[Index]); + MoveArray(FItems, Index + 1, Index, FCount - Index); + Dec(FCount); +end; + +function TJclVector.RemoveAll(ACollection: IJclCollection): Boolean; +var + It: IJclIterator; +begin + Result := False; + if ACollection = nil then + Exit; + It := ACollection.First; + while It.HasNext do + Remove(It.Next); +end; + +function TJclVector.RetainAll(ACollection: IJclCollection): Boolean; +var + I: Integer; +begin + Result := False; + if ACollection = nil then + Exit; + for I := FCount - 1 to 0 do + if not ACollection.Contains(Items[I]) then + Remove(I); +end; + +procedure TJclVector.SetObject(Index: Integer; AObject: TObject); +begin + if (Index < 0) or (Index >= FCount) then + {$IFDEF CLR} + raise EJclOutOfBoundsError.Create(RsEOutOfBounds); + {$ELSE} + raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds); + {$ENDIF CLR} + FItems[Index] := AObject; +end; + +function TJclVector.Size: Integer; +begin + Result := FCount; +end; + +function TJclVector.SubList(First, Count: Integer): IJclList; +var + I: Integer; + Last: Integer; +begin + Last := First + Count - 1; + if Last >= FCount then + Last := FCount - 1; + Result := TJclVector.Create(Count, FOwnsObjects); + for I := First to Last do + Result.Add(Items[I]); +end; + +{$IFNDEF CLR} +procedure TJclVector.AfterConstruction; +begin +end; + +procedure TJclVector.BeforeDestruction; +begin +end; +{$ENDIF ~CLR} + +// History: + +// $Log: JclVectors.pas,v $ +// Revision 1.12 2005/05/05 20:08:46 ahuser +// JCL.NET support +// +// Revision 1.11 2005/03/14 08:46:53 rrossmair +// - check-in in preparation for release 1.95 +// +// Revision 1.10 2005/03/12 06:01:06 rrossmair +// - fixed collection insert, iterator add methods +// +// Revision 1.9 2005/03/12 05:22:07 rrossmair +// - InsertAll methods fixed +// +// Revision 1.8 2005/03/08 08:33:18 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.7 2005/03/03 08:02:57 marquardt +// various style cleanings, bugfixes and improvements +// +// Revision 1.6 2005/03/02 17:51:24 rrossmair +// - removed DCLAppendDelimited from JclAlgorithms, changed uses clauses accordingly +// +// Revision 1.5 2005/03/02 09:59:30 dade2004 +// Added +// -TJclStrCollection in JclContainerIntf +// Every common methods for IJclStrCollection are implemented here +// +// -Every class that implement IJclStrCollection now derive from TJclStrCollection instead of TJclAbstractContainer +// -Every abstract method in TJclStrCollection has been marked as "override" in descendent classes +// +// DCLAppendDelimited has been removed from JclAlgorothms, his body has been fixed for a bug and put into +// relative method in TJclStrCollection +// +// Revision 1.4 2005/02/27 11:36:20 marquardt +// fixed and secured Capacity/Grow mechanism, raise exceptions with efficient CreateResRec +// +// Revision 1.3 2005/02/27 07:27:47 marquardt +// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas +// +// Revision 1.2 2005/02/24 07:36:24 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.1 2005/02/24 03:57:10 rrossmair +// - donated DCL code, initial check-in +// + +end. + diff --git a/official/1.96/source/common/JclWideStrings.pas b/official/1.96/source/common/JclWideStrings.pas new file mode 100644 index 0000000..537b621 --- /dev/null +++ b/official/1.96/source/common/JclWideStrings.pas @@ -0,0 +1,2028 @@ +{----------------------------------------------------------------------------- +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/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed 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 +and Mike Lischke (WideQuotedStr & WideExtractQuotedStr from Unicode.pas). + +All Rights Reserved. + +Contributors: + Robert Marquardt (marquardt) + Robert Rossmair (rrossmair) + +You may retrieve the latest version of this file at the Project JEDI's JCL home page, +located at http://jcl.sourceforge.net + +This is a lightweight Unicode unit. For more features use JclUnicode. + +Known Issues: +-----------------------------------------------------------------------------} + +unit JclWideStrings; + +{$I jcl.inc} + +interface + +uses + Classes, SysUtils; + +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); + + BOM_LSB_FIRST = WideChar($FEFF); + BOM_MSB_FIRST = WideChar($FFFE); + +type + 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; + + TWStrings = class; + TWStringList = class; + + TWStringListSortCompare = function(List: TWStringList; Index1, Index2: Integer): Integer; + + TWStrings = 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: TWStrings); 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: TWStrings): Boolean; overload; + function Equals(Strings: TStrings): Boolean; 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: AnsiString; + WideFileOptions: TWideFileOptions = []); virtual; + procedure LoadFromStream(Stream: TStream; + WideFileOptions: TWideFileOptions = []); virtual; + procedure Move(CurIndex, NewIndex: Integer); virtual; + procedure SaveToFile(const FileName: AnsiString; + 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; + + TWStringList = class(TWStrings) + 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: TWStringListSortCompare); 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; + + TWideStringList = TWStringList; + TWideStrings = TWStrings; + +// WideChar functions +function CharToWideChar(Ch: AnsiChar): WideChar; +function WideCharToChar(Ch: WideChar): AnsiChar; + +// PWideChar functions +procedure MoveWideChar(const Source; var Dest; Count: Integer); + +function StrLenW(const Str: PWideChar): Cardinal; +function StrEndW(const Str: PWideChar): PWideChar; +function StrMoveW(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): 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: Cardinal): PWideChar; +function StrPCopyWW(Dest: PWideChar; const Source: WideString): PWideChar; +function StrPCopyW(Dest: PWideChar; const Source: string): PWideChar; +function StrPLCopyWW(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar; +function StrPLCopyW(Dest: PWideChar; const Source: string; MaxLen: Cardinal): PWideChar; +function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; +function StrLCatW(Dest: PWideChar; const Source: PWideChar; MaxLen: Cardinal): PWideChar; +function StrCompW(const Str1, Str2: PWideChar): Integer; +function StrICompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +function StrLCompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +function StrLICompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +function StrLICompW2(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +function StrNScanW(const Str1, Str2: PWideChar): Integer; +function StrRNScanW(const Str1, Str2: PWideChar): Integer; +function StrScanW(const Str: PWideChar; Ch: WideChar): PWideChar; overload; +function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: Cardinal): PWideChar; overload; +function StrRScanW(const Str: PWideChar; Chr: WideChar): PWideChar; +function StrPosW(const Str, SubStr: PWideChar): PWideChar; +function StrAllocW(WideSize: Cardinal): PWideChar; +function StrBufSizeW(const Str: PWideChar): Cardinal; +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): Integer; +function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; +function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; +{$IFNDEF RTL140_UP} +function WideCompareText(const S1, S2: WideString): Integer; +function WideCompareStr(const S1, S2: WideString): Integer; +function WideUpperCase(const S: WideString): WideString; +function WideLowerCase(const S: WideString): WideString; +{$ENDIF ~RTL140_UP} +function TrimW(const S: WideString): WideString; +function TrimLeftW(const S: WideString): WideString; +function TrimRightW(const S: WideString): WideString; + +function TrimLeftLengthW(const S: WideString): Integer; +function TrimRightLengthW(const S: WideString): Integer; + +implementation + +uses + {$IFDEF HAS_UNIT_RTLCONSTS} + RTLConsts, + {$ELSE} + Consts, + {$ENDIF HAS_UNIT_RTLCONSTS} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Math; + +procedure SwapWordByteOrder(P: PChar; Len: Cardinal); +var + B: Char; +begin + while Len > 0 do + begin + B := P[0]; + P[0] := P[1]; + P[1] := B; + Inc(P, 2); + Dec(Len); + end; +end; + +//=== WideChar functions ===================================================== + +function CharToWideChar(Ch: Char): WideChar; +var + WS: WideString; +begin + WS := Ch; + Result := WS[1]; +end; + +function WideCharToChar(Ch: WideChar): AnsiChar; +var + S: AnsiString; +begin + S := Ch; + Result := S[1]; +end; + +//=== PWideChar functions ==================================================== + +procedure MoveWideChar(const Source; var Dest; Count: Integer); +begin + Move(Source, Dest, Count * SizeOf(WideChar)); +end; + +function StrAllocW(WideSize: Cardinal): PWideChar; +begin + WideSize := SizeOf(WideChar) * WideSize + SizeOf(Cardinal); + Result := AllocMem(WideSize); + Cardinal(Pointer(Result)^) := WideSize; + Inc(Result, SizeOf(Cardinal) 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: Cardinal; +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(Cardinal) div SizeOf(WideChar)); + FreeMem(Str); + end; +end; + +procedure StrDisposeAndNilW(var Str: PWideChar); +begin + StrDisposeW(Str); + Str := nil; +end; + +function StrLICompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +var + P1, P2: WideString; +begin + SetString(P1, Str1, Min(MaxLen, StrLenW(Str1))); + SetString(P2, Str2, Min(MaxLen, StrLenW(Str2))); + Result := WideCompareText(P1, P2); +end; + +function StrLICompW2(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +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 StrCompW(const Str1, Str2: PWideChar): Integer; +var + NullWide: WideChar; + SA, SB: PWideChar; +begin + Result := 0; + if Str1 = Str2 then // "equal" and "nil" case + Exit; + NullWide := #0; + + if Str1 = nil then + SA := @NullWide + else + SA := Str1; + if Str2 = nil then + SB := @NullWide + else + SB := Str2; + while (SA^ = SB^) and (SA^ <> #0) and (SB^ <> #0) do + begin + Inc(SA); + Inc(SB); + end; + Result := Integer(SA^) - Integer(SB^); +end; + +function StrLCompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +var + NullWide: WideChar; + SA, SB: PWideChar; +begin + Result := 0; + if Str1 = Str2 then // "equal" and "nil" case + Exit; + NullWide := #0; + + if Str1 = nil then + SA := @NullWide + else + SA := Str1; + if Str2 = nil then + SB := @NullWide + else + SB := Str2; + while (MaxLen > 0) and (SA^ = SB^) and (SA^ <> #0) and (SB^ <> #0) do + begin + Inc(SA); + Inc(SB); + Dec(MaxLen); + end; + if MaxLen > 0 then + Result := Integer(SA^) - Integer(SB^) + else + Result := 0; +end; + +function StrICompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +begin + Result := StrLICompW(Str1, Str2, Max(StrLenW(Str1), StrLenW(Str2))); +end; + +function StrPosW(const Str, SubStr: PWideChar): PWideChar; +var + P: PWideChar; + I: Integer; +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): Cardinal; +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: Cardinal): 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: Cardinal): PWideChar; +begin + Result := Dest; + StrLCopyW(StrEndW(Dest), Source, MaxLen); +end; + +function StrMoveW(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar; +begin + Result := Dest; + if Count > 0 then + Move(Source^, Dest^, Integer(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: Cardinal): 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 contains address of string + +procedure StrSwapByteOrder(Str: PWideChar); +asm + 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 +end; + +function StrNScanW(const Str1, Str2: PWideChar): Integer; +// 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): Integer; +// 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. +// +// on enter EAX contains Str, EDX contains Chr and ECX StrLen +// on exit EAX contains result pointer or nil + +function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: Cardinal): PWideChar; +asm + TEST EAX, EAX + JZ @@Exit // get out if the string is nil or StrLen is 0 + JCXZ @@Exit +@@Loop: + CMP [EAX], DX // this unrolled loop is actually faster on modern processors + JE @@Exit // than REP SCASW + ADD EAX, 2 + DEC ECX + JNZ @@Loop + XOR EAX, EAX +@@Exit: +end; + +function StrBufSizeW(const Str: PWideChar): Cardinal; +// 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(Cardinal) div SizeOf(WideChar)); + Result := (Cardinal(PInteger(P)^) - SizeOf(Cardinal)) div SizeOf(WideChar); + end + else + Result := 0; +end; + +function StrPCopyW(Dest: PWideChar; const Source: string): PWideChar; +// copies a Pascal-style string to a null-terminated wide string +begin + Result := StrPLCopyW(Dest, Source, Cardinal(Length(Source))); + Result[Length(Source)] := WideNull; +end; + +function StrPLCopyW(Dest: PWideChar; const Source: string; MaxLen: Cardinal): PWideChar; +// copies characters from a Pascal-style string into a null-terminated wide string +asm + PUSH EDI + PUSH ESI + MOV EDI, EAX + MOV ESI, EDX + MOV EDX, EAX + XOR AX, AX +@@1: LODSB + STOSW + DEC ECX + JNZ @@1 + MOV EAX, EDX + POP ESI + POP EDI +end; + +//=== WideString functions =================================================== + +function WidePos(const SubStr, S: WideString): Integer; +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: Integer; +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: Integer; +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: Integer; +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: Integer; +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: Integer; +begin + I := Length(S); + while (I > 0) and (S[I] <= ' ') do + Dec(I); + Result := Copy(S, 1, I); +end; +{$ENDIF ~RTL150_UP} + +// functions missing in Delphi 5 / FPC +{$IFNDEF RTL140_UP} + +function WideCompareText(const S1, S2: WideString): Integer; +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): Integer; +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} + { TODO : Don't cheat here } + Result := CompareString(S1, S2); + {$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; + +{$ENDIF ~RTL140_UP} + +function TrimLeftLengthW(const S: WideString): Integer; +var + Len: Integer; +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): Integer; +begin + Result := Length(S); + while (Result > 0) and (S[Result] <= #32) do + Dec(Result); +end; + +//=== { TWStrings } ========================================================== + +constructor TWStrings.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 TWStrings.Add(const S: WideString): Integer; +begin + Result := AddObject(S, nil); +end; + +function TWStrings.AddObject(const S: WideString; AObject: TObject): Integer; +begin + Result := Count; + InsertObject(Result, S, AObject); +end; + +procedure TWStrings.AddStrings(Strings: TWStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + AddObject(Strings.GetP(I)^, Strings.Objects[I]); +end; + +procedure TWStrings.AddStrings(Strings: TStrings); +var + I: Integer; +begin + for I := 0 to Strings.Count - 1 do + AddObject(Strings.Strings[I], Strings.Objects[I]); +end; + +procedure TWStrings.AddStringsTo(Dest: TStrings); +var + I: Integer; +begin + for I := 0 to Count - 1 do + Dest.AddObject(GetP(I)^, Objects[I]); +end; + +procedure TWStrings.Append(const S: WideString); +begin + Add(S); +end; + +procedure TWStrings.Assign(Source: TPersistent); +begin + if Source is TWStrings then + begin + BeginUpdate; + try + Clear; + FDelimiter := TWStrings(Source).FDelimiter; + FNameValueSeparator := TWStrings(Source).FNameValueSeparator; + FQuoteChar := TWStrings(Source).FQuoteChar; + AddStrings(TWStrings(Source)); + finally + EndUpdate; + end; + end + else + if Source is TStrings then + begin + BeginUpdate; + try + Clear; + {$IFDEF RTL150_UP} + FNameValueSeparator := CharToWideChar(TStrings(Source).NameValueSeparator); + {$ENDIF RTL150_UP} + {$IFDEF RTL140_UP} + FQuoteChar := CharToWideChar(TStrings(Source).QuoteChar); + FDelimiter := CharToWideChar(TStrings(Source).Delimiter); + {$ENDIF RTL140_UP} + AddStrings(TStrings(Source)); + finally + EndUpdate; + end; + end + else + inherited Assign(Source); +end; + +procedure TWStrings.AssignTo(Dest: TPersistent); +var + I: Integer; +begin + if Dest is TStrings then + begin + TStrings(Dest).BeginUpdate; + try + TStrings(Dest).Clear; + {$IFDEF RTL150_UP} + TStrings(Dest).NameValueSeparator := WideCharToChar(NameValueSeparator); + {$ENDIF RTL150_UP} + {$IFDEF RTL140_UP} + TStrings(Dest).QuoteChar := WideCharToChar(QuoteChar); + TStrings(Dest).Delimiter := WideCharToChar(Delimiter); + {$ENDIF RTL140_UP} + 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 TWStrings.BeginUpdate; +begin + if FUpdateCount = 0 then + SetUpdateState(True); + Inc(FUpdateCount); +end; + +function TWStrings.CompareStrings(const S1, S2: WideString): Integer; +begin + Result := WideCompareText(S1, S2); +end; + +function TWStrings.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 TWStrings.DefineProperties(Filer: TFiler); + + function DoWrite: Boolean; + begin + if Filer.Ancestor <> nil then + begin + Result := True; + if Filer.Ancestor is TWStrings then + Result := not Equals(TWStrings(Filer.Ancestor)) + end + else + Result := Count > 0; + end; + +begin + Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite); +end; + +procedure TWStrings.EndUpdate; +begin + Dec(FUpdateCount); + if FUpdateCount = 0 then + SetUpdateState(False); +end; + +function TWStrings.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 TWStrings.Equals(Strings: TWStrings): 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 TWStrings.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 TWStrings.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 TWStrings.Get(Index: Integer): WideString; +begin + Result := GetP(Index)^; +end; + +function TWStrings.GetCapacity: Integer; +begin + Result := Count; +end; + +function TWStrings.GetCommaText: WideString; +begin + Result := GetDelimitedTextEx(',', '"'); +end; + +function TWStrings.GetDelimitedText: WideString; +begin + Result := GetDelimitedTextEx(FDelimiter, FQuoteChar); +end; + +function TWStrings.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 TWStrings.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 TWStrings.GetObject(Index: Integer): TObject; +begin + Result := nil; +end; + +function TWStrings.GetText: PWideChar; +begin + Result := StrNewW(GetTextStr); +end; + +function TWStrings.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 TWStrings.GetValue(const Name: WideString): WideString; +var + Idx: Integer; +begin + Idx := IndexOfName(Name); + if Idx >= 0 then + Result := GetValueFromIndex(Idx) + else + Result := ''; +end; + +function TWStrings.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 TWStrings.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 TWStrings.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 TWStrings.IndexOfObject(AObject: TObject): Integer; +begin + for Result := 0 to Count - 1 do + if Objects[Result] = AObject then + Exit; + Result := -1; +end; + +procedure TWStrings.Insert(Index: Integer; const S: WideString); +begin + InsertObject(Index, S, nil); +end; + +procedure TWStrings.InsertObject(Index: Integer; const S: WideString; AObject: TObject); +begin +end; + +procedure TWStrings.LoadFromFile(const FileName: AnsiString; + WideFileOptions: TWideFileOptions = []); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(Stream, WideFileOptions); + finally + Stream.Free; + end; +end; + +procedure TWStrings.LoadFromStream(Stream: TStream; + WideFileOptions: TWideFileOptions = []); +var + AnsiS: AnsiString; + WideS: WideString; + WC: WideChar; +begin + BeginUpdate; + try + Clear; + if foAnsiFile in WideFileOptions then + begin + Stream.Read(WC, SizeOf(WC)); + Stream.Seek(-SizeOf(WC), soFromCurrent); + if (Hi(Word(WC)) <> 0) and (WC <> BOM_LSB_FIRST) and (WC <> BOM_MSB_FIRST) then + begin + SetLength(AnsiS, Stream.Size - Stream.Position); + Stream.Read(AnsiS[1], Length(AnsiS)); + SetTextStr(AnsiS); + Exit; + end; + end; + + Stream.Read(WC, SizeOf(WC)); + if (WC <> BOM_LSB_FIRST) and (WC <> BOM_MSB_FIRST) then + Stream.Seek(-SizeOf(WC), soFromCurrent); + SetLength(WideS, Stream.Size - Stream.Position); + Stream.Read(WideS[1], Length(WideS) * SizeOf(WideChar)); + + if WC = BOM_MSB_FIRST then + SwapWordByteOrder(Pointer(WideS), Length(WideS)); + + SetTextStr(WideS); + finally + EndUpdate; + end; +end; + +procedure TWStrings.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 TWStrings.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 TWStrings.SaveToFile(const FileName: AnsiString; WideFileOptions: TWideFileOptions = []); +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(FileName, fmCreate); + try + SaveToStream(Stream, WideFileOptions); + finally + Stream.Free; + end; +end; + +procedure TWStrings.SaveToStream(Stream: TStream; WideFileOptions: TWideFileOptions = []); +var + AnsiS: AnsiString; + WideS: WideString; + WC: WideChar; +begin + if foAnsiFile in WideFileOptions then + begin + AnsiS := GetTextStr; + Stream.Write(AnsiS[1], Length(AnsiS)); + 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 TWStrings.SetCapacity(NewCapacity: Integer); +begin +end; + +procedure TWStrings.SetCommaText(const Value: WideString); +begin + SetDelimitedTextEx(',', '"', Value); +end; + +procedure TWStrings.SetDelimitedText(const Value: WideString); +begin + SetDelimitedTextEx(Delimiter, QuoteChar, Value); +end; + +procedure TWStrings.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 TWStrings.SetText(Text: PWideChar); +begin + SetTextStr(Text); +end; + +procedure TWStrings.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 TWStrings.SetUpdateState(Updating: Boolean); +begin +end; + +procedure TWStrings.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 TWStrings.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 TWStrings.WriteData(Writer: TWriter); +var + I: Integer; +begin + Writer.WriteListBegin; + for I := 0 to Count - 1 do + Writer.WriteWideString(GetP(I)^); + Writer.WriteListEnd; +end; + +//=== { TWStringList } ======================================================= + +constructor TWStringList.Create; +begin + inherited Create; + FList := TList.Create; +end; + +destructor TWStringList.Destroy; +begin + FOnChange := nil; + FOnChanging := nil; + Inc(FUpdateCount); // do not call unnecessary functions + Clear; + FList.Free; + inherited Destroy; +end; + +function TWStringList.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 TWStringList.Changed; +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + +procedure TWStringList.Changing; +begin + if Assigned(FOnChanging) then + FOnChanging(Self); +end; + +procedure TWStringList.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 TWStringList.CompareStrings(const S1, S2: WideString): Integer; +begin + if CaseSensitive then + Result := WideCompareStr(S1, S2) + else + Result := WideCompareText(S1, S2); +end; + +threadvar + CustomSortList: TWStringList; + CustomSortCompare: TWStringListSortCompare; + +function WStringListCustomSort(Item1, Item2: Pointer): Integer; +begin + Result := CustomSortCompare(CustomSortList, + CustomSortList.FList.IndexOf(Item1), + CustomSortList.FList.IndexOf(Item2)); +end; + +procedure TWStringList.CustomSort(Compare: TWStringListSortCompare); +var + TempList: TWStringList; + TempCompare: TWStringListSortCompare; +begin + TempList := CustomSortList; + TempCompare := CustomSortCompare; + CustomSortList := Self; + CustomSortCompare := Compare; + try + Changing; + FList.Sort(WStringListCustomSort); + Changed; + finally + CustomSortList := TempList; + CustomSortCompare := TempCompare; + end; +end; + +procedure TWStringList.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 TWStringList.Exchange(Index1, Index2: Integer); +begin + if FUpdateCount = 0 then + Changing; + FList.Exchange(Index1, Index2); + if FUpdateCount = 0 then + Changed; +end; + +function TWStringList.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 TWStringList.GetCapacity: Integer; +begin + Result := FList.Capacity; +end; + +function TWStringList.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TWStringList.GetItem(Index: Integer): PWStringItem; +begin + Result := FList[Index]; +end; + +function TWStringList.GetObject(Index: Integer): TObject; +begin + Result := GetItem(Index).FObject; +end; + +function TWStringList.GetP(Index: Integer): PWideString; +begin + Result := Addr(GetItem(Index).FString); +end; + +function TWStringList.IndexOf(const S: WideString): Integer; +begin + if Sorted then + begin + 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 TWStringList.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 TWStringList.Put(Index: Integer; const Value: WideString); +begin + if FUpdateCount = 0 then + Changing; + GetItem(Index).FString := Value; + if FUpdateCount = 0 then + Changed; +end; + +procedure TWStringList.PutObject(Index: Integer; AObject: TObject); +begin + if FUpdateCount = 0 then + Changing; + GetItem(Index).FObject := AObject; + if FUpdateCount = 0 then + Changed; +end; + +procedure TWStringList.SetCapacity(NewCapacity: Integer); +begin + FList.Capacity := NewCapacity; +end; + +procedure TWStringList.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 TWStringList.SetSorted(Value: Boolean); +begin + if Value <> FSorted then + begin + FSorted := Value; + if FSorted then + begin + FSorted := False; + Sort; + FSorted := True; + end; + end; +end; + +procedure TWStringList.SetUpdateState(Updating: Boolean); +begin + if Updating then + Changing + else + Changed; +end; + +function DefaultSort(List: TWStringList; Index1, Index2: Integer): Integer; +begin + Result := List.CompareStrings(List.GetItem(Index1).FString, List.GetItem(Index2).FString); +end; + +procedure TWStringList.Sort; +begin + if not Sorted then + CustomSort(DefaultSort); +end; + +// History: + +// $Log: JclWideStrings.pas,v $ +// Revision 1.23 2005/10/27 06:54:20 marquardt +// removed unneeded Sign function and fixed multiple history entries +// +// Revision 1.22 2005/10/26 09:15:13 marquardt +// most functions now have the same const parameters as their Ansi counterparts +// +// Revision 1.21 2005/10/26 08:36:29 marquardt +// StrPCopyWW and StrPLCopyWW introduced to solve overloaded problem +// +// Revision 1.20 2005/10/25 16:27:36 marquardt +// StrPCopyW and StrPLCopyW overloaded versions deactivated because of Delphi5 compiler problems +// +// Revision 1.19 2005/10/25 10:33:40 marquardt +// made StrPCopyW and StrPLCopyW compatible with the original Unicode.pas by adding overloaded versions +// +// Revision 1.18 2005/10/25 09:46:35 marquardt +// fixes for StrAllocW family and cleaned up Str*W parameter names +// +// Revision 1.17 2005/10/25 08:54:57 marquardt +// make a union of the Str*W family of functions in JclUnicode and JclWideStrings +// +// Revision 1.16 2005/10/16 05:15:38 marquardt +// Str*W family now matches completely Delphi Str* family semantics +// +// Revision 1.15 2005/07/19 23:21:21 outchy +// IT 2968: The result StrLCompW was false when MaxLen characters were compared. +// +// Revision 1.14 2005/04/07 00:41:35 rrossmair +// - changed for FPC 1.9.8 +// +// Revision 1.13 2005/03/19 21:22:25 rrossmair +// - fixed typo in changed StrScanW +// +// Revision 1.12 2005/03/19 02:47:07 rrossmair +// - fixed issue #2680 (WideQuotedStr always fails) +// - gives credit to Mike Lischke in header now +// +// Revision 1.11 2005/03/08 08:33:18 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.10 2005/03/01 15:37:40 marquardt +// addressing Mantis 0714, 0716, 0720, 0731, 0740 partly or completely +// +// Revision 1.9 2005/02/24 16:34:40 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.8 2005/02/14 00:47:23 rrossmair +// - removed (redundant) comment in German language. +// +// Revision 1.7 2004/10/25 15:12:30 marquardt +// fix internal error +// +// Revision 1.6 2004/10/17 21:49:03 rrossmair +// added CVS Log entries +// +// Revision 1.5 rossmair +// fixed D6, FPC compatibility +// +// Revision 1.4 marquardt +// complete and fix PWideChar Str functions +// +// Revision 1.3 marquardt +// PH cleaning of JclStrings +// +// Revision 1.2 rrossmair +// replaced some conditional compilation symbols by more appropriate ones +// +end. diff --git a/official/1.96/source/common/JclZLib.int b/official/1.96/source/common/JclZLib.int new file mode 100644 index 0000000..90a90d4 --- /dev/null +++ b/official/1.96/source/common/JclZLib.int @@ -0,0 +1,349 @@ +unit JclZLib; + +const + JclZLibStreamDefaultBufferSize = 32 * 1024; + +const + {$IFDEF MSWINDOWS} + JclZLibDefaultLineSeparator = #$0D#$0A; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + JclZLibDefaultLineSeparator = #$0A; + {$ENDIF UNIX} + +const + WindowsPathDelimiter = '\'; + UnixPathDelimiter = '/'; + {$IFNDEF RTL140_UP} + {$IFDEF MSWINDOWS} + PathDelim = WindowsPathDelimiter; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + PathDelim = UnixPathDelimiter; + {$ENDIF UNIX} + {$ENDIF ~RTL140_UP} + +//-------------------------------------------------------------------------------------------------- +// zlib format support +//-------------------------------------------------------------------------------------------------- + +type + TJclZLibStream = class(TStream) + protected + FStream: TStream; + FBufferSize: Integer; + FBuffer: Pointer; + FZLibStream: TZStreamRec; + procedure SetSize(NewSize: Longint); override; + public + constructor Create(const Stream: TStream; const BufferSize: Integer); + destructor Destroy; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + end; + + TJclZLibReader = class(TJclZLibStream) + protected + FEndOfStream: Boolean; + procedure ReadNextBlock; + procedure FinishZLibStream; + public + constructor Create(const Stream: TStream; + const BufferSize: Integer = JclZLibStreamDefaultBufferSize; + const WindowBits: Integer = DEF_WBITS); + + destructor Destroy; override; + + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + + procedure Reset; + procedure SyncZLibStream; + + property EndOfStream: Boolean read FEndOfStream; + end; + + TJclZLibWriter = class(TJclZLibStream) + protected + procedure WriteNextBlock; + procedure FlushZLibStream(const Flush: Integer); + public + constructor Create(const Stream: TStream; + const BufferSize: Integer = JclZLibStreamDefaultBufferSize; + const Level: Integer = Z_DEFAULT_COMPRESSION; + const Strategy: Integer = Z_DEFAULT_STRATEGY; + const WindowBits: Integer = DEF_WBITS); + + destructor Destroy; override; + + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + + procedure Reset; + end; + + EJclZLibError = class(EJclError); + +// zlib error texts +function GetZLibErrorText(const ErrorCode: Integer): PResStringRec; + +function ZLibCompressMem(const Src: Pointer; SrcLen: Integer; + out Dst: Pointer; out DstLen: Integer; out DstCapacity: Integer; + const Level: Integer = Z_DEFAULT_COMPRESSION): Boolean; + +// Flush: +// Z_SYNC_FLUSH: DstCapacity can be 0 +// Z_FINISH: decompress with faster routine in a single step +// DstCapacity must be >= uncompressed size +function ZLibDecompressMem(const Src: Pointer; SrcLen: Integer; + out Dst: Pointer; out DstLen: Integer; var DstCapacity: Integer; + const Flush: Integer = Z_SYNC_FLUSH): Boolean; + +type + TJclGZipStream = class(TStream) + protected + FStream: TStream; + FCRC32: LongWord; + FUncompressedSize: LongWord; + procedure SetSize(NewSize: Longint); override; + public + constructor Create(const Stream: TStream); + destructor Destroy; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + end; + + TJclGZipReader = class(TJclGZipStream) + private + FZLibReader: TJclZLibReader; + FTextMode: Boolean; + FFilename: string; + FComment: string; + FTimeStamp: TJclUnixTime32; + FLevel: Integer; + FOperatingSystem: Byte; + FMultipartNumber: Word; + FExtraField: Pointer; + FExtraFieldSize: Integer; + FEndOfStream: Boolean; + public + constructor Create(const Stream: TStream; + const BufferSize: Integer = JclZLibStreamDefaultBufferSize; + const LineSeparator: string = JclZLibDefaultLineSeparator); + + destructor Destroy; override; + + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + + property TextMode: Boolean read FTextMode; + property Filename: string read FFilename; + property Comment: string read FComment; + property TimeStamp: TJclUnixTime32 read FTimeStamp; + property Level: Integer read FLevel; + property OperatingSystem: Byte read FOperatingSystem; + property MultipartNumber: Word read FMultipartNumber; // 0 = first part + property ExtraField: Pointer read FExtraField; + property ExtraFieldSize: Integer read FExtraFieldSize; + + property EndOfStream: Boolean read FEndOfStream; + end; + + TJclGZipWriter = class(TJclGZipStream) + private + FTextMode: Boolean; + FZLibWriter: TJclZLibWriter; + public + constructor Create(const Stream: TStream; + const BufferSize: Integer = JclZLibStreamDefaultBufferSize; + const Level: Integer = Z_DEFAULT_COMPRESSION; + const Strategie: Integer = Z_DEFAULT_STRATEGY; + const Filename: string = ''; + const TimeStamp: TJclUnixTime32 = 0; + const Comment: string = ''; + const TextMode: Boolean = False; + const ExtraField: Pointer = nil; + const ExtraFieldSize: Integer = 0); + + destructor Destroy; override; + + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + end; + + EJclGZipError = class(EJclError); + +// gzip file extension +const + JclGZipDefaultFileExtension = '.gz'; + +// if DstFilename = '' -> DstFilename := SrcFilename + JclGZipDefaultFileExtension +procedure GZipCompressFile(const SrcFilename: string; DstFilename: string; + const Level: Integer = Z_DEFAULT_COMPRESSION); +procedure GZipDecompressFile(const SrcFilename: string; DstFilename: string); + +const + TarBlockSize = 512; + +type + TTarArchiveFormat = ( + tafDefaultFormat, // format to be decided later + tafV7Format, // old V7 tar format + tafOldGnuFormat, // GNU format as per before tar 1.12 + tafPosixFormat, // restricted, pure POSIX format + tafGnuFormat); // POSIX format with GNU extensions + +type + PSparse = ^TSparse; + TSparse = packed record // offset + Offset: array [0..11] of AnsiChar; // $00 + NumBytes: array [0..11] of AnsiChar; // $0C + end; // $18 + + PTarHeader = ^TTarHeader; + TTarHeader = packed record // offset + case Integer of + 0: (Buffer: array [0..TarBlockSize - 1] of Byte); + 1: ( + // Old UNIX TAR format + Name: array [0..99] of AnsiChar; // $000 Char + #0 / mit 0 gefüllt + Mode: array [0..7] of AnsiChar; // $064 Octal + ' '#0 9 + 3 bits 20 34 30 37 35 35 20 00 + UID: array [0..7] of AnsiChar; // $06C Octal + ' '#0 ignore on DOS 20 20 31 37 35 36 20 00 + GID: array [0..7] of AnsiChar; // $074 Octal + ' '#0 ignore on DOS 20 20 20 31 34 34 20 00 + Size: array [0..11] of AnsiChar; // $07C Octal + ' ' size in bytes 20 20 20 20 20 20 20 20 20 20 30 20 + MTime: array [0..11] of AnsiChar; // $088 Octal + ' ' last modify Unix 20 36 37 32 32 34 34 36 31 30 37 20 + Chksum: array [0..7] of AnsiChar; // $094 Octal + ' '#0 >= 17 bit, init 0, add 20 20 37 35 37 32 00 20 + TypeFlag: AnsiChar; // $09C Octal + ' '#0 ?? 35 + Linkname: array [0..99] of AnsiChar; // $09D Char + #0 + // Extension of POSIX P1003.1 + Magic: array [0..5] of AnsiChar; // $101 Char + #0 75 73 74 61 72 20 + Version: array [0..1] of AnsiChar; // $107 Octal + ' ' 20 00 + UName: array [0..31] of AnsiChar; // $109 Char + #0 72 63 64 00 ... + GName: array [0..31] of AnsiChar; // $129 Char + #0 75 73 65 72 73 00 ... + DevMajor: array [0..7] of AnsiChar; // $149 Octal + ' '#0 + DevMinor: array [0..7] of AnsiChar; // $151 Octal + ' '#0 + case TTarArchiveFormat of + tafV7Format: ( + FillV7: array [0..166] of AnsiChar); // $159 + tafPosixFormat: ( + Prefix: array [0..154] of AnsiChar; // $159 Prefix for name + FillPosix: array [0..11] of AnsiChar); // $1F4 + tafOldGnuFormat: ( + ATime: array [0..11] of AnsiChar; // $159 + CTime: array [0..11] of AnsiChar; // $165 + Offset: array [0..11] of AnsiChar; // $171 + Longnames: array [0..3] of AnsiChar; // $17D + Pad: AnsiChar; // $181 + Sparses: array [0..3] of TSparse; // $182 + IsExtended: AnsiChar; // $1E2 + RealSize: array [0..11] of AnsiChar; // $1E3 + FillGnu: array [0..16] of AnsiChar)); // $1EF + end; // $200 + +// ModeFlag Flags +type + TTarMode = ( + tmOtherExec, // execute/search by other + tmOtherWrite, // write by other + tmOtherRead, // read by other + tmGroupExec, // execute/search by group + tmGroupWrite, // write by group + tmGroupRead, // read by group + tmOwnerExec, // execute/search by owner + tmOwnerWrite, // write by owner + tmOwnerRead, // read by owner + tmSaveText, // reserved + tmSetGID, // set GID on execution + tmSetUID); // set UID on execution + TTarModes = set of TTarMode; + +// TypeFlag +type + TTarTypeFlag = AnsiChar; + +const // V7 Posix + ttfRegFile = '0'; // regular file x x + ttfARegFile = #0; // regular file x x + ttfLink = '1'; // link x x + ttfSymbolicLink = '2'; // symbolic link x + ttfCharacter = '3'; // character special x + ttfBlock = '4'; // block special x + ttfDirectory = '5'; // directory x + ttfFIFO = '6'; // FIFO special x + ttfContiguous = '7'; // contiguous file + + // GNU extensions + ttfGnuDumpDir = 'D'; + ttfGnuLongLink = 'K'; // next file have a long link name + ttfGnuLongName = 'L'; // next file have a long name + ttfGnuMultiVol = 'M'; // file began on another volume + ttfGnuNames = 'N'; // long filename + ttfGnuSparse = 'S'; // sparse files + ttfGnuVolHeader = 'V'; // Volume label (must be the first file) + +const + TarOldGnuMagic = 'ustar '#0; // old GNU Magic + Version + TarPosixMagic = 'ustar'#0; // Posix or GNU + TarGnuVersion = '00'; + + // other version for GNU-Magic: 'GNUtar '#0 + +type + TJclTarFileType = (tftUnknown, tftEof, tftFile, tftDirectory); + + TJclTarFileSize = Int64; + + + TJclTarReader = class(TObject) + private + function GetFileDateTime: TDateTime; + protected + FTarStream: TStream; + FHeader: TTarHeader; + FArchiveFormat: TTarArchiveFormat; + FFileType: TJclTarFileType; + FFilename: string; + FFileSize: TJclTarFileSize; + FFileTime: TJclUnixTime32; + function ReadHeader: Boolean; // False if Eof + procedure ScanHeader; + public + constructor Create(const TarStream: TStream); + procedure CopyToStream(const FileStream: TStream; CanSeek: Boolean = False); + procedure CopyToFile(const FilePath: string); + procedure SkipFile; + procedure SkipFileSeek; + property FileType: TJclTarFileType read FFileType; + property Filename: string read FFilename; + property FileSize: TJclTarFileSize read FFileSize; + property FileTime: TJclUnixTime32 read FFileTime; + property FileDateTime: TDateTime read GetFileDateTime; + end; + + TJclTarWriter = class(TObject) + protected + FTarStream: TStream; + procedure AddEof; + public + constructor Create(const TarStream: TStream); + destructor Destroy; override; + procedure AddFile(FileRoot, Filename: string); + procedure AddStream(const Stream: TStream; Filename: string; + FileSize: TJclTarFileSize; FileTime: TJclUnixTime32); + procedure AddDirectory(DirName: string); + end; + + EJclTarError = class(EJclError); + +procedure TarAllFiles(const TarFilename, FileRoot: string); +procedure TarFileList(const TarFilename, FileRoot: string; List: TStrings); +procedure TarFileArray(const TarFilename, FileRoot: string; const Filenames: array of string); +procedure TarGZipAllFiles(const TgzFilename, FileRoot: string); +procedure TarGZipFileList(const TgzFilename, FileRoot: string; List: TStrings); +procedure TarGZipFileArray(const TgzFilename, FileRoot: string; const Filenames: array of string); + +procedure UnTarAllFiles(const TarFilename: string; DstDir: string); +procedure UnGZipTarAllFiles(const TgzFilename: string; DstDir: string); + +procedure GetFileList(RootDir: string; List: TStrings); + diff --git a/official/1.96/source/common/dirinfo.txt b/official/1.96/source/common/dirinfo.txt new file mode 100644 index 0000000..f3b0ae3 --- /dev/null +++ b/official/1.96/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/official/1.96/source/common/pcre.pas b/official/1.96/source/common/pcre.pas new file mode 100644 index 0000000..c4f2682 --- /dev/null +++ b/official/1.96/source/common/pcre.pas @@ -0,0 +1,435 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{ 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 } +{ } +{ Unit owner: Peter Thornqvist } +{ Last modified: $Date: 2004/11/06 02:19:34 $ } +{ } +{**************************************************************************************************} + +unit pcre; + +{$I jedi.inc} + +interface + +(************************************************* +* Perl-Compatible Regular Expressions * +*************************************************) + +{$WEAKPACKAGEUNIT ON} + +// (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 + +{$DEFINE PCRE_LINKONREQUEST} +(*$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 = $0001; + {$EXTERNALSYM PCRE_CASELESS} + PCRE_MULTILINE = $0002; + {$EXTERNALSYM PCRE_MULTILINE} + PCRE_DOTALL = $0004; + {$EXTERNALSYM PCRE_DOTALL} + PCRE_EXTENDED = $0008; + {$EXTERNALSYM PCRE_EXTENDED} + PCRE_ANCHORED = $0010; + {$EXTERNALSYM PCRE_ANCHORED} + PCRE_DOLLAR_ENDONLY = $0020; + {$EXTERNALSYM PCRE_DOLLAR_ENDONLY} + PCRE_EXTRA = $0040; + {$EXTERNALSYM PCRE_EXTRA} + PCRE_NOTBOL = $0080; + {$EXTERNALSYM PCRE_NOTBOL} + PCRE_NOTEOL = $0100; + {$EXTERNALSYM PCRE_NOTEOL} + PCRE_UNGREEDY = $0200; + {$EXTERNALSYM PCRE_UNGREEDY} + PCRE_NOTEMPTY = $0400; + {$EXTERNALSYM PCRE_NOTEMPTY} + PCRE_UTF8 = $0800; + {$EXTERNALSYM PCRE_UTF8} + + (* 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} + + (* 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} + +type + (* Types *) + PPChar = ^PChar; + PPPChar = ^PPChar; + PInteger = ^Integer; + PPointer = ^Pointer; + + real_pcre = record + magic_number: Longword; + size: Integer; + tables: PChar; + options: Longword; + top_bracket: Word; + top_backref: word; + first_char: PChar; + req_char: PChar; + code: array [0..0] of Char; + end; + {$EXTERNALSYM real_pcre} + TPCRE = real_pcre; + PPCRE = ^TPCRE; + + real_pcre_extra = record + options: PChar; + start_bits: array [0..31] of Char; + end; +{$EXTERNALSYM real_pcre_extra} + TPCREExtra = real_pcre_extra; + PPCREExtra = ^TPCREExtra; + +(* Functions *) +{$IFNDEF PCRE_LINKONREQUEST} + +function pcre_compile(const pattern: PChar; options: Integer; + const errptr: PPChar; erroffset: PInteger; const tableptr: PChar): PPCRE; cdecl; +{$EXTERNALSYM pcre_compile} +function pcre_copy_substring(const subject: PChar; ovector: PInteger; stringcount, stringnumber: Integer; + buffer: PChar; buffersize: Integer): Integer; cdecl; +{$EXTERNALSYM pcre_copy_substring} +function pcre_exec(const code: PPCRE; const extra: PPCREExtra; const subject: PChar; +{$EXTERNALSYM pcre_exec} + length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; cdecl; +function pcre_study(const code: PPCRE; options: Integer; const errptr: PPChar): PPCREExtra; cdecl; +{$EXTERNALSYM pcre_study} +function pcre_get_substring(const subject: PChar; ovector: PInteger; +{$EXTERNALSYM pcre_get_substring} + stringcount, stringnumber: Integer; const stringptr: PPChar): Integer; cdecl; +function pcre_get_substring_list(const subject: PChar; ovector: PInteger; + stringcount: Integer; listptr: PPPChar): Integer; cdecl; +{$EXTERNALSYM pcre_get_substring_list} +procedure pcre_free_substring(var stringptr: PChar); cdecl; +{$EXTERNALSYM pcre_free_substring} +procedure pcre_free_substring_list(var stringptr: PChar); cdecl; +{$EXTERNALSYM pcre_free_substring_list} +function pcre_maketables: PChar; cdecl; +{$EXTERNALSYM pcre_maketables} +function pcre_fullinfo(const code: PPCRE; const extra: PPCREExtra; + what: Integer; where: Pointer): Integer; cdecl; +{$EXTERNALSYM pcre_fullinfo} +function pcre_info(const code: PPCRE; optptr, firstcharptr: PInteger): Integer; cdecl; +{$EXTERNALSYM pcre_info} +function pcre_version: PChar; cdecl; +{$EXTERNALSYM pcre_version} + +// Don't use! These do *not* work!!! +function pcre_malloc(Size: Integer): Pointer; cdecl; +{$EXTERNALSYM pcre_malloc} +procedure pcre_free(P: Pointer); cdecl; +{$EXTERNALSYM pcre_free} + +{$ELSE} + // dynamic linking +type + TPCRELibNotLoadedHandler = procedure; cdecl; + pcre_compile_func = function(const pattern: PChar; options: Integer; + const errptr: PPChar; erroffset: PInteger; const tableptr: PChar): PPCRE; cdecl; + pcre_copy_substring_func = function(const subject: PChar; ovector: PInteger; stringcount, stringnumber: Integer; + buffer: PChar; buffersize: Integer): Integer; cdecl; + pcre_exec_func = function(const code: PPCRE; const extra: PPCREExtra; const subject: PChar; + length, startoffset, options: Integer; ovector: PInteger; ovecsize: Integer): Integer; cdecl; + pcre_study_func = function(const code: PPCRE; options: Integer; const errptr: PPChar): PPCREExtra; cdecl; + pcre_get_substring_func = function(const subject: PChar; ovector: PInteger; + stringcount, stringnumber: Integer; const stringptr: PPChar): Integer; cdecl; + pcre_get_substring_list_func = function(const subject: PChar; ovector: PInteger; + stringcount: Integer; listptr: PPPChar): Integer; cdecl; + pcre_free_substring_func = procedure(var stringptr: PChar); cdecl; + pcre_free_substring_list_func = procedure(var stringptr: PChar); cdecl; + pcre_maketables_func = function: PChar; cdecl; + pcre_fullinfo_func = function(const code: PPCRE; const extra: PPCREExtra; + what: Integer; where: Pointer): Integer; cdecl; + pcre_info_func = function(const code: PPCRE; optptr, firstcharptr: PInteger): Integer; cdecl; + pcre_version_func = function: PChar; cdecl; + + pcre_malloc_func = function(Size: Integer): Pointer; cdecl; + pcre_free_func = procedure(P: Pointer); cdecl; +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; + + pcre_compile: pcre_compile_func = nil; + {$EXTERNALSYM pcre_compile} + pcre_copy_substring: pcre_copy_substring_func = nil; + {$EXTERNALSYM pcre_copy_substring} + pcre_exec: pcre_exec_func = nil; + {$EXTERNALSYM pcre_exec} + pcre_study: pcre_study_func = nil; + {$EXTERNALSYM pcre_study} + pcre_get_substring: pcre_get_substring_func = nil; + {$EXTERNALSYM pcre_get_substring} + pcre_get_substring_list: pcre_get_substring_list_func = nil; + {$EXTERNALSYM pcre_get_substring_list} + pcre_free_substring: pcre_free_substring_func = nil; + {$EXTERNALSYM pcre_free_substring} + pcre_free_substring_list: pcre_free_substring_list_func = nil; + {$EXTERNALSYM pcre_free_substring_list} + pcre_maketables: pcre_maketables_func = nil; + {$EXTERNALSYM pcre_maketables} + pcre_fullinfo: pcre_fullinfo_func = nil; + {$EXTERNALSYM pcre_fullinfo} + pcre_info: pcre_info_func = nil; + {$EXTERNALSYM pcre_info} + pcre_version: pcre_version_func = nil; + {$EXTERNALSYM pcre_version} + + // Don't use! These don't work!!! + pcre_malloc: pcre_malloc_func = nil; + {$EXTERNALSYM pcre_malloc} + pcre_free: pcre_free_func = nil; + {$EXTERNALSYM pcre_free} + +{$ENDIF ~PCRE_LINKONREQUEST} + +function IsPCRELoaded: Boolean; +function LoadPCRE: Boolean; +procedure UnloadPCRE; + +implementation + +uses + {$IFDEF MSWINDOWS} + Windows; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + {$IFDEF HAS_UNIT_TYPES} + Types, + {$ENDIF HAS_UNIT_TYPES} + {$IFDEF HAS_UNIT_LIBC} + Libc; + {$ELSE ~HAS_UNIT_LIBC} + dl; + {$ENDIF ~HAS_UNIT_LIBC} + {$ENDIF UNIX} + +type + {$IFDEF MSWINDOWS} + TModuleHandle = HINST; + {$ENDIF MSWINDOWS} + {$IFDEF LINUX} + TModuleHandle = Pointer; + {$ENDIF LINUX} + +const + {$IFDEF MSWINDOWS} + libpcremodulename = 'pcre.dll'; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + libpcremodulename = 'libpcre.so.0'; + {$ENDIF UNIX} + INVALID_MODULEHANDLE_VALUE = TModuleHandle(0); + +{$IFDEF PCRE_LINKONREQUEST} +var + PCRELib: TModuleHandle = INVALID_MODULEHANDLE_VALUE; + +procedure InitPCREFuncPtrs(const Value: Pointer); +begin + @pcre_compile := Value; + @pcre_copy_substring := Value; + @pcre_exec := Value; + @pcre_study := Value; + @pcre_get_substring := Value; + @pcre_get_substring_list := Value; + @pcre_free_substring := Value; + @pcre_free_substring_list := Value; + @pcre_maketables := Value; + @pcre_fullinfo := Value; + @pcre_info := Value; + @pcre_version := Value; + + @pcre_malloc := Value; + @pcre_free := Value; +end; +{$ENDIF PCRE_LINKONREQUEST} + +function IsPCRELoaded: Boolean; +begin + {$IFDEF PCRE_LINKONREQUEST} + Result := PCRELib <> INVALID_MODULEHANDLE_VALUE; + {$ELSE} + Result := True; + {$ENDIF PCRE_LINKONREQUEST} +end; + +function LoadPCRE: Boolean; + + function GetSymbol(SymbolName: PChar): Pointer; + begin + {$IFDEF MSWINDOWS} + Result := GetProcAddress(PCRELib, PChar(SymbolName)); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + Result := dlsym(PCRELib, PChar(SymbolName)); + {$ENDIF UNIX} + end; + +begin + Result := PCRELib <> INVALID_MODULEHANDLE_VALUE; + if Result then + Exit; + {$IFDEF PCRE_LINKONREQUEST} + if PCRELib = INVALID_MODULEHANDLE_VALUE then + {$IFDEF MSWINDOWS} + PCRELib := LoadLibrary(libpcremodulename); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + PCRELib := dlopen(PChar(libpcremodulename), RTLD_NOW); + {$ENDIF UNIX} + Result := PCRELib <> INVALID_MODULEHANDLE_VALUE; + if Result then + begin + @pcre_compile := GetSymbol('pcre_compile'); + @pcre_copy_substring := GetSymbol('pcre_copy_substring'); + @pcre_exec := GetSymbol('pcre_exec'); + @pcre_study := GetSymbol('pcre_study'); + @pcre_get_substring := GetSymbol('pcre_get_substring'); + @pcre_get_substring_list := GetSymbol('pcre_get_substring_list'); + @pcre_free_substring := GetSymbol('pcre_free_substring'); + @pcre_free_substring_list := GetSymbol('pcre_free_substring_list'); + @pcre_maketables := GetSymbol('pcre_maketables'); + @pcre_fullinfo := GetSymbol('pcre_fullinfo'); + @pcre_info := GetSymbol('pcre_info'); + @pcre_version := GetSymbol('pcre_version'); + + @pcre_malloc := GetSymbol('pcre_malloc'); + @pcre_free := GetSymbol('pcre_free'); + end + else + InitPCREFuncPtrs(@LibNotLoadedHandler); + {$ELSE} + Result := True; + {$ENDIF PCRE_LINKONREQUEST} +end; + +procedure UnloadPCRE; +begin + {$IFDEF PCRE_LINKONREQUEST} + if PCRELib <> INVALID_MODULEHANDLE_VALUE then + {$IFDEF MSWINDOWS} + FreeLibrary(PCRELib); + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + dlclose(Pointer(PCRELib)); + {$ENDIF UNIX} + PCRELib := INVALID_MODULEHANDLE_VALUE; + InitPCREFuncPtrs(@LibNotLoadedHandler); + {$ENDIF PCRE_LINKONREQUEST} +end; + +{$IFNDEF PCRE_LINKONREQUEST} +function pcre_compile; external libpcremodulename name 'pcre_compile'; +function pcre_copy_substring; external libpcremodulename name 'pcre_copy_substring'; +function pcre_exec; external libpcremodulename name 'pcre_exec'; +function pcre_study; external libpcremodulename name 'pcre_study'; +function pcre_get_substring; external libpcremodulename name 'pcre_get_substring'; +function pcre_get_substring_list; external libpcremodulename name 'pcre_get_substring_list'; +procedure pcre_free_substring; external libpcremodulename name 'pcre_free_substring'; +procedure pcre_free_substring_list; external libpcremodulename name 'pcre_free_substring_list'; +function pcre_maketables; external libpcremodulename name 'pcre_maketables'; +function pcre_fullinfo; external libpcremodulename name 'pcre_fullinfo'; +function pcre_info; external libpcremodulename name 'pcre_info'; +function pcre_version; external libpcremodulename name 'pcre_version'; +function pcre_malloc; external libpcremodulename name 'pcre_malloc'; +procedure pcre_free; external libpcremodulename name 'pcre_free'; +{$ENDIF ~PCRE_LINKONREQUEST} + +// History + +// $Log: pcre.pas,v $ +// Revision 1.6 2004/11/06 02:19:34 rrossmair +// - bug fix (Windows: module handle was tested against INVALID_HANDLE_VALUE = -1, instead of 0) +// - better handling of calls into DLL when it got not loaded. +// +// Revision 1.5 2004/10/02 05:47:28 marquardt +// added check for incompatible jedi.inc +// replaced jedi.inc with jvcl.inc +// +// Revision 1.4 2004/07/27 06:42:23 marquardt +// style cleaning of pcre files +// +// Revision 1.3 2004/07/26 06:01:39 rrossmair +// *** empty log message *** +// +// Revision 1.2 2004/07/26 05:13:52 rrossmair +// made it compile under Kylix (no functional tests performed yet) +// + +end. + diff --git a/official/1.96/source/crossplatform.inc b/official/1.96/source/crossplatform.inc new file mode 100644 index 0000000..c74d692 --- /dev/null +++ b/official/1.96/source/crossplatform.inc @@ -0,0 +1,31 @@ +{----------------------------------------------------------------------------- +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/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed 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 Project JEDI's JVCL home page, +located at http://jvcl.sourceforge.net + +Known Issues: +-----------------------------------------------------------------------------} +// $Id: crossplatform.inc,v 1.2 2004/07/29 07:58:21 marquardt Exp $ + +// 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/official/1.96/source/fpctest.bat b/official/1.96/source/fpctest.bat new file mode 100644 index 0000000..a193c67 --- /dev/null +++ b/official/1.96/source/fpctest.bat @@ -0,0 +1,14 @@ +@echo Free Pascal Compiler test... +@echo For error messages, see fpctest.err. +@echo off +@if "%1"=="" goto usage +@if not exist %1. goto invpath +@del fpctest.err +@for %%f in (common\Jcl*.pas windows\Jcl*.pas) do make file=%%f fpc=%1 -fMakefile.fpc +@goto exit +:invpath +@echo invalid path "%1" +@goto exit +:usage +@echo usage: fpctest ^ +:exit \ No newline at end of file diff --git a/official/1.96/source/fpctestunit.bat b/official/1.96/source/fpctestunit.bat new file mode 100644 index 0000000..457e4a9 --- /dev/null +++ b/official/1.96/source/fpctestunit.bat @@ -0,0 +1,15 @@ +@echo Free Pascal Compiler test... +@echo For error messages, see fpctest.err. +@echo off +@if "%1"=="" goto usage +@if not exist %1. goto invpath +@del fpctest.err +@make file=%2 fpc=%1 -fMakefile.fpc +@type fpctest.err +@goto exit +:invpath +@echo invalid path "%1" +@goto exit +:usage +@echo usage: fpctest ^ ^ +:exit \ No newline at end of file diff --git a/official/1.96/source/jcl.inc b/official/1.96/source/jcl.inc new file mode 100644 index 0000000..6c1f156 --- /dev/null +++ b/official/1.96/source/jcl.inc @@ -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 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) } +{ } +{**************************************************************************************************} +{ } +{ This include file defines various JCL specific defines. The more generic defines are defined in } +{ the jedi.inc file which is shared with the JEDI VCL. } +{ } +{**************************************************************************************************} + +{$B-} // Boolean shortcut evaluation +{$H+} // Long strings +{$J-} // Read-only typed constants +{$T-} // Type checked pointers off + +{$I jedi.inc} // Pull in the JCL/J-VCL shared directives + +{$IFNDEF JEDI_INC} +ALERT_jedi_inc_incompatible +// secure against old versions of jedi.inc. +{$ENDIF ~JEDI_INC} + +// Math precision selection, mutually exclusive + +{$DEFINE MATH_EXTENDED_PRECISION} +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + +{$IFDEF MATH_DOUBLE_PRECISION} + {$UNDEF MATH_SINGLE_PRECISION} + {$UNDEF MATH_EXTENDED_PRECISION} +{$ENDIF} +{$IFDEF MATH_SINGLE_PRECISION} + {$UNDEF MATH_DOUBLE_PRECISION} + {$UNDEF MATH_EXTENDED_PRECISION} +{$ENDIF} + +{.$DEFINE MATH_EXT_EXTREMEVALUES} + +// JclHookExcept support for hooking exceptions from DLLs + +{.$DEFINE HOOK_DLL_EXCEPTIONS} + +{$IFDEF SUPPORTS_UNSAFE_WARNINGS} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} +{$ENDIF} + + +//Threadsafe directive (added for DCL support) +{.DEFINE THREADSAFE} + +// To exclude obsolete code from compilation, remove the point from the line below +{.$DEFINE DROP_OBSOLETE_CODE} + +{$IFNDEF DROP_OBSOLETE_CODE} + {$DEFINE KEEP_DEPRECATED} +{$ENDIF} + + + +{$IFDEF CLR} + {$WARN UNSAFE_TYPE ON} + {$WARN UNSAFE_CODE ON} + {$WARN UNSAFE_CAST ON} + {$WARN UNIT_PLATFORM OFF} + + {$DEFINE MSWINDOWS} + {$DEFINE PIC} + {$DEFINE PUREPASCAL} +{$ENDIF CLR} + +// $Log: jcl.inc,v $ +// Revision 1.14 2005/10/30 01:49:27 rrossmair +// - introduce KEEP_DEPRECATED as alias for ~DROP_OBSOLETE_CODE +// +// Revision 1.13 2005/05/05 20:08:47 ahuser +// JCL.NET support +// +// Revision 1.12 2005/03/14 08:46:54 rrossmair +// - check-in in preparation for release 1.95 +// +// Revision 1.11 2005/02/26 16:42:08 marquardt +// deactivated THREADSAFE and fixed bugs stemming from that +// +// Revision 1.10 2005/01/05 17:36:34 dade2004 +// Added THREADSAFE directive for DCL support +// +// Revision 1.10 2005/01/05 06:55:51 dade2004 +// Added THREADSAFE directive +// +// $Log: jcl.inc,v $ +// Revision 1.14 2005/10/30 01:49:27 rrossmair +// - introduce KEEP_DEPRECATED as alias for ~DROP_OBSOLETE_CODE +// +// Revision 1.13 2005/05/05 20:08:47 ahuser +// JCL.NET support +// +// Revision 1.12 2005/03/14 08:46:54 rrossmair +// - check-in in preparation for release 1.95 +// +// Revision 1.11 2005/02/26 16:42:08 marquardt +// deactivated THREADSAFE and fixed bugs stemming from that +// +// Revision 1.10 2005/01/05 17:36:34 dade2004 +// Added THREADSAFE directive for DCL support +// +// Revision 1.9 2004/10/17 06:55:51 rrossmair +// cleanup +// +// Revision 1.8 2004/10/02 05:47:28 marquardt +// added check for incompatible jedi.inc +// replaced jedi.inc with jvcl.inc +// +// Revision 1.7 2004/07/29 07:58:21 marquardt +// inc files updated +// +// Revision 1.6 2004/06/02 03:17:02 rrossmair +// added DROP_OBSOLETE_CODE comment +// +// Revision 1.5 2004/05/31 22:28:39 rrossmair +// header updated according to new policy: initial developers & contributors listed +// + diff --git a/official/1.96/source/jedi.inc b/official/1.96/source/jedi.inc new file mode 100644 index 0000000..9675c44 --- /dev/null +++ b/official/1.96/source/jedi.inc @@ -0,0 +1,1288 @@ +{$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 (J-VCL). 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: 2005/12/04 10:10:58 $ +// For history see end of file + +(* + +- 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 + MSWINDOWS Defined when target platform is 32 bit Windows + LINUX Defined when target platform is Linux + UNIX Defined when target platform is Linux or Unix + + +- 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 + DELPHI2 Defined when compiling with Delphi 2 + DELPHI3 Defined when compiling with Delphi 3 + DELPHI4 Defined when compiling with Delphi 4 + DELPHI5 Defined when compiling with Delphi 5 + DELPHI6 Defined when compiling with Delphi 6 + DELPHI7 Defined when compiling with Delphi 7 + DELPHI8 Defined when compiling with Delphi 8 + DELPHI2005 Defined when compiling with Delphi 2005 + DELPHI9 Alias for DELPHI2005 + DELPHI10 Defined when compiling with Delphi Personality of BDS 4.0 + 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 Personality of BDS 4.0 + + +- 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 + 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 + 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 Personality of BDS 4.0 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 + BCB6 Defined when compiling with C++ Builder 6 + BCB10 Defined when compiling with C++ Builder Personality of BDS 4.0 + 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 + + +- 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 a Borland Developer Studio version's dcc32.exe + BDS2 Defined when compiling with BDS 2.0 (Delphi 8) + BDS3 Defined when compiling with BDS 3.0 (Delphi 2005) + BDS4 Defined when compiling with BDS 4.0 (Borland Developer Studio 2006) + 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 + +- 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 + 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 + + +- 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 later, Kylix 2 or later, C++ Builder 6 or later + ... + {$IFEND} + {$ENDIF} + + Directive Description + ------------------------------------------------------------------------------ + RTL80_UP Defined when compiling with Delphi 1 or later + RTL90_UP Defined when compiling with Delphi 2 or later + RTL93_UP Defined when compiling with C++ Builder 1 or later + RTL100_UP Defined when compiling with Delphi 3 or later + RTL110_UP Defined when compiling with C++ Builder 3 or later + RTL120_UP Defined when compiling with Delphi 4 or later + RTL125_UP Defined when compiling with C++ Builder 4 or later + RTL130_UP Defined when compiling with Delphi 5 or C++ Builder 5 or later + RTL140_UP Defined when compiling with Delphi 6, Kylix 1, 2 or 3 or C++ Builder 6 or later + RTL150_UP Defined when compiling with Delphi 7 or later + RTL160_UP Defined when compiling with Delphi 8 or later + RTL170_UP Defined when compiling with Delphi Personalities of BDS 3.0 or later + RTL180_UP Defined when compiling with Delphi or C++ Builder Personalities of BDS 4.0 or later + + +- 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_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+) + SUPPORTS_LOCAL Compiler supports the local directive (D6+/BCB6+) + SUPPORTS_INLINE Compiler supports the inline directive (D9+) + 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_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_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+) + ACCEPT_DEPRECATED Compiler supports or ignores the deprecated directive (D6+/BCB6+/FPC) + ACCEPT_PLATFORM Compiler supports or ignores the platform directive (D6+/BCB6+) + 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 + SUPPORTS_COMPILETIME_MESSAGES Compiler supports the MESSAGE directive + HAS_UNIT_LIBC Unit Libc exists (Kylix, FPC on Linux) + HAS_UNIT_RTLCONSTS Unit RTLConsts exists (D6+/BCB6+) + HAS_UNIT_TYPES Unit Types exists (D6+/BCB6+) + HAS_UNIT_VARIANTS Unit Variants exists (D6+/BCB6+) + HAS_UNIT_STRUTILS Unit StrUtils exists (D6+/BCB6+) + XPLATFORM_RTL The RTL supports crossplatform function names (e.g. RaiseLastOSError) (D6+/BCB6+/FPC) + + +- 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) + 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} + {$ASMMODE Intel} + {$UNDEF BORLAND} +{$ENDIF} + +{$IFDEF BORLAND} + {$IFDEF LINUX} + {$DEFINE KYLIX} + {$ENDIF LINUX} +{$ENDIF BORLAND} + +{------------------------------------------------------------------------------} +{ VERXXX to COMPILERX, DELPHIX and BCBX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF BORLAND} + {$IFDEF KYLIX} + {$I kylix.inc} // FPC incompatible stuff + {$ELSE ~KYLIX} + + {$IFDEF VER180} + {$DEFINE BDS4} + {$DEFINE BDS} + {$DEFINE COMPILER10} + {$IFDEF BCB} + {$DEFINE BCB10} + {$ELSE} + {$DEFINE DELPHI10} + {$DEFINE DELPHICOMPILER10} + {$ENDIF} + {$DEFINE RTL180_UP} + {$ENDIF} + + {$IFDEF VER170} + {$DEFINE BDS3} + {$DEFINE BDS} + {$DEFINE COMPILER9} + {$DEFINE DELPHI9} + {$DEFINE DELPHI2005} // synonym to DELPHI9 + {$DEFINE DELPHICOMPILER9} + {$DEFINE RTL170_UP} + {$ENDIF} + + {$IFDEF VER160} + {$DEFINE BDS2} + {$DEFINE BDS} + {$DEFINE COMPILER8} + {$DEFINE DELPHI8} + {$DEFINE DELPHICOMPILER8} + {$DEFINE RTL160_UP} + {$ENDIF} + + {$IFDEF VER150} + {$DEFINE COMPILER7} + {$DEFINE DELPHI7} + {$DEFINE DELPHICOMPILER7} + {$DEFINE RTL150_UP} + {$ENDIF} + + {$IFDEF VER140} + {$DEFINE COMPILER6} + {$IFDEF BCB} + {$DEFINE BCB6} + {$ELSE} + {$DEFINE DELPHI6} + {$DEFINE DELPHICOMPILER6} + {$ENDIF} + {$DEFINE RTL140_UP} + {$ENDIF} + + {$IFDEF VER130} + {$DEFINE COMPILER5} + {$IFDEF BCB} + {$DEFINE BCB5} + {$ELSE} + {$DEFINE DELPHI5} + {$DEFINE DELPHICOMPILER5} + {$ENDIF} + {$DEFINE RTL130_UP} + {$ENDIF} + + {$IFDEF VER125} + {$DEFINE COMPILER4} + {$DEFINE BCB4} + {$DEFINE BCB} + {$DEFINE RTL125_UP} + {$ENDIF} + + {$IFDEF VER120} + {$DEFINE COMPILER4} + {$DEFINE DELPHI4} + {$DEFINE DELPHICOMPILER4} + {$DEFINE RTL120_UP} + {$ENDIF} + + {$IFDEF VER110} + {$DEFINE COMPILER35} + {$DEFINE BCB3} + {$DEFINE RTL110_UP} + {$ENDIF} + + {$IFDEF VER100} + {$DEFINE COMPILER3} + {$DEFINE DELPHI3} + {$DEFINE DELPHICOMPILER3} + {$DEFINE RTL100_UP} + {$ENDIF} + + {$IFDEF VER93} + {$DEFINE COMPILER2} + {$DEFINE BCB1} + {$DEFINE BCB} + {$DEFINE RTL93_UP} + {$ENDIF} + + {$IFDEF VER90} + {$DEFINE COMPILER2} + {$DEFINE DELPHI2} + {$DEFINE DELPHICOMPILER2} + {$DEFINE RTL90_UP} + {$ENDIF} + + {$IFDEF VER80} + {$DEFINE COMPILER1} + {$DEFINE DELPHI1} + {$DEFINE DELPHICOMPILER1} + {$DEFINE RTL80_UP} + {$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 DELPHI10} + {$DEFINE DELPHI10_UP} + {$DEFINE DELPHI2005_UP // synonym to DELPHI9_UP } + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI4_UP} + {$DEFINE DELPHI3_UP} + {$DEFINE DELPHI2_UP} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{$IFDEF DELPHI9} + {$DEFINE DELPHI2005_UP} // synonym to DELPHI9_UP + {$DEFINE DELPHI9_UP} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI4_UP} + {$DEFINE DELPHI3_UP} + {$DEFINE DELPHI2_UP} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{$IFDEF DELPHI8} + {$DEFINE DELPHI8_UP} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI4_UP} + {$DEFINE DELPHI3_UP} + {$DEFINE DELPHI2_UP} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{$IFDEF DELPHI7} + {$DEFINE DELPHI7_UP} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI4_UP} + {$DEFINE DELPHI3_UP} + {$DEFINE DELPHI2_UP} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{$IFDEF DELPHI6} + {$DEFINE DELPHI6_UP} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI4_UP} + {$DEFINE DELPHI3_UP} + {$DEFINE DELPHI2_UP} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{$IFDEF DELPHI5} + {$DEFINE DELPHI5_UP} + {$DEFINE DELPHI4_UP} + {$DEFINE DELPHI3_UP} + {$DEFINE DELPHI2_UP} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{$IFDEF DELPHI4} + {$DEFINE DELPHI4_UP} + {$DEFINE DELPHI3_UP} + {$DEFINE DELPHI2_UP} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{$IFDEF DELPHI3} + {$DEFINE DELPHI3_UP} + {$DEFINE DELPHI2_UP} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{$IFDEF DELPHI2} + {$DEFINE DELPHI2_UP} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{$IFDEF DELPHI1} + {$DEFINE DELPHI1_UP} +{$ENDIF} + +{------------------------------------------------------------------------------} +{ KYLIXX_UP from KYLIXX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF KYLIX3} + {$DEFINE KYLIX3_UP} + {$DEFINE KYLIX2_UP} + {$DEFINE KYLIX1_UP} +{$ENDIF} + +{$IFDEF KYLIX2} + {$DEFINE KYLIX2_UP} + {$DEFINE KYLIX1_UP} +{$ENDIF} + +{$IFDEF KYLIX1} + {$DEFINE KYLIX1_UP} +{$ENDIF} + +{------------------------------------------------------------------------------} +{ BCBX_UP from BCBX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF BCB10} + {$DEFINE BCB10_UP} + {$DEFINE BCB6_UP} + {$DEFINE BCB5_UP} + {$DEFINE BCB4_UP} + {$DEFINE BCB3_UP} + {$DEFINE BCB1_UP} +{$ENDIF} + +{$IFDEF BCB6} + {$DEFINE BCB6_UP} + {$DEFINE BCB5_UP} + {$DEFINE BCB4_UP} + {$DEFINE BCB3_UP} + {$DEFINE BCB1_UP} +{$ENDIF} + +{$IFDEF BCB5} + {$DEFINE BCB5_UP} + {$DEFINE BCB4_UP} + {$DEFINE BCB3_UP} + {$DEFINE BCB1_UP} +{$ENDIF} + +{$IFDEF BCB4} + {$DEFINE BCB4_UP} + {$DEFINE BCB3_UP} + {$DEFINE BCB1_UP} +{$ENDIF} + +{$IFDEF BCB3} + {$DEFINE BCB3_UP} + {$DEFINE BCB1_UP} +{$ENDIF} + +{$IFDEF BCB1} + {$DEFINE BCB1_UP} +{$ENDIF} + +{------------------------------------------------------------------------------} +{ BDSX_UP from BDSX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF BDS4} + {$DEFINE BDS4_UP} + {$DEFINE BDS3_UP} + {$DEFINE BDS2_UP} +{$ENDIF} + +{$IFDEF BDS3} + {$DEFINE BDS3_UP} + {$DEFINE BDS2_UP} +{$ENDIF} + +{$IFDEF BDS2} + {$DEFINE BDS2_UP} +{$ENDIF} + +{------------------------------------------------------------------------------} +{ DELPHICOMPILERX_UP from DELPHICOMPILERX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF DELPHICOMPILER10} + {$DEFINE DELPHICOMPILER10_UP} + {$DEFINE DELPHICOMPILER9_UP} + {$DEFINE DELPHICOMPILER8_UP} + {$DEFINE DELPHICOMPILER7_UP} + {$DEFINE DELPHICOMPILER6_UP} + {$DEFINE DELPHICOMPILER5_UP} + {$DEFINE DELPHICOMPILER4_UP} + {$DEFINE DELPHICOMPILER3_UP} + {$DEFINE DELPHICOMPILER2_UP} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{$IFDEF DELPHICOMPILER9} + {$DEFINE DELPHICOMPILER9_UP} + {$DEFINE DELPHICOMPILER8_UP} + {$DEFINE DELPHICOMPILER7_UP} + {$DEFINE DELPHICOMPILER6_UP} + {$DEFINE DELPHICOMPILER5_UP} + {$DEFINE DELPHICOMPILER4_UP} + {$DEFINE DELPHICOMPILER3_UP} + {$DEFINE DELPHICOMPILER2_UP} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{$IFDEF DELPHICOMPILER8} + {$DEFINE DELPHICOMPILER8_UP} + {$DEFINE DELPHICOMPILER7_UP} + {$DEFINE DELPHICOMPILER6_UP} + {$DEFINE DELPHICOMPILER5_UP} + {$DEFINE DELPHICOMPILER4_UP} + {$DEFINE DELPHICOMPILER3_UP} + {$DEFINE DELPHICOMPILER2_UP} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{$IFDEF DELPHICOMPILER7} + {$DEFINE DELPHICOMPILER7_UP} + {$DEFINE DELPHICOMPILER6_UP} + {$DEFINE DELPHICOMPILER5_UP} + {$DEFINE DELPHICOMPILER4_UP} + {$DEFINE DELPHICOMPILER3_UP} + {$DEFINE DELPHICOMPILER2_UP} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{$IFDEF DELPHICOMPILER6} + {$DEFINE DELPHICOMPILER6_UP} + {$DEFINE DELPHICOMPILER5_UP} + {$DEFINE DELPHICOMPILER4_UP} + {$DEFINE DELPHICOMPILER3_UP} + {$DEFINE DELPHICOMPILER2_UP} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{$IFDEF DELPHICOMPILER5} + {$DEFINE DELPHICOMPILER5_UP} + {$DEFINE DELPHICOMPILER4_UP} + {$DEFINE DELPHICOMPILER3_UP} + {$DEFINE DELPHICOMPILER2_UP} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{$IFDEF DELPHICOMPILER4} + {$DEFINE DELPHICOMPILER4_UP} + {$DEFINE DELPHICOMPILER3_UP} + {$DEFINE DELPHICOMPILER2_UP} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{$IFDEF DELPHICOMPILER3} + {$DEFINE DELPHICOMPILER3_UP} + {$DEFINE DELPHICOMPILER2_UP} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{$IFDEF DELPHICOMPILER2} + {$DEFINE DELPHICOMPILER2_UP} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{$IFDEF DELPHICOMPILER1} + {$DEFINE DELPHICOMPILER1_UP} +{$ENDIF} + +{------------------------------------------------------------------------------} +{ COMPILERX_UP from COMPILERX mappings } +{------------------------------------------------------------------------------} + +{$IFDEF COMPILER10} + {$DEFINE COMPILER10_UP} + {$DEFINE COMPILER9_UP} + {$DEFINE COMPILER8_UP} + {$DEFINE COMPILER7_UP} + {$DEFINE COMPILER6_UP} + {$DEFINE COMPILER5_UP} + {$DEFINE COMPILER4_UP} + {$DEFINE COMPILER35_UP} + {$DEFINE COMPILER3_UP} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER9} + {$DEFINE COMPILER9_UP} + {$DEFINE COMPILER8_UP} + {$DEFINE COMPILER7_UP} + {$DEFINE COMPILER6_UP} + {$DEFINE COMPILER5_UP} + {$DEFINE COMPILER4_UP} + {$DEFINE COMPILER35_UP} + {$DEFINE COMPILER3_UP} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER8} + {$DEFINE COMPILER8_UP} + {$DEFINE COMPILER7_UP} + {$DEFINE COMPILER6_UP} + {$DEFINE COMPILER5_UP} + {$DEFINE COMPILER4_UP} + {$DEFINE COMPILER35_UP} + {$DEFINE COMPILER3_UP} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER7} + {$DEFINE COMPILER7_UP} + {$DEFINE COMPILER6_UP} + {$DEFINE COMPILER5_UP} + {$DEFINE COMPILER4_UP} + {$DEFINE COMPILER35_UP} + {$DEFINE COMPILER3_UP} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER6} + {$DEFINE COMPILER6_UP} + {$DEFINE COMPILER5_UP} + {$DEFINE COMPILER4_UP} + {$DEFINE COMPILER35_UP} + {$DEFINE COMPILER3_UP} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER5} + {$DEFINE COMPILER5_UP} + {$DEFINE COMPILER4_UP} + {$DEFINE COMPILER35_UP} + {$DEFINE COMPILER3_UP} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER4} + {$DEFINE COMPILER4_UP} + {$DEFINE COMPILER35_UP} + {$DEFINE COMPILER3_UP} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER35} + {$DEFINE COMPILER35_UP} + {$DEFINE COMPILER3_UP} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER3} + {$DEFINE COMPILER3_UP} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER2} + {$DEFINE COMPILER2_UP} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{$IFDEF COMPILER1} + {$DEFINE COMPILER1_UP} +{$ENDIF} + +{------------------------------------------------------------------------------} + +{$IFDEF DELPHICOMPILER} + {$DEFINE DELPHILANGUAGE} +{$ENDIF} + +{$IFDEF BCBCOMPILER} + {$DEFINE DELPHILANGUAGE} +{$ENDIF} + +{------------------------------------------------------------------------------} +{ RTLX_UP from RTLX_UP mappings } +{------------------------------------------------------------------------------} + +{$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} + +{------------------------------------------------------------------------------} +{ Map COMPILERX_UP to friendly feature names } +{------------------------------------------------------------------------------} + +{$IFDEF FPC} + {$IFDEF VER1_0} + Please use FPC 2.0 or later to compile this. + {$ELSE} + {$DEFINE SUPPORTS_OUTPARAMS} + {$DEFINE SUPPORTS_WIDECHAR} + {$DEFINE SUPPORTS_WIDESTRING} + {$IFDEF HASINTF} + {$DEFINE SUPPORTS_INTERFACE} + {$ENDIF} + {$IFDEF HASVARIANT} + {$DEFINE SUPPORTS_VARIANT} + {$ENDIF} + {$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} + {$IFDEF HASCURRENCY} + {$DEFINE SUPPORTS_CURRENCY} + {$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} + {$DEFINE ACCEPT_PLATFORM} + {$DEFINE ACCEPT_LIBRARY} + {$DEFINE SUPPORTS_EXTSYM} + {$DEFINE SUPPORTS_NODEFINE} + + {$DEFINE SUPPORTS_CUSTOMVARIANTS} + {$DEFINE SUPPORTS_VARARGS} + {$DEFINE SUPPORTS_ENUMVALUE} + {$IFDEF LINUX} + {$DEFINE HAS_UNIT_LIBC} + {$ENDIF LINUX} + {$DEFINE HAS_UNIT_TYPES} + {$DEFINE HAS_UNIT_VARIANTS} + {$DEFINE HAS_UNIT_STRUTILS} + {$DEFINE HAS_UNIT_RTLCONSTS} + + {$DEFINE XPLATFORM_RTL} + + {$UNDEF SUPPORTS_DISPINTERFACE} + {$UNDEF SUPPORTS_IMPLEMENTS} + {$UNDEF SUPPORTS_UNSAFE_WARNINGS} + {$ENDIF} +{$ENDIF FPC} + +{$IFDEF COMPILER1_UP} + {$DEFINE SUPPORTS_CONSTPARAMS} + {$DEFINE SUPPORTS_SINGLE} + {$DEFINE SUPPORTS_DOUBLE} + {$DEFINE SUPPORTS_EXTENDED} +{$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 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} +{$ENDIF COMPILER7_UP} + +{$IFDEF COMPILER9_UP} + {$DEFINE SUPPORTS_FOR_IN} + {$DEFINE SUPPORTS_INLINE} + {$DEFINE SUPPORTS_NESTED_CONSTANTS} + {$DEFINE SUPPORTS_NESTED_TYPES} + {$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} +{$ENDIF COMPILER10_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 XPLATFORM_RTL} +{$ENDIF RTL140_UP} + +{------------------------------------------------------------------------------} +{ Cross-platform related defines } +{------------------------------------------------------------------------------} + +{$IFNDEF CPU386} + {$DEFINE PUREPASCAL} +{$ENDIF} + +{$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} {$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} +{ REALCOMPATIBILITY } +{$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} + +// History: + +// $Log: jedi.inc,v $ +// Revision 1.30 2005/12/04 10:10:58 obones +// Borland Developer Studio 2006 support +// +// Revision 1.29 2005/11/01 20:46:20 obones +// Removed COMPLIB_VCL and COMPLIB_VisualCLX, they are not used and obsolete +// +// Revision 1.28 2005/10/28 04:33:17 rrossmair +// - added BDS and BDSX_UP symbols +// +// Revision 1.27 2005/10/12 21:18:43 ahuser +// Moved comments out of the compiler directives. +// +// Revision 1.26 2005/09/03 15:46:42 marquardt +// new SUPPORTS_ added to description section +// +// Revision 1.25 2005/09/03 15:22:24 rrossmair +// - support for Delphi.NET personality syntax +// +// Revision 1.24 2005/08/22 01:43:02 rrossmair +// - added symbols Win32API, PUREPASCAL, DELPHI2005, DELPHI2005_UP +// - reworked/reformated some comments +// +// Revision 1.23 2005/04/15 08:27:38 marquardt +// introduced SUPPORTS_DISPID for FPC +// +// Revision 1.22 2005/04/07 00:41:35 rrossmair +// - changed for FPC 1.9.8 +// +// Revision 1.21 2005/02/22 07:36:46 marquardt +// introduced SUPPORTS_INLINE, minor cleanups in JclRegistry +// +// Revision 1.20 2004/11/18 00:57:13 rrossmair +// - check-in for release 1.93 +// +// Revision 1.19 2004/11/06 02:11:20 mthoma +// history cleaning. +// +// Revision 1.18 2004/08/10 02:52:02 rrossmair +// - moved {$ENDIF ~JEDI_INC} to EOF. +// +// Revision 1.17 2004/08/09 06:38:08 peter3 +// - D8 support added +// - D9 support added (guesswork) +// +// Revision 1.16 2004/07/29 17:12:28 rrossmair +// fixed comment ("KYLIXX_UP from KYLIXX mappings") +// +// Revision 1.15 2004/07/29 07:58:21 marquardt +// inc files updated +// +// Revision 1.14 2004/06/21 01:10:17 rrossmair +// - $IFDEFed contents (to prevent from repeated inclusion) +// - introduced symbols SUPPORTS_DEPRECATED_WARNINGS, SUPPORTS_LIBRARY_WARNINGS, SUPPORTS_PLATFORM_WARNINGS, SUPPORTS_COMPILETIME_MESSAGES +// - reordered pre-CVS history +// +// Revision 1.13 2004/05/08 08:44:20 rrossmair +// introduced & applied symbol HAS_UNIT_LIBC +// +// Revision 1.12 2004/05/06 05:03:59 rrossmair +// SUPPORTS_ENUMVALUE definition fixed for Free Pascal Compiler +// +// Revision 1.11 2004/05/05 03:20:13 rrossmair +// jedi.inc: moved FPC-incompatible Kylix-related code to separate include file "kylix.inc", disposed of FPC-related TODOs +// +// Revision 1.10 2004/05/01 00:03:59 rrossmair +// FPC workaround removed; didn't work with Kylix +// +// Revision 1.9 2004/04/30 18:25:15 rrossmair +// added symbols BORLAND, CPPBUILDER, BCBCOMPILER +// removed symbol NONBORLAND +// cleanup (reduced redundancy) +// corrected embarrassing typo "widestring's" (for the 3rd time, I believe) +// +// Revision 1.8 2004/04/14 20:26:33 mthoma +// Changed data to date +// Local is Delphi 6 - removed todo comment +// Replaced CLX with VisualCLX to be consistent with Borlands current definition of what "CLX" is. +// +// Revision 1.7 2004/04/06 05:06:12 +// add support for Kylix, FPC, RTL, versions, some speaking directives +// +// 2004-03-22, +// - add SUPPORTS_WEAKPACKAGEUNIT +// +// 2004-03-20, +// - add SUPPORTS_LOCAL +// +// 2004-03-18, +// - add SUPPORTS_LONGWORD +// +// 2004-03-16, +// - add HAS_UNIT_STRUTILS +// - add XPLATFORM_RTL +// +// 2003-12-03, +// - add SUPPORTS_ENUMVALUE +// +// 2003-11-14, +// - add SUPPORTS_VARARGS +// +// 2003-10-30, +// - correct and complete comments +// - add Kylix definitions +// - add RTL definitions +// - add FPC definitions + +{$ENDIF ~JEDI_INC} diff --git a/official/1.96/source/kylix.inc b/official/1.96/source/kylix.inc new file mode 100644 index 0000000..55f095e --- /dev/null +++ b/official/1.96/source/kylix.inc @@ -0,0 +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} + + diff --git a/official/1.96/source/prototypes/Hardlinks.pas b/official/1.96/source/prototypes/Hardlinks.pas new file mode 100644 index 0000000..06e1697 --- /dev/null +++ b/official/1.96/source/prototypes/Hardlinks.pas @@ -0,0 +1,1007 @@ +{$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. } +{ } +{**************************************************************************************************} +{$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 *** + *** (see JCL revision history) *** + *** *** + *** 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} + +{$IFDEF JCL} +// Last modified: $Date: 2005/04/07 01:12:01 $ +// For history see end of file + +{$ENDIF ~JCL} +unit Hardlinks; + +{$ALIGN ON} +{$MINENUMSIZE 4} + +interface +{$IFDEF JCL // 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} + +(* + 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 + Windows; + +{$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} + +implementation + +const + szNtDll = 'NTDLL.DLL'; // Import native APIs from this 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; + PPWideChar = ^PWideChar; + +type + LARGE_INTEGER = TLargeInteger; + PLARGE_INTEGER = ^LARGE_INTEGER; + +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: PChar): 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 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: PChar): 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; + + 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; + RtlAllocateHeap: TRtlAllocateHeap = nil; + RtlFreeHeap: TRtlFreeHeap = nil; + RtlDosPathNameToNtPathName_U: TRtlDosPathNameToNtPathName_U = nil; + RtlInitUnicodeString: TRtlInitUnicodeString = nil; + RtlDetermineDosPathNameType_U: TRtlDetermineDosPathNameType_U = nil; + RtlNtStatusToDosError: TRtlNtStatusToDosError = nil; +{$ENDIF RTDL} + + +function NtpGetProcessHeap: Pointer; assembler; +asm + // The structure offsets are now hardcoded to be able to remove otherwise + // obsolete structure definitions. +//MOV EAX, FS:[0]._TEB.Peb + MOV EAX, FS:[$30] // FS points to TEB/TIB which has a pointer to the PEB +//MOV EAX, [EAX]._PEB.ProcessHeap + MOV EAX, [EAX+$18] // Get the process heap's handle +(* +An alternative way to achieve exactly the same (at least in usermode) as above: + MOV EAX, FS:$18 + MOV EAX, [EAX+$30] + MOV EAX, [EAX+$18] +*) +end; + +(****************************************************************************** + + 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 := NtpGetProcessHeap; + {------------------------------------------------------------- + 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 + 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 + 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 + 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 + 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 + -----------------------} + Status := ZwOpenFile(hLinkTarget, dwDesiredAccessHL, oaMisc, + IOStats, dwShareAccessHL, dwOpenOptionsHL); + if Status = STATUS_SUCCESS then + try + // Wow ... target opened ... let's try to + 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 := NtpGetProcessHeap; + // Create and allocate a UNICODE_STRING from the zero-terminated parameters + if RtlCreateUnicodeStringFromAsciiz(usLinkName, szLinkName) then + try + 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'; + szRtlAllocateHeap = 'RtlAllocateHeap'; + szRtlFreeHeap = 'RtlFreeHeap'; + szRtlDosPathNameToNtPathName_U = 'RtlDosPathNameToNtPathName_U'; + szRtlInitUnicodeString = 'RtlInitUnicodeString'; + szRtlDetermineDosPathNameType_U = 'RtlDetermineDosPathNameType_U'; + szRtlNtStatusToDosError = 'RtlNtStatusToDosError'; +{$ENDIF RTDL} + +{$IFDEF PREFERAPI} +var + hKernel32: THandle = 0; +{$ENDIF PREFERAPI} + +initialization + {$IFDEF PREFERAPI} + // 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 + {$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); + @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(@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} + +{$IFNDEF JCL} +//-------------------------------------------------------------------------------------------------- +{$ENDIF ~JCL} + +// History: + +{$IFDEF PROTOTYPE} +// $Log: Hardlinks.pas,v $ +// Revision 1.14 2005/04/07 01:12:01 rrossmair +// - moved conditional compilation comments into directive brackets, +// so that they are removed together with the directive when it gets resolved by JPP +// +// Revision 1.13 2005/04/07 00:41:37 rrossmair +// - changed for FPC 1.9.8 +// +// Revision 1.12 2005/03/08 08:33:18 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.11 2005/03/06 11:03:29 assarbad +// - Changed prototype of RtlDosPathNameToNtPathName_U() +// +// Revision 1.10 2005/03/03 13:47:04 assarbad +// - Dividing lines now enclosed by a preprocessor statement to still show in the author's version. +// - Removed PEB/TEB/TIB declarations and renamed one function (see author's version comments for details v1.13) +// - Any OSI-approved license qualifies now for licensing of this module. +// +// Revision 1.9 2005/02/24 16:34:41 marquardt +// - remove divider lines, add section lines (unfinished) +// +// Revision 1.8 2004/10/29 05:46:36 marquardt +// - style cleaning +// +// Revision 1.7 2004/10/26 14:23:48 assarbad +// - Implementation of Robert Marquardts proposals for the sake of brevity +// in the CreateHardLinkW() implementation - C-like returns +// - Removal of potential bug in CreateHardLinkA() implementation +// - Removal of two unused function prototypes +// - Some more comments and corrections and indentations +// - Perl script to create "my" version from JCL prototype +// - Compiles fine on Delphi 4 (minor changes would be necessary for D3) +// +// Revision 1.6 2004/10/26 00:05:45 assarbad +// - Removed some superfluous records/structs and constants +// - Replaced literals by symbolic names (constants) to make the source more meaningful +// - Checked with Delphi 4 after preprocessing by JPP - works +// - Will not yet check in the preprocessed version - still discussing in the egroup about it +// +// Revision 1.5 2004/10/25 15:05:12 marquardt +// - remove strange round braces in Hardlinks.pas, bugfix JclRegistry.pas +// +// Revision 1.4 2004/10/22 01:26:50 rrossmair +// - fixed style cleaning collateral damage (as far as required to make it compile) +// +// Revision 1.3 2004/10/21 21:58:03 assarbad +// - minimal changes in the prototype +// (change of the filename for the release version on assarbad.net +// Hardlink.pas -> Hardlinks.pas +// The JCL prototype is now reference for "my" release version) +// - creation of new unit from style-cleaned prototype +// +// Revision 1.2 2004/10/21 17:53:03 marquardt +// - style cleaning +// +// Revision 1.1 2004/10/20 19:49:00 rrossmair +// - added prototype unit Hardlinks (formerly known as Hardlink) +// - modified makefile accordingly +// +{$ENDIF PROTOTYPE} + +{ + Version 1.13a - 2005-03-06 + + Minor correction in the prototype of RtlDosPathNameToNtPathName_U() + to easier pass NIL as the 4th parameter. + + Version 1.13 - 2005-03-03 + + NtMyGetProcessHeap() renamed to NtpGetProcessHeap() + + Removed declarations for TEB/PEB/TIB and supplement. As they depend + on structures which are unlikely to change, the respective offsets + can be hardcoded. As soon as this function becomes OS-version- + dependent, adapted offsets will be used. + + Version 1.12c - 2004-10-26 + + Implementation of Robert Marquardts proposals for the sake of brevity + in the CreateHardLinkW() implementation - C-like returns + + Removal of potential bug in CreateHardLinkA() implementation + + Removal of two unused function prototypes + + Some more comments and corrections and indentations + + Perl script to create "my" version from JCL prototype + + Compiles fine on Delphi 4 (minor changes would be necessary for D3) + + Version 1.12b - 2004-10-26 + + Added some constants and replaced literals by them + + Removed some superfluous constants and records + + Version 1.12a - 2004-10-21 + + "Original" file renamed according to the change in the JCL prototype + Hardlink.pas -> Hardlinks.pas + + The original version is now being created using: + jpp -c -uJCL -dMSWINDOWS -uUNIX -uHAS_UNIT_LIBC -x..\ Hardlinks.pas + + Changes will first occur in this prototype and the output of the + preprocessor undefining the "JCL" symbol will be mirrored to my site + afterwards. The prototype at the JCL is the reference from now on. + + Version 1.12 - 2004-10-18 + + Code-cleaning (removal of the currently not working softlink stuff from 1.10) + + Comments for Project JEDI (JCL) + + Some extra declarations to be compatible with JclNTFS + + Runtime dynamic linking + + Checked into the JCL + + Version 1.11 - 2004-07-01 + + Bugfix from Nico Bendlin - Odd behavior of NtMyGetProcessHeap() + + ! Version 1.10 - 2004-04-16 [this was taken out again in 1.12] + ! + Implemented softlinks for directories (junction points/reparse points) + + Version 1.01 - 2003-08-25 + + Implemented hardlinks +} + +end. + diff --git a/official/1.96/source/prototypes/JclGraphUtils.pas b/official/1.96/source/prototypes/JclGraphUtils.pas new file mode 100644 index 0000000..7e089e0 --- /dev/null +++ b/official/1.96/source/prototypes/JclGraphUtils.pas @@ -0,0 +1,3 @@ +unit JclGraphUtils; +{$DEFINE PROTOTYPE} +{$I _GraphUtils.pas} \ No newline at end of file diff --git a/official/1.96/source/prototypes/JclGraphics.pas b/official/1.96/source/prototypes/JclGraphics.pas new file mode 100644 index 0000000..df91b79 --- /dev/null +++ b/official/1.96/source/prototypes/JclGraphics.pas @@ -0,0 +1,4 @@ +unit JclGraphics; +{$DEFINE PROTOTYPE} +{$DEFINE Bitmap32} +{$I _Graphics.pas} diff --git a/official/1.96/source/prototypes/JclQGraphUtils.pas b/official/1.96/source/prototypes/JclQGraphUtils.pas new file mode 100644 index 0000000..5764e17 --- /dev/null +++ b/official/1.96/source/prototypes/JclQGraphUtils.pas @@ -0,0 +1,4 @@ +unit JclQGraphUtils; +{$DEFINE PROTOTYPE} +{$DEFINE VisualCLX} +{$I _GraphUtils.pas} \ No newline at end of file diff --git a/official/1.96/source/prototypes/JclQGraphics.pas b/official/1.96/source/prototypes/JclQGraphics.pas new file mode 100644 index 0000000..58a2d42 --- /dev/null +++ b/official/1.96/source/prototypes/JclQGraphics.pas @@ -0,0 +1,4 @@ +unit JclQGraphics; +{$DEFINE PROTOTYPE} +{$DEFINE VisualCLX} +{$I _Graphics.pas} \ No newline at end of file diff --git a/official/1.96/source/prototypes/JclWin32.pas b/official/1.96/source/prototypes/JclWin32.pas new file mode 100644 index 0000000..b704794 --- /dev/null +++ b/official/1.96/source/prototypes/JclWin32.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. } +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ 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: 2005/04/07 00:41:37 $ + +unit JclWin32; + +{$I jcl.inc} + +{$DEFINE STRICT} +{$DEFINE WINVER_0400_UP} +{$DEFINE WINVER_0500_GREATER} +{$DEFINE WINVER_0400_GREATER} +{$DEFINE WINNT} +{$DEFINE WINNT_0400_UP} +{$DEFINE WINNT_0400_GREATER} +{$DEFINE WINNT_0500_GREATER} +{$DEFINE WINDOWS_0400_GREATER} + +{$MINENUMSIZE 4} +{$ALIGN ON} +{$WARNINGS OFF} + +interface + +uses + Windows, SysUtils, + {$IFNDEF FPC} + AccCtrl, ActiveX, + {$ENDIF ~FPC} + JclBase; + +{$HPPEMIT ''} +{$HPPEMIT '#include "WinDef.h"'} +{$HPPEMIT '#include "WinNT.h"'} +{$HPPEMIT '#include "WinBase.h"'} +{$HPPEMIT '#include "BaseTsd.h"'} +{$HPPEMIT '#include "ImageHlp.h"'} +{$HPPEMIT '#include "lm.h"'} +{$HPPEMIT '#include "Nb30.h"'} +{$HPPEMIT '#include "RasDlg.h"'} +{$HPPEMIT '#include "Reason.h"'} +{$HPPEMIT '#include "ShlWApi.h"'} +{$HPPEMIT '#include "WinError.h"'} +{$HPPEMIT '#include "WinIoCtl.h"'} +{$HPPEMIT '#include "WinUser.h"'} + +{$HPPEMIT '#include '} +{$HPPEMIT ''} + +{$IFDEF FPC} +// include file for FPC compatibility +{$I win32api\fpc.inc} +{$ENDIF FPC} + +{$I win32api\WinDef.int} +{$I win32api\WinNT.int} +{$I win32api\WinBase.int} +{$I win32api\BaseTsd.int} +{$I win32api\AclApi.int} +{$I win32api\ImageHlp.int} +{$I win32api\LmErr.int} +{$I win32api\LmCons.int} +{$I win32api\LmAccess.int} +{$I win32api\LmApiBuf.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\DelayImp.int} + +{$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; + + RtdlEnumCalendarInfoExA: function(lpCalInfoEnumProc: TCalInfoEnumProcExA; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall = EnumCalendarInfoExA; + + RtdlGetVolumeNameForVolumeMountPoint: function(lpszVolumeMountPoint: LPCSTR; + lpszVolumeName: LPSTR; cchBufferLength: DWORD): BOOL; stdcall = GetVolumeNameForVolumeMountPoint; + + RtdlSetVolumeMountPoint: function(lpszVolumeMountPoint: LPCSTR; + lpszVolumeName: LPCSTR): BOOL; stdcall = SetVolumeMountPoint; + + RtdlDeleteVolumeMountPoint: function(lpszVolumeMountPoint: LPCSTR): BOOL; + stdcall = DeleteVolumeMountPoint; + + RtdlNetBios: function(P: PNCB): UCHAR; stdcall = NetBios; + +{$ENDIF MSWINDOWS} + +implementation + +uses + JclResources; + +const + {$IFDEF UNICODE} + AWSuffix = 'W'; + {$ELSE ~UNICODE} + AWSuffix = 'A'; + {$ENDIF ~UNICODE} + +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 := LoadLibrary(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; + +{$I win32api\AclApi.imp} +{$I win32api\ImageHlp.imp} +{$I win32api\LmAccess.imp} +{$I win32api\LmApiBuf.imp} +{$I win32api\Nb30.imp} +{$I win32api\WinBase.imp} +{$I win32api\WinNLS.imp} +{$I win32api\WinNT.imp} + +// History of source\prototypes\JclWin32.pas: + +{$IFDEF PROTOTYPE} +// $Log: JclWin32.pas,v $ +// Revision 1.5 2005/04/07 00:41:37 rrossmair +// - changed for FPC 1.9.8 +// +{$ENDIF PROTOTYPE} +// Revision 1.4 2005/03/08 08:33:19 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.3 2005/03/07 07:49:12 marquardt +// made the generator not remove IFDEF MSWINDOWS and UNIX +// +// Revision 1.2 2004/12/23 04:31:43 rrossmair +// - check-in for JCL 1.94 RC 1 +// +// Revision 1.1 2004/12/03 04:05:19 rrossmair +// JclWin32 a unit generated from prototype now +// +// History of source\windows\JclWin32.pas: +// +// Revision 1.32 2004/11/04 12:55:21 obones +// BCB compatibility fix: aclapi.h and shlobj.h must not be included. +// +// Revision 1.31 2004/10/30 08:20:09 rrossmair +// fixed BCB-related bugs +// +// Revision 1.30 2004/10/21 08:40:11 marquardt +// style cleaning +// +// Revision 1.29 2004/10/19 21:28:41 rrossmair +// - rewrite from scratch, cannibalizing MvB's Win32API distribution +// +// Revision 1.28 2004/10/09 13:58:52 marquardt +// style cleaning JclPrint +// remove WinSpool related functions from JclWin32 +// +// Revision 1.27 2004/08/02 06:34:59 marquardt +// minor string literal improvements +// +// Revision 1.26 2004/08/01 05:50:00 marquardt +// fix JclFreeLibrary +// +// Revision 1.25 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.24 2004/07/28 18:00:55 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.23 2004/06/14 13:05:22 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.22 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.21 2004/06/02 03:23:47 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.20 2004/05/28 14:00:46 obones +// BCB5 compatibility +// +// Revision 1.19 2004/05/06 05:09:55 rrossmair +// Changes for FPC v1.9.4 compatibility +// +// Revision 1.18 2004/05/05 05:38:38 rrossmair +// Changes for FPC compatibility; header updated according to new policy: initial developers, contributors listed +// +// Revision 1.17 2004/04/18 00:45:05 +// add run-time dynamic linking support for GetOpenGLVersion +// +// Revision 1.16 2004/04/11 22:16:20 mthoma +// Modifications for GetDefaultPrinterName. Added GetDefaultPrinter API function. +// +// Revision 1.15 2004/04/08 19:59:11 ahuser +// BCB compatibility +// +// Revision 1.14 2004/04/08 10:27:15 rrossmair +// GetVersionEx overload added. +// +end. + + + diff --git a/official/1.96/source/prototypes/Makefile.mak b/official/1.96/source/prototypes/Makefile.mak new file mode 100644 index 0000000..86674df --- /dev/null +++ b/official/1.96/source/prototypes/Makefile.mak @@ -0,0 +1,76 @@ +# +# Generates platform dependent units from common code base +# +# $Id: Makefile.mak,v 1.13 2005/03/14 02:41:06 rrossmair Exp $ +# + +jpp = ..\..\devtools\jpp.exe + +Options = -c -dJCL -dSUPPORTS_DEFAULTPARAMS -dSUPPORTS_INT64 +CommonOptions = $(Options) -f..\common\\ +VclOptions = $(Options) -dVCL -uVisualCLX -dMSWINDOWS -uUnix -dBitmap32 -x1:..\vcl\Jcl +VClxOptions = $(Options) -uVCL -dVisualCLX -dHAS_UNIT_TYPES -uBitmap32 -x1:..\visclx\JclQ +WinOptions = $(Options) -dMSWINDOWS -uUNIX -uHAS_UNIT_LIBC -f..\windows\\ +Win32Options = $(Options) -uHAS_UNIT_LIBC -f..\windows\\ +UnixOptions = $(Options) -uMSWINDOWS -dUNIX -f..\unix\\ +ZlibOptions = -uSTATIC_GZIO + + +release: VCL VisualCLX Windows Unix + +VCL: ..\vcl\JclGraphics.pas \ + ..\vcl\JclGraphUtils.pas + +VisualCLX: ..\visclx\JclQGraphics.pas \ + ..\visclx\JclQGraphUtils.pas + +Windows: ..\windows\JclWin32.pas \ + ..\windows\Hardlinks.pas \ + ..\windows\zlibh.pas + +Unix: ..\unix\zlibh.pas + +zlib: ..\windows\zlibh.pas ..\unix\zlibh.pas + +..\vcl\JclGraphics.pas: \ + _Graphics.pas + $(jpp) $(VclOptions) $? + +..\vcl\JclGraphUtils.pas: \ + _GraphUtils.pas + $(jpp) $(VclOptions) $? + +..\visclx\JclQGraphics.pas: \ + _Graphics.pas + $(jpp) $(VClxOptions) $? + +..\visclx\JclQGraphUtils.pas: \ + _GraphUtils.pas + $(jpp) $(VClxOptions) $? + +..\unix\JclWin32.pas: \ + JclWin32.pas + $(jpp) -ijcl.inc $(UnixOptions) $? + +..\unix\zlibh.pas: \ + zlibh.pas + echo Unix-zlib + $(jpp) $(UnixOptions) $(ZlibOptions) -dZLIB_DLL $? + +..\windows\JclWin32.pas: \ + JclWin32.pas + $(jpp) -ijcl.inc $(WinOptions) $? + +..\windows\zlibh.pas: \ + zlibh.pas + echo Win-zlib + $(jpp) $(WinOptions) $(ZlibOptions) -uZLIB_DLL $? + +{.}.pas{..\common}.pas: + $(jpp) $(CommonOptions) $< + +{.}.pas{..\windows}.pas: + $(jpp) $(WinOptions) $< + +{.}.pas{..\unix}.pas: + $(jpp) $(UnixOptions) $< diff --git a/official/1.96/source/prototypes/_GraphUtils.pas b/official/1.96/source/prototypes/_GraphUtils.pas new file mode 100644 index 0000000..bc64675 --- /dev/null +++ b/official/1.96/source/prototypes/_GraphUtils.pas @@ -0,0 +1,2695 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} + +{$IFDEF PROTOTYPE} +// Last modified: $Date: 2005/10/30 01:52:22 $ +{$ELSE ~PROTOTYPE} +// For history, see end of file + +{$IFDEF VCL} +unit JclGraphUtils; +{$ELSE VisualCLX} +unit JclQGraphUtils; +{$ENDIF VisualCLX} +{$ENDIF ~PROTOTYPE} + +interface + +{$I jcl.inc} + +uses + {$IFDEF HAS_UNIT_TYPES} + Types, + {$ENDIF HAS_UNIT_TYPES} + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + SysUtils, + {$IFDEF VCL} + Graphics, + {$ENDIF VCL} + {$IFDEF VisualCLX} + Qt, QGraphics, + {$ENDIF VisualCLX} + 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; + +{$IFDEF KEEP_DEPRECATED} +// obsolete; use corresponding HLS aliases instead +procedure HSLToRGB(const H, S, L: Single; out R, G, B: Single); overload; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +procedure RGBToHSL(const R, G, B: Single; out H, S, L: Single); overload; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +{$ENDIF KEEP_DEPRECATED} + +// 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; + +implementation + +uses + {$IFDEF VCL} + Classes, Consts, + {$ENDIF VCL} + Math, + JclResources, 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, SizeOf(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 +{asm +// EAX = WinColor + MOV ECX, EAX // ECX = WinColor + MOV EDX, EAX // EDX = WinColor + + AND ECX, $FF0000 // B component + AND EAX, $0000FF // R component + AND EDX, $00FF00 // G component + + OR EAX, $00FF00 // write $FF into A component + SHR ECX, 16 // shift B + SHL EAX, 16 // shift AR + OR ECX, EDX // ECX = GB + OR EAX, ECX // set GB +end;} +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; +{asm + // 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) + // EAX <- X + // EDX <- Y + // ECX <- W + + // W = 0 or $FF? + JCXZ @1 // CX = 0 ? => Result := EDX + CMP ECX, $FF // CX = $FF ? => Result := EAX + JE @2 + + PUSH EBX + + // P = W * X + MOV EBX, EAX // EBX <- Xa Xr Xg Xb + AND EAX, $00FF00FF // EAX <- 00 Xr 00 Xb + AND EBX, $FF00FF00 // EBX <- Xa 00 Xg 00 + IMUL EAX, ECX // EAX <- Pr ** Pb ** + SHR EBX, 8 // EBX <- 00 Xa 00 Xg + IMUL EBX, ECX // EBX <- Pa ** Pg ** + ADD EAX, Bias + AND EAX, $FF00FF00 // EAX <- Pr 00 Pb 00 + SHR EAX, 8 // EAX <- 00 Pr 00 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 * Y + XOR ECX, $000000FF // ECX <- 1 - ECX + MOV EBX, EDX // EBX <- Ya Yr Yg Yb + AND EDX, $00FF00FF // EDX <- 00 Yr 00 Yb + AND EBX, $FF00FF00 // EBX <- Ya 00 Yg 00 + IMUL EDX, ECX // EDX <- Qr ** Qb ** + SHR EBX, 8 // EBX <- 00 Ya 00 Yg + IMUL EBX, ECX // EBX <- Qa ** Qg ** + ADD EDX, Bias + AND EDX, $FF00FF00 // EDX <- Qr 00 Qb 00 + SHR EDX, 8 // EDX <- 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 + + POP EBX + RET + +@1: MOV EAX, EDX +@2: RET +end;} +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); +{asm + // EAX <- F + // [EDX] <- B + // ECX <- W + PUSH EDX + MOV EDX, [EDX] + CALL _CombineReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := _CombineReg(F, B, W); +end; + +function _BlendReg(F, B: TColor32): TColor32; +{asm + // blend foreground color (F) to a background color (B), + // using alpha channel value of F + // Result Z = Fa * Frgb + (1 - Fa) * Brgb + // EAX <- F + // EDX <- B + MOV ECX, EAX // ECX <- Fa Fr Fg Fb + SHR ECX, 24 // ECX <- 00 00 00 Fa + JMP _CombineReg +end;} +begin + Result := _CombineReg(F, B, F shr 24); +end; + +procedure _BlendMem(F: TColor32; var B: TColor32); +{asm + // EAX <- F + // [EDX] <- B + PUSH EDX + MOV ECX, EAX // ECX <- Fa Fr Fg Fb + SHR ECX, 24 // ECX <- 00 00 00 Fa + MOV EDX, [EDX] + CALL _CombineReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := _CombineReg(F, B, F shr 24); +end; + +function _BlendRegEx(F, B, M: TColor32): TColor32; +{asm + // blend foreground color (F) to a background color (B), + // using alpha channel value of F multiplied by master alpha (M) + // no checking for M = $FF, if this is the case Graphics32 uses BlendReg + // Result Z = Fa * M * Frgb + (1 - Fa * M) * Brgb + // EAX <- F + // EDX <- B + // ECX <- M + MOV EBX, EAX // EBX <- Fa Fr Fg Fb + SHR EBX, 24 // EBX <- 00 00 00 Fa + IMUL ECX, EBX // ECX <- 00 00 W ** + SHR ECX, 8 // ECX <- 00 00 00 W + JMP _CombineReg +end;} +begin + Result := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + +procedure _BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +{asm + // EAX <- F + // [EDX] <- B + // ECX <- M + PUSH EBX + MOV EBX, EAX // EBX <- Fa Fr Fg Fb + SHR EBX, 24 // EBX <- 00 00 00 Fa + IMUL ECX, EBX // ECX <- 00 00 W ** + SHR ECX, 8 // ECX <- 00 00 00 W + + MOV EBX, EDX + MOV EDX, [EDX] + CALL _BlendRegEx + MOV [EBX], EAX + POP EBX +end;} +begin + B := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + + +procedure _BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + // 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 +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; + +{ 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); + alpha_ptr := Pointer(Integer(AlphaTable) and $FFFFFFF8); + if Integer(alpha_ptr) < Integer(AlphaTable) then + alpha_ptr := Pointer(Integer(alpha_ptr) + 8); + 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(Integer(alpha_ptr) + $80 * 8); +end; + +procedure FreeAlphaTable; +begin + FreeMem(AlphaTable); + AlphaTable := nil; +end; + +procedure EMMS; +begin + if MMX_ACTIVE then + asm + db $0F, $77 // EMMS + end; +end; + +function M_CombineReg(X, Y, W: TColor32): TColor32; assembler; +asm + // 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 +end; + +procedure M_CombineMem(F: TColor32; var B: TColor32; W: TColor32); +{asm + // EAX - Color X + // [EDX] - Color Y + // ECX - Weight of X [0..255] + // Result := W * (X - Y) + Y + PUSH EDX + MOV EDX, [EDX] + CALL M_CombineReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := M_CombineReg(F, B, W); +end; + +function M_BlendReg(F, B: TColor32): TColor32; assembler; +asm + // 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 +end; + +procedure M_BlendMem(F: TColor32; var B: TColor32); +{asm + // EAX - Color X + // [EDX] - Color Y + // Result := W * (X - Y) + Y + PUSH EDX + MOV EDX, [EDX] + CALL M_BlendReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := M_BlendReg(F, B); +end; + +function M_BlendRegEx(F, B, M: TColor32): TColor32; assembler; +asm + // 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 +end; + +procedure M_BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +{asm + // 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 EDX + MOV EDX, [EDX] + CALL M_BlendRegEx + POP EDX + MOV [EDX], EAX +end;} +begin + B := M_BlendRegEx(F, B, M); +end; + +procedure M_BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + // 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 +end; + +procedure M_BlendLineEx(Src, Dst: PColor32; Count: Integer; M: TColor32); assembler; +asm + // 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: +end; + +{ 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} + {$IFDEF VisualCLX} + { TODO : Find a Qt-independent solution } + X := QWidget_width(QApplication_desktop); + Y := QWidget_height(QApplication_desktop); + {$ENDIF VisualCLX} + {$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; + +{$IFDEF KEEP_DEPRECATED} +procedure HSLToRGB(const H, S, L: Single; out R, G, B: Single); +begin + HLSToRGB(H, L, S, R, G, B); +end; +{$ENDIF KEEP_DEPRECATED} + +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; + +{$IFDEF KEEP_DEPRECATED} +procedure RGBToHSL(const R, G, B: Single; out H, S, L: Single); +begin + RGBToHLS(R, G, B, H, L, S); +end; +{$ENDIF KEEP_DEPRECATED} + +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 neccessary + 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; + +finalization + if MMX_ACTIVE then + FreeAlphaTable; + +// History: + +{$IFDEF PROTOTYPE} +// $Log: _GraphUtils.pas,v $ +// Revision 1.21 2005/10/30 01:52:22 rrossmair +// - introduce KEEP_DEPRECATED as alias for ~DROP_OBSOLETE_CODE +// +// Revision 1.20 2005/03/08 08:33:19 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.19 2005/03/05 06:28:24 rrossmair +// - fixed DROP_OBSOLETE_CODE usage +// +{$ENDIF PROTOTYPE} +// Revision 1.18 2005/02/24 16:34:41 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.17 2004/11/25 21:56:12 rrossmair +// - TColor32Array declaration changed to avoid range check errors in JclGraphics +// +// Revision 1.16 2004/11/14 06:05:05 rrossmair +// - some source formatting +// +// Revision 1.15 2004/10/18 16:22:14 marquardt +// corrected typo +// +// Revision 1.14 2004/10/17 20:54:14 mthoma +// cleaning +// +// Revision 1.13 2004/07/31 06:21:02 marquardt +// - reset AlphaTable to nil in FreeAlphaTable +// +// Revision 1.12 2004/07/16 03:58:14 rrossmair +// some style cleaning +// +// Revision 1.11 2004/06/27 23:28:51 rrossmair +// some style cleaning (case, spaces) +// +// Revision 1.10 2004/06/16 07:30:28 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.9 2004/06/14 13:05:19 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.8 2004/05/05 22:14:51 rrossmair +// bug fix in HSLToRGB(const H, S, L: Single; out R, G, B: Single); source code formatted +// renamed Hue/Luminance/Saturation related routines from *HSL* to *HLS*, as far as possible; old identifiers kept as deprecated +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.7 2004/05/01 00:21:10 rrossmair +// fixed for Kylix +// +// Revision 1.6 2004/04/28 04:16:19 rrossmair +// new functions added: RGBToHLS, HLSToRGB, RGB2HLS, HLS2RGB, SetBitmapColors (VCL only) +// +// Revision 1.5 2004/04/18 06:32:07 rrossmair +// replaced symbol "Develop" by jpp-pre-undefined "PROTOTYPE"; protected CVS key words by "PROTOTYPE" symbol +// +// Revision 1.4 2004/04/06 05:01:54 +// adapt compiler conditions, add log entry +// +// 2001-03-28, Mike Lischke: +// - ShortenString included + +end. diff --git a/official/1.96/source/prototypes/_Graphics.pas b/official/1.96/source/prototypes/_Graphics.pas new file mode 100644 index 0000000..bfdc765 --- /dev/null +++ b/official/1.96/source/prototypes/_Graphics.pas @@ -0,0 +1,5746 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} + +{$IFDEF PROTOTYPE} +// Last modified: $Date: 2005/12/12 21:54:10 $ +{$ELSE ~PROTOTYPE} +// For history, see end of file + +{$IFDEF VCL} +unit JclGraphics; +{$ELSE VisualCLX} +unit JclQGraphics; +{$ENDIF VisualCLX} +{$ENDIF ~PROTOTYPE} + +{$I jcl.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + {$IFDEF VisualCLX} + Types, QGraphics, JclQGraphUtils, + {$ELSE} + Graphics, JclGraphUtils, Controls, + {$ENDIF VisualCLX} + 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; + 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; + 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 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; +function IconToBitmap(Icon: HICON): HBITMAP; +{$ENDIF MSWINDOWS} + +{$IFDEF VCL} +procedure BitmapToJPeg(const FileName: string); +procedure JPegToBitmap(const FileName: string); + +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): HRGN; +procedure ScreenShot(bm: TBitmap; Left, Top, Width, Height: Integer; Window: THandle = HWND_DESKTOP); overload; +procedure ScreenShot(bm: TBitmap; IncludeTaskBar: Boolean = True); 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} + +implementation + +uses + Math, + {$IFDEF MSWINDOWS} + CommCtrl, ShellApi, + {$IFDEF VCL} + ClipBrd, JPeg, TypInfo, + JclResources, + {$ENDIF VCL} + {$ENDIF MSWINDOWS} + JclLogic; + +type + TRGBInt = record + R: Integer; + G: Integer; + B: Integer; + end; + + PBGRA = ^TBGRA; + TBGRA = packed record + B: Byte; + G: Byte; + R: Byte; + A: Byte; + end; + + PPixelArray = ^TPixelArray; + TPixelArray = array [0..0] of TBGRA; + + 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 + 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; + +threadvar + // globally used cache for current image (speeds up resampling about 10%) + CurrentLineR: array of Integer; + CurrentLineG: array of Integer; + CurrentLineB: array of Integer; + +//=== Helper functions ======================================================= + +function IntToByte(Value: Integer): Byte; +begin + Result := Math.Max(0, Math.Min(255, Value)); +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); +{asm +// EAX = X +// EDX = Count +// ECX = Value + TEST EDX, EDX + JLE @@EXIT + + PUSH EDI + MOV EDI, EAX // Point EDI to destination + MOV EAX, ECX + MOV ECX, EDX + REP STOSD // Fill count dwords + POP EDI +@@EXIT: +end;} +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); +{asm +// EAX = [A] +// EDX = [B] + MOV ECX, [EAX] // ECX := [A] + CMP ECX, [EDX] // ECX <= [B]? Exit + JLE @@EXIT + //Replaced on more fast code + //XCHG ECX, [EDX] // ECX <-> [B]; + //MOV [EAX], ECX // [A] := ECX + PUSH EBX + MOV EBX,[EDX] // EBX := [B] + MOV [EAX],EBX // [A] := EBX + MOV [EDX],ECX // [B] := ECX + POP EBX +@@EXIT: +end;} +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; + + 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 / 3.0) + else + Result := 0.0; +end; + +function BitmapMitchellFilter(Value: Single): Single; +const + B = 1.0 / 3.0; + C = 1.0 / 3.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 / 6.0; + 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 / 6.0; + end + else + Result := 0.0; +end; + +const + FilterList: array [TResamplingFilter] of TBitmapFilterFunction = + ( + BitmapBoxFilter, + BitmapTriangleFilter, + BitmapHermiteFilter, + BitmapBellFilter, + BitmapSplineFilter, + BitmapLanczos3Filter, + BitmapMitchellFilter + ); + +procedure FillLineCache(N, Delta: Integer; Line: Pointer); +var + I: Integer; + Run: PBGRA; +begin + Run := Line; + for I := 0 to N - 1 do + begin + CurrentLineR[I] := Run.R; + CurrentLineG[I] := Run.G; + CurrentLineB[I] := Run.B; + Inc(PByte(Run), Delta); + end; +end; + +function ApplyContributors(N: Integer; Contributors: TContributors): TBGRA; +var + J: Integer; + RGB: TRGBInt; + Total, + Weight: Integer; + Pixel: Cardinal; + Contr: PContributor; +begin + RGB.R := 0; + RGB.G := 0; + RGB.B := 0; + Total := 0; + Contr := @Contributors[0]; + for J := 0 to N - 1 do + begin + Weight := Contr.Weight; + Inc(Total, Weight); + Pixel := Contr.Pixel; + Inc(RGB.R, CurrentLineR[Pixel] * Weight); + Inc(RGB.G, CurrentLineG[Pixel] * Weight); + Inc(RGB.B, CurrentLineB[Pixel] * Weight); + Inc(Contr); + end; + + if Total = 0 then + begin + Result.R := IntToByte(RGB.R shr 8); + Result.G := IntToByte(RGB.G shr 8); + Result.B := IntToByte(RGB.B shr 8); + end + else + begin + Result.R := IntToByte(RGB.R div Total); + Result.G := IntToByte(RGB.G div Total); + Result.B := IntToByte(RGB.B div Total); + 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: PPixelArray; + DestPixel: PBGRA; + Delta, DestDelta: Integer; + SourceHeight, SourceWidth: Integer; + TargetHeight, TargetWidth: Integer; +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 := Math.Floor(Center - Width); + Right := 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 := Math.Floor(Center - Radius); + Right := 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; + + // now apply filter to sample horizontally from Src to Work + + SetLength(CurrentLineR, SourceWidth); + SetLength(CurrentLineG, SourceWidth); + SetLength(CurrentLineB, SourceWidth); + for K := 0 to SourceHeight - 1 do + begin + SourceLine := Source.ScanLine[K]; + FillLineCache(SourceWidth, SizeOf(TBGRA), SourceLine); + DestPixel := Work.ScanLine[K]; + for I := 0 to TargetWidth - 1 do + with ContributorList[I] do + begin + DestPixel^ := ApplyContributors(N, ContributorList[I].Contributors); + // 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 := Math.Floor(Center - Width); + Right := 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 := Math.Floor(Center - Radius); + Right := 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 + SetLength(CurrentLineR, SourceHeight); + SetLength(CurrentLineG, SourceHeight); + SetLength(CurrentLineB, SourceHeight); + + SourceLine := Work.ScanLine[0]; + Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine); + DestLine := Target.ScanLine[0]; + DestDelta := Integer(Target.ScanLine[1]) - Integer(DestLine); + for K := 0 to TargetWidth - 1 do + begin + DestPixel := Pointer(DestLine); + FillLineCache(SourceHeight, Delta, SourceLine); + for I := 0 to TargetHeight - 1 do + with ContributorList[I] do + begin + DestPixel^ := ApplyContributors(N, ContributorList[I].Contributors); + Inc(Integer(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; + CurrentLineR := nil; + CurrentLineG := nil; + CurrentLineB := nil; + 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; +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; + + 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); + 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 JPegToBitmap(const FileName: string); +var + Bitmap: TBitmap; + JPeg: TJPegImage; +begin + Bitmap := nil; + JPeg := nil; + try + JPeg := TJPegImage.Create; + JPeg.LoadFromFile(FileName); + Bitmap := TBitmap.Create; + Bitmap.Assign(JPeg); + Bitmap.SaveToFile(ChangeFileExt(FileName, LoadResString(@RsBitmapExtension))); + finally + FreeAndNil(Bitmap); + FreeAndNil(JPeg); + end; +end; + +procedure BitmapToJPeg(const FileName: string); +var + Bitmap: TBitmap; + JPeg: TJPegImage; +begin + Bitmap := nil; + JPeg := nil; + try + Bitmap := TBitmap.Create; + Bitmap.LoadFromFile(FileName); + JPeg := TJPegImage.Create; + JPeg.Assign(Bitmap); + JPeg.SaveToFile(ChangeFileExt(FileName, LoadResString(@RsJpegExtension))); + finally + FreeAndNil(Bitmap); + FreeAndNil(JPeg); + end; +end; +{$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 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 + FillChar(CI, SizeOf(CI), 0); + FillChar(List, SizeOf(List), 0); + 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): HRGN; +var + FBitmap: TBitmap; + X, Y: Integer; + StartX: Integer; + Region: HRGN; +begin + Result := 0; + + if Bitmap = nil then + EJclGraphicsError.CreateRes(@RsNoBitmapForRegion); + + if (Bitmap.Width = 0) or (Bitmap.Height = 0) then + Exit; + + FBitmap := TBitmap.Create; + try + FBitmap.Assign(Bitmap); + + for Y := 0 to FBitmap.Height - 1 do + begin + X := 0; + while X < FBitmap.Width do + begin + + if RegionBitmapMode = rmExclude then + begin + while FBitmap.Canvas.Pixels[X,Y] = RegionColor do + begin + Inc(X); + if X = FBitmap.Width then + Break; + end; + end + else + begin + while FBitmap.Canvas.Pixels[X,Y] <> RegionColor do + begin + Inc(X); + if X = FBitmap.Width then + Break; + end; + end; + + if X = FBitmap.Width then + Break; + + StartX := X; + if RegionBitmapMode = rmExclude then + begin + while FBitmap.Canvas.Pixels[X,Y] <> RegionColor do + begin + if X = FBitmap.Width then + Break; + Inc(X); + end; + end + else + begin + while FBitmap.Canvas.Pixels[X,Y] = RegionColor do + begin + if X = FBitmap.Width then + Break; + Inc(X); + end; + end; + + if Result = 0 then + Result := CreateRectRgn(StartX, Y, X, Y + 1) + else + begin + Region := CreateRectRgn(StartX, Y, X, Y + 1); + if Region <> 0 then + begin + CombineRgn(Result, Result, Region, RGN_OR); + DeleteObject(Region); + end; + end; + end; + end; + finally + FBitmap.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); + + // Palette-device? + if (GetDeviceCaps(WinDC, RASTERCAPS) and RC_PALETTE) = RC_PALETTE then + begin + FillChar(Pal, SizeOf(TMaxLogPalette), #0); // 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); + + ReleaseDC(Window, WinDC); // finally, relase the DC of the window +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; + +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(PChar(@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, Count, ALTERNATE), True); + fmWinding: + Create(CreatePolygonRgn(Points, 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, Vertex, Count, ALTERNATE), True); + fmWinding: + Create(CreatePolyPolygonRgn(Points, Vertex, 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 EJclWin32Error.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); +begin + SelectClipRgn(Canvas.Handle,FHandle); + {$IFDEF VisualCLX}JclQGraphics{$ELSE}JclGraphics{$ENDIF}.FillGradient(Canvas.Handle, Box, ColorCount, StartColor, EndColor, ADirection); +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; + FillChar(FBitmapInfo, SizeOf(TBitmapInfo), #0); + 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); + 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)); + 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)); + 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, 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; + 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); + +// History: +{$IFDEF PROTOTYPE} +// $Log: _Graphics.pas,v $ +// Revision 1.25 2005/12/12 21:54:10 outchy +// HWND changed to THandle (linking problems with BCB). +// +// Revision 1.24 2005/08/07 13:09:55 outchy +// Changed PByteArray to PJclByteArray to avoid RangeCheck exceptions. +// +// Revision 1.23 2005/04/03 14:53:11 outchy +// Donation of Dejoy, modifications of prototypes +// +// Revision 1.22 2005/03/14 08:46:54 rrossmair +// - check-in in preparation for release 1.95 +// +// Revision 1.21 2005/03/08 08:33:19 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.20 2005/02/24 16:34:44 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.19 2004/11/25 22:00:07 rrossmair +// - removed orphaned local variable +// +{$ENDIF PROTOTYPE} +// Revision 1.18 2004/11/14 06:05:05 rrossmair +// - some source formatting +// +// Revision 1.17 2004/11/06 02:19:45 mthoma +// history cleaning. +// +// Revision 1.16 2004/10/17 20:54:14 mthoma +// cleaning +// +// Revision 1.15 2004/07/28 07:40:41 marquardt +// remove comiler warnings +// +// Revision 1.14 2004/07/16 03:50:35 rrossmair +// fixed "not accesssible with BCB" warning for TJclRegion.CreateRect +// +// Revision 1.13 2004/07/15 05:15:41 rrossmair +// TJclRegion: Handle ownership management added, some refactoring +// +// Revision 1.12 2004/07/12 02:54:33 rrossmair +// TJclRegion.Create fixed +// +// Revision 1.11 2004/06/14 13:05:19 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.10 2004/05/14 15:20:44 rrossmair +// added Marcin Wieczorek to Contributors list +// +// Revision 1.9 2004/05/05 22:16:40 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.8 2004/04/18 06:32:07 rrossmair +// replaced symbol "Develop" by jpp-pre-undefined "PROTOTYPE"; protected CVS key words by "PROTOTYPE" symbol +// +// Revision 1.7 2004/04/08 19:44:30 mthoma +// Fixed 0001513: CheckParams at the beginning of ApplyLut is: CheckParams(Src, Dst) but should be CheckParams(Dst, Src) +// +// Revision 1.6 2004/04/06 05:01:54 +// adapt compiler conditions, add log entry + +end. diff --git a/official/1.96/source/prototypes/supplement/create_JCL_Hardlinks.pas.cmd b/official/1.96/source/prototypes/supplement/create_JCL_Hardlinks.pas.cmd new file mode 100644 index 0000000..9152639 --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/supplement/create_nonJCL_Hardlinks.pas.cmd b/official/1.96/source/prototypes/supplement/create_nonJCL_Hardlinks.pas.cmd new file mode 100644 index 0000000..8deea6c --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/supplement/simple_pp.pl b/official/1.96/source/prototypes/supplement/simple_pp.pl new file mode 100644 index 0000000..31c0a99 --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/AclApi.imp b/official/1.96/source/prototypes/win32api/AclApi.imp new file mode 100644 index 0000000..38dd162 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/AclApi.imp @@ -0,0 +1,19 @@ +{$IFDEF MSWINDOWS} + +const + aclapilib = 'advapi32.dll'; + +var + _SetNamedSecurityInfoW: Pointer; + +function SetNamedSecurityInfoW; +begin + GetProcedureAddress(_SetNamedSecurityInfoW, aclapilib, 'SetNamedSecurityInfoW'); + asm + mov esp, ebp + pop ebp + jmp [_SetNamedSecurityInfoW] + end; +end; + +{$ENDIF MSWINDOWS} diff --git a/official/1.96/source/prototypes/win32api/AclApi.int b/official/1.96/source/prototypes/win32api/AclApi.int new file mode 100644 index 0000000..c7cb2a6 --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/BaseTsd.int b/official/1.96/source/prototypes/win32api/BaseTsd.int new file mode 100644 index 0000000..ed2bf95 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/BaseTsd.int @@ -0,0 +1,7 @@ +type + {$EXTERNALSYM ULONG_PTR} + ULONG_PTR = LongWord; // Need to have the same size like Pointer + {$EXTERNALSYM DWORD_PTR} + DWORD_PTR = ULONG_PTR; + {$EXTERNALSYM PDWORD_PTR} + PDWORD_PTR = ^PLongWord; diff --git a/official/1.96/source/prototypes/win32api/DelayImp.int b/official/1.96/source/prototypes/win32api/DelayImp.int new file mode 100644 index 0000000..aac9837 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/DelayImp.int @@ -0,0 +1,61 @@ + +type + { TODO : Source unknown } + {$EXTERNALSYM ImgDelayDescr} + ImgDelayDescr = packed record + grAttrs: DWORD; // attributes + szName: DWORD; // pointer to dll name + phmod: PDWORD; // address of module handle + { TODO : probably wrong declaration } + pIAT: TImageThunkData; // address of the IAT + { TODO : probably wrong declaration } + pINT: TImageThunkData; // address of the INT + { TODO : probably wrong declaration } + pBoundIAT: TImageThunkData; // address of the optional bound IAT + { TODO : probably wrong declaration } + pUnloadIAT: TImageThunkData; // 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; + TImgDelayDescr = ImgDelayDescr; + PImgDelayDescr = ^ImgDelayDescr; + +(* + // DelayImp.h, Borland BCC 5.5 + {$EXTERNALSYM ImgDelayDescr} + ImgDelayDescr = packed record + grAttrs: DWORD; // attributes + szName: LPCSTR; // pointer to dll name + { TODO : probably wrong declaration } + hmod: HMODULE; // address of module handle + pIAT: PIMAGE_THUNK_DATA; // address of the IAT + pINT: PIMAGE_THUNK_DATA; // address of the INT + pBoundIAT: PIMAGE_THUNK_DATA; // address of the optional bound IAT + pUnloadIAT: PIMAGE_THUNK_DATA; // 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; + TImgDelayDescr = ImgDelayDescr; + PImgDelayDescr = ^ImgDelayDescr; + + + // Microsoft version (64 bit SDK) + {$EXTERNALSYM RVA} + RVA = DWORD; + + {$EXTERNALSYM ImgDelayDescr} + ImgDelayDescr = 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 PImgDelayDescr} + PImgDelayDescr = ImgDelayDescr; + TImgDelayDescr = ImgDelayDescr; +*) diff --git a/official/1.96/source/prototypes/win32api/ImageHlp.imp b/official/1.96/source/prototypes/win32api/ImageHlp.imp new file mode 100644 index 0000000..7bd88f6 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/ImageHlp.imp @@ -0,0 +1,203 @@ +{$IFDEF MSWINDOWS} + +const + ImageHlpLib = 'imagehlp.dll'; + +var + _ReBaseImage: Pointer; + +function ReBaseImage; +begin + GetProcedureAddress(_ReBaseImage, ImageHlpLib, 'ReBaseImage'); + asm + mov esp, ebp + pop ebp + jmp [_ReBaseImage] + end; +end; + +var + _CheckSumMappedFile: Pointer; + +function CheckSumMappedFile; +begin + GetProcedureAddress(_CheckSumMappedFile, ImageHlpLib, 'CheckSumMappedFile'); + asm + mov esp, ebp + pop ebp + jmp [_CheckSumMappedFile] + end; +end; + +var + _GetImageUnusedHeaderBytes: Pointer; + +function GetImageUnusedHeaderBytes; +begin + GetProcedureAddress(_GetImageUnusedHeaderBytes, ImageHlpLib, 'GetImageUnusedHeaderBytes'); + asm + mov esp, ebp + pop ebp + jmp [_GetImageUnusedHeaderBytes] + end; +end; + +var + _MapAndLoad: Pointer; + +function MapAndLoad; +begin + GetProcedureAddress(_MapAndLoad, ImageHlpLib, 'MapAndLoad'); + asm + mov esp, ebp + pop ebp + jmp [_MapAndLoad] + end; +end; + +var + _UnMapAndLoad: Pointer; + +function UnMapAndLoad; +begin + GetProcedureAddress(_UnMapAndLoad, ImageHlpLib, 'UnMapAndLoad'); + asm + mov esp, ebp + pop ebp + jmp [_UnMapAndLoad] + end; +end; + +var + _TouchFileTimes: Pointer; + +function TouchFileTimes; +begin + GetProcedureAddress(_TouchFileTimes, ImageHlpLib, 'TouchFileTimes'); + asm + mov esp, ebp + pop ebp + jmp [_TouchFileTimes] + end; +end; + +var + _ImageDirectoryEntryToData: Pointer; + +function ImageDirectoryEntryToData; +begin + GetProcedureAddress(_ImageDirectoryEntryToData, ImageHlpLib, 'ImageDirectoryEntryToData'); + asm + mov esp, ebp + pop ebp + jmp [_ImageDirectoryEntryToData] + end; +end; + +var + _ImageRvaToSection: Pointer; + +function ImageRvaToSection; +begin + GetProcedureAddress(_ImageRvaToSection, ImageHlpLib, 'ImageRvaToSection'); + asm + mov esp, ebp + pop ebp + jmp [_ImageRvaToSection] + end; +end; + +var + _ImageRvaToVa: Pointer; + +function ImageRvaToVa; +begin + GetProcedureAddress(_ImageRvaToVa, ImageHlpLib, 'ImageRvaToVa'); + asm + mov esp, ebp + pop ebp + jmp [_ImageRvaToVa] + end; +end; + +var + _UnDecorateSymbolName: Pointer; + +function UnDecorateSymbolName; +begin + GetProcedureAddress(_UnDecorateSymbolName, ImageHlpLib, 'UnDecorateSymbolName'); + asm + mov esp, ebp + pop ebp + jmp [_UnDecorateSymbolName] + end; +end; + +{$ENDIF MSWINDOWS} + +{$IFDEF UNIX} + +function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: ULONG; var OldImageBase: ULONG_PTR; var NewImageSize: ULONG; + var NewImageBase: ULONG_PTR; TimeStamp: ULONG): BOOL; +begin + Result := False; +end; + +function CheckSumMappedFile(BaseAddress: Pointer; FileLength: DWORD; + out HeaderSum, CheckSum: DWORD): PImageNtHeaders; +begin + HeaderSum := 0; + CheckSum := 0; + Result := nil; +end; + +function GetImageUnusedHeaderBytes(const LoadedImage: LOADED_IMAGE; + var SizeUnusedHeaderBytes: DWORD): DWORD; +begin + SizeUnusedHeaderBytes := 0; + Result := 0; +end; + +function MapAndLoad(ImageName, DllPath: PChar; var LoadedImage: LOADED_IMAGE; + DotDll: BOOL; ReadOnly: BOOL): BOOL; +begin + Result := False; +end; + +function UnMapAndLoad(const LoadedImage: LOADED_IMAGE): BOOL; +begin + Result := False; +end; + +function TouchFileTimes(const FileHandle: THandle; const pSystemTime: TSystemTime): BOOL; +begin + Result := False; +end; + +function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool; + DirectoryEntry: USHORT; var Size: ULONG): Pointer; +begin + Size := 0; + Result := nil; +end; + +function ImageRvaToSection(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG): PImageSectionHeader; +begin + Result := nil; +end; + +function ImageRvaToVa(NtHeaders: PImageNtHeaders; Base: Pointer; Rva: ULONG; + LastRvaSection: PPImageSectionHeader): Pointer; +begin + Result := nil; +end; + +function UnDecorateSymbolName(DecoratedName: PAnsiChar; UnDecoratedName: PAnsiChar; + UndecoratedLength: DWORD; Flags: DWORD): DWORD; +begin + Result := 0; +end; + +{$ENDIF UNIX} diff --git a/official/1.96/source/prototypes/win32api/ImageHlp.int b/official/1.96/source/prototypes/win32api/ImageHlp.int new file mode 100644 index 0000000..680d28d --- /dev/null +++ b/official/1.96/source/prototypes/win32api/ImageHlp.int @@ -0,0 +1,124 @@ +const + IMAGE_SEPARATION = (64*1024); + {$EXTERNALSYM IMAGE_SEPARATION} + +type + PLOADED_IMAGE = ^LOADED_IMAGE; + {$EXTERNALSYM PLOADED_IMAGE} + _LOADED_IMAGE = record + ModuleName: PChar; + hFile: THandle; + MappedAddress: PAnsiChar; // 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; + +// line 152 + +function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: ULONG; var OldImageBase: ULONG_PTR; var NewImageSize: ULONG; + var NewImageBase: ULONG_PTR; TimeStamp: ULONG): BOOL; stdcall; +{$EXTERNALSYM ReBaseImage} + +// 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: PChar; 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} + +function UnDecorateSymbolName(DecoratedName: PAnsiChar; UnDecoratedName: PAnsiChar; + UndecoratedLength: DWORD; Flags: DWORD): DWORD; stdcall; +{$EXTERNALSYM UnDecorateSymbolName} + + diff --git a/official/1.96/source/prototypes/win32api/LmAccess.imp b/official/1.96/source/prototypes/win32api/LmAccess.imp new file mode 100644 index 0000000..fd13d04 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/LmAccess.imp @@ -0,0 +1,406 @@ +{$IFDEF MSWINDOWS} + +var + _NetUserAdd: Pointer; + +function NetUserAdd; +begin + GetProcedureAddress(_NetUserAdd, netapi32, 'NetUserAdd'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserAdd] + end; +end; + +var + _NetUserEnum: Pointer; + +function NetUserEnum; +begin + GetProcedureAddress(_NetUserEnum, netapi32, 'NetUserEnum'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserEnum] + end; +end; + +var + _NetUserGetInfo: Pointer; + +function NetUserGetInfo; +begin + GetProcedureAddress(_NetUserGetInfo, netapi32, 'NetUserGetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserGetInfo] + end; +end; + +var + _NetUserSetInfo: Pointer; + +function NetUserSetInfo; +begin + GetProcedureAddress(_NetUserSetInfo, netapi32, 'NetUserSetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserSetInfo] + end; +end; + +var + _NetUserDel: Pointer; + +function NetUserDel; +begin + GetProcedureAddress(_NetUserDel, netapi32, 'NetUserDel'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserDel] + end; +end; + +var + _NetUserGetGroups: Pointer; + +function NetUserGetGroups; +begin + GetProcedureAddress(_NetUserGetGroups, netapi32, 'NetUserGetGroups'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserGetGroups] + end; +end; + +var + _NetUserSetGroups: Pointer; + +function NetUserSetGroups; +begin + GetProcedureAddress(_NetUserSetGroups, netapi32, 'NetUserSetGroups'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserSetGroups] + end; +end; + +var + _NetUserGetLocalGroups: Pointer; + +function NetUserGetLocalGroups; +begin + GetProcedureAddress(_NetUserGetLocalGroups, netapi32, 'NetUserGetLocalGroups'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserGetLocalGroups] + end; +end; + +var + _NetUserModalsGet: Pointer; + +function NetUserModalsGet; +begin + GetProcedureAddress(_NetUserModalsGet, netapi32, 'NetUserModalsGet'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserModalsGet] + end; +end; + +var + _NetUserModalsSet: Pointer; + +function NetUserModalsSet; +begin + GetProcedureAddress(_NetUserModalsSet, netapi32, 'NetUserModalsSet'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserModalsSet] + end; +end; + +var + _NetUserChangePassword: Pointer; + +function NetUserChangePassword; +begin + GetProcedureAddress(_NetUserChangePassword, netapi32, 'NetUserChangePassword'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserChangePassword] + end; +end; + +var + _NetGroupAdd: Pointer; + +function NetGroupAdd; +begin + GetProcedureAddress(_NetGroupAdd, netapi32, 'NetGroupAdd'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupAdd] + end; +end; + +var + _NetGroupAddUser: Pointer; + +function NetGroupAddUser; +begin + GetProcedureAddress(_NetGroupAddUser, netapi32, 'NetGroupAddUser'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupAddUser] + end; +end; + +var + _NetGroupEnum: Pointer; + +function NetGroupEnum; +begin + GetProcedureAddress(_NetGroupEnum, netapi32, 'NetGroupEnum'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupEnum] + end; +end; + +var + _NetGroupGetInfo: Pointer; + +function NetGroupGetInfo; +begin + GetProcedureAddress(_NetGroupGetInfo, netapi32, 'NetGroupGetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupGetInfo] + end; +end; + +var + _NetGroupSetInfo: Pointer; + +function NetGroupSetInfo; +begin + GetProcedureAddress(_NetGroupSetInfo, netapi32, 'NetGroupSetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupSetInfo] + end; +end; + +var + _NetGroupDel: Pointer; + +function NetGroupDel; +begin + GetProcedureAddress(_NetGroupDel, netapi32, 'NetGroupDel'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupDel] + end; +end; + +var + _NetGroupDelUser: Pointer; + +function NetGroupDelUser; +begin + GetProcedureAddress(_NetGroupDelUser, netapi32, 'NetGroupDelUser'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupDelUser] + end; +end; + +var + _NetGroupGetUsers: Pointer; + +function NetGroupGetUsers; +begin + GetProcedureAddress(_NetGroupGetUsers, netapi32, 'NetGroupGetUsers'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupGetUsers] + end; +end; + +var + _NetGroupSetUsers: Pointer; + +function NetGroupSetUsers; +begin + GetProcedureAddress(_NetGroupSetUsers, netapi32, 'NetGroupSetUsers'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupSetUsers] + end; +end; + +var + _NetLocalGroupAdd: Pointer; + +function NetLocalGroupAdd; +begin + GetProcedureAddress(_NetLocalGroupAdd, netapi32, 'NetLocalGroupAdd'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupAdd] + end; +end; + +var + _NetLocalGroupAddMember: Pointer; + +function NetLocalGroupAddMember; +begin + GetProcedureAddress(_NetLocalGroupAddMember, netapi32, 'NetLocalGroupAddMember'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupAddMember] + end; +end; + +var + _NetLocalGroupEnum: Pointer; + +function NetLocalGroupEnum; +begin + GetProcedureAddress(_NetLocalGroupEnum, netapi32, 'NetLocalGroupEnum'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupEnum] + end; +end; + +var + _NetLocalGroupGetInfo: Pointer; + +function NetLocalGroupGetInfo; +begin + GetProcedureAddress(_NetLocalGroupGetInfo, netapi32, 'NetLocalGroupGetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupGetInfo] + end; +end; + +var + _NetLocalGroupSetInfo: Pointer; + +function NetLocalGroupSetInfo; +begin + GetProcedureAddress(_NetLocalGroupSetInfo, netapi32, 'NetLocalGroupSetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupSetInfo] + end; +end; + +var + _NetLocalGroupDel: Pointer; + +function NetLocalGroupDel; +begin + GetProcedureAddress(_NetLocalGroupDel, netapi32, 'NetLocalGroupDel'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupDel] + end; +end; + +var + _NetLocalGroupDelMember: Pointer; + +function NetLocalGroupDelMember; +begin + GetProcedureAddress(_NetLocalGroupDelMember, netapi32, 'NetLocalGroupDelMember'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupDelMember] + end; +end; + +var + _NetLocalGroupGetMembers: Pointer; + +function NetLocalGroupGetMembers; +begin + GetProcedureAddress(_NetLocalGroupGetMembers, netapi32, 'NetLocalGroupGetMembers'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupGetMembers] + end; +end; + +var + _NetLocalGroupSetMembers: Pointer; + +function NetLocalGroupSetMembers; +begin + GetProcedureAddress(_NetLocalGroupSetMembers, netapi32, 'NetLocalGroupSetMembers'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupSetMembers] + end; +end; + +var + _NetLocalGroupAddMembers: Pointer; + +function NetLocalGroupAddMembers; +begin + GetProcedureAddress(_NetLocalGroupAddMembers, netapi32, 'NetLocalGroupAddMembers'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupAddMembers] + end; +end; + +var + _NetLocalGroupDelMembers: Pointer; + +function NetLocalGroupDelMembers; +begin + GetProcedureAddress(_NetLocalGroupDelMembers, netapi32, 'NetLocalGroupDelMembers'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupDelMembers] + end; +end; + +{$ENDIF MSWINDOWS} diff --git a/official/1.96/source/prototypes/win32api/LmAccess.int b/official/1.96/source/prototypes/win32api/LmAccess.int new file mode 100644 index 0000000..973c0fe --- /dev/null +++ b/official/1.96/source/prototypes/win32api/LmAccess.int @@ -0,0 +1,460 @@ +// 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 + 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; + + 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; + + 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; + +// 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 + 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; + + 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; + + 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; + + 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; + + 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; diff --git a/official/1.96/source/prototypes/win32api/LmApiBuf.imp b/official/1.96/source/prototypes/win32api/LmApiBuf.imp new file mode 100644 index 0000000..c32422a --- /dev/null +++ b/official/1.96/source/prototypes/win32api/LmApiBuf.imp @@ -0,0 +1,16 @@ +{$IFDEF MSWINDOWS} + +var + _NetApiBufferFree: Pointer; + +function NetApiBufferFree; +begin + GetProcedureAddress(_NetApiBufferFree, netapi32, 'NetApiBufferFree'); + asm + mov esp, ebp + pop ebp + jmp [_NetApiBufferFree] + end; +end; + +{$ENDIF MSWINDOWS} diff --git a/official/1.96/source/prototypes/win32api/LmApiBuf.int b/official/1.96/source/prototypes/win32api/LmApiBuf.int new file mode 100644 index 0000000..8975bfa --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/LmCons.int b/official/1.96/source/prototypes/win32api/LmCons.int new file mode 100644 index 0000000..eb94576 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/LmCons.int @@ -0,0 +1,284 @@ +// 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 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} + +type + LMSTR = LPSTR; + {$EXTERNALSYM LMSTR} + LMCSTR = LPCSTR; + {$EXTERNALSYM LMCSTR} + +{$ENDIF} + +{$UNDEF 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/official/1.96/source/prototypes/win32api/LmErr.int b/official/1.96/source/prototypes/win32api/LmErr.int new file mode 100644 index 0000000..5768036 --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/NTDef.int b/official/1.96/source/prototypes/win32api/NTDef.int new file mode 100644 index 0000000..42bdbba --- /dev/null +++ b/official/1.96/source/prototypes/win32api/NTDef.int @@ -0,0 +1,27 @@ +// ntdef.h + +type + +//typedef double DOUBLE; + + PQuad = ^TQuad; + _QUAD = record // QUAD is for those times we want + DoNotUseThisField: Double; // an 8 byte aligned 8 byte long structure + end; // which is NOT really a floating point + {$EXTERNALSYM _QUAD} // number. Use DOUBLE if you want an FP number. + QUAD = _QUAD; + {$EXTERNALSYM QUAD} + TQuad = _QUAD; + +// +// Unsigned Basics +// + + UCHAR = {$IFDEF USE_DELPHI_TYPES}Windows.UCHAR{$ELSE}Char{$ENDIF}; + {$EXTERNALSYM UCHAR} + USHORT = Word; + {$EXTERNALSYM USHORT} + ULONG = {$IFDEF USE_DELPHI_TYPES}Windows.ULONG{$ELSE}Longword{$ENDIF}; + {$EXTERNALSYM ULONG} + UQUAD = QUAD; + {$EXTERNALSYM UQUAD} diff --git a/official/1.96/source/prototypes/win32api/Nb30.imp b/official/1.96/source/prototypes/win32api/Nb30.imp new file mode 100644 index 0000000..e1ece1f --- /dev/null +++ b/official/1.96/source/prototypes/win32api/Nb30.imp @@ -0,0 +1,16 @@ +{$IFDEF MSWINDOWS} + +var + _Netbios: Pointer; + +function Netbios; +begin + GetProcedureAddress(_Netbios, 'netapi32.dll', 'Netbios'); + asm + mov esp, ebp + pop ebp + jmp [_Netbios] + end; +end; + +{$ENDIF MSWINDOWS} diff --git a/official/1.96/source/prototypes/win32api/Nb30.int b/official/1.96/source/prototypes/win32api/Nb30.int new file mode 100644 index 0000000..6055e91 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/Nb30.int @@ -0,0 +1,424 @@ +(**************************************************************** + * * + * 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 + PNCB = ^NCB; + + TNcbPost = procedure (P: PNCB); stdcall; + + _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: PChar; // address of message buffer + ncb_length: Word; // size of message buffer + ncb_callname: array [0..NCBNAMSZ - 1] of Char; // blank-padded name of remote + ncb_name: array [0..NCBNAMSZ - 1] of Char; // 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 Char; // reserved, used by BIOS + {$ELSE} + ncb_reserve: array [0..9] of Char; // reserved, used by BIOS + {$ENDIF} + 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; + +// +// Structure returned to the NCB command NCBASTAT is ADAPTER_STATUS followed +// by an array of NAME_BUFFER structures. +// + + _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 Char; + 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; + +// 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. +// + +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; + +// 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. +// + +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; + +// +// Structure returned to the NCB command NCBFINDNAME is FIND_NAME_HEADER followed +// by an array of FIND_NAME_BUFFER structures. +// + +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; + +// 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/official/1.96/source/prototypes/win32api/RasDlg.int b/official/1.96/source/prototypes/win32api/RasDlg.int new file mode 100644 index 0000000..5c57d62 --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/Reason.int b/official/1.96/source/prototypes/win32api/Reason.int new file mode 100644 index 0000000..8c5a0aa --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/ShlObj.int b/official/1.96/source/prototypes/win32api/ShlObj.int new file mode 100644 index 0000000..8e52004 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/ShlObj.int @@ -0,0 +1,44 @@ + +const + 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_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_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} + diff --git a/official/1.96/source/prototypes/win32api/ShlWApi.int b/official/1.96/source/prototypes/win32api/ShlWApi.int new file mode 100644 index 0000000..808fef8 --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/WinBase.imp b/official/1.96/source/prototypes/win32api/WinBase.imp new file mode 100644 index 0000000..9952355 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/WinBase.imp @@ -0,0 +1,166 @@ +{$IFDEF MSWINDOWS} + +var + _BackupSeek: Pointer; + +function BackupSeek; +begin + GetProcedureAddress(_BackupSeek, kernel32, 'BackupSeek'); + asm + mov esp, ebp + pop ebp + jmp [_BackupSeek] + end; +end; + +var + _AdjustTokenPrivileges: Pointer; + +function AdjustTokenPrivileges; +begin + GetProcedureAddress(_AdjustTokenPrivileges, advapi32, 'AdjustTokenPrivileges'); + asm + mov esp, ebp + pop ebp + jmp [_AdjustTokenPrivileges] + end; +end; + +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: DWORD; lpName: PChar): THandle; stdcall; + external kernel32 name 'CreateMutexA'; + +function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall; + external kernel32 name 'GetVersionExA'; +function GetVersionEx(lpVersionInformation: POSVersionInfoEx): BOOL; stdcall; + external kernel32 name 'GetVersionExA'; + +var + _SetWaitableTimer: Pointer; + +function SetWaitableTimer; +begin + GetProcedureAddress(_SetWaitableTimer, kernel32, 'SetWaitableTimer'); + asm + mov esp, ebp + pop ebp + jmp [_SetWaitableTimer] + end; +end; +var + _SetFileSecurityA: Pointer; + +function SetFileSecurityA; +begin + GetProcedureAddress(_SetFileSecurityA, advapi32, 'SetFileSecurityA'); + asm + MOV ESP, EBP + POP EBP + JMP [_SetFileSecurityA] + end; +end; + +var + _SetFileSecurityW: Pointer; + +function SetFileSecurityW; +begin + GetProcedureAddress(_SetFileSecurityW, advapi32, 'SetFileSecurityW'); + asm + MOV ESP, EBP + POP EBP + JMP [_SetFileSecurityW] + end; +end; + +var + _SetFileSecurity: Pointer; + +function SetFileSecurity; +begin + GetProcedureAddress(_SetFileSecurity, advapi32, 'SetFileSecurity' + AWSuffix); + asm + MOV ESP, EBP + POP EBP + JMP [_SetFileSecurity] + end; +end; + +var + _GetFileSecurityA: Pointer; + +function GetFileSecurityA; +begin + GetProcedureAddress(_GetFileSecurityA, advapi32, 'GetFileSecurityA'); + asm + MOV ESP, EBP + POP EBP + JMP [_GetFileSecurityA] + end; +end; + +var + _GetFileSecurityW: Pointer; + +function GetFileSecurityW; +begin + GetProcedureAddress(_GetFileSecurityW, advapi32, 'GetFileSecurityW'); + asm + MOV ESP, EBP + POP EBP + JMP [_GetFileSecurityW] + end; +end; + +var + _GetFileSecurity: Pointer; + +function GetFileSecurity; +begin + GetProcedureAddress(_GetFileSecurity, advapi32, 'GetFileSecurity' + AWSuffix); + asm + MOV ESP, EBP + POP EBP + JMP [_GetFileSecurity] + end; +end; + +var + _SetVolumeMountPoint: Pointer; + +function SetVolumeMountPoint; +begin + GetProcedureAddress(_SetVolumeMountPoint, kernel32, 'SetVolumeMountPointA'); + asm + mov esp, ebp + pop ebp + jmp [_SetVolumeMountPoint] + end; +end; + +var + _DeleteVolumeMountPoint: Pointer; + +function DeleteVolumeMountPoint; +begin + GetProcedureAddress(_DeleteVolumeMountPoint, kernel32, 'DeleteVolumeMountPointA'); + asm + mov esp, ebp + pop ebp + jmp [_DeleteVolumeMountPoint] + end; +end; + +var + _GetVolumeNameForVolMountPoint: Pointer; + +function GetVolumeNameForVolumeMountPoint; +begin + GetProcedureAddress(_GetVolumeNameForVolMountPoint, kernel32, 'GetVolumeNameForVolumeMountPointA'); + asm + mov esp, ebp + pop ebp + jmp [_GetVolumeNameForVolMountPoint] + end; +end; + +{$ENDIF MSWINDOWS} diff --git a/official/1.96/source/prototypes/win32api/WinBase.int b/official/1.96/source/prototypes/win32api/WinBase.int new file mode 100644 index 0000000..b1320ce --- /dev/null +++ b/official/1.96/source/prototypes/win32api/WinBase.int @@ -0,0 +1,130 @@ +// 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 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 SetFileSecurityA} + +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 GetFileSecurityA} + +// WinBase.h line 10251 + +function SetVolumeMountPoint(lpszVolumeMountPoint, lpszVolumeName: LPCSTR): BOOL; stdcall; +{$EXTERNALSYM SetVolumeMountPoint} + +function DeleteVolumeMountPoint(lpszVolumeMountPoint: LPCSTR): BOOL; stdcall; +{$EXTERNALSYM DeleteVolumeMountPoint} + +function GetVolumeNameForVolumeMountPoint(lpszVolumeMountPoint: LPCSTR; + lpszVolumeName: LPSTR; cchBufferLength: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetVolumeNameForVolumeMountPoint} + +{$ENDIF MSWINDOWS} diff --git a/official/1.96/source/prototypes/win32api/WinDef.int b/official/1.96/source/prototypes/win32api/WinDef.int new file mode 100644 index 0000000..c5fc176 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/WinDef.int @@ -0,0 +1,9 @@ +type + +// +// Unsigned Basics +// + + USHORT = Word; + {$EXTERNALSYM USHORT} + diff --git a/official/1.96/source/prototypes/win32api/WinError.int b/official/1.96/source/prototypes/win32api/WinError.int new file mode 100644 index 0000000..bab5352 --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/WinIoctl.int b/official/1.96/source/prototypes/win32api/WinIoctl.int new file mode 100644 index 0000000..ffcf83c --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/WinNLS.imp b/official/1.96/source/prototypes/win32api/WinNLS.imp new file mode 100644 index 0000000..cbb1f15 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/WinNLS.imp @@ -0,0 +1,42 @@ +{$IFDEF MSWINDOWS} + +var + _GetCalendarInfoA: Pointer; + +function GetCalendarInfoA; +begin + GetProcedureAddress(_GetCalendarInfoA, kernel32, 'GetCalendarInfoA'); + asm + mov esp, ebp + pop ebp + jmp [_GetCalendarInfoA] + end; +end; + +var + _GetCalendarInfoW: Pointer; + +function GetCalendarInfoW; +begin + GetProcedureAddress(_GetCalendarInfoW, kernel32, 'GetCalendarInfoW'); + asm + mov esp, ebp + pop ebp + jmp [_GetCalendarInfoW] + end; +end; + +var + _EnumCalendarInfoExA: Pointer; + +function EnumCalendarInfoExA; +begin + GetProcedureAddress(_EnumCalendarInfoExA, kernel32, 'EnumCalendarInfoExA'); + asm + mov esp, ebp + pop ebp + jmp [_EnumCalendarInfoExA] + end; +end; + +{$ENDIF MSWINDOWS} diff --git a/official/1.96/source/prototypes/win32api/WinNLS.int b/official/1.96/source/prototypes/win32api/WinNLS.int new file mode 100644 index 0000000..f1da4ac --- /dev/null +++ b/official/1.96/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_ENUMPROCEXA = function (lpCalendarInfoString: LPSTR; Calendar: CALID): BOOL; stdcall; + {$EXTERNALSYM CALINFO_ENUMPROCEXA} + TCalInfoEnumProcExA = CALINFO_ENUMPROCEXA; + +// 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 EnumCalendarInfoExA(lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXA; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall; +{$EXTERNALSYM EnumCalendarInfoExA} + +{$ENDIF MSWINDOWS} diff --git a/official/1.96/source/prototypes/win32api/WinNT.imp b/official/1.96/source/prototypes/win32api/WinNT.imp new file mode 100644 index 0000000..cb0be64 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/WinNT.imp @@ -0,0 +1,105 @@ +// 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; + +// 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 FieldOffset(const Struc; const Field): Cardinal; +begin + Result := Cardinal(@Field) - Cardinal(@Struc); +end; + +function IMAGE_FIRST_SECTION(NtHeader: PImageNtHeaders): PImageSectionHeader; +begin + Result := PImageSectionHeader(Cardinal(NtHeader) + + FieldOffset(NtHeader^, NtHeader^.OptionalHeader) + + NtHeader^.FileHeader.SizeOfOptionalHeader); +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/official/1.96/source/prototypes/win32api/WinNT.int b/official/1.96/source/prototypes/win32api/WinNT.int new file mode 100644 index 0000000..8d4f133 --- /dev/null +++ b/official/1.96/source/prototypes/win32api/WinNT.int @@ -0,0 +1,2728 @@ +//================================================================================================== +// 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 and MountPointReparseBuffer + SubstituteNameOffset: Word; + SubstituteNameLength: Word; + PrintNameOffset: Word; + PrintNameLength: Word; + PathBuffer: array [0..0] of WCHAR); + 1: ( // GenericReparseBuffer + DataBuffer: array [0..0] of Byte); + 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) + +type + ULONGLONG = Int64; + {$EXTERNALSYM ULONGLONG} + +const + MAXLONGLONG = $7fffffffffffffff; + {$EXTERNALSYM MAXLONGLONG} + +type + PLONGLONG = ^LONGLONG; + {$EXTERNALSYM PLONGLONG} + PULONGLONG = ^ULONGLONG; + {$EXTERNALSYM PULONGLONG} + +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} + +// 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[] - - - - - - - - -+ +// | | +// +---------------------------------------------------------------+ +// +// + +type + // 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; + +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} +{$ENDIF ~FPC} + +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; + +///////////////////////////////////////////////////////////////////////////// +// // +// 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} + + +// line 2686 + +// +// Token information class structures +// + +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; + +// 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_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_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. +// + +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; + +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. +// + +{$IFDEF FPC} + +type + PIMAGE_DATA_DIRECTORY = ^IMAGE_DATA_DIRECTORY; + {$EXTERNALSYM PIMAGE_DATA_DIRECTORY} + _IMAGE_DATA_DIRECTORY = record + VirtualAddress: DWORD; + Size: DWORD; + end; + {$EXTERNALSYM _IMAGE_DATA_DIRECTORY} + IMAGE_DATA_DIRECTORY = _IMAGE_DATA_DIRECTORY; + {$EXTERNALSYM IMAGE_DATA_DIRECTORY} + TImageDataDirectory = IMAGE_DATA_DIRECTORY; + PImageDataDirectory = PIMAGE_DATA_DIRECTORY; + +{$ENDIF FPC} + +const + IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16; + {$EXTERNALSYM IMAGE_NUMBEROF_DIRECTORY_ENTRIES} + +// +// Optional header format. +// + +type + PIMAGE_OPTIONAL_HEADER32 = ^IMAGE_OPTIONAL_HEADER32; + {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER32} + +{$IFDEF FPC} + + _IMAGE_OPTIONAL_HEADER = record + // + // Standard fields. + // + Magic: Word; + MajorLinkerVersion: Byte; + MinorLinkerVersion: Byte; + SizeOfCode: DWORD; + SizeOfInitializedData: DWORD; + SizeOfUninitializedData: DWORD; + AddressOfEntryPoint: DWORD; + BaseOfCode: DWORD; + BaseOfData: DWORD; + // + // NT additional fields. + // + ImageBase: DWORD; + 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: DWORD; + SizeOfStackCommit: DWORD; + SizeOfHeapReserve: DWORD; + SizeOfHeapCommit: DWORD; + LoaderFlags: DWORD; + NumberOfRvaAndSizes: DWORD; + DataDirectory: array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of IMAGE_DATA_DIRECTORY; + end; + {$EXTERNALSYM _IMAGE_OPTIONAL_HEADER} + +{$ENDIF FPC} + + 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; + +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} + +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; + +{$IFDEF FPC} + + PIMAGE_ROM_HEADERS = ^IMAGE_ROM_HEADERS; + {$EXTERNALSYM PIMAGE_ROM_HEADERS} + _IMAGE_ROM_HEADERS = record + FileHeader: IMAGE_FILE_HEADER; + OptionalHeader: IMAGE_ROM_OPTIONAL_HEADER; + end; + {$EXTERNALSYM _IMAGE_ROM_HEADERS} + IMAGE_ROM_HEADERS = _IMAGE_ROM_HEADERS; + {$EXTERNALSYM IMAGE_ROM_HEADERS} + TImageRomHeaders = IMAGE_ROM_HEADERS; + PImageRomHeaders = PIMAGE_ROM_HEADERS; + + IMAGE_NT_HEADERS = IMAGE_NT_HEADERS32; + {$EXTERNALSYM IMAGE_NT_HEADERS} + PIMAGE_NT_HEADERS = PIMAGE_NT_HEADERS32; + {$EXTERNALSYM PIMAGE_NT_HEADERS} + + PImageNtHeaders = PIMAGE_NT_HEADERS; + +{$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 +{$IFDEF FPC} + + TImgSecHdrMisc = record + case Integer of + 0: (PhysicalAddress: DWORD); + 1: (VirtualSize: DWORD); + end; + + PIMAGE_SECTION_HEADER = ^IMAGE_SECTION_HEADER; + {$EXTERNALSYM PIMAGE_SECTION_HEADER} + _IMAGE_SECTION_HEADER = record + Name: array [0..IMAGE_SIZEOF_SHORT_NAME - 1] of BYTE; + Misc: TImgSecHdrMisc; + VirtualAddress: DWORD; + SizeOfRawData: DWORD; + PointerToRawData: DWORD; + PointerToRelocations: DWORD; + PointerToLinenumbers: DWORD; + NumberOfRelocations: WORD; + NumberOfLinenumbers: WORD; + Characteristics: DWORD; + end; + {$EXTERNALSYM _IMAGE_SECTION_HEADER} + IMAGE_SECTION_HEADER = _IMAGE_SECTION_HEADER; + {$EXTERNALSYM IMAGE_SECTION_HEADER} + TImageSectionHeader = IMAGE_SECTION_HEADER; + PImageSectionHeader = PIMAGE_SECTION_HEADER; + +{$ENDIF FPC} + + 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; + PImageTlsDirectory64 = PIMAGE_TLS_DIRECTORY64; + + 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; + PImageTlsDirectory32 = PIMAGE_TLS_DIRECTORY32; + +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; + PImageTlsDirectory = PImageTlsDirectory32; + + 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 CHAR; + 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 +// + +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; + +// 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} +*) +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; + +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 + +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; + +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. +// + + 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; + +// +// 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; + {$EXTERNALSYM IMAGE_COR20_HEADER} + PIMAGE_COR20_HEADER = ^IMAGE_COR20_HEADER; + {$EXTERNALSYM PIMAGE_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 CHAR; // 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 UNICODE} + + OSVERSIONINFOEX = OSVERSIONINFOEXW; + {$EXTERNALSYM OSVERSIONINFOEX} + POSVERSIONINFOEX = POSVERSIONINFOEXW; + {$EXTERNALSYM POSVERSIONINFOEX} + LPOSVERSIONINFOEX = LPOSVERSIONINFOEXW; + {$EXTERNALSYM LPOSVERSIONINFOEX} + TOSVersionInfoEx = TOSVersionInfoExW; + +{$ELSE} + + OSVERSIONINFOEX = OSVERSIONINFOEXA; + {$EXTERNALSYM OSVERSIONINFOEX} + POSVERSIONINFOEX = POSVERSIONINFOEXA; + {$EXTERNALSYM POSVERSIONINFOEX} + LPOSVERSIONINFOEX = LPOSVERSIONINFOEXA; + {$EXTERNALSYM LPOSVERSIONINFOEX} + TOSVersionInfoEx = TOSVersionInfoExA; + +{$ENDIF} + +// +// 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} diff --git a/official/1.96/source/prototypes/win32api/WinUser.int b/official/1.96/source/prototypes/win32api/WinUser.int new file mode 100644 index 0000000..977e07f --- /dev/null +++ b/official/1.96/source/prototypes/win32api/WinUser.int @@ -0,0 +1,83 @@ +type + MAKEINTRESOURCEA = LPSTR; + {$EXTERNALSYM MAKEINTRESOURCEA} + MAKEINTRESOURCEW = LPWSTR; + {$EXTERNALSYM MAKEINTRESOURCEW} +{$IFDEF UNICODE} + MAKEINTRESOURCE = MAKEINTRESOURCEW; + {$EXTERNALSYM MAKEINTRESOURCE} +{$ELSE} + MAKEINTRESOURCE = MAKEINTRESOURCEA; + {$EXTERNALSYM MAKEINTRESOURCE} +{$ENDIF} + +// +// 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} + diff --git a/official/1.96/source/prototypes/win32api/dirinfo.txt b/official/1.96/source/prototypes/win32api/dirinfo.txt new file mode 100644 index 0000000..d4d00fa --- /dev/null +++ b/official/1.96/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/official/1.96/source/prototypes/win32api/fpc.inc b/official/1.96/source/prototypes/win32api/fpc.inc new file mode 100644 index 0000000..3e4b12f --- /dev/null +++ b/official/1.96/source/prototypes/win32api/fpc.inc @@ -0,0 +1,71 @@ +// JclWin32 include file for FPC compatibility + +// from unit Windows +const + + // from WinReg.h + HKEY_CLASSES_ROOT = DWORD($80000000); + HKEY_CURRENT_USER = DWORD($80000001); + HKEY_LOCAL_MACHINE = DWORD($80000002); + HKEY_USERS = DWORD($80000003); + HKEY_PERFORMANCE_DATA = DWORD($80000004); + HKEY_CURRENT_CONFIG = DWORD($80000005); + HKEY_DYN_DATA = DWORD($80000006); + + // from WinVer.h + VOS__BASE = 0; + VOS__WINDOWS16 = 1; + VOS__PM16 = 2; + VOS__PM32 = 3; + VOS__WINDOWS32 = 4; + +{ VS_VERSION.dwFileSubtype for VFT_WINDOWS_DRV } + + VFT2_UNKNOWN = 0; + VFT2_DRV_PRINTER = 1; + VFT2_DRV_KEYBOARD = 2; + VFT2_DRV_LANGUAGE = 3; + VFT2_DRV_DISPLAY = 4; + VFT2_DRV_MOUSE = 5; + VFT2_DRV_NETWORK = 6; + VFT2_DRV_SYSTEM = 7; + VFT2_DRV_INSTALLABLE = 8; + VFT2_DRV_SOUND = 9; + VFT2_DRV_COMM = 10; + +type + // from WinBase.h + _GET_FILEEX_INFO_LEVELS = (GetFileExInfoStandard, GetFileExMaxInfoLevel); + TGetFileExInfoLevels = _GET_FILEEX_INFO_LEVELS; + GET_FILEEX_INFO_LEVELS = _GET_FILEEX_INFO_LEVELS; + +type + PKeyboardState = ^TKeyboardState; + TKeyboardState = array [0..255] of Byte; + +// from unit AccCtrl +type + SE_OBJECT_TYPE = ( + SE_UNKNOWN_OBJECT_TYPE, + SE_FILE_OBJECT, + SE_SERVICE, + SE_PRINTER, + SE_REGISTRY_KEY, + SE_LMSHARE, + SE_KERNEL_OBJECT, + SE_WINDOW_OBJECT, + SE_DS_OBJECT, + SE_DS_OBJECT_ALL, + SE_PROVIDER_DEFINED_OBJECT, + SE_WMIGUID_OBJECT + ); + +// from ActiveX +const + // from OleIdl.h, OleIdl.Idl + DROPEFFECT_NONE = 0; + DROPEFFECT_COPY = 1; + DROPEFFECT_MOVE = 2; + DROPEFFECT_LINK = 4; + DROPEFFECT_SCROLL = DWORD($80000000); + diff --git a/official/1.96/source/prototypes/zlibh.pas b/official/1.96/source/prototypes/zlibh.pas new file mode 100644 index 0000000..8589167 --- /dev/null +++ b/official/1.96/source/prototypes/zlibh.pas @@ -0,0 +1,1724 @@ +{ 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). +} + +{$I jedi.inc} + +{* Set this DEFINE to allow this unit to be linked against a .SO/.DLL + * The name "DLL" was used because e.g. the wxWidgets projects also uses + * this name to refer to dynamic libraries (even on *nix systems). + *} + +{ $DEFINE ZLIB_DLL} + +{ $DEFINE STATIC_GZIO} + +{ TODO: cdecl = zlib1.dll calling convention? } +{$IFDEF ZLIB_DLL} + {$DEFINE ZEXPORT_CDECL} + {$UNDEF STATIC_GZIO} +{$ENDIF ZLIB_DLL} + +{$IFDEF ZLIB_DLL} +{$HPPEMIT '#define ZLIB_DLL'} +{$ELSE ~ZLIB_DLL} +{$HPPEMIT '#define ZEXPORT __fastcall'} +{$ENDIF ~ZLIB_DLL} + +{$IFDEF ZEXPORT_CDECL} +{$HPPEMIT '#define ZEXPORT __cdecl'} +{$ENDIF ZEXPORT_CDECL} + +{$HPPEMIT '#define ZEXPORTVA __cdecl'} + +{$HPPEMIT '#include '} + +unit zlibh; + +interface + +{$IFDEF MSWINDOWS} +uses + Windows; +{$ENDIF MSWINDOWS} +{$IFDEF HAS_UNIT_LIBC} +uses + Libc; +{$ELSE ~HAS_UNIT_LIBC} +type +{$IFDEF UNIX} + uLong = LongWord; + {$EXTERNALSYM uLong} + uInt = Cardinal; + {$EXTERNALSYM uInt} +{$ENDIF UNIX} + uShort = Word; + {$EXTERNALSYM uShort} + size_t = Longint; + {$EXTERNALSYM size_t} +{$ENDIF ~HAS_UNIT_LIBC} + +//----------------------------------------------------------------------------- +// 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.2'; + {$EXTERNALSYM ZLIB_VERNUM} + ZLIB_VERNUM =$1210; + +{* + 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; + {$EXTERNALSYM free_func} + free_func = procedure(opaque:voidpf; address:voidpf); + TFNAllocFunc = alloc_func; + TFNFreeFunc = free_func; + +type + {$EXTERNALSYM internal_state} + internal_state = packed record end; + TInternalState = internal_state; // backward compatibility + PInternalState = ^internal_state; // backward compatibility + +type + {$EXTERNALSYM z_stream_s} + z_stream_s = packed 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: PChar; // 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; + + {$EXTERNALSYM z_stream} + z_stream = z_stream_s; + {$EXTERNALSYM z_streamp} + z_streamp = ^z_stream_s; + + TZStreamRec = z_stream_s; + 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; + +{* 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_DEFAULT_STRATEGY} + Z_DEFAULT_STRATEGY = 0; +{* compression strategy; see deflateInit2() below for details *} + + {$EXTERNALSYM Z_BINARY} + Z_BINARY = 0; + {$EXTERNALSYM Z_ASCII} + Z_ASCII = 1; + {$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 *} + +{* for compatibility with versions < 1.0.2 *} + + {* basic functions *} + +{$EXTERNALSYM zlibVersion} +function zlibVersion(): PChar; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* 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. + *} + +{$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(). +*} + +{$EXTERNALSYM deflate} +function deflate(var strm: TZStreamRec; flush: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM deflateEnd} +function deflateEnd(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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). +*} + +{$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.) +*} + +{$EXTERNALSYM inflate} +function inflate(strm: TZStreamRec; flush: Integer): Integer; +{* + 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. +*} + +{$EXTERNALSYM inflateEnd} +function inflateEnd(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$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(). +*} + +{$EXTERNALSYM deflateSetDictionary} +function deflateSetDictionary(var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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(). +*} + +{$EXTERNALSYM deflateCopy} +function deflateCopy(var dest: TZStreamRec; + var source: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM deflateReset} +function deflateReset(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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). +*} + +{$EXTERNALSYM deflateParams} +function deflateParams(var strm: TZStreamRec; + level: Integer; + strategy: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM deflateBound} +function deflateBound(var strm: TZStreamRec; + sourceLen:uLong):uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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(). +*} + +{$EXTERNALSYM deflatePrime} +function deflatePrime(var strm: TZStreamRec; + bits: Integer; + value: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$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.) +*} + +{$EXTERNALSYM inflateSetDictionary} +function inflateSetDictionary(var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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(). +*} + +{$EXTERNALSYM inflateSync} +function inflateSync(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM inflateCopy} +function inflateCopy(var dest: TZStreamRec; + var source: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM inflateReset} +function inflateReset(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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). +*} + +{$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; + TFNInFunc = in_func; + TFNOutFunc = out_func; + +{$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 ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM inflateBackEnd} +function inflateBackEnd(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + All memory allocated by inflateBackInit() is freed. + + inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream + state was inconsistent. +*} + +{$EXTERNALSYM zlibCompileFlags} +function zlibCompileFlags():uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* 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. +*} + +{$EXTERNALSYM compress} +function compress(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM compress2} +function compress2(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong; + level: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM compressBound} +function compressBound(sourceLen:uLong):uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM uncompress} +function uncompress(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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: PChar; mode: PChar):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: PChar):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: PChar, ...): 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: PChar): 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: PChar; len: Integer): PChar; +{* + 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): PChar; +{* + 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. +*} + +{$EXTERNALSYM adler32} +function adler32(adler:uLong; {const} buf: PBytef; len:uInt):uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +(* + 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(); +*) + +{$EXTERNALSYM crc32} +function crc32 (crc:uLong; {const} buf: PBytef; len:uInt):uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +(* + 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: + *} +{$EXTERNALSYM deflateInit_} +function deflateInit_(var strm:z_stream; + level: Integer; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM inflateInit_} +function inflateInit_(var strm:z_stream; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM deflateInit2_} +function deflateInit2_(var strm:z_stream; + level: Integer; + method: Integer; + windowBits: Integer; + memLevel: Integer; + strategy: Integer; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM inflateInit2_} +function inflateInit2_(var strm:z_stream; + windowBits: Integer; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM inflateBackInit_} +function inflateBackInit_(var strm:z_stream; + windowBits: Integer; + window: PByte; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM zError} +function zError(err: Integer): PChar; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM inflateSyncPoint} +function inflateSyncPoint(var z: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM get_crc_table} +function get_crc_table():PuLongf; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +//----------------------------------------------------------------------------- +// 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} + +implementation + +{$IFDEF ZLIB_DLL} +{$IFNDEF HAS_UNIT_LIBC} +{$IFDEF UNIX} +uses + dl; +{$ENDIF UNIX} +{$ENDIF ~HAS_UNIT_LIBC} + +{$IFDEF MSWINDOWS} +type + TModuleHandle = HINST; +{$ENDIF MSWINDOWS} +{$IFDEF LINUX} +type + TModuleHandle = Pointer; +{$ENDIF LINUX} + +const + {$IFDEF MSWINDOWS} + ZLibModuleName = 'zlib1.dll'; + {$ENDIF MSWINDOWS} + {$IFDEF UNIX} + ZLibModuleName = 'libz.so'; + {$ENDIF UNIX} + INVALID_MODULEHANDLE_VALUE = TModuleHandle(0); + + {$UNDEF LINK_LIBC} + +var + _ZLibModuleHandle: TModuleHandle = INVALID_MODULEHANDLE_VALUE; + +function ZlibModuleHandle: Pointer; +begin + {$IFDEF UNIX} + if _ZLibModuleHandle = INVALID_MODULEHANDLE_VALUE then + _ZLibModuleHandle := dlopen(ZLibModuleName, RTLD_NOW); + Result := _ZLibModuleHandle; + {$ENDIF UNIX} +end; + +function GetFunctionAddress(FunctionName: string): Pointer; +begin + {$IFDEF UNIX} + Result := ZlibModuleHandle; + if Result <> nil then + Result := dlsym(Result, PChar(FunctionName)); {$ENDIF UNIX} +end; + +{$ELSE ~ZLIB_DLL} + +{$LINK obj\adler32.obj} // OS: CHECKTHIS - Kylix version may need forward slashes? +{$LINK obj\compress.obj} +{$LINK obj\crc32.obj} +{$LINK obj\deflate.obj} +{$LINK obj\infback.obj} +{$LINK obj\inffast.obj} +{$LINK obj\inflate.obj} +{$LINK obj\inftrees.obj} +{$LINK obj\trees.obj} +{$LINK obj\uncompr.obj} +{$LINK obj\zutil.obj} +{$IFDEF STATIC_GZIO} +{$LINK obj\gzio.obj} +{$DEFINE LINK_LIBC} +{$ENDIF STATIC_GZIO} + +{$IFDEF MSWINDOWS} + {$IFDEF LINK_LIBC} + {$DEFINE LINKTO_MSVCRT_DLL} + {$ENDIF LINK_LIBC} +{$ENDIF MSWINDOWS} + +{$ENDIF ~ZLIB_DLL} + +// Core functions +function zlibVersion; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function deflateInit_; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; // wrapped by deflateInit() +function deflate; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function deflateEnd; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function inflateInit_; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; // wrapped by inflateInit() +function inflate; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function inflateEnd; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function deflateInit2_; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; // wrapped by deflateInit2() +function deflateSetDictionary; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function deflateCopy; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function deflateReset; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function deflateParams; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function deflateBound; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function deflatePrime; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function inflateInit2_; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; // wrapped by inflateInit2() +function inflateSetDictionary; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function inflateSync; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function inflateCopy; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function inflateReset; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; + +{$IFDEF ZLIB_DLL} +var + _inflateBackInit_: function (var strm:z_stream; windowBits: Integer; + window: PByte; {const} version: PChar; stream_size: Integer): Integer = nil; + +function inflateBackInit_; // wrapped by inflateBackInit() +begin + if not Assigned(_inflateBackInit_) then + _inflateBackInit_ := GetFunctionAddress('inflateBackInit_'); + Result := _inflateBackInit_(strm, windowBits, window, version, stream_size); +end; +{$ELSE} +function inflateBackInit_; external; +{$ENDIF} + +function inflateBack; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function inflateBackEnd; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function zlibCompileFlags; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function compress; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function compress2; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function compressBound; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function uncompress; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; + +// Checksums +function adler32; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function crc32; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; + +function zError; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function inflateSyncPoint; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; +function get_crc_table; external {$IFDEF ZLIB_DLL}ZLibModuleName{$ENDIF}; + +{$IFNDEF ZLIB_DLL} +{$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: PChar; mode: PChar): Pointer; cdecl; external szMSVCRT name 'fopen'; +function _fdopen(handle: Integer; mode: PChar): Pointer; cdecl; external szMSVCRT name '_fdopen'; +function _fprintf(stream: Pointer; format: PChar {, ...}): Integer; cdecl; external szMSVCRT name 'fprintf'; +function _ftell(stream: Pointer): Longint; cdecl; external szMSVCRT name 'ftell'; +function _sprintf(buffer: PChar; format: PChar {, ...}): 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: PChar; count: size_t; format: PChar; 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: PChar; strSource: PChar): PChar; cdecl; external szMSVCRT name 'strcat'; +function _strlen(str: PChar): size_t; cdecl; external szMSVCRT name 'strlen'; +procedure _clearerr(stream: Pointer); cdecl; external szMSVCRT name 'clearerr'; + +{$ENDIF LINK_TO_MSVCRT} +{$IFNDEF LINK_LIBC} + +procedure _memcpy(dest, src: Pointer; count: size_t); cdecl; +begin + Move(src^, dest^, count); +end; + +procedure _memset(dest: Pointer; val: Integer; count: size_t); cdecl; +begin + FillChar(dest^, count, val); +end; + +function _malloc(size: size_t): Pointer; cdecl; +begin + GetMem(Result, size); +end; + +procedure _free(pBlock: Pointer); cdecl; +begin + FreeMem(pBlock); +end; + +{$ENDIF ~LINK_LIBC} +{$ENDIF ~ZLIB_DLL} + +//----------------------------------------------------------------------------- +// +// 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; + +end. + + + + diff --git a/official/1.96/source/unix/dirinfo.txt b/official/1.96/source/unix/dirinfo.txt new file mode 100644 index 0000000..6f6d1ea --- /dev/null +++ b/official/1.96/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/official/1.96/source/unix/zlibh.pas b/official/1.96/source/unix/zlibh.pas new file mode 100644 index 0000000..6168533 --- /dev/null +++ b/official/1.96/source/unix/zlibh.pas @@ -0,0 +1,1580 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{ 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). +} + +{$I jedi.inc} + +{* Set this DEFINE to allow this unit to be linked against a .SO/.DLL + * The name "DLL" was used because e.g. the wxWidgets projects also uses + * this name to refer to dynamic libraries (even on *nix systems). + *} + +{ $DEFINE ZLIB_DLL} + +{ $DEFINE STATIC_GZIO} + +{ TODO: cdecl = zlib1.dll calling convention? } + +{$HPPEMIT '#define ZLIB_DLL'} + +{$HPPEMIT '#define ZEXPORT __cdecl'} + +{$HPPEMIT '#define ZEXPORTVA __cdecl'} + +{$HPPEMIT '#include '} + +unit zlibh; + +interface + +{$IFDEF HAS_UNIT_LIBC} +uses + Libc; +{$ELSE ~HAS_UNIT_LIBC} +type + uLong = LongWord; + {$EXTERNALSYM uLong} + uInt = Cardinal; + {$EXTERNALSYM uInt} + uShort = Word; + {$EXTERNALSYM uShort} + size_t = Longint; + {$EXTERNALSYM size_t} +{$ENDIF ~HAS_UNIT_LIBC} + +//----------------------------------------------------------------------------- +// 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.2'; + {$EXTERNALSYM ZLIB_VERNUM} + ZLIB_VERNUM =$1210; + +{* + 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; + {$EXTERNALSYM free_func} + free_func = procedure(opaque:voidpf; address:voidpf); + TFNAllocFunc = alloc_func; + TFNFreeFunc = free_func; + +type + {$EXTERNALSYM internal_state} + internal_state = packed record end; + TInternalState = internal_state; // backward compatibility + PInternalState = ^internal_state; // backward compatibility + +type + {$EXTERNALSYM z_stream_s} + z_stream_s = packed 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: PChar; // 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; + + {$EXTERNALSYM z_stream} + z_stream = z_stream_s; + {$EXTERNALSYM z_streamp} + z_streamp = ^z_stream_s; + + TZStreamRec = z_stream_s; + 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; + +{* 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_DEFAULT_STRATEGY} + Z_DEFAULT_STRATEGY = 0; +{* compression strategy; see deflateInit2() below for details *} + + {$EXTERNALSYM Z_BINARY} + Z_BINARY = 0; + {$EXTERNALSYM Z_ASCII} + Z_ASCII = 1; + {$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 *} + +{* for compatibility with versions < 1.0.2 *} + + {* basic functions *} + +{$EXTERNALSYM zlibVersion} +function zlibVersion(): PChar; + cdecl; +{* 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. + *} + +{$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(). +*} + +{$EXTERNALSYM deflate} +function deflate(var strm: TZStreamRec; flush: Integer): Integer; + cdecl; +{* + 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. +*} + +{$EXTERNALSYM deflateEnd} +function deflateEnd(var strm: TZStreamRec): Integer; + cdecl; +{* + 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). +*} + +{$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.) +*} + +{$EXTERNALSYM inflate} +function inflate(strm: TZStreamRec; flush: Integer): Integer; +{* + 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. +*} + +{$EXTERNALSYM inflateEnd} +function inflateEnd(var strm: TZStreamRec): Integer; + cdecl; +{* + 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. +*} + +{$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(). +*} + +{$EXTERNALSYM deflateSetDictionary} +function deflateSetDictionary(var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; + cdecl; +{* + 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(). +*} + +{$EXTERNALSYM deflateCopy} +function deflateCopy(var dest: TZStreamRec; + var source: TZStreamRec): Integer; + cdecl; +{* + 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. +*} + +{$EXTERNALSYM deflateReset} +function deflateReset(var strm: TZStreamRec): Integer; + cdecl; +{* + 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). +*} + +{$EXTERNALSYM deflateParams} +function deflateParams(var strm: TZStreamRec; + level: Integer; + strategy: Integer): Integer; + cdecl; +{* + 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. +*} + +{$EXTERNALSYM deflateBound} +function deflateBound(var strm: TZStreamRec; + sourceLen:uLong):uLong; + cdecl; +{* + 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(). +*} + +{$EXTERNALSYM deflatePrime} +function deflatePrime(var strm: TZStreamRec; + bits: Integer; + value: Integer): Integer; + cdecl; +{* + 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. +*} + +{$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.) +*} + +{$EXTERNALSYM inflateSetDictionary} +function inflateSetDictionary(var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; + cdecl; +{* + 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(). +*} + +{$EXTERNALSYM inflateSync} +function inflateSync(var strm: TZStreamRec): Integer; + cdecl; +{* + 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. +*} + +{$EXTERNALSYM inflateCopy} +function inflateCopy(var dest: TZStreamRec; + var source: TZStreamRec): Integer; + cdecl; +{* + 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. +*} + +{$EXTERNALSYM inflateReset} +function inflateReset(var strm: TZStreamRec): Integer; + cdecl; +{* + 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). +*} + +{$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; + TFNInFunc = in_func; + TFNOutFunc = out_func; + +{$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 + cdecl; +{* + 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. +*} + +{$EXTERNALSYM inflateBackEnd} +function inflateBackEnd(var strm: TZStreamRec): Integer; + cdecl; +{* + All memory allocated by inflateBackInit() is freed. + + inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream + state was inconsistent. +*} + +{$EXTERNALSYM zlibCompileFlags} +function zlibCompileFlags():uLong; + cdecl; +{* 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. +*} + +{$EXTERNALSYM compress} +function compress(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; + cdecl; +{* + 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. +*} + +{$EXTERNALSYM compress2} +function compress2(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong; + level: Integer): Integer; + cdecl; +{* + 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. +*} + +{$EXTERNALSYM compressBound} +function compressBound(sourceLen:uLong):uLong; + cdecl; +{* + 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. +*} + +{$EXTERNALSYM uncompress} +function uncompress(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; + cdecl; +{* + 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: PChar; mode: PChar):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: PChar):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: PChar, ...): 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: PChar): 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: PChar; len: Integer): PChar; +{* + 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): PChar; +{* + 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. +*} + +{$EXTERNALSYM adler32} +function adler32(adler:uLong; {const} buf: PBytef; len:uInt):uLong; + cdecl; +(* + 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(); +*) + +{$EXTERNALSYM crc32} +function crc32 (crc:uLong; {const} buf: PBytef; len:uInt):uLong; + cdecl; +(* + 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: + *} +{$EXTERNALSYM deflateInit_} +function deflateInit_(var strm:z_stream; + level: Integer; + {const} version: PChar; + stream_size: Integer): Integer; + cdecl; + +{$EXTERNALSYM inflateInit_} +function inflateInit_(var strm:z_stream; + {const} version: PChar; + stream_size: Integer): Integer; + cdecl; + +{$EXTERNALSYM deflateInit2_} +function deflateInit2_(var strm:z_stream; + level: Integer; + method: Integer; + windowBits: Integer; + memLevel: Integer; + strategy: Integer; + {const} version: PChar; + stream_size: Integer): Integer; + cdecl; + +{$EXTERNALSYM inflateInit2_} +function inflateInit2_(var strm:z_stream; + windowBits: Integer; + {const} version: PChar; + stream_size: Integer): Integer; + cdecl; + +{$EXTERNALSYM inflateBackInit_} +function inflateBackInit_(var strm:z_stream; + windowBits: Integer; + window: PByte; + {const} version: PChar; + stream_size: Integer): Integer; + cdecl; + +{$EXTERNALSYM zError} +function zError(err: Integer): PChar; + cdecl; + +{$EXTERNALSYM inflateSyncPoint} +function inflateSyncPoint(var z: TZStreamRec): Integer; + cdecl; + +{$EXTERNALSYM get_crc_table} +function get_crc_table():PuLongf; + cdecl; + +//----------------------------------------------------------------------------- +// 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} + +implementation + +{$IFNDEF HAS_UNIT_LIBC} +uses + dl; +{$ENDIF ~HAS_UNIT_LIBC} + +{$IFDEF LINUX} +type + TModuleHandle = Pointer; +{$ENDIF LINUX} + +const + ZLibModuleName = 'libz.so'; + INVALID_MODULEHANDLE_VALUE = TModuleHandle(0); + + +var + _ZLibModuleHandle: TModuleHandle = INVALID_MODULEHANDLE_VALUE; + +function ZlibModuleHandle: Pointer; +begin + if _ZLibModuleHandle = INVALID_MODULEHANDLE_VALUE then + _ZLibModuleHandle := dlopen(ZLibModuleName, RTLD_NOW); + Result := _ZLibModuleHandle; +end; + +function GetFunctionAddress(FunctionName: string): Pointer; +begin + Result := ZlibModuleHandle; + if Result <> nil then + Result := dlsym(Result, PChar(FunctionName)); +end; + + +// Core functions +function zlibVersion; external ZLibModuleName; +function deflateInit_; external ZLibModuleName; // wrapped by deflateInit() +function deflate; external ZLibModuleName; +function deflateEnd; external ZLibModuleName; +function inflateInit_; external ZLibModuleName; // wrapped by inflateInit() +function inflate; external ZLibModuleName; +function inflateEnd; external ZLibModuleName; +function deflateInit2_; external ZLibModuleName; // wrapped by deflateInit2() +function deflateSetDictionary; external ZLibModuleName; +function deflateCopy; external ZLibModuleName; +function deflateReset; external ZLibModuleName; +function deflateParams; external ZLibModuleName; +function deflateBound; external ZLibModuleName; +function deflatePrime; external ZLibModuleName; +function inflateInit2_; external ZLibModuleName; // wrapped by inflateInit2() +function inflateSetDictionary; external ZLibModuleName; +function inflateSync; external ZLibModuleName; +function inflateCopy; external ZLibModuleName; +function inflateReset; external ZLibModuleName; + +var + _inflateBackInit_: function (var strm:z_stream; windowBits: Integer; + window: PByte; {const} version: PChar; stream_size: Integer): Integer = nil; + +function inflateBackInit_; // wrapped by inflateBackInit() +begin + if not Assigned(_inflateBackInit_) then + _inflateBackInit_ := GetFunctionAddress('inflateBackInit_'); + Result := _inflateBackInit_(strm, windowBits, window, version, stream_size); +end; + +function inflateBack; external ZLibModuleName; +function inflateBackEnd; external ZLibModuleName; +function zlibCompileFlags; external ZLibModuleName; +function compress; external ZLibModuleName; +function compress2; external ZLibModuleName; +function compressBound; external ZLibModuleName; +function uncompress; external ZLibModuleName; + +// Checksums +function adler32; external ZLibModuleName; +function crc32; external ZLibModuleName; + +function zError; external ZLibModuleName; +function inflateSyncPoint; external ZLibModuleName; +function get_crc_table; external ZLibModuleName; + + +//----------------------------------------------------------------------------- +// +// 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; + +end. + + + + diff --git a/official/1.96/source/unixonly.inc b/official/1.96/source/unixonly.inc new file mode 100644 index 0000000..e2e3d5f --- /dev/null +++ b/official/1.96/source/unixonly.inc @@ -0,0 +1,74 @@ +{$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/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed 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 + +Last Modified: 2004-05-07 + +You may retrieve the latest version of this file at the JCL home page, +located at http://homepages.borland.com/jedi/jcl/ + +Known Issues: +-----------------------------------------------------------------------------} + +// Last modified: $Date: 2004/08/12 17:22:30 $ +// For history see end of file + +{$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} + +// History: + +// $Log: unixonly.inc,v $ +// Revision 1.5 2004/08/12 17:22:30 marquardt +// removed XPLATFORM_RTL +// +// Revision 1.4 2004/08/10 00:52:06 rrossmair +// don't allow missing jedi.inc/wrong inclusion order to happen unnoticed. +// +// Revision 1.3 2004/07/30 07:16:47 marquardt +// added a tilde +// +// Revision 1.2 2004/07/29 07:58:21 marquardt +// inc files updated +// +// Revision 1.1 2004/06/21 01:21:37 rrossmair +// - renamed from linuxonly.inc +// - $IFDEFed contents (to prevent from repeated inclusion) +// - uses UNIX symbol instead of LINUX (FPC requirement) +// - use of feature friendly symbol names +// - header text adapted for JCL +// + +{$ENDIF ~UNIXONLY_INC} diff --git a/official/1.96/source/vcl/JclGraphUtils.pas b/official/1.96/source/vcl/JclGraphUtils.pas new file mode 100644 index 0000000..e2c11a6 --- /dev/null +++ b/official/1.96/source/vcl/JclGraphUtils.pas @@ -0,0 +1,2638 @@ +{**************************************************************************************************} +{ 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) } +{ } +{**************************************************************************************************} + +// For history, see end of file + +unit JclGraphUtils; + +interface + +{$I jcl.inc} + +uses + {$IFDEF HAS_UNIT_TYPES} + Types, + {$ENDIF HAS_UNIT_TYPES} + Windows, + SysUtils, + Graphics, + 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); + +procedure EMMS; + +// 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; + +{$IFDEF KEEP_DEPRECATED} +// obsolete; use corresponding HLS aliases instead +procedure HSLToRGB(const H, S, L: Single; out R, G, B: Single); overload; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +procedure RGBToHSL(const R, G, B: Single; out H, S, L: Single); overload; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +{$ENDIF KEEP_DEPRECATED} + +// 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; + +implementation + +uses + Classes, Consts, + Math, + JclResources, 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; + + +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, SizeOf(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 +{asm +// EAX = WinColor + MOV ECX, EAX // ECX = WinColor + MOV EDX, EAX // EDX = WinColor + + AND ECX, $FF0000 // B component + AND EAX, $0000FF // R component + AND EDX, $00FF00 // G component + + OR EAX, $00FF00 // write $FF into A component + SHR ECX, 16 // shift B + SHL EAX, 16 // shift AR + OR ECX, EDX // ECX = GB + OR EAX, ECX // set GB +end;} +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; +{asm + // 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) + // EAX <- X + // EDX <- Y + // ECX <- W + + // W = 0 or $FF? + JCXZ @1 // CX = 0 ? => Result := EDX + CMP ECX, $FF // CX = $FF ? => Result := EAX + JE @2 + + PUSH EBX + + // P = W * X + MOV EBX, EAX // EBX <- Xa Xr Xg Xb + AND EAX, $00FF00FF // EAX <- 00 Xr 00 Xb + AND EBX, $FF00FF00 // EBX <- Xa 00 Xg 00 + IMUL EAX, ECX // EAX <- Pr ** Pb ** + SHR EBX, 8 // EBX <- 00 Xa 00 Xg + IMUL EBX, ECX // EBX <- Pa ** Pg ** + ADD EAX, Bias + AND EAX, $FF00FF00 // EAX <- Pr 00 Pb 00 + SHR EAX, 8 // EAX <- 00 Pr 00 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 * Y + XOR ECX, $000000FF // ECX <- 1 - ECX + MOV EBX, EDX // EBX <- Ya Yr Yg Yb + AND EDX, $00FF00FF // EDX <- 00 Yr 00 Yb + AND EBX, $FF00FF00 // EBX <- Ya 00 Yg 00 + IMUL EDX, ECX // EDX <- Qr ** Qb ** + SHR EBX, 8 // EBX <- 00 Ya 00 Yg + IMUL EBX, ECX // EBX <- Qa ** Qg ** + ADD EDX, Bias + AND EDX, $FF00FF00 // EDX <- Qr 00 Qb 00 + SHR EDX, 8 // EDX <- 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 + + POP EBX + RET + +@1: MOV EAX, EDX +@2: RET +end;} +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); +{asm + // EAX <- F + // [EDX] <- B + // ECX <- W + PUSH EDX + MOV EDX, [EDX] + CALL _CombineReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := _CombineReg(F, B, W); +end; + +function _BlendReg(F, B: TColor32): TColor32; +{asm + // blend foreground color (F) to a background color (B), + // using alpha channel value of F + // Result Z = Fa * Frgb + (1 - Fa) * Brgb + // EAX <- F + // EDX <- B + MOV ECX, EAX // ECX <- Fa Fr Fg Fb + SHR ECX, 24 // ECX <- 00 00 00 Fa + JMP _CombineReg +end;} +begin + Result := _CombineReg(F, B, F shr 24); +end; + +procedure _BlendMem(F: TColor32; var B: TColor32); +{asm + // EAX <- F + // [EDX] <- B + PUSH EDX + MOV ECX, EAX // ECX <- Fa Fr Fg Fb + SHR ECX, 24 // ECX <- 00 00 00 Fa + MOV EDX, [EDX] + CALL _CombineReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := _CombineReg(F, B, F shr 24); +end; + +function _BlendRegEx(F, B, M: TColor32): TColor32; +{asm + // blend foreground color (F) to a background color (B), + // using alpha channel value of F multiplied by master alpha (M) + // no checking for M = $FF, if this is the case Graphics32 uses BlendReg + // Result Z = Fa * M * Frgb + (1 - Fa * M) * Brgb + // EAX <- F + // EDX <- B + // ECX <- M + MOV EBX, EAX // EBX <- Fa Fr Fg Fb + SHR EBX, 24 // EBX <- 00 00 00 Fa + IMUL ECX, EBX // ECX <- 00 00 W ** + SHR ECX, 8 // ECX <- 00 00 00 W + JMP _CombineReg +end;} +begin + Result := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + +procedure _BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +{asm + // EAX <- F + // [EDX] <- B + // ECX <- M + PUSH EBX + MOV EBX, EAX // EBX <- Fa Fr Fg Fb + SHR EBX, 24 // EBX <- 00 00 00 Fa + IMUL ECX, EBX // ECX <- 00 00 W ** + SHR ECX, 8 // ECX <- 00 00 00 W + + MOV EBX, EDX + MOV EDX, [EDX] + CALL _BlendRegEx + MOV [EBX], EAX + POP EBX +end;} +begin + B := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + + +procedure _BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + // 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 +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; + +{ 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); + alpha_ptr := Pointer(Integer(AlphaTable) and $FFFFFFF8); + if Integer(alpha_ptr) < Integer(AlphaTable) then + alpha_ptr := Pointer(Integer(alpha_ptr) + 8); + 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(Integer(alpha_ptr) + $80 * 8); +end; + +procedure FreeAlphaTable; +begin + FreeMem(AlphaTable); + AlphaTable := nil; +end; + +procedure EMMS; +begin + if MMX_ACTIVE then + asm + db $0F, $77 // EMMS + end; +end; + +function M_CombineReg(X, Y, W: TColor32): TColor32; assembler; +asm + // 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 +end; + +procedure M_CombineMem(F: TColor32; var B: TColor32; W: TColor32); +{asm + // EAX - Color X + // [EDX] - Color Y + // ECX - Weight of X [0..255] + // Result := W * (X - Y) + Y + PUSH EDX + MOV EDX, [EDX] + CALL M_CombineReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := M_CombineReg(F, B, W); +end; + +function M_BlendReg(F, B: TColor32): TColor32; assembler; +asm + // 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 +end; + +procedure M_BlendMem(F: TColor32; var B: TColor32); +{asm + // EAX - Color X + // [EDX] - Color Y + // Result := W * (X - Y) + Y + PUSH EDX + MOV EDX, [EDX] + CALL M_BlendReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := M_BlendReg(F, B); +end; + +function M_BlendRegEx(F, B, M: TColor32): TColor32; assembler; +asm + // 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 +end; + +procedure M_BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +{asm + // 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 EDX + MOV EDX, [EDX] + CALL M_BlendRegEx + POP EDX + MOV [EDX], EAX +end;} +begin + B := M_BlendRegEx(F, B, M); +end; + +procedure M_BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + // 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 +end; + +procedure M_BlendLineEx(Src, Dst: PColor32; Count: Integer; M: TColor32); assembler; +asm + // 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: +end; + +{ 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 ======================================================= + +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^ := 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; + +{$IFDEF KEEP_DEPRECATED} +procedure HSLToRGB(const H, S, L: Single; out R, G, B: Single); +begin + HLSToRGB(H, L, S, R, G, B); +end; +{$ENDIF KEEP_DEPRECATED} + +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; + +{$IFDEF KEEP_DEPRECATED} +procedure RGBToHSL(const R, G, B: Single; out H, S, L: Single); +begin + RGBToHLS(R, G, B, H, L, S); +end; +{$ENDIF KEEP_DEPRECATED} + +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 neccessary + Canvas.LineTo(X + 1, Y); + end; + with Points[I] do + begin + X1 := X; + Y1 := Y; + end; + end; +end; + +initialization + SetupFunctions; + if MMX_ACTIVE then + GenAlphaTable; + +finalization + if MMX_ACTIVE then + FreeAlphaTable; + +// History: + +// Revision 1.18 2005/02/24 16:34:41 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.17 2004/11/25 21:56:12 rrossmair +// - TColor32Array declaration changed to avoid range check errors in JclGraphics +// +// Revision 1.16 2004/11/14 06:05:05 rrossmair +// - some source formatting +// +// Revision 1.15 2004/10/18 16:22:14 marquardt +// corrected typo +// +// Revision 1.14 2004/10/17 20:54:14 mthoma +// cleaning +// +// Revision 1.13 2004/07/31 06:21:02 marquardt +// - reset AlphaTable to nil in FreeAlphaTable +// +// Revision 1.12 2004/07/16 03:58:14 rrossmair +// some style cleaning +// +// Revision 1.11 2004/06/27 23:28:51 rrossmair +// some style cleaning (case, spaces) +// +// Revision 1.10 2004/06/16 07:30:28 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.9 2004/06/14 13:05:19 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.8 2004/05/05 22:14:51 rrossmair +// bug fix in HSLToRGB(const H, S, L: Single; out R, G, B: Single); source code formatted +// renamed Hue/Luminance/Saturation related routines from *HSL* to *HLS*, as far as possible; old identifiers kept as deprecated +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.7 2004/05/01 00:21:10 rrossmair +// fixed for Kylix +// +// Revision 1.6 2004/04/28 04:16:19 rrossmair +// new functions added: RGBToHLS, HLSToRGB, RGB2HLS, HLS2RGB, SetBitmapColors (VCL only) +// +// Revision 1.5 2004/04/18 06:32:07 rrossmair +// replaced symbol "Develop" by jpp-pre-undefined "PROTOTYPE"; protected CVS key words by "PROTOTYPE" symbol +// +// Revision 1.4 2004/04/06 05:01:54 +// adapt compiler conditions, add log entry +// +// 2001-03-28, Mike Lischke: +// - ShortenString included + +end. diff --git a/official/1.96/source/vcl/JclGraphics.pas b/official/1.96/source/vcl/JclGraphics.pas new file mode 100644 index 0000000..7149e03 --- /dev/null +++ b/official/1.96/source/vcl/JclGraphics.pas @@ -0,0 +1,5644 @@ +{**************************************************************************************************} +{ 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) } +{ } +{**************************************************************************************************} + +// For history, see end of file + +unit JclGraphics; + +{$I jcl.inc} + +interface + +uses + Windows, + Classes, SysUtils, + Graphics, JclGraphUtils, Controls, + 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; + 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; + 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 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; +function IconToBitmap(Icon: HICON): HBITMAP; + +procedure BitmapToJPeg(const FileName: string); +procedure JPegToBitmap(const FileName: string); + +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): HRGN; +procedure ScreenShot(bm: TBitmap; Left, Top, Width, Height: Integer; Window: THandle = HWND_DESKTOP); overload; +procedure ScreenShot(bm: TBitmap; IncludeTaskBar: Boolean = True); 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); + +implementation + +uses + Math, + CommCtrl, ShellApi, + ClipBrd, JPeg, TypInfo, + JclResources, + JclLogic; + +type + TRGBInt = record + R: Integer; + G: Integer; + B: Integer; + end; + + PBGRA = ^TBGRA; + TBGRA = packed record + B: Byte; + G: Byte; + R: Byte; + A: Byte; + end; + + PPixelArray = ^TPixelArray; + TPixelArray = array [0..0] of TBGRA; + + 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 + 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; + +threadvar + // globally used cache for current image (speeds up resampling about 10%) + CurrentLineR: array of Integer; + CurrentLineG: array of Integer; + CurrentLineB: array of Integer; + +//=== Helper functions ======================================================= + +function IntToByte(Value: Integer): Byte; +begin + Result := Math.Max(0, Math.Min(255, Value)); +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); +{asm +// EAX = X +// EDX = Count +// ECX = Value + TEST EDX, EDX + JLE @@EXIT + + PUSH EDI + MOV EDI, EAX // Point EDI to destination + MOV EAX, ECX + MOV ECX, EDX + REP STOSD // Fill count dwords + POP EDI +@@EXIT: +end;} +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); +{asm +// EAX = [A] +// EDX = [B] + MOV ECX, [EAX] // ECX := [A] + CMP ECX, [EDX] // ECX <= [B]? Exit + JLE @@EXIT + //Replaced on more fast code + //XCHG ECX, [EDX] // ECX <-> [B]; + //MOV [EAX], ECX // [A] := ECX + PUSH EBX + MOV EBX,[EDX] // EBX := [B] + MOV [EAX],EBX // [A] := EBX + MOV [EDX],ECX // [B] := ECX + POP EBX +@@EXIT: +end;} +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; + + 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 / 3.0) + else + Result := 0.0; +end; + +function BitmapMitchellFilter(Value: Single): Single; +const + B = 1.0 / 3.0; + C = 1.0 / 3.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 / 6.0; + 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 / 6.0; + end + else + Result := 0.0; +end; + +const + FilterList: array [TResamplingFilter] of TBitmapFilterFunction = + ( + BitmapBoxFilter, + BitmapTriangleFilter, + BitmapHermiteFilter, + BitmapBellFilter, + BitmapSplineFilter, + BitmapLanczos3Filter, + BitmapMitchellFilter + ); + +procedure FillLineCache(N, Delta: Integer; Line: Pointer); +var + I: Integer; + Run: PBGRA; +begin + Run := Line; + for I := 0 to N - 1 do + begin + CurrentLineR[I] := Run.R; + CurrentLineG[I] := Run.G; + CurrentLineB[I] := Run.B; + Inc(PByte(Run), Delta); + end; +end; + +function ApplyContributors(N: Integer; Contributors: TContributors): TBGRA; +var + J: Integer; + RGB: TRGBInt; + Total, + Weight: Integer; + Pixel: Cardinal; + Contr: PContributor; +begin + RGB.R := 0; + RGB.G := 0; + RGB.B := 0; + Total := 0; + Contr := @Contributors[0]; + for J := 0 to N - 1 do + begin + Weight := Contr.Weight; + Inc(Total, Weight); + Pixel := Contr.Pixel; + Inc(RGB.R, CurrentLineR[Pixel] * Weight); + Inc(RGB.G, CurrentLineG[Pixel] * Weight); + Inc(RGB.B, CurrentLineB[Pixel] * Weight); + Inc(Contr); + end; + + if Total = 0 then + begin + Result.R := IntToByte(RGB.R shr 8); + Result.G := IntToByte(RGB.G shr 8); + Result.B := IntToByte(RGB.B shr 8); + end + else + begin + Result.R := IntToByte(RGB.R div Total); + Result.G := IntToByte(RGB.G div Total); + Result.B := IntToByte(RGB.B div Total); + 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: PPixelArray; + DestPixel: PBGRA; + Delta, DestDelta: Integer; + SourceHeight, SourceWidth: Integer; + TargetHeight, TargetWidth: Integer; +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 := Math.Floor(Center - Width); + Right := 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 := Math.Floor(Center - Radius); + Right := 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; + + // now apply filter to sample horizontally from Src to Work + + SetLength(CurrentLineR, SourceWidth); + SetLength(CurrentLineG, SourceWidth); + SetLength(CurrentLineB, SourceWidth); + for K := 0 to SourceHeight - 1 do + begin + SourceLine := Source.ScanLine[K]; + FillLineCache(SourceWidth, SizeOf(TBGRA), SourceLine); + DestPixel := Work.ScanLine[K]; + for I := 0 to TargetWidth - 1 do + with ContributorList[I] do + begin + DestPixel^ := ApplyContributors(N, ContributorList[I].Contributors); + // 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 := Math.Floor(Center - Width); + Right := 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 := Math.Floor(Center - Radius); + Right := 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 + SetLength(CurrentLineR, SourceHeight); + SetLength(CurrentLineG, SourceHeight); + SetLength(CurrentLineB, SourceHeight); + + SourceLine := Work.ScanLine[0]; + Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine); + DestLine := Target.ScanLine[0]; + DestDelta := Integer(Target.ScanLine[1]) - Integer(DestLine); + for K := 0 to TargetWidth - 1 do + begin + DestPixel := Pointer(DestLine); + FillLineCache(SourceHeight, Delta, SourceLine); + for I := 0 to TargetHeight - 1 do + with ContributorList[I] do + begin + DestPixel^ := ApplyContributors(N, ContributorList[I].Contributors); + Inc(Integer(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; + CurrentLineR := nil; + CurrentLineG := nil; + CurrentLineB := nil; + 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; +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; + + Target.FreeImage; + Target.PixelFormat := pf32bit; + Target.Width := NewWidth; + Target.Height := NewHeight; + + if not Target.Empty then + DoStretch(FilterList[Filter], Radius, Temp, Target); + 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); + + 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; + +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 JPegToBitmap(const FileName: string); +var + Bitmap: TBitmap; + JPeg: TJPegImage; +begin + Bitmap := nil; + JPeg := nil; + try + JPeg := TJPegImage.Create; + JPeg.LoadFromFile(FileName); + Bitmap := TBitmap.Create; + Bitmap.Assign(JPeg); + Bitmap.SaveToFile(ChangeFileExt(FileName, LoadResString(@RsBitmapExtension))); + finally + FreeAndNil(Bitmap); + FreeAndNil(JPeg); + end; +end; + +procedure BitmapToJPeg(const FileName: string); +var + Bitmap: TBitmap; + JPeg: TJPegImage; +begin + Bitmap := nil; + JPeg := nil; + try + Bitmap := TBitmap.Create; + Bitmap.LoadFromFile(FileName); + JPeg := TJPegImage.Create; + JPeg.Assign(Bitmap); + JPeg.SaveToFile(ChangeFileExt(FileName, LoadResString(@RsJpegExtension))); + finally + FreeAndNil(Bitmap); + FreeAndNil(JPeg); + end; +end; + +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 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 + FillChar(CI, SizeOf(CI), 0); + FillChar(List, SizeOf(List), 0); + 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; + + 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; + +function CreateRegionFromBitmap(Bitmap: TBitmap; RegionColor: TColor; + RegionBitmapMode: TJclRegionBitmapMode): HRGN; +var + FBitmap: TBitmap; + X, Y: Integer; + StartX: Integer; + Region: HRGN; +begin + Result := 0; + + if Bitmap = nil then + EJclGraphicsError.CreateRes(@RsNoBitmapForRegion); + + if (Bitmap.Width = 0) or (Bitmap.Height = 0) then + Exit; + + FBitmap := TBitmap.Create; + try + FBitmap.Assign(Bitmap); + + for Y := 0 to FBitmap.Height - 1 do + begin + X := 0; + while X < FBitmap.Width do + begin + + if RegionBitmapMode = rmExclude then + begin + while FBitmap.Canvas.Pixels[X,Y] = RegionColor do + begin + Inc(X); + if X = FBitmap.Width then + Break; + end; + end + else + begin + while FBitmap.Canvas.Pixels[X,Y] <> RegionColor do + begin + Inc(X); + if X = FBitmap.Width then + Break; + end; + end; + + if X = FBitmap.Width then + Break; + + StartX := X; + if RegionBitmapMode = rmExclude then + begin + while FBitmap.Canvas.Pixels[X,Y] <> RegionColor do + begin + if X = FBitmap.Width then + Break; + Inc(X); + end; + end + else + begin + while FBitmap.Canvas.Pixels[X,Y] = RegionColor do + begin + if X = FBitmap.Width then + Break; + Inc(X); + end; + end; + + if Result = 0 then + Result := CreateRectRgn(StartX, Y, X, Y + 1) + else + begin + Region := CreateRectRgn(StartX, Y, X, Y + 1); + if Region <> 0 then + begin + CombineRgn(Result, Result, Region, RGN_OR); + DeleteObject(Region); + end; + end; + end; + end; + finally + FBitmap.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); + + // Palette-device? + if (GetDeviceCaps(WinDC, RASTERCAPS) and RC_PALETTE) = RC_PALETTE then + begin + FillChar(Pal, SizeOf(TMaxLogPalette), #0); // 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); + + ReleaseDC(Window, WinDC); // finally, relase the DC of the window +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; + +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(PChar(@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, Count, ALTERNATE), True); + fmWinding: + Create(CreatePolygonRgn(Points, 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, Vertex, Count, ALTERNATE), True); + fmWinding: + Create(CreatePolyPolygonRgn(Points, Vertex, 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 EJclWin32Error.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); +begin + SelectClipRgn(Canvas.Handle,FHandle); + JclGraphics.FillGradient(Canvas.Handle, Box, ColorCount, StartColor, EndColor, ADirection); +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; + FillChar(FBitmapInfo, SizeOf(TBitmapInfo), #0); + 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); + 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)); + 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)); + 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, 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; + 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]; + 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; + +// 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); + +// History: +// Revision 1.18 2004/11/14 06:05:05 rrossmair +// - some source formatting +// +// Revision 1.17 2004/11/06 02:19:45 mthoma +// history cleaning. +// +// Revision 1.16 2004/10/17 20:54:14 mthoma +// cleaning +// +// Revision 1.15 2004/07/28 07:40:41 marquardt +// remove comiler warnings +// +// Revision 1.14 2004/07/16 03:50:35 rrossmair +// fixed "not accesssible with BCB" warning for TJclRegion.CreateRect +// +// Revision 1.13 2004/07/15 05:15:41 rrossmair +// TJclRegion: Handle ownership management added, some refactoring +// +// Revision 1.12 2004/07/12 02:54:33 rrossmair +// TJclRegion.Create fixed +// +// Revision 1.11 2004/06/14 13:05:19 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.10 2004/05/14 15:20:44 rrossmair +// added Marcin Wieczorek to Contributors list +// +// Revision 1.9 2004/05/05 22:16:40 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.8 2004/04/18 06:32:07 rrossmair +// replaced symbol "Develop" by jpp-pre-undefined "PROTOTYPE"; protected CVS key words by "PROTOTYPE" symbol +// +// Revision 1.7 2004/04/08 19:44:30 mthoma +// Fixed 0001513: CheckParams at the beginning of ApplyLut is: CheckParams(Src, Dst) but should be CheckParams(Dst, Src) +// +// Revision 1.6 2004/04/06 05:01:54 +// adapt compiler conditions, add log entry + +end. diff --git a/official/1.96/source/vcl/JclPrint.pas b/official/1.96/source/vcl/JclPrint.pas new file mode 100644 index 0000000..6bbc97c --- /dev/null +++ b/official/1.96/source/vcl/JclPrint.pas @@ -0,0 +1,1236 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/10/30 01:55:34 $ +// For history see end of file + +unit JclPrint; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + Windows, Classes, StdCtrls, SysUtils, + 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: PChar; { TODO : change to string } + FDriver: PChar; + FPort: PChar; + FHandle: THandle; + FDeviceMode: PDeviceModeA; + FPrinter: Integer; + FBinArray: PWordArray; + FNumBins: Byte; + FPaperArray: PWordArray; + FNumPapers: Byte; + FDpiX: Integer; + FiDpiY: Integer; + procedure CheckPrinter; + procedure SetBinArray; + procedure SetPaperArray; + function DefaultPaperName(const PaperID: Word): string; + 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: Byte); + function GetBinIndex: Byte; + procedure SetPaperFromList(PaperNum: Byte); + function GetPaperIndex: Byte; + procedure SetPort(Port: string); + public + constructor Create; virtual; + destructor Destroy; override; + {$IFDEF KEEP_DEPRECATED} + { TODO : Find a solution for deprecated } + function GetBinSourceList: TStringList; overload; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} + function GetPaperList: TStringList; overload; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} + {$ENDIF KEEP_DEPRECATED} + procedure GetBinSourceList(List: TStrings); overload; + procedure GetPaperList(List: TStrings); overload; + procedure SetDeviceMode(Creating: Boolean); + procedure UpdateDeviceMode; + 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 SaveToIniFile(const IniFileName, Section: string); + function ReadFromIniFile(const IniFileName, Section: string): Boolean; + 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; + property PrinterPort: string read GetPrinterPort write SetPort; + property PrinterDriver: string read GetPrinterDriver; + property BinIndex: Byte read GetBinIndex write SetBinFromList; + property PaperIndex: Byte read GetPaperIndex write SetPaperFromList; + property DpiX: Integer read FDpiX write FDpiX; + property DpiY: Integer read FiDpiY write FiDpiY; + end; + +procedure DirectPrint(const Printer, Data: 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; + +implementation + +uses + Graphics, IniFiles, Messages, Printers, WinSpool, + JclSysInfo, JclResources; + +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'; + + cWindows: PChar = 'windows'; + cDevice = 'device'; + cPrintSpool = 'winspool.drv'; + +// Misc. functions +procedure DirectPrint(const Printer, Data: 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" + DocInfo.DocName := PChar(RsSpoolerDocName); + 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, @Data, Count, 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 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 := LoadLibrary(cPrintSpool); + if hWinSpool <> 0 then + try + @GetDefPrint := GetProcAddress(hWinSpool, 'GetDefaultPrinterA'); + 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, 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, Needed); + end; + finally + FreeMem(PI2); + end; + finally + ClosePrinter(hPrinter); + end; + end + else + // >= Win 2000 uses SetDefaultPrinter + begin + hWinSpool := LoadLibrary(cPrintSpool); + if hWinSpool <> 0 then + try + @SetDefPrint := GetProcAddress(hWinSpool, 'SetDefaultPrinterA'); + if Assigned(SetDefPrint) then + Result := SetDefPrint(PChar(PrinterName)); + finally + FreeLibrary(hWinSpool); + end; + end; +end; + +// TJclPrintSet +constructor TJclPrintSet.Create; +begin + inherited Create; + FBinArray := nil; + FPaperArray := nil; + FPrinter := -99; { TODO : why -99 } + GetMem(FDevice, 255); + GetMem(FDriver, 255); + GetMem(FPort, 255); +end; + +destructor TJclPrintSet.Destroy; +begin + if FBinArray <> nil then + FreeMem(FBinArray, FNumBins * SizeOf(Word)); + if FPaperArray <> nil then + FreeMem(FPaperArray, FNumPapers * SizeOf(Word)); + if FDevice <> nil then + FreeMem(FDevice, 255); + if FDriver <> nil then + FreeMem(FDriver, 255); + if FPort <> nil then + FreeMem(FPort, 255); + inherited Destroy; +end; + +procedure TJclPrintSet.CheckPrinter; +begin + if FPrinter <> Printer.PrinterIndex then + begin + Printer.GetPrinter(FDevice, FDriver, FPort, FHandle); + Printer.SetPrinter(FDevice, FDriver, FPort, FHandle); + SetDeviceMode(False); + end; +end; + +procedure TJclPrintSet.SetBinArray; +var + NumBinsRec: Integer; +begin + if FBinArray <> nil then + FreeMem(FBinArray, FNumBins * SizeOf(Word)); + FBinArray := nil; + FNumBins := DeviceCapabilities(FDevice, FPort, DC_Bins, nil, FDeviceMode); + if FNumBins > 0 then + begin + GetMem(FBinArray, FNumBins * SizeOf(Word)); + NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_Bins, + PChar(FBinArray), FDeviceMode); + if NumBinsRec <> FNumBins then + raise EJclPrinterError.CreateRes(@RsRetrievingSource); + end; +end; + +procedure TJclPrintSet.SetPaperArray; +var + NumPapersRec: Integer; +begin + if FPaperArray <> nil then + FreeMem(FPaperArray, FNumPapers * SizeOf(Word)); + FNumPapers := DeviceCapabilities(FDevice, FPort, DC_Papers, nil, FDeviceMode); + if FNumPapers > 0 then + begin + GetMem(FPaperArray, FNumPapers * SizeOf(Word)); + NumPapersRec := DeviceCapabilities(FDevice, FPort, DC_Papers, + PChar(FPaperArray), FDeviceMode); + if NumPapersRec <> FNumPapers then + raise EJclPrinterError.CreateRes(@RsRetrievingPaperSource); + end + else + FPaperArray := nil; +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 := RsPSLetter; + dmpaper_LetterSmall: + Result := RsPSLetter; + dmpaper_Tabloid: + Result := RsPSTabloid; + dmpaper_Ledger: + Result := RsPSLedger; + dmpaper_Legal: + Result := RsPSLegal; + dmpaper_Statement: + Result := RsPSStatement; + dmpaper_Executive: + Result := RsPSExecutive; + dmpaper_A3: + Result := RsPSA3; + dmpaper_A4: + Result := RsPSA4; + dmpaper_A4Small: + Result := RsPSA4; + dmpaper_A5: + Result := RsPSA5; + dmpaper_B4: + Result := RsPSB4; + dmpaper_B5: + Result := RsPSB5; + dmpaper_Folio: + Result := RsPSFolio; + dmpaper_Quarto: + Result := RsPSQuarto; + dmpaper_10X14: + Result := RsPS10x14; + dmpaper_11X17: + Result := RsPS11x17; + dmpaper_Note: + Result := RsPSNote; + dmpaper_Env_9: + Result := RsPSEnv9; + dmpaper_Env_10: + Result := RsPSEnv10; + dmpaper_Env_11: + Result := RsPSEnv11; + dmpaper_Env_12: + Result := RsPSEnv12; + dmpaper_Env_14: + Result := RsPSEnv14; + dmpaper_CSheet: + Result := RsPSCSheet; + dmpaper_DSheet: + Result := RsPSDSheet; + dmpaper_ESheet: + Result := RsPSESheet; + dmpaper_User: + Result := RsPSUser; + else + Result := RsPSUnknown; + end; +end; + +{$IFDEF KEEP_DEPRECATED} +function TJclPrintSet.GetBinSourceList: TStringList; +begin + Result := TStringList.Create; + try + GetBinSourceList(Result); + except + FreeAndNil(Result); + raise; + end; +end; +{$ENDIF KEEP_DEPRECATED} + +procedure TJclPrintSet.GetBinSourceList(List: TStrings); +type + TBinName = array [0..CCHBinName - 1] of Char; + TBinArray = array [1..cBinMax] of TBinName; + PBinArray = ^TBinArray; +var + NumBinsRec: Integer; + BinArray: PBinArray; + BinStr: string; + Idx: Integer; +begin + CheckPrinter; + BinArray := nil; + if FNumBins = 0 then + Exit; + List.BeginUpdate; + try + GetMem(BinArray, FNumBins * SizeOf(TBinName)); + List.Clear; + NumBinsRec := DeviceCapabilities(FDevice, FPort, DC_BinNames, + PChar(BinArray), FDeviceMode); + 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; + +{$IFDEF KEEP_DEPRECATED} +function TJclPrintSet.GetPaperList: TStringList; +begin + Result := TStringList.Create; + try + GetPaperList(Result); + except + FreeAndNil(Result); + raise; + end; +end; +{$ENDIF KEEP_DEPRECATED} + +procedure TJclPrintSet.GetPaperList(List: TStrings); +type + TPaperName = array [0..CCHPaperName - 1] of Char; + TPaperArray = array [1..cPaperNames] of TPaperName; + PPaperArray = ^TPaperArray; +var + NumPaperRec: Integer; + PaperArray: PPaperArray; + PaperStr: string; + Idx: Integer; +begin + CheckPrinter; + PaperArray := nil; + if FNumPapers = 0 then + Exit; + List.BeginUpdate; + List.Clear; + try + GetMem(PaperArray, FNumPapers * SizeOf(TPaperName)); + NumPaperRec := DeviceCapabilities(FDevice, FPort, DC_PaperNames, + PChar(PaperArray), FDeviceMode); + 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; +begin + Printer.GetPrinter(FDevice, FDriver, FPort, FHandle); + if FHandle = 0 then + begin + Printer.PrinterIndex := Printer.PrinterIndex; + Printer.GetPrinter(FDevice, FDriver, FPort, FHandle); + end; + if FHandle <> 0 then + begin + FDeviceMode := GlobalLock(FHandle); + FPrinter := Printer.PrinterIndex; + FDeviceMode^.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; + UpdateDeviceMode; + FDeviceMode^.dmFields := 0; + SetBinArray; + SetPaperArray; + end + else + begin + FDeviceMode := nil; + 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; +var + DrvHandle: THandle; + ExtDevCode: Integer; +begin + CheckPrinter; + if OpenPrinter(FDevice, DrvHandle, nil) then + try + FDeviceMode^.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, FDevice, + FDeviceMode^, FDeviceMode^, + 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; +begin + CheckPrinter; + OpenPrinter(FDevice, DrvHandle, nil); + ExtDevCode := DocumentProperties(0, DrvHandle, FDevice, + FDeviceMode^, FDeviceMode^, DM_IN_BUFFER or DM_UPDATE); + 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 + Printer.GetPrinter(FDevice, FDriver, FPort, FHandle); + Printer.SetPrinter(FDevice, FDriver, 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.SaveToIniFile(const IniFileName, Section: string); +var + PrIniFile: TIniFile; + CurrentName: string; +begin + PrIniFile := TIniFile.Create(IniFileName); + 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.Free; +end; + +function TJclPrintSet.ReadFromIniFile(const IniFileName, Section: string): Boolean; +var + PrIniFile: TIniFile; + SavedName: string; + NewIndex: Integer; +begin + Result := False; + PrIniFile := TIniFile.Create(IniFileName); + SavedName := PrIniFile.ReadString(Section, PrintIniPrinterName, PrinterName); + if PrinterName <> SavedName then + begin + NewIndex := Printer.Printers.IndexOf(SavedName); + if NewIndex <> -1 then + begin + Result := True; + Printer.PrinterIndex := NewIndex; + 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); + end + else + Result := False; + end; + PrIniFile.Free; +end; + +procedure TJclPrintSet.SetOrientation(Orientation: Integer); +begin + CheckPrinter; + FDeviceMode^.dmOrientation := Orientation; + Printer.Orientation := TPrinterOrientation(Orientation - 1); + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION; +end; + +function TJclPrintSet.GetOrientation: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmOrientation; +end; + +procedure TJclPrintSet.SetPaperSize(Size: Integer); +begin + CheckPrinter; + FDeviceMode^.dmPaperSize := Size; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERSIZE; +end; + +function TJclPrintSet.GetPaperSize: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmPaperSize; +end; + +procedure TJclPrintSet.SetPaperLength(Length: Integer); +begin + CheckPrinter; + FDeviceMode^.dmPaperLength := Length; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERLENGTH; +end; + +function TJclPrintSet.GetPaperLength: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmPaperLength; +end; + +procedure TJclPrintSet.SetPaperWidth(Width: Integer); +begin + CheckPrinter; + FDeviceMode^.dmPaperWidth := Width; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERWIDTH; +end; + +function TJclPrintSet.GetPaperWidth: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmPaperWidth; +end; + +procedure TJclPrintSet.SetScale(Scale: Integer); +begin + CheckPrinter; + FDeviceMode^.dmScale := Scale; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_SCALE; +end; + +function TJclPrintSet.GetScale: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmScale; +end; + +procedure TJclPrintSet.SetCopies(Copies: Integer); +begin + CheckPrinter; + FDeviceMode^.dmCopies := Copies; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_COPIES; +end; + +function TJclPrintSet.GetCopies: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmCopies; +end; + +procedure TJclPrintSet.SetBin(Bin: Integer); +begin + CheckPrinter; + FDeviceMode^.dmDefaultSource := Bin; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_DEFAULTSOURCE; +end; + +function TJclPrintSet.GetBin: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmDefaultSource; +end; + +procedure TJclPrintSet.SetPrintQuality(Quality: Integer); +begin + CheckPrinter; + FDeviceMode^.dmPrintQuality := Quality; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PRINTQUALITY; +end; + +function TJclPrintSet.GetPrintQuality: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmPrintQuality; +end; + +procedure TJclPrintSet.SetColor(Color: Integer); +begin + CheckPrinter; + FDeviceMode^.dmColor := Color; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION; +end; + +function TJclPrintSet.GetColor: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmColor; +end; + +procedure TJclPrintSet.SetDuplex(Duplex: Integer); +begin + CheckPrinter; + FDeviceMode^.dmDuplex := Duplex; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_DUPLEX; +end; + +function TJclPrintSet.GetDuplex: Integer; +begin + CheckPrinter; + Result := FDeviceMode^.dmDuplex; +end; + +procedure TJclPrintSet.SetYResolution(YRes: Integer); +var + PrintDevMode: PDeviceModeA; +begin + CheckPrinter; + PrintDevMode := @FDeviceMode^; + PrintDevMode^.dmYResolution := YRes; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_YRESOLUTION; +end; + +function TJclPrintSet.GetYResolution: Integer; +var + PrintDevMode: PDeviceModeA; +begin + CheckPrinter; + PrintDevMode := @FDeviceMode^; + Result := PrintDevMode^.dmYResolution; +end; + +procedure TJclPrintSet.SetTrueTypeOption(Option: Integer); +var + PrintDevMode: PDeviceModeA; +begin + CheckPrinter; + PrintDevMode := @FDeviceMode^; + PrintDevMode^.dmTTOption := Option; + FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_TTOPTION; +end; + +function TJclPrintSet.GetTrueTypeOption: Integer; +var + PrintDevMode: PDeviceModeA; +begin + CheckPrinter; + PrintDevMode := @FDeviceMode^; + Result := PrintDevMode^.dmTTOption; +end; + +function TJclPrintSet.GetPrinterName: string; +begin + CheckPrinter; + Result := StrPas(FDevice); +end; + +function TJclPrintSet.GetPrinterPort: string; +begin + CheckPrinter; + Result := StrPas(FPort); +end; + +function TJclPrintSet.GetPrinterDriver: string; +begin + CheckPrinter; + Result := StrPas(FDriver); +end; + +procedure TJclPrintSet.SetBinFromList(BinNum: Byte); +begin + CheckPrinter; + if FNumBins = 0 then + Exit; + if BinNum > FNumBins then + raise EJclPrinterError.CreateRes(@RsIndexOutOfRange) + else + DefaultSource := FBinArray^[BinNum]; +end; + +function TJclPrintSet.GetBinIndex: Byte; +var + Idx: Byte; +begin + Result := 0; + for Idx := 0 to FNumBins do + begin + if FBinArray^[Idx] = Word(FDeviceMode^.dmDefaultSource) then + begin + Result := Idx; + Break; + end; + end; +end; + +procedure TJclPrintSet.SetPaperFromList(PaperNum: Byte); +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; + Port := Port + #0; + Move(Port[1], FPort^, Length(Port)); + Printer.SetPrinter(FDevice, FDriver, FPort, FHandle); +end; + +function TJclPrintSet.GetPaperIndex: Byte; +var + Idx: Byte; +begin + Result := 0; + for Idx := 0 to FNumPapers do + begin + if FPaperArray^[Idx] = Word(FDeviceMode^.dmPaperSize) then + begin + Result := Idx; + Break; + end; + end; +end; + +// History: + +// $Log: JclPrint.pas,v $ +// Revision 1.21 2005/10/30 01:55:34 rrossmair +// - introduce KEEP_DEPRECATED as alias for ~DROP_OBSOLETE_CODE +// +// Revision 1.20 2005/03/08 08:33:20 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.19 2005/03/05 06:31:19 rrossmair +// - allow conditional compilation for deprecated code (symbol DROP_OBSOLETE_CODE) +// +// Revision 1.18 2005/02/24 16:34:51 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.17 2004/11/06 02:07:05 mthoma +// cleaning. +// +// Revision 1.16 2004/10/09 13:58:52 marquardt +// style cleaning JclPrint +// remove WinSpool related functions from JclWin32 +// +// Revision 1.15 2004/10/09 06:17:27 marquardt +// cleaning: DPSetDefaultPrinter reimplemented from scratch +// +// Revision 1.14 2004/10/08 16:45:31 marquardt +// cleaning: DPGetDefaultPrinter reimplemented from scratch +// +// Revision 1.13 2004/09/16 19:47:32 rrossmair +// check-in in preparation for release 1.92 +// +// Revision 1.12 2004/08/02 15:30:16 marquardt +// hunting down (rom) comments +// +// Revision 1.11 2004/08/02 06:34:59 marquardt +// minor string literal improvements +// +// Revision 1.10 2004/07/30 07:20:25 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate +// +// Revision 1.9 2004/07/28 18:00:52 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.8 2004/06/14 13:05:20 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.7 2004/06/14 11:05:52 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.6 2004/05/13 07:32:18 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/13 13:33:38 +// add DPSetDefaultPrinter, bugfix GetDefaultPrinterName +// +// Revision 1.4 2004/04/11 22:12:16 mthoma +// Added a new function: GetDefaultPrinterName. +// +// Revision 1.3 2004/04/06 04:37:59 +// DPSetDefaultPrinter +// + +end. diff --git a/official/1.96/source/vcl/dirinfo.txt b/official/1.96/source/vcl/dirinfo.txt new file mode 100644 index 0000000..a478084 --- /dev/null +++ b/official/1.96/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/official/1.96/source/visclx/JclQGraphUtils.pas b/official/1.96/source/visclx/JclQGraphUtils.pas new file mode 100644 index 0000000..988c367 --- /dev/null +++ b/official/1.96/source/visclx/JclQGraphUtils.pas @@ -0,0 +1,2561 @@ +{**************************************************************************************************} +{ 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) } +{ } +{**************************************************************************************************} + +// For history, see end of file + +unit JclQGraphUtils; + +interface + +{$I jcl.inc} + +uses + Types, + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + SysUtils, + Qt, QGraphics, + 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; + + + { 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; + +{$IFDEF KEEP_DEPRECATED} +// obsolete; use corresponding HLS aliases instead +procedure HSLToRGB(const H, S, L: Single; out R, G, B: Single); overload; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +procedure RGBToHSL(const R, G, B: Single; out H, S, L: Single); overload; + {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +{$ENDIF KEEP_DEPRECATED} + +// 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; + + +// Misc +function ColorToHTML(const Color: TColor): string; + +// Petr Vones +{$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; + +implementation + +uses + Math, + JclResources, 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; + + +//=== Internal LowLevel ====================================================== + +function ColorSwap(WinColor: TColor): TColor32; +// this function swaps R and B bytes in ABGR and writes $FF into A component +{asm +// EAX = WinColor + MOV ECX, EAX // ECX = WinColor + MOV EDX, EAX // EDX = WinColor + + AND ECX, $FF0000 // B component + AND EAX, $0000FF // R component + AND EDX, $00FF00 // G component + + OR EAX, $00FF00 // write $FF into A component + SHR ECX, 16 // shift B + SHL EAX, 16 // shift AR + OR ECX, EDX // ECX = GB + OR EAX, ECX // set GB +end;} +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; +{asm + // 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) + // EAX <- X + // EDX <- Y + // ECX <- W + + // W = 0 or $FF? + JCXZ @1 // CX = 0 ? => Result := EDX + CMP ECX, $FF // CX = $FF ? => Result := EAX + JE @2 + + PUSH EBX + + // P = W * X + MOV EBX, EAX // EBX <- Xa Xr Xg Xb + AND EAX, $00FF00FF // EAX <- 00 Xr 00 Xb + AND EBX, $FF00FF00 // EBX <- Xa 00 Xg 00 + IMUL EAX, ECX // EAX <- Pr ** Pb ** + SHR EBX, 8 // EBX <- 00 Xa 00 Xg + IMUL EBX, ECX // EBX <- Pa ** Pg ** + ADD EAX, Bias + AND EAX, $FF00FF00 // EAX <- Pr 00 Pb 00 + SHR EAX, 8 // EAX <- 00 Pr 00 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 * Y + XOR ECX, $000000FF // ECX <- 1 - ECX + MOV EBX, EDX // EBX <- Ya Yr Yg Yb + AND EDX, $00FF00FF // EDX <- 00 Yr 00 Yb + AND EBX, $FF00FF00 // EBX <- Ya 00 Yg 00 + IMUL EDX, ECX // EDX <- Qr ** Qb ** + SHR EBX, 8 // EBX <- 00 Ya 00 Yg + IMUL EBX, ECX // EBX <- Qa ** Qg ** + ADD EDX, Bias + AND EDX, $FF00FF00 // EDX <- Qr 00 Qb 00 + SHR EDX, 8 // EDX <- 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 + + POP EBX + RET + +@1: MOV EAX, EDX +@2: RET +end;} +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); +{asm + // EAX <- F + // [EDX] <- B + // ECX <- W + PUSH EDX + MOV EDX, [EDX] + CALL _CombineReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := _CombineReg(F, B, W); +end; + +function _BlendReg(F, B: TColor32): TColor32; +{asm + // blend foreground color (F) to a background color (B), + // using alpha channel value of F + // Result Z = Fa * Frgb + (1 - Fa) * Brgb + // EAX <- F + // EDX <- B + MOV ECX, EAX // ECX <- Fa Fr Fg Fb + SHR ECX, 24 // ECX <- 00 00 00 Fa + JMP _CombineReg +end;} +begin + Result := _CombineReg(F, B, F shr 24); +end; + +procedure _BlendMem(F: TColor32; var B: TColor32); +{asm + // EAX <- F + // [EDX] <- B + PUSH EDX + MOV ECX, EAX // ECX <- Fa Fr Fg Fb + SHR ECX, 24 // ECX <- 00 00 00 Fa + MOV EDX, [EDX] + CALL _CombineReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := _CombineReg(F, B, F shr 24); +end; + +function _BlendRegEx(F, B, M: TColor32): TColor32; +{asm + // blend foreground color (F) to a background color (B), + // using alpha channel value of F multiplied by master alpha (M) + // no checking for M = $FF, if this is the case Graphics32 uses BlendReg + // Result Z = Fa * M * Frgb + (1 - Fa * M) * Brgb + // EAX <- F + // EDX <- B + // ECX <- M + MOV EBX, EAX // EBX <- Fa Fr Fg Fb + SHR EBX, 24 // EBX <- 00 00 00 Fa + IMUL ECX, EBX // ECX <- 00 00 W ** + SHR ECX, 8 // ECX <- 00 00 00 W + JMP _CombineReg +end;} +begin + Result := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + +procedure _BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +{asm + // EAX <- F + // [EDX] <- B + // ECX <- M + PUSH EBX + MOV EBX, EAX // EBX <- Fa Fr Fg Fb + SHR EBX, 24 // EBX <- 00 00 00 Fa + IMUL ECX, EBX // ECX <- 00 00 W ** + SHR ECX, 8 // ECX <- 00 00 00 W + + MOV EBX, EDX + MOV EDX, [EDX] + CALL _BlendRegEx + MOV [EBX], EAX + POP EBX +end;} +begin + B := _CombineReg(F, B, ((F shr 24) * M) shr 8); +end; + + +procedure _BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + // 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 +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; + +{ 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); + alpha_ptr := Pointer(Integer(AlphaTable) and $FFFFFFF8); + if Integer(alpha_ptr) < Integer(AlphaTable) then + alpha_ptr := Pointer(Integer(alpha_ptr) + 8); + 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(Integer(alpha_ptr) + $80 * 8); +end; + +procedure FreeAlphaTable; +begin + FreeMem(AlphaTable); + AlphaTable := nil; +end; + +procedure EMMS; +begin + if MMX_ACTIVE then + asm + db $0F, $77 // EMMS + end; +end; + +function M_CombineReg(X, Y, W: TColor32): TColor32; assembler; +asm + // 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 +end; + +procedure M_CombineMem(F: TColor32; var B: TColor32; W: TColor32); +{asm + // EAX - Color X + // [EDX] - Color Y + // ECX - Weight of X [0..255] + // Result := W * (X - Y) + Y + PUSH EDX + MOV EDX, [EDX] + CALL M_CombineReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := M_CombineReg(F, B, W); +end; + +function M_BlendReg(F, B: TColor32): TColor32; assembler; +asm + // 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 +end; + +procedure M_BlendMem(F: TColor32; var B: TColor32); +{asm + // EAX - Color X + // [EDX] - Color Y + // Result := W * (X - Y) + Y + PUSH EDX + MOV EDX, [EDX] + CALL M_BlendReg + POP EDX + MOV [EDX], EAX +end;} +begin + B := M_BlendReg(F, B); +end; + +function M_BlendRegEx(F, B, M: TColor32): TColor32; assembler; +asm + // 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 +end; + +procedure M_BlendMemEx(F: TColor32; var B: TColor32; M: TColor32); +{asm + // 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 EDX + MOV EDX, [EDX] + CALL M_BlendRegEx + POP EDX + MOV [EDX], EAX +end;} +begin + B := M_BlendRegEx(F, B, M); +end; + +procedure M_BlendLine(Src, Dst: PColor32; Count: Integer); assembler; +asm + // 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 +end; + +procedure M_BlendLineEx(Src, Dst: PColor32; Count: Integer; M: TColor32); assembler; +asm + // 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: +end; + +{ 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 Qt-independent solution } + X := QWidget_width(QApplication_desktop); + Y := QWidget_height(QApplication_desktop); + {$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; + +{$IFDEF KEEP_DEPRECATED} +procedure HSLToRGB(const H, S, L: Single; out R, G, B: Single); +begin + HLSToRGB(H, L, S, R, G, B); +end; +{$ENDIF KEEP_DEPRECATED} + +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; + +{$IFDEF KEEP_DEPRECATED} +procedure RGBToHSL(const R, G, B: Single; out H, S, L: Single); +begin + RGBToHLS(R, G, B, H, L, S); +end; +{$ENDIF KEEP_DEPRECATED} + +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; + + +//=== 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 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); + end; + with Points[I] do + begin + X1 := X; + Y1 := Y; + end; + end; +end; + +initialization + SetupFunctions; + if MMX_ACTIVE then + GenAlphaTable; + +finalization + if MMX_ACTIVE then + FreeAlphaTable; + +// History: + +// Revision 1.18 2005/02/24 16:34:41 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.17 2004/11/25 21:56:12 rrossmair +// - TColor32Array declaration changed to avoid range check errors in JclGraphics +// +// Revision 1.16 2004/11/14 06:05:05 rrossmair +// - some source formatting +// +// Revision 1.15 2004/10/18 16:22:14 marquardt +// corrected typo +// +// Revision 1.14 2004/10/17 20:54:14 mthoma +// cleaning +// +// Revision 1.13 2004/07/31 06:21:02 marquardt +// - reset AlphaTable to nil in FreeAlphaTable +// +// Revision 1.12 2004/07/16 03:58:14 rrossmair +// some style cleaning +// +// Revision 1.11 2004/06/27 23:28:51 rrossmair +// some style cleaning (case, spaces) +// +// Revision 1.10 2004/06/16 07:30:28 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.9 2004/06/14 13:05:19 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.8 2004/05/05 22:14:51 rrossmair +// bug fix in HSLToRGB(const H, S, L: Single; out R, G, B: Single); source code formatted +// renamed Hue/Luminance/Saturation related routines from *HSL* to *HLS*, as far as possible; old identifiers kept as deprecated +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.7 2004/05/01 00:21:10 rrossmair +// fixed for Kylix +// +// Revision 1.6 2004/04/28 04:16:19 rrossmair +// new functions added: RGBToHLS, HLSToRGB, RGB2HLS, HLS2RGB, SetBitmapColors (VCL only) +// +// Revision 1.5 2004/04/18 06:32:07 rrossmair +// replaced symbol "Develop" by jpp-pre-undefined "PROTOTYPE"; protected CVS key words by "PROTOTYPE" symbol +// +// Revision 1.4 2004/04/06 05:01:54 +// adapt compiler conditions, add log entry +// +// 2001-03-28, Mike Lischke: +// - ShortenString included + +end. diff --git a/official/1.96/source/visclx/JclQGraphics.pas b/official/1.96/source/visclx/JclQGraphics.pas new file mode 100644 index 0000000..fdcd1b6 --- /dev/null +++ b/official/1.96/source/visclx/JclQGraphics.pas @@ -0,0 +1,1511 @@ +{**************************************************************************************************} +{ 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) } +{ } +{**************************************************************************************************} + +// For history, see end of file + +unit JclQGraphics; + +{$I jcl.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + Types, QGraphics, JclQGraphUtils, + 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 + + + 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; +function IconToBitmap(Icon: HICON): HBITMAP; +{$ENDIF MSWINDOWS} + + + +{$IFDEF MSWINDOWS} +function FillGradient(DC: HDC; ARect: TRect; ColorCount: Integer; + StartColor, EndColor: TColor; ADirection: TGradientDirection): Boolean; overload; +{$ENDIF MSWINDOWS} + + + +implementation + +uses + Math, + {$IFDEF MSWINDOWS} + CommCtrl, ShellApi, + {$ENDIF MSWINDOWS} + JclLogic; + +type + TRGBInt = record + R: Integer; + G: Integer; + B: Integer; + end; + + PBGRA = ^TBGRA; + TBGRA = packed record + B: Byte; + G: Byte; + R: Byte; + A: Byte; + end; + + PPixelArray = ^TPixelArray; + TPixelArray = array [0..0] of TBGRA; + + 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 + 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; + +threadvar + // globally used cache for current image (speeds up resampling about 10%) + CurrentLineR: array of Integer; + CurrentLineG: array of Integer; + CurrentLineB: array of Integer; + +//=== Helper functions ======================================================= + +function IntToByte(Value: Integer): Byte; +begin + Result := Math.Max(0, Math.Min(255, Value)); +end; + + +//=== Internal low level routines ============================================ + +procedure FillLongword(var X; Count: Integer; Value: Longword); +{asm +// EAX = X +// EDX = Count +// ECX = Value + TEST EDX, EDX + JLE @@EXIT + + PUSH EDI + MOV EDI, EAX // Point EDI to destination + MOV EAX, ECX + MOV ECX, EDX + REP STOSD // Fill count dwords + POP EDI +@@EXIT: +end;} +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); +{asm +// EAX = [A] +// EDX = [B] + MOV ECX, [EAX] // ECX := [A] + CMP ECX, [EDX] // ECX <= [B]? Exit + JLE @@EXIT + //Replaced on more fast code + //XCHG ECX, [EDX] // ECX <-> [B]; + //MOV [EAX], ECX // [A] := ECX + PUSH EBX + MOV EBX,[EDX] // EBX := [B] + MOV [EAX],EBX // [A] := EBX + MOV [EDX],ECX // [B] := ECX + POP EBX +@@EXIT: +end;} +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; + + 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 / 3.0) + else + Result := 0.0; +end; + +function BitmapMitchellFilter(Value: Single): Single; +const + B = 1.0 / 3.0; + C = 1.0 / 3.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 / 6.0; + 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 / 6.0; + end + else + Result := 0.0; +end; + +const + FilterList: array [TResamplingFilter] of TBitmapFilterFunction = + ( + BitmapBoxFilter, + BitmapTriangleFilter, + BitmapHermiteFilter, + BitmapBellFilter, + BitmapSplineFilter, + BitmapLanczos3Filter, + BitmapMitchellFilter + ); + +procedure FillLineCache(N, Delta: Integer; Line: Pointer); +var + I: Integer; + Run: PBGRA; +begin + Run := Line; + for I := 0 to N - 1 do + begin + CurrentLineR[I] := Run.R; + CurrentLineG[I] := Run.G; + CurrentLineB[I] := Run.B; + Inc(PByte(Run), Delta); + end; +end; + +function ApplyContributors(N: Integer; Contributors: TContributors): TBGRA; +var + J: Integer; + RGB: TRGBInt; + Total, + Weight: Integer; + Pixel: Cardinal; + Contr: PContributor; +begin + RGB.R := 0; + RGB.G := 0; + RGB.B := 0; + Total := 0; + Contr := @Contributors[0]; + for J := 0 to N - 1 do + begin + Weight := Contr.Weight; + Inc(Total, Weight); + Pixel := Contr.Pixel; + Inc(RGB.R, CurrentLineR[Pixel] * Weight); + Inc(RGB.G, CurrentLineG[Pixel] * Weight); + Inc(RGB.B, CurrentLineB[Pixel] * Weight); + Inc(Contr); + end; + + if Total = 0 then + begin + Result.R := IntToByte(RGB.R shr 8); + Result.G := IntToByte(RGB.G shr 8); + Result.B := IntToByte(RGB.B shr 8); + end + else + begin + Result.R := IntToByte(RGB.R div Total); + Result.G := IntToByte(RGB.G div Total); + Result.B := IntToByte(RGB.B div Total); + 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: PPixelArray; + DestPixel: PBGRA; + Delta, DestDelta: Integer; + SourceHeight, SourceWidth: Integer; + TargetHeight, TargetWidth: Integer; +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 := Math.Floor(Center - Width); + Right := 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 := Math.Floor(Center - Radius); + Right := 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; + + // now apply filter to sample horizontally from Src to Work + + SetLength(CurrentLineR, SourceWidth); + SetLength(CurrentLineG, SourceWidth); + SetLength(CurrentLineB, SourceWidth); + for K := 0 to SourceHeight - 1 do + begin + SourceLine := Source.ScanLine[K]; + FillLineCache(SourceWidth, SizeOf(TBGRA), SourceLine); + DestPixel := Work.ScanLine[K]; + for I := 0 to TargetWidth - 1 do + with ContributorList[I] do + begin + DestPixel^ := ApplyContributors(N, ContributorList[I].Contributors); + // 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 := Math.Floor(Center - Width); + Right := 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 := Math.Floor(Center - Radius); + Right := 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 + SetLength(CurrentLineR, SourceHeight); + SetLength(CurrentLineG, SourceHeight); + SetLength(CurrentLineB, SourceHeight); + + SourceLine := Work.ScanLine[0]; + Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine); + DestLine := Target.ScanLine[0]; + DestDelta := Integer(Target.ScanLine[1]) - Integer(DestLine); + for K := 0 to TargetWidth - 1 do + begin + DestPixel := Pointer(DestLine); + FillLineCache(SourceHeight, Delta, SourceLine); + for I := 0 to TargetHeight - 1 do + with ContributorList[I] do + begin + DestPixel^ := ApplyContributors(N, ContributorList[I].Contributors); + Inc(Integer(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; + CurrentLineR := nil; + CurrentLineG := nil; + CurrentLineB := nil; + 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; +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; + + Target.FreeImage; + Target.PixelFormat := pf32bit; + Target.Width := NewWidth; + Target.Height := NewHeight; + + DoStretch(FilterList[Filter], Radius, Temp, Target); + 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 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 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 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 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} + + + +//=== 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 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; + +// 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); + +// History: +// Revision 1.18 2004/11/14 06:05:05 rrossmair +// - some source formatting +// +// Revision 1.17 2004/11/06 02:19:45 mthoma +// history cleaning. +// +// Revision 1.16 2004/10/17 20:54:14 mthoma +// cleaning +// +// Revision 1.15 2004/07/28 07:40:41 marquardt +// remove comiler warnings +// +// Revision 1.14 2004/07/16 03:50:35 rrossmair +// fixed "not accesssible with BCB" warning for TJclRegion.CreateRect +// +// Revision 1.13 2004/07/15 05:15:41 rrossmair +// TJclRegion: Handle ownership management added, some refactoring +// +// Revision 1.12 2004/07/12 02:54:33 rrossmair +// TJclRegion.Create fixed +// +// Revision 1.11 2004/06/14 13:05:19 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.10 2004/05/14 15:20:44 rrossmair +// added Marcin Wieczorek to Contributors list +// +// Revision 1.9 2004/05/05 22:16:40 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.8 2004/04/18 06:32:07 rrossmair +// replaced symbol "Develop" by jpp-pre-undefined "PROTOTYPE"; protected CVS key words by "PROTOTYPE" symbol +// +// Revision 1.7 2004/04/08 19:44:30 mthoma +// Fixed 0001513: CheckParams at the beginning of ApplyLut is: CheckParams(Src, Dst) but should be CheckParams(Dst, Src) +// +// Revision 1.6 2004/04/06 05:01:54 +// adapt compiler conditions, add log entry + +end. diff --git a/official/1.96/source/visclx/dirinfo.txt b/official/1.96/source/visclx/dirinfo.txt new file mode 100644 index 0000000..84b84f3 --- /dev/null +++ b/official/1.96/source/visclx/dirinfo.txt @@ -0,0 +1 @@ +This is the place where VisualCLX dependent units reside. \ No newline at end of file diff --git a/official/1.96/source/windows/Hardlinks.pas b/official/1.96/source/windows/Hardlinks.pas new file mode 100644 index 0000000..6987109 --- /dev/null +++ b/official/1.96/source/windows/Hardlinks.pas @@ -0,0 +1,734 @@ +{**************************************************************************************************} +{ 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: 2005/04/07 01:12:02 $ +// For history see end of file + +unit Hardlinks; + +{$ALIGN ON} +{$MINENUMSIZE 4} + +interface + +(* + 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 + Windows; + + +{$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 + +implementation + +const + szNtDll = 'NTDLL.DLL'; // Import native APIs from this 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; + PPWideChar = ^PWideChar; + +type + LARGE_INTEGER = TLargeInteger; + PLARGE_INTEGER = ^LARGE_INTEGER; + +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: PChar): 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; + + 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; + RtlAllocateHeap: TRtlAllocateHeap = nil; + RtlFreeHeap: TRtlFreeHeap = nil; + RtlDosPathNameToNtPathName_U: TRtlDosPathNameToNtPathName_U = nil; + RtlInitUnicodeString: TRtlInitUnicodeString = nil; + RtlDetermineDosPathNameType_U: TRtlDetermineDosPathNameType_U = nil; + RtlNtStatusToDosError: TRtlNtStatusToDosError = nil; + + +function NtpGetProcessHeap: Pointer; assembler; +asm + // The structure offsets are now hardcoded to be able to remove otherwise + // obsolete structure definitions. +//MOV EAX, FS:[0]._TEB.Peb + MOV EAX, FS:[$30] // FS points to TEB/TIB which has a pointer to the PEB +//MOV EAX, [EAX]._PEB.ProcessHeap + MOV EAX, [EAX+$18] // Get the process heap's handle +(* +An alternative way to achieve exactly the same (at least in usermode) as above: + MOV EAX, FS:$18 + MOV EAX, [EAX+$30] + MOV EAX, [EAX+$18] +*) +end; + +(****************************************************************************** + + 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 := NtpGetProcessHeap; + {------------------------------------------------------------- + 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 + 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 + 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 + 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 + 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 + -----------------------} + Status := ZwOpenFile(hLinkTarget, dwDesiredAccessHL, oaMisc, + IOStats, dwShareAccessHL, dwOpenOptionsHL); + if Status = STATUS_SUCCESS then + try + // Wow ... target opened ... let's try to + 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 := NtpGetProcessHeap; + // Create and allocate a UNICODE_STRING from the zero-terminated parameters + if RtlCreateUnicodeStringFromAsciiz(usLinkName, szLinkName) then + try + 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'; + szRtlAllocateHeap = 'RtlAllocateHeap'; + szRtlFreeHeap = 'RtlFreeHeap'; + szRtlDosPathNameToNtPathName_U = 'RtlDosPathNameToNtPathName_U'; + szRtlInitUnicodeString = 'RtlInitUnicodeString'; + szRtlDetermineDosPathNameType_U = 'RtlDetermineDosPathNameType_U'; + szRtlNtStatusToDosError = 'RtlNtStatusToDosError'; + +var + hKernel32: THandle = 0; + +initialization + // 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); + @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(@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 ... + + +// History: + + +{ + Version 1.13a - 2005-03-06 + + Minor correction in the prototype of RtlDosPathNameToNtPathName_U() + to easier pass NIL as the 4th parameter. + + Version 1.13 - 2005-03-03 + + NtMyGetProcessHeap() renamed to NtpGetProcessHeap() + + Removed declarations for TEB/PEB/TIB and supplement. As they depend + on structures which are unlikely to change, the respective offsets + can be hardcoded. As soon as this function becomes OS-version- + dependent, adapted offsets will be used. + + Version 1.12c - 2004-10-26 + + Implementation of Robert Marquardts proposals for the sake of brevity + in the CreateHardLinkW() implementation - C-like returns + + Removal of potential bug in CreateHardLinkA() implementation + + Removal of two unused function prototypes + + Some more comments and corrections and indentations + + Perl script to create "my" version from JCL prototype + + Compiles fine on Delphi 4 (minor changes would be necessary for D3) + + Version 1.12b - 2004-10-26 + + Added some constants and replaced literals by them + + Removed some superfluous constants and records + + Version 1.12a - 2004-10-21 + + "Original" file renamed according to the change in the JCL prototype + Hardlink.pas -> Hardlinks.pas + + The original version is now being created using: + jpp -c -uJCL -dMSWINDOWS -uUNIX -uHAS_UNIT_LIBC -x..\ Hardlinks.pas + + Changes will first occur in this prototype and the output of the + preprocessor undefining the "JCL" symbol will be mirrored to my site + afterwards. The prototype at the JCL is the reference from now on. + + Version 1.12 - 2004-10-18 + + Code-cleaning (removal of the currently not working softlink stuff from 1.10) + + Comments for Project JEDI (JCL) + + Some extra declarations to be compatible with JclNTFS + + Runtime dynamic linking + + Checked into the JCL + + Version 1.11 - 2004-07-01 + + Bugfix from Nico Bendlin - Odd behavior of NtMyGetProcessHeap() + + ! Version 1.10 - 2004-04-16 [this was taken out again in 1.12] + ! + Implemented softlinks for directories (junction points/reparse points) + + Version 1.01 - 2003-08-25 + + Implemented hardlinks +} + +end. + diff --git a/official/1.96/source/windows/JclAppInst.pas b/official/1.96/source/windows/JclAppInst.pas new file mode 100644 index 0000000..e2f2e89 --- /dev/null +++ b/official/1.96/source/windows/JclAppInst.pas @@ -0,0 +1,610 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{ Unit owner: Petr Vones } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/12 21:54:10 $ +// For history see end of file + +unit JclAppInst; + +{$I jcl.inc} + +interface + +uses + Windows, Classes, Messages, + JclFileUtils, JclSynch; + +// 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; + FMapping: TJclSwapFileMapping; + FMappingView: TJclFileMappingView; + FMessageID: DWORD; + FOptex: TJclOptex; + function GetAppWnds(Index: Integer): THandle; + function GetInstanceCount: Integer; + function GetProcessIDs(Index: Integer): DWORD; + function GetInstanceIndex(ProcessID: DWORD): Integer; + protected + procedure InitData; + procedure NotifyInstances(const W, L: Longint); + procedure RemoveInstance; + 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(const MaxInstances: Word): Boolean; + procedure CheckMultipleInstances(const MaxInstances: Word); + 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 SwitchTo(const Index: Integer): Boolean; + procedure UserNotify(const Param: Longint); + property AppWnds[Index: Integer]: THandle read GetAppWnds; + property InstanceIndex[ProcessID: DWORD]: Integer read GetInstanceIndex; + property InstanceCount: Integer read GetInstanceCount; + property MessageID: DWORD read FMessageID; + property ProcessIDs[Index: Integer]: DWORD read GetProcessIDs; + 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; var S: string); +procedure ReadMessageStrings(const Message: TMessage; const Strings: TStrings); + +implementation + +uses + SysUtils, + JclStrings; + +{$IFDEF FPC} // missing declaration from unit Messages +type + TWMCopyData = packed record + Msg: Cardinal; + From: THandle; + CopyDataStruct: PCopyDataStruct; + Result: Longint; + end; +{$ENDIF FPC} + +const + { strings to form a unique name for file mapping and optex objects } + JclAIPrefix = 'Jcl'; + JclAIOptex = '_Otx'; + JclAIMapping = '_Map'; + + { 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 (FMapping <> nil) and (FOptex <> nil) then + RemoveInstance; + FreeAndNil(FMapping); + 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(const MaxInstances: Word): Boolean; +begin + FOptex.Enter; + try + with PJclAISharedData(FMappingView.Memory)^ do + begin + if MaxInst = 0 then + MaxInst := MaxInstances; + Result := Count < MaxInst; + ProcessIDs[Count] := GetCurrentProcessId; + Inc(Count); + end; + finally + FOptex.Leave; + end; + if Result then + NotifyInstances(AI_INSTANCECREATED, Integer(FCPID)); +end; + +procedure TJclAppInstances.CheckMultipleInstances(const MaxInstances: Word); +begin + if not CheckInstance(MaxInstances) then + begin + SwitchTo(0); + KillInstance; + end; +end; + +procedure TJclAppInstances.CheckSingleInstance; +begin + CheckMultipleInstances(1); +end; + +class function TJclAppInstances.GetApplicationWnd(const ProcessID: DWORD): THandle; +type + PTopLevelWnd = ^TTopLevelWnd; + TTopLevelWnd = record + ProcessID: DWORD; + Wnd: THandle; + end; +var + TopLevelWnd: TTopLevelWnd; + + function EnumWinProc(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, SizeOf(C)) > 0) and + (C = ClassNameOfTApplication) then + begin + Result := False; + Param^.Wnd := Wnd; + end + else + Result := True; + end; + +begin + TopLevelWnd.ProcessID := ProcessID; + TopLevelWnd.Wnd := 0; + EnumWindows(@EnumWinProc, LPARAM(@TopLevelWnd)); + Result := TopLevelWnd.Wnd; +end; + +function TJclAppInstances.GetAppWnds(Index: Integer): THandle; +begin + Result := GetApplicationWnd(GetProcessIDs(Index)); +end; + +function TJclAppInstances.GetInstanceCount: Integer; +begin + FOptex.Enter; + try + Result := PJclAISharedData(FMappingView.Memory)^.Count; + finally + FOptex.Leave; + end; +end; + +function TJclAppInstances.GetInstanceIndex(ProcessID: DWORD): Integer; +var + I: Integer; +begin + Result := -1; + FOptex.Enter; + try + with PJclAISharedData(FMappingView.Memory)^ do + begin + for I := 0 to Count - 1 do + if ProcessIDs[I] = ProcessID then + begin + Result := I; + Break; + end; + end; + finally + FOptex.Leave; + end; +end; + +function TJclAppInstances.GetProcessIDs(Index: Integer): DWORD; +begin + FOptex.Enter; + try + with PJclAISharedData(FMappingView.Memory)^ do + if Index >= Count then + Result := 0 + else + Result := ProcessIDs[Index]; + finally + FOptex.Leave; + end; +end; + +procedure TJclAppInstances.InitData; +var + UniqueAppID: string; +begin + if ExplicitUniqueAppId <> '' then + UniqueAppID := JclAIPrefix + ExplicitUniqueAppId + else + UniqueAppID := AnsiUpperCase(JclAIPrefix + ParamStr(0)); + CharReplace(UniqueAppID, '\', '_'); + FOptex := TJclOptex.Create(UniqueAppID + JclAIOptex, 4000); + FOptex.Enter; + try + FMapping := TJclSwapFileMapping.Create(UniqueAppID + JclAIMapping, + PAGE_READWRITE, SizeOf(TJclAISharedData), nil); + FMappingView := FMapping.Views[FMapping.Add(FILE_MAP_ALL_ACCESS, SizeOf(TJclAISharedData), 0)]; + if not FMapping.Existed then + FillChar(FMappingView.Memory^, SizeOf(TJclAISharedData), #0); + finally + FOptex.Leave; + end; + FMessageID := RegisterWindowMessage(PChar(UniqueAppID + JclAIMessage)); +end; + +class procedure TJclAppInstances.KillInstance; +begin + Halt(0); +end; + +procedure TJclAppInstances.NotifyInstances(const W, L: Integer); +var + I: Integer; + Wnd: THandle; + TID: DWORD; + Msg: TMessage; + + function EnumWinProc(Wnd: THandle; Message: PMessage): BOOL; stdcall; + begin + with Message^ do + SendNotifyMessage(Wnd, Msg, WParam, LParam); + Result := True; + end; + +begin + FOptex.Enter; + try + with PJclAISharedData(FMappingView.Memory)^ do + for I := 0 to Count - 1 do + begin + Wnd := GetApplicationWnd(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, @EnumWinProc, LPARAM(@Msg)); + end; + finally + FOptex.Leave; + end; +end; + +procedure TJclAppInstances.RemoveInstance; +var + I: Integer; +begin + FOptex.Enter; + try + with PJclAISharedData(FMappingView.Memory)^ do + for I := 0 to Count - 1 do + if ProcessIDs[I] = FCPID then + begin + ProcessIDs[I] := 0; + Move(ProcessIDs[I + 1], ProcessIDs[I], (Count - I) * SizeOf(DWORD)); + Dec(Count); + Break; + end; + finally + FOptex.Leave; + end; + NotifyInstances(AI_INSTANCEDESTROYED, Integer(FCPID)); +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; + +function TJclAppInstances.SendData(const WindowClassName: string; + const DataKind: TJclAppInstDataKind; + Data: Pointer; const Size: Integer; + OriginatorWnd: THandle): Boolean; +type + PEnumWinRec = ^TEnumWinRec; + TEnumWinRec = record + WindowClassName: PChar; + OriginatorWnd: THandle; + CopyData: TCopyDataStruct; + Self: TJclAppInstances; + end; + +var + EnumWinRec: TEnumWinRec; + + function EnumWinProc(Wnd: THandle; Data: PEnumWinRec): BOOL; stdcall; + var + ClassName: array [0..200] of Char; + I: Integer; + PID: DWORD; + Found: Boolean; + begin + if (GetClassName(Wnd, ClassName, SizeOf(ClassName)) > 0) and + (StrComp(ClassName, Data.WindowClassName) = 0) then + begin + GetWindowThreadProcessId(Wnd, @PID); + Found := False; + Data.Self.FOptex.Enter; + try + with PJclAISharedData(Data.Self.FMappingView.Memory)^ do + for I := 0 to Count - 1 do + if 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; + +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, Integer(@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) + 1, + OriginatorWnd); +end; + +function TJclAppInstances.SendStrings(const WindowClassName: string; + const DataKind: TJclAppInstDataKind; const Strings: TStrings; + OriginatorWnd: THandle): Boolean; +var + S: string; +begin + S := Strings.Text; + Result := SendData(WindowClassName, DataKind, Pointer(S), Length(S), OriginatorWnd); +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(const Index: Integer): Boolean; +begin + Result := BringAppWindowToFront(AppWnds[Index]); +end; + +procedure TJclAppInstances.UserNotify(const Param: Integer); +begin + NotifyInstances(AI_USERMSG, Param); +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 + with TWMCopyData(Message) do + if Msg = WM_COPYDATA then + begin + Size := CopyDataStruct^.cbData; + GetMem(Data, Size); + Move(CopyDataStruct^.lpData^, Data^, Size); + end; +end; + +procedure ReadMessageString(const Message: TMessage; var S: string); +begin + with TWMCopyData(Message) do + if Msg = WM_COPYDATA then + SetString(S, PChar(CopyDataStruct^.lpData), CopyDataStruct^.cbData); +end; + +procedure ReadMessageStrings(const Message: TMessage; const Strings: TStrings); +var + S: string; +begin + with TWMCopyData(Message) do + if Msg = WM_COPYDATA then + begin + SetString(S, PChar(CopyDataStruct^.lpData), CopyDataStruct^.cbData); + Strings.Text := S; + end; +end; + +initialization + +finalization + FreeAndNil(AppInstances); + +// History: + +// $Log: JclAppInst.pas,v $ +// Revision 1.14 2005/12/12 21:54:10 outchy +// HWND changed to THandle (linking problems with BCB). +// +// Revision 1.13 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.12 2004/10/17 21:00:14 mthoma +// cleaning +// +// Revision 1.11 2004/09/22 20:38:49 obones +// Removed "const" specifiers that were triggering the well known HPP generation bug in C++ Builder +// +// Revision 1.10 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.9 2004/07/28 18:00:52 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.8 2004/06/16 07:30:30 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.7 2004/06/14 11:05:52 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.6 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclCIL.pas b/official/1.96/source/windows/JclCIL.pas new file mode 100644 index 0000000..f03d59c --- /dev/null +++ b/official/1.96/source/windows/JclCIL.pas @@ -0,0 +1,1044 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{ Unit owner: Flier Lu } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/08 08:05:53 $ +// For history see end of file + +unit JclCIL; + +interface + +{$I jcl.inc} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + {$IFDEF RTL130_UP} + Contnrs, + {$ENDIF RTL130_UP} + JclBase, JclSysUtils, JclCLR, 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); + +implementation + +uses + {$IFDEF HAS_UNIT_VARIANTS} + Variants, + {$ENDIF HAS_UNIT_VARIANTS} + JclStrings, JclResources; + +type + TJclOpCodeInfoType = (itName, itFullName, itDescription); + +const + STP1 = $FE; + + OpCodeInfos: array [TJclOpCode, TJclOpCodeInfoType] of string = + ( + ('nop', RsCILCmdnop, RsCILDescrnop), + ('break', RsCILCmdbreak, RsCILDescrbreak), + ('ldarg.0', RsCILCmdldarg0, RsCILDescrldarg0), + ('ldarg.1', RsCILCmdldarg1, RsCILDescrldarg1), + ('ldarg.2', RsCILCmdldarg2, RsCILDescrldarg2), + ('ldarg.3', RsCILCmdldarg3, RsCILDescrldarg3), + ('ldloc.0', RsCILCmdldloc0, RsCILDescrldloc0), + ('ldloc.1', RsCILCmdldloc1, RsCILDescrldloc1), + ('ldloc.2', RsCILCmdldloc2, RsCILDescrldloc2), + ('ldloc.3', RsCILCmdldloc3, RsCILDescrldloc3), + ('stloc.0', RsCILCmdstloc0, RsCILDescrstloc0), + ('stloc.1', RsCILCmdstloc1, RsCILDescrstloc1), + ('stloc.2', RsCILCmdstloc2, RsCILDescrstloc2), + ('stloc.3', RsCILCmdstloc3, RsCILDescrstloc3), + ('ldarg.s', RsCILCmdldargs, RsCILDescrldargs), + ('ldarga.s', RsCILCmdldargas, RsCILDescrldargas), + ('starg.s', RsCILCmdstargs, RsCILDescrstargs), + ('ldloc.s', RsCILCmdldlocs, RsCILDescrldlocs), + ('ldloca.s', RsCILCmdldlocas, RsCILDescrldlocas), + ('stloc.s', RsCILCmdstlocs, RsCILDescrstlocs), + ('ldnull', RsCILCmdldnull, RsCILDescrldnull), + ('ldc.i4.m1', RsCILCmdldci4m1, RsCILDescrldci4m1), + ('ldc.i4.0', RsCILCmdldci40, RsCILDescrldci40), + ('ldc.i4.1', RsCILCmdldci41, RsCILDescrldci41), + ('ldc.i4.2', RsCILCmdldci42, RsCILDescrldci42), + ('ldc.i4.3', RsCILCmdldci43, RsCILDescrldci43), + ('ldc.i4.4', RsCILCmdldci44, RsCILDescrldci44), + ('ldc.i4.5', RsCILCmdldci45, RsCILDescrldci45), + ('ldc.i4.6', RsCILCmdldci46, RsCILDescrldci46), + ('ldc.i4.7', RsCILCmdldci47, RsCILDescrldci47), + ('ldc.i4.8', RsCILCmdldci48, RsCILDescrldci48), + ('ldc.i4.s', RsCILCmdldci4s, RsCILDescrldci4s), + ('ldc.i4', RsCILCmdldci4, RsCILDescrldci4), + ('ldc.i8', RsCILCmdldci8, RsCILDescrldci8), + ('ldc.r4', RsCILCmdldcr4, RsCILDescrldcr4), + ('ldc.r8', RsCILCmdldcr8, RsCILDescrldcr8), + ('unused', RsCILCmdunused1, RsCILDescrunused1), + ('dup', RsCILCmddup, RsCILDescrdup), + ('pop', RsCILCmdpop, RsCILDescrpop), + ('jmp', RsCILCmdjmp, RsCILDescrjmp), + ('call', RsCILCmdcall, RsCILDescrcall), + ('calli', RsCILCmdcalli, RsCILDescrcalli), + ('ret', RsCILCmdret, RsCILDescrret), + ('br.s', RsCILCmdbrs, RsCILDescrbrs), + ('brfalse.s', RsCILCmdbrfalses, RsCILDescrbrfalses), + ('brtrue.s', RsCILCmdbrtrues, RsCILDescrbrtrues), + ('beq.s', RsCILCmdbeqs, RsCILDescrbeqs), + ('bge.s', RsCILCmdbges, RsCILDescrbges), + ('bgt.s', RsCILCmdbgts, RsCILDescrbgts), + ('ble.s', RsCILCmdbles, RsCILDescrbles), + ('blt.s', RsCILCmdblts, RsCILDescrblts), + ('bne.un.s', RsCILCmdbneuns, RsCILDescrbneuns), + ('bge.un.s', RsCILCmdbgeuns, RsCILDescrbgeuns), + ('bgt.un.s', RsCILCmdbgtuns, RsCILDescrbgtuns), + ('ble.un.s', RsCILCmdbleuns, RsCILDescrbleuns), + ('blt.un.s', RsCILCmdbltuns, RsCILDescrbltuns), + ('br', RsCILCmdbr, RsCILDescrbr), + ('brfalse', RsCILCmdbrfalse, RsCILDescrbrfalse), + ('brtrue', RsCILCmdbrtrue, RsCILDescrbrtrue), + ('beq', RsCILCmdbeq, RsCILDescrbeq), + ('bge', RsCILCmdbge, RsCILDescrbge), + ('bgt', RsCILCmdbgt, RsCILDescrbgt), + ('ble', RsCILCmdble, RsCILDescrble), + ('blt', RsCILCmdblt, RsCILDescrblt), + ('bne.un', RsCILCmdbneun, RsCILDescrbneun), + ('bge.un', RsCILCmdbgeun, RsCILDescrbgeun), + ('bgt.un', RsCILCmdbgtun, RsCILDescrbgtun), + ('ble.un', RsCILCmdbleun, RsCILDescrbleun), + ('blt.un', RsCILCmdbltun, RsCILDescrbltun), + ('switch', RsCILCmdswitch, RsCILDescrswitch), + ('ldind.i1', RsCILCmdldindi1, RsCILDescrldindi1), + ('ldind.u1', RsCILCmdldindu1, RsCILDescrldindu1), + ('ldind.i2', RsCILCmdldindi2, RsCILDescrldindi2), + ('ldind.u2', RsCILCmdldindu2, RsCILDescrldindu2), + ('ldind.i4', RsCILCmdldindi4, RsCILDescrldindi4), + ('ldind.u4', RsCILCmdldindu4, RsCILDescrldindu4), + ('ldind.i8', RsCILCmdldindi8, RsCILDescrldindi8), + ('ldind.i', RsCILCmdldindi, RsCILDescrldindi), + ('ldind.r4', RsCILCmdldindr4, RsCILDescrldindr4), + ('ldind.r8', RsCILCmdldindr8, RsCILDescrldindr8), + ('ldind.ref', RsCILCmdldindref, RsCILDescrldindref), + ('stind.ref', RsCILCmdstindref, RsCILDescrstindref), + ('stind.i1', RsCILCmdstindi1, RsCILDescrstindi1), + ('stind.i2', RsCILCmdstindi2, RsCILDescrstindi2), + ('stind.i4', RsCILCmdstindi4, RsCILDescrstindi4), + ('stind.i8', RsCILCmdstindi8, RsCILDescrstindi8), + ('stind.r4', RsCILCmdstindr4, RsCILDescrstindr4), + ('stind.r8', RsCILCmdstindr8, RsCILDescrstindr8), + ('add', RsCILCmdadd, RsCILDescradd), + ('sub', RsCILCmdsub, RsCILDescrsub), + ('mul', RsCILCmdmul, RsCILDescrmul), + ('div', RsCILCmddiv, RsCILDescrdiv), + ('div.un', RsCILCmddivun, RsCILDescrdivun), + ('rem', RsCILCmdrem, RsCILDescrrem), + ('rem.un', RsCILCmdremun, RsCILDescrremun), + ('and', RsCILCmdand, RsCILDescrand), + ('or', RsCILCmdor, RsCILDescror), + ('xor', RsCILCmdxor, RsCILDescrxor), + ('shl', RsCILCmdshl, RsCILDescrshl), + ('shr', RsCILCmdshr, RsCILDescrshr), + ('shr.un', RsCILCmdshrun, RsCILDescrshrun), + ('neg', RsCILCmdneg, RsCILDescrneg), + ('not', RsCILCmdnot, RsCILDescrnot), + ('conv.i1', RsCILCmdconvi1, RsCILDescrconvi1), + ('conv.i2', RsCILCmdconvi2, RsCILDescrconvi2), + ('conv.i4', RsCILCmdconvi4, RsCILDescrconvi4), + ('conv.i8', RsCILCmdconvi8, RsCILDescrconvi8), + ('conv.r4', RsCILCmdconvr4, RsCILDescrconvr4), + ('conv.r8', RsCILCmdconvr8, RsCILDescrconvr8), + ('conv.u4', RsCILCmdconvu4, RsCILDescrconvu4), + ('conv.u8', RsCILCmdconvu8, RsCILDescrconvu8), + ('callvirt', RsCILCmdcallvirt, RsCILDescrcallvirt), + ('cpobj', RsCILCmdcpobj, RsCILDescrcpobj), + ('ldobj', RsCILCmdldobj, RsCILDescrldobj), + ('ldstr', RsCILCmdldstr, RsCILDescrldstr), + ('newobj', RsCILCmdnewobj, RsCILDescrnewobj), + ('castclass', RsCILCmdcastclass, RsCILDescrcastclass), + ('isinst', RsCILCmdisinst, RsCILDescrisinst), + ('conv.r.un', RsCILCmdconvrun, RsCILDescrconvrun), + ('unused', RsCILCmdunused2, RsCILDescrunused2), + ('unused', RsCILCmdunused3, RsCILDescrunused3), + ('unbox', RsCILCmdunbox, RsCILDescrunbox), + ('throw', RsCILCmdthrow, RsCILDescrthrow), + ('ldfld', RsCILCmdldfld, RsCILDescrldfld), + ('ldflda', RsCILCmdldflda, RsCILDescrldflda), + ('stfld', RsCILCmdstfld, RsCILDescrstfld), + ('ldsfld', RsCILCmdldsfld, RsCILDescrldsfld), + ('ldsflda', RsCILCmdldsflda, RsCILDescrldsflda), + ('stsfld', RsCILCmdstsfld, RsCILDescrstsfld), + ('stobj', RsCILCmdstobj, RsCILDescrstobj), + ('conv.ovf.i1.un', RsCILCmdconvovfi1un, RsCILDescrconvovfi1un), + ('conv.ovf.i2.un', RsCILCmdconvovfi2un, RsCILDescrconvovfi2un), + ('conv.ovf.i4.un', RsCILCmdconvovfi4un, RsCILDescrconvovfi4un), + ('conv.ovf.i8.un', RsCILCmdconvovfi8un, RsCILDescrconvovfi8un), + ('conv.ovf.u1.un', RsCILCmdconvovfu1un, RsCILDescrconvovfu1un), + ('conv.ovf.u2.un', RsCILCmdconvovfu2un, RsCILDescrconvovfu2un), + ('conv.ovf.u4.un', RsCILCmdconvovfu4un, RsCILDescrconvovfu4un), + ('conv.ovf.u8.un', RsCILCmdconvovfu8un, RsCILDescrconvovfu8un), + ('conv.ovf.i.un', RsCILCmdconvovfiun, RsCILDescrconvovfiun), + ('conv.ovf.u.un', RsCILCmdconvovfuun, RsCILDescrconvovfuun), + ('box', RsCILCmdbox, RsCILDescrbox), + ('newarr', RsCILCmdnewarr, RsCILDescrnewarr), + ('ldlen', RsCILCmdldlen, RsCILDescrldlen), + ('ldelema', RsCILCmdldelema, RsCILDescrldelema), + ('ldelem.i1', RsCILCmdldelemi1, RsCILDescrldelemi1), + ('ldelem.u1', RsCILCmdldelemu1, RsCILDescrldelemu1), + ('ldelem.i2', RsCILCmdldelemi2, RsCILDescrldelemi2), + ('ldelem.u2', RsCILCmdldelemu2, RsCILDescrldelemu2), + ('ldelem.i4', RsCILCmdldelemi4, RsCILDescrldelemi4), + ('ldelem.u4', RsCILCmdldelemu4, RsCILDescrldelemu4), + ('ldelem.i8', RsCILCmdldelemi8, RsCILDescrldelemi8), + ('ldelem.i', RsCILCmdldelemi, RsCILDescrldelemi), + ('ldelem.r4', RsCILCmdldelemr4, RsCILDescrldelemr4), + ('ldelem.r8', RsCILCmdldelemr8, RsCILDescrldelemr8), + ('ldelem.ref', RsCILCmdldelemref, RsCILDescrldelemref), + ('stelem.i', RsCILCmdstelemi, RsCILDescrstelemi), + ('stelem.i1', RsCILCmdstelemi1, RsCILDescrstelemi1), + ('stelem.i2', RsCILCmdstelemi2, RsCILDescrstelemi2), + ('stelem.i4', RsCILCmdstelemi4, RsCILDescrstelemi4), + ('stelem.i8', RsCILCmdstelemi8, RsCILDescrstelemi8), + ('stelem.r4', RsCILCmdstelemr4, RsCILDescrstelemr4), + ('stelem.r8', RsCILCmdstelemr8, RsCILDescrstelemr8), + ('stelem.ref', RsCILCmdstelemref, RsCILDescrstelemref), + ('unused', RsCILCmdunused4, RsCILDescrunused4), + ('unused', RsCILCmdunused5, RsCILDescrunused5), + ('unused', RsCILCmdunused6, RsCILDescrunused6), + ('unused', RsCILCmdunused7, RsCILDescrunused7), + ('unused', RsCILCmdunused8, RsCILDescrunused8), + ('unused', RsCILCmdunused9, RsCILDescrunused9), + ('unused', RsCILCmdunused10, RsCILDescrunused10), + ('unused', RsCILCmdunused11, RsCILDescrunused11), + ('unused', RsCILCmdunused12, RsCILDescrunused12), + ('unused', RsCILCmdunused13, RsCILDescrunused13), + ('unused', RsCILCmdunused14, RsCILDescrunused14), + ('unused', RsCILCmdunused15, RsCILDescrunused15), + ('unused', RsCILCmdunused16, RsCILDescrunused16), + ('unused', RsCILCmdunused17, RsCILDescrunused17), + ('unused', RsCILCmdunused18, RsCILDescrunused18), + ('unused', RsCILCmdunused19, RsCILDescrunused19), + ('conv.ovf.i1', RsCILCmdconvovfi1, RsCILDescrconvovfi1), + ('conv.ovf.u1', RsCILCmdconvovfu1, RsCILDescrconvovfu1), + ('conv.ovf.i2', RsCILCmdconvovfi2, RsCILDescrconvovfi2), + ('conv.ovf.u2', RsCILCmdconvovfu2, RsCILDescrconvovfu2), + ('conv.ovf.i4', RsCILCmdconvovfi4, RsCILDescrconvovfi4), + ('conv.ovf.u4', RsCILCmdconvovfu4, RsCILDescrconvovfu4), + ('conv.ovf.i8', RsCILCmdconvovfi8, RsCILDescrconvovfi8), + ('conv.ovf.u8', RsCILCmdconvovfu8, RsCILDescrconvovfu8), + ('unused', RsCILCmdunused20, RsCILDescrunused20), + ('unused', RsCILCmdunused21, RsCILDescrunused21), + ('unused', RsCILCmdunused22, RsCILDescrunused22), + ('unused', RsCILCmdunused23, RsCILDescrunused23), + ('unused', RsCILCmdunused24, RsCILDescrunused24), + ('unused', RsCILCmdunused25, RsCILDescrunused25), + ('unused', RsCILCmdunused26, RsCILDescrunused26), + ('refanyval', RsCILCmdrefanyval, RsCILDescrrefanyval), + ('ckfinite', RsCILCmdckfinite, RsCILDescrckfinite), + ('unused', RsCILCmdunused27, RsCILDescrunused27), + ('unused', RsCILCmdunused28, RsCILDescrunused28), + ('mkrefany', RsCILCmdmkrefany, RsCILDescrmkrefany), + ('unused', RsCILCmdunused29, RsCILDescrunused29), + ('unused', RsCILCmdunused30, RsCILDescrunused30), + ('unused', RsCILCmdunused31, RsCILDescrunused31), + ('unused', RsCILCmdunused32, RsCILDescrunused32), + ('unused', RsCILCmdunused33, RsCILDescrunused33), + ('unused', RsCILCmdunused34, RsCILDescrunused34), + ('unused', RsCILCmdunused35, RsCILDescrunused35), + ('unused', RsCILCmdunused36, RsCILDescrunused36), + ('unused', RsCILCmdunused37, RsCILDescrunused37), + ('ldtoken', RsCILCmdldtoken, RsCILDescrldtoken), + ('conv.u2', RsCILCmdconvu2, RsCILDescrconvu2), + ('conv.u1', RsCILCmdconvu1, RsCILDescrconvu1), + ('conv.i', RsCILCmdconvi, RsCILDescrconvi), + ('conv.ovf.i', RsCILCmdconvovfi, RsCILDescrconvovfi), + ('conv.ovf.u', RsCILCmdconvovfu, RsCILDescrconvovfu), + ('add.ovf', RsCILCmdaddovf, RsCILDescraddovf), + ('add.ovf.un', RsCILCmdaddovfun, RsCILDescraddovfun), + ('mul.ovf', RsCILCmdmulovf, RsCILDescrmulovf), + ('mul.ovf.un', RsCILCmdmulovfun, RsCILDescrmulovfun), + ('sub.ovf', RsCILCmdsubovf, RsCILDescrsubovf), + ('sub.ovf.un', RsCILCmdsubovfun, RsCILDescrsubovfun), + ('endfinally', RsCILCmdendfinally, RsCILDescrendfinally), + ('leave', RsCILCmdleave, RsCILDescrleave), + ('leave.s', RsCILCmdleaves, RsCILDescrleaves), + ('stind.i', RsCILCmdstindi, RsCILDescrstindi), + ('conv.u', RsCILCmdconvu, RsCILDescrconvu), + ('unused', RsCILCmdunused38, RsCILDescrunused38), + ('unused', RsCILCmdunused39, RsCILDescrunused39), + ('unused', RsCILCmdunused40, RsCILDescrunused40), + ('unused', RsCILCmdunused41, RsCILDescrunused41), + ('unused', RsCILCmdunused42, RsCILDescrunused42), + ('unused', RsCILCmdunused43, RsCILDescrunused43), + ('unused', RsCILCmdunused44, RsCILDescrunused44), + ('unused', RsCILCmdunused45, RsCILDescrunused45), + ('unused', RsCILCmdunused46, RsCILDescrunused46), + ('unused', RsCILCmdunused47, RsCILDescrunused47), + ('unused', RsCILCmdunused48, RsCILDescrunused48), + ('unused', RsCILCmdunused49, RsCILDescrunused49), + ('unused', RsCILCmdunused50, RsCILDescrunused50), + ('unused', RsCILCmdunused51, RsCILDescrunused51), + ('unused', RsCILCmdunused52, RsCILDescrunused52), + ('unused', RsCILCmdunused53, RsCILDescrunused53), + ('unused', RsCILCmdunused54, RsCILDescrunused54), + ('unused', RsCILCmdunused55, RsCILDescrunused55), + ('unused', RsCILCmdunused56, RsCILDescrunused56), + ('unused', RsCILCmdunused57, RsCILDescrunused57), + ('unused', RsCILCmdunused58, RsCILDescrunused58), + ('unused', RsCILCmdunused59, RsCILDescrunused59), + ('unused', RsCILCmdunused60, RsCILDescrunused60), + ('prefix7', RsCILCmdprefix7, RsCILDescrprefix7), + ('prefix6', RsCILCmdprefix6, RsCILDescrprefix6), + ('prefix5', RsCILCmdprefix5, RsCILDescrprefix5), + ('prefix4', RsCILCmdprefix4, RsCILDescrprefix4), + ('prefix3', RsCILCmdprefix3, RsCILDescrprefix3), + ('prefix2', RsCILCmdprefix2, RsCILDescrprefix2), + ('prefix1', RsCILCmdprefix1, RsCILDescrprefix1), + ('prefixref', RsCILCmdprefixref, RsCILDescrprefixref), + + ('arglist', RsCILCmdarglist, RsCILDescrarglist), + ('ceq', RsCILCmdceq, RsCILDescrceq), + ('cgt', RsCILCmdcgt, RsCILDescrcgt), + ('cgt.un', RsCILCmdcgtun, RsCILDescrcgtun), + ('clt', RsCILCmdclt, RsCILDescrclt), + ('clt.un', RsCILCmdcltun, RsCILDescrcltun), + ('ldftn', RsCILCmdldftn, RsCILDescrldftn), + ('ldvirtftn', RsCILCmdldvirtftn, RsCILDescrldvirtftn), + ('unused', RsCILCmdunused61, RsCILDescrunused61), + ('ldarg', RsCILCmdldarg, RsCILDescrldarg), + ('ldarga', RsCILCmdldarga, RsCILDescrldarga), + ('starg', RsCILCmdstarg, RsCILDescrstarg), + ('ldloc', RsCILCmdldloc, RsCILDescrldloc), + ('ldloca', RsCILCmdldloca, RsCILDescrldloca), + ('stloc', RsCILCmdstloc, RsCILDescrstloc), + ('localloc', RsCILCmdlocalloc, RsCILDescrlocalloc), + ('unused', RsCILCmdunused62, RsCILDescrunused62), + ('endfilter', RsCILCmdendfilter, RsCILDescrendfilter), + ('unaligned.', RsCILCmdunaligned, RsCILDescrunaligned), + ('volatile.', RsCILCmdvolatile, RsCILDescrvolatile), + ('tail.', RsCILCmdtail, RsCILDescrtail), + ('initobj', RsCILCmdinitobj, RsCILDescrinitobj), + ('unused', RsCILCmdunused63, RsCILDescrunused63), + ('cpblk', RsCILCmdcpblk, RsCILDescrcpblk), + ('initblk', RsCILCmdinitblk, RsCILDescrinitblk), + ('unused', RsCILCmdunused64, RsCILDescrunused64), + ('rethrow', RsCILCmdrethrow, RsCILDescrrethrow), + ('unused', RsCILCmdunused65, RsCILDescrunused65), + ('sizeof', RsCILCmdsizeof, RsCILDescrsizeof), + ('refanytype', RsCILCmdrefanytype, RsCILDescrrefanytype), + ('unused', RsCILCmdunused66, RsCILDescrunused66), + ('unused', RsCILCmdunused67, RsCILDescrunused67), + ('unused', RsCILCmdunused68, RsCILDescrunused68), + ('unused', RsCILCmdunused69, RsCILDescrunused69), + ('unused', 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(Longint(Stream.Memory) + Stream.Position)^; + if OpCode = STP1 then + begin + OpCode := PByte(Longint(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; + +begin + Indent := 0; + with TStringList.Create do + try + for I := 0 to InstructionCount-1 do + begin + for J := 0 to Method.ExceptionHandlerCount-1 do + with Method.ExceptionHandlers[J] do + begin + if Instructions[I].Offset = TryBlock.Offset then + begin + Add(IndentStr + '.try'); + Add(IndentStr + '{'); + Inc(Indent); + end; + if Instructions[I].Offset = (TryBlock.Offset + TryBlock.Length) then + begin + Dec(Indent); + Add(IndentStr + '} // end .try'); + end; + if Instructions[I].Offset = HandlerBlock.Offset then + begin + Add(IndentStr + FlagsToName(Flags)); + Add(IndentStr + '{'); + Inc(Indent); + end; + if Instructions[I].Offset = (HandlerBlock.Offset + HandlerBlock.Length) then + begin + Dec(Indent); + Add(IndentStr + '} // end ' + FlagsToName(Flags)); + end; + end; + Add(IndentStr + Instructions[I].DumpIL(Options)); + end; + Result := Text; + finally + 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 := OpCodeInfos[OpCode, itName]; +end; + +function TJclInstruction.GetFullName: string; +begin + Result := OpCodeInfos[OpCode, itFullName]; +end; + +function TJclInstruction.GetDescription: string; +begin + Result := 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; + Result := OpCodeSize[OpCode in [opNop..opPrefixRef]] + Result; +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 + 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 + 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 + Stream.Read(Value, SizeOf(Value)); + FParam[I] := Value; + end; + end; + {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? } + ptSOff, ptI1: + begin + Stream.Read(VShortInt, SizeOf(ShortInt)); + 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; + {$ENDIF RTL140_UP} + end; + except + Stream.Position := FOffset; + raise; + end; +end; + +procedure TJclInstruction.Save(Stream: TStream); +var + Code: Byte; + {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? } + ArraySize: DWORD; + I, Value: Integer; + {$ENDIF RTL140_UP} +begin + if WideOpCode then + begin + 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)); + {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? } + 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; + {$ENDIF RTL140_UP} + 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 + {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? } + I: Integer; + Row: TJclClrTableRow; + {$ENDIF RTL140_UP} + CodeStr, ParamStr: string; +begin + case Option of + 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'; + {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? } + 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); + {$ENDIF RTL140_UP} + 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 + Size) + TVarData(Param).VInteger - 1); + {$IFDEF RTL140_UP} { TODO -cTest : since RTL 14.0 or 15.0? } + ptToken: + begin + if Byte(TJclPeMetadata.TokenTable(TVarData(Param).VLongWord)) = $70 then + 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 + with TJclClrTableTypeRefRow(Row) do + Result := FullName + else + if Row is TJclClrTableMethodDefRow then + with TJclClrTableMethodDefRow(Row) do + Result := ParentToken.FullName + '.' + Name + else + if Row is TJclClrTableMemberRefRow then + with TJclClrTableMemberRefRow(Row) do + Result := 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; + {$ENDIF RTL140_UP} + 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; + +// History: + +// $Log: JclCIL.pas,v $ +// Revision 1.15 2005/05/08 08:05:53 outchy +// Warning suppression, DWORD (Cardinal) changed to Integer +// +// Revision 1.14 2005/03/14 02:13:13 rrossmair +// - fixed JclCLR identifier case +// +// Revision 1.13 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.12 2005/03/07 17:27:58 marquardt +// reworked for resorucestrings +// +// Revision 1.11 2005/02/27 14:55:26 marquardt +// changed overloaded constructors to constructor with default parameter (BCB friendly) +// +// Revision 1.10 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.9 2004/10/17 21:00:14 mthoma +// cleaning +// +// Revision 1.8 2004/08/03 17:13:28 marquardt +// make duplicate string literals constants +// +// Revision 1.7 2004/06/14 13:05:21 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.6 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclCLR.pas b/official/1.96/source/windows/JclCLR.pas new file mode 100644 index 0000000..7a50f01 --- /dev/null +++ b/official/1.96/source/windows/JclCLR.pas @@ -0,0 +1,1788 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{ Unit owner: Flier Lu } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/26 18:03:58 $ +// For history see end of file + +unit JclCLR; + +interface + +{$I jcl.inc} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + {$IFDEF RTL130_UP} + Contnrs, + {$ENDIF RTL130_UP} + JclBase, JclFileUtils, 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 Char; + 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 Char; + // 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 Char; + 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; + protected + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); virtual; + public + 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; + protected + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); override; + public + 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; + protected + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); override; + public + 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; + protected + constructor Create(const AStream: TJclClrStream; APtr: PJclByteArray); + public + 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; + protected + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); override; + public + 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 + constructor Create(const ATable: TJclClrTable); virtual; + procedure Update; virtual; + function DecodeTypeDefOrRef(const Encoded: DWORD): TJclClrTableRow; + function DecodeResolutionScope(const Encoded: DWORD): TJclClrTableRow; + public + 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: PChar; + FPtr: PChar; + FRows: TObjectList; + FRowCount: Integer; + FSize: DWORD; + function GetOffset: DWORD; + protected + constructor Create(const AStream: TJclClrTableStream; + const Ptr: Pointer; const ARowCount: Integer); virtual; + 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 + 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: PChar 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; + protected + constructor Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); override; + public + destructor Destroy; override; + procedure Update; virtual; + function DumpIL: string; + function FindTable(const AKind: TJclClrTableKind; + var 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; + protected + constructor Create(const AImage: TJclPeImage); + public + destructor Destroy; override; + function DumpIL: string; + function FindStream(const AName: string; var Stream: TJclClrStream): Boolean; overload; + function FindStream(const AClass: TJclClrStreamClass; var 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; + protected + constructor Create(const AData: PChar; const AOffset: DWORD; const ARVA: DWORD); + public + 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 + constructor Create(AData: PImageCorVTableFixup); + class function VTableKinds(const Kinds: TJclClrVTableKinds): DWORD; overload; + class function VTableKinds(const Kinds: DWORD): TJclClrVTableKinds; overload; + public + 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; + +implementation + +uses + Math, TypInfo, + JclMetadata, JclResources, JclStrings, JclUnicode; + +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 := FHeader.Name; +end; + +function TJclClrStream.GetOffset: DWORD; +begin + Result := Data - Metadata.Image.LoadedImage.MappedAddress; +end; + +function TJclClrStream.GetSize: DWORD; +begin + Result := FHeader.Size; +end; + +function TJclClrStream.GetData: Pointer; +begin + Result := Pointer(DWORD(FMetadata.Header) + FHeader.Offset); +end; + +//=== { TJclClrStringsStream } =============================================== + +constructor TJclClrStringsStream.Create(const AMetadata: TJclPeMetadata; + AHeader: PClrStreamHeader); +var + pch: PChar; + 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(pch, TObject(off)); + pch := pch + StrLen(pch) + 1; + off := DWORD(pch - Data); + end; +end; + +destructor TJclClrStringsStream.Destroy; +begin + FreeAndNil(FStrings); + inherited Destroy; +end; + +function TJclClrStringsStream.GetString(const Idx: Integer): WideString; +begin + Result := UTF8ToWideString(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 := DWORD(FPtr) - DWORD(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) + (FPtr[1] shl 16) + (FPtr[2] shl 8) + 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) + 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: PChar; Size: Integer; IsHead, IsTail: Boolean): string; + var + I: Integer; + HexStr, AsciiStr: string; + begin + for I := 0 to Size-1 do + begin + HexStr := HexStr + IntToHex(Integer(Buf[I]), 2) + ' '; + if CharIsPrintable(Buf[I]) and ((Byte(Buf[I]) and $80) <> $80) then + AsciiStr := AsciiStr + Buf[I] + else + AsciiStr := AsciiStr + '.'; + end; + + if IsTail then + Result := HexStr + ')' + StrRepeat(' ', (BufSize-Size)*3) + ' // ' + AsciiStr + else + Result := HexStr + ' ' + StrRepeat(' ', (BufSize-Size)*3) + ' // ' + AsciiStr; + if IsHead then + Result := Indent + '( ' + Result + else + Result := 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(PChar(Memory) + I * BufSize, Size - I * BufSize, I=0, I=Len-1)) + else + Add(DumpBuf(PChar(Memory) + I * BufSize, BufSize, I=0, I=Len-1)); + Result := Text; + finally + Free; + end; +end; + +function TJclClrBlobRecord.GetData: PJclByteArray; +begin + Result := PJclByteArray(LongInt(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 (Integer(ABlob.Memory) + ABlob.Size) < (Integer(Self.Data) + Integer(Self.Size)) then + ABlob := TJclClrBlobRecord.Create(Self, Pointer(Integer(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 + // (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 := Byte(GetTableId) shl 24 + 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 := DWORD(Data) - DWORD(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 + ReadByte; + end + else + if ((Result and $80) = $80) and ((Result and $40) = 0) then // 10bs + begin + Result := ((Result and $3F) shl 8) + 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 + AnsiLineBreak; + {$IFDEF RTL140_UP} + if Supports(ClassType, ITableCanDumpIL) then + {$ELSE RTL140_UP} + if ClassType.GetInterfaceEntry(ITableCanDumpIL) <> nil then + {$ENDIF RTL140_UP} + for I := 0 to FRows.Count - 1 do + Result := Result + TJclClrTableRow(FRows[I]).DumpIL; +end; + +//=== { 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(DWORD(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 + FreeAndNil(FTables); + 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; + var 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 + 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(DWORD(@Header.Version[0]) + Header.Length); + pStream := @pStreamPart.StreamHeaders[0]; + for I := 0 to pStreamPart.StreamCount-1 do + begin + FStreams.Add(GetStreamClass(pStream.Name).Create(Self, pStream)); + + pStream := PClrStreamHeader(DWORD(@pStream.Name[0]) + + DWORD((((StrLen(@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: string; +begin + SetLength(VerStr, Header.Length+1); + StrlCopy(PChar(VerStr), @Header.Version[0], Header.Length); + SetLength(VerStr, StrLen(PChar(VerStr))); + Result := UTF8ToWideString(VerStr) +end; + +function TJclPeMetadata.GetVersion: string; +begin + Result := FormatVersionString(Header.MajorVersion, Header.MinorVersion); +end; + +function TJclPeMetadata.GetFlags: Word; +begin + Result := PWord(PChar(@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; + var 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; + var 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 + Add(Format('.imagebase 0x%.8x', [Image.OptionalHeader.ImageBase])); + Add(Format('.subsystem 0x%.8x', [Image.OptionalHeader.SubSystem])); + Add(Format('.file alignment %d', [Image.OptionalHeader.FileAlignment])); + if Assigned(FTableStream) then + begin + FTableStream.Update; + Result := Text + AnsiLineBreak + FTableStream.DumpIL; + end; + finally + Free; + end; +end; + +//=== { TJclClrResourceRecord } ============================================== + +constructor TJclClrResourceRecord.Create(const AData: PChar; + const AOffset: DWORD; const ARVA: DWORD); +begin + FData := AData; + FOffset := AOffset; + FRVA := ARVA; + inherited Create(Pointer(DWORD(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: PChar; + ARes: TJclClrResourceRecord; +begin + FResources := TObjectList.Create; + with Header.Resources do + begin + Base := Image.RvaToVa(VirtualAddress); + Ptr := Base; + while DWORD(Ptr-Base) < Size do + begin + ARes := TJclClrResourceRecord.Create(Ptr, Ptr-Base, Ptr-Image.LoadedImage.MappedAddress); + FResources.Add(ARes); + Ptr := PChar(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(RsClrCopyright); + Add(Format('.corflags 0x%.8x', [Header.Flags])); + Result := Text + AnsiLineBreak + Metadata.DumpIL; + finally + Free; + end; +end; + +// History: + +// $Log: JclCLR.pas,v $ +// Revision 1.16 2005/12/26 18:03:58 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.15 2005/08/07 13:09:56 outchy +// Changed PByteArray to PJclByteArray to avoid RangeCheck exceptions. +// +// Revision 1.14 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.13 2005/03/06 18:15:03 marquardt +// JclGUIDToString and JclStringToGUID moved to JclSysUtils.pas, CrLf replaced by AnsiLineBreak +// +// Revision 1.12 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.11 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.10 2004/10/17 21:00:14 mthoma +// cleaning +// +// Revision 1.9 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.8 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.7 2004/06/14 13:05:21 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.6 2004/05/13 07:35:09 rrossmair +// removed obsolete TODO +// +// Revision 1.5 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.4 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclCOM.pas b/official/1.96/source/windows/JclCOM.pas new file mode 100644 index 0000000..62878df --- /dev/null +++ b/official/1.96/source/windows/JclCOM.pas @@ -0,0 +1,680 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/03/08 08:33:22 $ +// For history see end of file + +unit JclCOM; + +{$I jcl.inc} + +interface + +uses + Windows, ActiveX, Classes, + 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; + +implementation + +uses + {$IFDEF FPC} + Types, + {$ENDIF FPC} + SysUtils, + {$IFDEF HAS_UNIT_VARIANTS} + Variants, + {$ENDIF HAS_UNIT_VARIANTS} + 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 [wvUnknown, wvWin95, wvWin95OSR2]); + if not Result then + begin + OLE32 := LoadLibrary(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 ??) } + 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 ??) } + 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: Largeint; + 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; + +// History: + +// $Log: JclCOM.pas,v $ +// Revision 1.13 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.12 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.11 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.10 2004/10/21 08:40:10 marquardt +// style cleaning +// +// Revision 1.9 2004/10/17 21:00:14 mthoma +// cleaning +// +// Revision 1.8 2004/06/14 11:05:52 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.7 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.6 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclConsole.pas b/official/1.96/source/windows/JclConsole.pas new file mode 100644 index 0000000..9a68180 --- /dev/null +++ b/official/1.96/source/windows/JclConsole.pas @@ -0,0 +1,1594 @@ +{**************************************************************************************************} +{ } +{ 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 } +{ } +{ Unit owner: Flier Lu } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/05/05 20:08:47 $ +// For history see end of file + +unit JclConsole; + +{$I jcl.inc} +{$I windowsonly.inc} + +{$HPPEMIT 'namespace JclConsole'} +(*$HPPEMIT '{'*) +{$HPPEMIT '__interface IJclScreenTextAttribute;'} +(*$HPPEMIT '}'*) +{$HPPEMIT 'using namespace JclConsole;'} +{$HPPEMIT ''} + +interface + +uses + Windows, + Classes, SysUtils, Contnrs, + 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); + protected + constructor Create; + public + destructor Destroy; override; + class function Default: TJclConsole; + class procedure Shutdown; + { TODO : Add 'Attach' and other functions for WinXP/Win.Net } + {$IFNDEF CLR} + class function IsConsole(const Module: HMODULE): Boolean; overload; + class function IsConsole(const FileName: TFileName): Boolean; overload; + {$ENDIF ~CLR} + 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 + constructor Create; overload; + constructor Create(const AHandle: THandle); overload; + constructor Create(const AWidth, AHeight: Smallint); overload; + procedure Init; + procedure DoResize(const NewSize: TCoord); overload; + procedure DoResize(const NewWidth, NewHeight: Smallint); overload; + property Info: TConsoleScreenBufferInfo read GetInfo; + public + 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; + {$IFDEF CLR} + function Write(const Text: string; const X: Smallint; const Y: Smallint; + Attrs: array of Word): DWORD; overload; + {$ELSE} + function Write(const Text: string; const X: Smallint; const Y: Smallint; + pAttrs: PWORD): DWORD; overload; + {$ENDIF CLR} + 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) + private + function GetBgColor: TJclScreenBackColor; + function GetBgHighlight: Boolean; + function GetColor: TJclScreenFontColor; + function GetHighlight: Boolean; + function GetStyle: TJclScreenFontStyles; + procedure SetBgColor(const Value: TJclScreenBackColor); + procedure SetBgHighlight(const Value: Boolean); + procedure SetColor(const Value: TJclScreenFontColor); + procedure SetHighlight(const Value: Boolean); + procedure SetStyle(const Value: TJclScreenFontStyles); + protected + function GetTextAttribute: Word; virtual; abstract; + procedure SetTextAttribute(const Value: Word); virtual; abstract; + public + constructor Create(const Attr: TJclScreenCustomTextAttribute = nil); overload; + procedure Clear; + property TextAttribute: Word read GetTextAttribute write SetTextAttribute; + 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) + private + FScreenBuffer: TJclScreenBuffer; + protected + constructor Create(const AScrBuf: TJclScreenBuffer); + function GetTextAttribute: Word; override; + procedure SetTextAttribute(const Value: Word); override; + public + property ScreenBuffer: TJclScreenBuffer read FScreenBuffer; + end; + + TJclScreenTextAttribute = class(TJclScreenCustomTextAttribute) + private + FAttribute: Word; + protected + function GetTextAttribute: Word; override; + procedure SetTextAttribute(const Value: Word); override; + 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; + end; + + TJclScreenCharacter = class(TJclScreenCustomTextAttribute) + private + FCharInfo: TCharInfo; + function GetCharacter: Char; + procedure SetCharacter(const Value: Char); + protected + constructor Create(const CharInfo: TCharInfo); + function GetTextAttribute: Word; override; + procedure SetTextAttribute(const Value: Word); override; + public + property Info: TCharInfo read FCharInfo write FCharInfo; + property Character: Char read GetCharacter write SetCharacter; + 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 + constructor Create(const AScrBuf: TJclScreenBuffer); + property Info: TConsoleCursorInfo read GetInfo write SetInfo; + public + 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 + constructor Create(const AScrBuf: TJclScreenBuffer); + procedure DoResize(const NewRect: TSmallRect; bAbsolute: Boolean = True); + public + 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; + protected + constructor Create(const AConsole: TJclConsole); + public + 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; + +implementation + +uses + {$IFDEF FPC} + WinSysUt, JwaWinNT, + {$ENDIF FPC} + {$IFDEF CLR} + System.Text, + {$ENDIF CLR} + Math, TypInfo, + JclFileUtils, JclResources; + +{$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; + +function CtrlHandler(CtrlType: DWORD): BOOL; {$IFNDEF CLR} stdcall; {$ENDIF ~CLR} +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; +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 } + {$IFDEF CLR} + { TODO : CLR TJclConsole.GetTitle } + SetLength(Result, High(Byte)); + Len := GetConsoleTitle(Result, Length(Result)); + Win32Check((0 < Len) and (Len < Length(Result))); + SetLength(Result, Len); + {$ELSE} + { 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); + {$ENDIF CLR} +end; + +procedure TJclConsole.SetTitle(const Value: string); +begin + {$IFDEF CLR} + Win32Check(SetConsoleTitle(Value)); + {$ELSE} + Win32Check(SetConsoleTitle(PChar(Value))); + {$ENDIF CLR} +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; + +{$IFNDEF CLR} +class function TJclConsole.IsConsole(const Module: HMODULE): Boolean; +begin + Result := False; + { TODO : Documentation of this solution } + with PImageDosHeader(Module)^ do + if e_magic = IMAGE_DOS_SIGNATURE then + with PImageNtHeaders(Integer(Module) + {$IFDEF FPC} e_lfanew {$ELSE} _lfanew {$ENDIF})^ do + if Signature = IMAGE_NT_SIGNATURE then + Result := OptionalHeader.Subsystem = IMAGE_SUBSYSTEM_WINDOWS_CUI; +end; + +class function TJclConsole.IsConsole(const FileName: TFileName): Boolean; +begin + with TJclFileMappingStream.Create(FileName) do + try + Result := IsConsole(HMODULE(Memory)); + finally + Free; + end; +end; +{$ENDIF ~CLR} + +class function TJclConsole.MouseButtonCount: DWORD; +begin + 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 := []; + 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; + {$IFDEF CLR} + Win32Check(WriteConsole(Handle, StringToByteArray(Text), Text.Length, Result, nil)); + {$ELSE} + Win32Check(WriteConsole(Handle, PChar(Text), Length(Text), Result, nil)); + {$ENDIF CLR} +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; + {$IFDEF CLR} + Result := Write(Text, X, Y, Attrs); + {$ELSE} + Result := Write(Text, X, Y, @Attrs[0]); + {$ENDIF CLR} + end + else + {$IFDEF CLR} + Win32Check(WriteConsoleOutputCharacter(Handle, Text, Length(Text), Pos, Result)); + {$ELSE} + Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result)); + {$ENDIF CLR} + end + else + Result := 0; +end; + +{$IFDEF CLR} +function TJclScreenBuffer.Write(const Text: string; const X, Y: Smallint; + Attrs: array of Word): 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; + if Length(Attrs) > 0 then + Win32Check(WriteConsoleOutputAttribute(Handle, Attrs, Length(Text), Pos, Result)); + Win32Check(WriteConsoleOutputCharacter(Handle, Text, Length(Text), Pos, Result)); +end; +{$ELSE} +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; + if pAttrs <> nil then + Win32Check(WriteConsoleOutputAttribute(Handle, pAttrs, Length(Text), Pos, Result)); + Win32Check(WriteConsoleOutputCharacter(Handle, PChar(Text), Length(Text), Pos, Result)); +end; +{$ENDIF CLR} + +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; + {$IFDEF CLR} + Data: array of Byte; + {$ENDIF CLR} +begin + SetLength(Result, Count); + {$IFDEF CLR} + SetLength(Data, Count); + Win32Check(ReadConsole(Handle, Data, Count, ReadCount, nil)); + Result := ByteArrayToString(Data, Min(ReadCount, ByteArrayStringLen(Data))); + {$ELSE} + Win32Check(ReadConsole(Handle, PChar(Result), Count, ReadCount, nil)); + SetLength(Result, Min(ReadCount, StrLen(PChar(Result)))); + {$ENDIF CLR} +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; + {$IFDEF CLR} + sb: System.Text.StringBuilder; + {$ENDIF CLR} +begin + ReadPos.X := X; + ReadPos.Y := Y; + SetLength(Result, Count); + {$IFDEF CLR} + sb := System.Text.StringBuilder.Create(Count); + Win32Check(ReadConsoleOutputCharacter(Handle, sb, Count, ReadPos, ReadCount)); + Result := sb.ToString(); + {$ELSE} + Win32Check(ReadConsoleOutputCharacter(Handle, PChar(Result), Count, ReadPos, ReadCount)); + SetLength(Result, Min(ReadCount, StrLen(PChar(Result)))); + {$ENDIF CLR} +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); + 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 := FCharInfo.AsciiChar; +end; + +procedure TJclScreenCharacter.SetCharacter(const Value: Char); +begin + FCharInfo.AsciiChar := 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 + 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 := []; + 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 + {$IFDEF CLR} + raise EJclError.CreateFmt(RsCannotRaiseSignal, + [GetEnumName(TypeInfo(TJclInputCtrlEvent), Integer(AEvent))]); + {$ELSE} + raise EJclError.CreateResFmt(@RsCannotRaiseSignal, + [GetEnumName(TypeInfo(TJclInputCtrlEvent), Integer(AEvent))]); + {$ENDIF CLR} +end; + +function TJclInputBuffer.GetEventCount: DWORD; +begin + 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 + 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 + 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; + +// History: + +// $Log: JclConsole.pas,v $ +// Revision 1.18 2005/05/05 20:08:47 ahuser +// JCL.NET support +// +// Revision 1.17 2005/04/07 00:41:38 rrossmair +// - changed for FPC 1.9.8 +// +// Revision 1.16 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.15 2005/03/04 06:40:26 marquardt +// changed overloaded constructors to constructor with default parameter (BCB friendly) +// +// Revision 1.14 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.13 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.12 2004/10/17 21:00:14 mthoma +// cleaning +// +// Revision 1.11 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.10 2004/07/29 07:58:21 marquardt +// inc files updated +// +// Revision 1.9 2004/05/13 04:23:21 rrossmair +// fixed TJclScreenWindow.InternalSetPosition; FPC-related changes +// +// Revision 1.8 2004/05/06 22:37:09 rrossmair +// contributor list updated +// +// Revision 1.7 2004/05/06 05:09:55 rrossmair +// Changes for FPC v1.9.4 compatibility +// +// Revision 1.6 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclDebug.pas b/official/1.96/source/windows/JclDebug.pas new file mode 100644 index 0000000..17e18f0 --- /dev/null +++ b/official/1.96/source/windows/JclDebug.pas @@ -0,0 +1,4090 @@ +{**************************************************************************************************} +{ } +{ 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 JclDebug.pas. } +{ } +{ The Initial Developers of the Original Code are Petr Vones and Marcel van Brakel. } +{ Portions created by these individuals are Copyright (C) of these individuals. } +{ All Rights Reserved. } +{ } +{ Contributor(s): } +{ Marcel van Brakel } +{ Flier Lu (flier) } +{ Florent Ouchet (outchy) +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ Various debugging support routines and classes. This includes: Diagnostics routines, Trace } +{ routines, Stack tracing and Source Locations a la the C/C++ __FILE__ and __LINE__ macros. } +{ } +{ Unit owner: Petr Vones } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/26 18:03:58 $ +// For history see end of file + +unit JclDebug; + +interface + +{$I jcl.inc} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, Contnrs, + JclBase, JclFileUtils, JclPeImage, JclSynch, JclTD32; + +// Diagnostics +procedure AssertKindOf(const ClassName: string; const Obj: TObject); overload; +procedure AssertKindOf(const ClassType: TClass; const Obj: TObject); overload; + +procedure Trace(const Msg: string); +procedure TraceFmt(const Fmt: string; const Args: array of const); +procedure TraceLoc(const Msg: string); +procedure TraceLocFmt(const Fmt: string; const Args: array of const); + +// Optimized functionality of JclSysInfo functions ModuleFromAddr and IsSystemModule +type + TJclModuleInfo = class(TObject) + private + FSize: Cardinal; + FEndAddr: Pointer; + FStartAddr: Pointer; + FSystemModule: Boolean; + public + property EndAddr: Pointer read FEndAddr; + property Size: Cardinal read FSize; + property StartAddr: Pointer read FStartAddr; + property SystemModule: Boolean read FSystemModule; + end; + + TJclModuleInfoList = class(TObjectList) + private + FDynamicBuild: Boolean; + FSystemModulesOnly: Boolean; + function GetItems(Index: Integer): TJclModuleInfo; + function GetModuleFromAddress(Addr: Pointer): TJclModuleInfo; + protected + procedure BuildModulesList; + function CreateItemForAddress(Addr: Pointer; SystemModule: Boolean): TJclModuleInfo; + public + constructor Create(ADynamicBuild, ASystemModulesOnly: Boolean); + function AddModule(Module: HMODULE; SystemModule: Boolean): Boolean; + function IsSystemModuleAddress(Addr: Pointer): Boolean; + function IsValidModuleAddress(Addr: Pointer): Boolean; + property DynamicBuild: Boolean read FDynamicBuild; + property Items[Index: Integer]: TJclModuleInfo read GetItems; + property ModuleFromAddress[Addr: Pointer]: TJclModuleInfo read GetModuleFromAddress; + end; + +function JclValidateModuleAddress(Addr: Pointer): Boolean; + +// MAP file abstract parser +type + PJclMapAddress = ^TJclMapAddress; + TJclMapAddress = packed record + Segment: Word; + Offset: Integer; + end; + + PJclMapString = PAnsiChar; + + TJclAbstractMapParser = class(TObject) + private + FLinkerBug: Boolean; + FLinkerBugUnitName: PJclMapString; + FStream: TJclFileMappingStream; + function GetLinkerBugUnitName: string; + protected + FLastUnitName: PJclMapString; + FLastUnitFileName: PJclMapString; + procedure ClassTableItem(const Address: TJclMapAddress; Len: Integer; SectionName, GroupName: PJclMapString); virtual; abstract; + procedure SegmentItem(const Address: TJclMapAddress; Len: Integer; GroupName, UnitName: PJclMapString); virtual; abstract; + procedure PublicsByNameItem(const Address: TJclMapAddress; Name: PJclMapString); virtual; abstract; + procedure PublicsByValueItem(const Address: TJclMapAddress; Name: PJclMapString); virtual; abstract; + procedure LineNumberUnitItem(UnitName, UnitFileName: PJclMapString); virtual; abstract; + procedure LineNumbersItem(LineNumber: Integer; const Address: TJclMapAddress); virtual; abstract; + public + constructor Create(const MapFileName: TFileName); virtual; + destructor Destroy; override; + procedure Parse; + class function MapStringToStr(MapString: PJclMapString): string; + class function MapStringToFileName(MapString: PJclMapString): string; + property LinkerBug: Boolean read FLinkerBug; + property LinkerBugUnitName: string read GetLinkerBugUnitName; + property Stream: TJclFileMappingStream read FStream; + end; + + // MAP file parser + TJclMapClassTableEvent = procedure(Sender: TObject; const Address: TJclMapAddress; Len: Integer; const SectionName, GroupName: string) of object; + TJclMapSegmentEvent = procedure(Sender: TObject; const Address: TJclMapAddress; Len: Integer; const GroupName, UnitName: string) of object; + TJclMapPublicsEvent = procedure(Sender: TObject; const Address: TJclMapAddress; const Name: string) of object; + TJclMapLineNumberUnitEvent = procedure(Sender: TObject; const UnitName, UnitFileName: string) of object; + TJclMapLineNumbersEvent = procedure(Sender: TObject; LineNumber: Integer; const Address: TJclMapAddress) of object; + + TJclMapParser = class(TJclAbstractMapParser) + private + FOnClassTable: TJclMapClassTableEvent; + FOnLineNumbers: TJclMapLineNumbersEvent; + FOnLineNumberUnit: TJclMapLineNumberUnitEvent; + FOnPublicsByValue: TJclMapPublicsEvent; + FOnPublicsByName: TJclMapPublicsEvent; + FOnSegmentItem: TJclMapSegmentEvent; + protected + procedure ClassTableItem(const Address: TJclMapAddress; Len: Integer; SectionName, GroupName: PJclMapString); override; + procedure SegmentItem(const Address: TJclMapAddress; Len: Integer; GroupName, UnitName: PJclMapString); override; + procedure PublicsByNameItem(const Address: TJclMapAddress; Name: PJclMapString); override; + procedure PublicsByValueItem(const Address: TJclMapAddress; Name: PJclMapString); override; + procedure LineNumberUnitItem(UnitName, UnitFileName: PJclMapString); override; + procedure LineNumbersItem(LineNumber: Integer; const Address: TJclMapAddress); override; + public + property OnClassTable: TJclMapClassTableEvent read FOnClassTable write FOnClassTable; + property OnSegment: TJclMapSegmentEvent read FOnSegmentItem write FOnSegmentItem; + property OnPublicsByName: TJclMapPublicsEvent read FOnPublicsByName write FOnPublicsByName; + property OnPublicsByValue: TJclMapPublicsEvent read FOnPublicsByValue write FOnPublicsByValue; + property OnLineNumberUnit: TJclMapLineNumberUnitEvent read FOnLineNumberUnit write FOnLineNumberUnit; + property OnLineNumbers: TJclMapLineNumbersEvent read FOnLineNumbers write FOnLineNumbers; + end; + + // MAP file scanner + PJclMapSegment = ^TJclMapSegment; + TJclMapSegment = record + StartAddr: DWORD; + EndAddr: DWORD; + UnitName: PJclMapString; + end; + + PJclMapProcName = ^TJclMapProcName; + TJclMapProcName = record + Addr: DWORD; + ProcName: PJclMapString; + end; + + PJclMapLineNumber = ^TJclMapLineNumber; + TJclMapLineNumber = record + Addr: DWORD; + LineNumber: Integer; + end; + + TJclMapScanner = class(TJclAbstractMapParser) + private + FLineNumbers: array of TJclMapLineNumber; + FProcNames: array of TJclMapProcName; + FSegments: array of TJclMapSegment; + FSourceNames: array of TJclMapProcName; + FLastValidAddr: TJclMapAddress; + FLineNumbersCnt: Integer; + FLineNumberErrors: Integer; + FNewUnitFileName: PJclMapString; + FProcNamesCnt: Integer; + FTopValidAddr: Integer; + protected + procedure ClassTableItem(const Address: TJclMapAddress; Len: Integer; SectionName, GroupName: PJclMapString); override; + procedure SegmentItem(const Address: TJclMapAddress; Len: Integer; GroupName, UnitName: PJclMapString); override; + procedure PublicsByNameItem(const Address: TJclMapAddress; Name: PJclMapString); override; + procedure PublicsByValueItem(const Address: TJclMapAddress; Name: PJclMapString); override; + procedure LineNumbersItem(LineNumber: Integer; const Address: TJclMapAddress); override; + procedure LineNumberUnitItem(UnitName, UnitFileName: PJclMapString); override; + procedure Scan; + public + constructor Create(const MapFileName: TFileName); override; + function LineNumberFromAddr(Addr: DWORD): Integer; overload; + function LineNumberFromAddr(Addr: DWORD; var Offset: Integer): Integer; overload; + function ModuleNameFromAddr(Addr: DWORD): string; + function ModuleStartFromAddr(Addr: DWORD): DWORD; + function ProcNameFromAddr(Addr: DWORD): string; overload; + function ProcNameFromAddr(Addr: DWORD; var Offset: Integer): string; overload; + function SourceNameFromAddr(Addr: DWORD): string; + property LineNumberErrors: Integer read FLineNumberErrors; + end; + +// JCL binary debug data generator and scanner +const + JclDbgDataSignature = $4742444A; // JDBG + JclDbgDataResName = 'JCLDEBUG'; + JclDbgFileExtension = '.jdbg'; + + JclDbgHeaderVersion = 1; // JCL 1.11 and 1.20 + + MapFileExtension = '.map'; + DrcFileExtension = '.drc'; + +type + PJclDbgHeader = ^TJclDbgHeader; + TJclDbgHeader = packed record + Signature: DWORD; + Version: Byte; + Units: Integer; + SourceNames: Integer; + Symbols: Integer; + LineNumbers: Integer; + Words: Integer; + ModuleName: Integer; + CheckSum: Integer; + CheckSumValid: Boolean; + end; + + TJclBinDebugGenerator = class(TJclMapScanner) + private + FDataStream: TMemoryStream; + FMapFileName: TFileName; + protected + procedure CreateData; + public + constructor Create(const MapFileName: TFileName); override; + destructor Destroy; override; + function CalculateCheckSum: Boolean; + property DataStream: TMemoryStream read FDataStream; + end; + + TJclBinDbgNameCache = record + Addr: DWORD; + FirstWord: Integer; + SecondWord: Integer; + end; + + TJclBinDebugScanner = class(TObject) + private + FCacheData: Boolean; + FStream: TCustomMemoryStream; + FValidFormat: Boolean; + FLineNumbers: array of TJclMapLineNumber; + FProcNames: array of TJclBinDbgNameCache; + function GetModuleName: string; + protected + procedure CacheLineNumbers; + procedure CacheProcNames; + procedure CheckFormat; + function DataToStr(A: Integer): string; + function MakePtr(A: Integer): Pointer; + function ReadValue(var P: Pointer; var Value: Integer): Boolean; + public + constructor Create(AStream: TCustomMemoryStream; CacheData: Boolean); + function IsModuleNameValid(const Name: TFileName): Boolean; + function LineNumberFromAddr(Addr: DWORD): Integer; overload; + function LineNumberFromAddr(Addr: DWORD; var Offset: Integer): Integer; overload; + function ProcNameFromAddr(Addr: DWORD): string; overload; + function ProcNameFromAddr(Addr: DWORD; var Offset: Integer): string; overload; + function ModuleNameFromAddr(Addr: DWORD): string; + function ModuleStartFromAddr(Addr: DWORD): DWORD; + function SourceNameFromAddr(Addr: DWORD): string; + property ModuleName: string read GetModuleName; + property ValidFormat: Boolean read FValidFormat; + end; + +function ConvertMapFileToJdbgFile(const MapFileName: TFileName): Boolean; overload; +function ConvertMapFileToJdbgFile(const MapFileName: TFileName; var LinkerBugUnit: string; + var LineNumberErrors: Integer): Boolean; overload; + +// do not change this function, it is used by the JVCL installer using dynamic +// linking (to avoid dependencies in the installer), the signature and name are +// sensible +// AnsiString and String types cannot be used because they are managed in +// memory, the memory manager of the JVCL installer is different of the memory +// manager used by the JCL package; only pointers and direct values are acceptable +function InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName: PChar; + var MapFileSize, JclDebugDataSize: Integer): Boolean; overload; + +function InsertDebugDataIntoExecutableFile(const ExecutableFileName, + MapFileName: TFileName; var LinkerBugUnit: string; + var MapFileSize, JclDebugDataSize: Integer): Boolean; overload; +function InsertDebugDataIntoExecutableFile(const ExecutableFileName, + MapFileName: TFileName; var LinkerBugUnit: string; + var MapFileSize, JclDebugDataSize, LineNumberErrors: Integer): Boolean; overload; + +function InsertDebugDataIntoExecutableFile(const ExecutableFileName: TFileName; + BinDebug: TJclBinDebugGenerator; var LinkerBugUnit: string; + var MapFileSize, JclDebugDataSize: Integer): Boolean; overload; +function InsertDebugDataIntoExecutableFile(const ExecutableFileName: TFileName; + BinDebug: TJclBinDebugGenerator; var LinkerBugUnit: string; + var MapFileSize, JclDebugDataSize, LineNumberErrors: Integer): Boolean; overload; + +// Source Locations +type + TJclDebugInfoSource = class; + + PJclLocationInfo = ^TJclLocationInfo; + TJclLocationInfo = record + Address: Pointer; // Error address + UnitName: string; // Name of Delphi unit + ProcedureName: string; // Procedure name + OffsetFromProcName: Integer; // Offset from Address to ProcedureName symbol location + LineNumber: Integer; // Line number + OffsetFromLineNumber: Integer; // Offset from Address to LineNumber symbol location + SourceName: string; // Module file name + DebugInfo: TJclDebugInfoSource; // Location object + end; + + TJclDebugInfoSource = class(TObject) + private + FModule: HMODULE; + function GetFileName: TFileName; + protected + function InitializeSource: Boolean; virtual; abstract; + function VAFromAddr(const Addr: Pointer): DWORD; virtual; + public + constructor Create(AModule: HMODULE); virtual; + function GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; virtual; abstract; + property Module: HMODULE read FModule; + property FileName: TFileName read GetFileName; + end; + + TJclDebugInfoSourceClass = class of TJclDebugInfoSource; + + TJclDebugInfoList = class(TObjectList) + private + function GetItemFromModule(const Module: HMODULE): TJclDebugInfoSource; + function GetItems(Index: Integer): TJclDebugInfoSource; + protected + function CreateDebugInfo(const Module: HMODULE): TJclDebugInfoSource; + public + function GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; + property ItemFromModule[const Module: HMODULE]: TJclDebugInfoSource read GetItemFromModule; + property Items[Index: Integer]: TJclDebugInfoSource read GetItems; + end; + + // Various source location implementations + TJclDebugInfoMap = class(TJclDebugInfoSource) + private + FScanner: TJclMapScanner; + protected + function InitializeSource: Boolean; override; + public + destructor Destroy; override; + function GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; override; + end; + + TJclDebugInfoBinary = class(TJclDebugInfoSource) + private + FScanner: TJclBinDebugScanner; + FStream: TCustomMemoryStream; + protected + function InitializeSource: Boolean; override; + public + destructor Destroy; override; + function GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; override; + end; + + TJclDebugInfoExports = class(TJclDebugInfoSource) + private + FBorImage: TJclPeBorImage; + protected + function InitializeSource: Boolean; override; + public + destructor Destroy; override; + function GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; override; + end; + + TJclDebugInfoTD32 = class(TJclDebugInfoSource) + private + FImage: TJclPeBorTD32Image; + protected + function InitializeSource: Boolean; override; + public + destructor Destroy; override; + function GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; override; + end; + +// Source location functions +function Caller(Level: Integer = 0; FastStackWalk: Boolean = False): Pointer; + +function GetLocationInfo(const Addr: Pointer): TJclLocationInfo; overload; +function GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; overload; +function GetLocationInfoStr(const Addr: Pointer; IncludeModuleName: Boolean = False; + IncludeAddressOffset: Boolean = False; IncludeStartProcLineOffset: Boolean = False; + IncludeVAdress: Boolean = False): string; +function DebugInfoAvailable(const Module: HMODULE): Boolean; +procedure ClearLocationData; + +function FileByLevel(const Level: Integer = 0): string; +function ModuleByLevel(const Level: Integer = 0): string; +function ProcByLevel(const Level: Integer = 0): string; +function LineByLevel(const Level: Integer = 0): Integer; +function MapByLevel(const Level: Integer; var File_, Module_, Proc_: string; var Line_: Integer): Boolean; + +function FileOfAddr(const Addr: Pointer): string; +function ModuleOfAddr(const Addr: Pointer): string; +function ProcOfAddr(const Addr: Pointer): string; +function LineOfAddr(const Addr: Pointer): Integer; +function MapOfAddr(const Addr: Pointer; var File_, Module_, Proc_: string; var Line_: Integer): Boolean; + +function ExtractClassName(const ProcedureName: string): string; +function ExtractMethodName(const ProcedureName: string): string; + +// Original function names, deprecated will be removed in V2.0; do not use! + +function __FILE__(const Level: Integer = 0): string; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function __MODULE__(const Level: Integer = 0): string; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function __PROC__(const Level: Integer = 0): string; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function __LINE__(const Level: Integer = 0): Integer; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function __MAP__(const Level: Integer; var _File, _Module, _Proc: string; var _Line: Integer): Boolean; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function __FILE_OF_ADDR__(const Addr: Pointer): string; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function __MODULE_OF_ADDR__(const Addr: Pointer): string; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function __PROC_OF_ADDR__(const Addr: Pointer): string; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function __LINE_OF_ADDR__(const Addr: Pointer): Integer; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} +function __MAP_OF_ADDR__(const Addr: Pointer; var _File, _Module, _Proc: string; + var _Line: Integer): Boolean; {$IFDEF SUPPORTS_DEPRECATED} deprecated; {$ENDIF} + +// Stack info routines base list +type + TJclStackBaseList = class(TObjectList) + private + FThreadID: DWORD; + FTimeStamp: TDateTime; + public + constructor Create; + property ThreadID: DWORD read FThreadID; + property TimeStamp: TDateTime read FTimeStamp; + end; + +// Stack info routines +type + PDWORDArray = ^TDWORDArray; + TDWORDArray = array [0..(MaxInt - $F) div SizeOf(DWORD)] of DWORD; + + PStackFrame = ^TStackFrame; + TStackFrame = record + CallersEBP: DWORD; + CallerAdr: DWORD; + end; + + PStackInfo = ^TStackInfo; + TStackInfo = record + CallerAdr: DWORD; + Level: DWORD; + CallersEBP: DWORD; + DumpSize: DWORD; + ParamSize: DWORD; + ParamPtr: PDWORDArray; + case Integer of + 0: + (StackFrame: PStackFrame); + 1: + (DumpPtr: PJclByteArray); + end; + + TJclStackInfoItem = class(TObject) + private + FStackInfo: TStackInfo; + function GetCallerAdr: Pointer; + function GetLogicalAddress: DWORD; + public + property CallerAdr: Pointer read GetCallerAdr; + property LogicalAddress: DWORD read GetLogicalAddress; + property StackInfo: TStackInfo read FStackInfo; + end; + + TJclStackInfoList = class(TJclStackBaseList) + private + FIgnoreLevels: DWORD; + TopOfStack: Cardinal; + BaseOfStack: Cardinal; + FModuleInfoList: TJclModuleInfoList; + function GetItems(Index: Integer): TJclStackInfoItem; + function NextStackFrame(var StackFrame: PStackFrame; var StackInfo: TStackInfo): Boolean; + procedure StoreToList(const StackInfo: TStackInfo); + procedure TraceStackFrames; + procedure TraceStackRaw; + function ValidCallSite(CodeAddr: DWORD; var CallInstructionSize: Cardinal): Boolean; + function ValidStackAddr(StackAddr: DWORD): Boolean; + public + constructor Create(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer); + destructor Destroy; override; + procedure AddToStrings(Strings: TStrings; IncludeModuleName: Boolean = False; + IncludeAddressOffset: Boolean = False; IncludeStartProcLineOffset: Boolean = False; + IncludeVAdress: Boolean = False); + property Items[Index: Integer]: TJclStackInfoItem read GetItems; default; + property IgnoreLevels: DWORD read FIgnoreLevels; + end; + +function JclCreateStackList(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer): TJclStackInfoList; + +function JclLastExceptStackList: TJclStackInfoList; +function JclLastExceptStackListToStrings(Strings: TStrings; IncludeModuleName: Boolean = False; + IncludeAddressOffset: Boolean = False; IncludeStartProcLineOffset: Boolean = False; + IncludeVAdress: Boolean = False): Boolean; + +// Exception frame info routines +type + PJmpInstruction = ^TJmpInstruction; + TJmpInstruction = packed record // from System.pas + OpCode: Byte; + Distance: Longint; + end; + + TExcDescEntry = record // from System.pas + VTable: Pointer; + Handler: Pointer; + end; + + PExcDesc = ^TExcDesc; + TExcDesc = packed record // from System.pas + JMP: TJmpInstruction; + case Integer of + 0: + (Instructions: array [0..0] of Byte); + 1: + (Cnt: Integer; + ExcTab: array [0..0] of TExcDescEntry); + end; + + PExcFrame = ^TExcFrame; + TExcFrame = record // from System.pas + Next: PExcFrame; + Desc: PExcDesc; + HEBP: Pointer; + case Integer of + 0: + (); + 1: + (ConstructedObject: Pointer); + 2: + (SelfOfMethod: Pointer); + end; + + PJmpTable = ^TJmpTable; + TJmpTable = packed record + OPCode: Word; // FF 25 = JMP DWORD PTR [$xxxxxxxx], encoded as $25FF + Ptr: Pointer; + end; + + TExceptFrameKind = + (efkUnknown, efkFinally, efkAnyException, efkOnException, efkAutoException); + + TJclExceptFrame = class(TObject) + private + FExcFrame: PExcFrame; + FFrameKind: TExceptFrameKind; + protected + procedure DoDetermineFrameKind; + public + constructor Create(AExcFrame: PExcFrame); + function Handles(ExceptObj: TObject): Boolean; + function HandlerInfo(ExceptObj: TObject; var HandlerAt: Pointer): Boolean; + function CodeLocation: Pointer; + property ExcFrame: PExcFrame read FExcFrame; + property FrameKind: TExceptFrameKind read FFrameKind; + end; + + TJclExceptFrameList = class(TJclStackBaseList) + private + FIgnoreLevels: Integer; + function GetItems(Index: Integer): TJclExceptFrame; + protected + function AddFrame(AFrame: PExcFrame): TJclExceptFrame; + public + constructor Create(AIgnoreLevels: Integer); + procedure TraceExceptionFrames; + property Items[Index: Integer]: TJclExceptFrame read GetItems; + property IgnoreLevels: Integer read FIgnoreLevels write FIgnoreLevels; + end; + +function JclCreateExceptFrameList(AIgnoreLevels: Integer): TJclExceptFrameList; +function JclLastExceptFrameList: TJclExceptFrameList; + +// Global exceptional stack tracker enable routines and variables +type + TJclStackTrackingOption = + (stStack, stExceptFrame, stRawMode, stAllModules, stStaticModuleList); + TJclStackTrackingOptions = set of TJclStackTrackingOption; + +var + JclStackTrackingOptions: TJclStackTrackingOptions = [stStack]; + +function JclStartExceptionTracking: Boolean; +function JclStopExceptionTracking: Boolean; +function JclExceptionTrackingActive: Boolean; + +function JclTrackExceptionsFromLibraries: Boolean; + +// Thread exception tracking support +type + TJclDebugThread = class(TThread) + private + FSyncException: Exception; + FThreadName: string; + procedure DoHandleException; + function GetThreadInfo: string; + protected + procedure DoNotify; + procedure DoSyncHandleException; dynamic; + procedure HandleException; + public + constructor Create(Suspended: Boolean; const AThreadName: string = ''); + destructor Destroy; override; + property SyncException: Exception read FSyncException; + property ThreadInfo: string read GetThreadInfo; + property ThreadName: string read FThreadName; + end; + + TJclDebugThreadNotifyEvent = procedure(Thread: TJclDebugThread) of object; + TJclThreadIDNotifyEvent = procedure(ThreadID: DWORD) of object; + + TJclDebugThreadList = class(TObject) + private + FList: TStringList; + FLock: TJclCriticalSection; + FReadLock: TJclCriticalSection; + FRegSyncThreadID: DWORD; + FUnregSyncThreadID: DWORD; + FOnSyncException: TJclDebugThreadNotifyEvent; + FOnThreadRegistered: TJclThreadIDNotifyEvent; + FOnThreadUnregistered: TJclThreadIDNotifyEvent; + function GetThreadClassNames(ThreadID: DWORD): string; + function GetThreadInfos(ThreadID: DWORD): string; + function GetThreadNames(ThreadID: DWORD): string; + procedure DoSyncThreadRegistered; + procedure DoSyncThreadUnregistered; + function GetThreadIDs(Index: Integer): DWORD; + function GetThreadIDCount: Integer; + function GetThreadValues(ThreadID: DWORD; Index: Integer): string; + protected + procedure DoSyncException(Thread: TJclDebugThread); + procedure DoThreadRegistered(Thread: TThread); + procedure DoThreadUnregistered(Thread: TThread); + procedure InternalRegisterThread(Thread: TThread; const ThreadName: string); + procedure InternalUnregisterThread(Thread: TThread); + public + constructor Create; + destructor Destroy; override; + procedure RegisterThread(Thread: TThread; const ThreadName: string); + procedure UnregisterThread(Thread: TThread); + property Lock: TJclCriticalSection read FLock; + //property ThreadClassNames[ThreadID: DWORD]: string index 1 read GetThreadValues; + property ThreadClassNames[ThreadID: DWORD]: string read GetThreadClassNames; + property ThreadIDs[Index: Integer]: DWORD read GetThreadIDs; + property ThreadIDCount: Integer read GetThreadIDCount; + //property ThreadInfos[ThreadID: DWORD]: string index 2 read GetThreadValues; + property ThreadInfos[ThreadID: DWORD]: string read GetThreadInfos; + //property ThreadNames[ThreadID: DWORD]: string index 0 read GetThreadValues; + property ThreadNames[ThreadID: DWORD]: string read GetThreadNames; + property OnSyncException: TJclDebugThreadNotifyEvent read FOnSyncException write FOnSyncException; + property OnThreadRegistered: TJclThreadIDNotifyEvent read FOnThreadRegistered write FOnThreadRegistered; + property OnThreadUnregistered: TJclThreadIDNotifyEvent read FOnThreadUnregistered write FOnThreadUnregistered; + end; + +function JclDebugThreadList: TJclDebugThreadList; + +// Miscellanuous +{$IFDEF MSWINDOWS} +function EnableCrashOnCtrlScroll(const Enable: Boolean): Boolean; +function IsDebuggerAttached: Boolean; +function IsHandleValid(Handle: THandle): Boolean; +{$ENDIF MSWINDOWS} + +{$IFDEF SUPPORTS_EXTSYM} +{$EXTERNALSYM __FILE__} +{$EXTERNALSYM __LINE__} +{$ENDIF SUPPORTS_EXTSYM} + +implementation + +uses + {$IFDEF MSWINDOWS} + JclRegistry, + {$ENDIF MSWINDOWS} + JclHookExcept, JclLogic, JclStrings, JclSysInfo, JclSysUtils; + +//=== Helper assembler routines ============================================== + +const + ModuleCodeOffset = $1000; + +{$STACKFRAMES OFF} + +function GetEBP: Pointer; +asm + MOV EAX, EBP +end; + +function GetESP: Pointer; +asm + MOV EAX, ESP +end; + +function GetFS: Pointer; +asm + XOR EAX, EAX + MOV EAX, FS:[EAX] +end; + +// Reference: Matt Pietrek, MSJ, Under the hood, on TIBs: +// http://www.microsoft.com/MSJ/archive/S2CE.HTM + +function GetStackTop: DWORD; +asm + MOV EAX, FS:[4] +end; + +{$IFDEF STACKFRAMES_ON} +{$STACKFRAMES ON} +{$ENDIF STACKFRAMES_ON} + +//=== Diagnostics =========================================================== + +procedure AssertKindOf(const ClassName: string; const Obj: TObject); +var + C: TClass; +begin + if not Obj.ClassNameIs(ClassName) then + begin + C := Obj.ClassParent; + while (C <> nil) and (not C.ClassNameIs(ClassName)) do + C := C.ClassParent; + Assert(C <> nil); + end; +end; + +procedure AssertKindOf(const ClassType: TClass; const Obj: TObject); +begin + Assert(Obj.InheritsFrom(ClassType)); +end; + +procedure Trace(const Msg: string); +begin + OutputDebugString(PChar(StrDoubleQuote(Msg))); +end; + +procedure TraceFmt(const Fmt: string; const Args: array of const); +begin + OutputDebugString(PChar(Format(StrDoubleQuote(Fmt), Args))); +end; + +procedure TraceLoc(const Msg: string); +begin + OutputDebugString(PChar(Format('%s:%u (%s) "%s"', + [FileByLevel(1), LineByLevel(1), ProcByLevel(1), Msg]))); +end; + +procedure TraceLocFmt(const Fmt: string; const Args: array of const); +var + S: string; +begin + S := Format('%s:%u (%s) ', [FileByLevel(1), LineByLevel(1), ProcByLevel(1)]) + + Format(StrDoubleQuote(Fmt), Args); + OutputDebugString(PChar(S)); +end; + +//=== { TJclModuleInfoList } ================================================= + +constructor TJclModuleInfoList.Create(ADynamicBuild, ASystemModulesOnly: Boolean); +begin + inherited Create(True); + FDynamicBuild := ADynamicBuild; + FSystemModulesOnly := ASystemModulesOnly; + if not FDynamicBuild then + BuildModulesList; +end; + +function TJclModuleInfoList.AddModule(Module: HMODULE; SystemModule: Boolean): Boolean; +begin + Result := not IsValidModuleAddress(Pointer(Module)) and + (CreateItemForAddress(Pointer(Module), SystemModule) <> nil); +end; + +procedure TJclModuleInfoList.BuildModulesList; +var + List: TStringList; + I: Integer; + CurModule: PLibModule; +begin + if FSystemModulesOnly then + begin + CurModule := LibModuleList; + while CurModule <> nil do + begin + CreateItemForAddress(Pointer(CurModule.Instance), True); + CurModule := CurModule.Next; + end; + end + else + begin + List := TStringList.Create; + try + LoadedModulesList(List, GetCurrentProcessId, True); + for I := 0 to List.Count - 1 do + CreateItemForAddress(List.Objects[I], False); + finally + List.Free; + end; + end; +end; + +function TJclModuleInfoList.CreateItemForAddress(Addr: Pointer; SystemModule: Boolean): TJclModuleInfo; +var + Module: HMODULE; + NtHeaders: PImageNtHeaders; +begin + Result := nil; + Module := ModuleFromAddr(Addr); + if Module > 0 then + begin + NtHeaders := PeMapImgNtHeaders(Pointer(Module)); + if NtHeaders <> nil then + begin + Result := TJclModuleInfo.Create; + Result.FStartAddr := Pointer(Module); + Result.FSize := NtHeaders^.OptionalHeader.SizeOfImage; + Result.FEndAddr := Pointer(Module + Result.FSize - 1); + if SystemModule then + Result.FSystemModule := True + else + Result.FSystemModule := IsSystemModule(Module); + end; + end; + if Result <> nil then + Add(Result); +end; + +function TJclModuleInfoList.GetItems(Index: Integer): TJclModuleInfo; +begin + Result := TJclModuleInfo(Get(Index)); +end; + +function TJclModuleInfoList.GetModuleFromAddress(Addr: Pointer): TJclModuleInfo; +var + I: Integer; + Item: TJclModuleInfo; +begin + Result := nil; + for I := 0 to Count - 1 do + begin + Item := Items[I]; + if (Cardinal(Item.StartAddr) <= Cardinal(Addr)) and (Cardinal(Item.EndAddr) > Cardinal(Addr)) then + begin + Result := Item; + Break; + end; + end; + if DynamicBuild and (Result = nil) then + Result := CreateItemForAddress(Addr, False); +end; + +function TJclModuleInfoList.IsSystemModuleAddress(Addr: Pointer): Boolean; +var + Item: TJclModuleInfo; +begin + Item := ModuleFromAddress[Addr]; + Result := (Item <> nil) and Item.SystemModule; +end; + +function TJclModuleInfoList.IsValidModuleAddress(Addr: Pointer): Boolean; +begin + Result := ModuleFromAddress[Addr] <> nil; +end; + +//=== { TJclAbstractMapParser } ============================================== + +constructor TJclAbstractMapParser.Create(const MapFileName: TFileName); +begin + if FileExists(MapFileName) then + FStream := TJclFileMappingStream.Create(MapFileName, fmOpenRead or fmShareDenyWrite); +end; + +destructor TJclAbstractMapParser.Destroy; +begin + FreeAndNil(FStream); + inherited Destroy; +end; + +function TJclAbstractMapParser.GetLinkerBugUnitName: string; +begin + Result := MapStringToStr(FLinkerBugUnitName); +end; + +class function TJclAbstractMapParser.MapStringToFileName( + MapString: PJclMapString): string; +var + PStart, PEnd, PExtension: PChar; +begin + if MapString = nil then + begin + Result := ''; + Exit; + end; + PEnd := MapString; + while not (PEnd^ in [AnsiCarriageReturn, '=']) do + Inc(PEnd); + if (PEnd^ = '=') then + begin + while not (PEnd^ = AnsiSpace) do + Dec(PEnd); + while ((PEnd-1)^ = AnsiSpace) do + Dec(PEnd); + end; + PExtension := PEnd; + while (not (PExtension^ in ['.', '|'])) and (PExtension >= MapString) do + Dec(PExtension); + if (PExtension^ = '.') then + PEnd := PExtension; + PExtension := PEnd; + while (not (PExtension^ in ['|','\'])) and (PExtension >= MapString) do + Dec(PExtension); + if (PExtension^ in ['|','\']) then + PStart := PExtension + 1 + else PStart := MapString; + SetString(Result, PStart, PEnd - PStart); +end; + +class function TJclAbstractMapParser.MapStringToStr(MapString: PJclMapString): string; +var + P: PChar; +begin + if MapString = nil then + begin + Result := ''; + Exit; + end; + if MapString^ = '(' then + begin + Inc(MapString); + P := MapString; + while not (P^ in [AnsiCarriageReturn, ')']) do + Inc(P); + end + else + begin + P := MapString; + while not (P^ in [AnsiSpace, AnsiCarriageReturn, '(']) do + Inc(P); + end; + SetString(Result, MapString, P - MapString); +end; + +procedure TJclAbstractMapParser.Parse; +const + TableHeader : array [0..3] of string = ('Start', 'Length', 'Name', 'Class'); + SegmentsHeader : array [0..3] of string = ('Detailed', 'map', 'of', 'segments'); + PublicsByNameHeader : array [0..3] of string = ('Address', 'Publics', 'by', 'Name'); + PublicsByValueHeader : array [0..3] of string = ('Address', 'Publics', 'by', 'Value'); + LineNumbersPrefix = 'Line numbers for'; + ResourceFilesHeader : array [0..2] of string = ('Bound', 'resource', 'files'); +var + CurrPos, EndPos: PChar; +{$IFNDEF COMPILER9_UP} + PreviousA, +{$ENDIF COMPILER9_UP} + A: TJclMapAddress; + L: Integer; + P1, P2: PJclMapString; + + procedure SkipWhiteSpace; + begin + while CurrPos^ in AnsiWhiteSpace do + Inc(CurrPos); + end; + + procedure SkipEndLine; + begin + while CurrPos^ <> AnsiLineFeed do + Inc(CurrPos); + SkipWhiteSpace; + end; + + function Eof: Boolean; + begin + Result := (CurrPos >= EndPos); + end; + + function IsDecDigit: Boolean; + begin + Result := CurrPos^ in AnsiDecDigits; + end; + + function ReadTextLine: string; + var + P: PChar; + begin + P := CurrPos; + while not (CurrPos^ in [AnsiCarriageReturn, AnsiNull]) do + Inc(CurrPos); + SetString(Result, P, CurrPos - P); + end; + + + function ReadDecValue: Integer; + begin + Result := 0; + while CurrPos^ in AnsiDecDigits do + begin + Result := Result * 10 + (Ord(CurrPos^) - Ord('0')); + Inc(CurrPos); + end; + end; + + {$OVERFLOWCHECKS OFF} + + function ReadHexValue: Integer; + var + C: Char; + begin + Result := 0; + repeat + C := CurrPos^; + case C of + '0'..'9': + begin + Result := Result * 16; + Inc(Result, Ord(C) - Ord('0')); + end; + 'A'..'F': + begin + Result := Result * 16; + Inc(Result, Ord(C) - Ord('A') + 10); + end; + 'a'..'f': + begin + Result := Result * 16; + Inc(Result, Ord(C) - Ord('a') + 10); + end; + 'H', 'h': + begin + Inc(CurrPos); + Break; + end; + else + Break; + end; + Inc(CurrPos); + until False; + end; + + {$IFDEF OVERFLOWCHECKS_ON} + {$OVERFLOWCHECKS ON} + {$ENDIF OVERFLOWCHECKS_ON} + + function ReadAddress: TJclMapAddress; + begin + Result.Segment := ReadHexValue; + if CurrPos^ = ':' then + begin + Inc(CurrPos); + Result.Offset := ReadHexValue; + end + else + Result.Offset := 0; + end; + + function ReadString: PJclMapString; + begin + SkipWhiteSpace; + Result := CurrPos; + while not (CurrPos^ in AnsiWhiteSpace) do + Inc(CurrPos); + end; + + procedure FindParam(Param: Char); + begin + while not ((CurrPos^ = Param) and ((CurrPos + 1)^ = '=')) do + Inc(CurrPos); + Inc(CurrPos, 2); + end; + + function SyncToHeader(const Header: array of string): Boolean; + var + S: string; + TokenIndex, OldPosition, CurrentPosition: Integer; + begin + Result := False; + while not Eof do + begin + S := Trim(ReadTextLine); + TokenIndex := Low(Header); + CurrentPosition := 0; + OldPosition := 0; + while (TokenIndex <= High(Header)) do + begin + CurrentPosition := Pos(Header[TokenIndex],S); + if (CurrentPosition <= OldPosition) then + begin + CurrentPosition := 0; + Break; + end; + OldPosition := CurrentPosition; + Inc(TokenIndex); + end; + Result := CurrentPosition <> 0; + if Result then + Break; + SkipEndLine; + end; + if not Eof then + SkipWhiteSpace; + end; + + function SyncToPrefix(const Prefix: string): Boolean; + var + I: Integer; + P: PChar; + S: string; + begin + if Eof then + begin + Result := False; + Exit; + end; + SkipWhiteSpace; + I := Length(Prefix); + P := CurrPos; + while not Eof and (not (P^ in [AnsiCarriageReturn, AnsiNull])) and (I > 0) do + begin + Inc(P); + Dec(I); + end; + SetString(S, CurrPos, Length(Prefix)); + Result := (S = Prefix); + if Result then + CurrPos := P; + SkipWhiteSpace; + end; + +begin + if FStream <> nil then + begin + FLinkerBug := False; +{$IFNDEF COMPILER9_UP} + PreviousA.Segment := 0; + PreviousA.Offset := 0; +{$ENDIF COMPILER9_UP} + CurrPos := FStream.Memory; + EndPos := CurrPos + FStream.Size; + if SyncToHeader(TableHeader) then + while IsDecDigit do + begin + A := ReadAddress; + SkipWhiteSpace; + L := ReadHexValue; + P1 := ReadString; + P2 := ReadString; + SkipEndLine; + ClassTableItem(A, L, P1, P2); + end; + if SyncToHeader(SegmentsHeader) then + while IsDecDigit do + begin + A := ReadAddress; + SkipWhiteSpace; + L := ReadHexValue; + FindParam('C'); + P1 := ReadString; + FindParam('M'); + P2 := ReadString; + SkipEndLine; + SegmentItem(A, L, P1, P2); + end; + if SyncToHeader(PublicsByNameHeader) then + while IsDecDigit do + begin + A := ReadAddress; + P1 := ReadString; + SkipWhiteSpace; + PublicsByNameItem(A, P1); + end; + if SyncToHeader(PublicsByValueHeader) then + while IsDecDigit do + begin + A := ReadAddress; + P1 := ReadString; + SkipWhiteSpace; + PublicsByValueItem(A, P1); + end; + while SyncToPrefix(LineNumbersPrefix) do + begin + FLastUnitName := CurrPos; + FLastUnitFileName := CurrPos; + while FLastUnitFileName^ <> '(' do + Inc(FLastUnitFileName); + SkipEndLine; + LineNumberUnitItem(FLastUnitName, FLastUnitFileName); + repeat + SkipWhiteSpace; + L := ReadDecValue; + SkipWhiteSpace; + A := ReadAddress; + SkipWhiteSpace; + LineNumbersItem(L, A); +{$IFNDEF COMPILER9_UP} + if (not FLinkerBug) and (A.Offset < PreviousA.Offset) then + begin + FLinkerBugUnitName := FLastUnitName; + FLinkerBug := True; + end; + PreviousA := A; +{$ENDIF COMPILER9_UP} + until not IsDecDigit; + end; + end; +end; + +//=== { TJclMapParser 0 ====================================================== + +procedure TJclMapParser.ClassTableItem(const Address: TJclMapAddress; + Len: Integer; SectionName, GroupName: PJclMapString); +begin + if Assigned(FOnClassTable) then + FOnClassTable(Self, Address, Len, MapStringToStr(SectionName), MapStringToStr(GroupName)); +end; + +procedure TJclMapParser.LineNumbersItem(LineNumber: Integer; const Address: TJclMapAddress); +begin + if Assigned(FOnLineNumbers) then + FOnLineNumbers(Self, LineNumber, Address); +end; + +procedure TJclMapParser.LineNumberUnitItem(UnitName, UnitFileName: PJclMapString); +begin + if Assigned(FOnLineNumberUnit) then + FOnLineNumberUnit(Self, MapStringToStr(UnitName), MapStringToStr(UnitFileName)); +end; + +procedure TJclMapParser.PublicsByNameItem(const Address: TJclMapAddress; + Name: PJclMapString); +begin + if Assigned(FOnPublicsByName) then + FOnPublicsByName(Self, Address, MapStringToStr(Name)); +end; + +procedure TJclMapParser.PublicsByValueItem(const Address: TJclMapAddress; + Name: PJclMapString); +begin + if Assigned(FOnPublicsByValue) then + FOnPublicsByValue(Self, Address, MapStringToStr(Name)); +end; + +procedure TJclMapParser.SegmentItem(const Address: TJclMapAddress; + Len: Integer; GroupName, UnitName: PJclMapString); +begin + if Assigned(FOnSegmentItem) then + FOnSegmentItem(Self, Address, Len, MapStringToStr(GroupName), MapStringToFileName(UnitName)); +end; + +//=== { TJclMapScanner } ===================================================== + +constructor TJclMapScanner.Create(const MapFileName: TFileName); +begin + inherited Create(MapFileName); + Scan; +end; + +procedure TJclMapScanner.ClassTableItem(const Address: TJclMapAddress; Len: Integer; + SectionName, GroupName: PJclMapString); +begin +end; + +function TJclMapScanner.LineNumberFromAddr(Addr: DWORD): Integer; +var + Dummy: Integer; +begin + Result := LineNumberFromAddr(Addr, Dummy); +end; + +function Search_MapLineNumber(Item1, Item2: Pointer): Integer; +begin + Result := Integer(PJclMapLineNumber(Item1)^.Addr) - PInteger(Item2)^; +end; + +function TJclMapScanner.LineNumberFromAddr(Addr: DWORD; var Offset: Integer): Integer; +var + I: Integer; + ModuleStartAddr: DWORD; +begin + ModuleStartAddr := ModuleStartFromAddr(Addr); + Result := 0; + Offset := 0; + I := SearchDynArray(FLineNumbers, SizeOf(FLineNumbers[0]), Search_MapLineNumber, @Addr, True); + if (I <> -1) and (FLineNumbers[I].Addr >= ModuleStartAddr) then + begin + Result := FLineNumbers[I].LineNumber; + Offset := Addr - FLineNumbers[I].Addr; + end; +end; + +procedure TJclMapScanner.LineNumbersItem(LineNumber: Integer; const Address: TJclMapAddress); +var + C: Integer; +begin + // Try to eliminate invalid line numbers caused by bug in the linker + if (FLastValidAddr.Offset = 0) or ((Address.Offset > 0) and (Address.Offset <= FTopValidAddr) and + (FLastValidAddr.Segment = Address.Segment) and (FLastValidAddr.Offset < Address.Offset)) then + begin + FLastValidAddr := Address; + if FLineNumbersCnt mod 256 = 0 then + SetLength(FLineNumbers, FLineNumbersCnt + 256); + FLineNumbers[FLineNumbersCnt].Addr := Address.Offset; + FLineNumbers[FLineNumbersCnt].LineNumber := LineNumber; + Inc(FLineNumbersCnt); + if FNewUnitFileName <> nil then + begin + C := Length(FSourceNames); + SetLength(FSourceNames, C + 1); + FSourceNames[C].Addr := Address.Offset; + FSourceNames[C].ProcName := FNewUnitFileName; + FNewUnitFileName := nil; + end; + end + else + Inc(FLineNumberErrors); +end; + +procedure TJclMapScanner.LineNumberUnitItem(UnitName, UnitFileName: PJclMapString); +begin + FNewUnitFileName := UnitFileName; +end; + +function TJclMapScanner.ModuleNameFromAddr(Addr: DWORD): string; +var + I: Integer; +begin + Result := ''; + for I := Length(FSegments) - 1 downto 0 do + if (FSegments[I].StartAddr <= Addr) and (FSegments[I].EndAddr >= Addr) then + begin + Result := MapStringToStr(FSegments[I].UnitName); + Break; + end; +end; + +function TJclMapScanner.ModuleStartFromAddr(Addr: DWORD): DWORD; +var + I: Integer; +begin + Result := DWORD(-1); + for I := Length(FSegments) - 1 downto 0 do + if (FSegments[I].StartAddr <= Addr) and (FSegments[I].EndAddr >= Addr) then + begin + Result := FSegments[I].StartAddr; + Break; + end; +end; + +function TJclMapScanner.ProcNameFromAddr(Addr: DWORD): string; +var + Dummy: Integer; +begin + Result := ProcNameFromAddr(Addr, Dummy); +end; + +function Search_MapProcName(Item1, Item2: Pointer): Integer; +begin + Result := Integer(PJclMapProcName(Item1)^.Addr) - PInteger(Item2)^; +end; + +function TJclMapScanner.ProcNameFromAddr(Addr: DWORD; var Offset: Integer): string; +var + I: Integer; + ModuleStartAddr: DWORD; +begin + ModuleStartAddr := ModuleStartFromAddr(Addr); + Result := ''; + Offset := 0; + I := SearchDynArray(FProcNames, SizeOf(FProcNames[0]), Search_MapProcName, @Addr, True); + if (I <> -1) and (FProcNames[I].Addr >= ModuleStartAddr) then + begin + Result := MapStringToStr(FProcNames[I].ProcName); + Offset := Addr - FProcNames[I].Addr; + end; +end; + +procedure TJclMapScanner.PublicsByNameItem(const Address: TJclMapAddress; Name: PJclMapString); +begin + { TODO : What to do? } +end; + +procedure TJclMapScanner.PublicsByValueItem(const Address: TJclMapAddress; Name: PJclMapString); +begin + if Address.Segment = 1 then + begin + if FProcNamesCnt mod 256 = 0 then + SetLength(FProcNames, FProcNamesCnt + 256); + FProcNames[FProcNamesCnt].Addr := Address.Offset; + FProcNames[FProcNamesCnt].ProcName := Name; + Inc(FProcNamesCnt); + end; +end; + +procedure TJclMapScanner.Scan; +begin + FLastValidAddr.Segment := 0; + FLastValidAddr.Offset := 0; + FTopValidAddr := 0; + FLineNumberErrors := 0; + Parse; + SetLength(FLineNumbers, FLineNumbersCnt); + SetLength(FProcNames, FProcNamesCnt); +end; + +procedure TJclMapScanner.SegmentItem(const Address: TJclMapAddress; Len: Integer; + GroupName, UnitName: PJclMapString); +var + C: Integer; +begin + if Address.Segment = 1 then + begin + C := Length(FSegments); + SetLength(FSegments, C + 1); + FSegments[C].StartAddr := Address.Offset; + FSegments[C].EndAddr := Address.Offset + Len; + FSegments[C].UnitName := UnitName; + FTopValidAddr := Max(FTopValidAddr, Address.Offset + Len); + end; +end; + +function TJclMapScanner.SourceNameFromAddr(Addr: DWORD): string; +var + I: Integer; + ModuleStartAddr: DWORD; +begin + ModuleStartAddr := ModuleStartFromAddr(Addr); + Result := ''; + I := SearchDynArray(FSourceNames, SizeOf(FSourceNames[0]), Search_MapProcName, @Addr, True); + if (I <> -1) and (FSourceNames[I].Addr >= ModuleStartAddr) then + Result := MapStringToStr(FSourceNames[I].ProcName); +end; + +// JCL binary debug format string encoding/decoding routines +{ Strings are compressed to following 6bit format (A..D represents characters) and terminated with } +{ 6bit #0 char. First char = #1 indicates non compressed text, #2 indicates compressed text with } +{ leading '@' character } +{ } +{ 7 6 5 4 3 2 1 0 | } +{--------------------------------- } +{ B1 B0 A5 A4 A3 A2 A1 A0 | Data byte 0 } +{--------------------------------- } +{ C3 C2 C1 C0 B5 B4 B3 B2 | Data byte 1 } +{--------------------------------- } +{ D5 D4 D3 D2 D1 D0 C5 C4 | Data byte 2 } +{--------------------------------- } + +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} + +function SimpleCryptString(const S: string): string; +var + I: Integer; + C: Byte; + P: PByte; +begin + SetLength(Result, Length(S)); + P := PByte(Result); + for I := 1 to Length(S) do + begin + C := Ord(S[I]); + if C <> $AA then + C := C xor $AA; + P^ := C; + Inc(P); + end; +end; + +function DecodeNameString(const S: PChar): string; +var + I, B: Integer; + C: Byte; + P: PByte; + Buffer: array [0..255] of Char; +begin + Result := ''; + B := 0; + P := PByte(S); + case P^ of + 1: + begin + Inc(P); + Result := SimpleCryptString(PChar(P)); + Exit; + end; + 2: + begin + Inc(P); + Buffer[B] := '@'; + Inc(B); + end; + end; + I := 0; + C := 0; + repeat + case I and $03 of + 0: + C := P^ and $3F; + 1: + begin + C := (P^ shr 6) and $03; + Inc(P); + Inc(C, (P^ and $0F) shl 2); + end; + 2: + begin + C := (P^ shr 4) and $0F; + Inc(P); + Inc(C, (P^ and $03) shl 4); + end; + 3: + begin + C := (P^ shr 2) and $3F; + Inc(P); + end; + end; + case C of + $00: + Break; + $01..$0A: + Inc(C, Ord('0') - $01); + $0B..$24: + Inc(C, Ord('A') - $0B); + $25..$3E: + Inc(C, Ord('a') - $25); + $3F: + C := Ord('_'); + end; + Buffer[B] := Chr(C); + Inc(B); + Inc(I); + until B >= SizeOf(Buffer) - 1; + Buffer[B] := AnsiNull; + Result := Buffer; +end; + +function EncodeNameString(const S: string): string; +var + I, StartIndex: Integer; + C: Byte; + P: PByte; +begin + if (Length(S) > 1) and (S[1] = '@') then + StartIndex := 1 + else + StartIndex := 0; + for I := StartIndex + 1 to Length(S) do + if not (S[I] in AnsiValidIdentifierLetters) then + begin + Result := #1 + SimpleCryptString(S) + #0; + Exit; + end; + SetLength(Result, Length(S) + StartIndex); + P := Pointer(Result); + if StartIndex = 1 then + P^ := 2 // store '@' leading char information + else + Dec(P); + for I := 0 to Length(S) - StartIndex do // including null char + begin + C := Byte(S[I + 1 + StartIndex]); + case Char(C) of + #0: + C := 0; + '0'..'9': + Dec(C, Ord('0') - $01); + 'A'..'Z': + Dec(C, Ord('A') - $0B); + 'a'..'z': + Dec(C, Ord('a') - $25); + '_': + C := $3F; + else + C := $3F; + end; + case I and $03 of + 0: + begin + Inc(P); + P^ := C; + end; + 1: + begin + P^ := P^ or (C and $03) shl 6; + Inc(P); + P^ := (C shr 2) and $0F; + end; + 2: + begin + P^ := P^ or (C shl 4); + Inc(P); + P^ := (C shr 4) and $03; + end; + 3: + P^ := P^ or (C shl 2); + end; + end; + SetLength(Result, DWORD(P) - DWORD(Pointer(Result)) + 1); +end; + +{$IFDEF RANGECHECKS_ON} +{$RANGECHECKS ON} +{$ENDIF RANGECHECKS_ON} + +{$IFDEF OVERFLOWCHECKS_ON} +{$OVERFLOWCHECKS ON} +{$ENDIF OVERFLOWCHECKS_ON} + +function ConvertMapFileToJdbgFile(const MapFileName: TFileName): Boolean; +var + Dummy1: string; + Dummy2: Integer; +begin + Result := ConvertMapFileToJdbgFile(MapFileName, Dummy1, Dummy2); +end; + +function ConvertMapFileToJdbgFile(const MapFileName: TFileName; var LinkerBugUnit: string; + var LineNumberErrors: Integer): Boolean; +var + JDbgFileName: TFileName; + Generator: TJclBinDebugGenerator; +begin + JDbgFileName := ChangeFileExt(MapFileName, JclDbgFileExtension); + Generator := TJclBinDebugGenerator.Create(MapFileName); + try + Result := (Generator.DataStream.Size > 0) and Generator.CalculateCheckSum; + if Result then + Generator.DataStream.SaveToFile(JDbgFileName); + LinkerBugUnit := Generator.LinkerBugUnitName; + LineNumberErrors := Generator.LineNumberErrors; + finally + Generator.Free; + end; +end; + +// do not change this function, it is used by the JVCL installer using dynamic +// linking (to avoid dependencies in the installer), the signature and name are +// sensible +function InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName: PChar; + var MapFileSize, JclDebugDataSize: Integer): Boolean; +var + LinkerBugUnit: string; +begin + LinkerBugUnit := ''; + Result := InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName, + LinkerBugUnit, MapFileSize, JclDebugDataSize); +end; + +function InsertDebugDataIntoExecutableFile(const ExecutableFileName, MapFileName: TFileName; + var LinkerBugUnit: string; var MapFileSize, JclDebugDataSize: Integer): Boolean; +var + Dummy: Integer; +begin + Result := InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName, LinkerBugUnit, + MapFileSize, JclDebugDataSize, Dummy); +end; + +function InsertDebugDataIntoExecutableFile(const ExecutableFileName, MapFileName: TFileName; + var LinkerBugUnit: string; var MapFileSize, JclDebugDataSize, LineNumberErrors: Integer): Boolean; +var + BinDebug: TJclBinDebugGenerator; +begin + BinDebug := TJclBinDebugGenerator.Create(MapFileName); + try + Result := InsertDebugDataIntoExecutableFile(ExecutableFileName, BinDebug, + LinkerBugUnit, MapFileSize, JclDebugDataSize, LineNumberErrors); + finally + BinDebug.Free; + end; +end; + +function InsertDebugDataIntoExecutableFile(const ExecutableFileName: TFileName; + BinDebug: TJclBinDebugGenerator; var LinkerBugUnit: string; + var MapFileSize, JclDebugDataSize: Integer): Boolean; +var + Dummy: Integer; +begin + Result := InsertDebugDataIntoExecutableFile(ExecutableFileName, BinDebug, LinkerBugUnit, + MapFileSize, JclDebugDataSize, Dummy); +end; + +function InsertDebugDataIntoExecutableFile(const ExecutableFileName: TFileName; + BinDebug: TJclBinDebugGenerator; var LinkerBugUnit: string; + var MapFileSize, JclDebugDataSize, LineNumberErrors: Integer): Boolean; +var + ImageStream: TMemoryStream; + NtHeaders: PImageNtHeaders; + Sections, LastSection, JclDebugSection: PImageSectionHeader; + VirtualAlignedSize: DWORD; + I, X, NeedFill: Integer; + + procedure RoundUpToAlignment(var Value: DWORD; Alignment: DWORD); + begin + if (Value mod Alignment) <> 0 then + Value := ((Value div Alignment) + 1) * Alignment; + end; + +begin + MapFileSize := 0; + JclDebugDataSize := 0; + LineNumberErrors := 0; + LinkerBugUnit := ''; + if BinDebug.Stream <> nil then + begin + Result := True; + if BinDebug.LinkerBug then + begin + LinkerBugUnit := BinDebug.LinkerBugUnitName; + LineNumberErrors := BinDebug.LineNumberErrors; + end; + end + else + Result := False; + if not Result then + Exit; + + ImageStream := TMemoryStream.Create; + try + try + ImageStream.LoadFromFile(ExecutableFileName); + MapFileSize := BinDebug.Stream.Size; + JclDebugDataSize := BinDebug.DataStream.Size; + NtHeaders := PeMapImgNtHeaders(ImageStream.Memory); + Assert(NtHeaders <> nil); + Sections := PeMapImgSections(NtHeaders); + Assert(Sections <> nil); + // Check whether there is not a section with the name already. If so, return True (#0000069) + if PeMapImgFindSection(NtHeaders, JclDbgDataResName) <> nil then + begin + Result := True; + Exit; + end; + + LastSection := Sections; + Inc(LastSection, NtHeaders^.FileHeader.NumberOfSections - 1); + JclDebugSection := LastSection; + Inc(JclDebugSection); + + // Increase the number of sections + Inc(NtHeaders^.FileHeader.NumberOfSections); + FillChar(JclDebugSection^, SizeOf(TImageSectionHeader), #0); + // JCLDEBUG Virtual Address + JclDebugSection^.VirtualAddress := LastSection^.VirtualAddress + LastSection^.Misc.VirtualSize; + RoundUpToAlignment(JclDebugSection^.VirtualAddress, NtHeaders^.OptionalHeader.SectionAlignment); + // JCLDEBUG Physical Offset + JclDebugSection^.PointerToRawData := LastSection^.PointerToRawData + LastSection^.SizeOfRawData; + RoundUpToAlignment(JclDebugSection^.PointerToRawData, NtHeaders^.OptionalHeader.FileAlignment); + // JCLDEBUG Section name + StrPLCopy(PChar(@JclDebugSection^.Name), JclDbgDataResName, IMAGE_SIZEOF_SHORT_NAME); + // JCLDEBUG Characteristics flags + JclDebugSection^.Characteristics := IMAGE_SCN_MEM_READ or IMAGE_SCN_CNT_INITIALIZED_DATA; + + // Size of virtual data area + JclDebugSection^.Misc.VirtualSize := JclDebugDataSize; + VirtualAlignedSize := JclDebugDataSize; + RoundUpToAlignment(VirtualAlignedSize, NtHeaders^.OptionalHeader.SectionAlignment); + // Update Size of Image + Inc(NtHeaders^.OptionalHeader.SizeOfImage, VirtualAlignedSize); + // Raw data size + JclDebugSection^.SizeOfRawData := JclDebugDataSize; + RoundUpToAlignment(JclDebugSection^.SizeOfRawData, NtHeaders^.OptionalHeader.FileAlignment); + // Update Initialized data size + Inc(NtHeaders^.OptionalHeader.SizeOfInitializedData, JclDebugSection^.SizeOfRawData); + + // Fill data to alignment + NeedFill := Integer(JclDebugSection^.SizeOfRawData) - JclDebugDataSize; + + // Note: Delphi linker seems to generate incorrect (unaligned) size of + // the executable when adding TD32 debug data so the position could be + // behind the size of the file then. + ImageStream.Seek(JclDebugSection^.PointerToRawData, soFromBeginning); + ImageStream.CopyFrom(BinDebug.DataStream, 0); + X := 0; + for I := 1 to NeedFill do + ImageStream.WriteBuffer(X, 1); + + ImageStream.SaveToFile(ExecutableFileName); + except + Result := False; + end; + finally + ImageStream.Free; + end; +end; + +//=== { TJclBinDebugGenerator } ============================================== + +constructor TJclBinDebugGenerator.Create(const MapFileName: TFileName); +begin + inherited Create(MapFileName); + FDataStream := TMemoryStream.Create; + FMapFileName := MapFileName; + if FStream <> nil then + CreateData; +end; + +destructor TJclBinDebugGenerator.Destroy; +begin + FreeAndNil(FDataStream); + inherited Destroy; +end; + +{$OVERFLOWCHECKS OFF} + +function TJclBinDebugGenerator.CalculateCheckSum: Boolean; +var + Header: PJclDbgHeader; + P, EndData: PChar; + CheckSum: Integer; +begin + Result := DataStream.Size >= SizeOf(TJclDbgHeader); + if Result then + begin + P := DataStream.Memory; + EndData := P + DataStream.Size; + Header := PJclDbgHeader(P); + CheckSum := 0; + Header^.CheckSum := 0; + Header^.CheckSumValid := True; + while P < EndData do + begin + Inc(CheckSum, PInteger(P)^); + Inc(PInteger(P)); + end; + Header^.CheckSum := CheckSum; + end; +end; + +{$IFDEF OVERFLOWCHECKS_ON} +{$OVERFLOWCHECKS ON} +{$ENDIF OVERFLOWCHECKS_ON} + +procedure TJclBinDebugGenerator.CreateData; +var + FileHeader: TJclDbgHeader; + WordList: TStringList; + WordStream: TMemoryStream; + I, D: Integer; + S: string; + L1, L2, L3: Integer; + FirstWord, SecondWord: Integer; + + function AddWord(const S: string): Integer; + var + N: Integer; + E: string; + begin + if S = '' then + begin + Result := 0; + Exit; + end; + N := WordList.IndexOf(S); + if N = -1 then + begin + Result := WordStream.Position; + E := EncodeNameString(S); + WordStream.WriteBuffer(Pointer(E)^, Length(E)); + WordList.AddObject(S, TObject(Result)); + end + else + Result := DWORD(WordList.Objects[N]); + Inc(Result); + end; + + procedure WriteValue(Value: Integer); + var + L: Integer; + D: DWORD; + P: array [1..5] of Byte; + begin + D := Value and $FFFFFFFF; + L := 0; + while D > $7F do + begin + Inc(L); + P[L] := (D and $7F) or $80; + D := D shr 7; + end; + Inc(L); + P[L] := (D and $7F); + FDataStream.WriteBuffer(P, L); + end; + + procedure WriteValueOfs(Value: Integer; var LastValue: Integer); + begin + WriteValue(Value - LastValue); + LastValue := Value; + end; + +begin + WordStream := TMemoryStream.Create; + WordList := TStringList.Create; + try + WordList.Sorted := True; + WordList.Duplicates := dupError; + + FileHeader.Signature := JclDbgDataSignature; + FileHeader.Version := JclDbgHeaderVersion; + FileHeader.CheckSum := 0; + FileHeader.CheckSumValid := False; + FileHeader.ModuleName := AddWord(PathExtractFileNameNoExt(FMapFileName)); + FDataStream.WriteBuffer(FileHeader, SizeOf(FileHeader)); + + FileHeader.Units := FDataStream.Position; + L1 := 0; + L2 := 0; + for I := 0 to Length(FSegments) - 1 do + begin + WriteValueOfs(FSegments[I].StartAddr, L1); + WriteValueOfs(AddWord(MapStringToStr(FSegments[I].UnitName)), L2); + end; + WriteValue(MaxInt); + + FileHeader.SourceNames := FDataStream.Position; + L1 := 0; + L2 := 0; + for I := 0 to Length(FSourceNames) - 1 do + begin + WriteValueOfs(FSourceNames[I].Addr, L1); + WriteValueOfs(AddWord(MapStringToStr(FSourceNames[I].ProcName)), L2); + end; + WriteValue(MaxInt); + + FileHeader.Symbols := FDataStream.Position; + L1 := 0; + L2 := 0; + L3 := 0; + for I := 0 to Length(FProcNames) - 1 do + begin + WriteValueOfs(FProcNames[I].Addr, L1); + S := MapStringToStr(FProcNames[I].ProcName); + D := Pos('.', S); + if D = 1 then + begin + FirstWord := 0; + SecondWord := 0; + end + else + if D = 0 then + begin + FirstWord := AddWord(S); + SecondWord := 0; + end + else + begin + FirstWord := AddWord(Copy(S, 1, D - 1)); + SecondWord := AddWord(Copy(S, D + 1, Length(S))); + end; + WriteValueOfs(FirstWord, L2); + WriteValueOfs(SecondWord, L3); + end; + WriteValue(MaxInt); + + FileHeader.LineNumbers := FDataStream.Position; + L1 := 0; + L2 := 0; + for I := 0 to Length(FLineNumbers) - 1 do + begin + WriteValueOfs(FLineNumbers[I].Addr, L1); + WriteValueOfs(FLineNumbers[I].LineNumber, L2); + end; + WriteValue(MaxInt); + + FileHeader.Words := FDataStream.Position; + FDataStream.CopyFrom(WordStream, 0); + I := 0; + while FDataStream.Size mod 4 <> 0 do + FDataStream.WriteBuffer(I, 1); + FDataStream.Seek(0, soFromBeginning); + FDataStream.WriteBuffer(FileHeader, SizeOf(FileHeader)); + finally + WordStream.Free; + WordList.Free; + end; +end; + +//=== { TJclBinDebugScanner } ================================================ + +constructor TJclBinDebugScanner.Create(AStream: TCustomMemoryStream; CacheData: Boolean); +begin + FCacheData := CacheData; + FStream := AStream; + CheckFormat; +end; + +procedure TJclBinDebugScanner.CacheLineNumbers; +var + P: Pointer; + Value, LineNumber, C, Ln: Integer; + CurrAddr: DWORD; +begin + if FLineNumbers = nil then + begin + LineNumber := 0; + CurrAddr := 0; + C := 0; + Ln := 0; + P := MakePtr(PJclDbgHeader(FStream.Memory)^.LineNumbers); + while ReadValue(P, Value) do + begin + Inc(CurrAddr, Value); + ReadValue(P, Value); + Inc(LineNumber, Value); + if C = Ln then + begin + if Ln < 64 then + Ln := 64 + else + Ln := Ln + Ln div 4; + SetLength(FLineNumbers, Ln); + end; + FLineNumbers[C].Addr := CurrAddr; + FLineNumbers[C].LineNumber := LineNumber; + Inc(C); + end; + SetLength(FLineNumbers, C); + end; +end; + +procedure TJclBinDebugScanner.CacheProcNames; +var + P: Pointer; + Value, FirstWord, SecondWord, C, Ln: Integer; + CurrAddr: DWORD; +begin + if FProcNames = nil then + begin + FirstWord := 0; + SecondWord := 0; + CurrAddr := 0; + C := 0; + Ln := 0; + P := MakePtr(PJclDbgHeader(FStream.Memory)^.Symbols); + while ReadValue(P, Value) do + begin + Inc(CurrAddr, Value); + ReadValue(P, Value); + Inc(FirstWord, Value); + ReadValue(P, Value); + Inc(SecondWord, Value); + if C = Ln then + begin + if Ln < 64 then + Ln := 64 + else + Ln := Ln + Ln div 4; + SetLength(FProcNames, Ln); + end; + FProcNames[C].Addr := CurrAddr; + FProcNames[C].FirstWord := FirstWord; + FProcNames[C].SecondWord := SecondWord; + Inc(C); + end; + SetLength(FProcNames, C); + end; +end; + +{$OVERFLOWCHECKS OFF} + +procedure TJclBinDebugScanner.CheckFormat; +var + CheckSum: Integer; + Data, EndData: PChar; + Header: PJclDbgHeader; +begin + Data := FStream.Memory; + Header := PJclDbgHeader(Data); + FValidFormat := (Data <> nil) and (FStream.Size > SizeOf(TJclDbgHeader)) and + (FStream.Size mod 4 = 0) and + (Header^.Signature = JclDbgDataSignature) and (Header^.Version = JclDbgHeaderVersion); + if FValidFormat and Header^.CheckSumValid then + begin + CheckSum := -Header^.CheckSum; + EndData := Data + FStream.Size; + while Data < EndData do + begin + Inc(CheckSum, PInteger(Data)^); + Inc(PInteger(Data)); + end; + CheckSum := (CheckSum shr 8) or (CheckSum shl 24); + FValidFormat := (CheckSum = Header^.CheckSum); + end; +end; + +{$IFDEF OVERFLOWCHECKS_ON} +{$OVERFLOWCHECKS ON} +{$ENDIF OVERFLOWCHECKS_ON} + +function TJclBinDebugScanner.DataToStr(A: Integer): string; +var + P: PChar; +begin + if A = 0 then + Result := '' + else + begin + P := PChar(DWORD(A) + DWORD(FStream.Memory) + DWORD(PJclDbgHeader(FStream.Memory)^.Words) - 1); + Result := DecodeNameString(P); + end; +end; + +function TJclBinDebugScanner.GetModuleName: string; +begin + Result := DataToStr(PJclDbgHeader(FStream.Memory)^.ModuleName); +end; + +function TJclBinDebugScanner.IsModuleNameValid(const Name: TFileName): Boolean; +begin + Result := AnsiSameText(ModuleName, PathExtractFileNameNoExt(Name)); +end; + +function TJclBinDebugScanner.LineNumberFromAddr(Addr: DWORD): Integer; +var + Dummy: Integer; +begin + Result := LineNumberFromAddr(Addr, Dummy); +end; + +function TJclBinDebugScanner.LineNumberFromAddr(Addr: DWORD; var Offset: Integer): Integer; +var + P: Pointer; + Value, LineNumber: Integer; + CurrAddr, ModuleStartAddr, ItemAddr: DWORD; +begin + ModuleStartAddr := ModuleStartFromAddr(Addr); + LineNumber := 0; + Offset := 0; + if FCacheData then + begin + CacheLineNumbers; + for Value := Length(FLineNumbers) - 1 downto 0 do + if FLineNumbers[Value].Addr <= Addr then + begin + if FLineNumbers[Value].Addr >= ModuleStartAddr then + begin + LineNumber := FLineNumbers[Value].LineNumber; + Offset := Addr - FLineNumbers[Value].Addr; + end; + Break; + end; + end + else + begin + P := MakePtr(PJclDbgHeader(FStream.Memory)^.LineNumbers); + CurrAddr := 0; + ItemAddr := 0; + while ReadValue(P, Value) do + begin + Inc(CurrAddr, Value); + if Addr < CurrAddr then + begin + if ItemAddr < ModuleStartAddr then + begin + LineNumber := 0; + Offset := 0; + end; + Break; + end + else + begin + ItemAddr := CurrAddr; + ReadValue(P, Value); + Inc(LineNumber, Value); + Offset := Addr - CurrAddr; + end; + end; + end; + Result := LineNumber; +end; + +function TJclBinDebugScanner.MakePtr(A: Integer): Pointer; +begin + Result := Pointer(DWORD(FStream.Memory) + DWORD(A)); +end; + +function TJclBinDebugScanner.ModuleNameFromAddr(Addr: DWORD): string; +var + Value, Name: Integer; + StartAddr: DWORD; + P: Pointer; +begin + P := MakePtr(PJclDbgHeader(FStream.Memory)^.Units); + Name := 0; + StartAddr := 0; + while ReadValue(P, Value) do + begin + Inc(StartAddr, Value); + if Addr < StartAddr then + Break + else + begin + ReadValue(P, Value); + Inc(Name, Value); + end; + end; + Result := DataToStr(Name); +end; + +function TJclBinDebugScanner.ModuleStartFromAddr(Addr: DWORD): DWORD; +var + Value: Integer; + StartAddr, ModuleStartAddr: DWORD; + P: Pointer; +begin + P := MakePtr(PJclDbgHeader(FStream.Memory)^.Units); + StartAddr := 0; + ModuleStartAddr := DWORD(-1); + while ReadValue(P, Value) do + begin + Inc(StartAddr, Value); + if Addr < StartAddr then + Break + else + begin + ReadValue(P, Value); + ModuleStartAddr := StartAddr; + end; + end; + Result := ModuleStartAddr; +end; + +function TJclBinDebugScanner.ProcNameFromAddr(Addr: DWORD): string; +var + Dummy: Integer; +begin + Result := ProcNameFromAddr(Addr, Dummy); +end; + +function TJclBinDebugScanner.ProcNameFromAddr(Addr: DWORD; var Offset: Integer): string; +var + P: Pointer; + Value, FirstWord, SecondWord: Integer; + CurrAddr, ModuleStartAddr, ItemAddr: DWORD; +begin + ModuleStartAddr := ModuleStartFromAddr(Addr); + FirstWord := 0; + SecondWord := 0; + Offset := 0; + if FCacheData then + begin + CacheProcNames; + for Value := Length(FProcNames) - 1 downto 0 do + if FProcNames[Value].Addr <= Addr then + begin + if FProcNames[Value].Addr >= ModuleStartAddr then + begin + FirstWord := FProcNames[Value].FirstWord; + SecondWord := FProcNames[Value].SecondWord; + Offset := Addr - FProcNames[Value].Addr; + end; + Break; + end; + end + else + begin + P := MakePtr(PJclDbgHeader(FStream.Memory)^.Symbols); + CurrAddr := 0; + ItemAddr := 0; + while ReadValue(P, Value) do + begin + Inc(CurrAddr, Value); + if Addr < CurrAddr then + begin + if ItemAddr < ModuleStartAddr then + begin + FirstWord := 0; + SecondWord := 0; + Offset := 0; + end; + Break; + end + else + begin + ItemAddr := CurrAddr; + ReadValue(P, Value); + Inc(FirstWord, Value); + ReadValue(P, Value); + Inc(SecondWord, Value); + Offset := Addr - CurrAddr; + end; + end; + end; + if FirstWord <> 0 then + begin + Result := DataToStr(FirstWord); + if SecondWord <> 0 then + Result := Result + '.' + DataToStr(SecondWord) + end + else + Result := ''; +end; + +function TJclBinDebugScanner.ReadValue(var P: Pointer; var Value: Integer): Boolean; +var + N: Integer; + I: Integer; + B: Byte; +begin + N := 0; + I := 0; + repeat + B := PByte(P)^; + Inc(PByte(P)); + Inc(N, (B and $7F) shl I); + Inc(I, 7); + until B and $80 = 0; + Value := N; + Result := (Value <> MaxInt); +end; + +function TJclBinDebugScanner.SourceNameFromAddr(Addr: DWORD): string; +var + Value, Name: Integer; + StartAddr, ModuleStartAddr, ItemAddr: DWORD; + P: Pointer; +begin + ModuleStartAddr := ModuleStartFromAddr(Addr); + P := MakePtr(PJclDbgHeader(FStream.Memory)^.SourceNames); + Name := 0; + StartAddr := 0; + ItemAddr := 0; + while ReadValue(P, Value) do + begin + Inc(StartAddr, Value); + if Addr < StartAddr then + begin + if ItemAddr < ModuleStartAddr then + Name := 0; + Break; + end + else + begin + ItemAddr := StartAddr; + ReadValue(P, Value); + Inc(Name, Value); + end; + end; + Result := DataToStr(Name); +end; + +//=== { TJclDebugInfoSource } ================================================ + +constructor TJclDebugInfoSource.Create(AModule: HMODULE); +begin + FModule := AModule; +end; + +function TJclDebugInfoSource.GetFileName: TFileName; +begin + Result := GetModulePath(FModule); +end; + +function TJclDebugInfoSource.VAFromAddr(const Addr: Pointer): DWORD; +begin + Result := DWORD(Addr) - FModule - ModuleCodeOffset; +end; + +//=== { TJclDebugInfoList } ================================================== + +var + DebugInfoList: TJclDebugInfoList; + DebugInfoCritSect: TJclCriticalSection; + +procedure NeedDebugInfoList; +begin + if DebugInfoList = nil then + DebugInfoList := TJclDebugInfoList.Create; +end; + +function TJclDebugInfoList.CreateDebugInfo(const Module: HMODULE): TJclDebugInfoSource; +const + DebugInfoSources: array [1..4] of TJclDebugInfoSourceClass = + (TJclDebugInfoBinary, TJclDebugInfoTD32, TJclDebugInfoMap, TJclDebugInfoExports); +var + I: Integer; +begin + for I := Low(DebugInfoSources) to High(DebugInfoSources) do + begin + Result := DebugInfoSources[I].Create(Module); + try + if Result.InitializeSource then + Break + else + FreeAndNil(Result); + except + FreeAndNil(Result); + raise; + end; + end; +end; + +function TJclDebugInfoList.GetItemFromModule(const Module: HMODULE): TJclDebugInfoSource; +var + I: Integer; + TempItem: TJclDebugInfoSource; +begin + Result := nil; + if Module = 0 then + Exit; + for I := 0 to Count - 1 do + begin + TempItem := Items[I]; + if TempItem.Module = Module then + begin + Result := TempItem; + Break; + end; + end; + if Result = nil then + begin + Result := CreateDebugInfo(Module); + if Result <> nil then + Add(Result); + end; +end; + +function TJclDebugInfoList.GetItems(Index: Integer): TJclDebugInfoSource; +begin + Result := TJclDebugInfoSource(Get(Index)); +end; + +function TJclDebugInfoList.GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; +var + Item: TJclDebugInfoSource; +begin + FillChar(Info, SizeOf(Info), #0); + Item := ItemFromModule[ModuleFromAddr(Addr)]; + if Item <> nil then + Result := Item.GetLocationInfo(Addr, Info) + else + Result := False; +end; + +//=== { TJclDebugInfoMap } =================================================== + +destructor TJclDebugInfoMap.Destroy; +begin + FreeAndNil(FScanner); + inherited Destroy; +end; + +function TJclDebugInfoMap.GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; +var + VA: DWORD; +begin + VA := VAFromAddr(Addr); + with FScanner do + begin + Info.UnitName := ModuleNameFromAddr(VA); + Result := (Info.UnitName <> ''); + if Result then + begin + Info.Address := Addr; + Info.ProcedureName := ProcNameFromAddr(VA, Info.OffsetFromProcName); + Info.LineNumber := LineNumberFromAddr(VA, Info.OffsetFromLineNumber); + Info.SourceName := SourceNameFromAddr(VA); + Info.DebugInfo := Self; + end; + end; +end; + +function TJclDebugInfoMap.InitializeSource: Boolean; +var + MapFileName: TFileName; +begin + MapFileName := ChangeFileExt(FileName, MapFileExtension); + Result := FileExists(MapFileName); + if Result then + FScanner := TJclMapScanner.Create(MapFileName); +end; + +//=== { TJclDebugInfoBinary } ================================================ + +destructor TJclDebugInfoBinary.Destroy; +begin + FreeAndNil(FScanner); + FreeAndNil(FStream); + inherited Destroy; +end; + +function TJclDebugInfoBinary.GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; +var + VA: DWORD; +begin + VA := VAFromAddr(Addr); + with FScanner do + begin + Info.UnitName := ModuleNameFromAddr(VA); + Result := (Info.UnitName) <> ''; + if Result then + begin + Info.Address := Addr; + Info.ProcedureName := ProcNameFromAddr(VA, Info.OffsetFromProcName); + Info.LineNumber := LineNumberFromAddr(VA, Info.OffsetFromLineNumber); + Info.SourceName := SourceNameFromAddr(VA); + Info.DebugInfo := Self; + end; + end; +end; + +function TJclDebugInfoBinary.InitializeSource: Boolean; +var + JdbgFileName: TFileName; + VerifyFileName: Boolean; +begin + VerifyFileName := False; + Result := (PeMapImgFindSection(PeMapImgNtHeaders(Pointer(Module)), JclDbgDataResName) <> nil); + if Result then + FStream := TJclPeSectionStream.Create(Module, JclDbgDataResName) + else + begin + JdbgFileName := ChangeFileExt(FileName, JclDbgFileExtension); + Result := FileExists(JdbgFileName); + if Result then + begin + FStream := TJclFileMappingStream.Create(JdbgFileName, fmOpenRead or fmShareDenyWrite); + VerifyFileName := True; + end; + end; + if Result then + begin + FScanner := TJclBinDebugScanner.Create(FStream, True); + Result := FScanner.ValidFormat and + (not VerifyFileName or FScanner.IsModuleNameValid(FileName)); + end; +end; + +//=== { TJclDebugInfoExports } =============================================== + +destructor TJclDebugInfoExports.Destroy; +begin + FreeAndNil(FBorImage); + inherited Destroy; +end; + +function TJclDebugInfoExports.GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; +var + I, BasePos: Integer; + VA: DWORD; + Desc: TJclBorUmDescription; + Unmangled: string; + RawName: Boolean; +begin + Result := False; + VA := DWORD(Addr) - FModule; + RawName := not FBorImage.IsPackage; + Info.OffsetFromProcName := 0; + Info.OffsetFromLineNumber := 0; + with FBorImage.ExportList do + begin + SortList(esAddress, False); + for I := Count - 1 downto 0 do + if Items[I].Address <= VA then + begin + if RawName then + begin + Info.ProcedureName := Items[I].Name; + Info.OffsetFromProcName := VA - Items[I].Address; + Result := True; + end + else + begin + case PeBorUnmangleName(Items[I].Name, Unmangled, Desc, BasePos) of + urOk: + begin + Info.UnitName := Copy(Unmangled, 1, BasePos - 2); + if not (Desc.Kind in [skRTTI, skVTable]) then + begin + Info.ProcedureName := Copy(Unmangled, BasePos, Length(Unmangled)); + if smLinkProc in Desc.Modifiers then + Info.ProcedureName := '@' + Info.ProcedureName; + Info.OffsetFromProcName := VA - Items[I].Address; + end; + Result := True; + end; + urNotMangled: + begin + Info.ProcedureName := Items[I].Name; + Info.OffsetFromProcName := VA - Items[I].Address; + Result := True; + end; + end; + end; + if Result then + begin + Info.Address := Addr; + Info.DebugInfo := Self; + Break; + end; + end; + end; +end; + +function TJclDebugInfoExports.InitializeSource: Boolean; +begin + FBorImage := TJclPeBorImage.Create(True); + FBorImage.AttachLoadedModule(FModule); + Result := FBorImage.StatusOK and (FBorImage.ExportList.Count > 0); +end; + +//=== { TJclDebugInfoTD32 } ================================================== + +destructor TJclDebugInfoTD32.Destroy; +begin + FreeAndNil(FImage); + inherited Destroy; +end; + +function TJclDebugInfoTD32.GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; +var + VA: DWORD; +begin + VA := VAFromAddr(Addr); + Info.UnitName := FImage.TD32Scanner.ModuleNameFromAddr(VA); + Result := (Info.UnitName) <> ''; + if Result then + with Info do + begin + Address := Addr; + ProcedureName := FImage.TD32Scanner.ProcNameFromAddr(VA, OffsetFromProcName); + LineNumber := FImage.TD32Scanner.LineNumberFromAddr(VA, OffsetFromLineNumber); + SourceName := FImage.TD32Scanner.SourceNameFromAddr(VA); + DebugInfo := Self; + end; +end; + +function TJclDebugInfoTD32.InitializeSource: Boolean; +begin + FImage := TJclPeBorTD32Image.Create(True); + try + FImage.AttachLoadedModule(Module); + Result := FImage.IsTD32DebugPresent; + except + Result := False; + end; +end; + +//=== Source location functions ============================================== + +{$STACKFRAMES ON} + +function Caller(Level: Integer; FastStackWalk: Boolean): Pointer; +var + TopOfStack: Cardinal; + BaseOfStack: Cardinal; + StackFrame: PStackFrame; +begin + Result := nil; + try + if FastStackWalk then + begin + StackFrame := GetEBP; + BaseOfStack := Cardinal(StackFrame) - 1; + TopOfStack := GetStackTop; + while (BaseOfStack < Cardinal(StackFrame)) and (Cardinal(StackFrame) < TopOfStack) do + begin + if Level = 0 then + begin + Result := Pointer(StackFrame^.CallerAdr - 1); + Break; + end; + StackFrame := PStackFrame(StackFrame^.CallersEBP); + Dec(Level); + end; + end + else + with TJclStackInfoList.Create(False, 1, nil) do + try + if Level < Count then + Result := Items[Level].CallerAdr; + finally + Free; + end; + except + Result := nil; + end; +end; + +{$IFNDEF STACKFRAMES_ON} +{$STACKFRAMES OFF} +{$ENDIF ~STACKFRAMES_ON} + +function GetLocationInfo(const Addr: Pointer): TJclLocationInfo; +begin + try + DebugInfoCritSect.Enter; + try + NeedDebugInfoList; + DebugInfoList.GetLocationInfo(Addr, Result) + finally + DebugInfoCritSect.Leave; + end; + except + FillChar(Result, SizeOf(Result), #0); + end; +end; + +function GetLocationInfo(const Addr: Pointer; var Info: TJclLocationInfo): Boolean; +begin + try + DebugInfoCritSect.Enter; + try + NeedDebugInfoList; + Result := DebugInfoList.GetLocationInfo(Addr, Info); + finally + DebugInfoCritSect.Leave; + end; + except + Result := False; + end; +end; + +function GetLocationInfoStr(const Addr: Pointer; IncludeModuleName, IncludeAddressOffset, + IncludeStartProcLineOffset: Boolean; IncludeVAdress: Boolean): string; +var + Info, StartProcInfo: TJclLocationInfo; + OffsetStr, StartProcOffsetStr: string; + Module : HMODULE; +begin + OffsetStr := ''; + if GetLocationInfo(Addr, Info) then + with Info do + begin + if LineNumber > 0 then + begin + if IncludeStartProcLineOffset and GetLocationInfo(Pointer(Cardinal(Info.Address) - + Cardinal(Info.OffsetFromProcName)), StartProcInfo) and (StartProcInfo.LineNumber > 0) then + StartProcOffsetStr := Format(' + %d', [LineNumber - StartProcInfo.LineNumber]) + else + StartProcOffsetStr := ''; + if IncludeAddressOffset then + begin + if OffsetFromLineNumber >= 0 then + OffsetStr := Format(' + $%x', [OffsetFromLineNumber]) + else + OffsetStr := Format(' - $%x', [-OffsetFromLineNumber]) + end; + Result := Format('[%p] %s.%s (Line %u, "%s"%s)%s', [Addr, UnitName, ProcedureName, LineNumber, + SourceName, StartProcOffsetStr, OffsetStr]); + end + else + begin + if IncludeAddressOffset then + OffsetStr := Format(' + $%x', [OffsetFromProcName]); + if UnitName <> '' then + Result := Format('[%p] %s.%s%s', [Addr, UnitName, ProcedureName, OffsetStr]) + else + Result := Format('[%p] %s%s', [Addr, ProcedureName, OffsetStr]); + end; + end + else + Result := Format('[%p]', [Addr]); + if IncludeVAdress or IncludeModuleName then + begin + Module := ModuleFromAddr(Addr); + if IncludeVAdress then + OffsetStr := Format('(%p) ', [Pointer(DWORD(Addr) - Module - ModuleCodeOffset)]); + if IncludeModuleName then + Insert(Format('{%-12s}', [ExtractFileName(GetModulePath(Module))]), Result, 11); + Result := OffsetStr + Result; + end; +end; + +function DebugInfoAvailable(const Module: HMODULE): Boolean; +begin + DebugInfoCritSect.Enter; + try + NeedDebugInfoList; + Result := (DebugInfoList.ItemFromModule[Module] <> nil); + finally + DebugInfoCritSect.Leave; + end; +end; + +procedure ClearLocationData; +begin + DebugInfoCritSect.Enter; + try + if DebugInfoList <> nil then + DebugInfoList.Clear; + finally + DebugInfoCritSect.Leave; + end; +end; + +{$STACKFRAMES ON} + +function FileByLevel(const Level: Integer): string; +begin + Result := GetLocationInfo(Caller(Level + 1)).SourceName; +end; + +function ModuleByLevel(const Level: Integer): string; +begin + Result := GetLocationInfo(Caller(Level + 1)).UnitName; +end; + +function ProcByLevel(const Level: Integer): string; +begin + Result := GetLocationInfo(Caller(Level + 1)).ProcedureName; +end; + +function LineByLevel(const Level: Integer): Integer; +begin + Result := GetLocationInfo(Caller(Level + 1)).LineNumber; +end; + +function MapByLevel(const Level: Integer; var File_, Module_, Proc_: string; + var Line_: Integer): Boolean; +begin + Result := MapOfAddr(Caller(Level + 1), File_, Module_, Proc_, Line_); +end; + +function ExtractClassName(const ProcedureName: string): string; +var + D: Integer; +begin + D := Pos('.', ProcedureName); + if D < 2 then + Result := '' + else + Result := Copy(ProcedureName, 1, D - 1); +end; + +function ExtractMethodName(const ProcedureName: string): string; +begin + Result := Copy(ProcedureName, Pos('.', ProcedureName) + 1, Length(ProcedureName)); +end; + +function __FILE__(const Level: Integer): string; +begin + Result := FileByLevel(Level + 1); +end; + +function __MODULE__(const Level: Integer): string; +begin + Result := ModuleByLevel(Level + 1); +end; + +function __PROC__(const Level: Integer): string; +begin + Result := ProcByLevel(Level + 1); +end; + +function __LINE__(const Level: Integer): Integer; +begin + Result := LineByLevel(Level + 1); +end; + +function __MAP__(const Level: Integer; var _File, _Module, _Proc: string; var _Line: Integer): Boolean; +begin + Result := MapByLevel(Level + 1, _File, _Module, _Proc, _Line); +end; + +{$IFNDEF STACKFRAMES_ON} +{$STACKFRAMES OFF} +{$ENDIF ~STACKFRAMES_ON} + +function FileOfAddr(const Addr: Pointer): string; +begin + Result := GetLocationInfo(Addr).SourceName; +end; + +function ModuleOfAddr(const Addr: Pointer): string; +begin + Result := GetLocationInfo(Addr).UnitName; +end; + +function ProcOfAddr(const Addr: Pointer): string; +begin + Result := GetLocationInfo(Addr).ProcedureName; +end; + +function LineOfAddr(const Addr: Pointer): Integer; +begin + Result := GetLocationInfo(Addr).LineNumber; +end; + +function MapOfAddr(const Addr: Pointer; var File_, Module_, Proc_: string; + var Line_: Integer): Boolean; +var + LocInfo: TJclLocationInfo; +begin + NeedDebugInfoList; + Result := DebugInfoList.GetLocationInfo(Addr, LocInfo); + if Result then + begin + File_ := LocInfo.SourceName; + Module_ := LocInfo.UnitName; + Proc_ := LocInfo.ProcedureName; + Line_ := LocInfo.LineNumber; + end; +end; + +function __FILE_OF_ADDR__(const Addr: Pointer): string; +begin + Result := FileOfAddr(Addr); +end; + +function __MODULE_OF_ADDR__(const Addr: Pointer): string; +begin + Result := ModuleOfAddr(Addr); +end; + +function __PROC_OF_ADDR__(const Addr: Pointer): string; +begin + Result := ProcOfAddr(Addr); +end; + +function __LINE_OF_ADDR__(const Addr: Pointer): Integer; +begin + Result := LineOfAddr(Addr); +end; + +function __MAP_OF_ADDR__(const Addr: Pointer; var _File, _Module, _Proc: string; + var _Line: Integer): Boolean; +begin + Result := MapOfAddr(Addr, _File, _Module, _Proc, _Line); +end; + +//=== { TJclStackBaseList } ================================================== + +constructor TJclStackBaseList.Create; +begin + inherited Create(True); + FThreadID := GetCurrentThreadId; + FTimeStamp := Now; +end; + +//=== { TJclGlobalStackList } ================================================ + +type + TJclStackBaseListClass = class of TJclStackBaseList; + + TJclGlobalStackList = class(TThreadList) + private + FLockedTID: DWORD; + FTIDLocked: Boolean; + function GetExceptStackInfo: TJclStackInfoList; + function GetLastExceptFrameList: TJclExceptFrameList; + public + destructor Destroy; override; + procedure AddObject(AObject: TJclStackBaseList); + procedure LockThreadID(TID: DWORD); + procedure UnlockThreadID; + function FindObject(TID: DWORD; AClass: TJclStackBaseListClass): TJclStackBaseList; + property ExceptStackInfo: TJclStackInfoList read GetExceptStackInfo; + property LastExceptFrameList: TJclExceptFrameList read GetLastExceptFrameList; + end; + +var + GlobalStackList: TJclGlobalStackList; + +destructor TJclGlobalStackList.Destroy; +var + I: Integer; +begin + with LockList do + try + for I := 0 to Count - 1 do + TObject(Items[I]).Free; + finally + UnlockList; + end; + inherited Destroy; +end; + +procedure TJclGlobalStackList.AddObject(AObject: TJclStackBaseList); +var + ReplacedObj: TObject; +begin + with LockList do + try + ReplacedObj := FindObject(AObject.ThreadID, TJclStackBaseListClass(AObject.ClassType)); + if ReplacedObj <> nil then + begin + Remove(ReplacedObj); + ReplacedObj.Free; + end; + Add(AObject); + finally + UnlockList; + end; +end; + +function TJclGlobalStackList.FindObject(TID: DWORD; AClass: TJclStackBaseListClass): TJclStackBaseList; +var + I: Integer; + Item: TJclStackBaseList; +begin + Result := nil; + with LockList do + try + if FTIDLocked and (GetCurrentThreadId = MainThreadID) then + TID := FLockedTID; + for I := 0 to Count - 1 do + begin + Item := Items[I]; + if (Item.ThreadID = TID) and (Item is AClass) then + begin + Result := Item; + Break; + end; + end; + finally + UnlockList; + end; +end; + +function TJclGlobalStackList.GetExceptStackInfo: TJclStackInfoList; +begin + Result := TJclStackInfoList(FindObject(GetCurrentThreadId, TJclStackInfoList)); +end; + +function TJclGlobalStackList.GetLastExceptFrameList: TJclExceptFrameList; +begin + Result := TJclExceptFrameList(FindObject(GetCurrentThreadId, TJclExceptFrameList)); +end; + +procedure TJclGlobalStackList.LockThreadID(TID: DWORD); +begin + with LockList do + try + if GetCurrentThreadId = MainThreadID then + begin + FTIDLocked := True; + FLockedTID := TID; + end + else + FTIDLocked := False; + finally + UnlockList; + end; +end; + +procedure TJclGlobalStackList.UnlockThreadID; +begin + with LockList do + try + FTIDLocked := False; + finally + UnlockList; + end; +end; + +//=== { TJclGlobalModulesList } ============================================== + +type + TJclGlobalModulesList = class(TObject) + private + FHookedModules: TJclModuleArray; + FLock: TJclCriticalSection; + FModulesList: TJclModuleInfoList; + public + constructor Create; + destructor Destroy; override; + function CreateModulesList: TJclModuleInfoList; + procedure FreeModulesList(var ModulesList: TJclModuleInfoList); + function ValidateAddress(Addr: Pointer): Boolean; + end; + +var + GlobalModulesList: TJclGlobalModulesList; + +constructor TJclGlobalModulesList.Create; +begin + FLock := TJclCriticalSection.Create; +end; + +destructor TJclGlobalModulesList.Destroy; +begin + FreeAndNil(FLock); + FreeAndNil(FModulesList); + inherited Destroy; +end; + +function TJclGlobalModulesList.CreateModulesList: TJclModuleInfoList; +var + I: Integer; + SystemModulesOnly: Boolean; +begin + FLock.Enter; + try + if FModulesList = nil then + begin + SystemModulesOnly := not (stAllModules in JclStackTrackingOptions); + Result := TJclModuleInfoList.Create(False, SystemModulesOnly); + // Add known Borland modules collected by DLL exception hooking code + if SystemModulesOnly and JclHookedExceptModulesList(FHookedModules) then + for I := Low(FHookedModules) to High(FHookedModules) do + Result.AddModule(FHookedModules[I], True); + if stStaticModuleList in JclStackTrackingOptions then + FModulesList := Result; + end + else + Result := FModulesList; + finally + FLock.Leave; + end; +end; + +procedure TJclGlobalModulesList.FreeModulesList(var ModulesList: TJclModuleInfoList); +begin + FLock.Enter; + try + if FModulesList <> ModulesList then + FreeAndNil(ModulesList); + finally + FLock.Leave; + end; +end; + +function TJclGlobalModulesList.ValidateAddress(Addr: Pointer): Boolean; +var + TempList: TJclModuleInfoList; +begin + TempList := CreateModulesList; + try + Result := TempList.IsValidModuleAddress(Addr); + finally + FreeModulesList(TempList); + end; +end; + +function JclValidateModuleAddress(Addr: Pointer): Boolean; +begin + Result := GlobalModulesList.ValidateAddress(Addr); +end; + +//=== Stack info routines ==================================================== + +{$STACKFRAMES OFF} + +function ValidCodeAddr(CodeAddr: DWORD; ModuleList: TJclModuleInfoList): Boolean; +begin + if stAllModules in JclStackTrackingOptions then + Result := ModuleList.IsValidModuleAddress(Pointer(CodeAddr)) + else + Result := ModuleList.IsSystemModuleAddress(Pointer(CodeAddr)); +end; + +procedure CorrectExceptStackListTop(List: TJclStackInfoList; SkipFirstItem: Boolean); +var + TopItem,I, FoundPos: Integer; +begin + FoundPos := -1; + if SkipFirstItem then + TopItem := 1 + else + TopItem := 0; + with List do + begin + for I := Count - 1 downto TopItem do + if JclBelongsHookedCode(Items[I].CallerAdr) then + begin + FoundPos := I; + Break; + end; + if FoundPos <> -1 then + for I := FoundPos downto TopItem do + Delete(I); + end; +end; + +{$STACKFRAMES ON} + +procedure DoExceptionStackTrace(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean); +var + IgnoreLevels: DWORD; + FirstCaller: Pointer; + RawMode: Boolean; +begin + RawMode := stRawMode in JclStackTrackingOptions; + if RawMode then + IgnoreLevels := 7 + else + IgnoreLevels := 5; + if OSException then + FirstCaller := ExceptAddr + else + FirstCaller := nil; + CorrectExceptStackListTop(JclCreateStackList(RawMode, IgnoreLevels, FirstCaller), OSException); +end; + +function JclLastExceptStackList: TJclStackInfoList; +begin + Result := GlobalStackList.ExceptStackInfo; +end; + +function JclLastExceptStackListToStrings(Strings: TStrings; IncludeModuleName, IncludeAddressOffset, + IncludeStartProcLineOffset, IncludeVAdress: Boolean): Boolean; +var + List: TJclStackInfoList; +begin + List := JclLastExceptStackList; + Result := Assigned(List); + if Result then + List.AddToStrings(Strings, IncludeModuleName, IncludeAddressOffset, IncludeStartProcLineOffset, + IncludeVAdress); +end; + +function JclCreateStackList(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer): TJclStackInfoList; +begin + Result := TJclStackInfoList.Create(Raw, AIgnoreLevels, FirstCaller); + GlobalStackList.AddObject(Result); +end; + +//=== { TJclStackInfoItem 0 ================================================== +function TJclStackInfoItem.GetCallerAdr: Pointer; +begin + Result := Pointer(FStackInfo.CallerAdr); +end; + +function TJclStackInfoItem.GetLogicalAddress: DWORD; +begin + Result := FStackInfo.CallerAdr - DWORD(ModuleFromAddr(CallerAdr)); +end; + +//=== { TJclStackInfoList } ================================================== + +constructor TJclStackInfoList.Create(Raw: Boolean; AIgnoreLevels: DWORD; FirstCaller: Pointer); +var + Item: TJclStackInfoItem; +begin + inherited Create; + FIgnoreLevels := AIgnoreLevels; + TopOfStack := GetStackTop; + FModuleInfoList := GlobalModulesList.CreateModulesList; + if FirstCaller <> nil then + begin + Item := TJclStackInfoItem.Create; + Item.FStackInfo.CallerAdr := DWORD(FirstCaller); + Add(Item); + end; + if Raw then + TraceStackRaw + else + TraceStackFrames; +end; + +destructor TJclStackInfoList.Destroy; +begin + GlobalModulesList.FreeModulesList(FModuleInfoList); + inherited Destroy; +end; + +procedure TJclStackInfoList.AddToStrings(Strings: TStrings; IncludeModuleName, IncludeAddressOffset, + IncludeStartProcLineOffset, IncludeVAdress: Boolean); +var + I: Integer; +begin + Strings.BeginUpdate; + try + for I := 0 to Count - 1 do + Strings.Add(GetLocationInfoStr(Items[I].CallerAdr, IncludeModuleName, IncludeAddressOffset, + IncludeStartProcLineOffset, IncludeVAdress)); + finally + Strings.EndUpdate; + end; +end; + +function TJclStackInfoList.GetItems(Index: Integer): TJclStackInfoItem; +begin + Result := TJclStackInfoItem(Get(Index)); +end; + +{$OVERFLOWCHECKS OFF} + +function TJclStackInfoList.NextStackFrame(var StackFrame: PStackFrame; var StackInfo: TStackInfo): Boolean; +var + CallInstructionSize: Cardinal; +begin + // Only report this stack frame into the StockInfo structure + // if the StackFrame pointer, EBP on the stack and return + // address on the stack are valid addresses + while ValidStackAddr(DWORD(StackFrame)) do + begin + // CallerAdr within current process space, code segment etc. + // CallersEBP within current thread stack. Added Mar 12 2002 per Hallvard's suggestion + if ValidCodeAddr(StackFrame^.CallerAdr, FModuleInfoList) and ValidStackAddr(StackFrame^.CallersEBP) then + begin + Inc(StackInfo.Level); + StackInfo.StackFrame := StackFrame; + StackInfo.ParamPtr := PDWORDArray(DWORD(StackFrame) + SizeOf(TStackFrame)); + StackInfo.CallersEBP := StackFrame^.CallersEBP; + // Calculate the address of caller by subtracting the CALL instruction size (if possible) + if ValidCallSite(StackFrame^.CallerAdr, CallInstructionSize) then + StackInfo.CallerAdr := StackFrame^.CallerAdr - CallInstructionSize + else + StackInfo.CallerAdr := StackFrame^.CallerAdr; + StackInfo.DumpSize := StackFrame^.CallersEBP - DWORD(StackFrame); + StackInfo.ParamSize := (StackInfo.DumpSize - SizeOf(TStackFrame)) div 4; + // Step to the next stack frame by following the EBP pointer + StackFrame := PStackFrame(StackFrame^.CallersEBP); + Result := True; + Exit; + end; + // Step to the next stack frame by following the EBP pointer + StackFrame := PStackFrame(StackFrame^.CallersEBP); + end; + Result := False; +end; + +{$IFDEF OVERFLOWCHECKS_ON} +{$OVERFLOWCHECKS ON} +{$ENDIF OVERFLOWCHECKS_ON} + +procedure TJclStackInfoList.StoreToList(const StackInfo: TStackInfo); +var + Item: TJclStackInfoItem; +begin + if StackInfo.Level > IgnoreLevels + 1 then + begin + Item := TJclStackInfoItem.Create; + Item.FStackInfo := StackInfo; + Add(Item); + end; +end; + +procedure TJclStackInfoList.TraceStackFrames; +var + StackFrame: PStackFrame; + StackInfo: TStackInfo; +begin + // Start at level 0 + StackInfo.Level := 0; + // Get the current stack frame from the EBP register + StackFrame := GetEBP; + // We define the bottom of the valid stack to be the current EBP Pointer + // There is a TIB field called pvStackUserBase, but this includes more of the + // stack than what would define valid stack frames. + BaseOfStack := DWORD(StackFrame) - 1; + // Loop over and report all valid stackframes + while NextStackFrame(StackFrame, StackInfo) do + StoreToList(StackInfo); +end; + +procedure TJclStackInfoList.TraceStackRaw; +var + StackInfo: TStackInfo; + StackPtr: PDWORD; + PrevCaller: DWORD; + CallInstructionSize: Cardinal; +begin + // We define the bottom of the valid stack to be the current ESP pointer + BaseOfStack := DWORD(GetESP); + // We will not be able to fill in all the fields in the StackInfo record, + // so just blank it all out first + FillChar(StackInfo, SizeOf(StackInfo), 0); + // Clear the previous call address + PrevCaller := 0; + // Get a pointer to the current bottom of the stack + StackPtr := PDWORD(BaseOfStack); + // Loop through all of the valid stack space + while DWORD(StackPtr) < TopOfStack do + begin + // If the current DWORD on the stack refers to a valid call site... + if ValidCallSite(StackPtr^, CallInstructionSize) and (StackPtr^ <> PrevCaller) then + begin + // then pick up the callers address + StackInfo.CallerAdr := StackPtr^ - CallInstructionSize; + // remember to callers address so that we don't report it repeatedly + PrevCaller := StackPtr^; + // increase the stack level + Inc(StackInfo.Level); + // then report it back to our caller + StoreToList(StackInfo); + end; + // Look at the next DWORD on the stack + Inc(StackPtr); + end; +end; + +// Validate that the code address is a valid code site +// +// Information from Intel Manual 24319102(2).pdf, Download the 6.5 MBs from: +// http://developer.intel.com/design/pentiumii/manuals/243191.htm +// Instruction format, Chapter 2 and The CALL instruction: page 3-53, 3-54 + +{$OVERFLOWCHECKS OFF} + +function TJclStackInfoList.ValidCallSite(CodeAddr: DWORD; var CallInstructionSize: Cardinal): Boolean; +var + CodeDWORD4: DWORD; + CodeDWORD8: DWORD; + C4P, C8P: PDWORD; +begin + // First check that the address is within range of our code segment! + C8P := PDWORD(CodeAddr - 8); + C4P := PDWORD(CodeAddr - 4); + Result := (CodeAddr > 8) and ValidCodeAddr(DWORD(C8P), FModuleInfoList) and not IsBadReadPtr(C8P, 8); + + // Now check to see if the instruction preceding the return address + // could be a valid CALL instruction + if Result then + begin + try + CodeDWORD8 := PDWORD(C8P)^; + CodeDWORD4 := PDWORD(C4P)^; + + // Check the instruction prior to the potential call site. + // We consider it a valid call site if we find a CALL instruction there + // Check the most common CALL variants first + if ((CodeDWORD8 and $FF000000) = $E8000000) then // 5-byte, CALL [-$1234567] + CallInstructionSize := 5 + else + if ((CodeDWORD4 and $38FF0000) = $10FF0000) then // 2 byte, CALL EAX + CallInstructionSize := 2 + else + if ((CodeDWORD4 and $0038FF00) = $0010FF00) then // 3 byte, CALL [EBP+0x8] + CallInstructionSize := 3 + else + if ((CodeDWORD4 and $000038FF) = $000010FF) then // 4 byte, CALL ?? + CallInstructionSize := 4 + else + if ((CodeDWORD8 and $38FF0000) = $10FF0000) then // 6-byte, CALL ?? + CallInstructionSize := 6 + else + if ((CodeDWORD8 and $0038FF00) = $0010FF00) then // 7-byte, CALL [ESP-0x1234567] + CallInstructionSize := 7 + else + Result := False; + // Because we're not doing a complete disassembly, we will potentially report + // false positives. If there is odd code that uses the CALL 16:32 format, we + // can also get false negatives.} + except + Result := False; + end; + end; +end; + +{$IFDEF OVERFLOWCHECKS_ON} +{$OVERFLOWCHECKS ON} +{$ENDIF OVERFLOWCHECKS_ON} + +{$IFNDEF STACKFRAMES_ON} +{$STACKFRAMES OFF} +{$ENDIF ~STACKFRAMES_ON} + +function TJclStackInfoList.ValidStackAddr(StackAddr: DWORD): Boolean; +begin + Result := (BaseOfStack < StackAddr) and (StackAddr < TopOfStack); +end; + +//=== Exception frame info routines ========================================== + +function JclCreateExceptFrameList(AIgnoreLevels: Integer): TJclExceptFrameList; +begin + Result := TJclExceptFrameList.Create(AIgnoreLevels); + GlobalStackList.AddObject(Result); +end; + +function JclLastExceptFrameList: TJclExceptFrameList; +begin + Result := GlobalStackList.LastExceptFrameList; +end; + +procedure DoExceptFrameTrace; +begin + // Ignore first 2 levels; the First level is an undefined frame (I haven't a + // clue as to where it comes from. The second level is the try..finally block + // in DoExceptNotify. + JclCreateExceptFrameList(4); +end; + +function GetJmpDest(Jmp: PJmpInstruction): DWORD; +begin + if Jmp.opCode = $E9 then + Result := Longint(Jmp) + Jmp.distance + 5 + else + if Jmp.opCode = $EB then + Result := Longint(Jmp) + ShortInt(jmp.distance) + 2 + else + Result := 0; + if (Result <> 0) and (PJmpTable(Result).OPCode = $25FF) then + if not IsBadReadPtr(PJmpTable(Result).Ptr, 4) then + Result := PDWORD(PJmpTable(Result).Ptr)^; +end; + +//=== { TJclExceptFrame } ==================================================== + +constructor TJclExceptFrame.Create(AExcFrame: PExcFrame); +begin + inherited Create; + FExcFrame := AExcFrame; + DoDetermineFrameKind; +end; + +procedure TJclExceptFrame.DoDetermineFrameKind; +var + Dest: Longint; + LocInfo: TJclLocationInfo; +begin + FFrameKind := efkUnknown; + if FExcFrame <> nil then + begin + Dest := GetJmpDest(@ExcFrame.desc.Jmp); + if Dest <> 0 then + begin + LocInfo := GetLocationInfo(Pointer(Dest)); + if CompareText(LocInfo.UnitName, 'system') = 0 then + begin + if CompareText(LocInfo.ProcedureName, '@HandleAnyException') = 0 then + FFrameKind := efkAnyException + else + if CompareText(LocInfo.ProcedureName, '@HandleOnException') = 0 then + FFrameKind := efkOnException + else + if CompareText(LocInfo.ProcedureName, '@HandleAutoException') = 0 then + FFrameKind := efkAutoException + else + if CompareText(LocInfo.ProcedureName, '@HandleFinally') = 0 then + FFrameKind := efkFinally; + end; + end; + end; +end; + +function TJclExceptFrame.Handles(ExceptObj: TObject): Boolean; +var + Handler: Pointer; +begin + Result := HandlerInfo(ExceptObj, Handler); +end; + +function TJclExceptFrame.HandlerInfo(ExceptObj: TObject; var HandlerAt: Pointer): Boolean; +var + I: Integer; + VTable: Pointer; +begin + Result := FrameKind in [efkAnyException, efkAutoException]; + if not Result and (FrameKind = efkOnException) then + begin + I := 0; + VTable := Pointer(Integer(ExceptObj.ClassType) + vmtSelfPtr); + while (I < ExcFrame.Desc.Cnt) and not Result and (VTable <> nil) do + begin + Result := (ExcFrame.Desc.ExcTab[I].VTable = nil) or + (ExcFrame.Desc.ExcTab[I].VTable = VTable); + if not Result then + begin + Move(PChar(VTable)[vmtParent - vmtSelfPtr], VTable, 4); + if VTable = nil then + begin + VTable := Pointer(Integer(ExceptObj.ClassType) + vmtSelfPtr); + Inc(I); + end; + end; + end; + if Result then + HandlerAt := ExcFrame.Desc.ExcTab[I].Handler; + end + else + if Result then + begin + HandlerAt := Pointer(GetJmpDest(@ExcFrame.Desc.Instructions)); + if HandlerAt = nil then + HandlerAt := @ExcFrame.Desc.Instructions; + end + else + HandlerAt := nil; +end; + +function TJclExceptFrame.CodeLocation: Pointer; +begin + if FrameKind <> efkUnknown then + begin + Result := Pointer(GetJmpDest(PJmpInstruction(DWORD(@ExcFrame.Desc.Instructions)))); + if Result = nil then + Result := @ExcFrame.Desc.Instructions; + end + else + begin + Result := Pointer(GetJmpDest(PJmpInstruction(DWORD(@ExcFrame.Desc)))); + if Result = nil then + Result := @ExcFrame.Desc; + end; +end; + +//=== { TJclExceptFrameList } ================================================ + +constructor TJclExceptFrameList.Create(AIgnoreLevels: Integer); +begin + inherited Create; + FIgnoreLevels := AIgnoreLevels; + TraceExceptionFrames; +end; + +function TJclExceptFrameList.AddFrame(AFrame: PExcFrame): TJclExceptFrame; +begin + Result := TJclExceptFrame.Create(AFrame); + try + Add(Result); + except + Remove(Result); + Result.Free; + raise; + end; +end; + +function TJclExceptFrameList.GetItems(Index: Integer): TJclExceptFrame; +begin + Result := TJclExceptFrame(Get(Index)); +end; + +procedure TJclExceptFrameList.TraceExceptionFrames; +var + FS: PExcFrame; + Level: Integer; + ModulesList: TJclModuleInfoList; +begin + Clear; + ModulesList := GlobalModulesList.CreateModulesList; + try + Level := 0; + FS := GetFS; + while Longint(FS) <> -1 do + begin + if (Level >= IgnoreLevels) and ValidCodeAddr(DWORD(FS.Desc), ModulesList) then + AddFrame(FS); + Inc(Level); + FS := FS.next; + end; + finally + GlobalModulesList.FreeModulesList(ModulesList); + end; +end; + +//=== Exception hooking ====================================================== + +var + TrackingActive: Boolean; + +procedure DoExceptNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean); +begin + if TrackingActive then + begin + if stStack in JclStackTrackingOptions then + DoExceptionStackTrace(ExceptObj, ExceptAddr, OSException); + if stExceptFrame in JclStackTrackingOptions then + DoExceptFrameTrace; + end; +end; + +function JclStartExceptionTracking: Boolean; +begin + if TrackingActive then + Result := False + else + begin + Result := JclHookExceptions and JclAddExceptNotifier(DoExceptNotify, npFirstChain); + TrackingActive := Result; + end; +end; + +function JclStopExceptionTracking: Boolean; +begin + if TrackingActive then + begin + Result := JclRemoveExceptNotifier(DoExceptNotify); + TrackingActive := False; + end + else + Result := False; +end; + +function JclExceptionTrackingActive: Boolean; +begin + Result := TrackingActive; +end; + +function JclTrackExceptionsFromLibraries: Boolean; +begin + Result := TrackingActive; + if Result then + JclInitializeLibrariesHookExcept; +end; + +//=== Thread exception tracking support ====================================== + +var + RegisteredThreadList: TJclDebugThreadList; + +function JclDebugThreadList: TJclDebugThreadList; +begin + if RegisteredThreadList = nil then + RegisteredThreadList := TJclDebugThreadList.Create; + Result := RegisteredThreadList; +end; + +//=== { TJclDebugThread } ==================================================== + +constructor TJclDebugThread.Create(Suspended: Boolean; const AThreadName: string); +begin + FThreadName := AThreadName; + inherited Create(True); + JclDebugThreadList.RegisterThread(Self, AThreadName); + if not Suspended then + Resume; +end; + +destructor TJclDebugThread.Destroy; +begin + JclDebugThreadList.UnregisterThread(Self); + inherited Destroy; +end; + +procedure TJclDebugThread.DoHandleException; +begin + GlobalStackList.LockThreadID(ThreadID); + try + DoSyncHandleException; + finally + GlobalStackList.UnlockThreadID; + end; +end; + +procedure TJclDebugThread.DoNotify; +begin + JclDebugThreadList.DoSyncException(Self); +end; + +procedure TJclDebugThread.DoSyncHandleException; +begin + // Note: JclLastExceptStackList and JclLastExceptFrameList returns information + // for this Thread ID instead of MainThread ID here to allow use a common + // exception handling routine easily. + // Any other call of those JclLastXXX routines from another thread at the same + // time will return expected information for current Thread ID. + DoNotify; +end; + +function TJclDebugThread.GetThreadInfo: string; +begin + Result := JclDebugThreadList.ThreadInfos[ThreadID]; +end; + +procedure TJclDebugThread.HandleException; +begin + FSyncException := Exception(ExceptObject); + try + if not (FSyncException is EAbort) then + Synchronize(DoHandleException); + finally + FSyncException := nil; + end; +end; + +//=== { TJclDebugThreadList } ================================================ + +type + TThreadAccess = class(TThread); + +constructor TJclDebugThreadList.Create; +begin + FLock := TJclCriticalSection.Create; + FReadLock := TJclCriticalSection.Create; + FList := TStringList.Create; +end; + +destructor TJclDebugThreadList.Destroy; +begin + FreeAndNil(FList); + FreeAndNil(FLock); + FreeAndNil(FReadLock); + inherited Destroy; +end; + +procedure TJclDebugThreadList.DoSyncException(Thread: TJclDebugThread); +begin + if Assigned(FOnSyncException) then + FOnSyncException(Thread); +end; + +procedure TJclDebugThreadList.DoSyncThreadRegistered; +begin + if Assigned(FOnThreadRegistered) then + FOnThreadRegistered(FRegSyncThreadID); +end; + +procedure TJclDebugThreadList.DoSyncThreadUnregistered; +begin + if Assigned(FOnThreadUnregistered) then + FOnThreadUnregistered(FUnregSyncThreadID); +end; + +procedure TJclDebugThreadList.DoThreadRegistered(Thread: TThread); +begin + if Assigned(FOnThreadRegistered) then + begin + FRegSyncThreadID := Thread.ThreadID; + TThreadAccess(Thread).Synchronize(DoSyncThreadRegistered); + end; +end; + +procedure TJclDebugThreadList.DoThreadUnregistered(Thread: TThread); +begin + if Assigned(FOnThreadUnregistered) then + begin + FUnregSyncThreadID := Thread.ThreadID; + TThreadAccess(Thread).Synchronize(DoSyncThreadUnregistered); + end; +end; + +function TJclDebugThreadList.GetThreadClassNames(ThreadID: DWORD): string; +begin + Result := GetThreadValues(ThreadID, 1); +end; + +function TJclDebugThreadList.GetThreadIDCount: Integer; +begin + FReadLock.Enter; + try + Result := FList.Count; + finally + FReadLock.Leave; + end; +end; + +function TJclDebugThreadList.GetThreadIDs(Index: Integer): DWORD; +begin + Result := DWORD(FList.Objects[Index]); +end; + +function TJclDebugThreadList.GetThreadInfos(ThreadID: DWORD): string; +begin + Result := GetThreadValues(ThreadID, 2); +end; + +function TJclDebugThreadList.GetThreadNames(ThreadID: DWORD): string; +begin + Result := GetThreadValues(ThreadID, 0); +end; + +function TJclDebugThreadList.GetThreadValues(ThreadID: DWORD; Index: Integer): string; +var + I: Integer; + + function ThreadName: string; + begin + Result := FList[I]; + Delete(Result, 1, Pos('=', Result)); + end; + +begin + FReadLock.Enter; + try + I := FList.IndexOfObject(Pointer(ThreadID)); + if I <> -1 then + begin + case Index of + 0: + Result := ThreadName; + 1: + Result := FList.Names[I]; + 2: + Result := Format('%.8x [%s] "%s"', [ThreadID, FList.Names[I], ThreadName]); + end; + end + else + Result := ''; + finally + FReadLock.Leave; + end; +end; + +procedure TJclDebugThreadList.InternalRegisterThread(Thread: TThread; const ThreadName: string); +var + I: Integer; + + function FormatInternalName: string; + begin + Result := Format('%s=%s', [Thread.ClassName, ThreadName]); + end; + +begin + FLock.Enter; + try + I := FList.IndexOfObject(Pointer(Thread.ThreadID)); + if I = -1 then + begin + FReadLock.Enter; + try + FList.AddObject(FormatInternalName, Pointer(Thread.ThreadID)); + finally + FReadLock.Leave; + end; + DoThreadRegistered(Thread); + end; + finally + FLock.Leave; + end; +end; + +procedure TJclDebugThreadList.InternalUnregisterThread(Thread: TThread); +var + I: Integer; +begin + FLock.Enter; + try + I := FList.IndexOfObject(Pointer(Thread.ThreadID)); + if I <> -1 then + begin + DoThreadUnregistered(Thread); + FReadLock.Enter; + try + FList.Delete(I); + finally + FReadLock.Leave; + end; + end; + finally + FLock.Leave; + end; +end; + +procedure TJclDebugThreadList.RegisterThread(Thread: TThread; const ThreadName: string); +begin + InternalRegisterThread(Thread, ThreadName); +end; + +procedure TJclDebugThreadList.UnregisterThread(Thread: TThread); +begin + InternalUnregisterThread(Thread); +end; + +//== Miscellanuous =========================================================== + +{$IFDEF MSWINDOWS} + +function EnableCrashOnCtrlScroll(const Enable: Boolean): Boolean; +const + CrashCtrlScrollKey = 'SYSTEM\CurrentControlSet\Services\i8042prt\Parameters'; + CrashCtrlScrollName = 'CrashOnCtrlScroll'; +var + Enabled: Integer; +begin + Enabled := 0; + if Enable then + Enabled := 1; + RegWriteInteger(HKEY_LOCAL_MACHINE, CrashCtrlScrollKey, CrashCtrlScrollName, Enabled); + Result := RegReadInteger(HKEY_LOCAL_MACHINE, CrashCtrlScrollKey, CrashCtrlScrollName) = Enabled; +end; + +function IsDebuggerAttached: Boolean; +var + IsDebuggerPresent: function: Boolean; stdcall; + KernelHandle: THandle; + P: Pointer; +begin + KernelHandle := GetModuleHandle(kernel32); + @IsDebuggerPresent := GetProcAddress(KernelHandle, 'IsDebuggerPresent'); + if @IsDebuggerPresent <> nil then + begin + // Win98+ / NT4+ + Result := IsDebuggerPresent + end + else + begin + // Win9x uses thunk pointer outside the module when under a debugger + P := GetProcAddress(KernelHandle, 'GetProcAddress'); + Result := DWORD(P) < KernelHandle; + end; +end; + +function IsHandleValid(Handle: THandle): Boolean; +var + Duplicate: THandle; + Flags: DWORD; +begin + if IsWinNT then + Result := GetHandleInformation(Handle, Flags) + else + Result := False; + if not Result then + begin + // DuplicateHandle is used as an additional check for those object types not + // supported by GetHandleInformation (e.g. according to the documentation, + // GetHandleInformation doesn't support window stations and desktop although + // tests show that it does). GetHandleInformation is tried first because its + // much faster. Additionally GetHandleInformation is only supported on NT... + Result := DuplicateHandle(GetCurrentProcess, Handle, GetCurrentProcess, + @Duplicate, 0, False, DUPLICATE_SAME_ACCESS); + if Result then + Result := CloseHandle(Duplicate); + end; +end; + +{$ENDIF MSWINDOWS} + +initialization + DebugInfoCritSect := TJclCriticalSection.Create; + GlobalModulesList := TJclGlobalModulesList.Create; + GlobalStackList := TJclGlobalStackList.Create; + +finalization + { TODO -oPV -cInvestigate : Calling JclStopExceptionTracking causes linking of various classes to + the code without a real need. Although there doesn't seem to be a way to unhook exceptions + safely because we need to be covered by JclHookExcept.Notifiers critical section } + JclStopExceptionTracking; + FreeAndNil(RegisteredThreadList); + FreeAndNil(DebugInfoList); + FreeAndNil(GlobalStackList); + FreeAndNil(GlobalModulesList); + FreeAndNil(DebugInfoCritSect); + +// History: + +// $Log: JclDebug.pas,v $ +// Revision 1.21 2005/12/26 18:03:58 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.20 2005/08/07 13:09:56 outchy +// Changed PByteArray to PJclByteArray to avoid RangeCheck exceptions. +// +// Revision 1.19 2005/06/05 09:53:34 uschuster +// improved TJclBinDebugScanner.Cache... (mantis #2952) +// +// Revision 1.18 2005/04/14 04:00:44 outchy +// IT2858: Linker bug is disabled in D2005 (conditionnal directives were wrong). +// +// Revision 1.17 2005/04/13 17:50:21 outchy +// IT2858: Linker bug in D2005 now disabled. +// +// Revision 1.16 2005/03/23 04:10:22 rrossmair +// - TJclMapParser fixed for BCB6 (by outchy) +// +// Revision 1.15 2005/03/08 16:10:09 marquardt +// standard char sets extended and used, some optimizations for string literals +// +// Revision 1.14 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.13 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.12 2004/10/21 08:40:10 marquardt +// style cleaning +// +// Revision 1.11 2004/10/17 21:00:14 mthoma +// cleaning +// +// Revision 1.10 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.9 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.8 2004/06/16 07:30:30 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.7 2004/06/14 11:05:52 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.6 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclDotNet.pas b/official/1.96/source/windows/JclDotNet.pas new file mode 100644 index 0000000..dc71cd0 --- /dev/null +++ b/official/1.96/source/windows/JclDotNet.pas @@ -0,0 +1,789 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ Microsoft .Net framework support routines and classes. } +{ } +{ Unit owner: Flier Lu } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/12 21:54:10 $ +// For history see end of file + +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} + +uses + {$IFDEF MSWINDOWS} + Windows, ActiveX, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + {$IFDEF RTL130_UP} + Contnrs, + {$ENDIF RTL130_UP} + JclBase, + mscoree_TLB, mscorlib_TLB; + +{ TODO -cDOC : Original code: "Flier Lu" } + +type + TJclClrBase = TInterfacedObject; + +type + IJclClrAppDomain = mscorlib_TLB._AppDomain; + IJclClrEvidence = mscorlib_TLB._Evidence; + IJclClrAssembly = mscorlib_TLB._Assembly; + IJclClrMethod = mscorlib_TLB._MethodInfo; + +type + TJclClrHostFlavor = (hfServer, hfWorkStation); + + TJclClrHostLoaderFlag = + (hlOptSingleDomain, + hlOptMultiDomain, + hlOptMultiDomainHost, + hlSafeMode, + hlSetPreference); + TJclClrHostLoaderFlags = set of TJclClrHostLoaderFlag; + +type + 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: IJclClrAppDomain; + function GetCurrentAppDomain: IJclClrAppDomain; + 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: IJclClrEvidence = nil): TJclClrAppDomain; + function FindAppDomain(const Intf: IJclClrAppDomain; 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; + property DefaultInterface: ICorRuntimeHost read FDefaultInterface implements ICorRuntimeHost; + property AppDomains[const Idx: Integer]: TJclClrAppDomain read GetAppDomain; default; + property AppDomainCount: Integer read GetAppDomainCount; + property DefaultAppDomain: IJclClrAppDomain read GetDefaultAppDomain; + property CurrentAppDomain: IJclClrAppDomain read GetCurrentAppDomain; + end; + + TJclClrAssemblyArguments = array of WideString; + + TJclClrAppDomain = class(TJclClrBase, IJclClrAppDomain) + private + FHost: TJclClrHost; + FDefaultInterface: IJclClrAppDomain; + protected + constructor Create(const AHost: TJclClrHost; const AAppDomain: IJclClrAppDomain); + public + function Load(const AssemblyString: WideString; + const AssemblySecurity: IJclClrEvidence = nil): TJclClrAssembly; overload; + function Load(const RawAssemblyStream: TStream; + const RawSymbolStoreStream: TStream = nil; + const AssemblySecurity: IJclClrEvidence = nil): TJclClrAssembly; overload; + function Execute(const AssemblyFile: TFileName; + const AssemblySecurity: IJclClrEvidence = nil): Integer; overload; + function Execute(const AssemblyFile: TFileName; + const Arguments: TJclClrAssemblyArguments; + const AssemblySecurity: IJclClrEvidence = nil): Integer; overload; + function Execute(const AssemblyFile: TFileName; + const Arguments: TStrings; + const AssemblySecurity: IJclClrEvidence = nil): Integer; overload; + procedure Unload; + property Host: TJclClrHost read FHost; + property DefaultInterface: IJclClrAppDomain read FDefaultInterface implements IJclClrAppDomain; + 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); + protected + constructor Create(Intf: IAppDomainSetup); + public + property DefaultInterface: IAppDomainSetup read FDefaultInterface implements 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; + end; + + TJclClrAssembly = class(TJclClrBase, IJclClrAssembly) + private + FDefaultInterface: IJclClrAssembly; + protected + constructor Create(Intf: IJclClrAssembly); + public + property DefaultInterface: IJclClrAssembly read FDefaultInterface implements IJclClrAssembly; + end; + +type + TJclClrField = class(TObject) + end; + + TJclClrProperty = class(TObject) + end; + + TJclClrMethod = class(TJclClrBase, IJclClrMethod) + private + FDefaultInterface: IJclClrMethod; + public + property DefaultInterface: IJclClrMethod read FDefaultInterface implements IJclClrMethod; + end; + + TJclClrObject = class(TObject) + private + function GetMethod(const Name: WideString): TJclClrMethod; + function GetField(const Name: WideString): TJclClrField; + function GetProperty(const Name: WideString): TJclClrProperty; + protected + 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; + public + 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; + +type + HDOMAINENUM = Pointer; + +function GetCORSystemDirectory(pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; +function GetCORVersion(pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; +function GetCORRequiredVersion(pbuffer: PWideChar; const cchBuffer: DWORD; + var dwLength: DWORD): HRESULT; stdcall; +function CorBindToRuntimeHost(pwszVersion, pwszBuildFlavor, pwszHostConfigFile: PWideChar; + const pReserved: Pointer; const startupFlags: DWORD; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; stdcall; +function CorBindToRuntimeEx(pwszVersion, pwszBuildFlavor: PWideChar; startupFlags: DWORD; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; stdcall; +function CorBindToRuntimeByCfg(const pCfgStream: IStream; const reserved, startupFlags: DWORD; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; stdcall; +function CorBindToRuntime(pwszVersion, pwszBuildFlavor: PWideChar; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; stdcall; +function CorBindToCurrentRuntime(pwszFileName: PWideChar; + const rclsid: TCLSID; const riid: TIID; out pv): HRESULT; stdcall; +function ClrCreateManagedInstance(pTypeName: PWideChar; + const riid: TIID; out pv): HRESULT; stdcall; +procedure CorMarkThreadInThreadPool; stdcall; +function RunDll32ShimW(const hwnd: THandle; const hinst: HMODULE; + lpszCmdLine: PWideChar; const nCmdShow: Integer): HRESULT; stdcall; +function LoadLibraryShim(szDllName, szVersion: PWideChar; + const pvReserved: Pointer; out phModDll: HMODULE): HRESULT; stdcall; +function CallFunctionShim(szDllName: PWideChar; const szFunctionName: PChar; + const lpvArgument1, lpvArgument2: Pointer; szVersion: PWideChar; + const pvReserved: Pointer): HRESULT; stdcall; +function GetRealProcAddress(const pwszProcName: PChar; out ppv: Pointer): HRESULT; stdcall; +procedure CorExitProcess(const exitCode: Integer); stdcall; + +implementation + +uses + ComObj, Variants, Provider, + JclSysUtils; + +const + mscoree_dll = 'mscoree.dll'; + +function GetCORSystemDirectory; external mscoree_dll; +function GetCORVersion; external mscoree_dll; +function GetCORRequiredVersion; external mscoree_dll; +function CorBindToRuntimeHost; external mscoree_dll; +function CorBindToRuntimeEx; external mscoree_dll; +function CorBindToRuntimeByCfg; external mscoree_dll; +function CorBindToRuntime; external mscoree_dll; +function CorBindToCurrentRuntime; external mscoree_dll; +function ClrCreateManagedInstance; external mscoree_dll; +procedure CorMarkThreadInThreadPool; external mscoree_dll; +function RunDll32ShimW; external mscoree_dll; +function LoadLibraryShim; external mscoree_dll; +function CallFunctionShim; external mscoree_dll; +function GetRealProcAddress; external mscoree_dll; +procedure CorExitProcess; external mscoree_dll; + +//=== { TJclClrHost } ======================================================== + +const + CLR_MAJOR_VERSION = 1; + CLR_MINOR_VERSION = 0; + CLR_BUILD_VERSION = 3705; + + 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; + +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 IJclClrAppDomain); + finally + OleCheck(FDefaultInterface.CloseEnum(hEnum)); + end; +end; + +function TJclClrHost.FindAppDomain(const Intf: IJclClrAppDomain; + 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: IJclClrAppDomain; +var + Unk: IUnknown; +begin + OleCheck(FDefaultInterface.GetDefaultDomain(Unk)); + Result := Unk as IJclClrAppDomain; +end; + +function TJclClrHost.GetCurrentAppDomain: IJclClrAppDomain; +var + Unk: IUnknown; +begin + OleCheck(FDefaultInterface.CurrentDomain(Unk)); + Result := Unk as IJclClrAppDomain; +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); + OleCheck(GetCORSystemDirectory(PWideChar(Result), Length(Result), Len)); + SetLength(Result, Len); +end; + +class function TJclClrHost.CorVersion: WideString; +var + Len: DWORD; +begin + SetLength(Result, 64); + OleCheck(GetCORVersion(PWideChar(Result), Length(Result), Len)); + SetLength(Result, Len); +end; + +class function TJclClrHost.CorRequiredVersion: WideString; +var + Len: DWORD; +begin + SetLength(Result, 64); + OleCheck(GetCORRequiredVersion(PWideChar(Result), Length(Result), Len)); + SetLength(Result, Len); +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: IJclClrEvidence): TJclClrAppDomain; +var + pUnk: IUnknown; +begin + OleCheck(FDefaultInterface.CreateDomainEx(PWideChar(Name), Setup as IAppDomainSetup, Evidence, pUnk)); + Result := TJclClrAppDomain.Create(Self, pUnk as IJclClrAppDomain); +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: IJclClrAppDomain); +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: IJclClrEvidence): Integer; +var + Args: Variant; +begin + Assert(FileExists(AssemblyFile)); + if Length(Arguments) = 0 then + Result := Execute(AssemblyFile, AssemblySecurity) + else + begin + 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: IJclClrEvidence): 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: IJclClrEvidence): Integer; +var + Args: Variant; +begin + Assert(FileExists(AssemblyFile)); + if Arguments.Count = 0 then + Result := Execute(AssemblyFile, AssemblySecurity) + else + begin + Args := VarArrayFromStrings(Arguments); + Result := DefaultInterface.ExecuteAssembly_3(AssemblyFile, AssemblySecurity, PSafeArray(TVarData(Args).VArray)); + end; +end; + +function TJclClrAppDomain.Load(const AssemblyString: WideString; + const AssemblySecurity: IJclClrEvidence): 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: IJclClrEvidence): 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)); + 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: IJclClrAssembly); +begin + Assert(Assigned(Intf)); + inherited Create; + FDefaultInterface := Intf; +end; + +// History: + +// $Log: JclDotNet.pas,v $ +// Revision 1.14 2005/12/12 21:54:10 outchy +// HWND changed to THandle (linking problems with BCB). +// +// Revision 1.13 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.12 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.11 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.10 2004/10/17 21:00:14 mthoma +// cleaning +// +// Revision 1.9 2004/08/09 06:38:08 marquardt +// add JvWStrUtils.pas as JclWideStrings.pas +// +// Revision 1.8 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.7 2004/06/14 13:05:21 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.6 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclHookExcept.pas b/official/1.96/source/windows/JclHookExcept.pas new file mode 100644 index 0000000..0500ecb --- /dev/null +++ b/official/1.96/source/windows/JclHookExcept.pas @@ -0,0 +1,575 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ Exception hooking routines } +{ } +{ Unit owner: Petr Vones } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/02/25 07:20:15 $ +// For history see end of file + +unit JclHookExcept; + +interface + +{$I jcl.inc} + +uses + Windows, SysUtils; + +type + // Exception hooking notifiers routines + TJclExceptNotifyProc = procedure(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean); + TJclExceptNotifyMethod = procedure(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean) of object; + + TJclExceptNotifyPriority = (npNormal, npFirstChain); + +function JclAddExceptNotifier(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority = npNormal): Boolean; overload; +function JclAddExceptNotifier(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority = npNormal): Boolean; overload; + +function JclRemoveExceptNotifier(const NotifyProc: TJclExceptNotifyProc): 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 JclUnkookExceptionsInModule(Module: HMODULE): Boolean; + +// Exceptions hooking in libraries +type + TJclModuleArray = array of HMODULE; + +function JclInitializeLibrariesHookExcept: Boolean; +function JclHookedExceptModulesList(var ModulesList: TJclModuleArray): Boolean; + +// Hooking routines location info helper +function JclBelongsHookedCode(Addr: Pointer): Boolean; + +implementation + +uses + Classes, + JclBase, JclPeImage, JclSysInfo, JclSysUtils; + +type + PExceptionArguments = ^TExceptionArguments; + TExceptionArguments = record + ExceptAddr: Pointer; + ExceptObj: Exception; + end; + + TNotifierItem = class(TObject) + private + FNotifyMethod: TJclExceptNotifyMethod; + FNotifyProc: TJclExceptNotifyProc; + FPriority: TJclExceptNotifyPriority; + public + constructor Create(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority); overload; + constructor Create(const NotifyMethod: TJclExceptNotifyMethod; Priority: TJclExceptNotifyPriority); overload; + procedure DoNotify(ExceptObj: TObject; ExceptAddr: Pointer; OSException: Boolean); + property Priority: TJclExceptNotifyPriority read FPriority; + end; + +var + ExceptionsHooked: Boolean; + Kernel32_RaiseException: procedure (dwExceptionCode, dwExceptionFlags, + nNumberOfArguments: DWORD; lpArguments: PDWORD); stdcall; + SysUtils_ExceptObjProc: function (P: PExceptionRecord): Exception; + Notifiers: TThreadList; + +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(var ModulesList: TJclModuleArray); + procedure UnhookModule(Module: HMODULE); + end; + +var + HookExceptModuleList: TJclHookExceptModuleList; + JclHookExceptDebugHook: Pointer; + +{$IFDEF HOOK_DLL_EXCEPTIONS} +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 FreeNotifiers; +var + I: Integer; +begin + with Notifiers.LockList do + try + for I := 0 to Count - 1 do + TObject(Items[I]).Free; + finally + Notifiers.UnlockList; + end; + FreeAndNil(Notifiers); +end; + +//=== { TNotifierItem } ====================================================== + +constructor TNotifierItem.Create(const NotifyProc: TJclExceptNotifyProc; Priority: TJclExceptNotifyPriority); +begin + inherited Create; + FNotifyProc := 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); +begin + if Assigned(FNotifyProc) then + FNotifyProc(ExceptObj, ExceptAddr, OSException) + else + if Assigned(FNotifyMethod) then + FNotifyMethod(ExceptObj, ExceptAddr, OSException); +end; + +{$STACKFRAMES ON} + +procedure DoExceptNotify(ExceptObj: Exception; ExceptAddr: Pointer; OSException: Boolean); +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 + 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); + finally + Notifiers.UnlockList; + end; + finally + Recursive := False; + end; + end; +end; + +procedure HookedRaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments: DWORD; + Arguments: PExceptionArguments); stdcall; +const + {$IFDEF DELPHI2} + cDelphiException = $0EEDFACE; + {$ELSE} + cDelphiException = $0EEDFADE; + {$ENDIF DELPHI2} + cNonContinuable = 1; +begin + if (ExceptionFlags = cNonContinuable) and (ExceptionCode = cDelphiException) and + (NumberOfArguments = 7) and (DWORD(Arguments) = DWORD(@Arguments) + 4) then + DoExceptNotify(Arguments.ExceptObj, Arguments.ExceptAddr, False); + Kernel32_RaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments, PDWORD(Arguments)); +end; + +function HookedExceptObjProc(P: PExceptionRecord): Exception; +var + NewResultExcCache: Exception; // TLS optimization +begin + Result := SysUtils_ExceptObjProc(P); + DoExceptNotify(Result, P^.ExceptionAddress, True); + NewResultExcCache := NewResultExc; + if NewResultExcCache <> nil then + Result := NewResultExcCache; +end; + +{$IFNDEF STACKFRAMES_ON} +{$STACKFRAMES OFF} +{$ENDIF ~STACKFRAMES_ON} + +// Do not change ordering of HookedRaiseException, HookedExceptObjProc and JclBelongsHookedCode routines + +function JclBelongsHookedCode(Addr: Pointer): Boolean; +begin + Result := (Cardinal(@HookedRaiseException) < Cardinal(@JclBelongsHookedCode)) and + (Cardinal(@HookedRaiseException) <= Cardinal(Addr)) and + (Cardinal(@JclBelongsHookedCode) > Cardinal(Addr)); +end; + +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 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; + +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 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; + +function JclHookExceptions: Boolean; +var + RaiseExceptionAddressCache: Pointer; +begin + if not ExceptionsHooked then + begin + Recursive := False; + RaiseExceptionAddressCache := RaiseExceptionAddress; + with TJclPeMapImgHooks do + Result := ReplaceImport(SystemBase, kernel32, RaiseExceptionAddressCache, @HookedRaiseException); + if Result then + begin + @Kernel32_RaiseException := RaiseExceptionAddressCache; + SysUtils_ExceptObjProc := System.ExceptObjProc; + System.ExceptObjProc := @HookedExceptObjProc; + end; + ExceptionsHooked := Result; + end + else + Result := True; +end; + +function JclUnhookExceptions: Boolean; +begin + if ExceptionsHooked then + begin + with TJclPeMapImgHooks do + ReplaceImport(SystemBase, kernel32, @HookedRaiseException, @Kernel32_RaiseException); + System.ExceptObjProc := @SysUtils_ExceptObjProc; + @SysUtils_ExceptObjProc := nil; + @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 JclUnkookExceptionsInModule(Module: HMODULE): Boolean; +begin + Result := ExceptionsHooked and + TJclPeMapImgHooks.ReplaceImport(Pointer(Module), kernel32, @HookedRaiseException, @Kernel32_RaiseException); +end; + +// 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; + +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(var ModulesList: TJclModuleArray): Boolean; +begin + {$IFDEF HOOK_DLL_EXCEPTIONS} + Result := Assigned(HookExceptModuleList); + if Result then + HookExceptModuleList.List(ModulesList); + {$ELSE HOOK_DLL_EXCEPTIONS} + Result := False; + {$ENDIF HOOK_DLL_EXCEPTIONS} +end; + +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(var 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; + +initialization + Notifiers := TThreadList.Create; + +finalization + {$IFDEF HOOK_DLL_EXCEPTIONS} + FinalizeLibrariesHookExcept; + {$ENDIF HOOK_DLL_EXCEPTIONS} + FreeNotifiers; + +// History: + +// $Log: JclHookExcept.pas,v $ +// Revision 1.10 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.9 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.8 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.7 2004/08/02 15:30:17 marquardt +// hunting down (rom) comments +// +// Revision 1.6 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.5 2004/06/16 07:30:30 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.4 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.3 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclLANMan.pas b/official/1.96/source/windows/JclLANMan.pas new file mode 100644 index 0000000..5c14405 --- /dev/null +++ b/official/1.96/source/windows/JclLANMan.pas @@ -0,0 +1,464 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/02/25 07:20:15 $ +// For history see end of file + + +// 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} + +interface + +uses + Windows, SysUtils, Classes; + +// 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; var Domain, UserName: string); +function IsLocalAccount(const AccountName: string): Boolean; + +implementation + +uses + JclBase, JclStrings, 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; + + FillChar(Details, SizeOf(Details), #0); + 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; + + FillChar(Details, SizeOf(Details), #0); + 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; + + FillChar(Details, SizeOf(Details), #0); + 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: SID_IDENTIFIER_AUTHORITY; + rd1, rd2: DWORD; + ridCount: Integer; + sd: PSID; + AccountNameLen, DomainNameLen: DWORD; + SidNameUse: SID_NAME_USE; +begin + Result := ''; + 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; + if AllocateAndInitializeSid(sia, ridCount, rd1, rd2, 0, 0, 0, 0, 0, 0, sd) then + try + AccountNameLen := 0; + DomainNameLen := 0; + if not LookupAccountSID(PChar(Server), sd, PChar(Result), AccountNameLen, + nil, DomainNameLen, SidNameUse) then + SetLength(Result, AccountNamelen); + + if LookupAccountSID(PChar(Server), sd, PChar(Result), AccountNameLen, + nil, DomainNameLen, sidNameUse) then + StrResetLength(Result) + else + RaiseLastOSError; + finally + FreeSID(sd); + end; +end; + +procedure ParseAccountName(const QualifiedName: string; var 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; + +// History: + +// $Log: JclLANMan.pas,v $ +// Revision 1.12 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.11 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.10 2005/02/06 07:45:42 marquardt +// fixed non-compiling IsLocalAccount +// +// Revision 1.9 2005/02/06 03:36:50 mthoma +// Added feature [Code Library 0000805]: IsLocalAccount does not work with names like serveruser. +// +// Revision 1.8 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.7 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.6 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclLocales.pas b/official/1.96/source/windows/JclLocales.pas new file mode 100644 index 0000000..10b3b6e --- /dev/null +++ b/official/1.96/source/windows/JclLocales.pas @@ -0,0 +1,1082 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{ Unit owner: Petr Vones } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/26 18:03:58 $ +// For history see end of file + +unit JclLocales; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + {$IFDEF FPC} + JwaWinNLS, + {$ENDIF FPC} + Windows, Classes, SysUtils, Contnrs, + 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 AdditionalCaledarTypes: 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: Integer): TJclLocaleInfo; + function GetCodePages: TStrings; + protected + procedure CreateList; + public + constructor Create(AKind: TJclLocalesKind = lkInstalled); + destructor Destroy; override; + procedure FillStrings(Strings: 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: Integer]: 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); + +implementation + +uses + {$IFDEF FPC} + WinSysUt, + {$ENDIF FPC} + SysConst, JclFileUtils, JclRegistry, JclStrings, JclSysInfo; + +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 IsWin2K then + 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: PChar; 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.RtdlEnumCalendarInfoExA(EnumCalendarInfoProcEx, FLocaleID, ENUM_ALL_CALENDARS, C) then + 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 TJclLocaleInfo.GetDateFormats(Format: TJclLocaleDateFormats): TStrings; +const + DateFormats: array [TJclLocaleDateFormats] of DWORD = + (DATE_SHORTDATE, DATE_LONGDATE, DATE_YEARMONTH); + + function EnumDateFormatsProc(lpDateFormatString: LPSTR): BOOL; stdcall; + begin + ProcessedLocaleInfoList.Add(lpDateFormatString); + DWORD(Result) := 1; + end; + +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 + Windows.EnumDateFormats(@EnumDateFormatsProc, FLocaleID, DateFormats[Format] or + LocaleUseAcp[FUseSystemACP]); + Include(FValidDateFormatLists, Format); + finally + ProcessedLocaleInfoList := nil; + end; + end; + Result := FDateFormats[Format]; +end; + +function TJclLocaleInfo.GetFontCharset: Byte; +type + TCharsetEntry = record + CodePage: Word; + Charset: Byte; + end; +const + CharsetTable: array [1..10] of TCharsetEntry = + ( + (CodePage: 1252; Charset: ANSI_CHARSET), + (CodePage: 1250; Charset: EASTEUROPE_CHARSET), + (CodePage: 1251; Charset: RUSSIAN_CHARSET), + (CodePage: 1253; Charset: GREEK_CHARSET), + (CodePage: 1254; Charset: TURKISH_CHARSET), + (CodePage: 1255; Charset: HEBREW_CHARSET), + (CodePage: 1256; Charset: ARABIC_CHARSET), + (CodePage: 1257; Charset: BALTIC_CHARSET), + (CodePage: 874; Charset: THAI_CHARSET), + (CodePage: 932; Charset: SHIFTJIS_CHARSET) + ); +var + I, CpANSI: Integer; +begin + Result := DEFAULT_CHARSET; + CpANSI := CodePageANSI; + for I := Low(CharsetTable) to High(CharsetTable) do + if CharsetTable[I].CodePage = CpANSI then + begin + Result := CharsetTable[I].Charset; + Break; + end; +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 := Windows.GetLocaleInfoA(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 := Windows.GetLocaleInfoW(FLocaleID, InfoType, W, Res); + Result := WideCharToString(W); + FreeMem(W); + end; + end; + if Res = 0 then + Result := ''; +end; + +function TJclLocaleInfo.GetTimeFormats: TStrings; + + function EnumTimeFormatsProc(lpTimeFormatString: LPSTR): BOOL; stdcall; + begin + ProcessedLocaleInfoList.Add(lpTimeFormatString); + DWORD(Result) := 1; + end; + +begin + if not FValidTimeFormatLists then + begin + if FTimeFormats = nil then + FTimeFormats := TStringList.Create + else + FTimeFormats.Clear; + ProcessedLocaleInfoList := FTimeFormats; + try + Windows.EnumTimeFormats(@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(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; + +procedure TJclLocalesList.CreateList; +const + Flags: array [TJclLocalesKind] of DWORD = (LCID_INSTALLED, LCID_SUPPORTED); + + function EnumLocalesProc(lpLocaleString: LPSTR): 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: LPSTR): BOOL; stdcall; + begin + ProcessedLocalesList.CodePages.AddObject(lpCodePageString, Pointer(StrToIntDef(lpCodePageString, 0))); + DWORD(Result) := 1; + end; + +begin + ProcessedLocalesList := Self; + try + Win32Check(Windows.EnumSystemLocales(@EnumLocalesProc, Flags[FKind])); + Win32Check(Windows.EnumSystemCodePages(@EnumCodePagesProc, Flags[FKind])); + finally + ProcessedLocalesList := nil; + end; +end; + +procedure TJclLocalesList.FillStrings(Strings: TStrings; InfoType: Integer); +var + I: Integer; +begin + Strings.BeginUpdate; + try + for I := 0 to Count - 1 do + with Items[I] do + Strings.AddObject(StringInfo[InfoType], Pointer(LocaleId)); + finally + Strings.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: Integer): 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 := 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 + Cnt := 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; + +// History: + +// $Log: JclLocales.pas,v $ +// Revision 1.16 2005/12/26 18:03:58 outchy +// Enhanced bds support (including C#1 and D8) +// Introduction of dll experts +// Project types in templates +// +// Revision 1.15 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.14 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.13 2005/02/06 03:37:52 mthoma +// Fixed [Code Library 0002479]: Wrong parameter count in callback function +// +// Revision 1.12 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.11 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.10 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.9 2004/07/29 07:58:21 marquardt +// inc files updated +// +// Revision 1.8 2004/06/14 11:05:52 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.7 2004/05/13 07:46:06 rrossmair +// changes for FPC 1.9.3+ compatibility +// +// Revision 1.6 2004/05/06 05:09:55 rrossmair +// Changes for FPC v1.9.4 compatibility +// +// Revision 1.5 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.4 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclMapi.pas b/official/1.96/source/windows/JclMapi.pas new file mode 100644 index 0000000..bb4ef01 --- /dev/null +++ b/official/1.96/source/windows/JclMapi.pas @@ -0,0 +1,1325 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ Various classes and support routines for sending e-mail through Simple MAPI } +{ } +{ Unit owner: Petr Vones } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/12/12 21:54:10 $ +// For history see end of file + +unit JclMapi; + +{$I jcl.inc} + +interface + +uses + Windows, Classes, Contnrs, Mapi, SysUtils, + JclBase; + +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: string; + FFunctions: array[0..11] of ^Pointer; + FMapiInstalled: Boolean; + FMapiVersion: string; + FProfiles: array of string; + 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): string; + 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: string read FDefaultProfileName; + property MapiInstalled: Boolean read FMapiInstalled; + property MapiVersion: string read FMapiVersion; + property ProfileCount: Integer read GetProfileCount; + property Profiles[Index: Integer]: string 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: string; + FAddressType: string; + FKind: TJclEmailRecipKind; + FName: string; + protected + function SortingName: string; + public + function AddressAndName: string; + class function RecipKindToString(const AKind: TJclEmailRecipKind): string; + property AddressType: string read FAddressType write FAddressType; + property Address: string read FAddress write FAddress; + property Kind: TJclEmailRecipKind read FKind write FKind; + property Name: string read FName write FName; + end; + + TJclEmailRecips = class(TObjectList) + private + FAddressesType: string; + function GetItems(Index: Integer): TJclEmailRecip; + function GetOriginator: TJclEmailRecip; + public + function Add(const Address: string; + const Name: string = ''; + const Kind: TJclEmailRecipKind = rkTO; + const AddressType: string = ''): Integer; + procedure SortRecips; + property AddressesType: string read FAddressesType write FAddressesType; + property Items[Index: Integer]: 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: string; + DateReceived: TDateTime; + MessageType: string; + Flags: FLAGS; + end; + + TJclTaskWindowsList = array of THandle; + + TJclEmail = class(TJclSimpleMapi) + private + FAttachments: TStringList; + FBody: string; + FFindOptions: TJclEmailFindOptions; + FHtmlBody: Boolean; + FLogonOptions: TJclEmailLogonOptions; + FParentWnd: THandle; + FParentWndValid: Boolean; + FReadMsg: TJclEmailReadMsg; + FRecipients: TJclEmailRecips; + FSeedMessageID: string; + FSessionHandle: THandle; + FSubject: string; + FTaskWindowList: TJclTaskWindowsList; + function GetAttachments: TStrings; + function GetParentWnd: THandle; + function GetUserLogged: Boolean; + procedure SetBody(const Value: string); + 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: string = ''; EditFields: Integer = 3): Boolean; + procedure Clear; + function Delete(const MessageID: string): Boolean; + function FindFirstMessage: Boolean; + function FindNextMessage: Boolean; + procedure LogOff; + procedure LogOn(const ProfileName: string = ''; const Password: string = ''); + function MessageReport(Strings: TStrings; MaxWidth: Integer = 80; IncludeAddresses: Boolean = False): Integer; + function Read(const Options: TJclEmailReadOptions = []): Boolean; + function ResolveName(var Name, Address: string; ShowDialog: Boolean = False): Boolean; + procedure RestoreTaskWindows; + function Save: Boolean; + procedure SaveTaskWindows; + function Send(ShowDialog: Boolean = True): Boolean; + procedure SortAttachments; + property Attachments: TStrings read GetAttachments; + property Body: string 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: string read FSeedMessageID write FSeedMessageID; + property SessionHandle: THandle read FSessionHandle; + property Subject: string read FSubject write FSubject; + property UserLogged: Boolean read GetUserLogged; + end; + +// Simple email send function +function JclSimpleSendMail(const Recipient, Name, Subject, Body: string; + const Attachment: string = ''; ShowDialog: Boolean = True; ParentWND: THandle = 0; + const ProfileName: string = ''; const Password: string = ''): Boolean; + +function JclSimpleSendFax(const Recipient, Name, Subject, Body: string; + const Attachment: string = ''; ShowDialog: Boolean = True; ParentWND: THandle = 0; + const ProfileName: string = ''; const Password: string = ''): Boolean; + +function JclSimpleBringUpSendMailDialog(const Subject, Body: string; + const Attachment: string = ''; ParentWND: THandle = 0; + const ProfileName: string = ''; const Password: string = ''): Boolean; + +// MAPI Errors +function MapiCheck(const Res: DWORD; IgnoreUserAbort: Boolean = True): DWORD; + +function MapiErrorMessage(const ErrorCode: DWORD): string; + +implementation + +uses + JclFileUtils, JclLogic, JclRegistry, JclResources, JclStrings, 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 = ':'; + +//=== 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 := RsMapiErrUSER_ABORT; + MAPI_E_FAILURE: + Result := RsMapiErrFAILURE; + MAPI_E_LOGIN_FAILURE: + Result := RsMapiErrLOGIN_FAILURE; + MAPI_E_DISK_FULL: + Result := RsMapiErrDISK_FULL; + MAPI_E_INSUFFICIENT_MEMORY: + Result := RsMapiErrINSUFFICIENT_MEMORY; + MAPI_E_ACCESS_DENIED: + Result := RsMapiErrACCESS_DENIED; + MAPI_E_TOO_MANY_SESSIONS: + Result := RsMapiErrTOO_MANY_SESSIONS; + MAPI_E_TOO_MANY_FILES: + Result := RsMapiErrTOO_MANY_FILES; + MAPI_E_TOO_MANY_RECIPIENTS: + Result := RsMapiErrTOO_MANY_RECIPIENTS; + MAPI_E_ATTACHMENT_NOT_FOUND: + Result := RsMapiErrATTACHMENT_NOT_FOUND; + MAPI_E_ATTACHMENT_OPEN_FAILURE: + Result := RsMapiErrATTACHMENT_OPEN_FAILURE; + MAPI_E_ATTACHMENT_WRITE_FAILURE: + Result := RsMapiErrATTACHMENT_WRITE_FAILURE; + MAPI_E_UNKNOWN_RECIPIENT: + Result := RsMapiErrUNKNOWN_RECIPIENT; + MAPI_E_BAD_RECIPTYPE: + Result := RsMapiErrBAD_RECIPTYPE; + MAPI_E_NO_MESSAGES: + Result := RsMapiErrNO_MESSAGES; + MAPI_E_INVALID_MESSAGE: + Result := RsMapiErrINVALID_MESSAGE; + MAPI_E_TEXT_TOO_LARGE: + Result := RsMapiErrTEXT_TOO_LARGE; + MAPI_E_INVALID_SESSION: + Result := RsMapiErrINVALID_SESSION; + MAPI_E_TYPE_NOT_SUPPORTED: + Result := RsMapiErrTYPE_NOT_SUPPORTED; + MAPI_E_AMBIGUOUS_RECIPIENT: + Result := RsMapiErrAMBIGUOUS_RECIPIENT; + MAPI_E_MESSAGE_IN_USE: + Result := RsMapiErrMESSAGE_IN_USE; + MAPI_E_NETWORK_FAILURE: + Result := RsMapiErrNETWORK_FAILURE; + MAPI_E_INVALID_EDITFIELDS: + Result := RsMapiErrINVALID_EDITFIELDS; + MAPI_E_INVALID_RECIPS: + Result := RsMapiErrINVALID_RECIPS; + MAPI_E_NOT_SUPPORTED: + Result := RsMapiErrNOT_SUPPORTED; + else + Result := ''; + end; +end; + +procedure RestoreTaskWindowsList(const List: TJclTaskWindowsList); +var + I: Integer; + + 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; + +begin + if Length(List) > 0 then + begin + EnumThreadWindows(MainThreadID, @RestoreTaskWnds, Integer(List)); + for I := 0 to Length(List) - 1 do + EnableWindow(List[I], True); + SetFocus(List[0]); + end; +end; + +function SaveTaskWindowsList: TJclTaskWindowsList; + + 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; + +begin + SetLength(Result, 1); + Result[0] := GetFocus; + EnumThreadWindows(MainThreadID, @SaveTaskWnds, Integer(@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): string; +begin + CheckListIndex(Index, ProfileCount); + Result := FProfiles[Index]; +end; + +procedure TJclSimpleMapi.LoadClientLib; +var + I: Integer; + P: Pointer; +begin + if ClientLibLoaded then + Exit; + FClientLibHandle := LoadLibrary(PChar(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 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_LOCAL_MACHINE, MailClientsKey) then + begin + 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, 'DLLPath', ''); + ExpandEnvironmentVar(FClients[I].ClientPath); + 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 := RegReadStringDef(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] := 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: string; +var + N: string; +begin + if Name = '' then + N := Address + else + N := Name; + Result := Format('"%s" <%s>', [N, Address]); +end; + +class function TJclEmailRecip.RecipKindToString(const AKind: TJclEmailRecipKind): string; +const + Idents: array [TJclEmailRecipKind] of string = ( + RsMapiMailORIG, RsMapiMailTO, RsMapiMailCC, RsMapiMailBCC); +begin + case AKind of + rkOriginator: + Result := RsMapiMailORIG; + rkTO: + Result := RsMapiMailTO; + rkCC: + Result := RsMapiMailCC; + rkBCC: + Result := RsMapiMailBCC; + end; +end; + +function TJclEmailRecip.SortingName: string; +begin + if FName = '' then + Result := FAddress + else + Result := FName; +end; + +//=== { TJclEmailRecips } ==================================================== + +function TJclEmailRecips.Add(const Address, Name: string; + const Kind: TJclEmailRecipKind; const AddressType: string): Integer; +var + Item: TJclEmailRecip; +begin + Item := TJclEmailRecip.Create; + try + Item.Address := Trim(Address); + Item.AddressType := AddressType; + Item.Name := Name; + Item.Kind := Kind; + Result := inherited Add(Item); + except + Item.Free; + raise; + end; +end; + +function TJclEmailRecips.GetItems(Index: Integer): 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 := TStringList.Create; + FLogonOptions := [loLogonUI]; + FFindOptions := [foFifo]; + FRecipients := TJclEmailRecips.Create(True); + FRecipients.AddressesType := MapiAddressTypeSMTP; +end; + +destructor TJclEmail.Destroy; +begin + FreeAndNil(FAttachments); + FreeAndNil(FRecipients); + inherited Destroy; +end; + +function TJclEmail.Address(const Caption: string; EditFields: Integer): Boolean; +var + NewRecipCount: ULONG; + NewRecips: PMapiRecipDesc; + Recips: TMapiRecipDesc; + Res: DWORD; +begin + LoadClientLib; + NewRecips := nil; + NewRecipCount := 0; + Res := MapiAddress(FSessionHandle, ParentWnd, PChar(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; + Body := ''; + FSubject := ''; + Recipients.Clear; + FReadMsg.MessageType := ''; + FReadMsg.DateReceived := 0; + FReadMsg.ConversationID := ''; + FReadMsg.Flags := 0; +end; + +procedure TJclEmail.DecodeRecips(RecipDesc: PMapiRecipDesc; Count: Integer); +var + S: string; + 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 := lpszAddress; + N := Pos(AddressTypeDelimiter, S); + if N = 0 then + Recipients.Add(S, lpszName, Kind) + else + Recipients.Add(Copy(S, N + 1, Length(S)), lpszName, Kind, Copy(S, 1, N - 1)); + end; + Inc(RecipDesc); + end; +end; + +function TJclEmail.Delete(const MessageID: string): Boolean; +begin + LoadClientLib; + Result := MapiCheck(MapiDeleteMail(FSessionHandle, 0, PChar(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, PChar(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: TStrings; +begin + Result := FAttachments; +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); +var + AttachArray: array of TMapiFileDesc; + RecipArray: array of TMapiRecipDesc; + RealAdresses: array of string; + MapiMessage: TMapiMessage; + Flags, Res: DWORD; + I: Integer; + MsgID: array [0..512] of AnsiChar; + HtmlBodyFileName: string; +begin + if not AnyClientInstalled then + raise EJclMapiError.CreateRes(@RsMapiMailNoClient); + + HtmlBodyFileName := ''; + try + if FHtmlBody then + begin + HtmlBodyFileName := FindUnusedFileName(PathAddSeparator(GetWindowsTempFolder) + 'JclMapi', 'htm', 'Temp'); + Attachments.Insert(0, HtmlBodyFileName); + StringToFile(HtmlBodyFileName, Body); + end; + // Create attachments + if Attachments.Count > 0 then + begin + SetLength(AttachArray, Attachments.Count); + for I := 0 to Attachments.Count - 1 do + begin + if not FileExists(Attachments[I]) then + MapiCheck(MAPI_E_ATTACHMENT_NOT_FOUND, False); + Attachments[I] := ExpandFileName(Attachments[I]); + FillChar(AttachArray[I], SizeOf(TMapiFileDesc), #0); + AttachArray[I].nPosition := DWORD(-1); + AttachArray[I].lpszFileName := nil; + AttachArray[I].lpszPathName := PChar(Attachments[I]); + end; + end + else + AttachArray := nil; + // Create recipients + if Recipients.Count > 0 then + begin + SetLength(RecipArray, Recipients.Count); + SetLength(RealAdresses, Recipients.Count); + for I := 0 to Recipients.Count - 1 do + begin + FillChar(RecipArray[I], SizeOf(TMapiRecipDesc), #0); + with RecipArray[I], Recipients[I] do + begin + ulRecipClass := RecipClasses[Kind]; + if Name = '' then // some clients requires Name item always filled + begin + if FAddress = '' then + MapiCheck(MAPI_E_INVALID_RECIPS, False); + lpszName := PChar(FAddress); + end + else + lpszName := PChar(FName); + if FAddressType <> '' then + RealAdresses[I] := FAddressType + AddressTypeDelimiter + FAddress + else + if Recipients.AddressesType <> '' then + RealAdresses[I] := Recipients.AddressesType + AddressTypeDelimiter + FAddress + else + RealAdresses[I] := FAddress; + lpszAddress := PCharOrNil(RealAdresses[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 + FillChar(MapiMessage, SizeOf(MapiMessage), #0); + MapiMessage.lpszSubject := PChar(FSubject); + if FHtmlBody then + MapiMessage.lpszNoteText := #0 + else + MapiMessage.lpszNoteText := PChar(FBody); + MapiMessage.lpRecips := PMapiRecipDesc(RecipArray); + MapiMessage.nRecipCount := Length(RecipArray); + MapiMessage.lpFiles := PMapiFileDesc(AttachArray); + MapiMessage.nFileCount := Length(AttachArray); + Flags := LogonOptionsToFlags(ShowDialog); + if Save then + begin + StrPLCopy(MsgID, SeedMessageID, SizeOf(MsgID)); + Res := MapiSaveMail(FSessionHandle, ParentWND, MapiMessage, Flags, 0, MsgID); + if Res = SUCCESS_SUCCESS then + SeedMessageID := MsgID; + end + else + Res := MapiSendMail(FSessionHandle, ParentWND, MapiMessage, Flags, 0); + Result := (MapiCheck(Res, True) = SUCCESS_SUCCESS); + finally + if HtmlBodyFileName <> '' then + begin + DeleteFile(HtmlBodyFileName); + Attachments.Delete(0); + end; + 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: string); +begin + if not UserLogged then + begin + LoadClientLib; + MapiCheck(MapiLogOn(ParentWND, PChar(ProfileName), PChar(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 string; + ReportKind: TJclEmailRecipKind; + I, Cnt: Integer; + BreakStr, S: string; +begin + Cnt := Strings.Count; + LabelsWidth := Length(RsMapiMailSubject); + for ReportKind := Low(ReportKind) to High(ReportKind) do + begin + NamesList[ReportKind] := ''; + LabelsWidth := Max(LabelsWidth, Length(TJclEmailRecip.RecipKindToString(ReportKind))); + end; + BreakStr := AnsiCrLf + StringOfChar(' ', 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(S, BreakStr, [AnsiTab, AnsiSpace], MaxWidth)); + end; + S := RsMapiMailSubject + ': ' + Subject; + Strings.Add(WrapText(S, BreakStr, [AnsiTab, AnsiSpace], MaxWidth)); + Result := Strings.Count - Cnt; + Strings.Add(''); + Strings.Add(WrapText(Body, AnsiCrLf, [AnsiTab, AnsiSpace, '-'], MaxWidth)); + 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: string; Index, Count: Integer): Integer; + begin + Result := StrToIntDef(Copy(S, Index, Count), 0); + end; + + function MessageDateToDate(const S: string): TDateTime; + var + T: TSystemTime; + begin + FillChar(T, SizeOf(T), #0); + 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, PChar(FSeedMessageID), Flags, 0, Msg), True); + if Msg <> nil then + try + DecodeRecips(Msg^.lpOriginator, 1); + DecodeRecips(Msg^.lpRecips, Msg^.nRecipCount); + FSubject := Msg^.lpszSubject; + Body := AdjustLineBreaks(Msg^.lpszNoteText); + Files := Msg^.lpFiles; + if Files <> nil then + for I := 0 to Msg^.nFileCount - 1 do + begin + if Files^.lpszPathName <> nil then + Attachments.Add(Files^.lpszPathName) + else + Attachments.Add(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: string; ShowDialog: Boolean): Boolean; +var + Recip: PMapiRecipDesc; + Res, Flags: DWORD; +begin + LoadClientLib; + Flags := LogonOptionsToFlags(ShowDialog) or MAPI_AB_NOMODIFY; + Recip := nil; + Res := MapiResolveName(FSessionHandle, ParentWnd, PChar(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: string); +begin + if Value = '' then + FBody := '' + else + FBody := StrEnsureSuffix(AnsiCrLf, Value); +end; + +procedure TJclEmail.SetParentWnd(const Value: THandle); +begin + FParentWnd := Value; + FParentWndValid := True; +end; + +procedure TJclEmail.SortAttachments; +begin + FAttachments.Sort; +end; + +//=== Simple email send function ============================================= + +function SimpleSendHelper(const ARecipient, AName, ASubject, ABody: string; const AAttachment: string; + AShowDialog: Boolean; AParentWND: THandle; const AProfileName, APassword, AAddressType: string): Boolean; +begin + with TJclEmail.Create do + try + if AParentWND <> 0 then + ParentWnd := AParentWND; + if ARecipient <> '' then + Recipients.Add(ARecipient, AName, rkTO, AAddressType); + Subject := ASubject; + Body := ABody; + if AAttachment <> '' then + Attachments.Add(AAttachment); + if AProfileName <> '' then + LogOn(AProfileName, APassword); + Result := Send(AShowDialog); + finally + Free; + end; +end; + +function JclSimpleSendMail(const Recipient, Name, Subject, Body: string; + const Attachment: string; ShowDialog: Boolean; ParentWND: THandle; + const ProfileName: string; const Password: string): Boolean; +begin + Result := SimpleSendHelper(Recipient, Name, Subject, Body, Attachment, ShowDialog, ParentWND, + ProfileName, Password, MapiAddressTypeSMTP); +end; + +function JclSimpleSendFax(const Recipient, Name, Subject, Body: string; + const Attachment: string; ShowDialog: Boolean; ParentWND: THandle; + const ProfileName: string; const Password: string): Boolean; +begin + Result := SimpleSendHelper(Recipient, Name, Subject, Body, Attachment, ShowDialog, ParentWND, + ProfileName, Password, MapiAddressTypeFAX); +end; + +function JclSimpleBringUpSendMailDialog(const Subject, Body: string; + const Attachment: string; ParentWND: THandle; + const ProfileName: string; const Password: string): Boolean; +begin + Result := SimpleSendHelper('', '', Subject, Body, Attachment, True, ParentWND, + ProfileName, Password, MapiAddressTypeSMTP); +end; + +// History: + +// $Log: JclMapi.pas,v $ +// Revision 1.15 2005/12/12 21:54:10 outchy +// HWND changed to THandle (linking problems with BCB). +// +// Revision 1.14 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.13 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.12 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.11 2004/10/25 20:42:07 mthoma +// #0002255 +// +// Revision 1.10 2004/10/17 21:29:23 mthoma +// Used version rev 1.2 to remove all rev 1.3 contributions. +// +// Revision 1.9 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.8 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.7 2004/07/28 18:00:53 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.6 2004/06/16 07:30:30 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.5 2004/06/02 03:23:47 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.4 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.3 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclMetadata.pas b/official/1.96/source/windows/JclMetadata.pas new file mode 100644 index 0000000..ecf1b3f --- /dev/null +++ b/official/1.96/source/windows/JclMetadata.pas @@ -0,0 +1,4851 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{ Unit owner: Flier Lu } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/08/07 13:09:57 $ +// For history see end of file + +unit JclMetadata; + +{$I jcl.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, + {$IFDEF RTL130_UP} + Contnrs, + {$ENDIF RTL130_UP} + JclBase, JclClr, JclFileUtils, JclPeImage, 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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 + constructor Create(const ATable: TJclClrTable); override; + procedure SetParentToken(const ARow: TJclClrTableTypeDefRow); + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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 + constructor Create(const ATable: TJclClrTable); override; + procedure SetMethod(const AMethod: TJclClrTableMethodDefRow); + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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: Integer = 1): PByte; + + function UncompressedDataSize(DataPtr: PJclByteArray): Integer; + function UncompressData(DataPtr: PJclByteArray; var Value: DWord): Integer; + function UncompressToken(DataPtr: PJclByteArray; var Token: TJclClrToken): Integer; + function UncompressCallingConv(DataPtr: PJclByteArray): Byte; + function UncompressSignedInt(DataPtr: PJclByteArray; var 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); + + TJclClrArraySign = class(TJclClrSignature) + private + FBounds: array of array [TJclClrArrayData] of Integer; + 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 + constructor Create(const ATable: TJclClrTable); override; + procedure Update; override; + procedure SetParentToken(const ARow: TJclClrTableTypeDefRow); + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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 + constructor Create(const ATable: TJclClrTable); override; + + function Add(const ARow: TJclClrTablePropertyDefRow): Integer; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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 + constructor Create(const ATable: TJclClrTable); override; + procedure Update; override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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; + protected + constructor Create(const ATable: TJclClrTable); override; + public + 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 + constructor Create(const ATable: TJclClrTable); override; + property FuncCode: DWORD read FFuncCode; + 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 + constructor Create(const ATable: TJclClrTable); override; + property FuncCode: DWORD read FFuncCode; + 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); + +implementation + +uses + Math, + 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; var 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 + DataPtr[1]; + Result := 2; + end + else + if (DataPtr[0] and $E0) = $C0 then // 110? ???? + begin + Value := (DataPtr[0] and $1F) shl 24 + DataPtr[1] shl 16 + DataPtr[2] shl 8 + DataPtr[3]; + Result := 4; + end + else + raise EJclMetadataError.CreateResFmt(@RsInvalidSignatureData, + [DataPtr[0], DataPtr[1], DataPtr[2], DataPtr[3]]); +end; + +function TJclClrSignature.UncompressToken(DataPtr: PJclByteArray; var 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 + Token shr 2; +end; + +function TJclClrSignature.UncompressCallingConv(DataPtr: PJclByteArray): Byte; +begin + Result := DataPtr[0]; +end; + +function TJclClrSignature.UncompressSignedInt(DataPtr: PJclByteArray; var 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: Integer): PByte; +begin + Result := PByte(Integer(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) + AnsiLineBreak; +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 + AnsiLineBreak; +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); + 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(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 + 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 + 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 + { 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(DWORD(ILMethod) + 1); + FMaxStack := 0; + FLocalVarSignToken := 0; + end + else + begin + FSize := ILMethod.Fat.CodeSize; + FCode := Pointer(DWORD(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((DWORD(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(DWORD(FCode) + FSize), SectSize); + + if IsBitSet(SectHeader.Small.Kind, CorILMethod_Sect_MoreSects) then + ParseMoreSections(Pointer(DWORD(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 + 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 + 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 + AnsiLineBreak + '{' + AnsiLineBreak + + '.maxstack ' + IntToStr(MethodBody.MaxStack) + AnsiLineBreak; + + if MethodBody.LocalVarSignToken <> 0 then + begin + Result := Result + '.locals /* ' + IntToHex(MethodBody.LocalVarSignToken, 8) + ' */ init(' + AnsiLineBreak; + 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 + ')' + AnsiLineBreak + else + Result := Result + ',' + AnsiLineBreak; + end; + end; + + with TJclClrILGenerator.Create(MethodBody) do + try + Result := Result + AnsiLineBreak + 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 + 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 + 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 + 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 + 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; + +// History: + +// $Log: JclMetadata.pas,v $ +// Revision 1.15 2005/08/07 13:09:57 outchy +// Changed PByteArray to PJclByteArray to avoid RangeCheck exceptions. +// +// Revision 1.14 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.13 2005/03/06 18:15:03 marquardt +// JclGUIDToString and JclStringToGUID moved to JclSysUtils.pas, CrLf replaced by AnsiLineBreak +// +// Revision 1.12 2005/02/25 07:20:15 marquardt +// add section lines +// +// Revision 1.11 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.10 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.9 2004/07/30 12:42:57 marquardt +// style cleaning +// +// Revision 1.8 2004/06/16 07:30:30 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.7 2004/06/14 13:05:21 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.6 2004/06/02 03:23:47 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.5 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.4 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclMiscel.pas b/official/1.96/source/windows/JclMiscel.pas new file mode 100644 index 0000000..7f1a13d --- /dev/null +++ b/official/1.96/source/windows/JclMiscel.pas @@ -0,0 +1,373 @@ +{**************************************************************************************************} +{ } +{ 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 miscellanuous routines that do not (yet) fit nicely into other units } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/03/08 08:33:22 $ +// For history see end of file + +unit JclMiscel; + +{$I jcl.inc} + +interface + +uses + Windows, + JclBase; + +// StrLstLoadSave +function SetDisplayResolution(const XRes, YRes: DWORD): Longint; + +function CreateDOSProcessRedirected(const CommandLine, InputFile, OutputFile: string): Boolean; +function WinExec32(const Cmd: string; const CmdShow: Integer): Boolean; +function WinExec32AndWait(const Cmd: string; const CmdShow: Integer): Cardinal; +function WinExec32AndRedirectOutput(const Cmd: string; var Output: string; RawOutput: Boolean = False): Cardinal; + +function ExitWindows(ExitCode: Cardinal): Boolean; +function LogOffOS: Boolean; +function PowerOffOS: Boolean; +function ShutDownOS: Boolean; +function RebootOS: Boolean; + +// 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} + +implementation + +uses + SysUtils, + JclResources, JclSecurity, JclStrings, JclSysUtils, JclWin32; + +function CreateDOSProcessRedirected(const CommandLine, 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 + FillChar(StartupInfo, SizeOf(StartupInfo), #0); + StartupInfo.cb := SizeOf(StartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; + StartupInfo.wShowWindow := SW_HIDE; + StartupInfo.hStdOutput := hOutputFile; + StartupInfo.hStdInput := hInputFile; + 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(const Cmd: string; const CmdShow: Integer): Boolean; +var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; +begin + FillChar(StartupInfo, SizeOf(TStartupInfo), #0); + StartupInfo.cb := SizeOf(TStartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := CmdShow; + 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(const Cmd: string; const CmdShow: Integer): Cardinal; +var + StartupInfo: TStartupInfo; + ProcessInfo: TProcessInformation; +begin + Result := Cardinal($FFFFFFFF); + FillChar(StartupInfo, SizeOf(TStartupInfo), #0); + StartupInfo.cb := SizeOf(TStartupInfo); + StartupInfo.dwFlags := STARTF_USESHOWWINDOW; + StartupInfo.wShowWindow := CmdShow; + 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 LogOffOS: Boolean; +begin + {$IFDEF MSWINDOWS} + Result := JclMiscel.ExitWindows(EWX_LOGOFF); + {$ENDIF MSWINDOWS} + { TODO : implement at least LINUX variants throwing an exception } +end; + +function PowerOffOS: Boolean; +begin + {$IFDEF MSWINDOWS} + Result := JclMiscel.ExitWindows(EWX_POWEROFF); + {$ENDIF MSWINDOWS} +end; + +function ShutDownOS: Boolean; +begin + {$IFDEF MSWINDOWS} + Result := JclMiscel.ExitWindows(EWX_SHUTDOWN); + {$ENDIF MSWINDOWS} +end; + +function RebootOS: Boolean; +begin + {$IFDEF MSWINDOWS} + Result := JclMiscel.ExitWindows(EWX_Reboot); + {$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 SetDisplayResolution(const XRes, YRes: DWORD): Longint; +var + DevMode: TDeviceMode; +begin + Result := DISP_CHANGE_FAILED; + FillChar(DevMode, SizeOf(DevMode), #0); + 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; + +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 + 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; + FillChar(StartUpInfo, SizeOf(StartUpInfo), #0); + 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} + 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; + +// History: + +// $Log: JclMiscel.pas,v $ +// Revision 1.13 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.12 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.11 2004/10/25 06:58:44 rrossmair +// - fixed bug #0002065 +// - outsourced JclMiscel.Win32ExecAndRedirectOutput() + JclBorlandTools.ExecAndRedirectOutput() code into JclSysUtils.Execute() +// - refactored this code +// - added overload to supply callback capability per line of output +// +// Revision 1.10 2004/10/21 06:38:52 marquardt +// style clenaing, bugfixes, improvements +// +// Revision 1.9 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.8 2004/07/28 18:00:53 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.7 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.6 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclMsdosSys.pas b/official/1.96/source/windows/JclMsdosSys.pas new file mode 100644 index 0000000..e8f53e3 --- /dev/null +++ b/official/1.96/source/windows/JclMsdosSys.pas @@ -0,0 +1,651 @@ +{**************************************************************************************************} +{ } +{ 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 http://sourceforge.net/projects/jcl/ } +{ } +{ Known Issues: None } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/02/25 07:20:16 $ +// For history see end of file + +unit JclMsdosSys; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + Classes, SysUtils; + +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; + +function GetMsdosSys: IJclMsdosSys; + +implementation + +const + cMsdosSys = 'C:\MSDOS.SYS'; + +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; + 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; + public + constructor Create; + destructor Destroy; override; + 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; +begin + Result := TJclMsdosSys.Create; +end; + +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; + +// History: + +// $Log: JclMsdosSys.pas,v $ +// Revision 1.8 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.7 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.6 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.5 2004/08/09 06:38:08 marquardt +// add JvWStrUtils.pas as JclWideStrings.pas +// +// Revision 1.4 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.3 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclMultimedia.pas b/official/1.96/source/windows/JclMultimedia.pas new file mode 100644 index 0000000..c90d476 --- /dev/null +++ b/official/1.96/source/windows/JclMultimedia.pas @@ -0,0 +1,1388 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/12/12 21:54:10 $ +// For history see end of file + +unit JclMultimedia; + +{$I jcl.inc} + +interface + +uses + Windows, Classes, MMSystem, Contnrs, + JclBase, JclSynch, JclStrings; + +type + {$IFDEF FPC} + // declarations missing from mmsystem.pp + // see also implementation section + TTimeCaps = TIMECAPS; + TMixerControl = MIXERCONTROL; + TMixerCaps = MIXERCAPS; + TMixerLine = MIXERLINE; + TMCI_Open_Parms = MCI_OPEN_PARMS; + {$ENDIF FPC} + + // 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 + constructor Create(AMixerLine: TJclMixerLine; const AControlInfo: TMixerControl); + procedure PrepareControlDetailsStruc(var ControlDetails: TMixerControlDetails; AUniform, AMultiple: Boolean); + public + 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; + constructor Create(AMixerDevice: TJclMixerDevice); + public + 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; + protected + constructor Create(AMixerDestination: TJclMixerDestination; ASourceIndex: Cardinal); + public + property MixerDestination: TJclMixerDestination read FMixerDestination; + end; + + TJclMixerDestination = class(TJclMixerLine) + private + FSources: TObjectList; + function GetSourceCount: Integer; + function GetSources(Index: Integer): TJclMixerSource; + protected + constructor Create(AMixerDevice: TJclMixerDevice; ADestinationIndex: Cardinal); + procedure BuildSources; + public + 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 + constructor Create(ADeviceIndex: Cardinal; ACallBackWnd: THandle); + procedure BuildDestinations; + procedure BuildLines; + procedure Close; + procedure Open(ACallBackWnd: THandle); + public + 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; + +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); + 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(var 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(var TrackList: TJclCdTrackInfoArray; Drive: Char = #0): TJclCdTrackInfo; overload; +function GetCDAudioTrackList(TrackList: TStrings; IncludeTrackType: Boolean = False; Drive: Char = #0): string; overload; + +implementation + +uses + SysUtils, + JclResources, JclSysUtils; + +{ TODO : move to JclWin32? } +{$IFDEF FPC} +// declarations missing from mmsystem.pp +const + mmsyst = 'winmm.dll'; + +type + TFNTimeCallBack = procedure(uTimerID, uMessage: UINT; + dwUser, dw1, dw2: DWORD) stdcall; + + PMixerControlDetailsListText = ^TMixerControlDetailsListText; + TMixerControlDetailsListText = MIXERCONTROLDETAILS_LISTTEXTA; + + TMixerLineControlsA = MIXERLINECONTROLSA; + TMixerLineControls = TMixerLineControlsA; + TMCI_Status_Parms = MCI_STATUS_PARMS; + TMCI_Info_Parms = MCI_INFO_PARMS; + TMCI_Set_Parms = MCI_SET_PARMS; + +function mixerSetControlDetails(hmxobj: HMIXEROBJ; pmxcd: PMixerControlDetails; fdwDetails: DWORD): MMRESULT; stdcall; + external mmsyst name 'mixerSetControlDetails'; +{$ENDIF FPC} + +//=== { TJclMultimediaTimer } ================================================ + +constructor TJclMultimediaTimer.Create(Kind: TMmTimerKind; Notification: TMmNotificationKind); +begin + FKind := Kind; + FNotification := Notification; + FPeriod := 0; + FTimerID := 0; + FEvent := nil; + FillChar(FTimeCaps, SizeOf(FTimeCaps), #0); + 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(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: PMixerControlDetailsListText; + I: Cardinal; +begin + if FListText = nil then + begin + FListText := TStringList.Create; + if IsMultiple and IsList then + begin + PrepareControlDetailsStruc(ControlDetails, True, IsMultiple); + ControlDetails.cbDetails := SizeOf(TMixerControlDetailsListText); + GetMem(ListTexts, SizeOf(TMixerControlDetailsListText) * 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(var ControlDetails: TMixerControlDetails; + AUniform, AMultiple: Boolean); +begin + FillChar(ControlDetails, SizeOf(ControlDetails), 0); + 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 := RsMmMixerUndefined; + MIXERLINE_COMPONENTTYPE_DST_DIGITAL, MIXERLINE_COMPONENTTYPE_SRC_DIGITAL: + Result := RsMmMixerDigital; + MIXERLINE_COMPONENTTYPE_DST_LINE, MIXERLINE_COMPONENTTYPE_SRC_LINE: + Result := RsMmMixerLine; + MIXERLINE_COMPONENTTYPE_DST_MONITOR: + Result := RsMmMixerMonitor; + MIXERLINE_COMPONENTTYPE_DST_SPEAKERS: + Result := RsMmMixerSpeakers; + MIXERLINE_COMPONENTTYPE_DST_HEADPHONES: + Result := RsMmMixerHeadphones; + MIXERLINE_COMPONENTTYPE_DST_TELEPHONE, MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE: + Result := RsMmMixerTelephone; + MIXERLINE_COMPONENTTYPE_DST_WAVEIN: + Result := RsMmMixerWaveIn; + MIXERLINE_COMPONENTTYPE_DST_VOICEIN: + Result := RsMmMixerVoiceIn; + MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE: + Result := RsMmMixerMicrophone; + MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER: + Result := RsMmMixerSynthesizer; + MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC: + Result := RsMmMixerCompactDisc; + MIXERLINE_COMPONENTTYPE_SRC_PCSPEAKER: + Result := RsMmMixerPcSpeaker; + MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT: + Result := RsMmMixerWaveOut; + MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY: + Result := RsMmMixerAuxiliary; + MIXERLINE_COMPONENTTYPE_SRC_ANALOG: + Result := 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 := -1; + 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 <> -1 then + begin + mixerClose(FHandle); + FHandle := -1; + 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, Pointer(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 = -1 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 + AnsiLineBreak + 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 + AnsiLineBreak + RsMmMciErrorPrefix + FMciErrorMsg, Args); +end; + +constructor EJclMciError.CreateRes(MciErrNo: MCIERROR; Ident: Integer); +begin + FMciErrorNo := MciErrNo; + FMciErrorMsg := GetMciErrorMessage(MciErrNo); + inherited Create(LoadStr(Ident)+ AnsiLineBreak + RsMmMciErrorPrefix + FMciErrorMsg); +end; + +function GetMciErrorMessage(const MciErrNo: MCIERROR): string; +var + Buffer: array [0..MMSystem.MAXERRORLENGTH - 1] of Char; +begin + if mciGetErrorString(MciErrNo, Buffer, SizeOf(Buffer)) then + Result := Buffer + else + Result := Format(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(var OpenParams: TMCI_Open_Parms; Drive: Char): MCIERROR; +var + OpenParam: DWORD; + DriveName: array [0..2] of Char; +begin + FillChar(OpenParams, SizeOf(OpenParams), 0); + 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, Cardinal(@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 + FillChar(OpenParams, SizeOf(OpenParams), 0); +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 + FillChar(StatusParams, SizeOf(StatusParams), 0); + StatusParams.dwItem := MCI_STATUS_MEDIA_PRESENT; + MMCheck(mciSendCommand(Mci.wDeviceID, MCI_STATUS, MCI_STATUS_ITEM or MCI_WAIT, Cardinal(@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 + InfoParams.dwCallback := 0; + InfoParams.lpstrReturn := Buffer; + InfoParams.dwRetSize := SizeOf(Buffer) - 1; + if mciSendCommand(Mci.wDeviceID, MCI_INFO, InfoConsts[InfoType], Cardinal(@InfoParams)) = MMSYSERR_NOERROR then + Result := Buffer; + finally + CloseCdMciDevice(Mci); + end; +end; + +function GetCDAudioTrackList(var 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 + FillChar(StatusParams, SizeOf(StatusParams), 0); + StatusParams.dwItem := Item; + StatusParams.dwTrack := Track; + if mciSendCommand(Mci.wDeviceID, MCI_STATUS, Command, Cardinal(@StatusParams)) = MMSYSERR_NOERROR then + Result := StatusParams.dwReturn + else + Result := 0; + end; + +begin + MMCheck(OpenCdMciDevice(Mci, Drive), LoadResString(@RsMmNoCdAudio)); + try + FillChar(SetParams, SizeOf(SetParams), 0); + SetParams.dwTimeFormat := MCI_FORMAT_MSF; + MMCheck(mciSendCommand(Mci.wDeviceID, MCI_SET, MCI_SET_TIME_FORMAT, Cardinal(@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 := RsMMTrackAudio; + ttOther: + S := RsMMTrackOther; + end; + S := Format('[%s]', [S]); + end + else + S := ''; + S := Format(RsMmCdTrackNo, [I + 1]) + ' ' + S; + S := S + ' ' + Format(RsMMCdTimeFormat, [I + 1, Minute, Second]); + TrackList.Add(S); + end; + finally + TrackList.EndUpdate; + end; + Result := Format(RsMMCdTimeFormat, [TotalTime.Minute, TotalTime.Second]); +end; + +// History: + +// $Log: JclMultimedia.pas,v $ +// Revision 1.18 2005/12/12 21:54:10 outchy +// HWND changed to THandle (linking problems with BCB). +// +// Revision 1.17 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.16 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.15 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.14 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.13 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.12 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.11 2004/07/28 18:00:53 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.10 2004/06/16 07:30:31 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.9 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.8 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.7 2004/04/08 16:59:17 mthoma +// Fixed #1115. Changed $Data$ to $Date: 2005/12/12 21:54:10 $ +// +// Revision 1.6 2004/04/06 04:55:17 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclNTFS.pas b/official/1.96/source/windows/JclNTFS.pas new file mode 100644 index 0000000..0aae522 --- /dev/null +++ b/official/1.96/source/windows/JclNTFS.pas @@ -0,0 +1,1222 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ 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: 2005/03/08 08:33:22 $ +// For history see end of file + + +// 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 + Windows, Classes, + JclBase, JclWin32; + +// NTFS Exception +type + EJclNtfsError = class(EJclWin32Error); + +// NTFS - Compression +type + TFileCompressionState = (fcNoCompression, fcDefaultCompression, fcLZNT1Compression); + +function NtfsGetCompression(const FileName: string; var State: Short): Boolean; overload; +function NtfsGetCompression(const FileName: string): TFileCompressionState; overload; +function NtfsSetCompression(const FileName: string; const State: Short): Boolean; +procedure NtfsSetFileCompression(const FileName: string; 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: Integer; + 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: Integer): 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: string; Drive: Char): Boolean; +function NtfsMountVolume(const Volume: Char; const MountPoint: string): 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 NtfsCreateJunctionPoint(const Source, Destination: string): Boolean; +function NtfsDeleteJunctionPoint(const Source: string): Boolean; +function NtfsGetJunctionPointDestination(const Source: string; var Destination: string): 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; + +implementation + +uses + {$IFDEF FPC} + WinSysUt, + {$ENDIF FPC} + SysUtils, Hardlinks, + JclFileUtils, JclSysInfo, JclResources, JclSecurity; + +//=== 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: DWord; + CallerAddress: DWord; + end; + + EJclInvalidArgument = class(EJclError); + +{$STACKFRAMES OFF} + +function CallersCallerAddress: Pointer; +asm + MOV EAX, [EBP] + MOV EAX, TStackFrame([EAX]).CallerAddress +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; + 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 + SysUtils.FindClose(SearchRec); + end; + end; +end; + +function NtfsGetCompression(const FileName: string; var State: Short): Boolean; +var + Handle: THandle; + BytesReturned: DWORD; +begin + Result := False; + Handle := CreateFile(PChar(FileName), 0, 0, nil, OPEN_EXISTING, + FileFlag[IsDirectory(FileName)], 0); + if Handle <> INVALID_HANDLE_VALUE then + try + Result := DeviceIoControl(Handle, FSCTL_GET_COMPRESSION, nil, 0, @State, + SizeOf(Short), BytesReturned, nil); + finally + CloseHandle(Handle); + end; +end; + +function NtfsGetCompression(const FileName: string): 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: string; const State: Short): Boolean; +begin + Result := SetCompression(FileName, State, FileFlag[IsDirectory(FileName)]); +end; + +{$STACKFRAMES ON} + +procedure NtfsSetFileCompression(const FileName: string; 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 + 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. + GetFileInformationByHandle(Handle, Info); + Result := (Info.dwFileAttributes and FILE_ATTRIBUTE_SPARSE_FILE) <> 0; + if Result then + begin + ZeroDataInfo.FileOffset.QuadPart := First; + ZeroDataInfo.BeyondFinalZero.QuadPart := Last; + 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: Integer): TFileAllocatedRangeBuffer; +var + Offset: Longint; +begin + Assert((Index >= 0) and (Index < Ranges.Entries)); + Offset := Longint(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); + 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 + 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), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, + nil, OPEN_EXISTING, 0, 0); + if Handle <> INVALID_HANDLE_VALUE then + try + 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 + FillChar(ReparseData, SizeOf(ReparseData), #0); + ReparseData.ReparseTag := ReparseTag; + 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 + 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 + 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 + Result := NtfsGetReparseTag(Path, Tag); + if Result then + Result := (Tag = IO_REPARSE_TAG_MOUNT_POINT); +end; + +function NtfsMountDeviceAsDrive(const Device: string; Drive: Char): Boolean; +const + DDD_FLAGS = DDD_RAW_TARGET_PATH or DDD_REMOVE_DEFINITION or DDD_EXACT_MATCH_ON_REMOVE; +var + DriveStr: string; + VolumeName: string; +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 := DefineDosDevice(DDD_RAW_TARGET_PATH, PChar(DriveStr), PChar(Device)); + if Result then + begin + SetLength(VolumeName, 1024); + Result := RtdlGetVolumeNameForVolumeMountPoint(PChar(DriveStr + '\'), + PChar(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 DefineDosDevice(DDD_FLAGS, PChar(DriveStr), PChar(Device)) then + raise EJclNtfsError.CreateRes(@RsNtfsUnableToDeleteSymbolicLink); + if Result then + Result := RtdlSetVolumeMountPoint(PChar(DriveStr + '\'), PChar(VolumeName)); + end; +end; + +function NtfsMountVolume(const Volume: Char; const MountPoint: string): Boolean; +var + VolumeName: string; + VolumeStr: string; +begin + SetLength(VolumeName, 1024); + VolumeStr := Volume + ':\'; + Result := RtdlGetVolumeNameForVolumeMountPoint(PChar(VolumeStr), PChar(VolumeName), 1024); + if Result then + begin + if not JclFileUtils.DirectoryExists(MountPoint) then + JclFileUtils.ForceDirectories(MountPoint); + Result := RtdlSetVolumeMountPoint(PChar(MountPoint), PChar(VolumeName)); + end; +end; + +//=== NTFS - Change Journal ================================================== + +//=== NTFS - Opportunistic Locks ============================================= + +function NtfsOpLockAckClosePending(Handle: THandle; Overlapped: TOverlapped): Boolean; +var + BytesReturned: Cardinal; +begin + 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 + 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 + 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 + 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 + 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 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. + 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; + FillChar(ReparseData, SizeOf(ReparseData), #0); + NameLength := StrLen(Dest) * SizeOf(WideChar); + ReparseData.Reparse.ReparseTag := IO_REPARSE_TAG_MOUNT_POINT; + ReparseData.Reparse.ReparseDataLength := NameLength + 12; + ReparseData.Reparse.SubstituteNameLength := NameLength; + ReparseData.Reparse.PrintNameOffset := NameLength + 2; + // 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.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): Boolean; +var + Handle: THandle; + ReparseData: TReparseDataBufferOverlay; + BytesReturned: DWORD; +begin + Result := False; + if NtfsFileHasReparsePoint(Source) then + begin + Handle := CreateFile(PChar(Source), GENERIC_READ, 0, nil, + OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OPEN_REPARSE_POINT, 0); + if Handle <> INVALID_HANDLE_VALUE then + 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 + if BytesReturned >= ReparseData.Reparse.SubstituteNameLength + SizeOf(WideChar) then + begin + SetLength(Destination, (ReparseData.Reparse.SubstituteNameLength div SizeOf(WideChar)) + 1); + WideCharToMultiByte(CP_THREAD_ACP, 0, ReparseData.Reparse.PathBuffer, + (ReparseData.Reparse.SubstituteNameLength div SizeOf(WCHAR)) + 1, + PChar(Destination), Length(Destination), nil, nil); + Result := True; + end; + end; + finally + CloseHandle(Handle); + 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: TULargeInteger; + Hi, Lo: DWORD; + FoundStream: Boolean; + StreamName: PWideChar; +begin + Result := False; + FoundStream := False; + // We loop until we either found a stream or an error occurs. + while not FoundStream do + begin + // Read stream header + BytesToRead := DWORD(@Header.cStreamName[0]) - DWORD(@Header.dwStreamId); + if not 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 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} + 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} + 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 + Result := 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 successfull, +// 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; +{$DEFINE ANSI} // TODO: review for possible existing compatible DEFINES in the JCL +begin + {$IFDEF ANSI} + Result := CreateHardLinkA(PAnsiChar(LinkFileName), PAnsiChar(ExistingFileName), nil); + {$ELSE} + Result := CreateHardLinkW(PWideChar(LinkFileName), PWideChar(ExistingFileName)); + {$ENDIF ANSI} +end; + +function NtfsGetHardLinkInfo(const FileName: string; var Info: TNtfsHardLinkInfo): Boolean; +var + F: THandle; + FileInfo: TByHandleFileInformation; +begin + Result := False; + F := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); + if F <> INVALID_HANDLE_VALUE then + try + 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? + 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 + 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); + GetFullPathName(PChar(FileName), MAX_PATH, PChar(FullPathName), FilePart); + SetLength(FullPathName, StrLen(PChar(FullPathName))); + // get hard link information + 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 succesfully 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 succesfully 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; + +// History: + +// $Log: JclNTFS.pas,v $ +// Revision 1.23 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.22 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.21 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.20 2004/12/07 02:46:44 rrossmair +// - NtfsSparseStreamsSupported, NtfsReparsePointsSupported: +// Fixed bug in call to GetVolumeInformation (did not ensure trailing backslash) +// by replacing it with new function JclSysInfo.GetVolumeFileSystemFlags +// +// Revision 1.19 2004/10/20 19:52:15 rrossmair +// - renamed Hardlink to Hardlinks +// - Hardlinks now generated from prototype unit +// +// Revision 1.18 2004/10/19 06:26:48 marquardt +// JclRegistry extended, JclNTFS made compiling, JclDateTime style cleaned +// +// Revision 1.17 2004/10/18 18:42:49 assarbad +// Just removed a stupidity (BTW: introduced by PH) +// +// Revision 1.16 2004/10/18 18:20:55 assarbad +// Completely replaced the CreateHardLink() implementation. For the sake of brevity it is kept in the separate unit Hardlink.pas now. +// +// Please check wether it compiles. I had to change fragments as the JCL will not compile on my Delphi 4. +// +// Revision 1.15 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.14 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.13 2004/07/29 07:58:21 marquardt +// inc files updated +// +// Revision 1.12 2004/07/28 18:00:53 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.11 2004/07/14 03:00:34 rrossmair +// fixed bug #1962 ( NtfsCreateJunctionPoint fails if a \\??\\ path is used) +// +// Revision 1.10 2004/06/16 07:30:31 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.9 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.8 2004/05/31 00:30:45 rrossmair +// Processed documentation TODOs +// +// Revision 1.7 2004/05/13 07:46:06 rrossmair +// changes for FPC 1.9.3+ compatibility +// +// Revision 1.6 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/06 04:55:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclPeImage.pas b/official/1.96/source/windows/JclPeImage.pas new file mode 100644 index 0000000..b7c9586 --- /dev/null +++ b/official/1.96/source/windows/JclPeImage.pas @@ -0,0 +1,5441 @@ +{**************************************************************************************************} +{ } +{ 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 JclPeImage.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) } +{ Uwe Schuster (uschuster) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ Hallvard Vassbotn } +{ } +{**************************************************************************************************} +{ } +{ This unit contains various classes and support routines to read the contents of portable } +{ executable (PE) files. You can use these classes to, for example examine the contents of the } +{ imports section of an executable. In addition the unit contains support for Borland specific } +{ structures and name unmangling. } +{ } +{ Unit owner: Petr Vones } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/03/09 23:52:19 $ +// For history see end of file + +unit JclPeImage; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + Windows, Classes, SysUtils, TypInfo, Contnrs, + JclBase, JclDateTime, JclFileUtils, JclStrings, JclSysInfo, JclWin32; + +type + // Smart name compare function + TJclSmartCompOption = (scSimpleCompare, scIgnoreCase); + TJclSmartCompOptions = set of TJclSmartCompOption; + +function PeStripFunctionAW(const FunctionName: string): string; + +function PeSmartFunctionNameSame(const ComparedName, FunctionName: string; + Options: TJclSmartCompOptions = []): Boolean; + +type + // Base list + EJclPeImageError = class(EJclError); + + TJclPeImage = class; + TJclPeBorImage = class; + + TJclPeImageClass = class of TJclPeImage; + + TJclPeImageBaseList = class(TObjectList) + private + FImage: TJclPeImage; + public + constructor Create(AImage: TJclPeImage); + property Image: TJclPeImage read FImage; + end; + + // Images cache + TJclPeImagesCache = class(TObject) + private + FList: TStringList; + function GetCount: Integer; + function GetImages(const FileName: TFileName): TJclPeImage; + protected + function GetPeImageClass: TJclPeImageClass; virtual; + public + constructor Create; + destructor Destroy; override; + procedure Clear; + property Images[const FileName: TFileName]: TJclPeImage read GetImages; default; + property Count: Integer read GetCount; + end; + + TJclPeBorImagesCache = class(TJclPeImagesCache) + private + function GetImages(const FileName: TFileName): TJclPeBorImage; + protected + function GetPeImageClass: TJclPeImageClass; override; + public + property Images[const FileName: TFileName]: TJclPeBorImage read GetImages; default; + end; + + // Import section related classes + TJclPeImportSort = (isName, isOrdinal, isHint, isLibImport); + TJclPeImportLibSort = (ilName, ilIndex); + TJclPeImportKind = (ikImport, ikDelayImport, ikBoundImport); + TJclPeResolveCheck = (icNotChecked, icResolved, icUnresolved); + TJclPeLinkerProducer = (lrBorland, lrMicrosoft); + // lrBorland -> Delphi PE files + // lrMicrosoft -> MSVC and BCB PE files + + TJclPeImportLibItem = class; + + TJclPeImportFuncItem = class(TObject) + private + FOrdinal: Word; + FHint: Word; + FImportLib: TJclPeImportLibItem; + FName: PChar; + FIndirectImportName: Boolean; + FResolveCheck: TJclPeResolveCheck; + function GetIsByOrdinal: Boolean; + function GetName: string; + protected + procedure SetIndirectImportName(P: PChar); + public + destructor Destroy; override; + property Ordinal: Word read FOrdinal; + property Hint: Word read FHint; + property ImportLib: TJclPeImportLibItem read FImportLib; + property IndirectImportName: Boolean read FIndirectImportName; + property IsByOrdinal: Boolean read GetIsByOrdinal; + property Name: string read GetName; + property ResolveCheck: TJclPeResolveCheck read FResolveCheck; + end; + + TJclPeImportLibItem = class(TJclPeImageBaseList) + private + FImportDescriptor: Pointer; + FImportDirectoryIndex: Integer; + FImportKind: TJclPeImportKind; + FLastSortType: TJclPeImportSort; + FLastSortDescending: Boolean; + FName: PChar; + FSorted: Boolean; + FTotalResolveCheck: TJclPeResolveCheck; + FThunk: PImageThunkData; + FThunkData: PImageThunkData; + function GetCount: Integer; + function GetFileName: TFileName; + function GetItems(Index: Integer): TJclPeImportFuncItem; + function GetOriginalName: string; + function GetName: string; + protected + procedure CheckImports(ExportImage: TJclPeImage); + procedure CreateList; + public + constructor Create(AImage: TJclPeImage); + procedure SortList(SortType: TJclPeImportSort; Descending: Boolean = False); + property Count: Integer read GetCount; + property FileName: TFileName read GetFileName; + property ImportDescriptor: Pointer read FImportDescriptor; + property ImportDirectoryIndex: Integer read FImportDirectoryIndex; + property ImportKind: TJclPeImportKind read FImportKind; + property Items[Index: Integer]: TJclPeImportFuncItem read GetItems; default; + property Name: string read GetName; + property OriginalName: string read GetOriginalName; + property ThunkData: PImageThunkData read FThunkData; + property TotalResolveCheck: TJclPeResolveCheck read FTotalResolveCheck; + end; + + TJclPeImportList = class(TJclPeImageBaseList) + private + FAllItemsList: TList; + FFilterModuleName: string; + FLastAllSortType: TJclPeImportSort; + FLastAllSortDescending: Boolean; + FLinkerProducer: TJclPeLinkerProducer; + FParalelImportTable: array of Pointer; + FUniqueNamesList: TStringList; + function GetAllItemCount: Integer; + function GetAllItems(Index: Integer): TJclPeImportFuncItem; + function GetItems(Index: Integer): TJclPeImportLibItem; + function GetUniqueLibItemCount: Integer; + function GetUniqueLibItems(Index: Integer): TJclPeImportLibItem; + function GetUniqueLibNames(Index: Integer): string; + function GetUniqueLibItemFromName(const Name: string): TJclPeImportLibItem; + procedure SetFilterModuleName(const Value: string); + protected + procedure CreateList; + procedure RefreshAllItems; + public + constructor Create(AImage: TJclPeImage); + destructor Destroy; override; + procedure CheckImports(PeImageCache: TJclPeImagesCache = nil); + function MakeBorlandImportTableForMappedImage: Boolean; + function SmartFindName(const CompareName, LibName: string; Options: TJclSmartCompOptions = []): TJclPeImportFuncItem; + procedure SortAllItemsList(SortType: TJclPeImportSort; Descending: Boolean = False); + procedure SortList(SortType: TJclPeImportLibSort); + procedure TryGetNamesForOrdinalImports; + 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 LinkerProducer: TJclPeLinkerProducer read FLinkerProducer; + property UniqueLibItemCount: Integer read GetUniqueLibItemCount; + property UniqueLibItemFromName[const Name: string]: TJclPeImportLibItem read GetUniqueLibItemFromName; + property UniqueLibItems[Index: Integer]: TJclPeImportLibItem read GetUniqueLibItems; + property UniqueLibNames[Index: Integer]: string read GetUniqueLibNames; + end; + + // Export section related classes + TJclPeExportSort = (esName, esOrdinal, esHint, esAddress, esForwarded, esAddrOrFwd, esSection); + + TJclPeExportFuncList = class; + + TJclPeExportFuncItem = class(TObject) + private + FAddress: DWORD; + FExportList: TJclPeExportFuncList; + FForwardedName: PChar; + FForwardedDotPos: PChar; + FHint: Word; + FName: PChar; + FOrdinal: Word; + FResolveCheck: TJclPeResolveCheck; + function GetAddressOrForwardStr: string; + function GetForwardedFuncName: string; + function GetForwardedLibName: string; + function GetForwardedFuncOrdinal: DWORD; + function GetForwardedName: string; + function GetIsExportedVariable: Boolean; + function GetIsForwarded: Boolean; + function GetName: string; + function GetSectionName: string; + function GetMappedAddress: Pointer; + protected + procedure FindForwardedDotPos; + public + property Address: DWORD read FAddress; + property AddressOrForwardStr: string read GetAddressOrForwardStr; + property IsExportedVariable: Boolean read GetIsExportedVariable; + property IsForwarded: Boolean read GetIsForwarded; + property ForwardedName: string read GetForwardedName; + property ForwardedLibName: string read GetForwardedLibName; + property ForwardedFuncOrdinal: DWORD read GetForwardedFuncOrdinal; + property ForwardedFuncName: string read GetForwardedFuncName; + property Hint: Word read FHint; + property MappedAddress: Pointer read GetMappedAddress; + property Name: string read GetName; + property Ordinal: Word read FOrdinal; + property ResolveCheck: TJclPeResolveCheck read FResolveCheck; + property SectionName: string read GetSectionName; + end; + + TJclPeExportFuncList = class(TJclPeImageBaseList) + private + FAnyForwards: Boolean; + FBase: DWORD; + FExportDir: PImageExportDirectory; + FForwardedLibsList: TStringList; + FFunctionCount: DWORD; + FLastSortType: TJclPeExportSort; + FLastSortDescending: Boolean; + FSorted: Boolean; + FTotalResolveCheck: TJclPeResolveCheck; + function GetForwardedLibsList: TStrings; + function GetItems(Index: Integer): TJclPeExportFuncItem; + function GetItemFromAddress(Address: DWORD): TJclPeExportFuncItem; + function GetItemFromOrdinal(Ordinal: DWORD): TJclPeExportFuncItem; + function GetItemFromName(const Name: string): TJclPeExportFuncItem; + function GetName: string; + protected + function CanPerformFastNameSearch: Boolean; + procedure CreateList; + property LastSortType: TJclPeExportSort read FLastSortType; + property LastSortDescending: Boolean read FLastSortDescending; + property Sorted: Boolean read FSorted; + public + constructor Create(AImage: TJclPeImage); + destructor Destroy; override; + procedure CheckForwards(PeImageCache: TJclPeImagesCache = nil); + class function ItemName(Item: TJclPeExportFuncItem): string; + function OrdinalValid(Ordinal: DWORD): Boolean; + procedure PrepareForFastNameSearch; + function SmartFindName(const CompareName: string; Options: TJclSmartCompOptions = []): TJclPeExportFuncItem; + procedure SortList(SortType: TJclPeExportSort; Descending: Boolean = False); + property AnyForwards: Boolean read FAnyForwards; + property Base: DWORD read FBase; + property ExportDir: PImageExportDirectory read FExportDir; + property ForwardedLibsList: TStrings read GetForwardedLibsList; + property FunctionCount: DWORD read FFunctionCount; + property Items[Index: Integer]: 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; + property Name: string read GetName; + property TotalResolveCheck: TJclPeResolveCheck read FTotalResolveCheck; + end; + + // Resource section related classes + TJclPeResourceKind = ( + rtUnknown0, + rtCursorEntry, + rtBitmap, + rtIconEntry, + rtMenu, + rtDialog, + rtString, + rtFontDir, + rtFont, + rtAccelerators, + rtRCData, + rtMessageTable, + rtCursor, + rtUnknown13, + rtIcon, + rtUnknown15, + rtVersion, + rtDlgInclude, + rtUnknown18, + rtPlugPlay, + rtVxd, + rtAniCursor, + rtAniIcon, + rtHmtl, + rtManifest, + rtUserDefined); + + TJclPeResourceList = class; + TJclPeResourceItem = class; + + TJclPeResourceRawStream = class(TCustomMemoryStream) + public + constructor Create(AResourceItem: TJclPeResourceItem); + function Write(const Buffer; Count: Longint): Longint; override; + end; + + TJclPeResourceItem = class(TObject) + private + FEntry: PImageResourceDirectoryEntry; + FImage: TJclPeImage; + FList: TJclPeResourceList; + FLevel: Byte; + FParentItem: TJclPeResourceItem; + FNameCache: string; + function GetDataEntry: PImageResourceDataEntry; + function GetIsDirectory: Boolean; + function GetIsName: Boolean; + function GetLangID: LANGID; + function GetList: TJclPeResourceList; + function GetName: string; + function GetParameterName: string; + function GetRawEntryData: Pointer; + function GetRawEntryDataSize: Integer; + function GetResourceType: TJclPeResourceKind; + function GetResourceTypeStr: string; + protected + function OffsetToRawData(Ofs: DWORD): DWORD; + function Level1Item: TJclPeResourceItem; + function SubDirData: PImageResourceDirectory; + public + constructor Create(AImage: TJclPeImage; AParentItem: TJclPeResourceItem; + AEntry: PImageResourceDirectoryEntry); + destructor Destroy; override; + function CompareName(AName: PChar): Boolean; + property DataEntry: PImageResourceDataEntry read GetDataEntry; + property Entry: PImageResourceDirectoryEntry read FEntry; + property Image: TJclPeImage read FImage; + property IsDirectory: Boolean read GetIsDirectory; + property IsName: Boolean read GetIsName; + property LangID: LANGID read GetLangID; + property List: TJclPeResourceList read GetList; + property Level: Byte read FLevel; + property Name: string read GetName; + property ParameterName: string read GetParameterName; + property ParentItem: TJclPeResourceItem read FParentItem; + property RawEntryData: Pointer read GetRawEntryData; + property RawEntryDataSize: Integer read GetRawEntryDataSize; + property ResourceType: TJclPeResourceKind read GetResourceType; + property ResourceTypeStr: string read GetResourceTypeStr; + end; + + TJclPeResourceList = class(TJclPeImageBaseList) + private + FDirectory: PImageResourceDirectory; + FParentItem: TJclPeResourceItem; + function GetItems(Index: Integer): TJclPeResourceItem; + protected + procedure CreateList(AParentItem: TJclPeResourceItem); + public + constructor Create(AImage: TJclPeImage; AParentItem: TJclPeResourceItem; + ADirectory: PImageResourceDirectory); + function FindName(const Name: string): TJclPeResourceItem; + property Directory: PImageResourceDirectory read FDirectory; + property Items[Index: Integer]: TJclPeResourceItem read GetItems; default; + property ParentItem: TJclPeResourceItem read FParentItem; + end; + + TJclPeRootResourceList = class(TJclPeResourceList) + private + FManifestContent: TStringList; + function GetManifestContent: TStrings; + public + destructor Destroy; override; + function FindResource(ResourceType: TJclPeResourceKind; + const ResourceName: string = ''): TJclPeResourceItem; overload; + function FindResource(const ResourceType: PChar; + const ResourceName: PChar = nil): TJclPeResourceItem; overload; + function ListResourceNames(ResourceType: TJclPeResourceKind; const Strings: TStrings): Boolean; + property ManifestContent: TStrings read GetManifestContent; + end; + + // Relocation section related classes + TJclPeRelocation = record + Address: Word; + RelocType: Byte; + VirtualAddress: DWORD; + end; + + TJclPeRelocEntry = class(TObject) + private + FChunk: PImageBaseRelocation; + FCount: Integer; + function GetRelocations(Index: Integer): TJclPeRelocation; + function GetSize: DWORD; + function GetVirtualAddress: DWORD; + public + property Count: Integer read FCount; + property Relocations[Index: Integer]: TJclPeRelocation read GetRelocations; default; + property Size: DWORD read GetSize; + property VirtualAddress: DWORD read GetVirtualAddress; + end; + + TJclPeRelocList = class(TJclPeImageBaseList) + private + FAllItemCount: Integer; + function GetItems(Index: Integer): TJclPeRelocEntry; + function GetAllItems(Index: Integer): TJclPeRelocation; + protected + procedure CreateList; + public + constructor Create(AImage: TJclPeImage); + property AllItems[Index: Integer]: TJclPeRelocation read GetAllItems; + property AllItemCount: Integer read FAllItemCount; + property Items[Index: Integer]: TJclPeRelocEntry read GetItems; default; + end; + + // Debug section related classes + TJclPeDebugList = class(TJclPeImageBaseList) + private + function GetItems(Index: Integer): TImageDebugDirectory; + protected + procedure CreateList; + public + constructor Create(AImage: TJclPeImage); + property Items[Index: Integer]: TImageDebugDirectory read GetItems; default; + end; + + // Certificates section related classes + TJclPeCertificate = class(TObject) + private + FData: Pointer; + FHeader: TWinCertificate; + public + property Data: Pointer read FData; + property Header: TWinCertificate read FHeader; + end; + + TJclPeCertificateList = class(TJclPeImageBaseList) + private + function GetItems(Index: Integer): TJclPeCertificate; + protected + procedure CreateList; + public + constructor Create(AImage: TJclPeImage); + property Items[Index: Integer]: TJclPeCertificate read GetItems; default; + end; + + // Common Language Runtime section related classes + TJclPeCLRHeader = class(TObject) + private + FHeader: TImageCor20Header; + FImage: TJclPeImage; + function GetVersionString: string; + function GetHasMetadata: Boolean; + protected + procedure ReadHeader; + public + constructor Create(AImage: TJclPeImage); + property HasMetadata: Boolean read GetHasMetadata; + property Header: TImageCor20Header read FHeader; + property VersionString: string read GetVersionString; + property Image: TJclPeImage read FImage; + end; + + // PE Image + TJclPeHeader = ( + JclPeHeader_Signature, + JclPeHeader_Machine, + JclPeHeader_NumberOfSections, + JclPeHeader_TimeDateStamp, + JclPeHeader_PointerToSymbolTable, + JclPeHeader_NumberOfSymbols, + JclPeHeader_SizeOfOptionalHeader, + JclPeHeader_Characteristics, + JclPeHeader_Magic, + JclPeHeader_LinkerVersion, + JclPeHeader_SizeOfCode, + JclPeHeader_SizeOfInitializedData, + JclPeHeader_SizeOfUninitializedData, + JclPeHeader_AddressOfEntryPoint, + JclPeHeader_BaseOfCode, + JclPeHeader_BaseOfData, + JclPeHeader_ImageBase, + JclPeHeader_SectionAlignment, + JclPeHeader_FileAlignment, + JclPeHeader_OperatingSystemVersion, + JclPeHeader_ImageVersion, + JclPeHeader_SubsystemVersion, + JclPeHeader_Win32VersionValue, + JclPeHeader_SizeOfImage, + JclPeHeader_SizeOfHeaders, + JclPeHeader_CheckSum, + JclPeHeader_Subsystem, + JclPeHeader_DllCharacteristics, + JclPeHeader_SizeOfStackReserve, + JclPeHeader_SizeOfStackCommit, + JclPeHeader_SizeOfHeapReserve, + JclPeHeader_SizeOfHeapCommit, + JclPeHeader_LoaderFlags, + JclPeHeader_NumberOfRvaAndSizes); + + TJclLoadConfig = ( + JclLoadConfig_Characteristics, { TODO : rename to Size? } + JclLoadConfig_TimeDateStamp, + JclLoadConfig_Version, + JclLoadConfig_GlobalFlagsClear, + JclLoadConfig_GlobalFlagsSet, + JclLoadConfig_CriticalSectionDefaultTimeout, + JclLoadConfig_DeCommitFreeBlockThreshold, + JclLoadConfig_DeCommitTotalFreeThreshold, + JclLoadConfig_LockPrefixTable, + JclLoadConfig_MaximumAllocationSize, + JclLoadConfig_VirtualMemoryThreshold, + JclLoadConfig_ProcessHeapFlags, + JclLoadConfig_ProcessAffinityMask, + JclLoadConfig_CSDVersion, + JclLoadConfig_Reserved1, + JclLoadConfig_EditList, + JclLoadConfig_Reserved { TODO : extend to the new fields? } + ); + + TJclPeFileProperties = record + Size: DWORD; + CreationTime: TDateTime; + LastAccessTime: TDateTime; + LastWriteTime: TDateTime; + Attributes: Integer; + end; + + TJclPeImageStatus = (stNotLoaded, stOk, stNotPE, stNotFound, stError); + + TJclPeImage = class(TObject) + private + FAttachedImage: Boolean; + FCertificateList: TJclPeCertificateList; + FCLRHeader: TJclPeCLRHeader; + FDebugList: TJclPeDebugList; + FFileName: TFileName; + FImageSections: TStringList; + FLoadedImage: TLoadedImage; + FExportList: TJclPeExportFuncList; + FImportList: TJclPeImportList; + FNoExceptions: Boolean; + FReadOnlyAccess: Boolean; + FRelocationList: TJclPeRelocList; + FResourceList: TJclPeRootResourceList; + FResourceVA: DWORD; + FStatus: TJclPeImageStatus; + FVersionInfo: TJclFileVersionInfo; + function GetCertificateList: TJclPeCertificateList; + function GetCLRHeader: TJclPeCLRHeader; + function GetDebugList: TJclPeDebugList; + function GetDescription: string; + function GetDirectories(Directory: Word): TImageDataDirectory; + function GetDirectoryExists(Directory: Word): Boolean; + function GetExportList: TJclPeExportFuncList; + function GetFileProperties: TJclPeFileProperties; + function GetImageSectionCount: Integer; + function GetImageSectionHeaders(Index: Integer): TImageSectionHeader; + function GetImageSectionNames(Index: Integer): string; + function GetImageSectionNameFromRva(const Rva: DWORD): string; + function GetImportList: TJclPeImportList; + function GetHeaderValues(Index: TJclPeHeader): string; + function GetLoadConfigValues(Index: TJclLoadConfig): string; + function GetMappedAddress: DWORD; + function GetOptionalHeader: TImageOptionalHeader; + function GetRelocationList: TJclPeRelocList; + function GetResourceList: TJclPeRootResourceList; + function GetUnusedHeaderBytes: TImageDataDirectory; + function GetVersionInfo: TJclFileVersionInfo; + function GetVersionInfoAvailable: Boolean; + procedure ReadImageSections; + procedure SetFileName(const Value: TFileName); + protected + procedure AfterOpen; dynamic; + procedure CheckNotAttached; + procedure Clear; dynamic; + function ExpandModuleName(const ModuleName: string): TFileName; + procedure RaiseStatusException; + function ResourceItemCreate(AEntry: PImageResourceDirectoryEntry; + AParentItem: TJclPeResourceItem): TJclPeResourceItem; virtual; + function ResourceListCreate(ADirectory: PImageResourceDirectory; + AParentItem: TJclPeResourceItem): TJclPeResourceList; virtual; + property NoExceptions: Boolean read FNoExceptions; + public + constructor Create(ANoExceptions: Boolean = False); virtual; + destructor Destroy; override; + procedure AttachLoadedModule(const Handle: HMODULE); + function CalculateCheckSum: DWORD; + function DirectoryEntryToData(Directory: Word): Pointer; + function GetSectionHeader(const SectionName: string; var Header: PImageSectionHeader): Boolean; + function GetSectionName(Header: PImageSectionHeader): string; + function IsBrokenFormat: Boolean; + function IsCLR: Boolean; + function IsSystemImage: Boolean; + function RawToVa(Raw: DWORD): Pointer; + function RvaToSection(Rva: DWORD): PImageSectionHeader; + function RvaToVa(Rva: DWORD): Pointer; + function RvaToVaEx(Rva: DWORD): Pointer; + function StatusOK: Boolean; + procedure TryGetNamesForOrdinalImports; + function VerifyCheckSum: Boolean; + class function DebugTypeNames(DebugType: DWORD): string; + class function DirectoryNames(Directory: Word): string; + class function ExpandBySearchPath(const ModuleName, BasePath: string): TFileName; + class function HeaderNames(Index: TJclPeHeader): string; + class function LoadConfigNames(Index: TJclLoadConfig): string; + class function ShortSectionInfo(Characteristics: DWORD): string; + class function StampToDateTime(TimeDateStamp: DWORD): TDateTime; + property AttachedImage: Boolean read FAttachedImage; + property CertificateList: TJclPeCertificateList read GetCertificateList; + property CLRHeader: TJclPeCLRHeader read GetCLRHeader; + property DebugList: TJclPeDebugList read GetDebugList; + property Description: string read GetDescription; + property Directories[Directory: Word]: TImageDataDirectory read GetDirectories; + property DirectoryExists[Directory: Word]: Boolean read GetDirectoryExists; + property ExportList: TJclPeExportFuncList read GetExportList; + property FileName: TFileName read FFileName write SetFileName; + property FileProperties: TJclPeFileProperties read GetFileProperties; + property HeaderValues[Index: TJclPeHeader]: string read GetHeaderValues; + property ImageSectionCount: Integer read GetImageSectionCount; + property ImageSectionHeaders[Index: Integer]: TImageSectionHeader read GetImageSectionHeaders; + property ImageSectionNames[Index: Integer]: string read GetImageSectionNames; + property ImageSectionNameFromRva[const Rva: DWORD]: string read GetImageSectionNameFromRva; + property ImportList: TJclPeImportList read GetImportList; + property LoadConfigValues[Index: TJclLoadConfig]: string read GetLoadConfigValues; + property LoadedImage: TLoadedImage read FLoadedImage; + property MappedAddress: DWORD read GetMappedAddress; + property OptionalHeader: TImageOptionalHeader read GetOptionalHeader; + property ReadOnlyAccess: Boolean read FReadOnlyAccess write FReadOnlyAccess; + property RelocationList: TJclPeRelocList read GetRelocationList; + property ResourceList: TJclPeRootResourceList read GetResourceList; + property Status: TJclPeImageStatus read FStatus; + property UnusedHeaderBytes: TImageDataDirectory read GetUnusedHeaderBytes; + property VersionInfo: TJclFileVersionInfo read GetVersionInfo; + property VersionInfoAvailable: Boolean read GetVersionInfoAvailable; + end; + + // Borland Delphi PE Image specific information + TJclPePackageInfo = class(TObject) + private + FAvailable: Boolean; + FContains: TStringList; + FDcpName: string; + FRequires: TStringList; + FFlags: Integer; + FDescription: string; + FEnsureExtension: Boolean; + function GetContains: TStrings; + function GetContainsCount: Integer; + function GetContainsFlags(Index: Integer): Byte; + function GetContainsNames(Index: Integer): string; + function GetRequires: TStrings; + function GetRequiresCount: Integer; + function GetRequiresNames(Index: Integer): string; + protected + procedure ReadPackageInfo(ALibHandle: THandle); + public + constructor Create(ALibHandle: THandle); + destructor Destroy; override; + class function PackageModuleTypeToString(Flags: Integer): string; + class function PackageOptionsToString(Flags: Integer): string; + class function ProducerToString(Flags: Integer): string; + class function UnitInfoFlagsToString(UnitFlags: Byte): string; + property Available: Boolean read FAvailable; + property Contains: TStrings read GetContains; + property ContainsCount: Integer read GetContainsCount; + property ContainsNames[Index: Integer]: string read GetContainsNames; + property ContainsFlags[Index: Integer]: Byte read GetContainsFlags; + property Description: string read FDescription; + property DcpName: string read FDcpName; + property EnsureExtension: Boolean read FEnsureExtension write FEnsureExtension; + property Flags: Integer read FFlags; + property Requires: TStrings read GetRequires; + property RequiresCount: Integer read GetRequiresCount; + property RequiresNames[Index: Integer]: string read GetRequiresNames; + end; + + TJclPeBorForm = class(TObject) + private + FFormFlags: TFilerFlags; + FFormClassName: string; + FFormObjectName: string; + FFormPosition: Integer; + FResItem: TJclPeResourceItem; + function GetDisplayName: string; + public + procedure ConvertFormToText(const Stream: TStream); overload; + procedure ConvertFormToText(const Strings: TStrings); overload; + property FormClassName: string read FFormClassName; + property FormFlags: TFilerFlags read FFormFlags; + property FormObjectName: string read FFormObjectName; + property FormPosition: Integer read FFormPosition; + property DisplayName: string read GetDisplayName; + property ResItem: TJclPeResourceItem read FResItem; + end; + + TJclPeBorImage = class(TJclPeImage) + private + FForms: TObjectList; + FIsPackage: Boolean; + FIsBorlandImage: Boolean; + FLibHandle: THandle; + FPackageInfo: TJclPePackageInfo; + FPackageCompilerVersion: Integer; + function GetFormCount: Integer; + function GetForms(Index: Integer): TJclPeBorForm; + function GetFormFromName(const FormClassName: string): TJclPeBorForm; + function GetLibHandle: THandle; + function GetPackageCompilerVersion: Integer; + function GetPackageInfo: TJclPePackageInfo; + protected + procedure AfterOpen; override; + procedure Clear; override; + procedure CreateFormsList; + public + constructor Create(ANoExceptions: Boolean = False); override; + destructor Destroy; override; + function DependedPackages(List: TStrings; FullPathName, Descriptions: Boolean): Boolean; + function FreeLibHandle: Boolean; + property Forms[Index: Integer]: TJclPeBorForm read GetForms; + property FormCount: Integer read GetFormCount; + property FormFromName[const FormClassName: string]: TJclPeBorForm read GetFormFromName; + property IsBorlandImage: Boolean read FIsBorlandImage; + property IsPackage: Boolean read FIsPackage; + property LibHandle: THandle read GetLibHandle; + property PackageCompilerVersion: Integer read GetPackageCompilerVersion; + property PackageInfo: TJclPePackageInfo read GetPackageInfo; + end; + + // Threaded function search + TJclPeNameSearchOption = (seImports, seDelayImports, seBoundImports, seExports); + TJclPeNameSearchOptions = set of TJclPeNameSearchOption; + + TJclPeNameSearchNotifyEvent = procedure (Sender: TObject; PeImage: TJclPeImage; + var Process: Boolean) of object; + TJclPeNameSearchFoundEvent = procedure (Sender: TObject; const FileName: TFileName; + const FunctionName: string; Option: TJclPeNameSearchOption) of object; + + TJclPeNameSearch = class(TThread) + private + F_FileName: TFileName; + F_FunctionName: string; + F_Option: TJclPeNameSearchOption; + F_Process: Boolean; + FFunctionName: string; + FOptions: TJclPeNameSearchOptions; + FPath: string; + FPeImage: TJclPeImage; + FOnFound: TJclPeNameSearchFoundEvent; + FOnProcessFile: TJclPeNameSearchNotifyEvent; + protected + function CompareName(const FunctionName, ComparedName: string): Boolean; virtual; + procedure DoFound; + procedure DoProcessFile; + procedure Execute; override; + public + constructor Create(const FunctionName, Path: string; Options: TJclPeNameSearchOptions = [seImports, seExports]); + procedure Start; + property OnFound: TJclPeNameSearchFoundEvent read FOnFound write FOnFound; + property OnProcessFile: TJclPeNameSearchNotifyEvent read FOnProcessFile write FOnProcessFile; + end; + +// PE Image miscellaneous functions +type + TJclRebaseImageInfo = record + OldImageSize: DWORD; + OldImageBase: DWORD; + NewImageSize: DWORD; + NewImageBase: DWORD; + end; + +{ Image validity } + +function IsValidPeFile(const FileName: TFileName): Boolean; + +function PeGetNtHeaders(const FileName: TFileName; var NtHeaders: TImageNtHeaders): Boolean; + +{ Image modifications } + +function PeCreateNameHintTable(const FileName: TFileName): Boolean; + +function PeRebaseImage(const ImageName: TFileName; NewBase: DWORD = 0; TimeStamp: DWORD = 0; + MaxNewSize: DWORD = 0): TJclRebaseImageInfo; + +function PeUpdateLinkerTimeStamp(const FileName: string; const Time: TDateTime): Boolean; +function PeReadLinkerTimeStamp(const FileName: string): TDateTime; + +function PeInsertSection(const FileName: TFileName; SectionStream: TStream; SectionName: string): Boolean; + +{ Image Checksum } + +function PeVerifyCheckSum(const FileName: TFileName): Boolean; +function PeClearCheckSum(const FileName: TFileName): Boolean; +function PeUpdateCheckSum(const FileName: TFileName): Boolean; + +// Various simple PE Image searching and listing routines +{ Exports searching } + +function PeDoesExportFunction(const FileName: TFileName; const FunctionName: string; + Options: TJclSmartCompOptions = []): Boolean; + +function PeIsExportFunctionForwardedEx(const FileName: TFileName; const FunctionName: string; + var ForwardedName: string; Options: TJclSmartCompOptions = []): Boolean; +function PeIsExportFunctionForwarded(const FileName: TFileName; const FunctionName: string; + Options: TJclSmartCompOptions = []): Boolean; + +{ Imports searching } + +function PeDoesImportFunction(const FileName: TFileName; const FunctionName: string; + const LibraryName: string = ''; Options: TJclSmartCompOptions = []): Boolean; + +function PeDoesImportLibrary(const FileName: TFileName; const LibraryName: string; + Recursive: Boolean = False): Boolean; + +{ Imports listing } + +function PeImportedLibraries(const FileName: TFileName; const LibrariesList: TStrings; + Recursive: Boolean = False; FullPathName: Boolean = False): Boolean; + +function PeImportedFunctions(const FileName: TFileName; const FunctionsList: TStrings; + const LibraryName: string = ''; IncludeLibNames: Boolean = False): Boolean; + +{ Exports listing } + +function PeExportedFunctions(const FileName: TFileName; const FunctionsList: TStrings): Boolean; +function PeExportedNames(const FileName: TFileName; const FunctionsList: TStrings): Boolean; +function PeExportedVariables(const FileName: TFileName; const FunctionsList: TStrings): Boolean; + +{ Resources listing } + +function PeResourceKindNames(const FileName: TFileName; ResourceType: TJclPeResourceKind; + const NamesList: TStrings): Boolean; + +{ Borland packages specific } + +function PeBorFormNames(const FileName: TFileName; const NamesList: TStrings): Boolean; + +function PeBorDependedPackages(const FileName: TFileName; PackagesList: TStrings; + FullPathName, Descriptions: Boolean): Boolean; + +// Missing imports checking routines +function PeFindMissingImports(const FileName: TFileName; MissingImportsList: TStrings): Boolean; overload; +function PeFindMissingImports(RequiredImportsList, MissingImportsList: TStrings): Boolean; overload; + +function PeCreateRequiredImportList(const FileName: TFileName; RequiredImportsList: TStrings): Boolean; + +// Mapped or loaded image related routines +function PeMapImgNtHeaders(const BaseAddress: Pointer): PImageNtHeaders; + +function PeMapImgLibraryName(const BaseAddress: Pointer): string; + +function PeMapImgSections(NtHeaders: PImageNtHeaders): PImageSectionHeader; + +function PeMapImgFindSection(NtHeaders: PImageNtHeaders; + const SectionName: string): PImageSectionHeader; + +function PeMapImgExportedVariables(const Module: HMODULE; const VariablesList: TStrings): Boolean; + +function PeMapImgResolvePackageThunk(Address: Pointer): Pointer; + +function PeMapFindResource(const Module: HMODULE; const ResourceType: PChar; + const ResourceName: string): Pointer; + +type + TJclPeSectionStream = class(TCustomMemoryStream) + private + FInstance: HMODULE; + FSectionHeader: TImageSectionHeader; + procedure Initialize(Instance: HMODULE; const ASectionName: string); + public + constructor Create(Instance: HMODULE; const ASectionName: string); + function Write(const Buffer; Count: Longint): Longint; override; + property Instance: HMODULE read FInstance; + property SectionHeader: TImageSectionHeader read FSectionHeader; + end; + +// API hooking classes +type + TJclPeMapImgHookItem = class(TObject) + private + FBaseAddress: Pointer; + FFunctionName: string; + FModuleName: string; + FNewAddress: Pointer; + FOriginalAddress: Pointer; + FList: TObjectList; + protected + function InternalUnhook: Boolean; + public + destructor Destroy; override; + function Unhook: Boolean; + property BaseAddress: Pointer read FBaseAddress; + property FunctionName: string read FFunctionName; + property ModuleName: string read FModuleName; + property NewAddress: Pointer read FNewAddress; + property OriginalAddress: Pointer read FOriginalAddress; + end; + + TJclPeMapImgHooks = class(TObjectList) + private + function GetItems(Index: Integer): TJclPeMapImgHookItem; + function GetItemFromOriginalAddress(OriginalAddress: Pointer): TJclPeMapImgHookItem; + function GetItemFromNewAddress(NewAddress: Pointer): TJclPeMapImgHookItem; + public + function HookImport(Base: Pointer; const ModuleName, FunctionName: string; + NewAddress: Pointer; var OriginalAddress: Pointer): Boolean; + class function IsWin9xDebugThunk(P: Pointer): Boolean; + class function ReplaceImport(Base: Pointer; ModuleName: string; FromProc, ToProc: Pointer): Boolean; + class function SystemBase: Pointer; + procedure UnhookAll; + function UnhookByNewAddress(NewAddress: Pointer): Boolean; + property Items[Index: Integer]: TJclPeMapImgHookItem read GetItems; default; + property ItemFromOriginalAddress[OriginalAddress: Pointer]: TJclPeMapImgHookItem read GetItemFromOriginalAddress; + property ItemFromNewAddress[NewAddress: Pointer]: TJclPeMapImgHookItem read GetItemFromNewAddress; + end; + +// Image access under a debbuger +function PeDbgImgNtHeaders(ProcessHandle: THandle; BaseAddress: Pointer; + var NtHeaders: TImageNtHeaders): Boolean; + +function PeDbgImgLibraryName(ProcessHandle: THandle; BaseAddress: Pointer; + var Name: string): Boolean; + +// Borland BPL packages name unmangling +type + TJclBorUmSymbolKind = (skData, skFunction, skConstructor, skDestructor, skRTTI, skVTable); + TJclBorUmSymbolModifier = (smQualified, smLinkProc); + TJclBorUmSymbolModifiers = set of TJclBorUmSymbolModifier; + TJclBorUmDescription = record + Kind: TJclBorUmSymbolKind; + Modifiers: TJclBorUmSymbolModifiers; + end; + TJclBorUmResult = (urOk, urNotMangled, urMicrosoft, urError); + TJclPeUmResult = (umNotMangled, umBorland, umMicrosoft); + +function PeBorUnmangleName(const Name: string; var Unmangled: string; + var Description: TJclBorUmDescription; var BasePos: Integer): TJclBorUmResult; overload; +function PeBorUnmangleName(const Name: string; var Unmangled: string; + var Description: TJclBorUmDescription): TJclBorUmResult; overload; +function PeBorUnmangleName(const Name: string; var Unmangled: string): TJclBorUmResult; overload; +function PeBorUnmangleName(const Name: string): string; overload; + +function PeIsNameMangled(const Name: string): TJclPeUmResult; + +function PeUnmangleName(const Name: string; var Unmangled: string): TJclPeUmResult; + +implementation + +uses + JclLogic, JclResources, JclSysUtils; + +const + BPLExtension = '.bpl'; + DCPExtension = '.dcp'; + MANIFESTExtension = '.manifest'; + + PackageInfoResName = 'PACKAGEINFO'; + DescriptionResName = 'DESCRIPTION'; + PackageOptionsResName = 'PACKAGEOPTIONS'; + DVclAlResName = 'DVCLAL'; + + DebugSectionName = '.debug'; + ReadOnlySectionName = '.rdata'; + +// Helper routines +function AddFlagTextRes(var Text: string; const FlagText: PResStringRec; const Value, Mask: Integer): Boolean; +begin + Result := (Value and Mask <> 0); + if Result then + begin + if Length(Text) > 0 then + Text := Text + ', '; + Text := Text + LoadResString(FlagText); + end; +end; + +function CompareResourceName(T1, T2: PChar): Boolean; +begin + if (LongRec(T1).Hi = 0) or (LongRec(T2).Hi = 0) then + Result := Word(T1) = Word(T2) + else + Result := (StrIComp(T1, T2) = 0); +end; + +function CreatePeImage(const FileName: TFileName): TJclPeImage; +begin + Result := TJclPeImage.Create(True); + Result.FileName := FileName; +end; + +function InternalImportedLibraries(const FileName: TFileName; + Recursive, FullPathName: Boolean; ExternalCache: TJclPeImagesCache): TStringList; +var + Cache: TJclPeImagesCache; + + procedure ProcessLibraries(const AFileName: TFileName); + var + I: Integer; + S: string; + ImportLib: TJclPeImportLibItem; + begin + with Cache[AFileName].ImportList do + for I := 0 to Count - 1 do + begin + ImportLib := Items[I]; + if FullPathName then + S := ImportLib.FileName + else + S := ImportLib.Name; + if Result.IndexOf(S) = -1 then + begin + Result.Add(S); + if Recursive then + ProcessLibraries(ImportLib.FileName); + end; + end; + end; + +begin + if ExternalCache = nil then + Cache := TJclPeImagesCache.Create + else + Cache := ExternalCache; + try + Result := TStringList.Create; + try + Result.Sorted := True; + Result.Duplicates := dupIgnore; + ProcessLibraries(FileName); + except + FreeAndNil(Result); + raise; + end; + finally + if ExternalCache = nil then + Cache.Free; + end; +end; + +// Smart name compare function +function PeStripFunctionAW(const FunctionName: string): string; +var + L: Integer; +begin + Result := FunctionName; + L := Length(Result); + // (rom) possible bug. 'A'..'Z' missing from set (better use AnsiValidIdentifierLetters). + if (L > 1) and (Result[L] in ['A', 'W']) and + (Result[L - 1] in ['a'..'z', '_', '0'..'9']) then + Delete(Result, L, 1); +end; + +function PeSmartFunctionNameSame(const ComparedName, FunctionName: string; + Options: TJclSmartCompOptions): Boolean; +var + S: string; +begin + if scIgnoreCase in Options then + Result := StrSame(FunctionName, ComparedName) + else + Result := (FunctionName = ComparedName); + if (not Result) and not (scSimpleCompare in Options) then + begin + if Length(FunctionName) > 0 then + begin + S := PeStripFunctionAW(FunctionName); + if scIgnoreCase in Options then + Result := StrSame(S, ComparedName) + else + Result := (S = ComparedName); + end + else + Result := False; + end; +end; + +//=== { TJclPeImagesCache } ================================================== + +constructor TJclPeImagesCache.Create; +begin + inherited Create; + FList := TStringList.Create; + FList.Sorted := True; + FList.Duplicates := dupIgnore; +end; + +destructor TJclPeImagesCache.Destroy; +begin + Clear; + FreeAndNil(FList); + inherited Destroy; +end; + +procedure TJclPeImagesCache.Clear; +var + I: Integer; +begin + with FList do + for I := 0 to Count - 1 do + Objects[I].Free; + FList.Clear; +end; + +function TJclPeImagesCache.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TJclPeImagesCache.GetImages(const FileName: TFileName): TJclPeImage; +var + I: Integer; +begin + I := FList.IndexOf(FileName); + if I = -1 then + begin + Result := GetPeImageClass.Create(True); + Result.FileName := FileName; + FList.AddObject(FileName, Result); + end + else + Result := TJclPeImage(FList.Objects[I]); +end; + +function TJclPeImagesCache.GetPeImageClass: TJclPeImageClass; +begin + Result := TJclPeImage; +end; + +//=== { TJclPeBorImagesCache } =============================================== + +function TJclPeBorImagesCache.GetImages(const FileName: TFileName): TJclPeBorImage; +begin + Result := TJclPeBorImage(inherited Images[FileName]); +end; + +function TJclPeBorImagesCache.GetPeImageClass: TJclPeImageClass; +begin + Result := TJclPeBorImage; +end; + +//=== { TJclPeImageBaseList } ================================================ + +constructor TJclPeImageBaseList.Create(AImage: TJclPeImage); +begin + inherited Create(True); + FImage := AImage; +end; + +// Import sort functions + +function ImportSortByName(Item1, Item2: Pointer): Integer; +begin + Result := StrComp(TJclPeImportFuncItem(Item1).FName, TJclPeImportFuncItem(Item2).FName); + if Result = 0 then + Result := StrComp(TJclPeImportFuncItem(Item1).ImportLib.FName, TJclPeImportFuncItem(Item2).ImportLib.FName); + if Result = 0 then + Result := TJclPeImportFuncItem(Item1).Ordinal - TJclPeImportFuncItem(Item2).Ordinal; +end; + +function ImportSortByNameDESC(Item1, Item2: Pointer): Integer; +begin + Result := ImportSortByName(Item2, Item1); +end; + +function ImportSortByHint(Item1, Item2: Pointer): Integer; +begin + Result := TJclPeImportFuncItem(Item1).Hint - TJclPeImportFuncItem(Item2).Hint; +end; + +function ImportSortByHintDESC(Item1, Item2: Pointer): Integer; +begin + Result := ImportSortByHint(Item2, Item1); +end; + +function ImportSortByDll(Item1, Item2: Pointer): Integer; +begin + Result := AnsiCompareStr(TJclPeImportFuncItem(Item1).ImportLib.Name, + TJclPeImportFuncItem(Item2).ImportLib.Name); + if Result = 0 then + Result := ImportSortByName(Item1, Item2); +end; + +function ImportSortByDllDESC(Item1, Item2: Pointer): Integer; +begin + Result := ImportSortByDll(Item2, Item1); +end; + +function ImportSortByOrdinal(Item1, Item2: Pointer): Integer; +begin + Result := StrComp(TJclPeImportFuncItem(Item1).ImportLib.FName, + TJclPeImportFuncItem(Item2).ImportLib.FName); + if Result = 0 then + Result := TJclPeImportFuncItem(Item1).Ordinal - TJclPeImportFuncItem(Item2).Ordinal; +end; + +function ImportSortByOrdinalDESC(Item1, Item2: Pointer): Integer; +begin + Result := ImportSortByOrdinal(Item2, Item1); +end; + +function GetImportSortFunction(SortType: TJclPeImportSort; Descending: Boolean): TListSortCompare; +const + SortFunctions: array [TJclPeImportSort, Boolean] of TListSortCompare = + ((ImportSortByName, ImportSortByNameDESC), + (ImportSortByOrdinal, ImportSortByOrdinalDESC), + (ImportSortByHint, ImportSortByHintDESC), + (ImportSortByDll, ImportSortByDllDESC) + ); +begin + Result := SortFunctions[SortType, Descending]; +end; + +function ImportLibSortByIndex(Item1, Item2: Pointer): Integer; +begin + Result := TJclPeImportLibItem(Item1).ImportDirectoryIndex - + TJclPeImportLibItem(Item2).ImportDirectoryIndex; +end; + +function ImportLibSortByName(Item1, Item2: Pointer): Integer; +begin + Result := AnsiCompareStr(TJclPeImportLibItem(Item1).Name, TJclPeImportLibItem(Item2).Name); + if Result = 0 then + Result := ImportLibSortByIndex(Item1, Item2); +end; + +function GetImportLibSortFunction(SortType: TJclPeImportLibSort): TListSortCompare; +const + SortFunctions: array [TJclPeImportLibSort] of TListSortCompare = + (ImportLibSortByName, ImportLibSortByIndex); +begin + Result := SortFunctions[SortType]; +end; + +//=== { TJclPeImportFuncItem } =============================================== + +destructor TJclPeImportFuncItem.Destroy; +begin + SetIndirectImportName(nil); + inherited Destroy; +end; + +function TJclPeImportFuncItem.GetIsByOrdinal: Boolean; +begin + Result := FOrdinal <> 0; +end; + +function TJclPeImportFuncItem.GetName: string; +begin + Result := FName; +end; + +procedure TJclPeImportFuncItem.SetIndirectImportName(P: PChar); +begin + if FIndirectImportName then + begin + StrDispose(FName); + FIndirectImportName := False; + FName := ''; + end; + if P <> nil then + begin + FName := StrNew(P); + FIndirectImportName := True; + end; +end; + +//=== { TJclPeImportLibItem } ================================================ + +constructor TJclPeImportLibItem.Create(AImage: TJclPeImage); +begin + inherited Create(AImage); + FTotalResolveCheck := icNotChecked; +end; + +procedure TJclPeImportLibItem.CheckImports(ExportImage: TJclPeImage); +var + I: Integer; + ExportList: TJclPeExportFuncList; +begin + if ExportImage.StatusOK then + begin + FTotalResolveCheck := icResolved; + ExportList := ExportImage.ExportList; + for I := 0 to Count - 1 do + begin + with Items[I] do + if IsByOrdinal then + begin + if ExportList.OrdinalValid(Ordinal) then + FResolveCheck := icResolved + else + begin + FResolveCheck := icUnresolved; + Self.FTotalResolveCheck := icUnresolved; + end; + end + else + begin + if ExportList.ItemFromName[Items[I].Name] <> nil then + FResolveCheck := icResolved + else + begin + FResolveCheck := icUnresolved; + Self.FTotalResolveCheck := icUnresolved; + end; + end; + end; + end + else + begin + FTotalResolveCheck := icUnresolved; + for I := 0 to Count - 1 do + Items[I].FResolveCheck := icUnresolved; + end; +end; + +procedure TJclPeImportLibItem.CreateList; +var + FuncItem: TJclPeImportFuncItem; + OrdinalName: PImageImportByName; +begin + if FThunk = nil then + Exit; + while FThunk^.Function_ <> 0 do + begin + FuncItem := TJclPeImportFuncItem.Create; + FuncItem.FImportLib := Self; + FuncItem.FResolveCheck := icNotChecked; + if FThunk^.Ordinal and IMAGE_ORDINAL_FLAG <> 0 then + begin + FuncItem.FOrdinal := IMAGE_ORDINAL(FThunk^.Ordinal); + FuncItem.FName := #0; + end + else + begin + case ImportKind of + ikImport, ikBoundImport: + OrdinalName := PImageImportByName(Image.RvaToVa(DWORD(FThunk^.AddressOfData))); + ikDelayImport: + OrdinalName := PImageImportByName(Image.RvaToVaEx(DWORD(FThunk^.AddressOfData))); + else + OrdinalName := nil; + end; + FuncItem.FHint := OrdinalName.Hint; + FuncItem.FName := OrdinalName.Name; + end; + Add(FuncItem); + Inc(FThunk); + end; + FThunk := nil; +end; + +function TJclPeImportLibItem.GetCount: Integer; +begin + if FThunk <> nil then + CreateList; + Result := inherited Count; +end; + +function TJclPeImportLibItem.GetFileName: TFileName; +begin + Result := FImage.ExpandModuleName(Name); +end; + +function TJclPeImportLibItem.GetItems(Index: Integer): TJclPeImportFuncItem; +begin + Result := TJclPeImportFuncItem(Get(Index)); +end; + +function TJclPeImportLibItem.GetName: string; +begin + Result := AnsiLowerCase(OriginalName); +end; + +function TJclPeImportLibItem.GetOriginalName: string; +begin + Result := FName; +end; + +procedure TJclPeImportLibItem.SortList(SortType: TJclPeImportSort; Descending: Boolean); +begin + if not FSorted or (SortType <> FLastSortType) or (Descending <> FLastSortDescending) then + begin + GetCount; // create list if it wasn't created + Sort(GetImportSortFunction(SortType, Descending)); + FLastSortType := SortType; + FLastSortDescending := Descending; + FSorted := True; + end; +end; + +//=== { TJclPeImportList } =================================================== + +constructor TJclPeImportList.Create(AImage: TJclPeImage); +begin + inherited Create(AImage); + FAllItemsList := TList.Create; + FAllItemsList.Capacity := 256; + FUniqueNamesList := TStringList.Create; + FUniqueNamesList.Sorted := True; + FUniqueNamesList.Duplicates := dupIgnore; + FLastAllSortType := isName; + FLastAllSortDescending := False; + CreateList; +end; + +destructor TJclPeImportList.Destroy; +var + I: Integer; +begin + FreeAndNil(FAllItemsList); + FreeAndNil(FUniqueNamesList); + for I := 0 to Length(FParalelImportTable) - 1 do + FreeMem(FParalelImportTable[I]); + inherited Destroy; +end; + +procedure TJclPeImportList.CheckImports(PeImageCache: TJclPeImagesCache); +var + I: Integer; + ExportPeImage: TJclPeImage; +begin + FImage.CheckNotAttached; + if PeImageCache <> nil then + ExportPeImage := nil // to make the compiler happy + else + ExportPeImage := TJclPeImage.Create(True); + try + for I := 0 to Count - 1 do + if Items[I].TotalResolveCheck = icNotChecked then + begin + if PeImageCache <> nil then + ExportPeImage := PeImageCache[Items[I].FileName] + else + ExportPeImage.FileName := Items[I].FileName; + ExportPeImage.ExportList.PrepareForFastNameSearch; + Items[I].CheckImports(ExportPeImage); + end; + finally + if PeImageCache = nil then + ExportPeImage.Free; + end; +end; + +procedure TJclPeImportList.CreateList; +var + ImportDesc: PImageImportDescriptor; + LibItem: TJclPeImportLibItem; + DelayImportDesc: PImgDelayDescr; + BoundImports, BoundImport: PImageBoundImportDescriptor; + S: string; + I: Integer; +begin + SetCapacity(100); + with Image do + begin + if not StatusOK then + Exit; + ImportDesc := DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_IMPORT); + if ImportDesc <> nil then + while ImportDesc^.Name <> 0 do + begin + LibItem := TJclPeImportLibItem.Create(Image); + LibItem.FImportDescriptor := ImportDesc; + LibItem.FName := RvaToVa(ImportDesc^.Name); + LibItem.FImportKind := ikImport; + if ImportDesc^.Union.Characteristics = 0 then + begin + if FAttachedImage then // Borland images doesn't have two paralel arrays + LibItem.FThunk := nil // see MakeBorlandImportTableForMappedImage method + else + LibItem.FThunk := PImageThunkData(RvaToVa(ImportDesc^.FirstThunk)); + FLinkerProducer := lrBorland; + end + else + begin + LibItem.FThunk := PImageThunkData(RvaToVa(ImportDesc^.Union.Characteristics)); + FLinkerProducer := lrMicrosoft; + end; + LibItem.FThunkData := LibItem.FThunk; + Add(LibItem); + FUniqueNamesList.AddObject(AnsiLowerCase(LibItem.Name), LibItem); + Inc(ImportDesc); + end; + DelayImportDesc := DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT); + if DelayImportDesc <> nil then + begin + while DelayImportDesc^.szName <> 0 do + begin + LibItem := TJclPeImportLibItem.Create(Image); + LibItem.FImportKind := ikDelayImport; + LibItem.FImportDescriptor := DelayImportDesc; + LibItem.FName := RvaToVaEx(DelayImportDesc^.szName); + LibItem.FThunk := PImageThunkData(RvaToVaEx(DelayImportDesc^.pINT.AddressOfData)); + Add(LibItem); + FUniqueNamesList.AddObject(AnsiLowerCase(LibItem.Name), LibItem); + Inc(DelayImportDesc); + end; + end; + BoundImports := DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT); + if BoundImports <> nil then + begin + BoundImport := BoundImports; + while BoundImport^.OffsetModuleName <> 0 do + begin + S := AnsiLowerCase(PChar(DWORD(BoundImports) + BoundImport^.OffsetModuleName)); + I := FUniqueNamesList.IndexOf(S); + if I >= 0 then + TJclPeImportLibItem(FUniqueNamesList.Objects[I]).FImportKind := ikBoundImport; + for I := 1 to BoundImport^.NumberOfModuleForwarderRefs do + Inc(PImageBoundForwarderRef(BoundImport)); // skip forward information + Inc(BoundImport); + end; + end; + end; + for I := 0 to Count - 1 do + Items[I].FImportDirectoryIndex := I; +end; + +function TJclPeImportList.GetAllItemCount: Integer; +begin + Result := FAllItemsList.Count; + if Result = 0 then // we haven't created the list yet -> create unsorted list + begin + RefreshAllItems; + Result := FAllItemsList.Count; + end; +end; + +function TJclPeImportList.GetAllItems(Index: Integer): TJclPeImportFuncItem; +begin + Result := TJclPeImportFuncItem(FAllItemsList[Index]); +end; + +function TJclPeImportList.GetItems(Index: Integer): TJclPeImportLibItem; +begin + Result := TJclPeImportLibItem(Get(Index)); +end; + +function TJclPeImportList.GetUniqueLibItemCount: Integer; +begin + Result := FUniqueNamesList.Count; +end; + +function TJclPeImportList.GetUniqueLibItemFromName(const Name: string): TJclPeImportLibItem; +var + I: Integer; +begin + I := FUniqueNamesList.IndexOf(Name); + if I = -1 then + Result := nil + else + Result := TJclPeImportLibItem(FUniqueNamesList.Objects[I]); +end; + +function TJclPeImportList.GetUniqueLibItems(Index: Integer): TJclPeImportLibItem; +begin + Result := TJclPeImportLibItem(FUniqueNamesList.Objects[Index]); +end; + +function TJclPeImportList.GetUniqueLibNames(Index: Integer): string; +begin + Result := FUniqueNamesList[Index]; +end; + +function TJclPeImportList.MakeBorlandImportTableForMappedImage: Boolean; +var + FileImage: TJclPeImage; + I, TableSize: Integer; +begin + if FImage.FAttachedImage and (FLinkerProducer = lrBorland) and + (Length(FParalelImportTable) = 0) then + begin + FileImage := TJclPeImage.Create(True); + try + FileImage.FileName := FImage.FileName; + Result := FileImage.StatusOK; + if Result then + begin + SetLength(FParalelImportTable, FileImage.ImportList.Count); + for I := 0 to FileImage.ImportList.Count - 1 do + begin + Assert(Items[I].ImportKind = ikImport); // Borland doesn't have Delay load or Bound imports + TableSize := (FileImage.ImportList[I].Count + 1) * SizeOf(TImageThunkData); + GetMem(FParalelImportTable[I], TableSize); + System.Move(FileImage.ImportList[I].ThunkData^, FParalelImportTable[I]^, TableSize); + Items[I].FThunk := FParalelImportTable[I]; + end; + end; + finally + FileImage.Free; + end; + end + else + Result := True; +end; + +procedure TJclPeImportList.RefreshAllItems; +var + L, I: Integer; + LibItem: TJclPeImportLibItem; +begin + FAllItemsList.Clear; + for L := 0 to Count - 1 do + begin + LibItem := Items[L]; + if (Length(FFilterModuleName) = 0) or (AnsiCompareText(LibItem.Name, FFilterModuleName) = 0) then + for I := 0 to LibItem.Count - 1 do + FAllItemsList.Add(LibItem[I]); + end; +end; + +procedure TJclPeImportList.SetFilterModuleName(const Value: string); +begin + if (FFilterModuleName <> Value) or (FAllItemsList.Count = 0) then + begin + FFilterModuleName := Value; + RefreshAllItems; + FAllItemsList.Sort(GetImportSortFunction(FLastAllSortType, FLastAllSortDescending)); + end; +end; + +function TJclPeImportList.SmartFindName(const CompareName, LibName: string; + Options: TJclSmartCompOptions): TJclPeImportFuncItem; +var + L, I: Integer; + LibItem: TJclPeImportLibItem; +begin + Result := nil; + for L := 0 to Count - 1 do + begin + LibItem := Items[L]; + if (Length(LibName) = 0) or (AnsiCompareText(LibItem.Name, LibName) = 0) then + for I := 0 to LibItem.Count - 1 do + if PeSmartFunctionNameSame(CompareName, LibItem[I].Name, Options) then + begin + Result := LibItem[I]; + Break; + end; + end; +end; + +procedure TJclPeImportList.SortAllItemsList(SortType: TJclPeImportSort; Descending: Boolean); +begin + GetAllItemCount; // create list if it wasn't created + FAllItemsList.Sort(GetImportSortFunction(SortType, Descending)); + FLastAllSortType := SortType; + FLastAllSortDescending := Descending; +end; + +procedure TJclPeImportList.SortList(SortType: TJclPeImportLibSort); +begin + Sort(GetImportLibSortFunction(SortType)); +end; + +procedure TJclPeImportList.TryGetNamesForOrdinalImports; +var + LibNamesList: TStringList; + L, I: Integer; + LibPeDump: TJclPeImage; + + procedure TryGetNames(const ModuleName: string); + var + Item: TJclPeImportFuncItem; + I, L: Integer; + ImportLibItem: TJclPeImportLibItem; + ExportItem: TJclPeExportFuncItem; + ExportList: TJclPeExportFuncList; + begin + if FImage.FAttachedImage then + LibPeDump.AttachLoadedModule(GetModuleHandle(PChar(ModuleName))) + else + LibPeDump.FileName := FImage.ExpandModuleName(ModuleName); + if not LibPeDump.StatusOK then + Exit; + ExportList := LibPeDump.ExportList; + for L := 0 to Count - 1 do + begin + ImportLibItem := Items[L]; + if AnsiCompareText(ImportLibItem.Name, ModuleName) = 0 then + begin + for I := 0 to ImportLibItem.Count - 1 do + begin + Item := ImportLibItem[I]; + if Item.IsByOrdinal then + begin + ExportItem := ExportList.ItemFromOrdinal[Item.Ordinal]; + if (ExportItem <> nil) and (ExportItem.FName <> nil) then + Item.SetIndirectImportName(ExportItem.FName); + end; + end; + ImportLibItem.FSorted := False; + end; + end; + end; + +begin + LibNamesList := TStringList.Create; + try + LibNamesList.Sorted := True; + LibNamesList.Duplicates := dupIgnore; + for L := 0 to Count - 1 do + with Items[L] do + for I := 0 to Count - 1 do + if Items[I].IsByOrdinal then + LibNamesList.Add(AnsiUpperCase(Name)); + LibPeDump := TJclPeImage.Create(True); + try + for I := 0 to LibNamesList.Count - 1 do + TryGetNames(LibNamesList[I]); + finally + LibPeDump.Free; + end; + SortAllItemsList(FLastAllSortType, FLastAllSortDescending); + finally + LibNamesList.Free; + end; +end; + +//=== { TJclPeExportFuncItem } =============================================== + +procedure TJclPeExportFuncItem.FindForwardedDotPos; +begin + if (FForwardedName <> nil) and (FForwardedDotPos = nil) then + FForwardedDotPos := StrPos(FForwardedName, '.'); +end; + +function TJclPeExportFuncItem.GetAddressOrForwardStr: string; +begin + if IsForwarded then + Result := ForwardedName + else + FmtStr(Result, '%.8x', [Address]); +end; + +function TJclPeExportFuncItem.GetForwardedFuncName: string; +begin + FindForwardedDotPos; + if (FForwardedDotPos <> nil) and (FForwardedDotPos + 1 <> '#') then + Result := PChar(FForwardedDotPos + 1) + else + Result := ''; +end; + +function TJclPeExportFuncItem.GetForwardedFuncOrdinal: DWORD; +begin + FindForwardedDotPos; + if (FForwardedDotPos <> nil) and (FForwardedDotPos + 1 = '#') then + Result := StrToIntDef(FForwardedDotPos + 2, 0) + else + Result := 0; +end; + +function TJclPeExportFuncItem.GetForwardedLibName: string; +begin + FindForwardedDotPos; + if FForwardedDotPos = nil then + Result := '' + else + begin + SetString(Result, FForwardedName, FForwardedDotPos - FForwardedName); + Result := AnsiLowerCase(Result) + '.dll'; + end; +end; + +function TJclPeExportFuncItem.GetForwardedName: string; +begin + Result := FForwardedName; +end; + +function TJclPeExportFuncItem.GetIsExportedVariable: Boolean; +begin + Result := (Address >= FExportList.FImage.OptionalHeader.BaseOfData); +end; + +function TJclPeExportFuncItem.GetIsForwarded: Boolean; +begin + Result := FForwardedName <> nil; +end; + +function TJclPeExportFuncItem.GetMappedAddress: Pointer; +begin + Result := FExportList.FImage.RvaToVa(FAddress); +end; + +function TJclPeExportFuncItem.GetName: string; +begin + Result := FName; +end; + +function TJclPeExportFuncItem.GetSectionName: string; +begin + if IsForwarded then + Result := '' + else + with FExportList.FImage do + Result := ImageSectionNameFromRva[Address]; +end; + +// Export sort functions +function ExportSortByName(Item1, Item2: Pointer): Integer; +begin + Result := StrComp(TJclPeExportFuncItem(Item1).FName, TJclPeExportFuncItem(Item2).FName); +end; + +function ExportSortByNameDESC(Item1, Item2: Pointer): Integer; +begin + Result := ExportSortByName(Item2, Item1); +end; + +function ExportSortByOrdinal(Item1, Item2: Pointer): Integer; +begin + Result := TJclPeExportFuncItem(Item1).Ordinal - TJclPeExportFuncItem(Item2).Ordinal; +end; + +function ExportSortByOrdinalDESC(Item1, Item2: Pointer): Integer; +begin + Result := ExportSortByOrdinal(Item2, Item1); +end; + +function ExportSortByHint(Item1, Item2: Pointer): Integer; +begin + Result := TJclPeExportFuncItem(Item1).Hint - TJclPeExportFuncItem(Item2).Hint; +end; + +function ExportSortByHintDESC(Item1, Item2: Pointer): Integer; +begin + Result := ExportSortByHint(Item2, Item1); +end; + +function ExportSortByAddress(Item1, Item2: Pointer): Integer; +begin + Result := Integer(TJclPeExportFuncItem(Item1).Address) - Integer(TJclPeExportFuncItem(Item2).Address); + if Result = 0 then + Result := ExportSortByName(Item1, Item2); +end; + +function ExportSortByAddressDESC(Item1, Item2: Pointer): Integer; +begin + Result := ExportSortByAddress(Item2, Item1); +end; + +function ExportSortByForwarded(Item1, Item2: Pointer): Integer; +begin + Result := CompareStr(TJclPeExportFuncItem(Item1).ForwardedName, TJclPeExportFuncItem(Item2).ForwardedName); + if Result = 0 then + Result := ExportSortByName(Item1, Item2); +end; + +function ExportSortByForwardedDESC(Item1, Item2: Pointer): Integer; +begin + Result := ExportSortByForwarded(Item2, Item1); +end; + +function ExportSortByAddrOrFwd(Item1, Item2: Pointer): Integer; +begin + Result := CompareStr(TJclPeExportFuncItem(Item1).AddressOrForwardStr, TJclPeExportFuncItem(Item2).AddressOrForwardStr); +end; + +function ExportSortByAddrOrFwdDESC(Item1, Item2: Pointer): Integer; +begin + Result := ExportSortByAddrOrFwd(Item2, Item1); +end; + +function ExportSortBySection(Item1, Item2: Pointer): Integer; +begin + Result := CompareStr(TJclPeExportFuncItem(Item1).SectionName, TJclPeExportFuncItem(Item2).SectionName); + if Result = 0 then + Result := ExportSortByName(Item1, Item2); +end; + +function ExportSortBySectionDESC(Item1, Item2: Pointer): Integer; +begin + Result := ExportSortBySection(Item2, Item1); +end; + +//=== { TJclPeExportFuncList } =============================================== + +constructor TJclPeExportFuncList.Create(AImage: TJclPeImage); +begin + inherited Create(AImage); + FTotalResolveCheck := icNotChecked; + CreateList; +end; + +destructor TJclPeExportFuncList.Destroy; +begin + FreeAndNil(FForwardedLibsList); + inherited Destroy; +end; + +function TJclPeExportFuncList.CanPerformFastNameSearch: Boolean; +begin + Result := FSorted and (FLastSortType = esName) and not FLastSortDescending; +end; + +procedure TJclPeExportFuncList.CheckForwards(PeImageCache: TJclPeImagesCache); +var + I: Integer; + FullFileName: TFileName; + ForwardPeImage: TJclPeImage; + ModuleResolveCheck: TJclPeResolveCheck; + + procedure PerformCheck(const ModuleName: string); + var + I: Integer; + Item: TJclPeExportFuncItem; + EL: TJclPeExportFuncList; + begin + EL := ForwardPeImage.ExportList; + EL.PrepareForFastNameSearch; + ModuleResolveCheck := icResolved; + for I := 0 to Count - 1 do + begin + Item := Items[I]; + if (not Item.IsForwarded) or (Item.ResolveCheck <> icNotChecked) or + (Item.ForwardedLibName <> ModuleName) then + Continue; + if EL.ItemFromName[Item.ForwardedFuncName] = nil then + begin + Item.FResolveCheck := icUnresolved; + ModuleResolveCheck := icUnresolved; + end + else + Item.FResolveCheck := icResolved; + end; + end; + +begin + if not AnyForwards then + Exit; + FTotalResolveCheck := icResolved; + if PeImageCache <> nil then + ForwardPeImage := nil // to make the compiler happy + else + ForwardPeImage := TJclPeImage.Create(True); + try + for I := 0 to ForwardedLibsList.Count - 1 do + begin + FullFileName := FImage.ExpandModuleName(ForwardedLibsList[I]); + if PeImageCache <> nil then + ForwardPeImage := PeImageCache[FullFileName] + else + ForwardPeImage.FileName := FullFileName; + if ForwardPeImage.StatusOK then + PerformCheck(ForwardedLibsList[I]) + else + ModuleResolveCheck := icUnresolved; + FForwardedLibsList.Objects[I] := Pointer(ModuleResolveCheck); + if ModuleResolveCheck = icUnresolved then + FTotalResolveCheck := icUnresolved; + end; + finally + if PeImageCache = nil then + ForwardPeImage.Free; + end; +end; + +procedure TJclPeExportFuncList.CreateList; +var + Functions: DWORD; + NameOrdinals: PWORD; + Names: PDWORD; + I: Integer; + ExportItem: TJclPeExportFuncItem; + ExportVABegin, ExportVAEnd: DWORD; +begin + with FImage do + begin + if not StatusOK then + Exit; + with Directories[IMAGE_DIRECTORY_ENTRY_EXPORT] do + begin + ExportVABegin := VirtualAddress; + ExportVAEnd := VirtualAddress + Size; + end; + FExportDir := DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_EXPORT); + if FExportDir <> nil then + begin + FBase := FExportDir^.Base; + FFunctionCount := FExportDir^.NumberOfFunctions; + Functions := DWORD(RvaToVa(DWORD(FExportDir^.AddressOfFunctions))); + NameOrdinals := RvaToVa(DWORD(FExportDir^.AddressOfNameOrdinals)); + Names := RvaToVa(DWORD(FExportDir^.AddressOfNames)); + Count := FExportDir^.NumberOfNames; + for I := 0 to FExportDir^.NumberOfNames - 1 do + begin + ExportItem := TJclPeExportFuncItem.Create; + ExportItem.FExportList := Self; + ExportItem.FOrdinal := NameOrdinals^ + FBase; + ExportItem.FAddress := PDWORD(Functions + NameOrdinals^ * SizeOf(DWORD))^; + ExportItem.FHint := I; + ExportItem.FName := RvaToVa(DWORD(Names^)); + ExportItem.FResolveCheck := icNotChecked; + if (ExportItem.FAddress >= ExportVABegin) and (ExportItem.FAddress <= ExportVAEnd) then + begin + FAnyForwards := True; + ExportItem.FForwardedName := RvaToVa(ExportItem.FAddress); + end + else + ExportItem.FForwardedName := nil; + List^[I] := ExportItem; + Inc(NameOrdinals); + Inc(Names); + end; + end; + end; +end; + +function TJclPeExportFuncList.GetForwardedLibsList: TStrings; +var + I: Integer; +begin + if FForwardedLibsList = nil then + begin + FForwardedLibsList := TStringList.Create; + FForwardedLibsList.Sorted := True; + FForwardedLibsList.Duplicates := dupIgnore; + if FAnyForwards then + for I := 0 to Count - 1 do + with Items[I] do + if IsForwarded then + FForwardedLibsList.AddObject(ForwardedLibName, Pointer(icNotChecked)); + end; + Result := FForwardedLibsList; +end; + +function TJclPeExportFuncList.GetItemFromAddress(Address: DWORD): TJclPeExportFuncItem; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].Address = Address then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclPeExportFuncList.GetItemFromName(const Name: string): TJclPeExportFuncItem; +var + L, H, I, C: Integer; + B: Boolean; +begin + Result := nil; + if CanPerformFastNameSearch then + begin + L := 0; + H := Count - 1; + B := False; + while L <= H do + begin + I := (L + H) shr 1; + C := CompareStr(Items[I].Name, Name); + if C < 0 then + L := I + 1 + else + begin + H := I - 1; + if C = 0 then + begin + B := True; + L := I; + end; + end; + end; + if B then + Result := Items[L]; + end + else + for I := 0 to Count - 1 do + if Items[I].Name = Name then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclPeExportFuncList.GetItemFromOrdinal(Ordinal: DWORD): TJclPeExportFuncItem; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].Ordinal = Ordinal then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclPeExportFuncList.GetItems(Index: Integer): TJclPeExportFuncItem; +begin + Result := TJclPeExportFuncItem(Get(Index)); +end; + +function TJclPeExportFuncList.GetName: string; +begin + if (FExportDir = nil) or (FExportDir^.Name = 0) then + Result := '' + else + Result := PChar(Image.RvaToVa(FExportDir^.Name)); +end; + +class function TJclPeExportFuncList.ItemName(Item: TJclPeExportFuncItem): string; +begin + if Item = nil then + Result := '' + else + Result := Item.Name; +end; + +function TJclPeExportFuncList.OrdinalValid(Ordinal: DWORD): Boolean; +begin + Result := (FExportDir <> nil) and (Ordinal >= Base) and + (Ordinal < FunctionCount + Base); +end; + +procedure TJclPeExportFuncList.PrepareForFastNameSearch; +begin + if not CanPerformFastNameSearch then + SortList(esName, False); +end; + +function TJclPeExportFuncList.SmartFindName(const CompareName: string; + Options: TJclSmartCompOptions): TJclPeExportFuncItem; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + begin + if PeSmartFunctionNameSame(CompareName, Items[I].Name, Options) then + begin + Result := Items[I]; + Break; + end; + end; +end; + +procedure TJclPeExportFuncList.SortList(SortType: TJclPeExportSort; Descending: Boolean); +const + SortFunctions: array [TJclPeExportSort, Boolean] of TListSortCompare = + ((ExportSortByName, ExportSortByNameDESC), + (ExportSortByOrdinal, ExportSortByOrdinalDESC), + (ExportSortByHint, ExportSortByHintDESC), + (ExportSortByAddress, ExportSortByAddressDESC), + (ExportSortByForwarded, ExportSortByForwardedDESC), + (ExportSortByAddrOrFwd, ExportSortByAddrOrFwdDESC), + (ExportSortBySection, ExportSortBySectionDESC) + ); +begin + if not FSorted or (SortType <> FLastSortType) or (Descending <> FLastSortDescending) then + begin + Sort(SortFunctions[SortType, Descending]); + FLastSortType := SortType; + FLastSortDescending := Descending; + FSorted := True; + end; +end; + +//=== { TJclPeResourceRawStream } ============================================ + +constructor TJclPeResourceRawStream.Create(AResourceItem: TJclPeResourceItem); +begin + Assert(not AResourceItem.IsDirectory); + inherited Create; + SetPointer(AResourceItem.RawEntryData, AResourceItem.RawEntryDataSize); +end; + +function TJclPeResourceRawStream.Write(const Buffer; Count: Integer): Longint; +begin + raise EJclPeImageError.CreateRes(@RsPeReadOnlyStream); +end; + +//=== { TJclPeResourceItem } ================================================= + +constructor TJclPeResourceItem.Create(AImage: TJclPeImage; + AParentItem: TJclPeResourceItem; AEntry: PImageResourceDirectoryEntry); +begin + inherited Create; + FImage := AImage; + FEntry := AEntry; + FParentItem := AParentItem; + if AParentItem = nil then + FLevel := 1 + else + FLevel := AParentItem.Level + 1; +end; + +destructor TJclPeResourceItem.Destroy; +begin + FreeAndNil(FList); + inherited Destroy; +end; + +function TJclPeResourceItem.CompareName(AName: PChar): Boolean; +var + P: PChar; +begin + if IsName then + P := PChar(Name) + else + P := PChar(FEntry^.Name and $FFFF); + Result := CompareResourceName(AName, P); +end; + +function TJclPeResourceItem.GetDataEntry: PImageResourceDataEntry; +begin + if GetIsDirectory then + Result := nil + else + Result := PImageResourceDataEntry(OffsetToRawData(FEntry^.OffsetToData)); +end; + +function TJclPeResourceItem.GetIsDirectory: Boolean; +begin + Result := FEntry^.OffsetToData and IMAGE_RESOURCE_DATA_IS_DIRECTORY <> 0; +end; + +function TJclPeResourceItem.GetIsName: Boolean; +begin + Result := FEntry^.Name and IMAGE_RESOURCE_NAME_IS_STRING <> 0; +end; + +function TJclPeResourceItem.GetLangID: LANGID; +begin + if IsDirectory then + begin + GetList; + if FList.Count = 1 then + Result := StrToIntDef(FList[0].Name, 0) + else + Result := 0; + end + else + Result := StrToIntDef(Name, 0); +end; + +function TJclPeResourceItem.GetList: TJclPeResourceList; +begin + if not IsDirectory then + begin + if FImage.FNoExceptions then + begin + Result := nil; + Exit; + end + else + raise EJclPeImageError.CreateRes(@RsPeNotResDir); + end; + if FList = nil then + FList := FImage.ResourceListCreate(SubDirData, Self); + Result := FList; +end; + +function TJclPeResourceItem.GetName: string; +begin + if IsName then + begin + if FNameCache = '' then + begin + with PImageResourceDirStringU(OffsetToRawData(FEntry^.Name))^ do + FNameCache := WideCharLenToString(NameString, Length); + StrResetLength(FNameCache); + end; + Result := FNameCache; + end + else + Result := IntToStr(FEntry^.Name and $FFFF); +end; + +function TJclPeResourceItem.GetParameterName: string; +begin + if IsName then + Result := Name + else + Result := Format('#%d', [FEntry^.Name and $FFFF]); +end; + +function TJclPeResourceItem.GetRawEntryData: Pointer; +begin + if GetIsDirectory then + Result := nil + else + Result := FImage.RvaToVa(GetDataEntry^.OffsetToData); +end; + +function TJclPeResourceItem.GetRawEntryDataSize: Integer; +begin + if GetIsDirectory then + Result := -1 + else + Result := PImageResourceDataEntry(OffsetToRawData(FEntry^.OffsetToData))^.Size; +end; + +function TJclPeResourceItem.GetResourceType: TJclPeResourceKind; +begin + with Level1Item do + begin + if FEntry^.Name < Cardinal(High(TJclPeResourceKind)) then + Result := TJclPeResourceKind(FEntry^.Name) + else + Result := rtUserDefined + end; +end; + +function TJclPeResourceItem.GetResourceTypeStr: string; +begin + with Level1Item do + begin + if FEntry^.Name < Cardinal(High(TJclPeResourceKind)) then + Result := Copy(GetEnumName(TypeInfo(TJclPeResourceKind), Ord(FEntry^.Name)), 3, 30) + else + Result := Name; + end; +end; + +function TJclPeResourceItem.Level1Item: TJclPeResourceItem; +begin + Result := Self; + while Result.FParentItem <> nil do + Result := Result.FParentItem; +end; + +function TJclPeResourceItem.OffsetToRawData(Ofs: DWORD): DWORD; +begin + Result := (Ofs and $7FFFFFFF) + FImage.FResourceVA; +end; + +function TJclPeResourceItem.SubDirData: PImageResourceDirectory; +begin + Result := Pointer(OffsetToRawData(FEntry^.OffsetToData)); +end; + +//=== { TJclPeResourceList } ================================================= + +constructor TJclPeResourceList.Create(AImage: TJclPeImage; + AParentItem: TJclPeResourceItem; ADirectory: PImageResourceDirectory); +begin + inherited Create(AImage); + FDirectory := ADirectory; + FParentItem := AParentItem; + CreateList(AParentItem); +end; + +procedure TJclPeResourceList.CreateList(AParentItem: TJclPeResourceItem); +var + Entry: PImageResourceDirectoryEntry; + DirItem: TJclPeResourceItem; + I: Integer; +begin + if FDirectory = nil then + Exit; + Entry := Pointer(DWORD(FDirectory) + SizeOf(TImageResourceDirectory)); + for I := 1 to FDirectory^.NumberOfNamedEntries + FDirectory^.NumberOfIdEntries do + begin + DirItem := FImage.ResourceItemCreate(Entry, AParentItem); + Add(DirItem); + Inc(Entry); + end; +end; + +function TJclPeResourceList.FindName(const Name: string): TJclPeResourceItem; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if StrSame(Items[I].Name, Name) then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclPeResourceList.GetItems(Index: Integer): TJclPeResourceItem; +begin + Result := TJclPeResourceItem(Get(Index)); +end; + +//=== { TJclPeRootResourceList } ============================================= + +destructor TJclPeRootResourceList.Destroy; +begin + FreeAndNil(FManifestContent); + inherited Destroy; +end; + +function TJclPeRootResourceList.FindResource(ResourceType: TJclPeResourceKind; + const ResourceName: string): TJclPeResourceItem; +var + I: Integer; + TypeItem: TJclPeResourceItem; +begin + Result := nil; + TypeItem := nil; + for I := 0 to Count - 1 do + begin + if Items[I].ResourceType = ResourceType then + begin + TypeItem := Items[I]; + Break; + end; + end; + if TypeItem <> nil then + if ResourceName = '' then + Result := TypeItem + else + with TypeItem.List do + for I := 0 to Count - 1 do + if Items[I].Name = ResourceName then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclPeRootResourceList.FindResource(const ResourceType: PChar; + const ResourceName: PChar): TJclPeResourceItem; +var + I: Integer; + TypeItem: TJclPeResourceItem; +begin + Result := nil; + TypeItem := nil; + for I := 0 to Count - 1 do + if Items[I].CompareName(ResourceType) then + begin + TypeItem := Items[I]; + Break; + end; + if TypeItem <> nil then + if ResourceName = nil then + Result := TypeItem + else + with TypeItem.List do + for I := 0 to Count - 1 do + if Items[I].CompareName(ResourceName) then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclPeRootResourceList.GetManifestContent: TStrings; +var + ManifestFileName: string; + ResItem: TJclPeResourceItem; + ResStream: TJclPeResourceRawStream; +begin + if FManifestContent = nil then + begin + FManifestContent := TStringList.Create; + ResItem := FindResource(RT_MANIFEST, CREATEPROCESS_MANIFEST_RESOURCE_ID); + if ResItem = nil then + begin + ManifestFileName := Image.FileName + MANIFESTExtension; + if FileExists(ManifestFileName) then + FManifestContent.LoadFromFile(ManifestFileName); + end + else + begin + ResStream := TJclPeResourceRawStream.Create(ResItem.List[0]); + try + FManifestContent.LoadFromStream(ResStream); + finally + ResStream.Free; + end; + end; + end; + Result := FManifestContent; +end; + +function TJclPeRootResourceList.ListResourceNames(ResourceType: TJclPeResourceKind; + const Strings: TStrings): Boolean; +var + ResTypeItem, TempItem: TJclPeResourceItem; + I: Integer; +begin + ResTypeItem := FindResource(ResourceType, ''); + Result := (ResTypeItem <> nil); + if Result then + begin + Strings.BeginUpdate; + try + with ResTypeItem.List do + for I := 0 to Count - 1 do + begin + TempItem := Items[I]; + Strings.AddObject(TempItem.Name, Pointer(TempItem.IsName)); + end; + finally + Strings.EndUpdate; + end; + end; +end; + +//=== { TJclPeRelocEntry } =================================================== + +function TJclPeRelocEntry.GetRelocations(Index: Integer): TJclPeRelocation; +var + Temp: Word; +begin + Temp := PWord(DWORD(FChunk) + SizeOf(TImageBaseRelocation) + DWORD(Index) * SizeOf(Word))^; + Result.Address := Temp and $0FFF; + Result.RelocType := (Temp and $F000) shr 12; + Result.VirtualAddress := Result.Address + VirtualAddress; +end; + +function TJclPeRelocEntry.GetSize: DWORD; +begin + Result := FChunk^.SizeOfBlock; +end; + +function TJclPeRelocEntry.GetVirtualAddress: DWORD; +begin + Result := FChunk^.VirtualAddress; +end; + +//=== { TJclPeRelocList } ==================================================== + +constructor TJclPeRelocList.Create(AImage: TJclPeImage); +begin + inherited Create(AImage); + CreateList; +end; + +procedure TJclPeRelocList.CreateList; +var + Chunk: PImageBaseRelocation; + Item: TJclPeRelocEntry; +begin + with FImage do + begin + if not StatusOK then + Exit; + Chunk := DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_BASERELOC); + if Chunk = nil then + Exit; + FAllItemCount := 0; + while Chunk^.SizeOfBlock <> 0 do + begin + Item := TJclPeRelocEntry.Create; + Item.FChunk := Chunk; + Item.FCount := (Chunk^.SizeOfBlock - SizeOf(TImageBaseRelocation)) div SizeOf(Word); + Inc(FAllItemCount, Item.FCount); + Add(Item); + Chunk := Pointer(DWORD(Chunk) + Chunk^.SizeOfBlock); + end; + end; +end; + +function TJclPeRelocList.GetAllItems(Index: Integer): TJclPeRelocation; +var + I, N, C: Integer; +begin + N := Index; + for I := 0 to Count - 1 do + begin + C := Items[I].Count; + Dec(N, C); + if N < 0 then + begin + Result := Items[I][N + C]; + Break; + end; + end; +end; + +function TJclPeRelocList.GetItems(Index: Integer): TJclPeRelocEntry; +begin + Result := TJclPeRelocEntry(Get(Index)); +end; + +//=== { TJclPeDebugList } ==================================================== + +constructor TJclPeDebugList.Create(AImage: TJclPeImage); +begin + inherited Create(AImage); + OwnsObjects := False; + CreateList; +end; + +procedure TJclPeDebugList.CreateList; +var + DebugImageDir: TImageDataDirectory; + DebugDir: PImageDebugDirectory; + Header: PImageSectionHeader; + FormatCount, I: Integer; +begin + with FImage do + begin + if not StatusOK then + Exit; + DebugImageDir := Directories[IMAGE_DIRECTORY_ENTRY_DEBUG]; + if DebugImageDir.VirtualAddress = 0 then + Exit; + if GetSectionHeader(DebugSectionName, Header) and + (Header^.VirtualAddress = DebugImageDir.VirtualAddress) then + begin + FormatCount := DebugImageDir.Size; + DebugDir := RvaToVa(Header^.VirtualAddress); + end + else + begin + if not GetSectionHeader(ReadOnlySectionName, Header) then + Exit; + FormatCount := DebugImageDir.Size div SizeOf(TImageDebugDirectory); + DebugDir := Pointer(MappedAddress + DebugImageDir.VirtualAddress - + Header^.VirtualAddress + Header^.PointerToRawData); + end; + for I := 1 to FormatCount do + begin + Add(TObject(DebugDir)); + Inc(DebugDir); + end; + end; +end; + +function TJclPeDebugList.GetItems(Index: Integer): TImageDebugDirectory; +begin + Result := PImageDebugDirectory(Get(Index))^; +end; + +//=== { TJclPeCertificateList } ============================================== + +constructor TJclPeCertificateList.Create(AImage: TJclPeImage); +begin + inherited Create(AImage); + CreateList; +end; + +procedure TJclPeCertificateList.CreateList; +var + Directory: TImageDataDirectory; + CertPtr: PChar; + TotalSize: Integer; + Item: TJclPeCertificate; +begin + Directory := FImage.Directories[IMAGE_DIRECTORY_ENTRY_SECURITY]; + if Directory.VirtualAddress = 0 then + Exit; + CertPtr := FImage.RawToVa(Directory.VirtualAddress); // Security directory is a raw offset + TotalSize := Directory.Size; + while TotalSize >= SizeOf(TWinCertificate) do + begin + Item := TJclPeCertificate.Create; + Item.FHeader := PWinCertificate(CertPtr)^; + Item.FData := CertPtr + SizeOf(TWinCertificate); + Dec(TotalSize, Item.Header.dwLength); + Add(Item); + end; +end; + +function TJclPeCertificateList.GetItems(Index: Integer): TJclPeCertificate; +begin + Result := TJclPeCertificate(Get(Index)); +end; + +//=== { TJclPeCLRHeader } ==================================================== + +constructor TJclPeCLRHeader.Create(AImage: TJclPeImage); +begin + FImage := AImage; + ReadHeader; +end; + +function TJclPeCLRHeader.GetHasMetadata: Boolean; +const + METADATA_SIGNATURE = $424A5342; // Reference: Partition II Metadata.doc - 23.2.1 Metadata root +begin + with Header.MetaData do + Result := (VirtualAddress <> 0) and (PDWORD(FImage.RvaToVa(VirtualAddress))^ = METADATA_SIGNATURE); +end; +{ TODO -cDOC : "Flier Lu" } + +function TJclPeCLRHeader.GetVersionString: string; +begin + Result := FormatVersionString(Header.MajorRuntimeVersion, Header.MinorRuntimeVersion); +end; + +procedure TJclPeCLRHeader.ReadHeader; +var + HeaderPtr: PImageCor20Header; +begin + HeaderPtr := Image.DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR); + if (HeaderPtr <> nil) and (HeaderPtr^.cb >= SizeOf(TImageCor20Header)) then + FHeader := HeaderPtr^; +end; + +//=== { TJclPeImage } ======================================================== + +constructor TJclPeImage.Create(ANoExceptions: Boolean); +begin + FNoExceptions := ANoExceptions; + FReadOnlyAccess := True; + FImageSections := TStringList.Create; +end; + +destructor TJclPeImage.Destroy; +begin + Clear; + FreeAndNil(FImageSections); + inherited Destroy; +end; + +procedure TJclPeImage.AfterOpen; +begin +end; + +procedure TJclPeImage.AttachLoadedModule(const Handle: HMODULE); +var + NtHeaders: PImageNtHeaders; +begin + Clear; + if Handle = 0 then + Exit; + NtHeaders := PeMapImgNtHeaders(Pointer(Handle)); + if NtHeaders = nil then + FStatus := stNotPE + else + begin + FStatus := stOk; + FAttachedImage := True; + FFileName := GetModulePath(Handle); + FLoadedImage.ModuleName := PChar(FFileName); + FLoadedImage.hFile := INVALID_HANDLE_VALUE; + FLoadedImage.MappedAddress := Pointer(Handle); + FLoadedImage.FileHeader := NtHeaders; + FLoadedImage.NumberOfSections := NtHeaders^.FileHeader.NumberOfSections; + FLoadedImage.Sections := PeMapImgSections(NtHeaders); + FLoadedImage.LastRvaSection := FLoadedImage.Sections; + FLoadedImage.Characteristics := NtHeaders^.FileHeader.Characteristics; + FLoadedImage.fSystemImage := (FLoadedImage.Characteristics and IMAGE_FILE_SYSTEM <> 0); + FLoadedImage.fDOSImage := False; + FLoadedImage.SizeOfImage := NtHeaders^.OptionalHeader.SizeOfImage; + ReadImageSections; + AfterOpen; + end; + RaiseStatusException; +end; + +function TJclPeImage.CalculateCheckSum: DWORD; +var + C: DWORD; +begin + if StatusOK then + begin + CheckNotAttached; + if CheckSumMappedFile(FLoadedImage.MappedAddress, FLoadedImage.SizeOfImage, + C, Result) = nil then + RaiseLastOSError; + end + else + Result := 0; +end; + +procedure TJclPeImage.CheckNotAttached; +begin + if FAttachedImage then + raise EJclPeImageError.CreateRes(@RsPeNotAvailableForAttached); +end; + +procedure TJclPeImage.Clear; +begin + FImageSections.Clear; + FreeAndNil(FCertificateList); + FreeAndNil(FCLRHeader); + FreeAndNil(FDebugList); + FreeAndNil(FImportList); + FreeAndNil(FExportList); + FreeAndNil(FRelocationList); + FreeAndNil(FResourceList); + FreeAndNil(FVersionInfo); + if not FAttachedImage and StatusOK then + UnMapAndLoad(FLoadedImage); + FillChar(FLoadedImage, SizeOf(FLoadedImage), #0); + FStatus := stNotLoaded; + FAttachedImage := False; +end; + +class function TJclPeImage.DebugTypeNames(DebugType: DWORD): string; +begin + case DebugType of + IMAGE_DEBUG_TYPE_UNKNOWN: + Result := RsPeDEBUG_UNKNOWN; + IMAGE_DEBUG_TYPE_COFF: + Result := RsPeDEBUG_COFF; + IMAGE_DEBUG_TYPE_CODEVIEW: + Result := RsPeDEBUG_CODEVIEW; + IMAGE_DEBUG_TYPE_FPO: + Result := RsPeDEBUG_FPO; + IMAGE_DEBUG_TYPE_MISC: + Result := RsPeDEBUG_MISC; + IMAGE_DEBUG_TYPE_EXCEPTION: + Result := RsPeDEBUG_EXCEPTION; + IMAGE_DEBUG_TYPE_FIXUP: + Result := RsPeDEBUG_FIXUP; + IMAGE_DEBUG_TYPE_OMAP_TO_SRC: + Result := RsPeDEBUG_OMAP_TO_SRC; + IMAGE_DEBUG_TYPE_OMAP_FROM_SRC: + Result := RsPeDEBUG_OMAP_FROM_SRC; + else + Result := '???'; + end; +end; + +function TJclPeImage.DirectoryEntryToData(Directory: Word): Pointer; +var + Size: DWORD; +begin + Result := ImageDirectoryEntryToData(FLoadedImage.MappedAddress, FAttachedImage, Directory, Size); +end; + +class function TJclPeImage.DirectoryNames(Directory: Word): string; +begin + case Directory of + IMAGE_DIRECTORY_ENTRY_EXPORT: + Result := RsPeImg_00; + IMAGE_DIRECTORY_ENTRY_IMPORT: + Result := RsPeImg_01; + IMAGE_DIRECTORY_ENTRY_RESOURCE: + Result := RsPeImg_02; + IMAGE_DIRECTORY_ENTRY_EXCEPTION: + Result := RsPeImg_03; + IMAGE_DIRECTORY_ENTRY_SECURITY: + Result := RsPeImg_04; + IMAGE_DIRECTORY_ENTRY_BASERELOC: + Result := RsPeImg_05; + IMAGE_DIRECTORY_ENTRY_DEBUG: + Result := RsPeImg_06; + IMAGE_DIRECTORY_ENTRY_COPYRIGHT: + Result := RsPeImg_07; + IMAGE_DIRECTORY_ENTRY_GLOBALPTR: + Result := RsPeImg_08; + IMAGE_DIRECTORY_ENTRY_TLS: + Result := RsPeImg_09; + IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG: + Result := RsPeImg_10; + IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT: + Result := RsPeImg_11; + IMAGE_DIRECTORY_ENTRY_IAT: + Result := RsPeImg_12; + IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT: + Result := RsPeImg_13; + IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR: + Result := RsPeImg_14; + else + Result := Format('reserved [%.2d]', [Directory]); + end; +end; + +class function TJclPeImage.ExpandBySearchPath(const ModuleName, BasePath: string): TFileName; +var + FullName: array [0..MAX_PATH] of Char; + FilePart: PChar; +begin + Result := PathAddSeparator(ExtractFilePath(BasePath)) + ModuleName; + if FileExists(Result) then + Exit; + if SearchPath(nil, PChar(ModuleName), nil, SizeOf(FullName), FullName, FilePart) = 0 then + Result := ModuleName + else + Result := FullName; +end; + +function TJclPeImage.ExpandModuleName(const ModuleName: string): TFileName; +begin + Result := ExpandBySearchPath(ModuleName, ExtractFilePath(FFileName)); +end; + +function TJclPeImage.GetCertificateList: TJclPeCertificateList; +begin + if FCertificateList = nil then + FCertificateList := TJclPeCertificateList.Create(Self); + Result := FCertificateList; +end; + +function TJclPeImage.GetCLRHeader: TJclPeCLRHeader; +begin + if FCLRHeader = nil then + FCLRHeader := TJclPeCLRHeader.Create(Self); + Result := FCLRHeader; +end; + +function TJclPeImage.GetDebugList: TJclPeDebugList; +begin + if FDebugList = nil then + FDebugList := TJclPeDebugList.Create(Self); + Result := FDebugList; +end; + +function TJclPeImage.GetDescription: string; +begin + if DirectoryExists[IMAGE_DIRECTORY_ENTRY_COPYRIGHT] then + Result := PChar(DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_COPYRIGHT)) + else + Result := ''; +end; + +function TJclPeImage.GetDirectories(Directory: Word): TImageDataDirectory; +begin + if StatusOK then + Result := FLoadedImage.FileHeader.OptionalHeader.DataDirectory[Directory] + else + begin + Result.VirtualAddress := 0; + Result.Size := 0; + end; +end; + +function TJclPeImage.GetDirectoryExists(Directory: Word): Boolean; +begin + Result := (Directories[Directory].VirtualAddress <> 0); +end; + +function TJclPeImage.GetExportList: TJclPeExportFuncList; +begin + if FExportList = nil then + FExportList := TJclPeExportFuncList.Create(Self); + Result := FExportList; +end; + +function TJclPeImage.GetFileProperties: TJclPeFileProperties; +const + faFile = faReadOnly or faHidden or faSysFile or faArchive; +var + Se: TSearchRec; + Res: Integer; +begin + FillChar(Result, SizeOf(Result), #0); + Res := FindFirst(FileName, faFile, Se); + if Res = 0 then + begin + Result.Size := Se.Size; + Result.CreationTime := FileTimeToLocalDateTime(Se.FindData.ftCreationTime); + Result.LastAccessTime := FileTimeToLocalDateTime(Se.FindData.ftLastAccessTime); + Result.LastWriteTime := FileTimeToLocalDateTime(Se.FindData.ftLastWriteTime); + Result.Attributes := Se.Attr; + end; + FindClose(Se); +end; + +function TJclPeImage.GetHeaderValues(Index: TJclPeHeader): string; + + function GetMachineString(Value: DWORD): string; + begin + case Value of + IMAGE_FILE_MACHINE_UNKNOWN: + Result := RsPeMACHINE_UNKNOWN; + IMAGE_FILE_MACHINE_I386: + Result := RsPeMACHINE_I386; + IMAGE_FILE_MACHINE_R3000: + Result := RsPeMACHINE_R3000; + IMAGE_FILE_MACHINE_R4000: + Result := RsPeMACHINE_R4000; + IMAGE_FILE_MACHINE_R10000: + Result := RsPeMACHINE_R10000; + IMAGE_FILE_MACHINE_ALPHA: + Result := RsPeMACHINE_ALPHA; + IMAGE_FILE_MACHINE_POWERPC: + Result := RsPeMACHINE_POWERPC; + else + Result := Format('[%.8x]', [Value]); + end; + end; + + function GetSubsystemString(Value: DWORD): string; + begin + case Value of + IMAGE_SUBSYSTEM_UNKNOWN: + Result := RsPeSUBSYSTEM_UNKNOWN; + IMAGE_SUBSYSTEM_NATIVE: + Result := RsPeSUBSYSTEM_NATIVE; + IMAGE_SUBSYSTEM_WINDOWS_GUI: + Result := RsPeSUBSYSTEM_WINDOWS_GUI; + IMAGE_SUBSYSTEM_WINDOWS_CUI: + Result := RsPeSUBSYSTEM_WINDOWS_CUI; + IMAGE_SUBSYSTEM_OS2_CUI: + Result := RsPeSUBSYSTEM_OS2_CUI; + IMAGE_SUBSYSTEM_POSIX_CUI: + Result := RsPeSUBSYSTEM_POSIX_CUI; + IMAGE_SUBSYSTEM_RESERVED8: + Result := RsPeSUBSYSTEM_RESERVED8; + else + Result := Format('[%.8x]', [Value]); + end; + end; + +begin + if StatusOK then + with FLoadedImage.FileHeader^ do + case Index of + JclPeHeader_Signature: + Result := IntToHex(Signature, 8); + JclPeHeader_Machine: + Result := GetMachineString(FileHeader.Machine); + JclPeHeader_NumberOfSections: + Result := IntToHex(FileHeader.NumberOfSections, 4); + JclPeHeader_TimeDateStamp: + Result := IntToHex(FileHeader.TimeDateStamp, 8); + JclPeHeader_PointerToSymbolTable: + Result := IntToHex(FileHeader.PointerToSymbolTable, 8); + JclPeHeader_NumberOfSymbols: + Result := IntToHex(FileHeader.NumberOfSymbols, 8); + JclPeHeader_SizeOfOptionalHeader: + Result := IntToHex(FileHeader.SizeOfOptionalHeader, 4); + JclPeHeader_Characteristics: + Result := IntToHex(FileHeader.Characteristics, 4); + JclPeHeader_Magic: + Result := IntToHex(OptionalHeader.Magic, 4); + JclPeHeader_LinkerVersion: + Result := FormatVersionString(OptionalHeader.MajorLinkerVersion, OptionalHeader.MinorLinkerVersion); + JclPeHeader_SizeOfCode: + Result := IntToHex(OptionalHeader.SizeOfCode, 8); + JclPeHeader_SizeOfInitializedData: + Result := IntToHex(OptionalHeader.SizeOfInitializedData, 8); + JclPeHeader_SizeOfUninitializedData: + Result := IntToHex(OptionalHeader.SizeOfUninitializedData, 8); + JclPeHeader_AddressOfEntryPoint: + Result := IntToHex(OptionalHeader.AddressOfEntryPoint, 8); + JclPeHeader_BaseOfCode: + Result := IntToHex(OptionalHeader.BaseOfCode, 8); + JclPeHeader_BaseOfData: + Result := IntToHex(OptionalHeader.BaseOfData, 8); + JclPeHeader_ImageBase: + Result := IntToHex(OptionalHeader.ImageBase, 8); + JclPeHeader_SectionAlignment: + Result := IntToHex(OptionalHeader.SectionAlignment, 8); + JclPeHeader_FileAlignment: + Result := IntToHex(OptionalHeader.FileAlignment, 8); + JclPeHeader_OperatingSystemVersion: + Result := FormatVersionString(OptionalHeader.MajorOperatingSystemVersion, OptionalHeader.MinorOperatingSystemVersion); + JclPeHeader_ImageVersion: + Result := FormatVersionString(OptionalHeader.MajorImageVersion, OptionalHeader.MinorImageVersion); + JclPeHeader_SubsystemVersion: + Result := FormatVersionString(OptionalHeader.MajorSubsystemVersion, OptionalHeader.MinorSubsystemVersion); + JclPeHeader_Win32VersionValue: + Result := IntToHex(OptionalHeader.Win32VersionValue, 8); + JclPeHeader_SizeOfImage: + Result := IntToHex(OptionalHeader.SizeOfImage, 8); + JclPeHeader_SizeOfHeaders: + Result := IntToHex(OptionalHeader.SizeOfHeaders, 8); + JclPeHeader_CheckSum: + Result := IntToHex(OptionalHeader.CheckSum, 8); + JclPeHeader_Subsystem: + Result := GetSubsystemString(OptionalHeader.Subsystem); + JclPeHeader_DllCharacteristics: + Result := IntToHex(OptionalHeader.DllCharacteristics, 4); + JclPeHeader_SizeOfStackReserve: + Result := IntToHex(OptionalHeader.SizeOfStackReserve, 8); + JclPeHeader_SizeOfStackCommit: + Result := IntToHex(OptionalHeader.SizeOfStackCommit, 8); + JclPeHeader_SizeOfHeapReserve: + Result := IntToHex(OptionalHeader.SizeOfHeapReserve, 8); + JclPeHeader_SizeOfHeapCommit: + Result := IntToHex(OptionalHeader.SizeOfHeapCommit, 8); + JclPeHeader_LoaderFlags: + Result := IntToHex(OptionalHeader.LoaderFlags, 8); + JclPeHeader_NumberOfRvaAndSizes: + Result := IntToHex(OptionalHeader.NumberOfRvaAndSizes, 8); + else + Result := ''; + end + else + Result := ''; +end; + +function TJclPeImage.GetImageSectionCount: Integer; +begin + Result := FImageSections.Count; +end; + +function TJclPeImage.GetImageSectionHeaders(Index: Integer): TImageSectionHeader; +begin + Result := PImageSectionHeader(FImageSections.Objects[Index])^; +end; + +function TJclPeImage.GetImageSectionNameFromRva(const Rva: DWORD): string; +begin + Result := GetSectionName(RvaToSection(Rva)); +end; + +function TJclPeImage.GetImageSectionNames(Index: Integer): string; +begin + Result := FImageSections[Index]; +end; + +function TJclPeImage.GetImportList: TJclPeImportList; +begin + if FImportList = nil then + FImportList := TJclPeImportList.Create(Self); + Result := FImportList; +end; + +function TJclPeImage.GetLoadConfigValues(Index: TJclLoadConfig): string; +var + LoadConfig: PImageLoadConfigDirectory; +begin + Result := ''; + LoadConfig := DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG); + if LoadConfig <> nil then + with LoadConfig^ do + case Index of + JclLoadConfig_Characteristics: + Result := IntToHex(Size, 8); + JclLoadConfig_TimeDateStamp: + Result := IntToHex(TimeDateStamp, 8); + JclLoadConfig_Version: + Result := FormatVersionString(MajorVersion, MinorVersion); + JclLoadConfig_GlobalFlagsClear: + Result := IntToHex(GlobalFlagsClear, 8); + JclLoadConfig_GlobalFlagsSet: + Result := IntToHex(GlobalFlagsSet, 8); + JclLoadConfig_CriticalSectionDefaultTimeout: + Result := IntToHex(CriticalSectionDefaultTimeout, 8); + JclLoadConfig_DeCommitFreeBlockThreshold: + Result := IntToHex(DeCommitFreeBlockThreshold, 8); + JclLoadConfig_DeCommitTotalFreeThreshold: + Result := IntToHex(DeCommitTotalFreeThreshold, 8); + JclLoadConfig_LockPrefixTable: + Result := IntToHex(LockPrefixTable, 8); + JclLoadConfig_MaximumAllocationSize: + Result := IntToHex(MaximumAllocationSize, 8); + JclLoadConfig_VirtualMemoryThreshold: + Result := IntToHex(VirtualMemoryThreshold, 8); + JclLoadConfig_ProcessHeapFlags: + Result := IntToHex(ProcessHeapFlags, 8); + JclLoadConfig_ProcessAffinityMask: + Result := IntToHex(ProcessAffinityMask, 8); + JclLoadConfig_CSDVersion: + Result := IntToHex(CSDVersion, 4); + JclLoadConfig_Reserved1: + Result := IntToHex(Reserved1, 4); + JclLoadConfig_EditList: + Result := IntToHex(EditList, 8); + JclLoadConfig_Reserved: + Result := RsPeReserved; + end; +end; + +function TJclPeImage.GetMappedAddress: DWORD; +begin + if StatusOK then + Result := DWORD(LoadedImage.MappedAddress) + else + Result := 0; +end; + +function TJclPeImage.GetOptionalHeader: TImageOptionalHeader; +begin + Result := FLoadedImage.FileHeader.OptionalHeader; +end; + +function TJclPeImage.GetRelocationList: TJclPeRelocList; +begin + if FRelocationList = nil then + FRelocationList := TJclPeRelocList.Create(Self); + Result := FRelocationList; +end; + +function TJclPeImage.GetResourceList: TJclPeRootResourceList; +begin + if FResourceList = nil then + begin + FResourceVA := Directories[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress; + if FResourceVA <> 0 then + FResourceVA := DWORD(RvaToVa(FResourceVA)); + FResourceList := TJclPeRootResourceList.Create(Self, nil, PImageResourceDirectory(FResourceVA)); + end; + Result := FResourceList; +end; + +function TJclPeImage.GetSectionHeader(const SectionName: string; + var Header: PImageSectionHeader): Boolean; +var + I: Integer; +begin + I := FImageSections.IndexOf(SectionName); + if I = -1 then + begin + Header := nil; + Result := False; + end + else + begin + Header := PImageSectionHeader(FImageSections.Objects[I]); + Result := True; + end; +end; + +function TJclPeImage.GetSectionName(Header: PImageSectionHeader): string; +var + I: Integer; +begin + I := FImageSections.IndexOfObject(TObject(Header)); + if I = -1 then + Result := '' + else + Result := FImageSections[I]; +end; + +function TJclPeImage.GetUnusedHeaderBytes: TImageDataDirectory; +begin + CheckNotAttached; + Result.VirtualAddress := GetImageUnusedHeaderBytes(FLoadedImage, Result.Size); + if Result.VirtualAddress = 0 then + RaiseLastOSError; +end; + +function TJclPeImage.GetVersionInfo: TJclFileVersionInfo; +var + VersionInfoResource: TJclPeResourceItem; +begin + if (FVersionInfo = nil) and VersionInfoAvailable then + begin + VersionInfoResource := ResourceList.FindResource(rtVersion, '1').List[0]; + with VersionInfoResource do + try + FVersionInfo := TJclFileVersionInfo.Attach(RawEntryData, RawEntryDataSize); + except + FreeAndNil(FVersionInfo); + end; + end; + Result := FVersionInfo; +end; + +function TJclPeImage.GetVersionInfoAvailable: Boolean; +begin + Result := StatusOK and (ResourceList.FindResource(rtVersion, '1') <> nil); +end; + +class function TJclPeImage.HeaderNames(Index: TJclPeHeader): string; +begin + case Index of + JclPeHeader_Signature: + Result := RsPeSignature; + JclPeHeader_Machine: + Result := RsPeMachine; + JclPeHeader_NumberOfSections: + Result := RsPeNumberOfSections; + JclPeHeader_TimeDateStamp: + Result := RsPeTimeDateStamp; + JclPeHeader_PointerToSymbolTable: + Result := RsPePointerToSymbolTable; + JclPeHeader_NumberOfSymbols: + Result := RsPeNumberOfSymbols; + JclPeHeader_SizeOfOptionalHeader: + Result := RsPeSizeOfOptionalHeader; + JclPeHeader_Characteristics: + Result := RsPeCharacteristics; + JclPeHeader_Magic: + Result := RsPeMagic; + JclPeHeader_LinkerVersion: + Result := RsPeLinkerVersion; + JclPeHeader_SizeOfCode: + Result := RsPeSizeOfCode; + JclPeHeader_SizeOfInitializedData: + Result := RsPeSizeOfInitializedData; + JclPeHeader_SizeOfUninitializedData: + Result := RsPeSizeOfUninitializedData; + JclPeHeader_AddressOfEntryPoint: + Result := RsPeAddressOfEntryPoint; + JclPeHeader_BaseOfCode: + Result := RsPeBaseOfCode; + JclPeHeader_BaseOfData: + Result := RsPeBaseOfData; + JclPeHeader_ImageBase: + Result := RsPeImageBase; + JclPeHeader_SectionAlignment: + Result := RsPeSectionAlignment; + JclPeHeader_FileAlignment: + Result := RsPeFileAlignment; + JclPeHeader_OperatingSystemVersion: + Result := RsPeOperatingSystemVersion; + JclPeHeader_ImageVersion: + Result := RsPeImageVersion; + JclPeHeader_SubsystemVersion: + Result := RsPeSubsystemVersion; + JclPeHeader_Win32VersionValue: + Result := RsPeWin32VersionValue; + JclPeHeader_SizeOfImage: + Result := RsPeSizeOfImage; + JclPeHeader_SizeOfHeaders: + Result := RsPeSizeOfHeaders; + JclPeHeader_CheckSum: + Result := RsPeCheckSum; + JclPeHeader_Subsystem: + Result := RsPeSubsystem; + JclPeHeader_DllCharacteristics: + Result := RsPeDllCharacteristics; + JclPeHeader_SizeOfStackReserve: + Result := RsPeSizeOfStackReserve; + JclPeHeader_SizeOfStackCommit: + Result := RsPeSizeOfStackCommit; + JclPeHeader_SizeOfHeapReserve: + Result := RsPeSizeOfHeapReserve; + JclPeHeader_SizeOfHeapCommit: + Result := RsPeSizeOfHeapCommit; + JclPeHeader_LoaderFlags: + Result := RsPeLoaderFlags; + JclPeHeader_NumberOfRvaAndSizes: + Result := RsPeNumberOfRvaAndSizes; + else + Result := ''; + end; +end; + +function TJclPeImage.IsBrokenFormat: Boolean; +begin + Result := not ((OptionalHeader.AddressOfEntryPoint = 0) or IsCLR); + if Result then + begin + Result := (ImageSectionCount = 0); + if not Result then + with ImageSectionHeaders[0] do + Result := (VirtualAddress <> OptionalHeader.BaseOfCode) or (SizeOfRawData = 0) or + (OptionalHeader.AddressOfEntryPoint > VirtualAddress + Misc.VirtualSize) or + (Characteristics and (IMAGE_SCN_CNT_CODE or IMAGE_SCN_MEM_WRITE) <> IMAGE_SCN_CNT_CODE); + end; +end; + +function TJclPeImage.IsCLR: Boolean; +begin + Result := DirectoryExists[IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR] and CLRHeader.HasMetadata; +end; + +function TJclPeImage.IsSystemImage: Boolean; +begin + Result := StatusOK and FLoadedImage.fSystemImage; +end; + +class function TJclPeImage.LoadConfigNames(Index: TJclLoadConfig): string; +begin + case Index of + JclLoadConfig_Characteristics: + Result := RsPeCharacteristics; + JclLoadConfig_TimeDateStamp: + Result := RsPeTimeDateStamp; + JclLoadConfig_Version: + Result := RsPeVersion; + JclLoadConfig_GlobalFlagsClear: + Result := RsPeGlobalFlagsClear; + JclLoadConfig_GlobalFlagsSet: + Result := RsPeGlobalFlagsSet; + JclLoadConfig_CriticalSectionDefaultTimeout: + Result := RsPeCriticalSectionDefaultTimeout; + JclLoadConfig_DeCommitFreeBlockThreshold: + Result := RsPeDeCommitFreeBlockThreshold; + JclLoadConfig_DeCommitTotalFreeThreshold: + Result := RsPeDeCommitTotalFreeThreshold; + JclLoadConfig_LockPrefixTable: + Result := RsPeLockPrefixTable; + JclLoadConfig_MaximumAllocationSize: + Result := RsPeMaximumAllocationSize; + JclLoadConfig_VirtualMemoryThreshold: + Result := RsPeVirtualMemoryThreshold; + JclLoadConfig_ProcessHeapFlags: + Result := RsPeProcessHeapFlags; + JclLoadConfig_ProcessAffinityMask: + Result := RsPeProcessAffinityMask; + JclLoadConfig_CSDVersion: + Result := RsPeCSDVersion; + JclLoadConfig_Reserved1: + Result := RsPeReserved; + JclLoadConfig_EditList: + Result := RsPeEditList; + JclLoadConfig_Reserved: + Result := RsPeReserved; + else + Result := ''; + end; +end; + +procedure TJclPeImage.RaiseStatusException; +begin + if not FNoExceptions then + case FStatus of + stNotPE: + raise EJclPeImageError.CreateRes(@RsPeNotPE); + stNotFound: + raise EJclPeImageError.CreateResFmt(@RsPeCantOpen, [FFileName]); + stError: + RaiseLastOSError; + end; +end; + +function TJclPeImage.RawToVa(Raw: DWORD): Pointer; +begin + Result := Pointer(DWORD(FLoadedImage.MappedAddress) + Raw); +end; + +procedure TJclPeImage.ReadImageSections; +var + I: Integer; + Header: PImageSectionHeader; +begin + if not StatusOK then + Exit; + Header := FLoadedImage.Sections; + for I := 0 to FLoadedImage.NumberOfSections - 1 do + begin + FImageSections.AddObject(Copy(PChar(@Header.Name), 1, IMAGE_SIZEOF_SHORT_NAME), Pointer(Header)); + Inc(Header); + end; +end; + +function TJclPeImage.ResourceItemCreate(AEntry: PImageResourceDirectoryEntry; + AParentItem: TJclPeResourceItem): TJclPeResourceItem; +begin + Result := TJclPeResourceItem.Create(Self, AParentItem, AEntry); +end; + +function TJclPeImage.ResourceListCreate(ADirectory: PImageResourceDirectory; + AParentItem: TJclPeResourceItem): TJclPeResourceList; +begin + Result := TJclPeResourceList.Create(Self, AParentItem, ADirectory); +end; + +function TJclPeImage.RvaToSection(Rva: DWORD): PImageSectionHeader; +var + I: Integer; + SectionHeader: PImageSectionHeader; + EndRVA: DWORD; +begin + Result := ImageRvaToSection(FLoadedImage.FileHeader, FLoadedImage.MappedAddress, Rva); + if Result = nil then + for I := 0 to FImageSections.Count - 1 do + begin + SectionHeader := PImageSectionHeader(FImageSections.Objects[I]); + if SectionHeader^.SizeOfRawData = 0 then + EndRVA := SectionHeader^.Misc.VirtualSize + else + EndRVA := SectionHeader^.SizeOfRawData; + Inc(EndRVA, SectionHeader^.VirtualAddress); + if (SectionHeader^.VirtualAddress <= Rva) and (EndRVA >= Rva) then + begin + Result := SectionHeader; + Break; + end; + end; +end; + +function TJclPeImage.RvaToVa(Rva: DWORD): Pointer; +begin + if FAttachedImage then + Result := FLoadedImage.MappedAddress + Rva + else + Result := ImageRvaToVa(FLoadedImage.FileHeader, FLoadedImage.MappedAddress, Rva, nil); +end; + +function TJclPeImage.RvaToVaEx(Rva: DWORD): Pointer; +begin + if (Rva > FLoadedImage.SizeOfImage) and (Rva > OptionalHeader.ImageBase) then + Dec(Rva, OptionalHeader.ImageBase); + Result := RvaToVa(Rva); +end; + +procedure TJclPeImage.SetFileName(const Value: TFileName); +begin + if FFileName <> Value then + begin + Clear; + FFileName := Value; + if FFileName = '' then + Exit; + if MapAndLoad(PChar(FFileName), nil, FLoadedImage, True, FReadOnlyAccess) then + begin + FStatus := stOk; + ReadImageSections; + AfterOpen; + end + else + case GetLastError of + ERROR_SUCCESS: + FStatus := stNotPE; + ERROR_FILE_NOT_FOUND: + FStatus := stNotFound; + else + FStatus := stError; + end; + RaiseStatusException; + end; +end; + +class function TJclPeImage.ShortSectionInfo(Characteristics: DWORD): string; +type + TSectionCharacteristics = packed record + Mask: DWORD; + InfoChar: Char; + end; +const + Info: array [1..8] of TSectionCharacteristics = ( + (Mask: IMAGE_SCN_CNT_CODE; InfoChar: 'C'), + (Mask: IMAGE_SCN_MEM_EXECUTE; InfoChar: 'E'), + (Mask: IMAGE_SCN_MEM_READ; InfoChar: 'R'), + (Mask: IMAGE_SCN_MEM_WRITE; InfoChar: 'W'), + (Mask: IMAGE_SCN_CNT_INITIALIZED_DATA; InfoChar: 'I'), + (Mask: IMAGE_SCN_CNT_UNINITIALIZED_DATA; InfoChar: 'U'), + (Mask: IMAGE_SCN_MEM_SHARED; InfoChar: 'S'), + (Mask: IMAGE_SCN_MEM_DISCARDABLE; InfoChar: 'D') + ); +var + I: Integer; +begin + SetLength(Result, High(Info)); + Result := ''; + for I := Low(Info) to High(Info) do + with Info[I] do + if (Characteristics and Mask) = Mask then + Result := Result + InfoChar; +end; + +function TJclPeImage.StatusOK: Boolean; +begin + Result := (FStatus = stOk); +end; + +class function TJclPeImage.StampToDateTime(TimeDateStamp: DWORD): TDateTime; +begin + Result := TimeDateStamp / SecsPerDay + UnixTimeStart +end; + +procedure TJclPeImage.TryGetNamesForOrdinalImports; +begin + if StatusOK then + begin + GetImportList; + FImportList.TryGetNamesForOrdinalImports; + end; +end; + +function TJclPeImage.VerifyCheckSum: Boolean; +begin + CheckNotAttached; + with OptionalHeader do + Result := StatusOK and ((CheckSum = 0) or (CalculateCheckSum = CheckSum)); +end; + +//=== { TJclPePackageInfo } ================================================== + +constructor TJclPePackageInfo.Create(ALibHandle: THandle); +begin + FContains := TStringList.Create; + FRequires := TStringList.Create; + FEnsureExtension := True; + ReadPackageInfo(ALibHandle); +end; + +destructor TJclPePackageInfo.Destroy; +begin + FreeAndNil(FContains); + FreeAndNil(FRequires); + inherited Destroy; +end; + +function TJclPePackageInfo.GetContains: TStrings; +begin + Result := FContains; +end; + +function TJclPePackageInfo.GetContainsCount: Integer; +begin + Result := Contains.Count; +end; + +function TJclPePackageInfo.GetContainsFlags(Index: Integer): Byte; +begin + Result := Byte(Contains.Objects[Index]); +end; + +function TJclPePackageInfo.GetContainsNames(Index: Integer): string; +begin + Result := Contains[Index]; +end; + +function TJclPePackageInfo.GetRequires: TStrings; +begin + Result := FRequires; +end; + +function TJclPePackageInfo.GetRequiresCount: Integer; +begin + Result := Requires.Count; +end; + +function TJclPePackageInfo.GetRequiresNames(Index: Integer): string; +begin + Result := Requires[Index]; + if FEnsureExtension then + StrEnsureSuffix(BPLExtension, Result); +end; + +class function TJclPePackageInfo.PackageModuleTypeToString(Flags: Integer): string; +begin + case Flags and pfModuleTypeMask of + pfExeModule, pfModuleTypeMask: + Result := RsPePkgExecutable; + pfPackageModule: + Result := RsPePkgPackage; + pfLibraryModule: + Result := PsPePkgLibrary; + else + Result := ''; + end; +end; + +class function TJclPePackageInfo.PackageOptionsToString(Flags: Integer): string; +begin + Result := ''; + AddFlagTextRes(Result, @RsPePkgNeverBuild, Flags, pfNeverBuild); + AddFlagTextRes(Result, @RsPePkgDesignOnly, Flags, pfDesignOnly); + AddFlagTextRes(Result, @RsPePkgRunOnly, Flags, pfRunOnly); + AddFlagTextRes(Result, @RsPePkgIgnoreDupUnits, Flags, pfIgnoreDupUnits); +end; + +class function TJclPePackageInfo.ProducerToString(Flags: Integer): string; +begin + case Flags and pfProducerMask of + pfV3Produced: + Result := RsPePkgV3Produced; + pfProducerUndefined: + Result := RsPePkgProducerUndefined; + pfBCB4Produced: + Result := RsPePkgBCB4Produced; + pfDelphi4Produced: + Result := RsPePkgDelphi4Produced; + else + Result := ''; + end; +end; + +procedure PackageInfoProc(const Name: string; NameType: TNameType; AFlags: Byte; Param: Pointer); +begin + with TJclPePackageInfo(Param) do + case NameType of + ntContainsUnit: + Contains.AddObject(Name, Pointer(AFlags)); + ntRequiresPackage: + Requires.Add(Name); + {$IFDEF COMPILER6_UP} + ntDcpBpiName: + FDcpName := Name; + {$ENDIF COMPILER6_UP} + end; +end; + +procedure TJclPePackageInfo.ReadPackageInfo(ALibHandle: THandle); +var + DescrResInfo: HRSRC; + DescrResData: HGLOBAL; +begin + FAvailable := FindResource(ALibHandle, PackageInfoResName, RT_RCDATA) <> 0; + if FAvailable then + begin + GetPackageInfo(ALibHandle, Self, FFlags, PackageInfoProc); + if FDcpName = '' then + FDcpName := PathExtractFileNameNoExt(GetModulePath(ALibHandle)) + DCPExtension; + FContains.Sort; + FRequires.Sort; + end; + DescrResInfo := FindResource(ALibHandle, DescriptionResName, RT_RCDATA); + if DescrResInfo <> 0 then + begin + DescrResData := LoadResource(ALibHandle, DescrResInfo); + if DescrResData <> 0 then + begin + FDescription := WideCharLenToString(LockResource(DescrResData), + SizeofResource(ALibHandle, DescrResInfo)); + StrResetLength(FDescription); + end; + end; +end; + +class function TJclPePackageInfo.UnitInfoFlagsToString(UnitFlags: Byte): string; +begin + Result := ''; + AddFlagTextRes(Result, @RsPePkgMain, UnitFlags, ufMainUnit); + AddFlagTextRes(Result, @RsPePkgPackage, UnitFlags, ufPackageUnit); + AddFlagTextRes(Result, @RsPePkgWeak, UnitFlags, ufWeakUnit); + AddFlagTextRes(Result, @RsPePkgOrgWeak, UnitFlags, ufOrgWeakUnit); + AddFlagTextRes(Result, @RsPePkgImplicit, UnitFlags, ufImplicitUnit); +end; + +//=== { TJclPeBorForm } ====================================================== + +procedure TJclPeBorForm.ConvertFormToText(const Stream: TStream); +var + SourceStream: TJclPeResourceRawStream; +begin + SourceStream := TJclPeResourceRawStream.Create(ResItem); + try + ObjectBinaryToText(SourceStream, Stream); + finally + SourceStream.Free; + end; +end; + +procedure TJclPeBorForm.ConvertFormToText(const Strings: TStrings); +var + TempStream: TMemoryStream; +begin + TempStream := TMemoryStream.Create; + try + ConvertFormToText(TempStream); + TempStream.Seek(0, soFromBeginning); + Strings.LoadFromStream(TempStream); + finally + TempStream.Free; + end; +end; + +function TJclPeBorForm.GetDisplayName: string; +begin + if FFormObjectName <> '' then + Result := FFormObjectName + ': ' + else + Result := ''; + Result := Result + FFormClassName; +end; + +//=== { TJclPeBorImage } ===================================================== + +constructor TJclPeBorImage.Create(ANoExceptions: Boolean); +begin + FForms := TObjectList.Create(True); + inherited Create(ANoExceptions); +end; + +destructor TJclPeBorImage.Destroy; +begin + inherited Destroy; + FreeAndNil(FForms); +end; + +procedure TJclPeBorImage.AfterOpen; +var + HasDVCLAL, HasPACKAGEINFO, HasPACKAGEOPTIONS: Boolean; +begin + inherited AfterOpen; + if StatusOK then + with ResourceList do + begin + HasDVCLAL := (FindResource(rtRCData, DVclAlResName) <> nil); + HasPACKAGEINFO := (FindResource(rtRCData, PackageInfoResName) <> nil); + HasPACKAGEOPTIONS := (FindResource(rtRCData, PackageOptionsResName) <> nil); + FIsPackage := HasPACKAGEINFO and HasPACKAGEOPTIONS; + FIsBorlandImage := HasDVCLAL or FIsPackage; + end; +end; + +procedure TJclPeBorImage.Clear; +begin + FForms.Clear; + FreeAndNil(FPackageInfo); + FreeLibHandle; + inherited Clear; + FIsBorlandImage := False; + FIsPackage := False; + FPackageCompilerVersion := 0; +end; + +procedure TJclPeBorImage.CreateFormsList; +var + ResTypeItem: TJclPeResourceItem; + I: Integer; + + procedure ProcessListItem(DfmResItem: TJclPeResourceItem); + const + FilerSignature: array [1..4] of Char = 'TPF0'; + var + SourceStream: TJclPeResourceRawStream; + DfmItem: TJclPeBorForm; + Reader: TReader; + begin + SourceStream := TJclPeResourceRawStream.Create(DfmResItem); + try + if (SourceStream.Size > SizeOf(FilerSignature)) and + (PInteger(SourceStream.Memory)^ = Integer(FilerSignature)) then + begin + Reader := TReader.Create(SourceStream, 4096); + try + DfmItem := TJclPeBorForm.Create; + DfmItem.FResItem := DfmResItem; + Reader.ReadSignature; + Reader.ReadPrefix(DfmItem.FFormFlags, DfmItem.FFormPosition); + DfmItem.FFormClassName := Reader.ReadStr; + DfmItem.FFormObjectName := Reader.ReadStr; + FForms.Add(DfmItem); + finally + Reader.Free; + end; + end; + finally + SourceStream.Free; + end; + end; + +begin + if StatusOK then + with ResourceList do + begin + ResTypeItem := FindResource(rtRCData, ''); + if ResTypeItem <> nil then + with ResTypeItem.List do + for I := 0 to Count - 1 do + ProcessListItem(Items[I].List[0]); + end; +end; + +function TJclPeBorImage.DependedPackages(List: TStrings; FullPathName, Descriptions: Boolean): Boolean; +var + ImportList: TStringList; + I: Integer; + Name: string; +begin + Result := IsBorlandImage; + if not Result then + Exit; + ImportList := InternalImportedLibraries(FileName, True, FullPathName, nil); + List.BeginUpdate; + try + for I := 0 to ImportList.Count - 1 do + begin + Name := ImportList[I]; + if StrSame(ExtractFileExt(Name), BPLExtension) then + begin + if Descriptions then + List.Add(Name + '=' + GetPackageDescription(PChar(Name))) + else + List.Add(Name); + end; + end; + finally + ImportList.Free; + List.EndUpdate; + end; +end; + +function TJclPeBorImage.FreeLibHandle: Boolean; +begin + if FLibHandle <> 0 then + begin + Result := FreeLibrary(FLibHandle); + FLibHandle := 0; + end + else + Result := True; +end; + +function TJclPeBorImage.GetFormCount: Integer; +begin + if FForms.Count = 0 then + CreateFormsList; + Result := FForms.Count; +end; + +function TJclPeBorImage.GetFormFromName(const FormClassName: string): TJclPeBorForm; +var + I: Integer; +begin + Result := nil; + for I := 0 to FormCount - 1 do + if StrSame(FormClassName, Forms[I].FormClassName) then + begin + Result := Forms[I]; + Break; + end; +end; + +function TJclPeBorImage.GetForms(Index: Integer): TJclPeBorForm; +begin + Result := TJclPeBorForm(FForms[Index]); +end; + +function TJclPeBorImage.GetLibHandle: THandle; +begin + if StatusOK and (FLibHandle = 0) then + begin + FLibHandle := LoadLibraryEx(PChar(FileName), 0, LOAD_LIBRARY_AS_DATAFILE); + if FLibHandle = 0 then + RaiseLastOSError; + end; + Result := FLibHandle; +end; + +function TJclPeBorImage.GetPackageCompilerVersion: Integer; +var + I: Integer; + ImportName: string; + + function CheckName: Boolean; + begin + Result := False; + ImportName := AnsiUpperCase(ImportName); + if StrSame(ExtractFileExt(ImportName), BPLExtension) then + begin + ImportName := PathExtractFileNameNoExt(ImportName); + if (Length(ImportName) = 5) and + CharIsDigit(ImportName[4]) and CharIsDigit(ImportName[5]) and + ((Pos('RTL', ImportName) = 1) or (Pos('VCL', ImportName) = 1)) then + begin + FPackageCompilerVersion := StrToIntDef(Copy(ImportName, 4, 2), 0); + Result := True; + end; + end; + end; + +begin + if (FPackageCompilerVersion = 0) and IsPackage then + begin + with ImportList do + for I := 0 to UniqueLibItemCount - 1 do + begin + ImportName := UniqueLibNames[I]; + if CheckName then + Break; + end; + if FPackageCompilerVersion = 0 then + begin + ImportName := ExtractFileName(FileName); + CheckName; + end; + end; + Result := FPackageCompilerVersion; +end; + +function TJclPeBorImage.GetPackageInfo: TJclPePackageInfo; +begin + if StatusOK and (FPackageInfo = nil) then + begin + GetLibHandle; + FPackageInfo := TJclPePackageInfo.Create(FLibHandle); + FreeLibHandle; + end; + Result := FPackageInfo; +end; + +//=== { TJclPeNameSearch } =================================================== + +constructor TJclPeNameSearch.Create(const FunctionName, Path: string; Options: TJclPeNameSearchOptions); +begin + inherited Create(True); + FFunctionName := FunctionName; + FOptions := Options; + FPath := Path; + FreeOnTerminate := True; +end; + +function TJclPeNameSearch.CompareName(const FunctionName, ComparedName: string): Boolean; +begin + Result := PeSmartFunctionNameSame(ComparedName, FunctionName, [scIgnoreCase]); +end; + +procedure TJclPeNameSearch.DoFound; +begin + if Assigned(FOnFound) then + FOnFound(Self, F_FileName, F_FunctionName, F_Option); +end; + +procedure TJclPeNameSearch.DoProcessFile; +begin + if Assigned(FOnProcessFile) then + FOnProcessFile(Self, FPeImage, F_Process); +end; + +procedure TJclPeNameSearch.Execute; +var + PathList: TStringList; + I: Integer; + + function CompareNameAndNotify(const S: string): Boolean; + begin + Result := CompareName(S, FFunctionName); + if Result and not Terminated then + begin + F_FunctionName := S; + Synchronize(DoFound); + end; + end; + + procedure ProcessDirectorySearch(const DirName: string); + var + Se: TSearchRec; + SearchResult: Integer; + ImportList: TJclPeImportList; + ExportList: TJclPeExportFuncList; + I: Integer; + begin + SearchResult := FindFirst(DirName, faArchive + faReadOnly, Se); + try + while not Terminated and (SearchResult = 0) do + begin + F_FileName := PathAddSeparator(ExtractFilePath(DirName)) + Se.Name; + F_Process := True; + FPeImage.FileName := F_FileName; + if Assigned(FOnProcessFile) then + Synchronize(DoProcessFile); + if F_Process and FPeImage.StatusOK then + begin + if seExports in FOptions then + begin + ExportList := FPeImage.ExportList; + F_Option := seExports; + for I := 0 to ExportList.Count - 1 do + begin + if Terminated then + Break; + CompareNameAndNotify(ExportList[I].Name); + end; + end; + if FOptions * [seImports, seDelayImports, seBoundImports] <> [] then + begin + ImportList := FPeImage.ImportList; + FPeImage.TryGetNamesForOrdinalImports; + for I := 0 to ImportList.AllItemCount - 1 do + with ImportList.AllItems[I] do + begin + if Terminated then + Break; + case ImportLib.ImportKind of + ikImport: + if seImports in FOptions then + begin + F_Option := seImports; + CompareNameAndNotify(Name); + end; + ikDelayImport: + if seDelayImports in FOptions then + begin + F_Option := seDelayImports; + CompareNameAndNotify(Name); + end; + ikBoundImport: + if seDelayImports in FOptions then + begin + F_Option := seBoundImports; + CompareNameAndNotify(Name); + end; + end; + end; + end; + end; + SearchResult := FindNext(Se); + end; + finally + FindClose(Se); + end; + end; + +begin + FPeImage := TJclPeImage.Create(True); + PathList := TStringList.Create; + try + PathList.Sorted := True; + PathList.Duplicates := dupIgnore; + StrToStrings(FPath, ';', PathList); + for I := 0 to PathList.Count - 1 do + ProcessDirectorySearch(PathAddSeparator(Trim(PathList[I])) + '*.*'); + finally + PathList.Free; + FPeImage.Free; + end; +end; + +procedure TJclPeNameSearch.Start; +begin + Resume; +end; + +//=== PE Image miscellaneous functions ======================================= + +function IsValidPeFile(const FileName: TFileName): Boolean; +var + NtHeaders: TImageNtHeaders; +begin + Result := PeGetNtHeaders(FileName, NtHeaders); +end; + +function PeGetNtHeaders(const FileName: TFileName; var NtHeaders: TImageNtHeaders): Boolean; +var + FileHandle: THandle; + Mapping: TJclFileMapping; + View: TJclFileMappingView; + HeadersPtr: PImageNtHeaders; +begin + Result := False; + FillChar(NtHeaders, SizeOf(NtHeaders), #0); + FileHandle := FileOpen(FileName, fmOpenRead or fmShareDenyWrite); + if FileHandle = INVALID_HANDLE_VALUE then + Exit; + try + if GetSizeOfFile(FileHandle) >= SizeOf(TImageDosHeader) then + begin + Mapping := TJclFileMapping.Create(FileHandle, '', PAGE_READONLY, 0, nil); + try + View := TJclFileMappingView.Create(Mapping, FILE_MAP_READ, 0, 0); + HeadersPtr := PeMapImgNtHeaders(View.Memory); + if HeadersPtr <> nil then + begin + Result := True; + NtHeaders := HeadersPtr^; + end; + finally + Mapping.Free; + end; + end; + finally + FileClose(FileHandle); + end; +end; + +function PeCreateNameHintTable(const FileName: TFileName): Boolean; +var + PeImage, ExportsImage: TJclPeImage; + I: Integer; + ImportItem: TJclPeImportLibItem; + Thunk: PImageThunkData; + OrdinalName: PImageImportByName; + ExportItem: TJclPeExportFuncItem; + Cache: TJclPeImagesCache; +begin + Cache := TJclPeImagesCache.Create; + try + PeImage := TJclPeImage.Create(False); + try + PeImage.ReadOnlyAccess := False; + PeImage.FileName := FileName; + Result := PeImage.ImportList.Count > 0; + for I := 0 to PeImage.ImportList.Count - 1 do + begin + ImportItem := PeImage.ImportList[I]; + if ImportItem.ImportKind = ikBoundImport then + Continue; + ExportsImage := Cache[ImportItem.FileName]; + ExportsImage.ExportList.PrepareForFastNameSearch; + Thunk := ImportItem.ThunkData; + while Thunk^.Function_ <> 0 do + begin + if Thunk^.Ordinal and IMAGE_ORDINAL_FLAG = 0 then + begin + case ImportItem.ImportKind of + ikImport: + OrdinalName := PImageImportByName(PeImage.RvaToVa(DWORD(Thunk^.AddressOfData))); + ikDelayImport: + OrdinalName := PImageImportByName(PeImage.RvaToVa(DWORD(Thunk^.AddressOfData - PeImage.OptionalHeader.ImageBase))); + else + OrdinalName := nil; + end; + ExportItem := ExportsImage.ExportList.ItemFromName[PChar(@OrdinalName.Name)]; + if ExportItem <> nil then + OrdinalName.Hint := ExportItem.Hint + else + OrdinalName.Hint := 0; + end; + Inc(Thunk); + end; + end; + finally + PeImage.Free; + end; + finally + Cache.Free; + end; +end; + +function PeRebaseImage(const ImageName: TFileName; NewBase, TimeStamp, MaxNewSize: DWORD): TJclRebaseImageInfo; + + function CalculateBaseAddress: DWORD; + var + FirstChar: Char; + ModuleName: string; + begin + ModuleName := ExtractFileName(ImageName); + FirstChar := UpCase(ModuleName[1]); + if not (FirstChar in AnsiUppercaseLetters) then + FirstChar := 'A'; + Result := $60000000 + (((Ord(FirstChar) - Ord('A')) div 3) * $1000000); + end; + +begin + if NewBase = 0 then + NewBase := CalculateBaseAddress; + with Result do + begin + NewImageBase := NewBase; + Win32Check(ReBaseImage(PChar(ImageName), nil, True, False, False, MaxNewSize, + OldImageSize, OldImageBase, NewImageSize, NewImageBase, TimeStamp)); + end; +end; + +function PeUpdateLinkerTimeStamp(const FileName: string; const Time: TDateTime): Boolean; +var + Mapping: TJclFileMapping; + View: TJclFileMappingView; + Headers: PImageNtHeaders; +begin + Mapping := TJclFileMapping.Create(FileName, fmOpenReadWrite, '', PAGE_READWRITE, 0, nil); + try + View := TJclFileMappingView.Create(Mapping, FILE_MAP_WRITE, 0, 0); + Headers := PeMapImgNtHeaders(View.Memory); + Result := (Headers <> nil); + if Result then + Headers^.FileHeader.TimeDateStamp := Round((Time - UnixTimeStart) * SecsPerDay); + finally + Mapping.Free; + end; +end; + +function PeReadLinkerTimeStamp(const FileName: string): TDateTime; +var + Mapping: TJclFileMappingStream; + Headers: PImageNtHeaders; +begin + Mapping := TJclFileMappingStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + Headers := PeMapImgNtHeaders(Mapping.Memory); + if Headers <> nil then + Result := Headers^.FileHeader.TimeDateStamp / SecsPerDay + UnixTimeStart + else + Result := -1; + finally + Mapping.Free; + end; +end; + +{ TODO -cHelp : Author: Uwe Schuster(just a generic version of JclDebug.InsertDebugDataIntoExecutableFile) } +function PeInsertSection(const FileName: TFileName; SectionStream: TStream; SectionName: string): Boolean; +var + ImageStream: TMemoryStream; + NtHeaders: PImageNtHeaders; + Sections, LastSection, NewSection: PImageSectionHeader; + VirtualAlignedSize: DWORD; + I, X, NeedFill: Integer; + SectionDataSize: Integer; + + procedure RoundUpToAlignment(var Value: DWORD; Alignment: DWORD); + begin + if (Value mod Alignment) <> 0 then + Value := ((Value div Alignment) + 1) * Alignment; + end; + +begin + Result := Assigned(SectionStream) and (SectionName <> ''); + if not Result then + Exit; + ImageStream := TMemoryStream.Create; + try + try + ImageStream.LoadFromFile(FileName); + SectionDataSize := SectionStream.Size; + NtHeaders := PeMapImgNtHeaders(ImageStream.Memory); + Assert(NtHeaders <> nil); + Sections := PeMapImgSections(NtHeaders); + Assert(Sections <> nil); + // Check whether there is not a section with the name already. If so, return True (#0000069) + if PeMapImgFindSection(NtHeaders, SectionName) <> nil then + begin + Result := True; + Exit; + end; + + LastSection := Sections; + Inc(LastSection, NtHeaders^.FileHeader.NumberOfSections - 1); + NewSection := LastSection; + Inc(NewSection); + + // Increase the number of sections + Inc(NtHeaders^.FileHeader.NumberOfSections); + FillChar(NewSection^, SizeOf(TImageSectionHeader), #0); + // JCLDEBUG Virtual Address + NewSection^.VirtualAddress := LastSection^.VirtualAddress + LastSection^.Misc.VirtualSize; + RoundUpToAlignment(NewSection^.VirtualAddress, NtHeaders^.OptionalHeader.SectionAlignment); + // JCLDEBUG Physical Offset + NewSection^.PointerToRawData := LastSection^.PointerToRawData + LastSection^.SizeOfRawData; + RoundUpToAlignment(NewSection^.PointerToRawData, NtHeaders^.OptionalHeader.FileAlignment); + // JCLDEBUG Section name + StrPLCopy(PChar(@NewSection^.Name), SectionName, IMAGE_SIZEOF_SHORT_NAME); + // JCLDEBUG Characteristics flags + NewSection^.Characteristics := IMAGE_SCN_MEM_READ or IMAGE_SCN_CNT_INITIALIZED_DATA; + + // Size of virtual data area + NewSection^.Misc.VirtualSize := SectionDataSize; + VirtualAlignedSize := SectionDataSize; + RoundUpToAlignment(VirtualAlignedSize, NtHeaders^.OptionalHeader.SectionAlignment); + // Update Size of Image + Inc(NtHeaders^.OptionalHeader.SizeOfImage, VirtualAlignedSize); + // Raw data size + NewSection^.SizeOfRawData := SectionDataSize; + RoundUpToAlignment(NewSection^.SizeOfRawData, NtHeaders^.OptionalHeader.FileAlignment); + // Update Initialized data size + Inc(NtHeaders^.OptionalHeader.SizeOfInitializedData, NewSection^.SizeOfRawData); + + // Fill data to alignment + NeedFill := Integer(NewSection^.SizeOfRawData) - SectionDataSize; + + // Note: Delphi linker seems to generate incorrect (unaligned) size of + // the executable when adding TD32 debug data so the position could be + // behind the size of the file then. + ImageStream.Seek(NewSection^.PointerToRawData, soFromBeginning); + ImageStream.CopyFrom(SectionStream, 0); + X := 0; + for I := 1 to NeedFill do + ImageStream.WriteBuffer(X, 1); + + ImageStream.SaveToFile(FileName); + except + Result := False; + end; + finally + ImageStream.Free; + end; +end; + +function PeVerifyCheckSum(const FileName: TFileName): Boolean; +begin + with CreatePeImage(FileName) do + try + Result := VerifyCheckSum; + finally + Free; + end; +end; + +function PeClearCheckSum(const FileName: TFileName): Boolean; +var + Mapping: TJclFileMapping; + View: TJclFileMappingView; + Headers: PImageNtHeaders; +begin + Mapping := TJclFileMapping.Create(FileName, fmOpenReadWrite, '', PAGE_READWRITE, 0, nil); + try + View := TJclFileMappingView.Create(Mapping, FILE_MAP_WRITE, 0, 0); + Headers := PeMapImgNtHeaders(View.Memory); + Result := (Headers <> nil); + if Result then + Headers^.OptionalHeader.CheckSum := 0; + finally + Mapping.Free; + end; +end; + +function PeUpdateCheckSum(const FileName: TFileName): Boolean; +var + LI: TLoadedImage; +begin + Result := MapAndLoad(PChar(FileName), nil, LI, True, False); + if Result then + Result := UnMapAndLoad(LI); +end; + +// Various simple PE Image searching and listing routines + +function PeDoesExportFunction(const FileName: TFileName; const FunctionName: string; + Options: TJclSmartCompOptions): Boolean; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK and Assigned(ExportList.SmartFindName(FunctionName, Options)); + finally + Free; + end; +end; + +function PeIsExportFunctionForwardedEx(const FileName: TFileName; const FunctionName: string; + var ForwardedName: string; Options: TJclSmartCompOptions): Boolean; +var + ExportItem: TJclPeExportFuncItem; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK; + if Result then + begin + ExportItem := ExportList.SmartFindName(FunctionName, Options); + if ExportItem <> nil then + begin + Result := ExportItem.IsForwarded; + ForwardedName := ExportItem.ForwardedName; + end + else + begin + Result := False; + ForwardedName := ''; + end; + end; + finally + Free; + end; +end; + +function PeIsExportFunctionForwarded(const FileName: TFileName; const FunctionName: string; + Options: TJclSmartCompOptions): Boolean; +var + Dummy: string; +begin + Result := PeIsExportFunctionForwardedEx(FileName, FunctionName, Dummy, Options); +end; + +function PeDoesImportFunction(const FileName: TFileName; const FunctionName: string; + const LibraryName: string; Options: TJclSmartCompOptions): Boolean; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK; + if Result then + with ImportList do + begin + TryGetNamesForOrdinalImports; + Result := SmartFindName(FunctionName, LibraryName, Options) <> nil; + end; + finally + Free; + end; +end; + +function PeDoesImportLibrary(const FileName: TFileName; const LibraryName: string; + Recursive: Boolean): Boolean; +var + SL: TStringList; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK; + if Result then + begin + SL := InternalImportedLibraries(FileName, Recursive, False, nil); + try + Result := SL.IndexOf(LibraryName) > -1; + finally + SL.Free; + end; + end; + finally + Free; + end; +end; + +function PeImportedLibraries(const FileName: TFileName; const LibrariesList: TStrings; + Recursive, FullPathName: Boolean): Boolean; +var + SL: TStringList; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK; + if Result then + begin + SL := InternalImportedLibraries(FileName, Recursive, FullPathName, nil); + try + LibrariesList.Assign(SL); + finally + SL.Free; + end; + end; + finally + Free; + end; +end; + +function PeImportedFunctions(const FileName: TFileName; const FunctionsList: TStrings; + const LibraryName: string; IncludeLibNames: Boolean): Boolean; +var + I: Integer; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK; + if Result then + with ImportList do + begin + TryGetNamesForOrdinalImports; + FunctionsList.BeginUpdate; + try + for I := 0 to AllItemCount - 1 do + with AllItems[I] do + if ((Length(LibraryName) = 0) or StrSame(ImportLib.Name, LibraryName)) and + (Name <> '') then + begin + if IncludeLibNames then + FunctionsList.Add(ImportLib.Name + '=' + Name) + else + FunctionsList.Add(Name); + end; + finally + FunctionsList.EndUpdate; + end; + end; + finally + Free; + end; +end; + +function PeExportedFunctions(const FileName: TFileName; const FunctionsList: TStrings): Boolean; +var + I: Integer; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK; + if Result then + begin + FunctionsList.BeginUpdate; + try + with ExportList do + for I := 0 to Count - 1 do + with Items[I] do + if not IsExportedVariable then + FunctionsList.Add(Name); + finally + FunctionsList.EndUpdate; + end; + end; + finally + Free; + end; +end; + +function PeExportedNames(const FileName: TFileName; const FunctionsList: TStrings): Boolean; +var + I: Integer; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK; + if Result then + begin + FunctionsList.BeginUpdate; + try + with ExportList do + for I := 0 to Count - 1 do + FunctionsList.Add(Items[I].Name); + finally + FunctionsList.EndUpdate; + end; + end; + finally + Free; + end; +end; + +function PeExportedVariables(const FileName: TFileName; const FunctionsList: TStrings): Boolean; +var + I: Integer; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK; + if Result then + begin + FunctionsList.BeginUpdate; + try + with ExportList do + for I := 0 to Count - 1 do + with Items[I] do + if IsExportedVariable then + FunctionsList.AddObject(Name, Pointer(Address)); + finally + FunctionsList.EndUpdate; + end; + end; + finally + Free; + end; +end; + +function PeResourceKindNames(const FileName: TFileName; ResourceType: TJclPeResourceKind; + const NamesList: TStrings): Boolean; +begin + with CreatePeImage(FileName) do + try + Result := StatusOK and ResourceList.ListResourceNames(ResourceType, NamesList); + finally + Free; + end; +end; + +function PeBorFormNames(const FileName: TFileName; const NamesList: TStrings): Boolean; +var + I: Integer; + BorImage: TJclPeBorImage; + BorForm: TJclPeBorForm; +begin + BorImage := TJclPeBorImage.Create(True); + try + BorImage.FileName := FileName; + Result := BorImage.IsBorlandImage; + if Result then + begin + NamesList.BeginUpdate; + try + for I := 0 to BorImage.FormCount - 1 do + begin + BorForm := BorImage.Forms[I]; + NamesList.AddObject(BorForm.DisplayName, Pointer(BorForm.ResItem.RawEntryDataSize)); + end; + finally + NamesList.EndUpdate; + end; + end; + finally + BorImage.Free; + end; +end; + +function PeBorDependedPackages(const FileName: TFileName; PackagesList: TStrings; + FullPathName, Descriptions: Boolean): Boolean; +var + BorImage: TJclPeBorImage; +begin + BorImage := TJclPeBorImage.Create(True); + try + BorImage.FileName := FileName; + Result := BorImage.DependedPackages(PackagesList, FullPathName, Descriptions); + finally + BorImage.Free; + end; +end; + +// Missing imports checking routines + +function PeFindMissingImports(const FileName: TFileName; MissingImportsList: TStrings): Boolean; +var + Cache: TJclPeImagesCache; + FileImage, LibImage: TJclPeImage; + L, I: Integer; + LibItem: TJclPeImportLibItem; + List: TStringList; +begin + Result := False; + List := nil; + Cache := TJclPeImagesCache.Create; + try + List := TStringList.Create; + List.Duplicates := dupIgnore; + List.Sorted := True; + FileImage := Cache[FileName]; + if FileImage.StatusOK then + begin + for L := 0 to FileImage.ImportList.Count - 1 do + begin + LibItem := FileImage.ImportList[L]; + LibImage := Cache[LibItem.FileName]; + if LibImage.StatusOK then + begin + LibImage.ExportList.PrepareForFastNameSearch; + for I := 0 to LibItem.Count - 1 do + if LibImage.ExportList.ItemFromName[LibItem[I].Name] = nil then + List.Add(LibItem.Name + '=' + LibItem[I].Name); + end + else + List.Add(LibItem.Name + '='); + end; + MissingImportsList.Assign(List); + Result := List.Count > 0; + end; + finally + List.Free; + Cache.Free; + end; +end; + +function PeFindMissingImports(RequiredImportsList, MissingImportsList: TStrings): Boolean; +var + Cache: TJclPeImagesCache; + LibImage: TJclPeImage; + I, SepPos: Integer; + List: TStringList; + S, LibName, ImportName: string; +begin + List := nil; + Cache := TJclPeImagesCache.Create; + try + List := TStringList.Create; + List.Duplicates := dupIgnore; + List.Sorted := True; + for I := 0 to RequiredImportsList.Count - 1 do + begin + S := RequiredImportsList[I]; + SepPos := Pos('=', S); + if SepPos = 0 then + Continue; + LibName := StrLeft(S, SepPos - 1); + LibImage := Cache[LibName]; + if LibImage.StatusOK then + begin + LibImage.ExportList.PrepareForFastNameSearch; + ImportName := StrRestOf(S, SepPos + 1); + if LibImage.ExportList.ItemFromName[ImportName] = nil then + List.Add(LibName + '=' + ImportName); + end + else + List.Add(LibName + '='); + end; + MissingImportsList.Assign(List); + Result := List.Count > 0; + finally + List.Free; + Cache.Free; + end; +end; + +function PeCreateRequiredImportList(const FileName: TFileName; RequiredImportsList: TStrings): Boolean; +begin + Result := PeImportedFunctions(FileName, RequiredImportsList, '', True); +end; + +// Mapped or loaded image related functions + +function PeMapImgNtHeaders(const BaseAddress: Pointer): PImageNtHeaders; +begin + Result := nil; + if IsBadReadPtr(BaseAddress, SizeOf(TImageDosHeader)) then + Exit; + if (PImageDosHeader(BaseAddress)^.e_magic <> IMAGE_DOS_SIGNATURE) or + (PImageDosHeader(BaseAddress)^._lfanew = 0) then + Exit; + Result := PImageNtHeaders(DWORD(BaseAddress) + DWORD(PImageDosHeader(BaseAddress)^._lfanew)); + if IsBadReadPtr(Result, SizeOf(TImageNtHeaders)) or + (Result^.Signature <> IMAGE_NT_SIGNATURE) then + Result := nil +end; + +function PeMapImgLibraryName(const BaseAddress: Pointer): string; +var + NtHeaders: PImageNtHeaders; + DataDir: TImageDataDirectory; + ExportDir: PImageExportDirectory; +begin + Result := ''; + NtHeaders := PeMapImgNtHeaders(BaseAddress); + if NtHeaders = nil then + Exit; + DataDir := NtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT]; + if DataDir.Size = 0 then + Exit; + ExportDir := PImageExportDirectory(DWORD(BaseAddress) + DataDir.VirtualAddress); + if IsBadReadPtr(ExportDir, SizeOf(TImageExportDirectory)) or (ExportDir^.Name = 0) then + Exit; + Result := PChar(DWORD(BaseAddress) + ExportDir^.Name); +end; + +function PeMapImgSections(NtHeaders: PImageNtHeaders): PImageSectionHeader; +begin + if NtHeaders = nil then + Result := nil + else + Result := PImageSectionHeader(DWORD(@NtHeaders^.OptionalHeader) + + NtHeaders^.FileHeader.SizeOfOptionalHeader); +end; + +function PeMapImgFindSection(NtHeaders: PImageNtHeaders; + const SectionName: string): PImageSectionHeader; +var + Header: PImageSectionHeader; + I: Integer; + P: PChar; +begin + Result := nil; + if NtHeaders <> nil then + begin + P := PChar(SectionName); + Header := PeMapImgSections(NtHeaders); + with NtHeaders^ do + for I := 1 to FileHeader.NumberOfSections do + if StrLComp(PChar(@Header^.Name), P, IMAGE_SIZEOF_SHORT_NAME) = 0 then + begin + Result := Header; + Break; + end + else + Inc(Header); + end; +end; + +function PeMapImgExportedVariables(const Module: HMODULE; const VariablesList: TStrings): Boolean; +var + I: Integer; +begin + with TJclPeImage.Create(True) do + try + AttachLoadedModule(Module); + Result := StatusOK; + if Result then + begin + VariablesList.BeginUpdate; + try + with ExportList do + for I := 0 to Count - 1 do + with Items[I] do + if IsExportedVariable then + VariablesList.AddObject(Name, MappedAddress); + finally + VariablesList.EndUpdate; + end; + end; + finally + Free; + end; +end; + +function PeMapImgResolvePackageThunk(Address: Pointer): Pointer; +const + JmpInstructionCode = $25FF; +type + PPackageThunk = ^TPackageThunk; + TPackageThunk = packed record + JmpInstruction: Word; + JmpAddress: PPointer; + end; +begin + if not IsCompiledWithPackages then + Result := Address + else + if not IsBadReadPtr(Address, SizeOf(TPackageThunk)) and + (PPackageThunk(Address)^.JmpInstruction = JmpInstructionCode) then + Result := PPackageThunk(Address)^.JmpAddress^ + else + Result := nil; +end; + +function PeMapFindResource(const Module: HMODULE; const ResourceType: PChar; + const ResourceName: string): Pointer; +var + ResItem: TJclPeResourceItem; +begin + Result := nil; + with TJclPeImage.Create(True) do + try + AttachLoadedModule(Module); + if StatusOK then + begin + ResItem := ResourceList.FindResource(ResourceType, PChar(ResourceName)); + if (ResItem <> nil) and ResItem.IsDirectory then + Result := ResItem.List[0].RawEntryData; + end; + finally + Free; + end; +end; + +//=== { TJclPeSectionStream } ================================================ + +constructor TJclPeSectionStream.Create(Instance: HMODULE; const ASectionName: string); +begin + inherited Create; + Initialize(Instance, ASectionName); +end; + +procedure TJclPeSectionStream.Initialize(Instance: HMODULE; const ASectionName: string); +var + Header: PImageSectionHeader; + NtHeaders: PImageNtHeaders; + DataSize: Integer; +begin + FInstance := Instance; + NtHeaders := PeMapImgNtHeaders(Pointer(Instance)); + if NtHeaders = nil then + raise EJclPeImageError.CreateRes(@RsPeNotPE); + Header := PeMapImgFindSection(NtHeaders, ASectionName); + if Header = nil then + raise EJclPeImageError.CreateResFmt(@RsPeSectionNotFound, [ASectionName]); + // Borland and Microsoft seems to have swapped the meaning of this items. + DataSize := Min(Header^.SizeOfRawData, Header^.Misc.VirtualSize); + SetPointer(Pointer(FInstance + Header^.VirtualAddress), DataSize); + FSectionHeader := Header^; +end; + +function TJclPeSectionStream.Write(const Buffer; Count: Integer): Longint; +begin + raise EJclPeImageError.CreateRes(@RsPeReadOnlyStream); +end; + +//=== { TJclPeMapImgHookItem } =============================================== + +destructor TJclPeMapImgHookItem.Destroy; +begin + if FBaseAddress <> nil then + InternalUnhook; + inherited Destroy; +end; + +function TJclPeMapImgHookItem.InternalUnhook: Boolean; +begin + Result := TJclPeMapImgHooks.ReplaceImport(FBaseAddress, ModuleName, NewAddress, OriginalAddress); + if Result then + FBaseAddress := nil; +end; + +function TJclPeMapImgHookItem.Unhook: Boolean; +begin + Result := InternalUnhook; + if Result then + FList.Remove(Self); +end; + +//=== { TJclPeMapImgHooks } ================================================== + +type + PWin9xDebugThunk = ^TWin9xDebugThunk; + TWin9xDebugThunk = packed record + PUSH: Byte; // PUSH instruction opcode ($68) + Addr: Pointer; // The actual address of the DLL routine + JMP: Byte; // JMP instruction opcode ($E9) + Rel: Integer; // Relative displacement (a Kernel32 address) + end; + +function TJclPeMapImgHooks.GetItemFromNewAddress(NewAddress: Pointer): TJclPeMapImgHookItem; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].NewAddress = NewAddress then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclPeMapImgHooks.GetItemFromOriginalAddress(OriginalAddress: Pointer): TJclPeMapImgHookItem; +var + I: Integer; +begin + Result := nil; + for I := 0 to Count - 1 do + if Items[I].OriginalAddress = OriginalAddress then + begin + Result := Items[I]; + Break; + end; +end; + +function TJclPeMapImgHooks.GetItems(Index: Integer): TJclPeMapImgHookItem; +begin + Result := TJclPeMapImgHookItem(Get(Index)); +end; + +function TJclPeMapImgHooks.HookImport(Base: Pointer; const ModuleName, FunctionName: string; + NewAddress: Pointer; var OriginalAddress: Pointer): Boolean; +var + Item: TJclPeMapImgHookItem; + ModuleHandle: THandle; +begin + ModuleHandle := GetModuleHandle(PChar(ModuleName)); + Result := (ModuleHandle <> 0); + if not Result then + begin + SetLastError(ERROR_MOD_NOT_FOUND); + Exit; + end; + OriginalAddress := GetProcAddress(ModuleHandle, PChar(FunctionName)); + Result := (OriginalAddress <> nil); + if not Result then + begin + SetLastError(ERROR_PROC_NOT_FOUND); + Exit; + end; + Result := (ItemFromOriginalAddress[OriginalAddress] = nil) and (NewAddress <> nil) and + (OriginalAddress <> NewAddress); + if not Result then + begin + SetLastError(ERROR_ALREADY_EXISTS); + Exit; + end; + if Result then + Result := ReplaceImport(Base, ModuleName, OriginalAddress, NewAddress); + if Result then + begin + Item := TJclPeMapImgHookItem.Create; + Item.FBaseAddress := Base; + Item.FFunctionName := FunctionName; + Item.FModuleName := ModuleName; + Item.FOriginalAddress := OriginalAddress; + Item.FNewAddress := NewAddress; + Item.FList := Self; + Add(Item); + end + else + SetLastError(ERROR_INVALID_PARAMETER); +end; + +class function TJclPeMapImgHooks.IsWin9xDebugThunk(P: Pointer): Boolean; +begin + with PWin9xDebugThunk(P)^ do + Result := (PUSH = $68) and (JMP = $E9); +end; + +class function TJclPeMapImgHooks.ReplaceImport(Base: Pointer; ModuleName: string; + FromProc, ToProc: Pointer): Boolean; +var + FromProcDebugThunk, ImportThunk: PWin9xDebugThunk; + IsThunked: Boolean; + NtHeader: PImageNtHeaders; + ImportDir: TImageDataDirectory; + ImportDesc: PImageImportDescriptor; + CurrName: PChar; + ImportEntry: PImageThunkData; + FoundProc: Boolean; + LastProtect, Dummy: Cardinal; +begin + Result := False; + FromProcDebugThunk := PWin9xDebugThunk(FromProc); + IsThunked := not IsWinNT and IsWin9xDebugThunk(FromProcDebugThunk); + NtHeader := PeMapImgNtHeaders(Base); + if NtHeader = nil then + Exit; + ImportDir := NtHeader.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]; + if ImportDir.VirtualAddress = 0 then + Exit; + ImportDesc := PImageImportDescriptor(DWORD(Base) + ImportDir.VirtualAddress); + while ImportDesc^.Name <> 0 do + begin + CurrName := PChar(Base) + ImportDesc^.Name; + if StrIComp(CurrName, PChar(ModuleName)) = 0 then + begin + ImportEntry := PImageThunkData(DWORD(Base) + ImportDesc^.FirstThunk); + while ImportEntry^.Function_ <> 0 do + begin + if IsThunked then + begin + ImportThunk := PWin9xDebugThunk(ImportEntry^.Function_); + FoundProc := IsWin9xDebugThunk(ImportThunk) and (ImportThunk^.Addr = FromProcDebugThunk^.Addr); + end + else + FoundProc := Pointer(ImportEntry^.Function_) = FromProc; + if FoundProc then + begin + if VirtualProtect(@ImportEntry^.Function_, SizeOf(ToProc), + PAGE_READWRITE, @LastProtect) then + begin + ImportEntry^.Function_ := Cardinal(ToProc); + + // According to Platform SDK documentation, the last parameter + // has to be (point to) a valid variable + VirtualProtect(@ImportEntry^.Function_, SizeOf(ToProc), + LastProtect, Dummy); + Result := True; + end; + end; + Inc(ImportEntry); + end; + end; + Inc(ImportDesc); + end; +end; + +class function TJclPeMapImgHooks.SystemBase: Pointer; +begin + Result := Pointer(SystemTObjectInstance); +end; + +procedure TJclPeMapImgHooks.UnhookAll; +var + I: Integer; +begin + I := 0; + while I < Count do + if not Items[I].Unhook then + Inc(I); +end; + +function TJclPeMapImgHooks.UnhookByNewAddress(NewAddress: Pointer): Boolean; +var + Item: TJclPeMapImgHookItem; +begin + Item := ItemFromNewAddress[NewAddress]; + Result := (Item <> nil) and Item.Unhook; +end; + +// Image access under a debbuger + +function InternalReadProcMem(ProcessHandle: THandle; Address: DWORD; + Buffer: Pointer; Size: Integer): Boolean; +var + BR: DWORD; +begin + Result := ReadProcessMemory(ProcessHandle, Pointer(Address), Buffer, Size, BR); +end; + +function PeDbgImgNtHeaders(ProcessHandle: THandle; BaseAddress: Pointer; + var NtHeaders: TImageNtHeaders): Boolean; +var + DosHeader: TImageDosHeader; +begin + Result := False; + FillChar(NtHeaders, SizeOf(NtHeaders), 0); + FillChar(DosHeader, SizeOf(DosHeader), 0); + if not InternalReadProcMem(ProcessHandle, DWORD(BaseAddress), @DosHeader, SizeOf(DosHeader)) then + Exit; + if DosHeader.e_magic <> IMAGE_DOS_SIGNATURE then + Exit; + Result := InternalReadProcMem(ProcessHandle, DWORD(BaseAddress) + DWORD(DosHeader._lfanew), + @NtHeaders, SizeOf(TImageNtHeaders)); +end; + +function PeDbgImgLibraryName(ProcessHandle: THandle; BaseAddress: Pointer; + var Name: string): Boolean; +var + NtHeaders: TImageNtHeaders; + DataDir: TImageDataDirectory; + ExportDir: TImageExportDirectory; +begin + Name := ''; + Result := PeDbgImgNtHeaders(ProcessHandle, BaseAddress, NtHeaders); + if not Result then + Exit; + DataDir := NtHeaders.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT]; + if DataDir.Size = 0 then + Exit; + if not InternalReadProcMem(ProcessHandle, DWORD(BaseAddress) + DataDir.VirtualAddress, + @ExportDir, SizeOf(ExportDir)) then + Exit; + if ExportDir.Name = 0 then + Exit; + SetLength(Name, MAX_PATH); + if InternalReadProcMem(ProcessHandle, DWORD(BaseAddress) + ExportDir.Name, PChar(Name), MAX_PATH) then + StrResetLength(Name) + else + Name := ''; +end; + +// Borland BPL packages name unmangling + +function PeBorUnmangleName(const Name: string; var Unmangled: string; + var Description: TJclBorUmDescription; var BasePos: Integer): TJclBorUmResult; +var + NameP, NameU, NameUFirst: PChar; + QualifierFound, LinkProcFound: Boolean; + + procedure MarkQualifier; + begin + if not QualifierFound then + begin + QualifierFound := True; + BasePos := NameU - NameUFirst + 2; + end; + end; + + procedure ReadSpecialSymbol; + var + SymbolLength: Integer; + begin + SymbolLength := 0; + while NameP^ in AnsiDecDigits do + begin + SymbolLength := SymbolLength * 10 + Ord(NameP^) - 48; + Inc(NameP); + end; + while (SymbolLength > 0) and (NameP^ <> #0) do + begin + if NameP^ = '@' then + begin + MarkQualifier; + NameU^ := '.'; + end + else + NameU^ := NameP^; + Inc(NameP); + Inc(NameU); + Dec(SymbolLength); + end; + end; + + procedure ReadRTTI; + begin + if StrLComp(NameP, '$xp$', 4) = 0 then + begin + Inc(NameP, 4); + Description.Kind := skRTTI; + QualifierFound := False; + ReadSpecialSymbol; + if QualifierFound then + Include(Description.Modifiers, smQualified); + end + else + Result := urError; + end; + + procedure ReadNameSymbol; + begin + if NameP^ = '@' then + begin + LinkProcFound := True; + Inc(NameP); + end; + while NameP^ in AnsiValidIdentifierLetters do + begin + NameU^ := NameP^; + Inc(NameP); + Inc(NameU); + end; + end; + + procedure ReadName; + begin + Description.Kind := skData; + QualifierFound := False; + LinkProcFound := False; + repeat + ReadNameSymbol; + if LinkProcFound and not QualifierFound then + LinkProcFound := False; + case NameP^ of + '@': + case (NameP + 1)^ of + #0: + begin + Description.Kind := skVTable; + Break; + end; + '$': + begin + if (NameP + 2)^ = 'b' then + begin + case (NameP + 3)^ of + 'c': + Description.Kind := skConstructor; + 'd': + Description.Kind := skDestructor; + end; + Inc(NameP, 6); + end + else + Description.Kind := skFunction; + Break; // no parameters unmangling yet + end; + else + MarkQualifier; + NameU^ := '.'; + Inc(NameU); + Inc(NameP); + end; + '$': + begin + Description.Kind := skFunction; + Break; // no parameters unmangling yet + end; + else + Break; + end; + until False; + if QualifierFound then + Include(Description.Modifiers, smQualified); + if LinkProcFound then + Include(Description.Modifiers, smLinkProc); + end; + +begin + NameP := PChar(Name); + Result := urError; + case NameP^ of + '@': + Result := urOk; + '?': + Result := urMicrosoft; + '_', 'A'..'Z', 'a'..'z': + Result := urNotMangled; + end; + if Result <> urOk then + Exit; + Inc(NameP); + SetLength(UnMangled, 1024); + NameU := Pointer(UnMangled); + NameUFirst := NameU; + Description.Modifiers := []; + BasePos := 1; + case NameP^ of + '$': + ReadRTTI; + '_', 'A'..'Z', 'a'..'z': + ReadName; + else + Result := urError; + end; + NameU^ := #0; + StrResetLength(Unmangled); +end; + +function PeBorUnmangleName(const Name: string; var Unmangled: string; + var Description: TJclBorUmDescription): TJclBorUmResult; +var + BasePos: Integer; +begin + Result := PeBorUnmangleName(Name, Unmangled, Description, BasePos); +end; + +function PeBorUnmangleName(const Name: string; var Unmangled: string): TJclBorUmResult; +var + Description: TJclBorUmDescription; + BasePos: Integer; +begin + Result := PeBorUnmangleName(Name, Unmangled, Description, BasePos); +end; + +function PeBorUnmangleName(const Name: string): string; +var + Unmangled: string; + Description: TJclBorUmDescription; + BasePos: Integer; +begin + if PeBorUnmangleName(Name, Unmangled, Description, BasePos) = urOk then + Result := Unmangled + else + Result := ''; +end; + +function PeIsNameMangled(const Name: string): TJclPeUmResult; +begin + Result := umNotMangled; + if Length(Name) > 0 then + case Name[1] of + '@': + Result := umBorland; + '?': + Result := umMicrosoft; + end; +end; + +function PeUnmangleName(const Name: string; var Unmangled: string): TJclPeUmResult; +var + Res: DWORD; +begin + Result := umNotMangled; + case PeBorUnmangleName(Name, Unmangled) of + urOk: + Result := umBorland; + urMicrosoft: + begin + SetLength(Unmangled, 2048); + Res := UnDecorateSymbolName(PChar(Name), PChar(Unmangled), 2048, UNDNAME_NAME_ONLY); + if Res > 0 then + begin + StrResetLength(Unmangled); + Result := umMicrosoft; + end + else + Unmangled := ''; + end; + end; + if Result = umNotMangled then + Unmangled := Name; +end; + +// History: + +// $Log: JclPeImage.pas,v $ +// Revision 1.24 2005/03/09 23:52:19 rrossmair +// - replaced constant UnixDateDelta by JclDateTime.UnixTimeStart +// +// Revision 1.23 2005/03/08 16:10:10 marquardt +// standard char sets extended and used, some optimizations for string literals +// +// Revision 1.22 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.21 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.20 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.19 2005/02/22 07:29:52 uschuster +// added function PeInsertSection(a generic version of JclDebug.InsertDebugDataIntoExecutableFile) +// +// Revision 1.18 2004/10/23 23:31:27 rrossmair +// - fixed bug # 0001885 +// +// Revision 1.17 2004/10/19 21:26:47 rrossmair +// restore JclWin32 compatibility +// +// Revision 1.16 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.15 2004/09/30 13:11:27 marquardt +// remove PH contributions +// +// Revision 1.14 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.13 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.12 2004/07/29 07:58:22 marquardt +// inc files updated +// +// Revision 1.11 2004/07/28 18:00:53 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.10 2004/06/16 07:30:31 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.9 2004/06/14 13:05:21 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.8 2004/06/02 03:23:47 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.7 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.6 2004/04/06 04:41:07 +// Remove the BCB5 conditions +// + +end. diff --git a/official/1.96/source/windows/JclRegistry.pas b/official/1.96/source/windows/JclRegistry.pas new file mode 100644 index 0000000..cddca32 --- /dev/null +++ b/official/1.96/source/windows/JclRegistry.pas @@ -0,0 +1,1728 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ 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: 2006/01/15 19:10:45 $ +// For history see end of file + +unit JclRegistry; + +{$I jcl.inc} + +interface + +uses + Windows, Classes, + JclBase, JclStrings, JclWideStrings; + +type + DelphiHKEY = Longword; + {$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); +{$ENDIF ~FPC} + +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: AnsiString; 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: AnsiString; out RetValue: AnsiString; RaiseException: Boolean = False): Boolean; +function RegReadAnsiString(const RootKey: DelphiHKEY; const Key, Name: AnsiString): AnsiString; +function RegReadAnsiStringDef(const RootKey: DelphiHKEY; const Key, Name: AnsiString; 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 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; Value: string); overload; +procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name, Value: AnsiString); overload; +procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: AnsiString; DataType: Cardinal; Value: AnsiString); overload; +procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; Value: WideString); overload; +procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; 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 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 RegHasSubKeys(const RootKey: DelphiHKEY; const Key: string): Boolean; + +function AllowRegKeyForEveryone(const RootKey: DelphiHKEY; Path: 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 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; + +implementation + +uses + SysUtils, + {$IFDEF FPC} + JwaAccCtrl, + {$ELSE} + AccCtrl, + {$ENDIF FPC} + JclResources, JclSysUtils, JclWin32; + +type + TRegKind = REG_NONE..REG_QWORD; + TRegKinds = set of TRegKind; + +const + cItems = 'Items'; + cRegBinKinds = [REG_SZ..REG_QWORD]; // all types + +//=== Internal helper routines =============================================== + +procedure ReadError(const Key: string); +begin + raise EJclRegistryError.CreateResFmt(@RsUnableToOpenKeyRead, [Key]); +end; + +procedure WriteError(const Key: string); +begin + raise EJclRegistryError.CreateResFmt(@RsUnableToOpenKeyWrite, [Key]); +end; + +procedure ValueError(const Key, Name: string); +begin + raise EJclRegistryError.CreateResFmt(@RsUnableToAccessValue, [Key, Name]); +end; + +procedure DataError(const Key, Name: string); +begin + raise EJclRegistryError.CreateResFmt(@RsWrongDataType, [Key, Name]); +end; + +function GetKeyAndPath(ExecKind: TExecKind; var 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: PChar): PChar; +type + TRootKey = record + Key: DelphiHKEY; + Name: PChar; + end; +const + RootKeys: array [0..13] of TRootKey = + ( + (Key: HKCR; Name: 'HKEY_CLASSES_ROOT\'), + (Key: HKCU; Name: 'HKEY_CURRENT_USER\'), + (Key: HKLM; Name: 'HKEY_LOCAL_MACHINE\'), + (Key: HKUS; Name: 'HKEY_USERS\'), + (Key: HKPD; Name: 'HKEY_PERFORMANCE_DATA\'), + (Key: HKCC; Name: 'HKEY_CURRENT_CONFIG\'), + (Key: HKDD; Name: 'HKEY_DYN_DATA\'), + (Key: HKCR; Name: 'HKCR\'), + (Key: HKCU; Name: 'HKCU\'), + (Key: HKLM; Name: 'HKLM\'), + (Key: HKUS; Name: 'HKUS\'), + (Key: HKPD; Name: 'HKPD\'), + (Key: HKCC; Name: 'HKCC\'), + (Key: HKDD; Name: 'HKDD\') + ); +var + I: Integer; +begin + Result := Key; + if Result^ = '\' then + Inc(Result); + for I := Low(RootKeys) to High(RootKeys) do + if StrPos(Key, RootKeys[I].Name) = Result then + begin + if RootKey <> RootKeys[I].Key then + raise EJclRegistryError.CreateResFmt(@RsInconsistentPath, [Key]) + else + Inc(Result, StrLen(RootKeys[I].Name)); + Break; + end; +end; + +function InternalRegOpenKeyEx(Key: HKEY; SubKey: PChar; + ulOptions: DWORD; samDesired: REGSAM; var RegKey: HKEY): Longint; +var + WideKey: WideString; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + begin + WideKey := RelativeKey(Key, SubKey); + Result := RegOpenKeyExW(Key, PWideChar(WideKey), ulOptions, samDesired, RegKey); + end + else + Result := RegOpenKeyExA(Key, RelativeKey(Key, SubKey), ulOptions, samDesired, RegKey); +end; + +function InternalRegQueryValueEx(Key: HKEY; ValueName: PChar; + lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; +var + WideName: WideString; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + begin + WideName := ValueName; + Result := RegQueryValueExW(Key, PWideChar(WideName), lpReserved, lpType, lpData, lpcbData); + end + else + Result := RegQueryValueExA(Key, ValueName, lpReserved, lpType, lpData, lpcbData); +end; + +function InternalRegSetValueEx(Key: HKEY; ValueName: PChar; + Reserved: DWORD; dwType: DWORD; lpData: Pointer; cbData: DWORD): Longint; stdcall; +var + WideName: WideString; +begin + if Win32Platform = VER_PLATFORM_WIN32_NT then + begin + WideName := ValueName; + Result := RegSetValueExW(Key, PWideChar(WideName), Reserved, dwType, lpData, cbData); + end + else + Result := RegSetValueExA(Key, PChar(ValueName), Reserved, dwType, lpData, cbData); +end; + +function InternalGetData(const RootKey: DelphiHKEY; const Key, Name: string; + 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; + if InternalRegOpenKeyEx(RootKey, PChar(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then + try + if InternalRegQueryValueEx(RegKey, PChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then + begin + if not (DataType in RegKinds) or (DataSize > ExpectedSize) then + if RaiseException then + DataError(Key, Name) + else + Result := False; + if InternalRegQueryValueEx(RegKey, PChar(Name), nil, nil, Data, @DataSize) <> ERROR_SUCCESS then + if RaiseException then + ValueError(Key, Name) + else + Result := False; + end + else + if RaiseException then + ValueError(Key, Name) + else + Result := False; + finally + RegCloseKey(RegKey); + end + else + if RaiseException then + ReadError(Key) + else + Result := False;; +end; + +function InternalGetString(const RootKey: DelphiHKEY; const Key, Name: string; MultiFlag: Boolean; + out RetValue: string; RaiseException: Boolean): Boolean; +var + RegKey: HKEY; + DataType, DataSize: DWORD; + RegKinds: TRegKinds; +begin + Result := True; + DataType := REG_NONE; + DataSize := 0; + RetValue := ''; + if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS then + try + if RegQueryValueEx(RegKey, PChar(Name), nil, @DataType, nil, @DataSize) = ERROR_SUCCESS then + begin + RegKinds := [REG_BINARY, REG_SZ, REG_EXPAND_SZ]; + if MultiFlag then + RegKinds := RegKinds + [REG_MULTI_SZ]; + if not (DataType in RegKinds) then + DataError(Key, Name); + SetLength(RetValue, DataSize div SizeOf(Char) + 1); + if RegQueryValueEx(RegKey, PChar(Name), nil, nil, Pointer(RetValue), @DataSize) <> ERROR_SUCCESS then + begin + RetValue := ''; + if RaiseException then + ValueError(Key, Name) + else + begin + Result := False; + DataSize := 1; // => empty string + end; + end; + SetLength(RetValue, (DataSize - 1) div SizeOf(Char)); + end + else + if RaiseException then + ValueError(Key, Name) + else + Result := False; + finally + RegCloseKey(RegKey); + end + else + if RaiseException then + ReadError(Key) + else + Result := False; +end; + +function InternalGetWideString(const RootKey: DelphiHKEY; const Key, Name: string; MultiFlag: Boolean; + out RetValue: WideString; RaiseException: Boolean): Boolean; +var + RegKey: HKEY; + DataType, DataSize: DWORD; + RegKinds: TRegKinds; +begin + Result := True; + DataType := REG_NONE; + DataSize := 0; + RetValue := ''; + if InternalRegOpenKeyEx(RootKey, PChar(Key), 0, KEY_READ, RegKey) = ERROR_SUCCESS then + try + if InternalRegQueryValueEx(RegKey, PChar(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 not (DataType in RegKinds) then + DataError(Key, Name); + SetLength(RetValue, DataSize div SizeOf(WideChar) + 1); + if InternalRegQueryValueEx(RegKey, PChar(Name), nil, nil, Pointer(RetValue), @DataSize) <> ERROR_SUCCESS then + begin + RetValue := ''; + if RaiseException then + ValueError(Key, Name) + else + begin + Result := False; + DataSize := 1; // => empty string + end; + end; + SetLength(RetValue, (DataSize - 1) div SizeOf(WideChar)); + end + else + if RaiseException then + ValueError(Key, Name) + else + Result := False; + finally + RegCloseKey(RegKey); + end + else + if RaiseException then + ReadError(Key) + else + Result := False; +end; + +procedure InternalSetData(const RootKey: DelphiHKEY; const Key, Name: string; + RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal); +var + RegKey: HKEY; +begin + if not RegKeyExists(RootKey, Key) then + RegCreateKey(RootKey, Key); + if RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_WRITE, RegKey) = ERROR_SUCCESS then + try + if RegSetValueEx(RegKey, PChar(Name), 0, RegKind, Value, ValueSize) <> ERROR_SUCCESS then + WriteError(Key); + finally + RegCloseKey(RegKey); + end + else + WriteError(Key); +end; + +procedure InternalSetWideData(const RootKey: DelphiHKEY; const Key, Name: string; + RegKind: TRegKind; Value: Pointer; ValueSize: Cardinal); +var + RegKey: HKEY; +begin + if not RegKeyExists(RootKey, Key) then + RegCreateKey(RootKey, Key); + if InternalRegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_WRITE, RegKey) = ERROR_SUCCESS then + try + if InternalRegSetValueEx(RegKey, PChar(Name), 0, RegKind, Value, ValueSize) <> ERROR_SUCCESS then + WriteError(Key); + finally + RegCloseKey(RegKey); + end + else + WriteError(Key); +end; + +//=== Registry =============================================================== + +function RegCreateKey(const RootKey: DelphiHKEY; const Key: string): Longint; +var + RegKey: HKEY; +begin + Result := Windows.RegCreateKey(RootKey, RelativeKey(RootKey, PChar(Key)), RegKey); + 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; + if RegOpenKeyEx(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(Key, Name); + end + else + WriteError(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 + Result := RegOpenKeyEx(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 + '\' + KeyName); + if not Result then + Break; + end; + RegCloseKey(RegKey); + if Result then + Result := Windows.RegDeleteKey(RootKey, RelativeKey(RootKey, PChar(Key))) = ERROR_SUCCESS; + end + else + WriteError(Key); +end; + +function RegGetDataSize(const RootKey: DelphiHKEY; const Key, Name: string; + out DataSize: Cardinal): Boolean; +var + RegKey: HKEY; +begin + DataSize := 0; + Result := RegOpenKeyEx(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; + Result := RegOpenKeyEx(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 + FillChar(Data[0], SizeOf(Data), 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; + OldSep: Char; +begin + RegGetDataType(RootKey, Key, Name, DataType); + OldSep := DecimalSeparator; + if DataType in [REG_SZ, REG_EXPAND_SZ] then + try + DecimalSeparator := '.'; + if RaiseException then + begin + RetValue := StrToFloat(RegReadString(RootKey, Key, Name)); + Result := True; + end + else + Result := TryStrToFloat(RegReadString(RootKey, Key, Name), RetValue); + finally + DecimalSeparator := OldSep; + end + 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; + OldSep: Char; +begin + RegGetDataType(RootKey, Key, Name, DataType); + OldSep := DecimalSeparator; + if DataType in [REG_SZ, REG_EXPAND_SZ] then + try + DecimalSeparator := '.'; + if RaiseException then + begin + RetValue := StrToFloat(RegReadString(RootKey, Key, Name)); + Result := True; + end + else + Result := TryStrToFloat(RegReadString(RootKey, Key, Name), RetValue); + finally + DecimalSeparator := OldSep; + end + 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; + OldSep: Char; +begin + RegGetDataType(RootKey, Key, Name, DataType); + OldSep := DecimalSeparator; + if DataType in [REG_SZ, REG_EXPAND_SZ] then + try + DecimalSeparator := '.'; + if RaiseException then + begin + RetValue := StrToFloat(RegReadString(RootKey, Key, Name)); + Result := True; + end + else + Result := TryStrToFloat(RegReadString(RootKey, Key, Name), RetValue); + finally + DecimalSeparator := OldSep; + end + 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: AnsiString; RaiseException: Boolean): Boolean; +begin + Result := RegReadAnsiStringEx(RootKey, Key, Name, RetValue, RaiseException); +end; + +function RegReadString(const RootKey: DelphiHKEY; const Key, Name: string): string; +begin + Result := RegReadAnsiString(RootKey, Key, Name); +end; + +function RegReadStringDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: string): string; +begin + Result := RegReadAnsiStringDef(RootKey, Key, Name, Def); +end; + +function RegReadAnsiStringEx(const RootKey: DelphiHKEY; const Key, Name: AnsiString; + out RetValue: AnsiString; RaiseException: Boolean): Boolean; +begin + Result := InternalGetString(RootKey, Key, Name, False, RetValue, RaiseException); +end; + +function RegReadAnsiString(const RootKey: DelphiHKEY; const Key, Name: AnsiString): AnsiString; +begin + RegReadAnsiStringEx(RootKey, Key, Name, Result, True); +end; + +function RegReadAnsiStringDef(const RootKey: DelphiHKEY; const Key, Name: AnsiString; 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; +var + S: string; +begin + Result := InternalGetString(RootKey, Key, Name, True, S, RaiseException); + if Result then + MultiSzToStrings(Value, PMultiSz(PChar(S))); +end; + +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; +var + S: string; +begin + RetValue := nil; + Result := InternalGetString(RootKey, Key, Name, True, S, RaiseException); + if Result then + // always returns a newly allocated PMultiSz + RetValue := MultiSzDup(PMultiSz(PChar(S))); +end; + +function RegReadMultiSz(const RootKey: DelphiHKEY; const Key, Name: string): PMultiSz; +begin + RegReadMultiSzEx(RootKey, Key, Name, Result, True); +end; + +function RegReadMultiSzDef(const RootKey: DelphiHKEY; const Key, Name: string; Def: PMultiSz): PMultiSz; +begin + try + if not RegReadMultiSzEx(RootKey, Key, Name, Result, False) then + // always returns a newly allocated PMultiSz + Result := MultiSzDup(Def); + except + // always returns a newly allocated PMultiSz + Result := 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 + WideMultiSzToWideStrings(Value, PWideMultiSz(PWideChar(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 := WideMultiSzDup(PWideMultiSz(PWideChar(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 := WideMultiSzDup(Def); + except + // always returns a newly allocated PWideMultiSz + Result := WideMultiSzDup(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(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(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(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(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(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(Key, Name); +end; + +procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name, Value: string); +begin + RegWriteAnsiString(RootKey, Key, Name, REG_SZ, Value); +end; + +procedure RegWriteString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: string); +begin + RegWriteAnsiString(RootKey, Key, Name, DataType, Value); +end; + +procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name, Value: AnsiString); +begin + RegWriteAnsiString(RootKey, Key, Name, REG_SZ, Value); +end; + +procedure RegWriteAnsiString(const RootKey: DelphiHKEY; const Key, Name: AnsiString; DataType: Cardinal; Value: AnsiString); +begin + if DataType in [REG_BINARY, REG_SZ, REG_EXPAND_SZ] then + InternalSetData(RootKey, Key, Name, DataType, PChar(Value), + (Length(Value) + 1) * SizeOf(AnsiChar)) + else + DataError(Key, Name); +end; + +procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; Value: WideString); +begin + RegWriteWideString(RootKey, Key, Name, REG_SZ, Value); +end; + +procedure RegWriteWideString(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: WideString); +begin + if DataType in [REG_BINARY, REG_SZ, REG_EXPAND_SZ] then + if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then + InternalSetWideData(RootKey, Key, Name, REG_BINARY, PWideChar(Value), + (Length(Value) + 1) * SizeOf(WideChar)) + else + InternalSetWideData(RootKey, Key, Name, DataType, PWideChar(Value), + (Length(Value) + 1) * SizeOf(WideChar)) + else + DataError(Key, Name); +end; + +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; Value: PMultiSz); +begin + RegWriteMultiSz(RootKey, Key, Name, REG_MULTI_SZ, Value); +end; + +procedure RegWriteMultiSz(const RootKey: DelphiHKEY; const Key, Name: string; DataType: Cardinal; Value: PMultiSz); +begin + if DataType in [REG_BINARY, REG_MULTI_SZ] then + InternalSetData(RootKey, Key, Name, DataType, Value, + MultiSzLength(Value) * SizeOf(Char)) + else + DataError(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: PMultiSz; +begin + if DataType in [REG_BINARY, REG_MULTI_SZ] then + begin + StringsToMultiSz(Dest, Value); + try + RegWriteMultiSz(RootKey, Key, Name, DataType, Dest); + finally + FreeMultiSz(Dest); + end; + end + else + DataError(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 Win32Platform = VER_PLATFORM_WIN32_WINDOWS then + DataType := REG_BINARY; + if DataType in [REG_BINARY, REG_MULTI_SZ] then + InternalSetWideData(RootKey, Key, Name, DataType, Value, + WideMultiSzLength(Value) * SizeOf(WideChar)) + else + DataError(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 + WideStringsToWideMultiSz(Dest, Value); + try + RegWriteWideMultiSz(RootKey, Key, Name, DataType, Dest); + finally + FreeWideMultiSz(Dest); + end; + end + else + DataError(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; + if RegOpenKeyEx(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(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; + if RegOpenKeyEx(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(Key); + finally + List.EndUpdate; + end; +end; + +function RegHasSubKeys(const RootKey: DelphiHKEY; const Key: string): Boolean; +var + RegKey: HKEY; + NumSubKeys: Integer; +begin + Result := False; + if RegOpenKeyEx(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(Key); +end; + +function RegKeyExists(const RootKey: DelphiHKEY; const Key: string): Boolean; +var + RegKey: HKEY; +begin + Result := (RegOpenKeyEx(RootKey, RelativeKey(RootKey, PChar(Key)), 0, KEY_READ, RegKey) = ERROR_SUCCESS); + if Result then + RegCloseKey(RegKey); +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 + '\' + 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 + '\' + 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 + '\' + 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; +begin + Result := Win32Platform <> VER_PLATFORM_WIN32_NT; + if not Result then // Win 2000/XP + begin + case RootKey of + HKLM: + Path := 'HKEY_LOCAL_MACHINE\' + RelativeKey(RootKey, PChar(Path)); + HKCU: + Path := 'HKEY_CURRENT_USER\' + RelativeKey(RootKey, PChar(Path)); + HKCR: + Path := 'HKEY_CLASSES_ROOT\' + RelativeKey(RootKey, PChar(Path)); + HKUS: + Path := 'HKEY_USERS\' + RelativeKey(RootKey, PChar(Path)); + end; + Len := (Length(Path) + 1) * SizeOf(WideChar); + GetMem(WidePath, Len); + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(Path), -1, WidePath, Len); + Result := RtdlSetNamedSecurityInfoW(WidePath, SE_REGISTRY_KEY, + DACL_SECURITY_INFORMATION, nil, nil, nil, nil) = ERROR_SUCCESS; + FreeMem(WidePath); + end; +end; + +// History: + +// $Log: JclRegistry.pas,v $ +// Revision 1.40 2006/01/15 19:10:45 ahuser +// Added RegRead*Ex functions +// RegRead*Def functions do not raise exceptions anymore (makes debugging easier) +// +// Revision 1.39 2005/10/24 12:06:28 marquardt +// fix RegLoadList for nonexistent list +// +// Revision 1.38 2005/04/07 00:41:38 rrossmair +// - changed for FPC 1.9.8 +// +// Revision 1.37 2005/04/04 19:15:42 outchy +// IT2805: Range Check Error in RegReadInteger and RegWriteInteger +// +// Revision 1.36 2005/03/08 08:33:22 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.35 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.34 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.33 2005/02/22 07:36:46 marquardt +// minor cleanups +// +// Revision 1.32 2005/02/20 13:09:52 marquardt +// Win 9x bugfixes +// +// Revision 1.31 2004/11/06 02:13:31 mthoma +// history cleaning. +// +// Revision 1.30 2004/10/25 15:05:13 marquardt +// bugfix +// +// Revision 1.29 2004/10/25 08:51:22 marquardt +// PH cleaning +// +// Revision 1.28 2004/10/22 15:47:15 marquardt +// add functions for Single, Double, Extended +// +// Revision 1.27 2004/10/21 06:38:53 marquardt +// style clenaing, bugfixes, improvements +// +// Revision 1.26 2004/10/20 17:13:53 rrossmair +// - fixed RegReadUInt64 (DataType undefined) +// +// Revision 1.25 2004/10/20 16:57:32 rrossmair +// - RegReadUInt64: D7 internal error C1118 workaround +// +// Revision 1.24 2004/10/19 06:27:03 marquardt +// JclRegistry extended, JclNTFS made compiling, JclDateTime style cleaned +// +// Revision 1.23 2004/10/18 16:22:14 marquardt +// JclRegistry redesign to remove PH contributor +// +// Revision 1.22 2004/10/17 21:00:15 mthoma +// cleaning +// +// Revision 1.21 2004/10/11 08:13:04 marquardt +// PH cleaning of JclStrings +// +// Revision 1.20 2004/09/30 07:50:29 marquardt +// remove PH contributions +// +// Revision 1.19 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.18 2004/07/28 18:00:53 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.17 2004/06/14 13:05:21 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.16 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.15 2004/05/31 22:45:07 rrossmair +// rollback to rev. 1.13 state +// +// Revision 1.13 2004/05/19 21:43:36 rrossmair +// processed help TODOs +// +// Revision 1.12 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.11 2004/04/12 22:02:53 +// Bugfix RegReadBinary for @Value = Nil or ValueSize = 0, +// add some WideString support, add RegGetDataSize, RegGetDataType, add alternative RegReadBinary function +// +// Revision 1.10 2004/04/08 13:46:38 ahuser +// BCB 6 compatible (no impact on Delphi) +// +// Revision 1.9 2004/04/08 10:34:58 rrossmair +// revert to 1.7 (temporarily?) +// +// Revision 1.7 2004/04/06 05:56:10 rrossmair +// fixed RegReadUInt64 & RegReadUInt64Def +// +// Revision 1.6 2004/04/06 04:45:57 +// Unite the single read functions and the single write functions, add Cardinal, +// Int64, UInt64 and Multistring support + +end. + diff --git a/official/1.96/source/windows/JclSecurity.pas b/official/1.96/source/windows/JclSecurity.pas new file mode 100644 index 0000000..4f854c9 --- /dev/null +++ b/official/1.96/source/windows/JclSecurity.pas @@ -0,0 +1,456 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ Various NT security related routines to perform commen asks such as enabling and disabling } +{ privileges. } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/02/25 07:20:16 $ +// For history see end of file + +unit JclSecurity; + +{$I jcl.inc} +{$I windowsonly.inc} + +{$HPPEMIT '#define TTokenInformationClass TOKEN_INFORMATION_CLASS'} + +interface + +uses + Windows, SysUtils, + JclBase; + +// Access Control +function CreateNullDacl(var Sa: TSecurityAttributes; + const Inheritable: Boolean): PSecurityAttributes; +function CreateInheritable(var Sa: TSecurityAttributes): PSecurityAttributes; + +// Privileges +function IsAdministrator: 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: string); +procedure QueryTokenInformation(Token: THandle; InformationClass: TTokenInformationClass; var Buffer: Pointer); +procedure FreeTokenInformation(var Buffer: Pointer); +{$IFNDEF FPC} +function GetInteractiveUserName: string; +{$ENDIF ~FPC} + +implementation + +uses + {$IFDEF FPC} + WinSysUt, + JwaAccCtrl, + {$ELSE} + AccCtrl, + {$ENDIF FPC} + JclResources, JclStrings, JclSysInfo, JclWin32; + +//=== Access Control ========================================================= + +function CreateNullDacl(var 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(var 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 IsAdministrator: Boolean; +var + psidAdmin: Pointer; + Token: THandle; + Count: DWORD; + TokenInfo: PTokenGroups; + HaveToken: Boolean; + I: Integer; +begin + Result := not IsWinNT; + if Result then // Win9x/ME + Exit; + psidAdmin := nil; + TokenInfo := nil; + HaveToken := False; + try + 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, DOMAIN_ALIAS_RID_ADMINS, 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, DOMAIN_ALIAS_RID_ADMINS, 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); + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} + if Result then + Break; + end; + end; + finally + if TokenInfo <> nil then + FreeMem(TokenInfo); + if HaveToken then + CloseHandle(Token); + if psidAdmin <> nil then + FreeSid(psidAdmin); + end; +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; + 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); + 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 + 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 + 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: string); +var + NameSize, DomainSize: DWORD; + Use: SID_NAME_USE; +begin + if IsWinNT then + begin + NameSize := 0; + DomainSize := 0; + { TODO : Check the success } + LookupAccountSid(nil, Sid, nil, NameSize, nil, DomainSize, Use); + SetLength(Name, NameSize); + SetLength(Domain, DomainSize); + Win32Check(LookupAccountSid(nil, Sid, PChar(Name), NameSize, PChar(Domain), DomainSize, Use)); + SetLength(Domain, StrLen(PChar(Domain))); + SetLength(Name, StrLen(PChar(Name))); + end + else + begin // if Win9x, then function return '' + 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} + 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} + 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; + +{$IFNDEF FPC} // JclSysInfo.GetShellProcessHandle not available +function GetInteractiveUserName: string; +var + Handle: THandle; + Token: THandle; + User: PTokenUser; + Name, Domain: string; +begin + Result := ''; + if not IsWinNT then // if Win9x, then function return '' + Exit; + Handle := GetShellProcessHandle; + try + Win32Check(OpenProcessToken(Handle, TOKEN_QUERY, Token)); + try + 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; +{$ENDIF ~FPC} + +// History: + +// $Log: JclSecurity.pas,v $ +// Revision 1.17 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.16 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.15 2004/10/25 08:51:23 marquardt +// PH cleaning +// +// Revision 1.14 2004/10/17 21:00:16 mthoma +// cleaning +// +// Revision 1.13 2004/07/29 07:58:22 marquardt +// inc files updated +// +// Revision 1.12 2004/07/28 18:00:54 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.11 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.10 2004/06/02 03:23:47 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.9 2004/05/13 07:46:06 rrossmair +// changes for FPC 1.9.3+ compatibility +// +// Revision 1.8 2004/05/05 07:30:54 rrossmair +// Changes for FPC compatibility; header updated according to new policy: initial developers & contributors listed +// +// Revision 1.7 2004/04/06 04:55:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclShell.pas b/official/1.96/source/windows/JclShell.pas new file mode 100644 index 0000000..17f2594 --- /dev/null +++ b/official/1.96/source/windows/JclShell.pas @@ -0,0 +1,1466 @@ +{**************************************************************************************************} +{ } +{ 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 } +{ Jeff } +{ Aleksej Kudinov } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Olivier Sannier (obones) } +{ Matthias Thoma (mthoma) } +{ Petr Vones (pvones) } +{ } +{**************************************************************************************************} +{ } +{ 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: 2006/01/02 04:30:53 $ +// For history see end of file + +unit JclShell; + +{$I jcl.inc} + +interface + +uses + Windows, SysUtils, + {$IFNDEF FPC} + ShlObj, + {$ENDIF ~FPC} + JclWin32, JclSysUtils; + +// Files and Folders +type + TSHDeleteOption = (doSilent, doAllowUndo, doFilesOnly); + TSHDeleteOptions = set of TSHDeleteOption; + TSHRenameOption = (roSilent, roRenameOnCollision); + TSHRenameOptions = set of TSHRenameOption; + + TUnicodePath = array [0..MAX_PATH-1] of WideChar; + TAnsiPath = array [0..MAX_PATH-1] of char; + +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; + +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 Folder: 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; + end; + +procedure ShellLinkFree(var Link: TShellLink); +function ShellLinkResolve(const FileName: string; var Link: TShellLink): HRESULT; +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; + +// 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): Boolean; + +function ShellOpenAs(const FileName: string): Boolean; +function ShellRasDial(const EntryName: string): Boolean; +function ShellRunControlPanel(const NameOrFileName: string; AppletNumber: Integer = 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'; +var + RtdlMsiLibHandle: TModuleHandle = INVALID_MODULEHANDLE_VALUE; + RtdlMsiGetShortcutTarget: function(szShortcutPath: LPCSTR; szProductCode: LPSTR; + szFeatureId: LPSTR; szComponentCode: LPSTR): UINT; stdcall = nil; + + RtdlMsiGetComponentPath: function(szProduct: LPCSTR; szComponent: LPCSTR; + lpPathBuf: LPSTR; pcchBuf: LPDWORD): INSTALLSTATE; stdcall = nil; + +implementation + +uses + ActiveX, + {$IFNDEF FPC} + CommCtrl, + {$ENDIF ~FPC} + Messages, ShellApi, + JclFileUtils, JclStrings, JclSysInfo; + +const + cVerbProperties = 'properties'; + cVerbOpen = 'open'; + cVerbExplore = 'explore'; + +//=== 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 + FillChar(FileOp, SizeOf(FileOp), #0); + with FileOp do + begin + {$IFDEF FPC} + THandle := Parent; + {$ELSE} + Wnd := Parent; + {$ENDIF FPC} + wFunc := FO_DELETE; + Source := Files + #0#0; + pFrom := PChar(Source); + fFlags := DeleteOptionsToCardinal(Options); + end; + {$IFDEF FPC} + Result := SHFileOperation(@FileOp) = 0; + {$ELSE} + Result := SHFileOperation(FileOp) = 0; + {$ENDIF FPC} +end; + +function SHDeleteFolder(Parent: THandle; const Folder: string; + Options: TSHDeleteOptions): Boolean; +begin + Exclude(Options, doFilesOnly); + Result := SHDeleteFiles(Parent, PathAddSeparator(Folder) + '*.*', Options); + if Result then + SHDeleteFiles(Parent, 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 + FillChar(FileOp, SizeOf(FileOp), #0); + with FileOp do + begin + {$IFDEF FPC} + THandle := GetDesktopWindow; + {$ELSE} + Wnd := GetDesktopWindow; + {$ENDIF FPC} + wFunc := FO_RENAME; + Source := Src + #0#0; + Destination := Dest + #0#0; + pFrom := PChar(Source); + pTo := PChar(Destination); + fFlags := RenameOptionsToCardinal(Options); + end; + {$IFDEF FPC} + Result := SHFileOperation(@FileOp) = 0; + {$ELSE} + Result := SHFileOperation(FileOp) = 0; + {$ENDIF FPC} +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: TUnicodePath; + IconIndex: Integer; + Flags: DWORD; +begin + Result := False; + ClearEnumFolderRec(F, True, False); + if (F.EnumIdList = nil) or (F.Folder = nil) then + Exit; + if F.EnumIdList.Next(1, F.Item, ItemsFetched) = NO_ERROR then + begin + 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 + ExtractIcon.GetIconLocation(0, @IconFile, MAX_PATH, IconIndex, Flags); + if (IconIndex < 0) and ((Flags and GIL_NOTFILENAME) = GIL_NOTFILENAME) 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); + SHGetDesktopFolder(DesktopFolder); + if SpecialFolder = CSIDL_DESKTOP then + F.Folder := DesktopFolder + else + begin + SHGetSpecialFolderLocation(0, SpecialFolder, FolderPidl); + try + DesktopFolder.BindToObject(FolderPidl, nil, IID_IShellFolder, Pointer(F.Folder)); + finally + PidlFree(FolderPidl); + end; + end; + F.Folder.EnumObjects(0, EnumFolderFlagsToCardinal(Flags), F.EnumIdList); + Result := SHEnumFolderNext(F); + if not Result then + SHEnumFolderClose(F); +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 Folder: Integer): string; +var + FolderPidl: PItemIdList; +begin + if Succeeded(SHGetSpecialFolderLocation(0, Folder, FolderPidl)) then + begin + Result := PidlToPath(FolderPidl); + PidlFree(FolderPidl); + end + else + Result := ''; +end; + +function DisplayPropDialog(const Handle: THandle; const FileName: string): Boolean; +var + Info: TShellExecuteInfo; +begin + FillChar(Info, SizeOf(Info), #0); + with Info do + begin + cbSize := SizeOf(Info); + lpFile := PChar(FileName); + nShow := SW_SHOW; + fMask := SEE_MASK_INVOKEIDLIST; + Wnd := Handle; + lpVerb := cVerbProperties; + end; + Result := ShellExecuteEx(@Info); +end; + +function DisplayPropDialog(const Handle: THandle; Item: PItemIdList): Boolean; +var + Info: TShellExecuteInfo; +begin + FillChar(Info, SizeOf(Info), #0); + 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; + Result := ShellExecuteEx(@Info); +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); + SetWindowLong(Wnd, GWL_USERDATA, Longint(ContextMenu2)); + Result := DefWindowProc(Wnd, Msg, wParam, lParam); + end; + WM_INITMENUPOPUP: + begin + ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA)); + ContextMenu2.HandleMenuMsg(Msg, wParam, lParam); + Result := 0; + end; + WM_DRAWITEM, WM_MEASUREITEM: + begin + ContextMenu2 := IContextMenu2(GetWindowLong(Wnd, GWL_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 + FillChar(WndClass, SizeOf(WndClass), #0); + WndClass.lpszClassName := PChar(IcmCallbackWnd); + WndClass.lpfnWndProc := @MenuCallback; + WndClass.hInstance := HInstance; + 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 + FillChar(CommandInfo, SizeOf(CommandInfo), #0); + CommandInfo.cbSize := SizeOf(TCMInvokeCommandInfo); + CommandInfo.hwnd := Handle; + CommandInfo.lpVerb := MakeIntResource(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 + FillChar(Sei, SizeOf(Sei), #0); + with Sei do + begin + cbSize := SizeOf(Sei); + Wnd := Parent; + if Explore then + lpVerb := cVerbExplore + else + lpVerb := cVerbOpen; + lpFile := PChar(Path); + nShow := SW_SHOWNORMAL; + end; + Result := ShellExecuteEx(@Sei); + end; +end; + +function OpenSpecialFolder(FolderID: Integer; Parent: THandle; Explore: Boolean): Boolean; +var + Malloc: IMalloc; + Pidl: PItemIDList; + Sei: TShellExecuteInfo; +begin + Result := False; + if Succeeded(SHGetMalloc(Malloc)) and + Succeeded(SHGetSpecialFolderLocation(Parent, FolderID, Pidl)) then + begin + FillChar(Sei, SizeOf(Sei), #0); + 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; + Result := ShellExecuteEx(@Sei); + Malloc.Free(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 + FillChar(P^, Count, #0); + 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: TUnicodePath; +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 + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(PathAddSeparator(DriveName)), -1, Path, MAX_PATH); + 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; + PidlFree(Drives); + end; +end; + +function PathToPidl(const Path: string; Folder: IShellFolder): PItemIdList; +var + DesktopFolder: IShellFolder; + CharsParsed, Attr: ULONG; + WidePath: TUnicodePath; +begin + Result := nil; + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(Path), -1, WidePath, MAX_PATH); + 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: TUnicodePath; +begin + Result := nil; + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(ExtractFilePath(FileName)), -1, Path, MAX_PATH); + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(ExtractFileName(FileName)), -1, ItemName, MAX_PATH); + if Succeeded(SHGetDesktopFolder(DesktopFolder)) then + begin + 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 + 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 := StrRet.cStr; + else + Result := ''; + end; +end; + +//=== ShortCuts / Shell link ================================================= + +procedure ShellLinkFree(var Link: TShellLink); +begin + PidlFree(Link.IdList); +end; + +const + IID_IShellLink: TGUID = { IID_IShellLinkA } + (D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46)); + +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 + Path := PidltoPath(Pidl); + if Path <> '' then + begin + StrResetLength(Path); + Result := ShellLinkCreate(Link, PathAddSeparator(Path) + FileName); + end; + end; +end; + +function ShellLinkCreate(const Link: TShellLink; const FileName: string): HRESULT; +var + ShellLink: IShellLink; + PersistFile: IPersistFile; + LinkName: TUnicodePath; +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; + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(FileName), -1, + LinkName, MAX_PATH); + 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,'MsiGetShortcutTargetA'); + + if not Assigned(RtdlMsiGetComponentPath) then + RtdlMsiGetComponentPath:=GetModuleSymbol(rtdlMsiLibHandle,'MsiGetComponentPathA'); + + Result:=(Assigned(RtdlMsiGetShortcutTarget)) and (Assigned(RtdlMsiGetComponentPath)); + end; +end; + +function ShellLinkResolve(const FileName: string; var Link: TShellLink): HRESULT; +const + MAX_FEATURE_CHARS = 38; // maximum chars in MSI feature name +var + ShellLink: IShellLink; + PersistFile: IPersistFile; + LinkName: TUnicodePath; + 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 + FillChar(ProductGuid, SizeOf(ProductGuid), #0); + FillChar(FeatureID, SizeOf(FeatureID), #0); + FillChar(ComponentGuid, SizeOf(ComponentGuid), #0); + FillChar(TargetFile, SizeOf(TargetFile), #0); + + if RtdlMsiGetShortcutTarget(PAnsiChar(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); + MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(FullPath), -1, LinkName, MAX_PATH); + Result := PersistFile.Load(LinkName, STGM_READ); + + if Succeeded(Result) then + begin + Result := ShellLink.Resolve(0, SLR_ANY_MATCH); + + if Succeeded(Result) then + begin + SetLength(Buffer, MAX_PATH); + + if not TargetResolved then + begin + 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 + FillChar(Info, SizeOf(Info), 0); + 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; + +//=== 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 + 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 := LoadLibrary(PChar(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; + 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; + 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 + FillChar(FileInfo, SizeOf(FileInfo), #0); + 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 + FillChar(Sei, SizeOf(Sei), #0); + 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; + Result := ShellExecuteEx(@Sei); +end; + +{ TODO -cHelp : author Jeff 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): Boolean; +var + Sei: TShellExecuteInfo; + Res: LongBool; + Msg: tagMSG; +begin + FillChar(Sei, SizeOf(Sei), #0); + 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; + Result := ShellExecuteEx(@Sei); + if Result then + begin + WaitForInputIdle(Sei.hProcess, INFINITE); + while WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT do + repeat + 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 + TRasDialDlgA = function(lpszPhonebook, lpszEntry, lpszPhoneNumber: PAnsiChar; lpInfo: PRasDialDlg): BOOL; stdcall; + +function ShellRasDial(const EntryName: string): Boolean; +var + Info: TRasDialDlg; + RasDlg: HModule; + RasDialDlgA: TRasDialDlgA; +begin + if IsWinNT then + begin + Result := False; + RasDlg := LoadLibrary(PChar('rasdlg.dll')); + if RasDlg <> 0 then + try + @RasDialDlgA := GetProcAddress(RasDlg, PChar('RasDialDlgA')); + if @RasDialDlgA <> nil then + begin + FillChar(Info, SizeOf(Info), 0); + Info.dwSize := SizeOf(Info); + Result := RasDialDlgA(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; + +function GetFileExeType(const FileName: TFileName): TJclFileExeType; +var + FileInfo: TSHFileInfo; + R: DWORD; +begin + 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: TAnsiPath; + I: Integer; +begin + FillChar(Buffer, SizeOf(Buffer), #0); + 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 + FillChar(FileInfo, SizeOf(FileInfo), #0); + 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 + +finalization + UnloadModule(rtdlMsiLibHandle); + +// History: + +// $Log: JclShell.pas,v $ +// Revision 1.22 2006/01/02 04:30:53 elahn +// Added parameter "Explore" added to OpenFolder & OpenSpecialFolder (Mantis #3402) +// +// Revision 1.21 2005/12/12 21:54:10 outchy +// HWND changed to THandle (linking problems with BCB). +// +// Revision 1.20 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.19 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.18 2005/02/13 15:47:09 mthoma +// SHEnumFolderNext works now with Win9x. +// +// Revision 1.17 2004/12/22 11:44:22 rikbarker +// Modified ShellLinkResolve to correctly read the target from MSI style shortcuts without invoking the windows installer if the product component was set to "Install on First Use". Added dynamic links to MSI functions in msi.dll +// +// Revision 1.16 2004/12/03 15:36:04 rikbarker +// Fixed ShellLinkResolve to correctly Resolve TargetPath for MS-Office style link files. +// +// Revision 1.15 2004/10/17 21:48:07 mthoma +// Removed ShellRasDial contribution. Rewrite needed as soon as dynmic linking support in JclWin32 has been redesigned. +// +// Revision 1.14 2004/10/17 21:00:16 mthoma +// cleaning +// +// Revision 1.13 2004/07/28 18:00:54 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.12 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.11 2004/05/09 11:22:39 rrossmair +// Contributor list update +// +// Revision 1.10 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.9 2004/04/09 20:46:30 mthoma +// Fixed 0000923 (ShellRunControlPanel). Changed $data$ to date. +// +// Revision 1.8 2004/04/06 04:55:18 +// adapt compiler conditions, add log entry +// + +end. + + diff --git a/official/1.96/source/windows/JclStructStorage.pas b/official/1.96/source/windows/JclStructStorage.pas new file mode 100644 index 0000000..060e2ab --- /dev/null +++ b/official/1.96/source/windows/JclStructStorage.pas @@ -0,0 +1,801 @@ +{**************************************************************************************************} +{ } +{ 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. } +{ } +{**************************************************************************************************} +{ } +{ MS Structured storage class wrapper } +{ } +{ Unit owner: Peter Thornqvist } +{ Contributor(s): } +{ A. Schmidt (shmia (at) bizerba.de) } +{ } +{**************************************************************************************************} +// Last modified: $Date: 2005/04/08 11:56:27 $ +// For history see end of file + +{ +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} + +interface + +uses + Windows, Classes, SysUtils, ActiveX, + 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 comitted immediately and thus cannot be comitted + function Commit: Boolean; + // Reverts any changes when smTransacted is true + // When smTransacted is false, changes are comitted 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); + +implementation + +uses + ComObj, + 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 + 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); + end; +end; + +procedure FreeWChar(W: PWideChar); +begin + if Assigned(W) then + FreeMem(W); +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: Int64; +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: Int64; +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; + +// History: + +// $Log: JclStructStorage.pas,v $ +// Revision 1.9 2005/04/08 11:56:27 outchy +// IT 2845: wrong widestring size +// +// Revision 1.8 2005/03/08 08:33:23 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.7 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.6 2004/10/02 05:47:29 marquardt +// added check for incompatible jedi.inc +// replaced jedi.inc with jvcl.inc +// +// Revision 1.5 2004/08/02 15:30:17 marquardt +// hunting down (rom) comments +// +// Revision 1.4 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.3 2004/07/28 18:00:54 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.2 2004/06/16 07:30:31 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.1 2004/06/12 02:50:33 rrossmair +// initial check-in +// +// +// donated 2004/04/30 20:54:36 + +end. + diff --git a/official/1.96/source/windows/JclSvcCtrl.pas b/official/1.96/source/windows/JclSvcCtrl.pas new file mode 100644 index 0000000..20f3b7a --- /dev/null +++ b/official/1.96/source/windows/JclSvcCtrl.pas @@ -0,0 +1,1536 @@ +{**************************************************************************************************} +{ } +{ 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 } +{ } +{**************************************************************************************************} +{ } +{ This unit contains routines and classes to control NT service } +{ } +{ Unit owner: Flier Lu } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/02/25 07:20:16 $ +// For history see end of file + +{$R+} { TODO : Why Rangecheck on here? } + +unit JclSvcCtrl; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + Windows, Classes, SysUtils, Contnrs, + {$IFDEF FPC} + JwaWinNT, JwaWinSvc, + {$ELSE} + WinSvc, + {$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} + +type + LPSERVICE_DESCRIPTIONA = ^SERVICE_DESCRIPTIONA; + {$EXTERNALSYM LPSERVICE_DESCRIPTIONA} + SERVICE_DESCRIPTIONA = record + lpDescription: LPSTR; + end; + {$EXTERNALSYM SERVICE_DESCRIPTIONA} + TServiceDescriptionA = SERVICE_DESCRIPTIONA; + PServiceDescriptionA = LPSERVICE_DESCRIPTIONA; + +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; + 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); + 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 + constructor Create(const ASCManager: TJclSCManager; const SvcStatus: TEnumServiceStatus); + 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 + 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 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 + constructor Create(const ASCManager: TJclSCManager; const AName: string; const AOrder: Integer); + function Add(const AService: TJclNtService): Integer; + function Remove(const AService: TJclNtService): Integer; + public + 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; var NtSvc: TJclNtService): Boolean; + function FindGroup(const GrpName: string; var 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; + +implementation + +uses + {$IFDEF FPC} + WinSysUt, + JwaRegStr, + {$ELSE} + RegStr, + {$ENDIF FPC} + Math, + 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 := 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.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); + Ret := EnumDependentServices(FHandle, SERVICE_STATE_ALL, + PEnumServiceStatus(PBuf){$IFNDEF FPC}^{$ENDIF}, BytesNeeded, BytesNeeded, ServicesReturned); + until Ret or (GetLastError <> ERROR_INSUFFICIENT_BUFFER); + Win32Check(Ret); + + PEss := PBuf; + 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); + 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: PQueryServiceConfig; +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: PQueryServiceConfig; +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^); + Win32Check(ChangeServiceConfig(Handle, + PQrySvcCnfg^.dwServiceType, + PQrySvcCnfg^.dwStartType, + PQrySvcCnfg^.dwErrorControl, + nil, {PQrySvcCnfg^.lpBinaryPathName,} + nil, {PQrySvcCnfg^.lpLoadOrderGroup,} + nil, {PQrySvcCnfg^.dwTagId,} + nil, {PQrySvcCnfg^.lpDependencies,} + nil, {PQrySvcCnfg^.lpServiceStartName,} + nil, {password-write only-not readable} + 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; + begin + Assert((DesiredAccess and SC_MANAGER_ENUMERATE_SERVICE) <> 0); + // Enum the services + ResumeHandle := 0; // Must set this value to zero !!! + try + PBuf := nil; + BytesNeeded := 40960; + repeat + ReallocMem(PBuf, BytesNeeded); + Ret := EnumServicesStatus(FHandle, SERVICE_TYPE_ALL, SERVICE_STATE_ALL, + PEnumServiceStatus(PBuf){$IFNDEF FPC}^{$ENDIF}, + BytesNeeded, BytesNeeded, ServicesReturned, ResumeHandle); + until Ret or (GetLastError <> ERROR_MORE_DATA); + Win32Check(Ret); + + PEss := PBuf; + for I := 0 to ServicesReturned - 1 do + begin + NtSvc := TJclNtService.Create(Self, PEss^); + NtSvc.Refresh; + Inc(PEss); + end; + 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 + GetService(I).Refresh; + 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; var 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; var 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 (IsWin2K or IsWinXP) then + 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: DWORD; + 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 + 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: DWORD; + 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: DWORD; + 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 + Result:=ControlService(ServiceHandle,SERVICE_CONTROL_STOP,SS); + + CloseServiceHandle(ServiceHandle); + finally + CloseServiceHandle(SCMHandle); + end; +end; + +function GetServiceStatus(ServiceHandle: SC_HANDLE): DWORD; +var + ServiceStatus: TServiceStatus; +begin + 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 + 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; + +// History: + +// $Log: JclSvcCtrl.pas,v $ +// Revision 1.32 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.31 2005/02/24 16:34:52 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.30 2004/12/22 09:21:32 rrossmair +// - removed superfluous comma in line 746 (which D7's parser did tolerate, but those of D5 and D6 did not) +// +// Revision 1.29 2004/12/21 12:24:51 rikbarker +// Added code by Warren Postma to allow modification of service start type. (Disabled, Automatic etc) +// Added three new helper functions, +// GetServiceStatusByName +// StartServiceByName +// StopServiceByName +// +// Revision 1.28 2004/10/24 01:36:26 mthoma +// history cleaned. +// +// Revision 1.27 2004/10/21 08:40:11 marquardt +// style cleaning +// +// Revision 1.26 2004/10/21 06:38:53 marquardt +// style clenaing, bugfixes, improvements +// +// Revision 1.25 2004/10/20 09:35:06 rikbarker +// EnumServiceGroups Modified to use new JclRegistry MULTI_SZ enabled functions. +// PH cleaning of GetServiceStatus. +// GetServiceStatusWaitingIfPending rewritten +// New set ssPendingStates defined +// +// Revision 1.24 2004/10/17 21:00:16 mthoma +// cleaning +// +// Revision 1.23 2004/10/11 08:13:04 marquardt +// PH cleaning of JclStrings +// +// Revision 1.22 2004/07/29 07:58:22 marquardt +// inc files updated +// +// Revision 1.21 2004/07/28 18:00:54 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.20 2004/06/16 07:30:31 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.19 2004/06/14 13:05:21 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.18 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.17 2004/06/02 03:23:47 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.16 2004/05/13 07:46:06 rrossmair +// changes for FPC 1.9.3+ compatibility +// +// Revision 1.15 2004/05/06 23:41:33 rrossmair +// fix: $IFDEF FPC left empty const section +// +// Revision 1.14 2004/05/06 22:37:10 rrossmair +// contributor list updated +// +// Revision 1.13 2004/05/06 22:29:19 rrossmair +// Changes for FPC v1.9.4 compatibility +// +// Revision 1.12 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.11 2004/04/26 04:25:46 +// - add GetServiceStatus +// - add GetServiceStatusWaitingIfPending +// +// Revision 1.10 2004/04/12 22:04:38 +// Bugfix: TJclSCManager.Refresh EnumServiceGroups +// +// Revision 1.9 2004/04/08 19:49:26 mthoma +// Fixed 0000521, 0000848. Range check error in TJclSCManager.Refresh and TJclSCManager raises exception when free'd . +// +// Revision 1.8 2004/04/08 12:18:07 obones +// BCB5 compatibility fix +// +// Revision 1.7 2004/04/08 02:44:52 rrossmair +// Log clean-up, typo in $Date: 2005/02/25 07:20:16 $ corrected +// +// Revision 1.6 2004/04/07 18:43:02 +// +// Revision 1.5 2004/04/07 14:01:15 obones +// +// Revision 1.4 2004/04/06 04:55:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclSynch.pas b/official/1.96/source/windows/JclSynch.pas new file mode 100644 index 0000000..3a9db16 --- /dev/null +++ b/official/1.96/source/windows/JclSynch.pas @@ -0,0 +1,1428 @@ +{**************************************************************************************************} +{ } +{ 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: 2005/03/08 08:33:23 $ +// For history see end of file + +unit JclSynch; + +{$I jcl.inc} + +interface + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + JclBase; + +// Locked Integer manipulation +// +// Routines to manipulate simple typed variables in a thread safe manner +function LockedAdd(var Target: Integer; Value: Integer): Integer; +function LockedCompareExchange(var Target: Integer; Exch, Comp: Integer): Integer; overload; +function LockedCompareExchange(var Target: Pointer; Exch, Comp: Pointer): Pointer; overload; +function LockedDec(var Target: Integer): Integer; +function LockedExchange(var Target: Integer; Value: Integer): Integer; +function LockedExchangeAdd(var Target: Integer; Value: Integer): Integer; +function LockedExchangeDec(var Target: Integer): Integer; +function LockedExchangeInc(var Target: Integer): Integer; +function LockedExchangeSub(var Target: Integer; Value: Integer): Integer; +function LockedInc(var Target: Integer): Integer; +function LockedSub(var Target: Integer; Value: Integer): Integer; + +// TJclDispatcherObject +// +// Base class for operating system provided synchronisation primitives +type + TJclWaitResult = (wrAbandoned, wrError, wrIoCompletion, wrSignaled, wrTimeout); + + TJclDispatcherObject = class(TObject) + private + FExisted: Boolean; + FHandle: THandle; + FName: string; + public + constructor Attach(Handle: THandle); + 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: THandle 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 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); virtual; + 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; var 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); + +implementation + +uses + SysUtils, + JclLogic, JclRegistry, JclResources, JclSysInfo, JclWin32; + +const + RegSessionManager = {HKLM\} 'SYSTEM\CurrentControlSet\Control\Session Manager'; + RegCritSecTimeout = {RegSessionManager\} 'CriticalSectionTimeout'; + +// Locked Integer manipulation +function LockedAdd(var Target: Integer; Value: Integer): Integer; assembler; +asm + MOV ECX, EAX + MOV EAX, EDX + LOCK XADD [ECX], EAX + ADD EAX, EDX +end; + +function LockedCompareExchange(var Target: Integer; Exch, Comp: Integer): Integer; assembler; +asm + XCHG EAX, ECX + LOCK CMPXCHG [ECX], EDX +end; + +function LockedCompareExchange(var Target: Pointer; Exch, Comp: Pointer): Pointer; assembler; +asm + XCHG EAX, ECX + LOCK CMPXCHG [ECX], EDX +end; + +function LockedDec(var Target: Integer): Integer; assembler; +asm + MOV ECX, EAX + MOV EAX, -1 + LOCK XADD [ECX], EAX + DEC EAX +end; + +function LockedExchange(var Target: Integer; Value: Integer): Integer; assembler; +asm + MOV ECX, EAX + MOV EAX, EDX + LOCK XCHG [ECX], EAX +end; + +function LockedExchangeAdd(var Target: Integer; Value: Integer): Integer; assembler; +asm + MOV ECX, EAX + MOV EAX, EDX + LOCK XADD [ECX], EAX +end; + +function LockedExchangeDec(var Target: Integer): Integer; assembler; +asm + MOV ECX, EAX + MOV EAX, -1 + LOCK XADD [ECX], EAX +end; + +function LockedExchangeInc(var Target: Integer): Integer; assembler; +asm + MOV ECX, EAX + MOV EAX, 1 + LOCK XADD [ECX], EAX +end; + +function LockedExchangeSub(var Target: Integer; Value: Integer): Integer; assembler; +asm + MOV ECX, EAX + NEG EDX + MOV EAX, EDX + LOCK XADD [ECX], EAX +end; + +function LockedInc(var Target: Integer): Integer; assembler; +asm + MOV ECX, EAX + MOV EAX, 1 + LOCK XADD [ECX], EAX + INC EAX +end; + +function LockedSub(var Target: Integer; Value: Integer): Integer; assembler; +asm + MOV ECX, EAX + NEG EDX + MOV EAX, EDX + LOCK XADD [ECX], EAX + ADD EAX, EDX +end; + +//=== { 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(Handle: THandle); +begin + FExisted := True; + FHandle := Handle; + 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(Windows.SignalObjectAndWait(Obj.Handle, Handle, TimeOut, Alertable))); +end; + +function TJclDispatcherObject.WaitAlertable(const TimeOut: Cardinal): TJclWaitResult; +begin + Result := MapSignalResult(Windows.WaitForSingleObjectEx(FHandle, TimeOut, True)); +end; + +function TJclDispatcherObject.WaitFor(const TimeOut: Cardinal): TJclWaitResult; +begin + Result := MapSignalResult(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 THandle; + I, Count: Integer; +begin + Count := High(Objects) + 1; + SetLength(Handles, Count); + for I := 0 to Count - 1 do + Handles[I] := Objects[I].Handle; + Result := Windows.WaitForMultipleObjects(Count, @Handles[0], WaitAll, TimeOut); +end; + +function WaitAlertableForMultipleObjects(const Objects: array of TJclDispatcherObject; + WaitAll: Boolean; TimeOut: Cardinal): Cardinal; +var + Handles: array of THandle; + I, Count: Integer; +begin + Count := High(Objects) + 1; + SetLength(Handles, Count); + for I := 0 to Count - 1 do + Handles[I] := Objects[I].Handle; + Result := Windows.WaitForMultipleObjectsEx(Count, @Handles[0], WaitAll, TimeOut, True); +end; + +//=== { TJclCriticalSection } ================================================ + +constructor TJclCriticalSection.Create; +begin + inherited Create; + Windows.InitializeCriticalSection(FCriticalSection); +end; + +destructor TJclCriticalSection.Destroy; +begin + 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 + Windows.EnterCriticalSection(FCriticalSection); +end; + +procedure TJclCriticalSection.Leave; +begin + 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 := 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 := Windows.OpenEvent(Access, Inheritable, PChar(Name)); + if FHandle = 0 then + raise EJclEventError.CreateRes(@RsSynchOpenEvent); +end; + +function TJclEvent.Pulse: Boolean; +begin + Result := Windows.PulseEvent(FHandle); +end; + +function TJclEvent.ResetEvent: Boolean; +begin + Result := Windows.ResetEvent(FHandle); +end; + +function TJclEvent.SetEvent: Boolean; +begin + Result := 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; + 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; + 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 := 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 := 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 := Windows.ReleaseSemaphore(FHandle, ReleaseCount, @PrevCount); +end; + +function TJclSemaphore.Release(ReleaseCount: Integer): Boolean; +begin + Result := Windows.ReleaseSemaphore(FHandle, ReleaseCount, nil); +end; + +//=== { TJclMutex } ========================================================== + +constructor TJclMutex.Create(SecAttr: PSecurityAttributes; InitialOwner: Boolean; const Name: string); +begin + FName := Name; + FHandle := JclWin32.CreateMutex(SecAttr, Ord(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 + FName := Name; + FExisted := True; + FHandle := Windows.OpenMutex(Access, Inheritable, PChar(Name)); + if FHandle = 0 then + raise EJclMutexError.CreateRes(@RsSynchOpenMutex); +end; + +function TJclMutex.Release: Boolean; +begin + Result := 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 := Windows.CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, + 0, SizeOf(TOptexSharedInfo), PChar('Optex_MMF_' + Name)); + Assert(FFileMapping <> 0); + FSharedInfo := 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 + Windows.UnmapViewOfFile(FSharedInfo); + Windows.CloseHandle(FFileMapping); + end; + inherited Destroy; +end; + +procedure TJclOptex.Enter; +var + ThreadId: Longword; +begin + if TryEnter then + Exit; + ThreadId := Windows.GetCurrentThreadId; + if 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 + Windows.InterlockedDecrement(FSharedInfo^.LockCount) + else + begin + FSharedInfo^.ThreadId := 0; + if 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 + Windows.InterlockedExchange(Integer(FSharedInfo^.SpinCount), Value); +end; + +function TJclOptex.TryEnter: Boolean; +var + ThreadId: Longword; + ThreadOwnsOptex: Boolean; + SpinCount: Integer; +begin + ThreadId := 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 + 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 := 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 := 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); + 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 Windows.InterlockedExchange(FMetSect^.SharedInfo^.SpinLock, 1) <> 0 do + Windows.Sleep(0); +end; + +procedure TJclMeteredSection.CloseMeteredSection; +begin + if FMetSect <> nil then + begin + if FMetSect^.SharedInfo <> nil then + Windows.UnmapViewOfFile(FMetSect^.SharedInfo); + if FMetSect^.FileMap <> 0 then + Windows.CloseHandle(FMetSect^.FileMap); + if FMetSect^.Event <> 0 then + 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 := Windows.CreateEvent(nil, False, False, nil) + else + begin + FullName := 'JCL_MSECT_EVT_' + Name; + if OpenOnly then + FMetSect^.Event := Windows.OpenEvent(0, False, PChar(FullName)) + else + FMetSect^.Event := 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 := Windows.CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TMetSectSharedInfo), nil) + else + begin + FullName := 'JCL_MSECT_MMF_' + Name; + if OpenOnly then + FMetSect^.FileMap := Windows.OpenFileMapping(0, False, PChar(FullName)) + else + FMetSect^.FileMap := Windows.CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(TMetSectSharedInfo), PChar(FullName)); + end; + if FMetSect^.FileMap <> 0 then + begin + LastError := GetLastError; + FMetSect^.SharedInfo := 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; + 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); + Windows.ResetEvent(FMetSect^.Event); + finally + ReleaseLock; + end; + Result := MapSignalResult(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; var 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 + 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); + 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 + 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; + +// History: + +// $Log: JclSynch.pas,v $ +// Revision 1.17 2005/03/08 08:33:23 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.16 2005/03/04 06:40:26 marquardt +// changed overloaded constructors to constructor with default parameter (BCB friendly) +// +// Revision 1.15 2005/02/24 16:34:53 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.14 2004/10/21 08:40:11 marquardt +// style cleaning +// +// Revision 1.13 2004/10/17 23:09:37 mthoma +// More cleaning. Removing RTLD versions of some functions. +// +// Revision 1.12 2004/10/17 21:00:16 mthoma +// cleaning +// +// Revision 1.11 2004/08/01 11:40:23 marquardt +// move constructors/destructors +// +// Revision 1.10 2004/07/28 18:00:54 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.9 2004/07/26 03:47:36 rrossmair +// replaced SetCriticalSectionSpinCount by RtdlSetCriticalSectionSpinCount to make it Win95 compatible +// +// Revision 1.8 2004/06/02 03:23:47 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.7 2004/05/09 10:13:38 ahuser +// Better Delphi 7.1 fix that does not throw hints for older versions +// +// Revision 1.6 2004/05/07 19:29:09 ahuser +// Fix for Delphi 7.1 compiler warning bug. +// +// Revision 1.5 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.4 2004/04/06 04:55:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclTD32.pas b/official/1.96/source/windows/JclTD32.pas new file mode 100644 index 0000000..563f37a --- /dev/null +++ b/official/1.96/source/windows/JclTD32.pas @@ -0,0 +1,1686 @@ +{**************************************************************************************************} +{ } +{ 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 JclTD32.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) } +{ Olivier Sannier (obones) } +{ Petr Vones (pvones) } +{ Heinz Zastrau (heinzz) } +{ Andreas Hausladen (ahuser) } +{ } +{**************************************************************************************************} +{ } +{ Borland TD32 symbolic debugging information support routines and classes. } +{ } +{ Unit owner: Flier Lu } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2006/01/15 19:11:42 $ +// For history see end of file + +unit JclTD32; + +interface + +{$I jcl.inc} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, SysUtils, Contnrs, + JclBase, JclFileUtils, JclPeImage; + +{ TODO -cDOC : Original code: "Flier Lu" } + +// TD32 constants and structures +{******************************************************************************* + + [-----------------------------------------------------------------------] + [ Symbol and Type OMF Format Borland Executable Files ] + [-----------------------------------------------------------------------] + + Introduction + + This section describes the format used to embed debugging information into + the executable file. + + Debug Information Format + + The format encompasses a block of data which goes at the end of the .EXE + file, i.e., after the header plus load image, overlays, and + Windows/Presentation Manager resource compiler information. The lower + portion of the file is unaffected by the additional data. + + The last eight bytes of the file contain a signature and a long file offset + from the end of the file (lfoBase). The signature is FBxx, where xx is the + version number. The long offset indicates the position in the file + (relative to the end of the file) of the base address. For the LX format + executables, the base address is determined by looking at the executable + header. + + The signatures have the following meanings: + + FB09 The signature for a Borland 32 bit symbol file. + + The value + + lfaBase=length of the file - lfoBase + + gives the base address of the start of the Symbol and Type OMF information + relative to the beginning of the file. All other file offsets in the + Symbol and Type OMF are relative to the lfaBase. At the base address the + signature is repeated, followed by the long displacement to the subsection + directory (lfoDir). All subsections start on a long word boundary and are + designed to maintain natural alignment internally in each subsection and + within the subsection directory. + + Subsection Directory + + The subsection directory has the format + + Directory header + + Directory entry 0 + + Directory entry 1 + + . + . + . + + Directory entry n + + There is no requirement for a particular subsection of a particular module to exist. + + The following is the layout of the FB09 debug information in the image: + + FB09 Header + + sstModule [1] + . + . + . + sstModule [n] + + sstAlignSym [1] + sstSrcModule [1] + . + . + . + sstAlignSym [n] + sstSrcModule [n] + + sstGlobalSym + sstGlobalTypes + sstNames + + SubSection Directory + + FB09 Trailer + +*******************************************************************************} + +const + Borland32BitSymbolFileSignatureForDelphi = $39304246; // 'FB09' + Borland32BitSymbolFileSignatureForBCB = $41304246; // 'FB0A' + +type + { Signature structure } + PJclTD32FileSignature = ^TJclTD32FileSignature; + TJclTD32FileSignature = packed record + Signature: DWORD; + Offset: DWORD; + end; + +const + { Subsection Types } + SUBSECTION_TYPE_MODULE = $120; + SUBSECTION_TYPE_TYPES = $121; + SUBSECTION_TYPE_SYMBOLS = $124; + SUBSECTION_TYPE_ALIGN_SYMBOLS = $125; + SUBSECTION_TYPE_SOURCE_MODULE = $127; + SUBSECTION_TYPE_GLOBAL_SYMBOLS = $129; + SUBSECTION_TYPE_GLOBAL_TYPES = $12B; + SUBSECTION_TYPE_NAMES = $130; + +type + { Subsection directory header structure } + { The directory header structure is followed by the directory entries + which specify the subsection type, module index, file offset, and size. + The subsection directory gives the location (LFO) and size of each subsection, + as well as its type and module number if applicable. } + PDirectoryEntry = ^TDirectoryEntry; + TDirectoryEntry = packed record + SubsectionType: Word; // Subdirectory type + ModuleIndex: Word; // Module index + Offset: DWORD; // Offset from the base offset lfoBase + Size: DWORD; // Number of bytes in subsection + end; + + { The subsection directory is prefixed with a directory header structure + indicating size and number of subsection directory entries that follow. } + PDirectoryHeader = ^TDirectoryHeader; + TDirectoryHeader = packed record + Size: Word; // Length of this structure + DirEntrySize: Word; // Length of each directory entry + DirEntryCount: DWORD; // Number of directory entries + lfoNextDir: DWORD; // Offset from lfoBase of next directory. + Flags: DWORD; // Flags describing directory and subsection tables. + DirEntries: array [0..0] of TDirectoryEntry; + end; + + +{******************************************************************************* + + SUBSECTION_TYPE_MODULE $120 + + This describes the basic information about an object module including code + segments, module name, and the number of segments for the modules that + follow. Directory entries for sstModules precede all other subsection + directory entries. + +*******************************************************************************} + +type + PSegmentInfo = ^TSegmentInfo; + TSegmentInfo = packed record + Segment: Word; // Segment that this structure describes + Flags: Word; // Attributes for the logical segment. + // The following attributes are defined: + // $0000 Data segment + // $0001 Code segment + Offset: DWORD; // Offset in segment where the code starts + Size: DWORD; // Count of the number of bytes of code in the segment + end; + PSegmentInfoArray = ^TSegmentInfoArray; + TSegmentInfoArray = array [0..32767] of TSegmentInfo; + + PModuleInfo = ^TModuleInfo; + TModuleInfo = packed record + OverlayNumber: Word; // Overlay number + LibraryIndex: Word; // Index into sstLibraries subsection + // if this module was linked from a library + SegmentCount: Word; // Count of the number of code segments + // this module contributes to + DebuggingStyle: Word; // Debugging style for this module. + NameIndex: DWORD; // Name index of module. + TimeStamp: DWORD; // Time stamp from the OBJ file. + Reserved: array [0..2] of DWORD; // Set to 0. + Segments: array [0..0] of TSegmentInfo; + // Detailed information about each segment + // that code is contributed to. + // This is an array of cSeg count segment + // information descriptor structures. + end; + +{******************************************************************************* + + SUBSECTION_TYPE_SOURCE_MODULE $0127 + + This table describes the source line number to addressing mapping + information for a module. The table permits the description of a module + containing multiple source files with each source file contributing code to + one or more code segments. The base addresses of the tables described + below are all relative to the beginning of the sstSrcModule table. + + + Module header + + Information for source file 1 + + Information for segment 1 + . + . + . + Information for segment n + + . + . + . + + Information for source file n + + Information for segment 1 + . + . + . + Information for segment n + +*******************************************************************************} +type + { The line number to address mapping information is contained in a table with + the following format: } + PLineMappingEntry = ^TLineMappingEntry; + TLineMappingEntry = packed record + SegmentIndex: Word; // Segment index for this table + PairCount: Word; // Count of the number of source line pairs to follow + Offsets: array [0..0] of DWORD; + // An array of 32-bit offsets for the offset + // within the code segment ofthe start of ine contained + // in the parallel array linenumber. + (* + { This is an array of 16-bit line numbers of the lines in the source file + that cause code to be emitted to the code segment. + This array is parallel to the offset array. + If cPair is not even, then a zero word is emitted to + maintain natural alignment in the sstSrcModule table. } + LineNumbers: array [0..PairCount - 1] of Word; + *) + end; + + TOffsetPair = packed record + StartOffset: DWORD; + EndOffset: DWORD; + end; + POffsetPairArray = ^TOffsetPairArray; + TOffsetPairArray = array [0..32767] of TOffsetPair; + + { The file table describes the code segments that receive code from this + source file. Source file entries have the following format: } + PSourceFileEntry = ^TSourceFileEntry; + TSourceFileEntry = packed record + SegmentCount: Word; // Number of segments that receive code from this source file. + NameIndex: DWORD; // Name index of Source file name. + + BaseSrcLines: array [0..0] of DWORD; + // An array of offsets for the line/address mapping + // tables for each of the segments that receive code + // from this source file. + (* + { An array of two 32-bit offsets per segment that + receives code from this module. The first offset + is the offset within the segment of the first byte + of code from this module. The second offset is the + ending address of the code from this module. The + order of these pairs corresponds to the ordering of + the segments in the seg array. Zeros in these + entries means that the information is not known and + the file and line tables described below need to be + examined to determine if an address of interest is + contained within the code from this module. } + SegmentAddress: array [0..SegmentCount - 1] of TOffsetPair; + + Name: ShortString; // Count of the number of bytes in source file name + *) + end; + + { The module header structure describes the source file and code segment + organization of the module. Each module header has the following format: } + PSourceModuleInfo = ^TSourceModuleInfo; + TSourceModuleInfo = packed record + FileCount: Word; // The number of source file scontributing code to segments + SegmentCount: Word; // The number of code segments receiving code from this module + + BaseSrcFiles: array [0..0] of DWORD; + (* + // This is an array of base offsets from the beginning of the sstSrcModule table + BaseSrcFiles: array [0..FileCount - 1] of DWORD; + + { An array of two 32-bit offsets per segment that + receives code from this module. The first offset + is the offset within the segment of the first byte + of code from this module. The second offset is the + ending address of the code from this module. The + order of these pairs corresponds to the ordering of + the segments in the seg array. Zeros in these + entries means that the information is not known and + the file and line tables described below need to be + examined to determine if an address of interest is + contained within the code from this module. } + SegmentAddress: array [0..SegmentCount - 1] of TOffsetPair; + + { An array of segment indices that receive code from + this module. If the number of segments is not + even, a pad word is inserted to maintain natural + alignment. } + SegmentIndexes: array [0..SegmentCount - 1] of Word; + *) + end; + +{******************************************************************************* + + SUBSECTION_TYPE_GLOBAL_TYPES $12b + + This subsection contains the packed type records for the executable file. + The first long word of the subsection contains the number of types in the + table. This count is followed by a count-sized array of long offsets to + the corresponding type record. As the sstGlobalTypes subsection is + written, each type record is forced to start on a long word boundary. + However, the length of the type string is NOT adjusted by the pad count. + The remainder of the subsection contains the type records. + +*******************************************************************************} + +type + PGlobalTypeInfo = ^TGlobalTypeInfo; + TGlobalTypeInfo = packed record + Count: DWORD; // count of the number of types + // offset of each type string from the beginning of table + Offsets: array [0..0] of DWORD; + end; + +const + { Symbol type defines } + SYMBOL_TYPE_COMPILE = $0001; // Compile flags symbol + SYMBOL_TYPE_REGISTER = $0002; // Register variable + SYMBOL_TYPE_CONST = $0003; // Constant symbol + SYMBOL_TYPE_UDT = $0004; // User-defined Type + SYMBOL_TYPE_SSEARCH = $0005; // Start search + SYMBOL_TYPE_END = $0006; // End block, procedure, with, or thunk + SYMBOL_TYPE_SKIP = $0007; // Skip - Reserve symbol space + SYMBOL_TYPE_CVRESERVE = $0008; // Reserved for Code View internal use + SYMBOL_TYPE_OBJNAME = $0009; // Specify name of object file + + SYMBOL_TYPE_BPREL16 = $0100; // BP relative 16:16 + SYMBOL_TYPE_LDATA16 = $0101; // Local data 16:16 + SYMBOL_TYPE_GDATA16 = $0102; // Global data 16:16 + SYMBOL_TYPE_PUB16 = $0103; // Public symbol 16:16 + SYMBOL_TYPE_LPROC16 = $0104; // Local procedure start 16:16 + SYMBOL_TYPE_GPROC16 = $0105; // Global procedure start 16:16 + SYMBOL_TYPE_THUNK16 = $0106; // Thunk start 16:16 + SYMBOL_TYPE_BLOCK16 = $0107; // Block start 16:16 + SYMBOL_TYPE_WITH16 = $0108; // With start 16:16 + SYMBOL_TYPE_LABEL16 = $0109; // Code label 16:16 + SYMBOL_TYPE_CEXMODEL16 = $010A; // Change execution model 16:16 + SYMBOL_TYPE_VFTPATH16 = $010B; // Virtual function table path descriptor 16:16 + + SYMBOL_TYPE_BPREL32 = $0200; // BP relative 16:32 + SYMBOL_TYPE_LDATA32 = $0201; // Local data 16:32 + SYMBOL_TYPE_GDATA32 = $0202; // Global data 16:32 + SYMBOL_TYPE_PUB32 = $0203; // Public symbol 16:32 + SYMBOL_TYPE_LPROC32 = $0204; // Local procedure start 16:32 + SYMBOL_TYPE_GPROC32 = $0205; // Global procedure start 16:32 + SYMBOL_TYPE_THUNK32 = $0206; // Thunk start 16:32 + SYMBOL_TYPE_BLOCK32 = $0207; // Block start 16:32 + SYMBOL_TYPE_WITH32 = $0208; // With start 16:32 + SYMBOL_TYPE_LABEL32 = $0209; // Label 16:32 + SYMBOL_TYPE_CEXMODEL32 = $020A; // Change execution model 16:32 + SYMBOL_TYPE_VFTPATH32 = $020B; // Virtual function table path descriptor 16:32 + +{******************************************************************************* + + Global and Local Procedure Start 16:32 + + SYMBOL_TYPE_LPROC32 $0204 + SYMBOL_TYPE_GPROC32 $0205 + + The symbol records define local (file static) and global procedure + definition. For C/C++, functions that are declared static to a module are + emitted as Local Procedure symbols. Functions not specifically declared + static are emitted as Global Procedures. + For each SYMBOL_TYPE_GPROC32 emitted, an SYMBOL_TYPE_GPROCREF symbol + must be fabricated and emitted to the SUBSECTION_TYPE_GLOBAL_SYMBOLS section. + +*******************************************************************************} + +type + TSymbolProcInfo = packed record + pParent: DWORD; + pEnd: DWORD; + pNext: DWORD; + Size: DWORD; // Length in bytes of this procedure + DebugStart: DWORD; // Offset in bytes from the start of the procedure to + // the point where the stack frame has been set up. + DebugEnd: DWORD; // Offset in bytes from the start of the procedure to + // the point where the procedure is ready to return + // and has calculated its return value, if any. + // Frame and register variables an still be viewed. + Offset: DWORD; // Offset portion of the segmented address of + // the start of the procedure in the code segment + Segment: Word; // Segment portion of the segmented address of + // the start of the procedure in the code segment + ProcType: DWORD; // Type of the procedure type record + NearFar: Byte; // Type of return the procedure makes: + // 0 near + // 4 far + Reserved: Byte; + NameIndex: DWORD; // Name index of procedure + end; + + TSymbolObjNameInfo = packed record + Signature: DWORD; // Signature for the CodeView information contained in + // this module + NameIndex: DWORD; // Name index of the object file + end; + + TSymbolDataInfo = packed record + Offset: DWORD; // Offset portion of the segmented address of + // the start of the data in the code segment + Segment: Word; // Segment portion of the segmented address of + // the start of the data in the code segment + Reserved: Word; + TypeIndex: DWORD; // Type index of the symbol + NameIndex: DWORD; // Name index of the symbol + end; + + TSymbolWithInfo = packed record + pParent: DWORD; + pEnd: DWORD; + Size: DWORD; // Length in bytes of this "with" + Offset: DWORD; // Offset portion of the segmented address of + // the start of the "with" in the code segment + Segment: Word; // Segment portion of the segmented address of + // the start of the "with" in the code segment + Reserved: Word; + NameIndex: DWORD; // Name index of the "with" + end; + + TSymbolLabelInfo = packed record + Offset: DWORD; // Offset portion of the segmented address of + // the start of the label in the code segment + Segment: Word; // Segment portion of the segmented address of + // the start of the label in the code segment + NearFar: Byte; // Address mode of the label: + // 0 near + // 4 far + Reserved: Byte; + NameIndex: DWORD; // Name index of the label + end; + + TSymbolConstantInfo = packed record + TypeIndex: DWORD; // Type index of the constant (for enums) + NameIndex: DWORD; // Name index of the constant + Reserved: DWORD; + Value: DWORD; // value of the constant + end; + + TSymbolUdtInfo = packed record + TypeIndex: DWORD; // Type index of the type + Properties: Word; // isTag:1 True if this is a tag (not a typedef) + // isNest:1 True if the type is a nested type (its name + // will be 'class_name::type_name' in that case) + NameIndex: DWORD; // Name index of the type + Reserved: DWORD; + end; + + TSymbolVftPathInfo = packed record + Offset: DWORD; // Offset portion of start of the virtual function table + Segment: Word; // Segment portion of the virtual function table + Reserved: Word; + RootIndex: DWORD; // The type index of the class at the root of the path + PathIndex: DWORD; // Type index of the record describing the base class + // path from the root to the leaf class for the virtual + // function table + end; + +type + { Symbol Information Records } + PSymbolInfo = ^TSymbolInfo; + TSymbolInfo = packed record + Size: Word; + SymbolType: Word; + case Word of + SYMBOL_TYPE_LPROC32, SYMBOL_TYPE_GPROC32: + (Proc: TSymbolProcInfo); + SYMBOL_TYPE_OBJNAME: + (ObjName: TSymbolObjNameInfo); + SYMBOL_TYPE_LDATA32, SYMBOL_TYPE_GDATA32, SYMBOL_TYPE_PUB32: + (Data: TSymbolDataInfo); + SYMBOL_TYPE_WITH32: + (With32: TSymbolWithInfo); + SYMBOL_TYPE_LABEL32: + (Label32: TSymbolLabelInfo); + SYMBOL_TYPE_CONST: + (Constant: TSymbolConstantInfo); + SYMBOL_TYPE_UDT: + (Udt: TSymbolUdtInfo); + SYMBOL_TYPE_VFTPATH32: + (VftPath: TSymbolVftPathInfo); + end; + + PSymbolInfos = ^TSymbolInfos; + TSymbolInfos = packed record + Signature: DWORD; + Symbols: array [0..0] of TSymbolInfo; + end; + +{$IFDEF SUPPORTS_EXTSYM} + +{$EXTERNALSYM Borland32BitSymbolFileSignatureForDelphi} +{$EXTERNALSYM Borland32BitSymbolFileSignatureForBCB} + +{$EXTERNALSYM SUBSECTION_TYPE_MODULE} +{$EXTERNALSYM SUBSECTION_TYPE_TYPES} +{$EXTERNALSYM SUBSECTION_TYPE_SYMBOLS} +{$EXTERNALSYM SUBSECTION_TYPE_ALIGN_SYMBOLS} +{$EXTERNALSYM SUBSECTION_TYPE_SOURCE_MODULE} +{$EXTERNALSYM SUBSECTION_TYPE_GLOBAL_SYMBOLS} +{$EXTERNALSYM SUBSECTION_TYPE_GLOBAL_TYPES} +{$EXTERNALSYM SUBSECTION_TYPE_NAMES} + +{$EXTERNALSYM SYMBOL_TYPE_COMPILE} +{$EXTERNALSYM SYMBOL_TYPE_REGISTER} +{$EXTERNALSYM SYMBOL_TYPE_CONST} +{$EXTERNALSYM SYMBOL_TYPE_UDT} +{$EXTERNALSYM SYMBOL_TYPE_SSEARCH} +{$EXTERNALSYM SYMBOL_TYPE_END} +{$EXTERNALSYM SYMBOL_TYPE_SKIP} +{$EXTERNALSYM SYMBOL_TYPE_CVRESERVE} +{$EXTERNALSYM SYMBOL_TYPE_OBJNAME} + +{$EXTERNALSYM SYMBOL_TYPE_BPREL16} +{$EXTERNALSYM SYMBOL_TYPE_LDATA16} +{$EXTERNALSYM SYMBOL_TYPE_GDATA16} +{$EXTERNALSYM SYMBOL_TYPE_PUB16} +{$EXTERNALSYM SYMBOL_TYPE_LPROC16} +{$EXTERNALSYM SYMBOL_TYPE_GPROC16} +{$EXTERNALSYM SYMBOL_TYPE_THUNK16} +{$EXTERNALSYM SYMBOL_TYPE_BLOCK16} +{$EXTERNALSYM SYMBOL_TYPE_WITH16} +{$EXTERNALSYM SYMBOL_TYPE_LABEL16} +{$EXTERNALSYM SYMBOL_TYPE_CEXMODEL16} +{$EXTERNALSYM SYMBOL_TYPE_VFTPATH16} + +{$EXTERNALSYM SYMBOL_TYPE_BPREL32} +{$EXTERNALSYM SYMBOL_TYPE_LDATA32} +{$EXTERNALSYM SYMBOL_TYPE_GDATA32} +{$EXTERNALSYM SYMBOL_TYPE_PUB32} +{$EXTERNALSYM SYMBOL_TYPE_LPROC32} +{$EXTERNALSYM SYMBOL_TYPE_GPROC32} +{$EXTERNALSYM SYMBOL_TYPE_THUNK32} +{$EXTERNALSYM SYMBOL_TYPE_BLOCK32} +{$EXTERNALSYM SYMBOL_TYPE_WITH32} +{$EXTERNALSYM SYMBOL_TYPE_LABEL32} +{$EXTERNALSYM SYMBOL_TYPE_CEXMODEL32} +{$EXTERNALSYM SYMBOL_TYPE_VFTPATH32} + +{$ENDIF SUPPORTS_EXTSYM} + +// TD32 information related classes +type + TJclModuleInfo = class(TObject) + private + FNameIndex: DWORD; + FSegments: PSegmentInfoArray; + FSegmentCount: Integer; + function GetSegment(const Idx: Integer): TSegmentInfo; + protected + constructor Create(pModInfo: PModuleInfo); + public + property NameIndex: DWORD read FNameIndex; + property SegmentCount: Integer read FSegmentCount; //GetSegmentCount; + property Segment[const Idx: Integer]: TSegmentInfo read GetSegment; default; + end; + + TJclLineInfo = class(TObject) + private + FLineNo: DWORD; + FOffset: DWORD; + protected + constructor Create(ALineNo, AOffset: DWORD); + public + property LineNo: DWORD read FLineNo; + property Offset: DWORD read FOffset; + end; + + TJclSourceModuleInfo = class(TObject) + private + FLines: TObjectList; + FSegments: POffsetPairArray; + FSegmentCount: Integer; + FNameIndex: DWORD; + function GetLine(const Idx: Integer): TJclLineInfo; + function GetLineCount: Integer; + function GetSegment(const Idx: Integer): TOffsetPair; + protected + constructor Create(pSrcFile: PSourceFileEntry; Base: DWORD); + public + destructor Destroy; override; + function FindLine(const AAddr: DWORD; var ALine: TJclLineInfo): Boolean; + property NameIndex: DWORD read FNameIndex; + property LineCount: Integer read GetLineCount; + property Line[const Idx: Integer]: TJclLineInfo read GetLine; default; + property SegmentCount: Integer read FSegmentCount; //GetSegmentCount; + property Segment[const Idx: Integer]: TOffsetPair read GetSegment; + end; + + TJclSymbolInfo = class(TObject) + private + FSymbolType: Word; + protected + constructor Create(pSymInfo: PSymbolInfo); virtual; + property SymbolType: Word read FSymbolType; + end; + + TJclProcSymbolInfo = class(TJclSymbolInfo) + private + FNameIndex: DWORD; + FOffset: DWORD; + FSize: DWORD; + protected + constructor Create(pSymInfo: PSymbolInfo); override; + public + property NameIndex: DWORD read FNameIndex; + property Offset: DWORD read FOffset; + property Size: DWORD read FSize; + end; + + TJclLocalProcSymbolInfo = class(TJclProcSymbolInfo); + TJclGlobalProcSymbolInfo = class(TJclProcSymbolInfo); + + { not used by Delphi } + TJclObjNameSymbolInfo = class(TJclSymbolInfo) + private + FSignature: DWORD; + FNameIndex: DWORD; + protected + constructor Create(pSymInfo: PSymbolInfo); override; + public + property NameIndex: DWORD read FNameIndex; + property Signature: DWORD read FSignature; + end; + + TJclDataSymbolInfo = class(TJclSymbolInfo) + private + FOffset: DWORD; + FTypeIndex: DWORD; + FNameIndex: DWORD; + protected + constructor Create(pSymInfo: PSymbolInfo); override; + public + property NameIndex: DWORD read FNameIndex; + property TypeIndex: DWORD read FTypeIndex; + property Offset: DWORD read FOffset; + end; + + TJclLDataSymbolInfo = class(TJclDataSymbolInfo); + TJclGDataSymbolInfo = class(TJclDataSymbolInfo); + TJclPublicSymbolInfo = class(TJclDataSymbolInfo); + + TJclWithSymbolInfo = class(TJclSymbolInfo) + private + FOffset: DWORD; + FSize: DWORD; + FNameIndex: DWORD; + protected + constructor Create(pSymInfo: PSymbolInfo); override; + public + property NameIndex: DWORD read FNameIndex; + property Offset: DWORD read FOffset; + property Size: DWORD read FSize; + end; + + { not used by Delphi } + TJclLabelSymbolInfo = class(TJclSymbolInfo) + private + FOffset: DWORD; + FNameIndex: DWORD; + protected + constructor Create(pSymInfo: PSymbolInfo); override; + public + property NameIndex: DWORD read FNameIndex; + property Offset: DWORD read FOffset; + end; + + { not used by Delphi } + TJclConstantSymbolInfo = class(TJclSymbolInfo) + private + FValue: DWORD; + FTypeIndex: DWORD; + FNameIndex: DWORD; + protected + constructor Create(pSymInfo: PSymbolInfo); override; + public + property NameIndex: DWORD read FNameIndex; + property TypeIndex: DWORD read FTypeIndex; // for enums + property Value: DWORD read FValue; + end; + + TJclUdtSymbolInfo = class(TJclSymbolInfo) + private + FTypeIndex: DWORD; + FNameIndex: DWORD; + FProperties: Word; + protected + constructor Create(pSymInfo: PSymbolInfo); override; + public + property NameIndex: DWORD read FNameIndex; + property TypeIndex: DWORD read FTypeIndex; + property Properties: Word read FProperties; + end; + + { not used by Delphi } + TJclVftPathSymbolInfo = class(TJclSymbolInfo) + private + FRootIndex: DWORD; + FPathIndex: DWORD; + FOffset: DWORD; + protected + constructor Create(pSymInfo: PSymbolInfo); override; + public + property RootIndex: DWORD read FRootIndex; + property PathIndex: DWORD read FPathIndex; + property Offset: DWORD read FOffset; + end; + + // TD32 parser + TJclTD32InfoParser = class(TObject) + private + FBase: Pointer; + FData: TCustomMemoryStream; + FNames: TList; + FModules: TObjectList; + FSourceModules: TObjectList; + FSymbols: TObjectList; + FValidData: Boolean; + function GetName(const Idx: Integer): string; + function GetNameCount: Integer; + function GetSymbol(const Idx: Integer): TJclSymbolInfo; + function GetSymbolCount: Integer; + function GetModule(const Idx: Integer): TJclModuleInfo; + function GetModuleCount: Integer; + function GetSourceModule(const Idx: Integer): TJclSourceModuleInfo; + function GetSourceModuleCount: Integer; + protected + procedure Analyse; + procedure AnalyseNames(const pSubsection: Pointer; const Size: DWORD); virtual; + procedure AnalyseGlobalTypes(const pTypes: Pointer; const Size: DWORD); virtual; + procedure AnalyseAlignSymbols(pSymbols: PSymbolInfos; const Size: DWORD); virtual; + procedure AnalyseModules(pModInfo: PModuleInfo; const Size: DWORD); virtual; + procedure AnalyseSourceModules(pSrcModInfo: PSourceModuleInfo; const Size: DWORD); virtual; + procedure AnalyseUnknownSubSection(const pSubsection: Pointer; const Size: DWORD); virtual; + function LfaToVa(Lfa: DWORD): Pointer; + public + constructor Create(const ATD32Data: TCustomMemoryStream); // Data mustn't be freed before the class is destroyed + destructor Destroy; override; + function FindModule(const AAddr: DWORD; var AMod: TJclModuleInfo): Boolean; + function FindSourceModule(const AAddr: DWORD; var ASrcMod: TJclSourceModuleInfo): Boolean; + function FindProc(const AAddr: DWORD; var AProc: TJclProcSymbolInfo): Boolean; + class function IsTD32Sign(const Sign: TJclTD32FileSignature): Boolean; + class function IsTD32DebugInfoValid(const DebugData: Pointer; const DebugDataSize: LongWord): Boolean; + property Data: TCustomMemoryStream read FData; + property Names[const Idx: Integer]: string read GetName; + property NameCount: Integer read GetNameCount; + property Symbols[const Idx: Integer]: TJclSymbolInfo read GetSymbol; + property SymbolCount: Integer read GetSymbolCount; + property Modules[const Idx: Integer]: TJclModuleInfo read GetModule; + property ModuleCount: Integer read GetModuleCount; + property SourceModules[const Idx: Integer]: TJclSourceModuleInfo read GetSourceModule; + property SourceModuleCount: Integer read GetSourceModuleCount; + property ValidData: Boolean read FValidData; + end; + + // TD32 scanner with source location methods + TJclTD32InfoScanner = class(TJclTD32InfoParser) + public + function LineNumberFromAddr(AAddr: DWORD; var Offset: Integer): Integer; overload; + function LineNumberFromAddr(AAddr: DWORD): Integer; overload; + function ProcNameFromAddr(AAddr: DWORD): string; overload; + function ProcNameFromAddr(AAddr: DWORD; var Offset: Integer): string; overload; + function ModuleNameFromAddr(AAddr: DWORD): string; + function SourceNameFromAddr(AAddr: DWORD): string; + end; + + // PE Image with TD32 information and source location support + TJclPeBorTD32Image = class(TJclPeBorImage) + private + FIsTD32DebugPresent: Boolean; + FTD32DebugData: TCustomMemoryStream; + FTD32Scanner: TJclTD32InfoScanner; + protected + procedure AfterOpen; override; + procedure Clear; override; + procedure ClearDebugData; + procedure CheckDebugData; + function IsDebugInfoInImage(var DataStream: TCustomMemoryStream): Boolean; + function IsDebugInfoInTds(var DataStream: TCustomMemoryStream): Boolean; + public + property IsTD32DebugPresent: Boolean read FIsTD32DebugPresent; + property TD32DebugData: TCustomMemoryStream read FTD32DebugData; + property TD32Scanner: TJclTD32InfoScanner read FTD32Scanner; + end; + +implementation + +uses + JclResources, JclSysUtils; + +const + TurboDebuggerSymbolExt = '.tds'; + +//=== { TJclModuleInfo } ===================================================== + +constructor TJclModuleInfo.Create(pModInfo: PModuleInfo); +begin + Assert(Assigned(pModInfo)); + inherited Create; + FNameIndex := pModInfo.NameIndex; + FSegments := @pModInfo.Segments[0]; + FSegmentCount := pModInfo.SegmentCount; +end; + +function TJclModuleInfo.GetSegment(const Idx: Integer): TSegmentInfo; +begin + Assert((0 <= Idx) and (Idx < FSegmentCount)); + Result := FSegments[Idx]; +end; + +//=== { TJclLineInfo } ======================================================= + +constructor TJclLineInfo.Create(ALineNo, AOffset: DWORD); +begin + inherited Create; + FLineNo := ALineNo; + FOffset := AOffset; +end; + +//=== { TJclSourceModuleInfo } =============================================== + +constructor TJclSourceModuleInfo.Create(pSrcFile: PSourceFileEntry; Base: DWORD); +type + PArrayOfWord = ^TArrayOfWord; + TArrayOfWord = array [0..0] of Word; +var + I, J: Integer; + pLineEntry: PLineMappingEntry; +begin + Assert(Assigned(pSrcFile)); + inherited Create; + FNameIndex := pSrcFile.NameIndex; + FLines := TObjectList.Create; + {$RANGECHECKS OFF} + for I := 0 to pSrcFile.SegmentCount - 1 do + begin + pLineEntry := PLineMappingEntry(Base + pSrcFile.BaseSrcLines[I]); + for J := 0 to pLineEntry.PairCount - 1 do + FLines.Add(TJclLineInfo.Create( + PArrayOfWord(@pLineEntry.Offsets[pLineEntry.PairCount])^[J], + pLineEntry.Offsets[J])); + end; + + FSegments := @pSrcFile.BaseSrcLines[pSrcFile.SegmentCount]; + FSegmentCount := pSrcFile.SegmentCount; + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} +end; + +destructor TJclSourceModuleInfo.Destroy; +begin + FreeAndNil(FLines); + inherited Destroy; +end; + +function TJclSourceModuleInfo.GetLine(const Idx: Integer): TJclLineInfo; +begin + Result := TJclLineInfo(FLines.Items[Idx]); +end; + +function TJclSourceModuleInfo.GetLineCount: Integer; +begin + Result := FLines.Count; +end; + +function TJclSourceModuleInfo.GetSegment(const Idx: Integer): TOffsetPair; +begin + Assert((0 <= Idx) and (Idx < FSegmentCount)); + Result := FSegments[Idx]; +end; + +function TJclSourceModuleInfo.FindLine(const AAddr: DWORD; var ALine: TJclLineInfo): Boolean; +var + I: Integer; +begin + for I := 0 to LineCount - 1 do + with Line[I] do + begin + if AAddr = Offset then + begin + Result := True; + ALine := Line[I]; + Exit; + end + else + if (I > 1) and (Line[I - 1].Offset < AAddr) and (AAddr < Offset) then + begin + Result := True; + ALine := Line[I-1]; + Exit; + end; + end; + Result := False; + ALine := nil; +end; + +//=== { TJclSymbolInfo } ===================================================== + +constructor TJclSymbolInfo.Create(pSymInfo: PSymbolInfo); +begin + Assert(Assigned(pSymInfo)); + inherited Create; + FSymbolType := pSymInfo.SymbolType; +end; + +//=== { TJclProcSymbolInfo } ================================================= + +constructor TJclProcSymbolInfo.Create(pSymInfo: PSymbolInfo); +begin + Assert(Assigned(pSymInfo)); + inherited Create(pSymInfo); + with pSymInfo^ do + begin + FNameIndex := Proc.NameIndex; + FOffset := Proc.Offset; + FSize := Proc.Size; + end; +end; + +//=== { TJclObjNameSymbolInfo } ============================================== + +constructor TJclObjNameSymbolInfo.Create(pSymInfo: PSymbolInfo); +begin + Assert(Assigned(pSymInfo)); + inherited Create(pSymInfo); + with pSymInfo^ do + begin + FNameIndex := ObjName.NameIndex; + FSignature := ObjName.Signature; + end; +end; + +//=== { TJclDataSymbolInfo } ================================================= + +constructor TJclDataSymbolInfo.Create(pSymInfo: PSymbolInfo); +begin + Assert(Assigned(pSymInfo)); + inherited Create(pSymInfo); + with pSymInfo^ do + begin + FTypeIndex := Data.TypeIndex; + FNameIndex := Data.NameIndex; + FOffset := Data.Offset; + end; +end; + +//=== { TJclWithSymbolInfo } ================================================= + +constructor TJclWithSymbolInfo.Create(pSymInfo: PSymbolInfo); +begin + Assert(Assigned(pSymInfo)); + inherited Create(pSymInfo); + with pSymInfo^ do + begin + FNameIndex := With32.NameIndex; + FOffset := With32.Offset; + FSize := With32.Size; + end; +end; + +//=== { TJclLabelSymbolInfo } ================================================ + +constructor TJclLabelSymbolInfo.Create(pSymInfo: PSymbolInfo); +begin + Assert(Assigned(pSymInfo)); + inherited Create(pSymInfo); + with pSymInfo^ do + begin + FNameIndex := Label32.NameIndex; + FOffset := Label32.Offset; + end; +end; + +//=== { TJclConstantSymbolInfo } ============================================= + +constructor TJclConstantSymbolInfo.Create(pSymInfo: PSymbolInfo); +begin + Assert(Assigned(pSymInfo)); + inherited Create(pSymInfo); + with pSymInfo^ do + begin + FNameIndex := Constant.NameIndex; + FTypeIndex := Constant.TypeIndex; + FValue := Constant.Value; + end; +end; + +//=== { TJclUdtSymbolInfo } ================================================== + +constructor TJclUdtSymbolInfo.Create(pSymInfo: PSymbolInfo); +begin + Assert(Assigned(pSymInfo)); + inherited Create(pSymInfo); + with pSymInfo^ do + begin + FNameIndex := Udt.NameIndex; + FTypeIndex := Udt.TypeIndex; + FProperties := Udt.Properties; + end; +end; + +//=== { TJclVftPathSymbolInfo } ============================================== + +constructor TJclVftPathSymbolInfo.Create(pSymInfo: PSymbolInfo); +begin + Assert(Assigned(pSymInfo)); + inherited Create(pSymInfo); + with pSymInfo^ do + begin + FRootIndex := VftPath.RootIndex; + FPathIndex := VftPath.PathIndex; + FOffset := VftPath.Offset; + end; +end; + +//=== { TJclTD32InfoParser } ================================================= + +constructor TJclTD32InfoParser.Create(const ATD32Data: TCustomMemoryStream); +begin + Assert(Assigned(ATD32Data)); + inherited Create; + FNames := TList.Create; + FModules := TObjectList.Create; + FSourceModules := TObjectList.Create; + FSymbols := TObjectList.Create; + FNames.Add(nil); + FData := ATD32Data; + FBase := FData.Memory; + FValidData := IsTD32DebugInfoValid(FBase, FData.Size); + if FValidData then + Analyse; +end; + +destructor TJclTD32InfoParser.Destroy; +begin + FreeAndNil(FSymbols); + FreeAndNil(FSourceModules); + FreeAndNil(FModules); + FreeAndNil(FNames); + inherited Destroy; +end; + +procedure TJclTD32InfoParser.Analyse; +var + I: Integer; + pDirHeader: PDirectoryHeader; + pSubsection: Pointer; +begin + pDirHeader := PDirectoryHeader(LfaToVa(PJclTD32FileSignature(LfaToVa(0)).Offset)); + while True do + begin + Assert(pDirHeader.DirEntrySize = SizeOf(TDirectoryEntry)); + {$RANGECHECKS OFF} + for I := 0 to pDirHeader.DirEntryCount - 1 do + with pDirHeader.DirEntries[I] do + begin + pSubsection := LfaToVa(Offset); + case SubsectionType of + SUBSECTION_TYPE_MODULE: + AnalyseModules(pSubsection, Size); + SUBSECTION_TYPE_ALIGN_SYMBOLS: + AnalyseAlignSymbols(pSubsection, Size); + SUBSECTION_TYPE_SOURCE_MODULE: + AnalyseSourceModules(pSubsection, Size); + SUBSECTION_TYPE_NAMES: + AnalyseNames(pSubsection, Size); + SUBSECTION_TYPE_GLOBAL_TYPES: + AnalyseGlobalTypes(pSubsection, Size); + else + AnalyseUnknownSubSection(pSubsection, Size); + end; + end; + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} + if pDirHeader.lfoNextDir <> 0 then + pDirHeader := PDirectoryHeader(LfaToVa(pDirHeader.lfoNextDir)) + else + Break; + end; +end; + +procedure TJclTD32InfoParser.AnalyseNames(const pSubsection: Pointer; const Size: DWORD); +var + I, Count, Len: Integer; + pszName: PChar; +begin + Count := PDWORD(pSubsection)^; + pszName := PChar(DWORD(pSubsection) + SizeOf(DWORD)); + for I := 0 to Count - 1 do + begin + // Get the length of the name + Len := Ord(pszName^); + Inc(pszName); + // Get the name + FNames.Add(pszName); + // skip the length of name and a NULL at the end + Inc(pszName, Len + 1); + end; +end; + +const + // Leaf indices for type records that can be referenced from symbols + LF_MODIFIER = $0001; + LF_POINTER = $0002; + LF_ARRAY = $0003; + LF_CLASS = $0004; + LF_STRUCTURE = $0005; + LF_UNION = $0006; + LF_ENUM = $0007; + LF_PROCEDURE = $0008; + LF_MFUNCTION = $0009; + LF_VTSHAPE = $000a; + LF_COBOL0 = $000b; + LF_COBOL1 = $000c; + LF_BARRAY = $000d; + LF_LABEL = $000e; + LF_NULL = $000f; + LF_NOTTRAN = $0010; + LF_DIMARRAY = $0011; + LF_VFTPATH = $0012; + + // Leaf indices for type records that can be referenced from other type records + LF_SKIP = $0200; + LF_ARGLIST = $0201; + LF_DEFARG = $0202; + LF_LIST = $0203; + LF_FIELDLIST = $0204; + LF_DERIVED = $0205; + LF_BITFIELD = $0206; + LF_METHODLIST = $0207; + LF_DIMCONU = $0208; + LF_DIMCONLU = $0209; + LF_DIMVARU = $020a; + LF_DIMVARLU = $020b; + LF_REFSYM = $020c; + + // Leaf indices for fields of complex lists: + LF_BCLASS = $0400; + LF_VBCLASS = $0401; + LF_IVBCLASS = $0402; + LF_ENUMERATE = $0403; + LF_FRIENDFCN = $0404; + LF_INDEX = $0405; + LF_MEMBER = $0406; + LF_STMEMBER = $0407; + LF_METHOD = $0408; + LF_NESTTYPE = $0409; + LF_VFUNCTAB = $040a; + LF_FRIENDCLS = $040b; + + // Leaf indices for numeric fields of symbols and type records: + LF_NUMERIC = $8000; + LF_CHAR = $8001; + LF_SHORT = $8002; + LF_USHORT = $8003; + LF_LONG = $8004; + LF_ULONG = $8005; + LF_REAL32 = $8006; + LF_REAL64 = $8007; + LF_REAL80 = $8008; + LF_REAL128 = $8009; + LF_QUADWORD = $800a; + LF_UQUADWORD = $800b; + LF_REAL48 = $800c; + + LF_PAD0 = $f0; + LF_PAD1 = $f1; + LF_PAD2 = $f2; + LF_PAD3 = $f3; + LF_PAD4 = $f4; + LF_PAD5 = $f5; + LF_PAD6 = $f6; + LF_PAD7 = $f7; + LF_PAD8 = $f8; + LF_PAD9 = $f9; + LF_PAD10 = $fa; + LF_PAD11 = $fb; + LF_PAD12 = $fc; + LF_PAD13 = $fd; + LF_PAD14 = $fe; + LF_PAD15 = $ff; + +type + PSymbolTypeInfo = ^TSymbolTypeInfo; + TSymbolTypeInfo = packed record + TypeId: DWORD; + NameIndex: DWORD; // 0 if unnamed + Size: Word; // size in bytes of the object + MaxSize: Byte; + ParentIndex: DWORD; + end; + +const + TID_VOID = $00; // Unknown or no type + TID_LSTR = $01; // Basic Literal string + TID_DSTR = $02; // Basic Dynamic string + TID_PSTR = $03; // Pascal style string + +procedure TJclTD32InfoParser.AnalyseGlobalTypes(const pTypes: Pointer; const Size: DWORD); +var + pTyp: PSymbolTypeInfo; +begin + pTyp := PSymbolTypeInfo(pTypes); + repeat + case pTyp.TypeId of + TID_VOID: ; + end; + pTyp := PSymbolTypeInfo(DWORD(pTyp) + pTyp.Size + SizeOf(pTyp^)); + until DWORD(pTyp) >= DWORD(pTypes) + Size; +end; + +procedure TJclTD32InfoParser.AnalyseAlignSymbols(pSymbols: PSymbolInfos; const Size: DWORD); +var + Offset: DWORD; + pInfo: PSymbolInfo; + Symbol: TJclSymbolInfo; +begin + Offset := DWORD(@pSymbols.Symbols[0]) - DWORD(pSymbols); + while Offset < Size do + begin + pInfo := PSymbolInfo(DWORD(pSymbols) + Offset); + case pInfo.SymbolType of + SYMBOL_TYPE_LPROC32: + Symbol := TJclLocalProcSymbolInfo.Create(pInfo); + SYMBOL_TYPE_GPROC32: + Symbol := TJclGlobalProcSymbolInfo.Create(pInfo); + SYMBOL_TYPE_OBJNAME: + Symbol := TJclObjNameSymbolInfo.Create(pInfo); + SYMBOL_TYPE_LDATA32: + Symbol := TJclLDataSymbolInfo.Create(pInfo); + SYMBOL_TYPE_GDATA32: + Symbol := TJclGDataSymbolInfo.Create(pInfo); + SYMBOL_TYPE_PUB32: + Symbol := TJclPublicSymbolInfo.Create(pInfo); + SYMBOL_TYPE_WITH32: + Symbol := TJclWithSymbolInfo.Create(pInfo); + SYMBOL_TYPE_LABEL32: + Symbol := TJclLabelSymbolInfo.Create(pInfo); + SYMBOL_TYPE_CONST: + Symbol := TJclConstantSymbolInfo.Create(pInfo); + SYMBOL_TYPE_UDT: + Symbol := TJclUdtSymbolInfo.Create(pInfo); + SYMBOL_TYPE_VFTPATH32: + Symbol := TJclVftPathSymbolInfo.Create(pInfo); + else + Symbol := nil; + end; + if Assigned(Symbol) then + FSymbols.Add(Symbol); + Inc(Offset, pInfo.Size + SizeOf(pInfo.Size)); + end; +end; + +procedure TJclTD32InfoParser.AnalyseModules(pModInfo: PModuleInfo; const Size: DWORD); +begin + FModules.Add(TJclModuleInfo.Create(pModInfo)); +end; + +procedure TJclTD32InfoParser.AnalyseSourceModules(pSrcModInfo: PSourceModuleInfo; const Size: DWORD); +var + I: Integer; + pSrcFile: PSourceFileEntry; +begin + {$RANGECHECKS OFF} + for I := 0 to pSrcModInfo.FileCount - 1 do + begin + pSrcFile := PSourceFileEntry(DWORD(pSrcModInfo) + pSrcModInfo.BaseSrcFiles[I]); + if pSrcFile.NameIndex > 0 then + FSourceModules.Add(TJclSourceModuleInfo.Create(pSrcFile, DWORD(pSrcModInfo))); + end; + {$IFDEF RANGECHECKS_ON} + {$RANGECHECKS ON} + {$ENDIF RANGECHECKS_ON} +end; + +procedure TJclTD32InfoParser.AnalyseUnknownSubSection(const pSubsection: Pointer; const Size: DWORD); +begin + // do nothing +end; + +function TJclTD32InfoParser.GetModule(const Idx: Integer): TJclModuleInfo; +begin + Result := TJclModuleInfo(FModules.Items[Idx]); +end; + +function TJclTD32InfoParser.GetModuleCount: Integer; +begin + Result := FModules.Count; +end; + +function TJclTD32InfoParser.GetName(const Idx: Integer): string; +begin + Result := PChar(FNames.Items[Idx]); +end; + +function TJclTD32InfoParser.GetNameCount: Integer; +begin + Result := FNames.Count; +end; + +function TJclTD32InfoParser.GetSourceModule(const Idx: Integer): TJclSourceModuleInfo; +begin + Result := TJclSourceModuleInfo(FSourceModules.Items[Idx]); +end; + +function TJclTD32InfoParser.GetSourceModuleCount: Integer; +begin + Result := FSourceModules.Count; +end; + +function TJclTD32InfoParser.GetSymbol(const Idx: Integer): TJclSymbolInfo; +begin + Result := TJclSymbolInfo(FSymbols.Items[Idx]); +end; + +function TJclTD32InfoParser.GetSymbolCount: Integer; +begin + Result := FSymbols.Count; +end; + +function TJclTD32InfoParser.FindModule(const AAddr: DWORD; + var AMod: TJclModuleInfo): Boolean; +var + I, J: Integer; +begin + if ValidData then + for I := 0 to ModuleCount - 1 do + with Modules[I] do + for J := 0 to SegmentCount - 1 do + begin + if AAddr >= FSegments[J].Offset then + begin + if AAddr - FSegments[J].Offset <= Segment[J].Size then + begin + Result := True; + AMod := Modules[I]; + Exit; + end; + end; + end; + Result := False; + AMod := nil; +end; + +function TJclTD32InfoParser.FindSourceModule(const AAddr: DWORD; + var ASrcMod: TJclSourceModuleInfo): Boolean; +var + I, J: Integer; +begin + if ValidData then + for I := 0 to SourceModuleCount - 1 do + with SourceModules[I] do + for J := 0 to SegmentCount - 1 do + with Segment[J] do + if (StartOffset <= AAddr) and (AAddr < EndOffset) then + begin + Result := True; + ASrcMod := SourceModules[I]; + Exit; + end; + Result := False; + ASrcMod := nil; +end; + +function TJclTD32InfoParser.FindProc(const AAddr: DWORD; var AProc: TJclProcSymbolInfo): Boolean; +var + I: Integer; +begin + if ValidData then + for I := 0 to SymbolCount - 1 do + if Symbols[I].InheritsFrom(TJclProcSymbolInfo) then + with Symbols[I] as TJclProcSymbolInfo do + if (Offset <= AAddr) and (AAddr < Offset + Size) then + begin + Result := True; + AProc := TJclProcSymbolInfo(Symbols[I]); + Exit; + end; + Result := False; + AProc := nil; +end; + +class function TJclTD32InfoParser.IsTD32DebugInfoValid( + const DebugData: Pointer; const DebugDataSize: LongWord): Boolean; +var + Sign: TJclTD32FileSignature; + EndOfDebugData: LongWord; +begin + Assert(not IsBadReadPtr(DebugData, DebugDataSize)); + Result := False; + EndOfDebugData := LongWord(DebugData) + DebugDataSize; + if DebugDataSize > SizeOf(Sign) then + begin + Sign := PJclTD32FileSignature(EndOfDebugData - SizeOf(Sign))^; + if IsTD32Sign(Sign) and (Sign.Offset <= DebugDataSize) then + begin + Sign := PJclTD32FileSignature(EndOfDebugData - Sign.Offset)^; + Result := IsTD32Sign(Sign); + end; + end; +end; + +class function TJclTD32InfoParser.IsTD32Sign(const Sign: TJclTD32FileSignature): Boolean; +begin + Result := (Sign.Signature = Borland32BitSymbolFileSignatureForDelphi) or + (Sign.Signature = Borland32BitSymbolFileSignatureForBCB); +end; + +function TJclTD32InfoParser.LfaToVa(Lfa: DWORD): Pointer; +begin + Result := Pointer(DWORD(FBase) + Lfa) +end; + +//=== { TJclTD32InfoScanner } ================================================ + +function TJclTD32InfoScanner.LineNumberFromAddr(AAddr: DWORD): Integer; +var + Dummy: Integer; +begin + Result := LineNumberFromAddr(AAddr, Dummy); +end; + +function TJclTD32InfoScanner.LineNumberFromAddr(AAddr: DWORD; var Offset: Integer): Integer; +var + ASrcMod: TJclSourceModuleInfo; + ALine: TJclLineInfo; +begin + if FindSourceModule(AAddr, ASrcMod) and ASrcMod.FindLine(AAddr, ALine) then + begin + Result := ALine.LineNo; + Offset := AAddr - ALine.Offset; + end + else + begin + Result := 0; + Offset := 0; + end; +end; + +function TJclTD32InfoScanner.ModuleNameFromAddr(AAddr: DWORD): string; +var + AMod: TJclModuleInfo; +begin + if FindModule(AAddr, AMod) then + Result := Names[AMod.NameIndex] + else + Result := ''; +end; + +function TJclTD32InfoScanner.ProcNameFromAddr(AAddr: DWORD): string; +var + Dummy: Integer; +begin + Result := ProcNameFromAddr(AAddr, Dummy); +end; + +function TJclTD32InfoScanner.ProcNameFromAddr(AAddr: DWORD; var Offset: Integer): string; +var + AProc: TJclProcSymbolInfo; + + function FormatProcName(const ProcName: string): string; + var + pchSecondAt, P: PChar; + begin + Result := ProcName; + if (Length(ProcName) > 0) and (ProcName[1] = '@') then + begin + pchSecondAt := StrScan(PChar(Copy(ProcName, 2, Length(ProcName) - 1)), '@'); + if pchSecondAt <> nil then + begin + Inc(pchSecondAt); + Result := pchSecondAt; + P := PChar(Result); + while P^ <> #0 do + begin + if (pchSecondAt^ = '@') and ((pchSecondAt - 1)^ <> '@') then + P^ := '.'; + Inc(P); + Inc(pchSecondAt); + end; + end; + end; + end; + +begin + if FindProc(AAddr, AProc) then + begin + Result := FormatProcName(Names[AProc.NameIndex]); + Offset := AAddr - AProc.Offset; + end + else + begin + Result := ''; + Offset := 0; + end; +end; + +function TJclTD32InfoScanner.SourceNameFromAddr(AAddr: DWORD): string; +var + ASrcMod: TJclSourceModuleInfo; +begin + if FindSourceModule(AAddr, ASrcMod) then + Result := Names[ASrcMod.NameIndex]; +end; + +//=== { TJclPeBorTD32Image } ================================================= + +procedure TJclPeBorTD32Image.AfterOpen; +begin + inherited AfterOpen; + CheckDebugData; +end; + +procedure TJclPeBorTD32Image.CheckDebugData; +begin + FIsTD32DebugPresent := IsDebugInfoInImage(FTD32DebugData); + if not FIsTD32DebugPresent then + FIsTD32DebugPresent := IsDebugInfoInTds(FTD32DebugData); + if FIsTD32DebugPresent then + begin + FTD32Scanner := TJclTD32InfoScanner.Create(FTD32DebugData); + if not FTD32Scanner.ValidData then + begin + ClearDebugData; + if not NoExceptions then + raise EJclError.CreateResFmt(@RsHasNotTD32Info, [FileName]); + end; + end; +end; + +procedure TJclPeBorTD32Image.Clear; +begin + ClearDebugData; + inherited Clear; +end; + +procedure TJclPeBorTD32Image.ClearDebugData; +begin + FIsTD32DebugPresent := False; + FreeAndNil(FTD32Scanner); + FreeAndNil(FTD32DebugData); +end; + +function TJclPeBorTD32Image.IsDebugInfoInImage(var DataStream: TCustomMemoryStream): Boolean; +var + DebugDir: TImageDebugDirectory; + BugDataStart: Pointer; + DebugDataSize: Integer; +begin + Result := False; + DataStream := nil; + if IsBorlandImage and (DebugList.Count = 1) then + begin + DebugDir := DebugList[0]; + if DebugDir._Type = IMAGE_DEBUG_TYPE_UNKNOWN then + begin + BugDataStart := RvaToVa(DebugDir.AddressOfRawData); + DebugDataSize := DebugDir.SizeOfData; + Result := TJclTD32InfoParser.IsTD32DebugInfoValid(BugDataStart, DebugDataSize); + if Result then + DataStream := TJclReferenceMemoryStream.Create(BugDataStart, DebugDataSize); + end; + end; +end; + +function TJclPeBorTD32Image.IsDebugInfoInTds(var DataStream: TCustomMemoryStream): Boolean; +var + TdsFileName: TFileName; + TempStream: TCustomMemoryStream; +begin + Result := False; + DataStream := nil; + TdsFileName := ChangeFileExt(FileName, TurboDebuggerSymbolExt); + if FileExists(TdsFileName) then + begin + TempStream := TJclFileMappingStream.Create(TdsFileName); + try + Result := TJclTD32InfoParser.IsTD32DebugInfoValid(TempStream.Memory, TempStream.Size); + if Result then + DataStream := TempStream + else + TempStream.Free; + except + TempStream.Free; + raise; + end; + end; +end; + +// History: + +// $Log: JclTD32.pas,v $ +// Revision 1.15 2006/01/15 19:11:42 ahuser +// Some new data from td32 files +// +// Revision 1.14 2005/09/21 19:31:27 ahuser +// Added further symbol types +// +// Revision 1.13 2005/03/08 08:33:23 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.12 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.11 2005/02/24 16:34:53 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.10 2004/10/17 21:00:16 mthoma +// cleaning +// +// Revision 1.9 2004/06/14 13:05:21 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.8 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.7 2004/04/06 04:55:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclTask.pas b/official/1.96/source/windows/JclTask.pas new file mode 100644 index 0000000..82baaaf --- /dev/null +++ b/official/1.96/source/windows/JclTask.pas @@ -0,0 +1,948 @@ +{**************************************************************************************************} +{ } +{ 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 } +{ } +{ Unit owner: Flier Lu } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/03/04 06:40:26 $ +// For history see end of file + +unit JclTask; + +interface + +{$I jcl.inc} +{$I windowsonly.inc} + +uses + Windows, Messages, Classes, SysUtils, Contnrs, + 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; + + 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; + + 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; + + 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: Windows.TSystemTime; + function GetNextRunTime: 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; + protected + constructor Create(const ATaskName: WideString; const AScheduledWorkItem: IScheduledWorkItem); + public + destructor Destroy; override; + procedure Save; + procedure Refresh; + procedure Run; + procedure Terminate; + 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: Windows.TSystemTime read GetMostRecentRunTime; + property NextRunTime: 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; + +implementation + +uses + ActiveX, ComObj, CommCtrl, + 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; + 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 + Win32Check(SearchPath(nil, 'mstask.exe', nil, MAX_PATH, AppName, FilePart) > 0); + + si.cb := SizeOf(si); + 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; + +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); + + 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(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; + +function TJclScheduledTask.ShowPage(Pages: TJclScheduleTaskPropertyPages): Boolean; +var + PropPages: array [0..2] of MSTask.HPropSheetPage; + PropHeader: {CommCtrl.}TPropSheetHeader; +begin + OleCheck((FScheduledWorkItem as IProvideTaskPage).GetPage(TASKPAGE_TASK, True, PropPages[0])); + OleCheck((FScheduledWorkItem as IProvideTaskPage).GetPage(TASKPAGE_SCHEDULE, True, PropPages[1])); + OleCheck((FScheduledWorkItem as IProvideTaskPage).GetPage(TASKPAGE_SETTINGS, True, PropPages[2])); + + FillChar(PropHeader, SizeOf(PropHeader), 0); + PropHeader.dwSize := SizeOf(PropHeader); + PropHeader.dwFlags := PSH_DEFAULT or PSH_NOAPPLYNOW; + PropHeader.phpage := @PropPages; + PropHeader.nPages := Length(PropPages); + Result := PropertySheet(PropHeader) > 0; +end; + +function TJclScheduledTask.GetTask: ITask; +begin + Result := ScheduledWorkItem as ITask; +end; + +// History: + +// $Log: JclTask.pas,v $ +// Revision 1.21 2005/03/04 06:40:26 marquardt +// changed overloaded constructors to constructor with default parameter (BCB friendly) +// +// Revision 1.20 2005/02/24 16:34:53 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.19 2005/02/24 07:36:24 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.18 2004/10/25 08:51:23 marquardt +// PH cleaning +// +// Revision 1.17 2004/10/19 21:26:03 rrossmair +// got rid of MSTaskError unit +// +// Revision 1.16 2004/10/17 21:00:16 mthoma +// cleaning +// +// Revision 1.15 2004/10/08 20:13:03 rrossmair +// replaced JclUnicode routines by JclWideStrings equivalents +// +// Revision 1.14 2004/07/28 18:00:54 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.13 2004/06/16 07:30:31 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.12 2004/06/14 13:05:21 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.11 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.10 2004/06/02 03:23:47 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.9 2004/05/06 23:43:22 rrossmair +// minor improvements +// +// Revision 1.8 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.7 2004/04/26 04:28:16 +// - add TaskSchedulerServiceControl +// - some bugfixes for Win9x +// +// Revision 1.6 2004/04/06 04:55:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclUnicode.pas b/official/1.96/source/windows/JclUnicode.pas new file mode 100644 index 0000000..9e74201 --- /dev/null +++ b/official/1.96/source/windows/JclUnicode.pas @@ -0,0 +1,8608 @@ +{**************************************************************************************************} +{ } +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ Various Unicode related routines } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/10/26 09:15:13 $ +// For history see end of file + +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 decompositon (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 MSWINDOWS} + Windows, + {$ENDIF MSWINDOWS} + Classes, + JclBase; + +{$IFNDEF FPC} + {$IFDEF MSWINDOWS} + {$DEFINE OWN_WIDESTRING_MEMMGR} + {$ENDIF MSWINDOWS} +{$ENDIF ~FPC} + +{$IFDEF SUPPORTS_WIDESTRING} + +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; + + 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 = Char; + PUTF8 = ^UTF8; + UTF8 = Char; + 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; + + // 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, + ccOtherNeutrals, + // self defined categories, they do not appear in the Unicode data file + ccComposed, // can be decomposed + ccNonBreaking, + ccSymmetric, // has left and right forms + ccHexDigit, + ccQuotationMark, + ccMirroring, + ccSpaceOther, + ccAssigned // means there is a definition in the Unicode standard + ); + TCharacterCategories = set of TCharacterCategory; + + // 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 + ); + + // 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. + TUnicodeBlock = ( + ubUndefined, + ubBasicLatin, + ubLatin1Supplement, + ubLatinExtendedA, + ubLatinExtendedB, + ubIPAExtensions, + ubSpacingModifierLetters, + ubCombiningDiacriticalMarks, + //ubGreekandCoptic, + ubGreek, + ubCyrillic, + ubCyrillicSupplement, + ubArmenian, + ubHebrew, + ubArabic, + ubSyriac, + ubArabicSupplement, + ubThaana, + 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, + ubLimbu, + ubTaiLe, + ubNewTaiLue, + ubKhmerSymbols, + ubBuginese, + ubPhoneticExtensions, + ubPhoneticExtensionsSupplement, + ubCombiningDiacriticalMarksSupplement, + ubLatinExtendedAdditional, + ubGreekExtended, + ubGeneralPunctuation, + ubSuperscriptsandSubscripts, + ubCurrencySymbols, + //ubCombiningDiacriticalMarksforSymbols, + ubCombiningMarksforSymbols, + ubLetterlikeSymbols, + ubNumberForms, + ubArrows, + ubMathematicalOperators, + ubMiscellaneousTechnical, + ubControlPictures, + ubOpticalCharacterRecognition, + ubEnclosedAlphanumerics, + ubBoxDrawing, + ubBlockElements, + ubGeometricShapes, + ubMiscellaneousSymbols, + ubDingbats, + ubMiscellaneousMathematicalSymbolsA, + ubSupplementalArrowsA, + ubBraillePatterns, + ubSupplementalArrowsB, + ubMiscellaneousMathematicalSymbolsB, + ubSupplementalMathematicalOperators, + ubMiscellaneousSymbolsandArrows, + ubGlagolitic, + ubCoptic, + ubGeorgianSupplement, + ubTifinagh, + ubEthiopicExtended, + ubSupplementalPunctuation, + ubCJKRadicalsSupplement, + ubKangxiRadicals, + ubIdeographicDescriptionCharacters, + ubCJKSymbolsandPunctuation, + ubHiragana, + ubKatakana, + ubBopomofo, + ubHangulCompatibilityJamo, + ubKanbun, + ubBopomofoExtended, + ubCJKStrokes, + ubKatakanaPhoneticExtensions, + ubEnclosedCJKLettersandMonths, + ubCJKCompatibility, + ubCJKUnifiedIdeographsExtensionA, + ubYijingHexagramSymbols, + ubCJKUnifiedIdeographs, + ubYiSyllables, + ubYiRadicals, + ubModifierToneLetters, + ubSylotiNagri, + ubHangulSyllables, + ubHighSurrogates, + ubHighPrivateUseSurrogates, + ubLowSurrogates, + //ubPrivateUseArea, + ubPrivateUse, + ubCJKCompatibilityIdeographs, + ubAlphabeticPresentationForms, + ubArabicPresentationFormsA, + ubVariationSelectors, + ubVerticalForms, + ubCombiningHalfMarks, + ubCJKCompatibilityForms, + ubSmallFormVariants, + ubArabicPresentationFormsB, + ubHalfwidthandFullwidthForms, + ubSpecials, + ubLinearBSyllabary, + ubLinearBIdeograms, + ubAegeanNumbers, + ubAncientGreekNumbers, + ubOldItalic, + ubGothic, + ubUgaritic, + ubOldPersian, + ubDeseret, + ubShavian, + ubOsmanya, + ubCypriotSyllabary, + ubKharoshthi, + ubByzantineMusicalSymbols, + ubMusicalSymbols, + ubAncientGreekMusicalNotation, + ubTaiXuanJingSymbols, + ubMathematicalAlphanumericSymbols, + ubCJKUnifiedIdeographsExtensionB, + ubCJKCompatibilityIdeographsSupplement, + ubTags, + ubVariationSelectorsSupplement, + ubSupplementaryPrivateUseAreaA, + ubSupplementaryPrivateUseAreaB +); + + + 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: Integer; virtual; + public + constructor Create(AOwner: TWideStrings); virtual; + destructor Destroy; override; + + procedure AddResult(Start, Stop: Cardinal); virtual; + procedure Clear; virtual; + procedure ClearResults; virtual; + procedure DeleteResult(Index: Cardinal); virtual; + procedure FindPrepare(const Pattern: WideString; Options: TSearchFlags); overload; virtual; abstract; + procedure FindPrepare(Pattern: PWideChar; PatternLength: Cardinal; Options: TSearchFlags); overload; virtual; abstract; + function FindFirst(const Text: WideString; var Start, Stop: Cardinal): Boolean; overload; virtual; abstract; + function FindFirst(Text: PWideChar; TextLen: Cardinal; var Start, Stop: Cardinal): Boolean; overload; virtual; abstract; + function FindAll(const Text: WideString): Boolean; overload; virtual; abstract; + function FindAll(Text: PWideChar; TextLen: Cardinal): Boolean; overload; virtual; abstract; + procedure GetResult(Index: Cardinal; var Start, Stop: Integer); virtual; + + property Count: Integer 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: Cardinal; + FPatternSize: Cardinal; + FPatternLength: Cardinal; + FSkipValues: PUTBMSkip; + FSkipsUsed: Integer; + FMD4: Cardinal; + protected + procedure ClearPattern; + procedure Compile(Pattern: PUCS2; PatternLength: Integer; Flags: TSearchFlags); + function Find(Text: PUCS2; TextLen: Cardinal; var MatchStart, MatchEnd: Cardinal): Boolean; + function GetSkipValue(TextStart, TextEnd: PUCS2): Cardinal; + function Match(Text, Start, Stop: PUCS2; var MatchStart, MatchEnd: Cardinal): Boolean; + public + procedure Clear; override; + procedure FindPrepare(const Pattern: WideString; Options: TSearchFlags); overload; override; + procedure FindPrepare(Pattern: PWideChar; PatternLength: Cardinal; Options: TSearchFlags); overload; override; + function FindFirst(const Text: WideString; var Start, Stop: Cardinal): Boolean; overload; override; + function FindFirst(Text: PWideChar; TextLen: Cardinal; var Start, Stop: Cardinal): Boolean; overload; override; + function FindAll(const Text: WideString): Boolean; overload; override; + function FindAll(Text: PWideChar; TextLen: Cardinal): 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 occurences and up to n occurences + // 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 occurences + // + // 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: Integer; + 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: Cardinal; + end; + + // this is a structure used to track a list or a stack of states + PUcStateList = ^TUcStateList; + TUcStateList = record + List: array of Cardinal; + ListUsed: Integer; + end; + + // structure to track the list of unique states for a symbol during reduction + PUcSymbolTableEntry = ^TUcSymbolTableEntry; + TUcSymbolTableEntry = record + ID, + AType: Cardinal; + Mods, + Categories: TCharacterCategories; + Symbol: TUcSymbol; + States: TUcStateList; + end; + + // structure to hold a single State + PUcState = ^TUcState; + TUcState = record + ID: Cardinal; + Accepting: Boolean; + StateList: TUcStateList; + Transitions: array of TUcElement; + TransitionsUsed: Integer; + end; + + // structure used for keeping lists of states + TUcStateTable = record + States: array of TUcState; + StatesUsed: Integer; + end; + + // structure to track pairs of DFA states when equivalent states are merged + TUcEquivalent = record + Left, + Right: Cardinal; + end; + + TUcExpressionList = record + Expressions: array of TUcElement; + ExpressionsUsed: Integer; + end; + + TUcSymbolTable = record + Symbols: array of TUcSymbolTableEntry; + SymbolsUsed: Integer; + end; + + TUcEquivalentList = record + Equivalents: array of TUcEquivalent; + EquivalentsUsed: Integer; + 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: Cardinal; + end; + + PDFAState = ^TDFAState; + TDFAState = record + Accepting: Boolean; + NumberTransitions: Integer; + StartTransition: Integer; + end; + + TDFAStates = record + States: array of TDFAState; + StatesUsed: Integer; + end; + + TUcTransitions = record + Transitions: array of TUcTransition; + TransitionsUsed: Integer; + 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: Cardinal); + procedure AddRange(var CCL: TUcCClass; Range: TUcRange); + function AddState(NewStates: array of Cardinal): Cardinal; + procedure AddSymbolState(Symbol, State: Cardinal); + function BuildCharacterClass(CP: PUCS2; Limit: Cardinal; Symbol: PUcSymbolTableEntry): Cardinal; + procedure ClearUREBuffer; + function CompileSymbol(S: PUCS2; Limit: Cardinal; Symbol: PUcSymbolTableEntry): Cardinal; + procedure CompileURE(RE: PWideChar; RELength: Cardinal; Casefold: Boolean); + procedure CollectPendingOperations(var State: Cardinal); + function ConvertRegExpToNFA(RE: PWideChar; RELength: Cardinal): Cardinal; + function ExecuteURE(Flags: Cardinal; Text: PUCS2; TextLen: Cardinal; var MatchStart, MatchEnd: Cardinal): Boolean; + procedure ClearDFA; + procedure HexDigitSetup(Symbol: PUcSymbolTableEntry); + function MakeExpression(AType, LHS, RHS: Cardinal): Cardinal; + function MakeHexNumber(NP: PUCS2; Limit: Cardinal; var Number: Cardinal): Cardinal; + function MakeSymbol(S: PUCS2; Limit: Cardinal; var Consumed: Cardinal): Cardinal; + procedure MergeEquivalents; + function ParsePropertyList(Properties: PUCS2; Limit: Cardinal; var Categories: TCharacterCategories): Cardinal; + function Peek: Cardinal; + function Pop: Cardinal; + function PosixCCL(CP: PUCS2; Limit: Cardinal; Symbol: PUcSymbolTableEntry): Cardinal; + function ProbeLowSurrogate(LeftState: PUCS2; Limit: Cardinal; var Code: UCS4): Cardinal; + procedure Push(V: Cardinal); + procedure Reduce(Start: Cardinal); + 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: Cardinal; Options: TSearchFlags); overload; override; + function FindFirst(const Text: WideString; var Start, Stop: Cardinal): Boolean; overload; override; + function FindFirst(Text: PWideChar; TextLen: Cardinal; var Start, Stop: Cardinal): Boolean; overload; override; + function FindAll(const Text: WideString): Boolean; overload; override; + function FindAll(Text: PWideChar; TextLen: Cardinal): 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 successfull 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; + 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: string); virtual; + procedure LoadFromStream(Stream: TStream); virtual; + procedure Move(CurIndex, NewIndex: Integer); virtual; + procedure SaveToFile(const FileName: string); 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 + TDynWideCharArray = array of WideChar; + TWideStringItem = record + {$IFDEF OWN_WIDESTRING_MEMMGR} + FString: PWideChar; // "array of WideChar"; + {$ELSE} + 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; + + // result type for number retrieval functions + TUcNumber = record + Numerator, + Denominator: Integer; + end; + + TFontCharSet = 0..255; + +const + ReplacementCharacter: UCS4 = $0000FFFD; + MaximumUCS2: UCS4 = $0000FFFF; + MaximumUTF16: UCS4 = $0010FFFF; + MaximumUCS4: UCS4 = $7FFFFFFF; + + SurrogateHighStart: UCS4 = $D800; + SurrogateHighEnd: UCS4 = $DBFF; + SurrogateLowStart: UCS4 = $DC00; + SurrogateLowEnd: UCS4 = $DFFF; + +// functions involving null-terminated strings +// NOTE: PWideChars as well as WideStrings are NOT managed by reference counting under Win32. +// In Kylix this is different. WideStrings are reference counted there, just like ANSI strings. +function StrLenW(Str: PWideChar): Cardinal; +function StrEndW(Str: PWideChar): PWideChar; +function StrMoveW(Dest, Source: PWideChar; Count: Cardinal): PWideChar; +function StrCopyW(Dest, Source: PWideChar): PWideChar; +function StrECopyW(Dest, Source: PWideChar): PWideChar; +function StrLCopyW(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar; +function StrPCopyWW(Dest: PWideChar; const Source: WideString): PWideChar; overload; +function StrPCopyW(Dest: PWideChar; const Source: string): PWideChar; +function StrPLCopyWW(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar; +function StrPLCopyW(Dest: PWideChar; const Source: string; MaxLen: Cardinal): PWideChar; +function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; +function StrLCatW(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar; +function StrCompW(const Str1, Str2: PWideChar): Integer; +function StrICompW(const Str1, Str2: PWideChar): Integer; +function StrLCompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +function StrLICompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +function StrNScanW(const Str1, Str2: PWideChar): Integer; +function StrRNScanW(const Str1, Str2: PWideChar): Integer; +function StrScanW(Str: PWideChar; Chr: WideChar): PWideChar; overload; +function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: Cardinal): PWideChar; overload; +function StrRScanW(Str: PWideChar; Chr: WideChar): PWideChar; +function StrPosW(Str, SubStr: PWideChar): PWideChar; +function StrAllocW(WideSize: Cardinal): PWideChar; +function StrBufSizeW(const Str: PWideChar): Cardinal; +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: Integer): Integer; //az +function WideCompose(const S: WideString): WideString; +function WideDecompose(const S: WideString; Compatible: Boolean): WideString; +function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString; +function WideQuotedStr(const S: WideString; Quote: WideChar): WideString; +function WideStringOfChar(C: WideChar; Count: Cardinal): WideString; +function WideCaseFolding(C: WideChar): WideString; overload; +function WideCaseFolding(const S: WideString): WideString; overload; +function WideLowerCase(C: WideChar): WideString; overload; +function WideLowerCase(const S: WideString): WideString; overload; +function WideNormalize(const S: WideString; Form: TNormalizationForm): WideString; +function WideSameText(const Str1, Str2: WideString): Boolean; +function WideTitleCase(C: WideChar): WideString; overload; +function WideTitleCase(const S: WideString): WideString; overload; +function WideTrim(const S: WideString): WideString; +function WideTrimLeft(const S: WideString): WideString; +function WideTrimRight(const S: WideString): WideString; +function WideUpperCase(C: WideChar): WideString; overload; +function WideUpperCase(const S: WideString): WideString; overload; + +// Low level character routines +function UnicodeNumberLookup(Code: UCS4; var Number: TUcNumber): Boolean; +function UnicodeComposePair(First, Second: UCS4; var Composite: UCS4): Boolean; +function UnicodeCaseFold(Code: UCS4): TUCS4Array; +function UnicodeToUpper(Code: UCS4): TUCS4Array; +function UnicodeToLower(Code: UCS4): TUCS4Array; +function UnicodeToTitle(Code: UCS4): TUCS4Array; + +// Character test routines +function UnicodeIsAlpha(C: UCS4): Boolean; +function UnicodeIsDigit(C: UCS4): Boolean; +function UnicodeIsAlphaNum(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; +function UnicodeIsHexDigit(C: UCS4): Boolean; +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; +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; +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 UnicodeIsNonSpacingMark(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; + +// Utility functions +function CharSetFromLocale(Language: LCID): TFontCharSet; +function GetCharSetFromLocale(Language: LCID; out FontCharSet: TFontCharSet): Boolean; +function CodePageFromLocale(Language: LCID): Integer; +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: string; CodePage: Word): WideString; +function TranslateString(const S: string; CP1, CP2: Word): string; +function WideStringToStringEx(const WS: WideString; CodePage: Word): string; + +// WideString conversion routines +procedure ExpandANSIString(const Source: PChar; Target: PWideChar; Count: Cardinal); +function WideStringToUTF8(S: WideString): AnsiString; +function UTF8ToWideString(S: AnsiString): WideString; + +type + TCompareFunc = function (const W1, W2: WideString; Locale: LCID): Integer; + +var + WideCompareText: TCompareFunc; + +{$ENDIF SUPPORTS_WIDESTRING} + +type + EJclUnicodeError = class(EJclError); + +implementation + +{$IFDEF SUPPORTS_WIDESTRING} + +// 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. + +{$R JclUnicode.res} + +uses + {$IFDEF HAS_UNIT_RTLCONSTS} + RtlConsts, + {$ELSE} + {$IFNDEF FPC} + Consts, + {$ENDIF ~FPC} + {$ENDIF HAS_UNIT_RTLCONSTS} + SysUtils, + JclResources, JclSynch; + +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, ccSpaceOther]; + 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)]; + +var + // As the global data can be accessed by several threads it should be guarded + // while the data is loaded. + LoadInProgress: TJclCriticalSection; + +//----------------- 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 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: TResourceStream; + Category: TCharacterCategory; + Buffer: TRangeArray; + First, + Second: Byte; + J, K: Integer; +begin + // Data already loaded? + if not CategoriesLoaded then + begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + try + CategoriesLoaded := True; + Stream := TResourceStream.Create(HInstance, 'CATEGORIES', 'UNICODEDATA'); + try + while Stream.Position < Stream.Size do + begin + // a) read which category is current in the stream + Stream.ReadBuffer(Category, 1); + // b) read the size of the ranges and the ranges themself + Stream.ReadBuffer(Size, 4); + if Size > 0 then + begin + SetLength(Buffer, Size); + Stream.ReadBuffer(Buffer[0], Size * SizeOf(TRange)); + + // 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 + if K > $FFFF then + Break; + + First := (K shr 8) and $FF; + Second := K and $FF; + // add second step array if not yet done + if Categories[First] = nil then + SetLength(Categories[First], 256); + Include(Categories[First, Second], Category); + end; + end; + end; + finally + Stream.Free; + end; + finally + LoadInProgress.Leave; + end; + end; +end; + +function CategoryLookup(Code: Cardinal; Cats: TCharacterCategories): Boolean; overload; +// determines whether the Code is in the given category +var + First, + Second: Byte; +begin + // load property data if not already done + if not CategoriesLoaded then + LoadCharacterCategories; + + First := (Code shr 8) and $FF; + Second := Code and $FF; + if Categories[First] <> nil then + Result := Categories[First, Second] * Cats <> [] + else + Result := False; +end; + +//----------------- support for case mapping ------------------------------------------------------- + +type + TCase = array [0..3] of TUCS4Array; // mapping for case fold, lower, title and upper in this order + TCaseArray = 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; + SingletonMapping: TUCS4Array; + +procedure LoadCaseMappingData; +var + Stream: TResourceStream; + I, Code, + Size: Cardinal; + First, + Second: Byte; +begin + if not CaseDataLoaded then + begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + + try + SetLength(SingletonMapping, 1); + CaseDataLoaded := True; + Stream := TResourceStream.Create(HInstance, 'CASE', 'UNICODEDATA'); + try + // the first entry in the stream is the number of entries in the case mapping table + Stream.ReadBuffer(Size, 4); + for I := 0 to Size - 1 do + begin + // a) read actual code point + Stream.ReadBuffer(Code, 4); + + Assert(Code < $10000, LoadResString(@RsCasedUnicodeChar)); + // if there is no high byte entry in the first stage table then create one + First := (Code shr 8) and $FF; + Second := Code and $FF; + if CaseMapping[First] = nil then + SetLength(CaseMapping[First], 256); + + // b) read fold case array + Stream.ReadBuffer(Size, 4); + if Size > 0 then + begin + SetLength(CaseMapping[First, Second, 0], Size); + Stream.ReadBuffer(CaseMapping[First, Second, 0, 0], Size * SizeOf(UCS4)); + end; + // c) read lower case array + Stream.ReadBuffer(Size, 4); + if Size > 0 then + begin + SetLength(CaseMapping[First, Second, 1], Size); + Stream.ReadBuffer(CaseMapping[First, Second, 1, 0], Size * SizeOf(UCS4)); + end; + // d) read title case array + Stream.ReadBuffer(Size, 4); + if Size > 0 then + begin + SetLength(CaseMapping[First, Second, 2], Size); + Stream.ReadBuffer(CaseMapping[First, Second, 2, 0], Size * SizeOf(UCS4)); + end; + // e) read upper case array + Stream.ReadBuffer(Size, 4); + if Size > 0 then + begin + SetLength(CaseMapping[First, Second, 3], Size); + Stream.ReadBuffer(CaseMapping[First, Second, 3, 0], Size * SizeOf(UCS4)); + end; + end; + + finally + Stream.Free; + end; + finally + LoadInProgress.Leave; + end; + end; +end; + +function CaseLookup(Code: Cardinal; CaseType: Cardinal): TUCS4Array; +// Performs a lookup of the given code and returns its case mapping if found. +// CaseType must be 0 for case folding, 1 for lower case, 2 for title case and 3 for upper case, respectively. +// If Code could not be found (or there is no case mapping) then the result is a mapping of length 1 with the +// code itself. Otherwise an array of code points is returned which represent the mapping. +var + First, + Second: Byte; +begin + // load case mapping data if not already done + if not CaseDataLoaded then + LoadCaseMappingData; + + First := (Code shr 8) and $FF; + Second := 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) or (CaseMapping[First, Second, CaseType] = nil) then + begin + SingletonMapping[0] := Code; + Result := SingletonMapping; + end + else + Result := CaseMapping[First, Second, CaseType]; +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 + Result := CaseLookup(Code, 0); +end; + +function UnicodeToUpper(Code: UCS4): TUCS4Array; +begin + Result := CaseLookup(Code, 3); +end; + +function UnicodeToLower(Code: UCS4): TUCS4Array; +begin + Result := CaseLookup(Code, 1); +end; + +function UnicodeToTitle(Code: UCS4): TUCS4Array; +begin + Result := CaseLookup(Code, 2); +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 + TDecompositions = array of TUCS4Array; + TDecompositionsArray = array [Byte] of TDecompositions; + +var + // list of decompositions, organized (again) as two stage matrix + // Note: there are two tables, one for canonical decompositions and the other one + // for compatibility decompositions. + DecompositionsLoaded: Boolean; + CanonicalDecompositions, + CompatibleDecompositions: TDecompositionsArray; + +procedure LoadDecompositionData; +var + Stream: TResourceStream; + I, Code, + Size: Cardinal; + First, + Second: Byte; +begin + if not DecompositionsLoaded then + begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + + try + DecompositionsLoaded := True; + Stream := TResourceStream.Create(HInstance, 'DECOMPOSITION', 'UNICODEDATA'); + try + // determine how many decomposition entries we have + Stream.ReadBuffer(Size, 4); + for I := 0 to Size - 1 do + begin + Stream.ReadBuffer(Code, 4); + + Assert((Code and not $40000000) < $10000, LoadResString(@RsDecomposedUnicodeChar)); + + // if there is no high byte entry in the first stage table then create one + First := (Code shr 8) and $FF; + Second := Code and $FF; + + // insert into the correct table depending on bit 30 + // (if set then it is a compatibility decomposition) + if Code and $40000000 <> 0 then + begin + if CompatibleDecompositions[First] = nil then + SetLength(CompatibleDecompositions[First], 256); + + Stream.ReadBuffer(Size, 4); + if Size > 0 then + begin + SetLength(CompatibleDecompositions[First, Second], Size); + Stream.ReadBuffer(CompatibleDecompositions[First, Second, 0], Size * SizeOf(UCS4)); + end; + end + else + begin + if CanonicalDecompositions[First] = nil then + SetLength(CanonicalDecompositions[First], 256); + + Stream.ReadBuffer(Size, 4); + if Size > 0 then + begin + SetLength(CanonicalDecompositions[First, Second], Size); + Stream.ReadBuffer(CanonicalDecompositions[First, Second, 0], Size * SizeOf(UCS4)); + end; + end; + end; + finally + Stream.Free; + end; + finally + LoadInProgress.Leave; + end; + 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: Byte; +begin + // 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 8) and $FF; + Second := Code and $FF; + if Compatible then + begin + // Check first stage table whether there is a particular block and + // (if so) then whether there is a decomposition or not. + if (CompatibleDecompositions[First] = nil) or (CompatibleDecompositions[First, Second] = nil) then + begin + // if there is no compatibility decompositions try canonical + if (CanonicalDecompositions[First] = nil) or (CanonicalDecompositions[First, Second] = nil) then + Result := nil + else + Result := CanonicalDecompositions[First, Second]; + end + else + Result := CompatibleDecompositions[First, Second]; + end + else + begin + if (CanonicalDecompositions[First] = nil) or (CanonicalDecompositions[First, Second] = nil) then + Result := nil + else + Result := CanonicalDecompositions[First, Second]; + end; + end; +end; + +//----------------- support for combining classes -------------------------------------------------- + +type + TClassArray = array of Byte; + +var + // canonical combining classes, again as two stage matrix + CCCsLoaded: Boolean; + CCCs: array [Byte] of TClassArray; + +procedure LoadCombiningClassData; +var + Stream: TResourceStream; + I, J, K, + Size: Cardinal; + Buffer: TRangeArray; + First, + Second: Byte; +begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + + try + if not CCCsLoaded then + begin + CCCsLoaded := True; + Stream := TResourceStream.Create(HInstance, 'COMBINING', 'UNICODEDATA'); + try + while Stream.Position < Stream.Size do + begin + // a) determine which class is stored here + Stream.ReadBuffer(I, 4); + // b) determine how many ranges are assigned to this class + Stream.ReadBuffer(Size, 4); + // c) read start and stop code of each range + if Size > 0 then + begin + SetLength(Buffer, Size); + Stream.ReadBuffer(Buffer[0], Size * SizeOf(TRange)); + + // 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 + Assert(K < $10000, LoadResString(@RsCombiningClassUnicodeChar)); + + First := (K shr 8) and $FF; + Second := K and $FF; + // add second step array if not yet done + if CCCs[First] = nil then + SetLength(CCCs[First], 256); + CCCs[First, Second] := I; + end; + end; + end; + finally + Stream.Free; + end; + end; + finally + LoadInProgress.Leave; + end; +end; + +function CanonicalCombiningClass(Code: Cardinal): Cardinal; +var + First, + Second: Byte; +begin + // load combining class data if not already done + if not CCCsLoaded then + LoadCombiningClassData; + + First := (Code shr 8) and $FF; + Second := Code and $FF; + if CCCs[First] <> nil then + Result := CCCs[First, Second] + 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 + NumberCodes: array of TCodeIndex; + // array of numbers used in NumberCodes + Numbers: array of TUcNumber; + +procedure LoadNumberData; +var + Stream: TResourceStream; + Size: Cardinal; +begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + + try + if NumberCodes = nil then + begin + Stream := TResourceStream.Create(HInstance, 'NUMBERS', 'UNICODEDATA'); + // 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 + Stream.ReadBuffer(Size, 4); + SetLength(Numbers, Size); + // b) read numbers data + Stream.ReadBuffer(Numbers[0], Size * SizeOf(TUcNumber)); + // c) determine size of index array + Stream.ReadBuffer(Size, 4); + SetLength(NumberCodes, Size); + // d) read index data + Stream.ReadBuffer(NumberCodes[0], Size * SizeOf(TCodeIndex)); + Stream.Free; + 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 NumberCodes = nil 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. + TCompositionPair = record + Code: Cardinal; + Composition: UCS4; + end; + +var + // list of composition mappings + Compositions: array of TCompositionPair; + +procedure LoadCompositionData; +var + Stream: TResourceStream; + Size: Cardinal; +begin + // make sure no other code is currently modifying the global data area + LoadInProgress.Enter; + + try + if Compositions = nil then + begin + Stream := TResourceStream.Create(HInstance, 'COMPOSITION', 'UNICODEDATA'); + // a) determine size of compositions array + Stream.ReadBuffer(Size, 4); + SetLength(Compositions, Size); + // b) read data + Stream.ReadBuffer(Compositions[0], Size * SizeOf(TCompositionPair)); + Stream.Free; + end; + finally + LoadInProgress.Leave; + end; +end; + +function UnicodeComposePair(First, Second: UCS4; var Composite: UCS4): Boolean; +// Maps the sequence of First and Second to a composite. +// Result is True if there was a mapping otherwise it is False. +var + L, R, M, C: Integer; + Pair: Integer; +begin + if Compositions = nil then + LoadCompositionData; + + Result := False; + L := 0; + R := High(Compositions); + Pair := Integer((First shl 16) or Word(Second)); + while L <= R do + begin + M := (L + R) shr 1; + C := Integer(Compositions[M].Code) - Pair; + if C < 0 then + L := M + 1 + else + begin + R := M - 1; + if C = 0 then + begin + Result := True; + L := M; + end; + end; + end; + if Result then + Composite := Compositions[L].Composition; +end; + +//=== { TSearchEngine } ====================================================== + +constructor TSearchEngine.Create(AOwner: TWideStrings); +begin + FOwner := AOwner; + FResults := TList.Create; +end; + +destructor TSearchEngine.Destroy; +begin + Clear; + FResults.Free; + inherited Destroy; +end; + +procedure TSearchEngine.AddResult(Start, Stop: Cardinal); +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: Cardinal); +// 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: Integer; +// returns the number of matches found +begin + Result := FResults.Count div 2; +end; + +procedure TSearchEngine.GetResult(Index: Cardinal; var Start, Stop: Integer); +// 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 := Cardinal(FResults[2 * Index]); + Stop := Cardinal(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): Cardinal; +// looks up the SkipValues value for a character +var + I: Integer; + C1, + C2: UCS4; + Sp: PUTBMSkip; +begin + Result := 0; + if Cardinal(TextStart) < Cardinal(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: Cardinal): 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 (happend 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: Integer; + 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: Integer; Flags: TSearchFlags); +var + HaveSpace: Boolean; + I, J, K, + SLen: Integer; + 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 := (PChar(Cp) - PChar(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: Cardinal; var MatchStart, MatchEnd: Cardinal): Boolean; +// this is the main matching routine using a tuned Boyer-Moore algorithm +var + K: Cardinal; + 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: Cardinal): Boolean; +// Looks for all occurences of the pattern passed to FindPrepare and creates an +// internal list of their positions. +var + Start, Stop: Cardinal; + Run: PWideChar; + RunLen: Cardinal; +begin + ClearResults; + Run := Text; + RunLen := TextLen; + // repeat to find all occurences 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: Cardinal): Boolean; +// Looks for the first occurence 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 occurence 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: Cardinal; var Start, Stop: Cardinal): 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: Cardinal; 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: Cardinal); +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: Cardinal; +begin + if FUREBuffer.Stack.ListUsed = 0 then + Result := _URE_NOOP + else + Result := FUREBuffer.Stack.List[FUREBuffer.Stack.ListUsed - 1]; +end; + +function TURESearch.Pop: Cardinal; +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: Cardinal; + var Categories: TCharacterCategories): Cardinal; +// 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: Cardinal; + 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 cardinal that + // represents the character category. + N := (N * 10) + Cardinal(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 Integer(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: Cardinal; var Number: Cardinal): Cardinal; +// Collect a hex number with 1 to 4 digits and return the number of characters used. +var + I: Integer; + 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) + Cardinal(Word(Run^) - Ord('0')) + else + begin + if (Run^ >= 'A') and (Run^ <= 'F') then + Number := (Number shl 4) + Cardinal(Word(Run^) - Ord('A')) + 10 + else + begin + if (Run^ >= 'a') and (Run^ <= 'f') then + Number := (Number shl 4) + 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: Integer; + 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: Cardinal; + Setup: Integer; + 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: Cardinal; Symbol: PUcSymbolTableEntry): Cardinal; +// Probe for one of the POSIX colon delimited character classes in the static trie. +var + I: Integer; + N: Cardinal; + 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: Cardinal; Symbol: PUcSymbolTableEntry): Cardinal; +// Construct a list of ranges and return the number of characters consumed. +var + RangeEnd: Integer; + N: Cardinal; + 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: Cardinal; var Code: UCS4): Cardinal; +// probes for a low surrogate hex code +var + I: Integer; + 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) + Cardinal(Word(Run^) - Ord('0')) + else + begin + if (Run^ >= 'A') and (Run^ <= 'F') then + Code := (Code shl 4) + Cardinal(Word(Run^) - Ord('A')) + 10 + else + begin + if (Run^ >= 'a') and (Run^ <= 'f') then + Code := (Code shl 4) + 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: Cardinal; Symbol: PUcSymbolTableEntry): Cardinal; +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: Cardinal; var Consumed: Cardinal): Cardinal; +// constructs a symbol, but only keep unique symbols +var + I: Integer; + Start: PUcSymbolTableEntry; + Symbol: TUcSymbolTableEntry; +begin + // Build the next symbol so we can test to see if it is already in the symbol table. + FillChar(Symbol, SizeOf(TUcSymbolTableEntry), 0); + 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: Cardinal): Cardinal; +var + I: Integer; +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 + Result := C in [Word('+'), Word('*'), Word('?'), Word('{'), Word('|'), Word(')')]; +end; + +procedure TURESearch.CollectPendingOperations(var State: Cardinal); +// collects all pending AND and OR operations and make corresponding expressions +var + Operation: Cardinal; +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: Cardinal): Cardinal; +// 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: Cardinal; + I: Integer; + +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); + S := ''; + while Head^ in [WideChar('0')..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); + S := ''; + while Head^ in [WideChar('0')..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 occurences + 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 occurences 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 Integer(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: Cardinal); +var + I, J: Integer; + 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(Cardinal) * (ListUsed - J)); + List[J] := State; + Inc(ListUsed); + end; + end; +end; + +function TURESearch.AddState(NewStates: array of Cardinal): Cardinal; +var + I: Integer; + 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(Cardinal) * 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(Cardinal) * 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: Cardinal); +var + I, J, + Symbols: Integer; + State, + RHS, + s1, s2, + ns1, ns2: Cardinal; + 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: Cardinal); +var + I: Integer; +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: Integer; + 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 = Cardinal(I) then + begin + J := 0; + while J < I do + begin + State2 := @FUREBuffer.States.States[J]; + if State2.ID = Cardinal(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 = Cardinal(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: Integer; +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; + FillChar(FUREBuffer, SizeOf(FUREBuffer), 0); +end; + +procedure TURESearch.CompileURE(RE: PWideChar; RELength: Cardinal; Casefold: Boolean); +var + I, J: Integer; + State: Cardinal; + Run: PUcState; + TP: Integer; + + 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 occured 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: Integer; +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; + FillChar(FDFA, SizeOf(FDFA), 0); +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: Cardinal; var MatchStart, + MatchEnd: Cardinal): Boolean; +var + I, J: Integer; + Matched, + Found: Boolean; + Start, Stop: Integer; + C: UCS4; + Run, Tail, lp: PUCS2; + LastState: PDFAState; + Symbol: PUcSymbolTableEntry; + Rp: PUcRange; +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 UnicodeIsNonSpacingMark(C) then + begin + Inc(Run); + Continue; + end; + + if (FDFA.Flags and _URE_DFA_CASEFOLD) <> 0 then + { TODO : use the entire mapping, not only the first character } + C := UnicodeToLower(C)[0]; + + // 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: Cardinal): Boolean; +// Looks for all occurences of the pattern passed to FindPrepare and creates an +// internal list of their positions. +var + Start, Stop: Cardinal; + Run: PWideChar; + RunLen: Cardinal; +begin + ClearResults; + Run := Text; + RunLen := TextLen; + // repeat to find all occurences of the pattern + 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: Cardinal): Boolean; +begin + Result := FindFirst(PWideChar(Text), Length(Text), Start, Stop); +end; + +function TURESearch.FindFirst(Text: PWideChar; TextLen: Cardinal; var Start, Stop: Cardinal): Boolean; +// Looks for the first occurence 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 occurence needs to be found. +begin + ClearResults; + Result := ExecuteURE(0, PWideChar(Text), Length(Text), Start, Stop); + if Result then + AddResult(Start, Stop); +end; + +procedure TURESearch.FindPrepare(Pattern: PWideChar; PatternLength: Cardinal; 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; + S: WideString; + CP: Integer; +begin + BeginUpdate; + try + CP := CodePageFromLocale(FLanguage); + for I := 0 to Strings.Count - 1 do + begin + S := StringToWideStringEx(Strings[I], CP); + AddObject(S, Strings.Objects[I]); + end; + finally + EndUpdate; + end; +end; + +procedure TWideStrings.AddStrings(Strings: TWideStrings); +var + I: Integer; + SourceCP, + TargetCP: Integer; + S: WideString; +begin + Assert(Strings <> nil); + + BeginUpdate; + try + if Strings.FLanguage <> FLanguage then + begin + SourceCP := CodePageFromLocale(Strings.FLanguage); + TargetCP := CodePageFromLocale(FLanguage); + for I := 0 to Strings.Count - 1 do + begin + S := TranslateString(Strings[I], SourceCP, TargetCP); + AddObject(S, Strings.Objects[I]); + end; + end + else + begin + for I := 0 to Strings.Count - 1 do + AddObject(Strings[I], Strings.Objects[I]); + end; + 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; + S: string; + CP: Integer; +begin + if Dest is TStrings then + begin + with Dest as TStrings do + begin + BeginUpdate; + try + CP := CodePageFromLocale(FLanguage); + Clear; + for I := 0 to Self.Count - 1 do + begin + S := WideStringToStringEx(Self[I], CP); + AddObject(S, Self.Objects[I]); + 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 + MOV EAX, [EBP + 4] + 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 not (P^ in [WideNull..WideSpace, WideChar('"'), WideChar(',')]) 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: string); +var + Stream: TStream; +begin + try + Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone); + 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: string; +begin + BeginUpdate; + try + Loaded := False; + + Size := Stream.Size - Stream.Position; + 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'); + System.Move(ByteOrderMask[2],SW[1],BytesRead-2); // max 4 bytes = 2 widechars + Stream.Read(SW[3], Size-BytesRead); // first 2 chars were copied by System.Move + 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'); + System.Move(ByteOrderMask[2],SW[1],BytesRead-2); // max 4 bytes = 2 widechars + Stream.Read(SW[3], Size-BytesRead); // first 2 chars were copied by System.Move + StrSwapByteOrder(PWideChar(SW)); + 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(Char)); + System.Move(ByteOrderMask[3],SA[1],BytesRead-3); // max 3 bytes = 3 chars + Stream.Read(SA[4], Size-BytesRead); // first 3 chars were copied by System.Move + SW := UTF8ToWideString(SA); + SetText(SW); + Loaded := True; + end; + + // default case (Ansi) + if not Loaded then + begin + FSaveFormat := sfAnsi; + SetLength(SA, Size div SizeOf(Char)); + System.Move(ByteOrderMask[0],SA[1],BytesRead); // max 6 bytes = 6 chars + Stream.Read(SA[7], Size-BytesRead); // first 6 chars were copied by System.Move + SetText(SA); + 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.ReadWideString); + end; +end; + +procedure TWideStrings.SaveToFile(const FileName: string); +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: string; + 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^ in [WideChar(#1)..WideChar(#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 + Stream.WriteBuffer(BOM_UTF16_LSB[0],SizeOf(BOM_UTF16_LSB)); + Stream.WriteBuffer(SW[1],Length(SW)*SizeOf(UTF16)); + FSaved := True; + end; + sfUTF16MSB : + begin + Stream.WriteBuffer(BOM_UTF16_MSB[0],SizeOf(BOM_UTF16_MSB)); + StrSwapByteOrder(PWideChar(SW)); + Stream.WriteBuffer(SW[1],Length(SW)*SizeOf(UTF16)); + FSaved := True; + end; + sfUTF8 : + begin + Stream.WriteBuffer(BOM_UTF8[0],SizeOf(BOM_UTF8)); + SA := WideStringToUTF8(SW); + Stream.WriteBuffer(SA[1],Length(SA)*SizeOf(UTF8)); + FSaved := True; + end; + sfAnsi : + begin + SA := WideStringToStringEx(SW,CodePageFromLocale(FLanguage)); + Stream.WriteBuffer(SA[1],Length(SA)*SizeOf(Char)); + 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^ in [WideChar(#1)..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^ in [WideChar(#1)..WideSpace] do + Inc(P); + if P^ = ',' then + begin + repeat + Inc(P); + until not (P^ in [WideChar(#1)..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 not (Tail^ in [WideNull, WideLineFeed, WideCarriageReturn, WideVerticalTab, 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.WriteWideString(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} + 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} + 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 + 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} + 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} + 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; + +//----------------- functions for null terminated strings ------------------------------------------ + +function StrLenW(Str: PWideChar): Cardinal; +// returns number of characters in a string excluding the null terminator +asm + MOV EDX, EDI + MOV EDI, EAX + MOV ECX, 0FFFFFFFFH + XOR AX, AX + REPNE SCASW + MOV EAX, 0FFFFFFFEH + SUB EAX, ECX + MOV EDI, EDX +end; + +function StrEndW(Str: PWideChar): PWideChar; +// returns a pointer to the end of a null terminated string +asm + MOV EDX, EDI + MOV EDI, EAX + MOV ECX, 0FFFFFFFFH + XOR AX, AX + REPNE SCASW + LEA EAX, [EDI - 2] + MOV EDI, EDX +end; + +function StrMoveW(Dest, Source: PWideChar; Count: Cardinal): PWideChar; +// Copies the specified number of characters to the destination string and returns Dest +// also as result. Dest must have enough room to store at least Count characters. +asm + PUSH ESI + PUSH EDI + MOV ESI, EDX + MOV EDI, EAX + MOV EDX, ECX + CMP EDI, ESI + JG @@1 + JE @@2 + SHR ECX, 1 + REP MOVSD + MOV ECX, EDX + AND ECX, 1 + REP MOVSW + JMP @@2 +@@1: + LEA ESI, [ESI + 2 * ECX - 2] + LEA EDI, [EDI + 2 * ECX - 2] + STD + AND ECX, 1 + REP MOVSW + SUB EDI, 2 + SUB ESI, 2 + MOV ECX, EDX + SHR ECX, 1 + REP MOVSD + CLD +@@2: + POP EDI + POP ESI +end; + +function StrCopyW(Dest, Source: PWideChar): PWideChar; +// copies Source to Dest and returns Dest +asm + PUSH EDI + PUSH ESI + MOV ESI, EAX + MOV EDI, EDX + MOV ECX, 0FFFFFFFFH + XOR AX, AX + REPNE SCASW + NOT ECX + MOV EDI, ESI + MOV ESI, EDX + MOV EDX, ECX + MOV EAX, EDI + SHR ECX, 1 + REP MOVSD + MOV ECX, EDX + AND ECX, 1 + REP MOVSW + POP ESI + POP EDI + +end; + +function StrECopyW(Dest, Source: PWideChar): PWideChar; +// copies Source to Dest and returns a pointer to the null character ending the string +asm + PUSH EDI + PUSH ESI + MOV ESI, EAX + MOV EDI, EDX + MOV ECX, 0FFFFFFFFH + XOR AX, AX + REPNE SCASW + NOT ECX + MOV EDI, ESI + MOV ESI, EDX + MOV EDX, ECX + SHR ECX, 1 + REP MOVSD + MOV ECX, EDX + AND ECX, 1 + REP MOVSW + LEA EAX, [EDI - 2] + POP ESI + POP EDI + +end; + +function StrLCopyW(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar; +// copies a specified maximum number of characters from Source to Dest +asm + PUSH EDI + PUSH ESI + PUSH EBX + MOV ESI, EAX + MOV EDI, EDX + MOV EBX, ECX + XOR AX, AX + TEST ECX, ECX + JZ @@1 + REPNE SCASW + JNE @@1 + INC ECX +@@1: + SUB EBX, ECX + MOV EDI, ESI + MOV ESI, EDX + MOV EDX, EDI + MOV ECX, EBX + SHR ECX, 1 + REP MOVSD + MOV ECX, EBX + AND ECX, 1 + REP MOVSW + STOSW + MOV EAX, EDX + POP EBX + POP ESI + POP EDI +end; + +function StrPCopyWW(Dest: PWideChar; const Source: WideString): PWideChar; +// copies a Pascal-style WideString to a null-terminated wide string +begin + Result := StrLCopyW(Dest, PWideChar(Source), Length(Source)); +end; + +function StrPCopyW(Dest: PWideChar; const Source: string): PWideChar; +// copies a Pascal-style string to a null-terminated wide string +begin + Result := StrPLCopyW(Dest, Source, Cardinal(Length(Source))); + Result[Length(Source)] := WideNull; +end; + +function StrPLCopyWW(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar; +// copies characters from a Pascal-style WideString into a null-terminated wide string +begin + Result := StrLCopyW(Dest, PWideChar(Source), MaxLen); +end; + +function StrPLCopyW(Dest: PWideChar; const Source: string; MaxLen: Cardinal): PWideChar; +// copies characters from a Pascal-style string into a null-terminated wide string +asm + PUSH EDI + PUSH ESI + MOV EDI, EAX + MOV ESI, EDX + MOV EDX, EAX + XOR AX, AX +@@1: LODSB + STOSW + DEC ECX + JNZ @@1 + MOV EAX, EDX + POP ESI + POP EDI +end; + +function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; +// appends a copy of Source to the end of Dest and returns the concatenated string +begin + StrCopyW(StrEndW(Dest), Source); + Result := Dest; +end; + +// appends a specified maximum number of WideCharacters to string + +function StrLCatW(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar; +asm + PUSH EDI + PUSH ESI + PUSH EBX + MOV EDI, Dest + MOV ESI, Source + MOV EBX, MaxLen + SHL EBX, 1 + CALL StrEndW + MOV ECX, EDI + ADD ECX, EBX + SUB ECX, EAX + JBE @@1 + MOV EDX, ESI + SHR ECX, 1 + CALL StrLCopyW +@@1: + MOV EAX, EDI + POP EBX + POP ESI + POP EDI +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): Integer; +// 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 + UTF16Fixup[C1 shr 11]); + C2 := Word(Run2^); + C2 := Word(C2 + UTF16Fixup[C2 shr 11]); + + // now C1 and C2 are in UTF-32-compatible order + Result := Integer(C1) - Integer(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 StrICompW(const Str1, Str2: PWideChar): Integer; +// 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. +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 + UTF16Fixup[C1 shr 11]); + C2 := Word(Run2^); + C2 := Word(C2 + UTF16Fixup[C2 shr 11]); + + // now C1 and C2 are in UTF-32-compatible order + Result := Integer(C1) - Integer(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; + +function StrLICompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +// compares strings up to MaxLen code points +// see also StrICompW +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 + UTF16Fixup[C1 shr 11]); + C2 := Word(Run2^); + C2 := Word(C2 + 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 := Integer(C1) - Integer(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; + +function StrLCompW(const Str1, Str2: PWideChar; MaxLen: Cardinal): Integer; +// 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 + UTF16Fixup[C1 shr 11]); + C2 := Word(S2^); + C2 := Word(C2 + 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 := Integer(C1) - Integer(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 StrNScanW(const Str1, Str2: PWideChar): Integer; +// 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): Integer; +// 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 + +function StrScanW(Str: PWideChar; Chr: WideChar): PWideChar; +asm + PUSH EDI + PUSH EAX + MOV EDI, Str + MOV ECX, 0FFFFFFFFH + XOR AX, AX + REPNE SCASW + NOT ECX + POP EDI + MOV AX, Chr + REPNE SCASW + MOV EAX, 0 + JNE @@1 + MOV EAX, EDI + SUB EAX, 2 +@@1: + POP EDI +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. +// +// on enter EAX contains Str, EDX contains Chr and ECX StrLen +// on exit EAX contains result pointer or nil + +function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: Cardinal): PWideChar; +asm + TEST EAX, EAX + JZ @@Exit // get out if the string is nil or StrLen is 0 + JCXZ @@Exit +@@Loop: + CMP [EAX], DX // this unrolled loop is actually faster on modern processors + JE @@Exit // than REP SCASW + ADD EAX, 2 + DEC ECX + JNZ @@Loop + XOR EAX, EAX +@@Exit: +end; + +// returns a pointer to the last occurance of Chr in Str + +function StrRScanW(Str: PWideChar; Chr: WideChar): PWideChar; +asm + PUSH EDI + MOV EDI, Str + MOV ECX, 0FFFFFFFFH + XOR AX, AX + REPNE SCASW + NOT ECX + STD + SUB EDI, 2 + MOV AX, Chr + REPNE SCASW + MOV EAX, 0 + JNE @@1 + MOV EAX, EDI + ADD EAX, 2 +@@1: + CLD + POP EDI +end; + +// returns a pointer to the first occurance of SubStr in Str + +function StrPosW(Str, SubStr: PWideChar): PWideChar; +asm + PUSH EDI + PUSH ESI + PUSH EBX + OR EAX, EAX + JZ @@2 + OR EDX, EDX + JZ @@2 + MOV EBX, EAX + MOV EDI, EDX + XOR AX, AX + MOV ECX, 0FFFFFFFFH + REPNE SCASW + NOT ECX + DEC ECX + JZ @@2 + MOV ESI, ECX + MOV EDI, EBX + MOV ECX, 0FFFFFFFFH + REPNE SCASW + NOT ECX + SUB ECX, ESI + JBE @@2 + MOV EDI, EBX + LEA EBX, [ESI - 1] +@@1: + MOV ESI, EDX + LODSW + REPNE SCASW + JNE @@2 + MOV EAX, ECX + PUSH EDI + MOV ECX, EBX + REPE CMPSW + POP EDI + MOV ECX, EAX + JNE @@1 + LEA EAX, [EDI - 2] + JMP @@3 +@@2: + XOR EAX, EAX +@@3: + POP EBX + POP ESI + POP EDI +end; + +function StrAllocW(WideSize: Cardinal): PWideChar; +// Allocates a buffer for a null-terminated wide string and returns a pointer +// to the first character of the string. +begin + WideSize := SizeOf(WideChar) * WideSize + SizeOf(Cardinal); + Result := AllocMem(WideSize); + Cardinal(Pointer(Result)^) := WideSize; + Inc(Result, SizeOf(Cardinal) div SizeOf(WideChar)); +end; + +function StrBufSizeW(const Str: PWideChar): Cardinal; +// 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(Cardinal) div SizeOf(WideChar)); + Result := (Cardinal(PInteger(P)^) - SizeOf(Cardinal)) div SizeOf(WideChar); + end + else + Result := 0; +end; + +function StrNewW(const Str: PWideChar): PWideChar; +// Duplicates the given string (if not nil) and returns the address of the new string. +var + Size: Cardinal; +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(Cardinal) div SizeOf(WideChar)); + FreeMem(Str); + end; +end; + +procedure StrDisposeAndNilW(var Str: PWideChar); +begin + StrDisposeW(Str); + Str := nil; +end; + +// 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 + +procedure StrSwapByteOrder(Str: PWideChar); +asm + 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 +end; + +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, (Integer(Dest) - Integer(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: Integer; +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: Integer; +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: Cardinal): WideString; +// returns a string of Count characters filled with C +var + I: Integer; +begin + SetLength(Result, Count); + for I := 1 to Count do + Result[I] := C; +end; + +function WideTrim(const S: WideString): WideString; +var + I, L: Integer; +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: Integer; +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: Integer; +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: Integer): Integer; +asm + TEST EAX,EAX // make sure we are not null + JZ @@StrIsNil + DEC ECX // make index zero based + JL @@IdxIsSmall + PUSH EBX + PUSH EDI + MOV EDI, EAX // EDI := S + XOR EAX, EAX + MOV AX, DX // AX := Ch + MOV EDX, [EDI - 4] // EDX := Length(S) * 2 + SHR EDX, 1 // EDX := EDX div 2 + MOV EBX, EDX // save the length to calc. result + SUB EDX, ECX // EDX = EDX - Index = # of chars to scan + JLE @@IdxIsBig + SHL ECX, 1 // two bytes per char + ADD EDI, ECX // point to index'th char + MOV ECX, EDX // loop counter + REPNE SCASW + JNE @@NoMatch + MOV EAX, EBX // result := saved length - + SUB EAX, ECX // loop counter value + POP EDI + POP EBX + RET +@@IdxIsBig: +@@NoMatch: + XOR EAX,EAX + POP EDI + POP EBX + RET +@@IdxIsSmall: + XOR EAX, EAX +@@StrIsNil: +end; + +function WideComposeHangul(const Source: WideString): WideString; +var + Len: Integer; + Ch, Last: WideChar; + I: Integer; + LIndex, VIndex, + SIndex, TIndex: Integer; +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): WideString; +var + StarterPos, + CompPos, + DecompPos: Integer; + Composite: UCS4; + Ch, + StarterChar: WideChar; + LastClass, + CurrentClass: Cardinal; +begin + // Set an arbitrary length for the result. This is automatically done when checking + // for hangul composition. + Result := WideComposeHangul(S); + + if Result = '' then + Exit; + + StarterPos := 1; + CompPos := 2; + + StarterChar := Result[StarterPos]; + LastClass := CanonicalCombiningClass(UCS4(StarterChar)); + if LastClass <> 0 then + LastClass := 256; // fix for irregular combining sequence + + // Loop on the (decomposed) characters, combining where possible. + for DecompPos := 2 to Length(Result) do + begin + Ch := Result[DecompPos]; + CurrentClass := CanonicalCombiningClass(UCS4(Ch)); + if UnicodeComposePair(UCS4(StarterChar), UCS4(Ch), Composite) and + ((LastClass < CurrentClass) or (LastClass = 0)) then + begin + Result[StarterPos] := UCS2(Composite); + StarterChar := UCS2(Composite); + end + else + begin + if CurrentClass = 0 then + begin + StarterPos := CompPos; + StarterChar := Ch; + end; + LastClass := CurrentClass; + Result[CompPos] := Ch; + Inc(CompPos); + end; + end; + // since we have likely shortened the source string we have to set the correct length on exit + SetLength(Result, CompPos - 1); +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: Integer; + 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; + +procedure GetDecompositions(Compatible: Boolean; Code: UCS4; var Buffer: TUCS4Array); +// helper function to recursively decompose a code point +var + Decomp: TUCS4Array; + I: Integer; +begin + Decomp := UnicodeDecompose(Code, Compatible); + if Assigned(Decomp) then + begin + for I := 0 to High(Decomp) do + GetDecompositions(Compatible, Decomp[I], Buffer); + end + else // if no decomp, append + begin + I := Length(Buffer); + SetLength(Buffer, I + 1); + Buffer[I] := Code; + 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: Integer; + Decomp: TUCS4Array; +begin + Result := ''; + Decomp := nil; + + // iterate through each source code point + for I := 1 to Length(S) do + begin + Decomp := nil; + GetDecompositions(Compatible, UCS4(S[I]), Decomp); + 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; + +//----------------- general purpose case mapping --------------------------------------------------- + +// 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. +var + I: Integer; + Mapping: TUCS4Array; +begin + Mapping := UnicodeCaseFold(UCS4(C)); + SetLength(Result, Length(Mapping)); + for I := 0 to High(Mapping) do + Result[I + 1] := WideChar(Mapping[I]); +end; + +function WideCaseFolding(const S: WideString): WideString; +var + I: Integer; +begin + Result := ''; + for I := 1 to Length(S) do + Result := Result + WideCaseFolding(S[I]); +end; + +function WideLowerCase(C: WideChar): WideString; +var + I: Integer; + Mapping: TUCS4Array; +begin + Mapping := UnicodeToLower(UCS4(C)); + SetLength(Result, Length(Mapping)); + for I := 0 to High(Mapping) do + Result[I + 1] := WideChar(Mapping[I]); +end; + +function WideLowerCase(const S: WideString): WideString; +var + I: Integer; +begin + Result := ''; + for I := 1 to Length(S) do + Result := Result + WideLowerCase(S[I]); +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); + end; +end; + +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; + +function WideTitleCase(C: WideChar): WideString; +var + I: Integer; + Mapping: TUCS4Array; +begin + Mapping := UnicodeToTitle(UCS4(C)); + SetLength(Result, Length(Mapping)); + for I := 0 to High(Mapping) do + Result[I + 1] := WideChar(Mapping[I]); +end; + +function WideTitleCase(const S: WideString): WideString; +var + I: Integer; +begin + Result := ''; + for I := 1 to Length(S) do + Result := Result + WideTitleCase(S[I]); +end; + +function WideUpperCase(C: WideChar): WideString; +var + I: Integer; + Mapping: TUCS4Array; +begin + Mapping := UnicodeToUpper(UCS4(C)); + SetLength(Result, Length(Mapping)); + for I := 0 to High(Mapping) do + Result[I + 1] := WideChar(Mapping[I]); +end; + +function WideUpperCase(const S: WideString): WideString; +var + I: Integer; +begin + Result := ''; + for I := 1 to Length(S) do + Result := Result + WideUpperCase(S[I]); +end; + +//----------------- character test routines -------------------------------------------------------- + +function UnicodeIsAlpha(C: UCS4): Boolean; // Is the character alphabetic? +begin + Result := CategoryLookup(C, ClassLetter); +end; + +function UnicodeIsDigit(C: UCS4): Boolean; // Is the character a digit? +begin + Result := CategoryLookup(C, [ccNumberDecimalDigit]); +end; + +function UnicodeIsAlphaNum(C: UCS4): Boolean; // Is the character alphabetic or a number? +begin + Result := CategoryLookup(C, ClassLetter + [ccNumberDecimalDigit]); +end; + +function UnicodeIsCased(C: UCS4): Boolean; +// Is the character a "cased" character, i.e. either lower case, title case or upper case +begin + Result := CategoryLookup(C, [ccLetterLowercase, ccLetterTitleCase, ccLetterUppercase]); +end; + +function UnicodeIsControl(C: UCS4): Boolean; +// Is the character a control character? +begin + Result := CategoryLookup(C, [ccOtherControl, ccOtherFormat]); +end; + +function UnicodeIsSpace(C: UCS4): Boolean; +// Is the character a spacing character? +begin + Result := CategoryLookup(C, ClassSpace); +end; + +function UnicodeIsWhiteSpace(C: UCS4): Boolean; +// Is the character a white space character (same as UnicodeIsSpace plus +// tabulator, new line etc.)? +begin + Result := CategoryLookup(C, ClassSpace + [ccWhiteSpace, ccSegmentSeparator]); +end; + +function UnicodeIsBlank(C: UCS4): Boolean; +// Is the character a space separator? +begin + Result := CategoryLookup(C, [ccSeparatorSpace]); +end; + +function UnicodeIsPunctuation(C: UCS4): Boolean; +// Is the character a punctuation mark? +begin + Result := CategoryLookup(C, ClassPunctuation); +end; + +function UnicodeIsGraph(C: UCS4): Boolean; +// Is the character graphical? +begin + Result := CategoryLookup(C, ClassMark + ClassNumber + ClassLetter + ClassPunctuation + ClassSymbol); +end; + +function UnicodeIsPrintable(C: UCS4): Boolean; +// Is the character printable? +begin + Result := CategoryLookup(C, ClassMark + ClassNumber + ClassLetter + ClassPunctuation + ClassSymbol + + [ccSeparatorSpace]); +end; + +function UnicodeIsUpper(C: UCS4): Boolean; +// Is the character already upper case? +begin + Result := CategoryLookup(C, [ccLetterUppercase]); +end; + +function UnicodeIsLower(C: UCS4): Boolean; +// Is the character already lower case? +begin + Result := CategoryLookup(C, [ccLetterLowercase]); +end; + +function UnicodeIsTitle(C: UCS4): Boolean; +// Is the character already title case? +begin + Result := CategoryLookup(C, [ccLetterTitlecase]); +end; + +function UnicodeIsHexDigit(C: UCS4): Boolean; +// Is the character a hex digit? +begin + Result := CategoryLookup(C, [ccHexDigit]); +end; + +function UnicodeIsIsoControl(C: UCS4): Boolean; +// Is the character a C0 control character (< 32)? +begin + Result := CategoryLookup(C, [ccOtherControl]); +end; + +function UnicodeIsFormatControl(C: UCS4): Boolean; +// Is the character a format control character? +begin + Result := CategoryLookup(C, [ccOtherFormat]); +end; + +function UnicodeIsSymbol(C: UCS4): Boolean; +// Is the character a symbol? +begin + Result := CategoryLookup(C, ClassSymbol); +end; + +function UnicodeIsNumber(C: UCS4): Boolean; +// Is the character a number or digit? +begin + Result := CategoryLookup(C, ClassNumber); +end; + +function UnicodeIsNonSpacing(C: UCS4): Boolean; +// Is the character non-spacing? +begin + Result := CategoryLookup(C, [ccMarkNonSpacing]); +end; + +function UnicodeIsOpenPunctuation(C: UCS4): Boolean; +// Is the character an open/left punctuation (e.g. '[')? +begin + Result := CategoryLookup(C, [ccPunctuationOpen]); +end; + +function UnicodeIsClosePunctuation(C: UCS4): Boolean; +// Is the character an close/right punctuation (e.g. ']')? +begin + Result := CategoryLookup(C, [ccPunctuationClose]); +end; + +function UnicodeIsInitialPunctuation(C: UCS4): Boolean; +// Is the character an initial punctuation (e.g. U+2018 LEFT SINGLE QUOTATION MARK)? +begin + Result := CategoryLookup(C, [ccPunctuationInitialQuote]); +end; + +function UnicodeIsFinalPunctuation(C: UCS4): Boolean; +// Is the character a final punctuation (e.g. U+2019 RIGHT SINGLE QUOTATION MARK)? +begin + Result := CategoryLookup(C, [ccPunctuationFinalQuote]); +end; + +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; + +function UnicodeIsLetterNumber(C: UCS4): Boolean; +// Is the character a number represented by a letter? +begin + Result := CategoryLookup(C, [ccNumberLetter]); +end; + +function UnicodeIsConnectionPunctuation(C: UCS4): Boolean; +// Is the character connecting punctuation? +begin + Result := CategoryLookup(C, [ccPunctuationConnector]); +end; + +function UnicodeIsDash(C: UCS4): Boolean; +// Is the character a dash punctuation? +begin + Result := CategoryLookup(C, [ccPunctuationDash]); +end; + +function UnicodeIsMath(C: UCS4): Boolean; +// Is the character a math character? +begin + Result := CategoryLookup(C, [ccSymbolMath]); +end; + +function UnicodeIsCurrency(C: UCS4): Boolean; +// Is the character a currency character? +begin + Result := CategoryLookup(C, [ccSymbolCurrency]); +end; + +function UnicodeIsModifierSymbol(C: UCS4): Boolean; +// Is the character a modifier symbol? +begin + Result := CategoryLookup(C, [ccSymbolModifier]); +end; + +function UnicodeIsNonSpacingMark(C: UCS4): Boolean; +// Is the character a non-spacing mark? +begin + Result := CategoryLookup(C, [ccMarkNonSpacing]); +end; + +function UnicodeIsSpacingMark(C: UCS4): Boolean; +// Is the character a spacing mark? +begin + Result := CategoryLookup(C, [ccMarkSpacingCombining]); +end; + +function UnicodeIsEnclosing(C: UCS4): Boolean; +// Is the character enclosing (i.e. enclosing box)? +begin + Result := CategoryLookup(C, [ccMarkEnclosing]); +end; + +function UnicodeIsPrivate(C: UCS4): Boolean; +// Is the character from the Private Use Area? +begin + Result := CategoryLookup(C, [ccOtherPrivate]); +end; + +function UnicodeIsSurrogate(C: UCS4): Boolean; +// Is the character one of the surrogate codes? +begin + Result := CategoryLookup(C, [ccOtherSurrogate]); +end; + +function UnicodeIsLineSeparator(C: UCS4): Boolean; +// Is the character a line separator? +begin + Result := CategoryLookup(C, [ccSeparatorLine]); +end; + +function UnicodeIsParagraphSeparator(C: UCS4): Boolean; +// Is th character a paragraph separator; +begin + Result := CategoryLookup(C, [ccSeparatorParagraph]); +end; + +function UnicodeIsIdentifierStart(C: UCS4): Boolean; +// Can the character begin an identifier? +begin + Result := CategoryLookup(C, ClassLetter + [ccNumberLetter]); +end; + +function UnicodeIsIdentifierPart(C: UCS4): Boolean; +// Can the character appear in an identifier? +begin + Result := CategoryLookup(C, ClassLetter + [ccNumberLetter, ccMarkNonSpacing, ccMarkSpacingCombining, + ccNumberDecimalDigit, ccPunctuationConnector, ccOtherFormat]); +end; + +function UnicodeIsDefined(C: UCS4): Boolean; +// Is the character defined (appears in one of the data files)? +begin + Result := CategoryLookup(C, [ccAssigned]); +end; + +function UnicodeIsUndefined(C: UCS4): Boolean; +// Is the character undefined (not assigned in the Unicode database)? +begin + Result := not CategoryLookup(C, [ccAssigned]); +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; + +// 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: PDWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; stdcall; + external 'gdi32.dll' name 'TranslateCharsetInfo'; + +function GetCharSetFromLocale(Language: LCID; out FontCharSet: TFontCharSet): Boolean; +var + CP: Cardinal; + CSI: TCharsetInfo; +begin + CP:= CodePageFromLocale(Language); + Result := TranslateCharsetInfoEx(Pointer(CP), CSI, TCI_SRCCODEPAGE); + if Result then + FontCharset := CSI.ciCharset; +end; + +function CharSetFromLocale(Language: LCID): TFontCharSet; +begin + if not GetCharSetFromLocale(Language, Result) then + RaiseLastOSError; +end; + +function CodePageFromLocale(Language: LCID): Integer; +// 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/4.1.0/ucd/Blocks.txt +begin + case CB of + ubBasicLatin: + begin + Result.RangeStart := $0000; + Result.RangeEnd := $007F; + end; + ubLatin1Supplement: + begin + Result.RangeStart := $0080; + Result.RangeEnd := $00FF; + end; + ubLatinExtendedA: + begin + Result.RangeStart := $0100; + Result.RangeEnd := $017F; + end; + ubLatinExtendedB: + begin + Result.RangeStart := $0180; + Result.RangeEnd := $024F; + end; + ubIPAExtensions: + begin + Result.RangeStart := $0250; + Result.RangeEnd := $02AF; + end; + ubSpacingModifierLetters: + begin + Result.RangeStart := $02B0; + Result.RangeEnd := $02FF; + end; + ubCombiningDiacriticalMarks: + begin + Result.RangeStart := $0300; + Result.RangeEnd := $036F; + end; + ubGreek: + begin + Result.RangeStart := $0370; + Result.RangeEnd := $03FF; + end; + ubCyrillic: + begin + Result.RangeStart := $0400; + Result.RangeEnd := $04FF; + end; + ubCyrillicSupplement: + begin + Result.RangeStart := $0500; + Result.RangeEnd := $052F; + end; + ubArmenian: + begin + Result.RangeStart := $0530; + Result.RangeEnd := $058F; + end; + ubHebrew: + begin + Result.RangeStart := $0590; + Result.RangeEnd := $05FF; + end; + ubArabic: + begin + Result.RangeStart := $0600; + Result.RangeEnd := $06FF; + end; + ubSyriac: + begin + Result.RangeStart := $0700; + Result.RangeEnd := $074F; + end; + ubArabicSupplement: + begin + Result.RangeStart := $0750; + Result.RangeEnd := $077F; + end; + ubThaana: + begin + Result.RangeStart := $0780; + Result.RangeEnd := $07BF; + end; + ubDevanagari: + begin + Result.RangeStart := $0900; + Result.RangeEnd := $097F; + end; + ubBengali: + begin + Result.RangeStart := $0980; + Result.RangeEnd := $09FF; + end; + ubGurmukhi: + begin + Result.RangeStart := $0A00; + Result.RangeEnd := $0A7F; + end; + ubGujarati: + begin + Result.RangeStart := $0A80; + Result.RangeEnd := $0AFF; + end; + ubOriya: + begin + Result.RangeStart := $0B00; + Result.RangeEnd := $0B7F; + end; + ubTamil: + begin + Result.RangeStart := $0B80; + Result.RangeEnd := $0BFF; + end; + ubTelugu: + begin + Result.RangeStart := $0C00; + Result.RangeEnd := $0C7F; + end; + ubKannada: + begin + Result.RangeStart := $0C80; + Result.RangeEnd := $0CFF; + end; + ubMalayalam: + begin + Result.RangeStart := $0D00; + Result.RangeEnd := $0D7F; + end; + ubSinhala: + begin + Result.RangeStart := $0D80; + Result.RangeEnd := $0DFF; + end; + ubThai: + begin + Result.RangeStart := $0E00; + Result.RangeEnd := $0E7F; + end; + ubLao: + begin + Result.RangeStart := $0E80; + Result.RangeEnd := $0EFF; + end; + ubTibetan: + begin + Result.RangeStart := $0F00; + Result.RangeEnd := $0FFF; + end; + ubMyanmar: + begin + Result.RangeStart := $1000; + Result.RangeEnd := $109F; + end; + ubGeorgian: + begin + Result.RangeStart := $10A0; + Result.RangeEnd := $10FF; + end; + ubHangulJamo: + begin + Result.RangeStart := $1100; + Result.RangeEnd := $11FF; + end; + ubEthiopic: + begin + Result.RangeStart := $1200; + Result.RangeEnd := $137F; + end; + ubEthiopicSupplement: + begin + Result.RangeStart := $1380; + Result.RangeEnd := $139F; + end; + ubCherokee: + begin + Result.RangeStart := $13A0; + Result.RangeEnd := $13FF; + end; + ubUnifiedCanadianAboriginalSyllabics: + begin + Result.RangeStart := $1400; + Result.RangeEnd := $167F; + end; + ubOgham: + begin + Result.RangeStart := $1680; + Result.RangeEnd := $169F; + end; + ubRunic: + begin + Result.RangeStart := $16A0; + Result.RangeEnd := $16FF; + end; + ubTagalog: + begin + Result.RangeStart := $1700; + Result.RangeEnd := $171F; + end; + ubHanunoo: + begin + Result.RangeStart := $1720; + Result.RangeEnd := $173F; + end; + ubBuhid: + begin + Result.RangeStart := $1740; + Result.RangeEnd := $175F; + end; + ubTagbanwa: + begin + Result.RangeStart := $1760; + Result.RangeEnd := $177F; + end; + ubKhmer: + begin + Result.RangeStart := $1780; + Result.RangeEnd := $17FF; + end; + ubMongolian: + begin + Result.RangeStart := $1800; + Result.RangeEnd := $18AF; + end; + ubLimbu: + begin + Result.RangeStart := $1900; + Result.RangeEnd := $194F; + end; + ubTaiLe: + begin + Result.RangeStart := $1950; + Result.RangeEnd := $197F; + end; + ubNewTaiLue: + begin + Result.RangeStart := $1980; + Result.RangeEnd := $19DF; + end; + ubKhmerSymbols: + begin + Result.RangeStart := $19E0; + Result.RangeEnd := $19FF; + end; + ubBuginese: + begin + Result.RangeStart := $1A00; + Result.RangeEnd := $1A1F; + end; + ubPhoneticExtensions: + begin + Result.RangeStart := $1D00; + Result.RangeEnd := $1D7F; + end; + ubPhoneticExtensionsSupplement: + begin + Result.RangeStart := $1D80; + Result.RangeEnd := $1DBF; + end; + ubCombiningDiacriticalMarksSupplement: + begin + Result.RangeStart := $1DC0; + Result.RangeEnd := $1DFF; + end; + ubLatinExtendedAdditional: + begin + Result.RangeStart := $1E00; + Result.RangeEnd := $1EFF; + end; + ubGreekExtended: + begin + Result.RangeStart := $1F00; + Result.RangeEnd := $1FFF; + end; + ubGeneralPunctuation: + begin + Result.RangeStart := $2000; + Result.RangeEnd := $206F; + end; + ubSuperscriptsandSubscripts: + begin + Result.RangeStart := $2070; + Result.RangeEnd := $209F; + end; + ubCurrencySymbols: + begin + Result.RangeStart := $20A0; + Result.RangeEnd := $20CF; + end; + ubCombiningMarksforSymbols: + begin + Result.RangeStart := $20D0; + Result.RangeEnd := $20FF; + end; + ubLetterlikeSymbols: + begin + Result.RangeStart := $2100; + Result.RangeEnd := $214F; + end; + ubNumberForms: + begin + Result.RangeStart := $2150; + Result.RangeEnd := $218F; + end; + ubArrows: + begin + Result.RangeStart := $2190; + Result.RangeEnd := $21FF; + end; + ubMathematicalOperators: + begin + Result.RangeStart := $2200; + Result.RangeEnd := $22FF; + end; + ubMiscellaneousTechnical: + begin + Result.RangeStart := $2300; + Result.RangeEnd := $23FF; + end; + ubControlPictures: + begin + Result.RangeStart := $2400; + Result.RangeEnd := $243F; + end; + ubOpticalCharacterRecognition: + begin + Result.RangeStart := $2440; + Result.RangeEnd := $245F; + end; + ubEnclosedAlphanumerics: + begin + Result.RangeStart := $2460; + Result.RangeEnd := $24FF; + end; + ubBoxDrawing: + begin + Result.RangeStart := $2500; + Result.RangeEnd := $257F; + end; + ubBlockElements: + begin + Result.RangeStart := $2580; + Result.RangeEnd := $259F; + end; + ubGeometricShapes: + begin + Result.RangeStart := $25A0; + Result.RangeEnd := $25FF; + end; + ubMiscellaneousSymbols: + begin + Result.RangeStart := $2600; + Result.RangeEnd := $26FF; + end; + ubDingbats: + begin + Result.RangeStart := $2700; + Result.RangeEnd := $27BF; + end; + ubMiscellaneousMathematicalSymbolsA: + begin + Result.RangeStart := $27C0; + Result.RangeEnd := $27EF; + end; + ubSupplementalArrowsA: + begin + Result.RangeStart := $27F0; + Result.RangeEnd := $27FF; + end; + ubBraillePatterns: + begin + Result.RangeStart := $2800; + Result.RangeEnd := $28FF; + end; + ubSupplementalArrowsB: + begin + Result.RangeStart := $2900; + Result.RangeEnd := $297F; + end; + ubMiscellaneousMathematicalSymbolsB: + begin + Result.RangeStart := $2980; + Result.RangeEnd := $29FF; + end; + ubSupplementalMathematicalOperators: + begin + Result.RangeStart := $2A00; + Result.RangeEnd := $2AFF; + end; + ubMiscellaneousSymbolsandArrows: + begin + Result.RangeStart := $2B00; + Result.RangeEnd := $2BFF; + end; + ubGlagolitic: + begin + Result.RangeStart := $2C00; + Result.RangeEnd := $2C5F; + end; + ubCoptic: + begin + Result.RangeStart := $2C80; + Result.RangeEnd := $2CFF; + end; + ubGeorgianSupplement: + begin + Result.RangeStart := $2D00; + Result.RangeEnd := $2D2F; + end; + ubTifinagh: + begin + Result.RangeStart := $2D30; + Result.RangeEnd := $2D7F; + end; + ubEthiopicExtended: + begin + Result.RangeStart := $2D80; + Result.RangeEnd := $2DDF; + end; + ubSupplementalPunctuation: + begin + Result.RangeStart := $2E00; + Result.RangeEnd := $2E7F; + end; + ubCJKRadicalsSupplement: + begin + Result.RangeStart := $2E80; + Result.RangeEnd := $2EFF; + end; + ubKangxiRadicals: + begin + Result.RangeStart := $2F00; + Result.RangeEnd := $2FDF; + end; + ubIdeographicDescriptionCharacters: + begin + Result.RangeStart := $2FF0; + Result.RangeEnd := $2FFF; + end; + ubCJKSymbolsandPunctuation: + begin + Result.RangeStart := $3000; + Result.RangeEnd := $303F; + end; + ubHiragana: + begin + Result.RangeStart := $3040; + Result.RangeEnd := $309F; + end; + ubKatakana: + begin + Result.RangeStart := $30A0; + Result.RangeEnd := $30FF; + end; + ubBopomofo: + begin + Result.RangeStart := $3100; + Result.RangeEnd := $312F; + end; + ubHangulCompatibilityJamo: + begin + Result.RangeStart := $3130; + Result.RangeEnd := $318F; + end; + ubKanbun: + begin + Result.RangeStart := $3190; + Result.RangeEnd := $319F; + end; + ubBopomofoExtended: + begin + Result.RangeStart := $31A0; + Result.RangeEnd := $31BF; + end; + ubCJKStrokes: + begin + Result.RangeStart := $31C0; + Result.RangeEnd := $31EF; + end; + ubKatakanaPhoneticExtensions: + begin + Result.RangeStart := $31F0; + Result.RangeEnd := $31FF; + end; + ubEnclosedCJKLettersandMonths: + begin + Result.RangeStart := $3200; + Result.RangeEnd := $32FF; + end; + ubCJKCompatibility: + begin + Result.RangeStart := $3300; + Result.RangeEnd := $33FF; + end; + ubCJKUnifiedIdeographsExtensionA: + begin + Result.RangeStart := $3400; + Result.RangeEnd := $4DBF; + end; + ubYijingHexagramSymbols: + begin + Result.RangeStart := $4DC0; + Result.RangeEnd := $4DFF; + end; + ubCJKUnifiedIdeographs: + begin + Result.RangeStart := $4E00; + Result.RangeEnd := $9FFF; + end; + ubYiSyllables: + begin + Result.RangeStart := $A000; + Result.RangeEnd := $A48F; + end; + ubYiRadicals: + begin + Result.RangeStart := $A490; + Result.RangeEnd := $A4CF; + end; + ubModifierToneLetters: + begin + Result.RangeStart := $A700; + Result.RangeEnd := $A71F; + end; + ubSylotiNagri: + begin + Result.RangeStart := $A800; + Result.RangeEnd := $A82F; + end; + ubHangulSyllables: + begin + Result.RangeStart := $AC00; + Result.RangeEnd := $D7AF; + end; + ubHighSurrogates: + begin + Result.RangeStart := $D800; + Result.RangeEnd := $DB7F; + end; + ubHighPrivateUseSurrogates: + begin + Result.RangeStart := $DB80; + Result.RangeEnd := $DBFF; + end; + ubLowSurrogates: + begin + Result.RangeStart := $DC00; + Result.RangeEnd := $DFFF; + end; + ubPrivateUse: + begin + Result.RangeStart := $E000; + Result.RangeEnd := $F8FF; + end; + ubCJKCompatibilityIdeographs: + begin + Result.RangeStart := $F900; + Result.RangeEnd := $FAFF; + end; + ubAlphabeticPresentationForms: + begin + Result.RangeStart := $FB00; + Result.RangeEnd := $FB4F; + end; + ubArabicPresentationFormsA: + begin + Result.RangeStart := $FB50; + Result.RangeEnd := $FDFF; + end; + ubVariationSelectors: + begin + Result.RangeStart := $FE00; + Result.RangeEnd := $FE0F; + end; + ubVerticalForms: + begin + Result.RangeStart := $FE10; + Result.RangeEnd := $FE1F; + end; + ubCombiningHalfMarks: + begin + Result.RangeStart := $FE20; + Result.RangeEnd := $FE2F; + end; + ubCJKCompatibilityForms: + begin + Result.RangeStart := $FE30; + Result.RangeEnd := $FE4F; + end; + ubSmallFormVariants: + begin + Result.RangeStart := $FE50; + Result.RangeEnd := $FE6F; + end; + ubArabicPresentationFormsB: + begin + Result.RangeStart := $FE70; + Result.RangeEnd := $FEFF; + end; + ubHalfwidthandFullwidthForms: + begin + Result.RangeStart := $FF00; + Result.RangeEnd := $FFEF; + end; + ubSpecials: + begin + Result.RangeStart := $FFF0; + Result.RangeEnd := $FFFF; + end; + ubLinearBSyllabary: + begin + Result.RangeStart := $10000; + Result.RangeEnd := $1007F; + end; + ubLinearBIdeograms: + begin + Result.RangeStart := $10080; + Result.RangeEnd := $100FF; + end; + ubAegeanNumbers: + begin + Result.RangeStart := $10100; + Result.RangeEnd := $1013F; + end; + ubAncientGreekNumbers: + begin + Result.RangeStart := $10140; + Result.RangeEnd := $1018F; + end; + ubOldItalic: + begin + Result.RangeStart := $10300; + Result.RangeEnd := $1032F; + end; + ubGothic: + begin + Result.RangeStart := $10330; + Result.RangeEnd := $1034F; + end; + ubUgaritic: + begin + Result.RangeStart := $10380; + Result.RangeEnd := $1039F; + end; + ubOldPersian: + begin + Result.RangeStart := $103A0; + Result.RangeEnd := $103DF; + end; + ubDeseret: + begin + Result.RangeStart := $10400; + Result.RangeEnd := $1044F; + end; + ubShavian: + begin + Result.RangeStart := $10450; + Result.RangeEnd := $1047F; + end; + ubOsmanya: + begin + Result.RangeStart := $10480; + Result.RangeEnd := $104AF; + end; + ubCypriotSyllabary: + begin + Result.RangeStart := $10800; + Result.RangeEnd := $1083F; + end; + ubKharoshthi: + begin + Result.RangeStart := $10A00; + Result.RangeEnd := $10A5F; + end; + ubByzantineMusicalSymbols: + begin + Result.RangeStart := $1D000; + Result.RangeEnd := $1D0FF; + end; + ubMusicalSymbols: + begin + Result.RangeStart := $1D100; + Result.RangeEnd := $1D1FF; + end; + ubAncientGreekMusicalNotation: + begin + Result.RangeStart := $1D200; + Result.RangeEnd := $1D24F; + end; + ubTaiXuanJingSymbols: + begin + Result.RangeStart := $1D300; + Result.RangeEnd := $1D35F; + end; + ubMathematicalAlphanumericSymbols: + begin + Result.RangeStart := $1D400; + Result.RangeEnd := $1D7FF; + end; + ubCJKUnifiedIdeographsExtensionB: + begin + Result.RangeStart := $20000; + Result.RangeEnd := $2A6DF; + end; + ubCJKCompatibilityIdeographsSupplement: + begin + Result.RangeStart := $2F800; + Result.RangeEnd := $2FA1F; + end; + ubTags: + begin + Result.RangeStart := $E0000; + Result.RangeEnd := $E007F; + end; + ubVariationSelectorsSupplement: + begin + Result.RangeStart := $E0100; + Result.RangeEnd := $E01EF; + end; + ubSupplementaryPrivateUseAreaA: + begin + Result.RangeStart := $F0000; + Result.RangeEnd := $FFFFF; + end; + ubSupplementaryPrivateUseAreaB: + begin + Result.RangeStart := $100000; + Result.RangeEnd := $10FFFF; + end; + else + begin + Result.RangeStart := 0; + Result.RangeEnd := 0; + end; + end; +end; + + +// Returns the CodeBlockName of the Block specified by CB +// Names taken from http://www.unicode.org/Public/4.1.0/ucd/Blocks.txt +function CodeBlockName(const CB: TUnicodeBlock): string; +begin + case CB of + ubBasicLatin: + Result := 'Basic Latin'; + ubLatin1Supplement: + Result := 'Latin-1 Supplement'; + ubLatinExtendedA: + Result := 'Latin Extended-A'; + ubLatinExtendedB: + Result := 'Latin Extended-B'; + ubIPAExtensions: + Result := 'IPA Extensions'; + ubSpacingModifierLetters: + Result := 'Spacing Modifier Letters'; + ubCombiningDiacriticalMarks: + Result := 'Combining Diacritical Marks'; + //ubGreekandCoptic: + ubGreek: + Result := 'Greek and Coptic'; + ubCyrillic: + Result := 'Cyrillic'; + ubCyrillicSupplement: + Result := 'Cyrillic Supplement'; + ubArmenian: + Result := 'Armenian'; + ubHebrew: + Result := 'Hebrew'; + ubArabic: + Result := 'Arabic'; + ubSyriac: + Result := 'Syriac'; + ubArabicSupplement: + Result := 'Arabic Supplement'; + ubThaana: + Result := 'Thaana'; + ubDevanagari: + Result := 'Devanagari'; + ubBengali: + Result := 'Bengali'; + ubGurmukhi: + Result := 'Gurmukhi'; + ubGujarati: + Result := 'Gujarati'; + ubOriya: + Result := 'Oriya'; + ubTamil: + Result := 'Tamil'; + ubTelugu: + Result := 'Telugu'; + ubKannada: + Result := 'Kannada'; + ubMalayalam: + Result := 'Malayalam'; + ubSinhala: + Result := 'Sinhala'; + ubThai: + Result := 'Thai'; + ubLao: + Result := 'Lao'; + ubTibetan: + Result := 'Tibetan'; + ubMyanmar: + Result := 'Myanmar'; + ubGeorgian: + Result := 'Georgian'; + ubHangulJamo: + Result := 'Hangul Jamo'; + ubEthiopic: + Result := 'Ethiopic'; + ubEthiopicSupplement: + Result := 'Ethiopic Supplement'; + ubCherokee: + Result := 'Cherokee'; + ubUnifiedCanadianAboriginalSyllabics: + Result := 'Unified Canadian Aboriginal Syllabics'; + ubOgham: + Result := 'Ogham'; + ubRunic: + Result := 'Runic'; + ubTagalog: + Result := 'Tagalog'; + ubHanunoo: + Result := 'Hanunoo'; + ubBuhid: + Result := 'Buhid'; + ubTagbanwa: + Result := 'Tagbanwa'; + ubKhmer: + Result := 'Khmer'; + ubMongolian: + Result := 'Mongolian'; + ubLimbu: + Result := 'Limbu'; + ubTaiLe: + Result := 'Tai Le'; + ubNewTaiLue: + Result := 'New Tai Lue'; + ubKhmerSymbols: + Result := 'Khmer Symbols'; + ubBuginese: + Result := 'Buginese'; + ubPhoneticExtensions: + Result := 'Phonetic Extensions'; + ubPhoneticExtensionsSupplement: + Result := 'Phonetic Extensions Supplement'; + ubCombiningDiacriticalMarksSupplement: + Result := 'Combining Diacritical Marks Supplement'; + ubLatinExtendedAdditional: + Result := 'Latin Extended Additional'; + ubGreekExtended: + Result := 'Greek Extended'; + ubGeneralPunctuation: + Result := 'General Punctuation'; + ubSuperscriptsandSubscripts: + Result := 'Superscripts and Subscripts'; + ubCurrencySymbols: + Result := 'Currency Symbols'; + //ubCombiningDiacriticalMarksforSymbols: + ubCombiningMarksforSymbols: + Result := 'Combining Diacritical Marks for Symbols'; + ubLetterlikeSymbols: + Result := 'Letterlike Symbols'; + ubNumberForms: + Result := 'Number Forms'; + ubArrows: + Result := 'Arrows'; + ubMathematicalOperators: + Result := 'Mathematical Operators'; + ubMiscellaneousTechnical: + Result := 'Miscellaneous Technical'; + ubControlPictures: + Result := 'Control Pictures'; + ubOpticalCharacterRecognition: + Result := 'Optical Character Recognition'; + ubEnclosedAlphanumerics: + Result := 'Enclosed Alphanumerics'; + ubBoxDrawing: + Result := 'Box Drawing'; + ubBlockElements: + Result := 'Block Elements'; + ubGeometricShapes: + Result := 'Geometric Shapes'; + ubMiscellaneousSymbols: + Result := 'Miscellaneous Symbols'; + ubDingbats: + Result := 'Dingbats'; + ubMiscellaneousMathematicalSymbolsA: + Result := 'Miscellaneous Mathematical Symbols-A'; + ubSupplementalArrowsA: + Result := 'Supplemental Arrows-A'; + ubBraillePatterns: + Result := 'Braille Patterns'; + ubSupplementalArrowsB: + Result := 'Supplemental Arrows-B'; + ubMiscellaneousMathematicalSymbolsB: + Result := 'Miscellaneous Mathematical Symbols-B'; + ubSupplementalMathematicalOperators: + Result := 'Supplemental Mathematical Operators'; + ubMiscellaneousSymbolsandArrows: + Result := 'Miscellaneous Symbols and Arrows'; + ubGlagolitic: + Result := 'Glagolitic'; + ubCoptic: + Result := 'Coptic'; + ubGeorgianSupplement: + Result := 'Georgian Supplement'; + ubTifinagh: + Result := 'Tifinagh'; + ubEthiopicExtended: + Result := 'Ethiopic Extended'; + ubSupplementalPunctuation: + Result := 'Supplemental Punctuation'; + ubCJKRadicalsSupplement: + Result := 'CJK Radicals Supplement'; + ubKangxiRadicals: + Result := 'Kangxi Radicals'; + ubIdeographicDescriptionCharacters: + Result := 'Ideographic Description Characters'; + ubCJKSymbolsandPunctuation: + Result := 'CJK Symbols and Punctuation'; + ubHiragana: + Result := 'Hiragana'; + ubKatakana: + Result := 'Katakana'; + ubBopomofo: + Result := 'Bopomofo'; + ubHangulCompatibilityJamo: + Result := 'Hangul Compatibility Jamo'; + ubKanbun: + Result := 'Kanbun'; + ubBopomofoExtended: + Result := 'Bopomofo Extended'; + ubCJKStrokes: + Result := 'CJK Strokes'; + ubKatakanaPhoneticExtensions: + Result := 'Katakana Phonetic Extensions'; + ubEnclosedCJKLettersandMonths: + Result := 'Enclosed CJK Letters and Months'; + ubCJKCompatibility: + Result := 'CJK Compatibility'; + ubCJKUnifiedIdeographsExtensionA: + Result := 'CJK Unified Ideographs Extension A'; + ubYijingHexagramSymbols: + Result := 'Yijing Hexagram Symbols'; + ubCJKUnifiedIdeographs: + Result := 'CJK Unified Ideographs'; + ubYiSyllables: + Result := 'Yi Syllables'; + ubYiRadicals: + Result := 'Yi Radicals'; + ubModifierToneLetters: + Result := 'Modifier Tone Letters'; + ubSylotiNagri: + Result := 'Syloti Nagri'; + ubHangulSyllables: + Result := 'Hangul Syllables'; + ubHighSurrogates: + Result := 'High Surrogates'; + ubHighPrivateUseSurrogates: + Result := 'High Private Use Surrogates'; + ubLowSurrogates: + Result := 'Low Surrogates'; + //ubPrivateUseArea: + ubPrivateUse: + Result := 'Private Use Area'; + ubCJKCompatibilityIdeographs: + Result := 'CJK Compatibility Ideographs'; + ubAlphabeticPresentationForms: + Result := 'Alphabetic Presentation Forms'; + ubArabicPresentationFormsA: + Result := 'Arabic Presentation Forms-A'; + ubVariationSelectors: + Result := 'Variation Selectors'; + ubVerticalForms: + Result := 'Vertical Forms'; + ubCombiningHalfMarks: + Result := 'Combining Half Marks'; + ubCJKCompatibilityForms: + Result := 'CJK Compatibility Forms'; + ubSmallFormVariants: + Result := 'Small Form Variants'; + ubArabicPresentationFormsB: + Result := 'Arabic Presentation Forms-B'; + ubHalfwidthandFullwidthForms: + Result := 'Halfwidth and Fullwidth Forms'; + ubSpecials: + Result := 'Specials'; + ubLinearBSyllabary: + Result := 'Linear B Syllabary'; + ubLinearBIdeograms: + Result := 'Linear B Ideograms'; + ubAegeanNumbers: + Result := 'Aegean Numbers'; + ubAncientGreekNumbers: + Result := 'Ancient Greek Numbers'; + ubOldItalic: + Result := 'Old Italic'; + ubGothic: + Result := 'Gothic'; + ubUgaritic: + Result := 'Ugaritic'; + ubOldPersian: + Result := 'Old Persian'; + ubDeseret: + Result := 'Deseret'; + ubShavian: + Result := 'Shavian'; + ubOsmanya: + Result := 'Osmanya'; + ubCypriotSyllabary: + Result := 'Cypriot Syllabary'; + ubKharoshthi: + Result := 'Kharoshthi'; + ubByzantineMusicalSymbols: + Result := 'Byzantine Musical Symbols'; + ubMusicalSymbols: + Result := 'Musical Symbols'; + ubAncientGreekMusicalNotation: + Result := 'Ancient Greek Musical Notation'; + ubTaiXuanJingSymbols: + Result := 'Tai Xuan Jing Symbols'; + ubMathematicalAlphanumericSymbols: + Result := 'Mathematical Alphanumeric Symbols'; + ubCJKUnifiedIdeographsExtensionB: + Result := 'CJK Unified Ideographs Extension B'; + ubCJKCompatibilityIdeographsSupplement: + Result := 'CJK Compatibility Ideographs Supplement'; + ubTags: + Result := 'Tags'; + ubVariationSelectorsSupplement: + Result := 'Variation Selectors Supplement'; + ubSupplementaryPrivateUseAreaA: + Result := 'Supplementary Private Use Area-A'; + ubSupplementaryPrivateUseAreaB: + Result := 'Supplementary Private Use Area-B'; + else + Result := 'Undefined'; + end; +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 3.1. +function CodeBlockFromChar(const C: UCS4): TUnicodeBlock; +// http://www.unicode.org/Public/4.1.0/ucd/Blocks.txt +begin + case C of + $0000..$007F: + Result := ubBasicLatin; + $0080..$00FF: + Result := ubLatin1Supplement; + $0100..$017F: + Result := ubLatinExtendedA; + $0180..$024F: + Result := ubLatinExtendedB; + $0250..$02AF: + Result := ubIPAExtensions; + $02B0..$02FF: + Result := ubSpacingModifierLetters; + $0300..$036F: + Result := ubCombiningDiacriticalMarks; + $0370..$03FF: + Result := ubGreek; //ubGreekandCoptic; + $0400..$04FF: + Result := ubCyrillic; + $0500..$052F: + Result := ubCyrillicSupplement; + $0530..$058F: + Result := ubArmenian; + $0590..$05FF: + Result := ubHebrew; + $0600..$06FF: + Result := ubArabic; + $0700..$074F: + Result := ubSyriac; + $0750..$077F: + Result := ubArabicSupplement; + $0780..$07BF: + Result := ubThaana; + $0900..$097F: + Result := ubDevanagari; + $0980..$09FF: + Result := ubBengali; + $0A00..$0A7F: + Result := ubGurmukhi; + $0A80..$0AFF: + Result := ubGujarati; + $0B00..$0B7F: + Result := ubOriya; + $0B80..$0BFF: + Result := ubTamil; + $0C00..$0C7F: + Result := ubTelugu; + $0C80..$0CFF: + Result := ubKannada; + $0D00..$0D7F: + Result := ubMalayalam; + $0D80..$0DFF: + Result := ubSinhala; + $0E00..$0E7F: + Result := ubThai; + $0E80..$0EFF: + Result := ubLao; + $0F00..$0FFF: + Result := ubTibetan; + $1000..$109F: + Result := ubMyanmar; + $10A0..$10FF: + Result := ubGeorgian; + $1100..$11FF: + Result := ubHangulJamo; + $1200..$137F: + Result := ubEthiopic; + $1380..$139F: + Result := ubEthiopicSupplement; + $13A0..$13FF: + Result := ubCherokee; + $1400..$167F: + Result := ubUnifiedCanadianAboriginalSyllabics; + $1680..$169F: + Result := ubOgham; + $16A0..$16FF: + Result := ubRunic; + $1700..$171F: + Result := ubTagalog; + $1720..$173F: + Result := ubHanunoo; + $1740..$175F: + Result := ubBuhid; + $1760..$177F: + Result := ubTagbanwa; + $1780..$17FF: + Result := ubKhmer; + $1800..$18AF: + Result := ubMongolian; + $1900..$194F: + Result := ubLimbu; + $1950..$197F: + Result := ubTaiLe; + $1980..$19DF: + Result := ubNewTaiLue; + $19E0..$19FF: + Result := ubKhmerSymbols; + $1A00..$1A1F: + Result := ubBuginese; + $1D00..$1D7F: + Result := ubPhoneticExtensions; + $1D80..$1DBF: + Result := ubPhoneticExtensionsSupplement; + $1DC0..$1DFF: + Result := ubCombiningDiacriticalMarksSupplement; + $1E00..$1EFF: + Result := ubLatinExtendedAdditional; + $1F00..$1FFF: + Result := ubGreekExtended; + $2000..$206F: + Result := ubGeneralPunctuation; + $2070..$209F: + Result := ubSuperscriptsandSubscripts; + $20A0..$20CF: + Result := ubCurrencySymbols; + $20D0..$20FF: + Result := ubCombiningMarksforSymbols; //ubCombiningDiacriticalMarksforSymbols; + $2100..$214F: + Result := ubLetterlikeSymbols; + $2150..$218F: + Result := ubNumberForms; + $2190..$21FF: + Result := ubArrows; + $2200..$22FF: + Result := ubMathematicalOperators; + $2300..$23FF: + Result := ubMiscellaneousTechnical; + $2400..$243F: + Result := ubControlPictures; + $2440..$245F: + Result := ubOpticalCharacterRecognition; + $2460..$24FF: + Result := ubEnclosedAlphanumerics; + $2500..$257F: + Result := ubBoxDrawing; + $2580..$259F: + Result := ubBlockElements; + $25A0..$25FF: + Result := ubGeometricShapes; + $2600..$26FF: + Result := ubMiscellaneousSymbols; + $2700..$27BF: + Result := ubDingbats; + $27C0..$27EF: + Result := ubMiscellaneousMathematicalSymbolsA; + $27F0..$27FF: + Result := ubSupplementalArrowsA; + $2800..$28FF: + Result := ubBraillePatterns; + $2900..$297F: + Result := ubSupplementalArrowsB; + $2980..$29FF: + Result := ubMiscellaneousMathematicalSymbolsB; + $2A00..$2AFF: + Result := ubSupplementalMathematicalOperators; + $2B00..$2BFF: + Result := ubMiscellaneousSymbolsandArrows; + $2C00..$2C5F: + Result := ubGlagolitic; + $2C80..$2CFF: + Result := ubCoptic; + $2D00..$2D2F: + Result := ubGeorgianSupplement; + $2D30..$2D7F: + Result := ubTifinagh; + $2D80..$2DDF: + Result := ubEthiopicExtended; + $2E00..$2E7F: + Result := ubSupplementalPunctuation; + $2E80..$2EFF: + Result := ubCJKRadicalsSupplement; + $2F00..$2FDF: + Result := ubKangxiRadicals; + $2FF0..$2FFF: + Result := ubIdeographicDescriptionCharacters; + $3000..$303F: + Result := ubCJKSymbolsandPunctuation; + $3040..$309F: + Result := ubHiragana; + $30A0..$30FF: + Result := ubKatakana; + $3100..$312F: + Result := ubBopomofo; + $3130..$318F: + Result := ubHangulCompatibilityJamo; + $3190..$319F: + Result := ubKanbun; + $31A0..$31BF: + Result := ubBopomofoExtended; + $31C0..$31EF: + Result := ubCJKStrokes; + $31F0..$31FF: + Result := ubKatakanaPhoneticExtensions; + $3200..$32FF: + Result := ubEnclosedCJKLettersandMonths; + $3300..$33FF: + Result := ubCJKCompatibility; + $3400..$4DBF: + Result := ubCJKUnifiedIdeographsExtensionA; + $4DC0..$4DFF: + Result := ubYijingHexagramSymbols; + $4E00..$9FFF: + Result := ubCJKUnifiedIdeographs; + $A000..$A48F: + Result := ubYiSyllables; + $A490..$A4CF: + Result := ubYiRadicals; + $A700..$A71F: + Result := ubModifierToneLetters; + $A800..$A82F: + Result := ubSylotiNagri; + $AC00..$D7AF: + Result := ubHangulSyllables; + $D800..$DB7F: + Result := ubHighSurrogates; + $DB80..$DBFF: + Result := ubHighPrivateUseSurrogates; + $DC00..$DFFF: + Result := ubLowSurrogates; + $E000..$F8FF: + Result := ubPrivateUse; //ubPrivateUseArea; + $F900..$FAFF: + Result := ubCJKCompatibilityIdeographs; + $FB00..$FB4F: + Result := ubAlphabeticPresentationForms; + $FB50..$FDFF: + Result := ubArabicPresentationFormsA; + $FE00..$FE0F: + Result := ubVariationSelectors; + $FE10..$FE1F: + Result := ubVerticalForms; + $FE20..$FE2F: + Result := ubCombiningHalfMarks; + $FE30..$FE4F: + Result := ubCJKCompatibilityForms; + $FE50..$FE6F: + Result := ubSmallFormVariants; + $FE70..$FEFF: + Result := ubArabicPresentationFormsB; + $FF00..$FFEF: + Result := ubHalfwidthandFullwidthForms; + $FFF0..$FFFF: + Result := ubSpecials; + $10000..$1007F: + Result := ubLinearBSyllabary; + $10080..$100FF: + Result := ubLinearBIdeograms; + $10100..$1013F: + Result := ubAegeanNumbers; + $10140..$1018F: + Result := ubAncientGreekNumbers; + $10300..$1032F: + Result := ubOldItalic; + $10330..$1034F: + Result := ubGothic; + $10380..$1039F: + Result := ubUgaritic; + $103A0..$103DF: + Result := ubOldPersian; + $10400..$1044F: + Result := ubDeseret; + $10450..$1047F: + Result := ubShavian; + $10480..$104AF: + Result := ubOsmanya; + $10800..$1083F: + Result := ubCypriotSyllabary; + $10A00..$10A5F: + Result := ubKharoshthi; + $1D000..$1D0FF: + Result := ubByzantineMusicalSymbols; + $1D100..$1D1FF: + Result := ubMusicalSymbols; + $1D200..$1D24F: + Result := ubAncientGreekMusicalNotation; + $1D300..$1D35F: + Result := ubTaiXuanJingSymbols; + $1D400..$1D7FF: + Result := ubMathematicalAlphanumericSymbols; + $20000..$2A6DF: + Result := ubCJKUnifiedIdeographsExtensionB; + $2F800..$2FA1F: + Result := ubCJKCompatibilityIdeographsSupplement; + $E0000..$E007F: + Result := ubTags; + $E0100..$E01EF: + Result := ubVariationSelectorsSupplement; + $F0000..$FFFFF: + Result := ubSupplementaryPrivateUseAreaA; + $100000..$10FFFF: + Result := ubSupplementaryPrivateUseAreaB; + else + Result := ubUndefined; + end; +end; + + +function CompareTextWin95(const W1, W2: WideString; Locale: LCID): Integer; +// 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: string; + CP: Integer; + L1, L2: Integer; +begin + L1 := Length(W1); + L2 := Length(W2); + SetLength(S1, L1); + SetLength(S2, L2); + CP := CodePageFromLocale(Locale); + WideCharToMultiByte(CP, 0, PWideChar(W1), L1, PChar(S1), L1, nil, nil); + WideCharToMultiByte(CP, 0, PWideChar(W2), L2, PChar(S2), L2, nil, nil); + Result := CompareStringA(Locale, NORM_IGNORECASE, PChar(S1), Length(S1), + PChar(S2), Length(S2)) - 2; +end; + +function CompareTextWinNT(const W1, W2: WideString; Locale: LCID): Integer; +// 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: string; CodePage: Word): WideString; +var + InputLength, + OutputLength: Integer; +begin + InputLength := Length(S); + OutputLength := MultiByteToWideChar(CodePage, 0, PChar(S), InputLength, nil, 0); + SetLength(Result, OutputLength); + MultiByteToWideChar(CodePage, 0, PChar(S), InputLength, PWideChar(Result), OutputLength); +end; + +function WideStringToStringEx(const WS: WideString; CodePage: Word): string; +var + InputLength, + OutputLength: Integer; +begin + InputLength := Length(WS); + OutputLength := WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, nil, 0, nil, nil); + SetLength(Result, OutputLength); + WideCharToMultiByte(CodePage, 0, PWideChar(WS), InputLength, PChar(Result), OutputLength, nil, nil); +end; + +function TranslateString(const S: string; CP1, CP2: Word): string; +begin + Result:= WideStringToStringEx(StringToWideStringEx(S, CP1), CP2); +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 ExpandANSIString(const Source: PChar; Target: PWideChar; Count: Cardinal); +asm + JECXZ @@Finish // go out if there is nothing to do + 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 +@@Finish: +end; + +const + HalfShift: Integer = 10; + + HalfBase: UCS4 = $0010000; + HalfMask: UCS4 = $3FF; + + OffsetsFromUTF8: array [0..5] of UCS4 = + ($00000000, $00003080, $000E2080, + $03C82080, $FA082080, $82082080); + + BytesFromUTF8: array [0..255] of Byte = + (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,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,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,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,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,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,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,0,0,0, + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5); + + FirstByteMark: array [0..6] of Byte = + ($00, $00, $C0, $E0, $F0, $F8, $FC); + +function WideStringToUTF8(S: WideString): AnsiString; +var + Ch: UCS4; + L, J, T, + BytesToWrite: Cardinal; + ByteMask: UCS4; + ByteMark: UCS4; +begin + if S = '' then + Result := '' + else + begin + SetLength(Result, Length(S) * 6); // assume worst case + T := 1; + ByteMask := $BF; + ByteMark := $80; + + for J := 1 to Length(S) do + begin + Ch := UCS4(S[J]); + + if Ch < $80 then + BytesToWrite := 1 + else + if Ch < $800 then + BytesToWrite := 2 + else + if Ch < $10000 then + BytesToWrite := 3 + else + if Ch < $200000 then + BytesToWrite := 4 + else + if Ch < $4000000 then + BytesToWrite := 5 + else + if Ch <= MaximumUCS4 then + BytesToWrite := 6 + else + begin + BytesToWrite := 2; + Ch := ReplacementCharacter; + end; + + for L := BytesToWrite downto 2 do + begin + Result[T + L - 1] := Char((Ch or ByteMark) and ByteMask); + Ch := Ch shr 6; + end; + Result[T] := Char(Ch or FirstByteMark[BytesToWrite]); + Inc(T, BytesToWrite); + end; + SetLength(Result, T - 1); // set to actual length + end; +end; + +function UTF8ToWideString(S: AnsiString): WideString; +var + L, J, T: Cardinal; + Ch: UCS4; + ExtraBytesToWrite: Word; +begin + if S = '' then + Result := '' + else + begin + SetLength(Result, Length(S)); // create enough room + + L := 1; + T := 1; + while L <= Cardinal(Length(S)) do + begin + Ch := 0; + ExtraBytesToWrite := BytesFromUTF8[Ord(S[L])]; + + for J := ExtraBytesToWrite downto 1 do + begin + Ch := Ch + Ord(S[L]); + Inc(L); + Ch := Ch shl 6; + end; + Ch := Ch + Ord(S[L]); + Inc(L); + Ch := Ch - OffsetsFromUTF8[ExtraBytesToWrite]; + + if Ch <= MaximumUCS2 then + begin + Result[T] := WideChar(Ch); + Inc(T); + end + else + if Ch > MaximumUCS4 then + begin + Result[T] := WideChar(ReplacementCharacter); + Inc(T); + end + else + begin + Ch := Ch - HalfBase; + Result[T] := WideChar((Ch shr HalfShift) + SurrogateHighStart); + Inc(T); + Result[T] := WideChar((Ch and HalfMask) + SurrogateLowStart); + Inc(T); + end; + end; + SetLength(Result, T - 1); // now fix up length + end; +end; + +procedure PrepareUnicodeData; +// Prepares structures which are globally needed. +begin + LoadInProgress := TJclCriticalSection.Create; + + 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 + FreeAndNil(LoadInProgress); +end; + +initialization + PrepareUnicodeData; + +finalization + FreeUnicodeData; + +{$ENDIF SUPPORTS_WIDESTRING} + +// History: + +// $Log: JclUnicode.pas,v $ +// Revision 1.31 2005/10/26 09:15:13 marquardt +// most functions now have the same const parameters as their Ansi counterparts +// +// Revision 1.30 2005/10/26 08:36:29 marquardt +// StrPCopyWW and StrPLCopyWW introduced to solve overloaded problem +// +// Revision 1.29 2005/10/25 18:20:10 outchy +// IT3174: UTF8-file support in JclUnicode.pas +// +// Revision 1.28 2005/10/25 16:27:36 marquardt +// StrPCopyW and StrPLCopyW overloaded versions deactivated because of Delphi5 compiler problems +// +// Revision 1.27 2005/10/25 10:33:40 marquardt +// made StrPCopyW and StrPLCopyW compatible with the original Unicode.pas by adding overloaded versions +// +// Revision 1.26 2005/10/25 09:47:04 marquardt +// minor fixes and cleanups +// +// Revision 1.25 2005/10/25 08:54:57 marquardt +// make a union of the Str*W family of functions in JclUnicode and JclWideStrings +// +// Revision 1.24 2005/10/16 05:16:51 marquardt +// TWideStrings now has GetText and GetTextStr like TStrings +// +// Revision 1.23 2005/07/19 21:28:26 outchy +// IT 3066: JclUnicode.pas updated to Unicode 4.1 +// +// Revision 1.22 2005/03/08 08:33:23 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.21 2005/03/01 15:37:40 marquardt +// addressing Mantis 0714, 0716, 0720, 0731, 0740 partly or completely +// +// Revision 1.20 2005/02/24 16:34:53 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.19 2005/02/24 07:36:25 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.18 2005/02/14 03:20:59 rrossmair +// - fixed issues #0000713 ( make CompareTextWin95/NT functions use const string parameters) and #0001909 (JclUnicode.CharSetFromLocale - result ignored) +// +// Revision 1.17 2004/11/22 19:17:18 ahuser +// Fixed memory leak +// Style cleaning +// +// Revision 1.16 2004/10/17 21:00:16 mthoma +// cleaning +// +// Revision 1.15 2004/08/01 11:40:24 marquardt +// move constructors/destructors +// +// Revision 1.14 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.13 2004/07/28 18:00:54 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.12 2004/06/16 07:30:31 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.11 2004/06/14 13:05:22 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.10 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.9 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.8 2004/04/06 04:55:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/JclUnicode.rc b/official/1.96/source/windows/JclUnicode.rc new file mode 100644 index 0000000..f5fd0f4 --- /dev/null +++ b/official/1.96/source/windows/JclUnicode.rc @@ -0,0 +1,2767 @@ +/**************************************************************************************************** + + + jclunicode.rc + + + Produced by UDExtract written by Dipl. Ing. Mike Lischke, public@lischke-online.de + + +****************************************************************************************************/ + + +CATEGORIES UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '00 73 01 00 00 41 00 00 00 5A 00 00 00 C0 00 00 00 D6 00 00 00 D8 00 00 00 DE 00 00 00 00 01 00' + '00 00 01 00 00 02 01 00 00 02 01 00 00 04 01 00 00 04 01 00 00 06 01 00 00 06 01 00 00 08 01 00' + '00 08 01 00 00 0A 01 00 00 0A 01 00 00 0C 01 00 00 0C 01 00 00 0E 01 00 00 0E 01 00 00 10 01 00' + '00 10 01 00 00 12 01 00 00 12 01 00 00 14 01 00 00 14 01 00 00 16 01 00 00 16 01 00 00 18 01 00' + '00 18 01 00 00 1A 01 00 00 1A 01 00 00 1C 01 00 00 1C 01 00 00 1E 01 00 00 1E 01 00 00 20 01 00' + '00 20 01 00 00 22 01 00 00 22 01 00 00 24 01 00 00 24 01 00 00 26 01 00 00 26 01 00 00 28 01 00' + '00 28 01 00 00 2A 01 00 00 2A 01 00 00 2C 01 00 00 2C 01 00 00 2E 01 00 00 2E 01 00 00 30 01 00' + '00 30 01 00 00 32 01 00 00 32 01 00 00 34 01 00 00 34 01 00 00 36 01 00 00 36 01 00 00 39 01 00' + '00 39 01 00 00 3B 01 00 00 3B 01 00 00 3D 01 00 00 3D 01 00 00 3F 01 00 00 3F 01 00 00 41 01 00' + '00 41 01 00 00 43 01 00 00 43 01 00 00 45 01 00 00 45 01 00 00 47 01 00 00 47 01 00 00 4A 01 00' + '00 4A 01 00 00 4C 01 00 00 4C 01 00 00 4E 01 00 00 4E 01 00 00 50 01 00 00 50 01 00 00 52 01 00' + '00 52 01 00 00 54 01 00 00 54 01 00 00 56 01 00 00 56 01 00 00 58 01 00 00 58 01 00 00 5A 01 00' + '00 5A 01 00 00 5C 01 00 00 5C 01 00 00 5E 01 00 00 5E 01 00 00 60 01 00 00 60 01 00 00 62 01 00' + '00 62 01 00 00 64 01 00 00 64 01 00 00 66 01 00 00 66 01 00 00 68 01 00 00 68 01 00 00 6A 01 00' + '00 6A 01 00 00 6C 01 00 00 6C 01 00 00 6E 01 00 00 6E 01 00 00 70 01 00 00 70 01 00 00 72 01 00' + '00 72 01 00 00 74 01 00 00 74 01 00 00 76 01 00 00 76 01 00 00 78 01 00 00 79 01 00 00 7B 01 00' + '00 7B 01 00 00 7D 01 00 00 7D 01 00 00 81 01 00 00 82 01 00 00 84 01 00 00 84 01 00 00 86 01 00' + '00 87 01 00 00 89 01 00 00 8B 01 00 00 8E 01 00 00 91 01 00 00 93 01 00 00 94 01 00 00 96 01 00' + '00 98 01 00 00 9C 01 00 00 9D 01 00 00 9F 01 00 00 A0 01 00 00 A2 01 00 00 A2 01 00 00 A4 01 00' + '00 A4 01 00 00 A6 01 00 00 A7 01 00 00 A9 01 00 00 A9 01 00 00 AC 01 00 00 AC 01 00 00 AE 01 00' + '00 AF 01 00 00 B1 01 00 00 B3 01 00 00 B5 01 00 00 B5 01 00 00 B7 01 00 00 B8 01 00 00 BC 01 00' + '00 BC 01 00 00 C4 01 00 00 C4 01 00 00 C7 01 00 00 C7 01 00 00 CA 01 00 00 CA 01 00 00 CD 01 00' + '00 CD 01 00 00 CF 01 00 00 CF 01 00 00 D1 01 00 00 D1 01 00 00 D3 01 00 00 D3 01 00 00 D5 01 00' + '00 D5 01 00 00 D7 01 00 00 D7 01 00 00 D9 01 00 00 D9 01 00 00 DB 01 00 00 DB 01 00 00 DE 01 00' + '00 DE 01 00 00 E0 01 00 00 E0 01 00 00 E2 01 00 00 E2 01 00 00 E4 01 00 00 E4 01 00 00 E6 01 00' + '00 E6 01 00 00 E8 01 00 00 E8 01 00 00 EA 01 00 00 EA 01 00 00 EC 01 00 00 EC 01 00 00 EE 01 00' + '00 EE 01 00 00 F1 01 00 00 F1 01 00 00 F4 01 00 00 F4 01 00 00 F6 01 00 00 F8 01 00 00 FA 01 00' + '00 FA 01 00 00 FC 01 00 00 FC 01 00 00 FE 01 00 00 FE 01 00 00 00 02 00 00 00 02 00 00 02 02 00' + '00 02 02 00 00 04 02 00 00 04 02 00 00 06 02 00 00 06 02 00 00 08 02 00 00 08 02 00 00 0A 02 00' + '00 0A 02 00 00 0C 02 00 00 0C 02 00 00 0E 02 00 00 0E 02 00 00 10 02 00 00 10 02 00 00 12 02 00' + '00 12 02 00 00 14 02 00 00 14 02 00 00 16 02 00 00 16 02 00 00 18 02 00 00 18 02 00 00 1A 02 00' + '00 1A 02 00 00 1C 02 00 00 1C 02 00 00 1E 02 00 00 1E 02 00 00 22 02 00 00 22 02 00 00 24 02 00' + '00 24 02 00 00 26 02 00 00 26 02 00 00 28 02 00 00 28 02 00 00 2A 02 00 00 2A 02 00 00 2C 02 00' + '00 2C 02 00 00 2E 02 00 00 2E 02 00 00 30 02 00 00 30 02 00 00 32 02 00 00 32 02 00 00 86 03 00' + '00 86 03 00 00 88 03 00 00 8A 03 00 00 8C 03 00 00 8C 03 00 00 8E 03 00 00 8F 03 00 00 91 03 00' + '00 A1 03 00 00 A3 03 00 00 AB 03 00 00 D2 03 00 00 D4 03 00 00 DA 03 00 00 DA 03 00 00 DC 03 00' + '00 DC 03 00 00 DE 03 00 00 DE 03 00 00 E0 03 00 00 E0 03 00 00 E2 03 00 00 E2 03 00 00 E4 03 00' + '00 E4 03 00 00 E6 03 00 00 E6 03 00 00 E8 03 00 00 E8 03 00 00 EA 03 00 00 EA 03 00 00 EC 03 00' + '00 EC 03 00 00 EE 03 00 00 EE 03 00 00 00 04 00 00 2F 04 00 00 60 04 00 00 60 04 00 00 62 04 00' + '00 62 04 00 00 64 04 00 00 64 04 00 00 66 04 00 00 66 04 00 00 68 04 00 00 68 04 00 00 6A 04 00' + '00 6A 04 00 00 6C 04 00 00 6C 04 00 00 6E 04 00 00 6E 04 00 00 70 04 00 00 70 04 00 00 72 04 00' + '00 72 04 00 00 74 04 00 00 74 04 00 00 76 04 00 00 76 04 00 00 78 04 00 00 78 04 00 00 7A 04 00' + '00 7A 04 00 00 7C 04 00 00 7C 04 00 00 7E 04 00 00 7E 04 00 00 80 04 00 00 80 04 00 00 8C 04 00' + '00 8C 04 00 00 8E 04 00 00 8E 04 00 00 90 04 00 00 90 04 00 00 92 04 00 00 92 04 00 00 94 04 00' + '00 94 04 00 00 96 04 00 00 96 04 00 00 98 04 00 00 98 04 00 00 9A 04 00 00 9A 04 00 00 9C 04 00' + '00 9C 04 00 00 9E 04 00 00 9E 04 00 00 A0 04 00 00 A0 04 00 00 A2 04 00 00 A2 04 00 00 A4 04 00' + '00 A4 04 00 00 A6 04 00 00 A6 04 00 00 A8 04 00 00 A8 04 00 00 AA 04 00 00 AA 04 00 00 AC 04 00' + '00 AC 04 00 00 AE 04 00 00 AE 04 00 00 B0 04 00 00 B0 04 00 00 B2 04 00 00 B2 04 00 00 B4 04 00' + '00 B4 04 00 00 B6 04 00 00 B6 04 00 00 B8 04 00 00 B8 04 00 00 BA 04 00 00 BA 04 00 00 BC 04 00' + '00 BC 04 00 00 BE 04 00 00 BE 04 00 00 C0 04 00 00 C1 04 00 00 C3 04 00 00 C3 04 00 00 C7 04 00' + '00 C7 04 00 00 CB 04 00 00 CB 04 00 00 D0 04 00 00 D0 04 00 00 D2 04 00 00 D2 04 00 00 D4 04 00' + '00 D4 04 00 00 D6 04 00 00 D6 04 00 00 D8 04 00 00 D8 04 00 00 DA 04 00 00 DA 04 00 00 DC 04 00' + '00 DC 04 00 00 DE 04 00 00 DE 04 00 00 E0 04 00 00 E0 04 00 00 E2 04 00 00 E2 04 00 00 E4 04 00' + '00 E4 04 00 00 E6 04 00 00 E6 04 00 00 E8 04 00 00 E8 04 00 00 EA 04 00 00 EA 04 00 00 EC 04 00' + '00 EC 04 00 00 EE 04 00 00 EE 04 00 00 F0 04 00 00 F0 04 00 00 F2 04 00 00 F2 04 00 00 F4 04 00' + '00 F4 04 00 00 F8 04 00 00 F8 04 00 00 31 05 00 00 56 05 00 00 A0 10 00 00 C5 10 00 00 00 1E 00' + '00 00 1E 00 00 02 1E 00 00 02 1E 00 00 04 1E 00 00 04 1E 00 00 06 1E 00 00 06 1E 00 00 08 1E 00' + '00 08 1E 00 00 0A 1E 00 00 0A 1E 00 00 0C 1E 00 00 0C 1E 00 00 0E 1E 00 00 0E 1E 00 00 10 1E 00' + '00 10 1E 00 00 12 1E 00 00 12 1E 00 00 14 1E 00 00 14 1E 00 00 16 1E 00 00 16 1E 00 00 18 1E 00' + '00 18 1E 00 00 1A 1E 00 00 1A 1E 00 00 1C 1E 00 00 1C 1E 00 00 1E 1E 00 00 1E 1E 00 00 20 1E 00' + '00 20 1E 00 00 22 1E 00 00 22 1E 00 00 24 1E 00 00 24 1E 00 00 26 1E 00 00 26 1E 00 00 28 1E 00' + '00 28 1E 00 00 2A 1E 00 00 2A 1E 00 00 2C 1E 00 00 2C 1E 00 00 2E 1E 00 00 2E 1E 00 00 30 1E 00' + '00 30 1E 00 00 32 1E 00 00 32 1E 00 00 34 1E 00 00 34 1E 00 00 36 1E 00 00 36 1E 00 00 38 1E 00' + '00 38 1E 00 00 3A 1E 00 00 3A 1E 00 00 3C 1E 00 00 3C 1E 00 00 3E 1E 00 00 3E 1E 00 00 40 1E 00' + '00 40 1E 00 00 42 1E 00 00 42 1E 00 00 44 1E 00 00 44 1E 00 00 46 1E 00 00 46 1E 00 00 48 1E 00' + '00 48 1E 00 00 4A 1E 00 00 4A 1E 00 00 4C 1E 00 00 4C 1E 00 00 4E 1E 00 00 4E 1E 00 00 50 1E 00' + '00 50 1E 00 00 52 1E 00 00 52 1E 00 00 54 1E 00 00 54 1E 00 00 56 1E 00 00 56 1E 00 00 58 1E 00' + '00 58 1E 00 00 5A 1E 00 00 5A 1E 00 00 5C 1E 00 00 5C 1E 00 00 5E 1E 00 00 5E 1E 00 00 60 1E 00' + '00 60 1E 00 00 62 1E 00 00 62 1E 00 00 64 1E 00 00 64 1E 00 00 66 1E 00 00 66 1E 00 00 68 1E 00' + '00 68 1E 00 00 6A 1E 00 00 6A 1E 00 00 6C 1E 00 00 6C 1E 00 00 6E 1E 00 00 6E 1E 00 00 70 1E 00' + '00 70 1E 00 00 72 1E 00 00 72 1E 00 00 74 1E 00 00 74 1E 00 00 76 1E 00 00 76 1E 00 00 78 1E 00' + '00 78 1E 00 00 7A 1E 00 00 7A 1E 00 00 7C 1E 00 00 7C 1E 00 00 7E 1E 00 00 7E 1E 00 00 80 1E 00' + '00 80 1E 00 00 82 1E 00 00 82 1E 00 00 84 1E 00 00 84 1E 00 00 86 1E 00 00 86 1E 00 00 88 1E 00' + '00 88 1E 00 00 8A 1E 00 00 8A 1E 00 00 8C 1E 00 00 8C 1E 00 00 8E 1E 00 00 8E 1E 00 00 90 1E 00' + '00 90 1E 00 00 92 1E 00 00 92 1E 00 00 94 1E 00 00 94 1E 00 00 A0 1E 00 00 A0 1E 00 00 A2 1E 00' + '00 A2 1E 00 00 A4 1E 00 00 A4 1E 00 00 A6 1E 00 00 A6 1E 00 00 A8 1E 00 00 A8 1E 00 00 AA 1E 00' + '00 AA 1E 00 00 AC 1E 00 00 AC 1E 00 00 AE 1E 00 00 AE 1E 00 00 B0 1E 00 00 B0 1E 00 00 B2 1E 00' + '00 B2 1E 00 00 B4 1E 00 00 B4 1E 00 00 B6 1E 00 00 B6 1E 00 00 B8 1E 00 00 B8 1E 00 00 BA 1E 00' + '00 BA 1E 00 00 BC 1E 00 00 BC 1E 00 00 BE 1E 00 00 BE 1E 00 00 C0 1E 00 00 C0 1E 00 00 C2 1E 00' + '00 C2 1E 00 00 C4 1E 00 00 C4 1E 00 00 C6 1E 00 00 C6 1E 00 00 C8 1E 00 00 C8 1E 00 00 CA 1E 00' + '00 CA 1E 00 00 CC 1E 00 00 CC 1E 00 00 CE 1E 00 00 CE 1E 00 00 D0 1E 00 00 D0 1E 00 00 D2 1E 00' + '00 D2 1E 00 00 D4 1E 00 00 D4 1E 00 00 D6 1E 00 00 D6 1E 00 00 D8 1E 00 00 D8 1E 00 00 DA 1E 00' + '00 DA 1E 00 00 DC 1E 00 00 DC 1E 00 00 DE 1E 00 00 DE 1E 00 00 E0 1E 00 00 E0 1E 00 00 E2 1E 00' + '00 E2 1E 00 00 E4 1E 00 00 E4 1E 00 00 E6 1E 00 00 E6 1E 00 00 E8 1E 00 00 E8 1E 00 00 EA 1E 00' + '00 EA 1E 00 00 EC 1E 00 00 EC 1E 00 00 EE 1E 00 00 EE 1E 00 00 F0 1E 00 00 F0 1E 00 00 F2 1E 00' + '00 F2 1E 00 00 F4 1E 00 00 F4 1E 00 00 F6 1E 00 00 F6 1E 00 00 F8 1E 00 00 F8 1E 00 00 08 1F 00' + '00 0F 1F 00 00 18 1F 00 00 1D 1F 00 00 28 1F 00 00 2F 1F 00 00 38 1F 00 00 3F 1F 00 00 48 1F 00' + '00 4D 1F 00 00 59 1F 00 00 59 1F 00 00 5B 1F 00 00 5B 1F 00 00 5D 1F 00 00 5D 1F 00 00 5F 1F 00' + '00 5F 1F 00 00 68 1F 00 00 6F 1F 00 00 B8 1F 00 00 BB 1F 00 00 C8 1F 00 00 CB 1F 00 00 D8 1F 00' + '00 DB 1F 00 00 E8 1F 00 00 EC 1F 00 00 F8 1F 00 00 FB 1F 00 00 02 21 00 00 02 21 00 00 07 21 00' + '00 07 21 00 00 0B 21 00 00 0D 21 00 00 10 21 00 00 12 21 00 00 15 21 00 00 15 21 00 00 19 21 00' + '00 1D 21 00 00 24 21 00 00 24 21 00 00 26 21 00 00 26 21 00 00 28 21 00 00 28 21 00 00 2A 21 00' + '00 2D 21 00 00 30 21 00 00 31 21 00 00 33 21 00 00 33 21 00 00 21 FF 00 00 3A FF 00 00 01 76 01' + '00 00 61 00 00 00 7A 00 00 00 AA 00 00 00 AA 00 00 00 B5 00 00 00 B5 00 00 00 BA 00 00 00 BA 00' + '00 00 DF 00 00 00 F6 00 00 00 F8 00 00 00 FF 00 00 00 01 01 00 00 01 01 00 00 03 01 00 00 03 01' + '00 00 05 01 00 00 05 01 00 00 07 01 00 00 07 01 00 00 09 01 00 00 09 01 00 00 0B 01 00 00 0B 01' + '00 00 0D 01 00 00 0D 01 00 00 0F 01 00 00 0F 01 00 00 11 01 00 00 11 01 00 00 13 01 00 00 13 01' + '00 00 15 01 00 00 15 01 00 00 17 01 00 00 17 01 00 00 19 01 00 00 19 01 00 00 1B 01 00 00 1B 01' + '00 00 1D 01 00 00 1D 01 00 00 1F 01 00 00 1F 01 00 00 21 01 00 00 21 01 00 00 23 01 00 00 23 01' + '00 00 25 01 00 00 25 01 00 00 27 01 00 00 27 01 00 00 29 01 00 00 29 01 00 00 2B 01 00 00 2B 01' + '00 00 2D 01 00 00 2D 01 00 00 2F 01 00 00 2F 01 00 00 31 01 00 00 31 01 00 00 33 01 00 00 33 01' + '00 00 35 01 00 00 35 01 00 00 37 01 00 00 38 01 00 00 3A 01 00 00 3A 01 00 00 3C 01 00 00 3C 01' + '00 00 3E 01 00 00 3E 01 00 00 40 01 00 00 40 01 00 00 42 01 00 00 42 01 00 00 44 01 00 00 44 01' + '00 00 46 01 00 00 46 01 00 00 48 01 00 00 49 01 00 00 4B 01 00 00 4B 01 00 00 4D 01 00 00 4D 01' + '00 00 4F 01 00 00 4F 01 00 00 51 01 00 00 51 01 00 00 53 01 00 00 53 01 00 00 55 01 00 00 55 01' + '00 00 57 01 00 00 57 01 00 00 59 01 00 00 59 01 00 00 5B 01 00 00 5B 01 00 00 5D 01 00 00 5D 01' + '00 00 5F 01 00 00 5F 01 00 00 61 01 00 00 61 01 00 00 63 01 00 00 63 01 00 00 65 01 00 00 65 01' + '00 00 67 01 00 00 67 01 00 00 69 01 00 00 69 01 00 00 6B 01 00 00 6B 01 00 00 6D 01 00 00 6D 01' + '00 00 6F 01 00 00 6F 01 00 00 71 01 00 00 71 01 00 00 73 01 00 00 73 01 00 00 75 01 00 00 75 01' + '00 00 77 01 00 00 77 01 00 00 7A 01 00 00 7A 01 00 00 7C 01 00 00 7C 01 00 00 7E 01 00 00 80 01' + '00 00 83 01 00 00 83 01 00 00 85 01 00 00 85 01 00 00 88 01 00 00 88 01 00 00 8C 01 00 00 8D 01' + '00 00 92 01 00 00 92 01 00 00 95 01 00 00 95 01 00 00 99 01 00 00 9B 01 00 00 9E 01 00 00 9E 01' + '00 00 A1 01 00 00 A1 01 00 00 A3 01 00 00 A3 01 00 00 A5 01 00 00 A5 01 00 00 A8 01 00 00 A8 01' + '00 00 AA 01 00 00 AB 01 00 00 AD 01 00 00 AD 01 00 00 B0 01 00 00 B0 01 00 00 B4 01 00 00 B4 01' + '00 00 B6 01 00 00 B6 01 00 00 B9 01 00 00 BA 01 00 00 BD 01 00 00 BF 01 00 00 C6 01 00 00 C6 01' + '00 00 C9 01 00 00 C9 01 00 00 CC 01 00 00 CC 01 00 00 CE 01 00 00 CE 01 00 00 D0 01 00 00 D0 01' + '00 00 D2 01 00 00 D2 01 00 00 D4 01 00 00 D4 01 00 00 D6 01 00 00 D6 01 00 00 D8 01 00 00 D8 01' + '00 00 DA 01 00 00 DA 01 00 00 DC 01 00 00 DD 01 00 00 DF 01 00 00 DF 01 00 00 E1 01 00 00 E1 01' + '00 00 E3 01 00 00 E3 01 00 00 E5 01 00 00 E5 01 00 00 E7 01 00 00 E7 01 00 00 E9 01 00 00 E9 01' + '00 00 EB 01 00 00 EB 01 00 00 ED 01 00 00 ED 01 00 00 EF 01 00 00 F0 01 00 00 F3 01 00 00 F3 01' + '00 00 F5 01 00 00 F5 01 00 00 F9 01 00 00 F9 01 00 00 FB 01 00 00 FB 01 00 00 FD 01 00 00 FD 01' + '00 00 FF 01 00 00 FF 01 00 00 01 02 00 00 01 02 00 00 03 02 00 00 03 02 00 00 05 02 00 00 05 02' + '00 00 07 02 00 00 07 02 00 00 09 02 00 00 09 02 00 00 0B 02 00 00 0B 02 00 00 0D 02 00 00 0D 02' + '00 00 0F 02 00 00 0F 02 00 00 11 02 00 00 11 02 00 00 13 02 00 00 13 02 00 00 15 02 00 00 15 02' + '00 00 17 02 00 00 17 02 00 00 19 02 00 00 19 02 00 00 1B 02 00 00 1B 02 00 00 1D 02 00 00 1D 02' + '00 00 1F 02 00 00 1F 02 00 00 23 02 00 00 23 02 00 00 25 02 00 00 25 02 00 00 27 02 00 00 27 02' + '00 00 29 02 00 00 29 02 00 00 2B 02 00 00 2B 02 00 00 2D 02 00 00 2D 02 00 00 2F 02 00 00 2F 02' + '00 00 31 02 00 00 31 02 00 00 33 02 00 00 33 02 00 00 50 02 00 00 AD 02 00 00 90 03 00 00 90 03' + '00 00 AC 03 00 00 CE 03 00 00 D0 03 00 00 D1 03 00 00 D5 03 00 00 D7 03 00 00 DB 03 00 00 DB 03' + '00 00 DD 03 00 00 DD 03 00 00 DF 03 00 00 DF 03 00 00 E1 03 00 00 E1 03 00 00 E3 03 00 00 E3 03' + '00 00 E5 03 00 00 E5 03 00 00 E7 03 00 00 E7 03 00 00 E9 03 00 00 E9 03 00 00 EB 03 00 00 EB 03' + '00 00 ED 03 00 00 ED 03 00 00 EF 03 00 00 F3 03 00 00 30 04 00 00 5F 04 00 00 61 04 00 00 61 04' + '00 00 63 04 00 00 63 04 00 00 65 04 00 00 65 04 00 00 67 04 00 00 67 04 00 00 69 04 00 00 69 04' + '00 00 6B 04 00 00 6B 04 00 00 6D 04 00 00 6D 04 00 00 6F 04 00 00 6F 04 00 00 71 04 00 00 71 04' + '00 00 73 04 00 00 73 04 00 00 75 04 00 00 75 04 00 00 77 04 00 00 77 04 00 00 79 04 00 00 79 04' + '00 00 7B 04 00 00 7B 04 00 00 7D 04 00 00 7D 04 00 00 7F 04 00 00 7F 04 00 00 81 04 00 00 81 04' + '00 00 8D 04 00 00 8D 04 00 00 8F 04 00 00 8F 04 00 00 91 04 00 00 91 04 00 00 93 04 00 00 93 04' + '00 00 95 04 00 00 95 04 00 00 97 04 00 00 97 04 00 00 99 04 00 00 99 04 00 00 9B 04 00 00 9B 04' + '00 00 9D 04 00 00 9D 04 00 00 9F 04 00 00 9F 04 00 00 A1 04 00 00 A1 04 00 00 A3 04 00 00 A3 04' + '00 00 A5 04 00 00 A5 04 00 00 A7 04 00 00 A7 04 00 00 A9 04 00 00 A9 04 00 00 AB 04 00 00 AB 04' + '00 00 AD 04 00 00 AD 04 00 00 AF 04 00 00 AF 04 00 00 B1 04 00 00 B1 04 00 00 B3 04 00 00 B3 04' + '00 00 B5 04 00 00 B5 04 00 00 B7 04 00 00 B7 04 00 00 B9 04 00 00 B9 04 00 00 BB 04 00 00 BB 04' + '00 00 BD 04 00 00 BD 04 00 00 BF 04 00 00 BF 04 00 00 C2 04 00 00 C2 04 00 00 C4 04 00 00 C4 04' + '00 00 C8 04 00 00 C8 04 00 00 CC 04 00 00 CC 04 00 00 D1 04 00 00 D1 04 00 00 D3 04 00 00 D3 04' + '00 00 D5 04 00 00 D5 04 00 00 D7 04 00 00 D7 04 00 00 D9 04 00 00 D9 04 00 00 DB 04 00 00 DB 04' + '00 00 DD 04 00 00 DD 04 00 00 DF 04 00 00 DF 04 00 00 E1 04 00 00 E1 04 00 00 E3 04 00 00 E3 04' + '00 00 E5 04 00 00 E5 04 00 00 E7 04 00 00 E7 04 00 00 E9 04 00 00 E9 04 00 00 EB 04 00 00 EB 04' + '00 00 ED 04 00 00 ED 04 00 00 EF 04 00 00 EF 04 00 00 F1 04 00 00 F1 04 00 00 F3 04 00 00 F3 04' + '00 00 F5 04 00 00 F5 04 00 00 F9 04 00 00 F9 04 00 00 61 05 00 00 87 05 00 00 01 1E 00 00 01 1E' + '00 00 03 1E 00 00 03 1E 00 00 05 1E 00 00 05 1E 00 00 07 1E 00 00 07 1E 00 00 09 1E 00 00 09 1E' + '00 00 0B 1E 00 00 0B 1E 00 00 0D 1E 00 00 0D 1E 00 00 0F 1E 00 00 0F 1E 00 00 11 1E 00 00 11 1E' + '00 00 13 1E 00 00 13 1E 00 00 15 1E 00 00 15 1E 00 00 17 1E 00 00 17 1E 00 00 19 1E 00 00 19 1E' + '00 00 1B 1E 00 00 1B 1E 00 00 1D 1E 00 00 1D 1E 00 00 1F 1E 00 00 1F 1E 00 00 21 1E 00 00 21 1E' + '00 00 23 1E 00 00 23 1E 00 00 25 1E 00 00 25 1E 00 00 27 1E 00 00 27 1E 00 00 29 1E 00 00 29 1E' + '00 00 2B 1E 00 00 2B 1E 00 00 2D 1E 00 00 2D 1E 00 00 2F 1E 00 00 2F 1E 00 00 31 1E 00 00 31 1E' + '00 00 33 1E 00 00 33 1E 00 00 35 1E 00 00 35 1E 00 00 37 1E 00 00 37 1E 00 00 39 1E 00 00 39 1E' + '00 00 3B 1E 00 00 3B 1E 00 00 3D 1E 00 00 3D 1E 00 00 3F 1E 00 00 3F 1E 00 00 41 1E 00 00 41 1E' + '00 00 43 1E 00 00 43 1E 00 00 45 1E 00 00 45 1E 00 00 47 1E 00 00 47 1E 00 00 49 1E 00 00 49 1E' + '00 00 4B 1E 00 00 4B 1E 00 00 4D 1E 00 00 4D 1E 00 00 4F 1E 00 00 4F 1E 00 00 51 1E 00 00 51 1E' + '00 00 53 1E 00 00 53 1E 00 00 55 1E 00 00 55 1E 00 00 57 1E 00 00 57 1E 00 00 59 1E 00 00 59 1E' + '00 00 5B 1E 00 00 5B 1E 00 00 5D 1E 00 00 5D 1E 00 00 5F 1E 00 00 5F 1E 00 00 61 1E 00 00 61 1E' + '00 00 63 1E 00 00 63 1E 00 00 65 1E 00 00 65 1E 00 00 67 1E 00 00 67 1E 00 00 69 1E 00 00 69 1E' + '00 00 6B 1E 00 00 6B 1E 00 00 6D 1E 00 00 6D 1E 00 00 6F 1E 00 00 6F 1E 00 00 71 1E 00 00 71 1E' + '00 00 73 1E 00 00 73 1E 00 00 75 1E 00 00 75 1E 00 00 77 1E 00 00 77 1E 00 00 79 1E 00 00 79 1E' + '00 00 7B 1E 00 00 7B 1E 00 00 7D 1E 00 00 7D 1E 00 00 7F 1E 00 00 7F 1E 00 00 81 1E 00 00 81 1E' + '00 00 83 1E 00 00 83 1E 00 00 85 1E 00 00 85 1E 00 00 87 1E 00 00 87 1E 00 00 89 1E 00 00 89 1E' + '00 00 8B 1E 00 00 8B 1E 00 00 8D 1E 00 00 8D 1E 00 00 8F 1E 00 00 8F 1E 00 00 91 1E 00 00 91 1E' + '00 00 93 1E 00 00 93 1E 00 00 95 1E 00 00 9B 1E 00 00 A1 1E 00 00 A1 1E 00 00 A3 1E 00 00 A3 1E' + '00 00 A5 1E 00 00 A5 1E 00 00 A7 1E 00 00 A7 1E 00 00 A9 1E 00 00 A9 1E 00 00 AB 1E 00 00 AB 1E' + '00 00 AD 1E 00 00 AD 1E 00 00 AF 1E 00 00 AF 1E 00 00 B1 1E 00 00 B1 1E 00 00 B3 1E 00 00 B3 1E' + '00 00 B5 1E 00 00 B5 1E 00 00 B7 1E 00 00 B7 1E 00 00 B9 1E 00 00 B9 1E 00 00 BB 1E 00 00 BB 1E' + '00 00 BD 1E 00 00 BD 1E 00 00 BF 1E 00 00 BF 1E 00 00 C1 1E 00 00 C1 1E 00 00 C3 1E 00 00 C3 1E' + '00 00 C5 1E 00 00 C5 1E 00 00 C7 1E 00 00 C7 1E 00 00 C9 1E 00 00 C9 1E 00 00 CB 1E 00 00 CB 1E' + '00 00 CD 1E 00 00 CD 1E 00 00 CF 1E 00 00 CF 1E 00 00 D1 1E 00 00 D1 1E 00 00 D3 1E 00 00 D3 1E' + '00 00 D5 1E 00 00 D5 1E 00 00 D7 1E 00 00 D7 1E 00 00 D9 1E 00 00 D9 1E 00 00 DB 1E 00 00 DB 1E' + '00 00 DD 1E 00 00 DD 1E 00 00 DF 1E 00 00 DF 1E 00 00 E1 1E 00 00 E1 1E 00 00 E3 1E 00 00 E3 1E' + '00 00 E5 1E 00 00 E5 1E 00 00 E7 1E 00 00 E7 1E 00 00 E9 1E 00 00 E9 1E 00 00 EB 1E 00 00 EB 1E' + '00 00 ED 1E 00 00 ED 1E 00 00 EF 1E 00 00 EF 1E 00 00 F1 1E 00 00 F1 1E 00 00 F3 1E 00 00 F3 1E' + '00 00 F5 1E 00 00 F5 1E 00 00 F7 1E 00 00 F7 1E 00 00 F9 1E 00 00 F9 1E 00 00 00 1F 00 00 07 1F' + '00 00 10 1F 00 00 15 1F 00 00 20 1F 00 00 27 1F 00 00 30 1F 00 00 37 1F 00 00 40 1F 00 00 45 1F' + '00 00 50 1F 00 00 57 1F 00 00 60 1F 00 00 67 1F 00 00 70 1F 00 00 7D 1F 00 00 80 1F 00 00 87 1F' + '00 00 90 1F 00 00 97 1F 00 00 A0 1F 00 00 A7 1F 00 00 B0 1F 00 00 B4 1F 00 00 B6 1F 00 00 B7 1F' + '00 00 BE 1F 00 00 BE 1F 00 00 C2 1F 00 00 C4 1F 00 00 C6 1F 00 00 C7 1F 00 00 D0 1F 00 00 D3 1F' + '00 00 D6 1F 00 00 D7 1F 00 00 E0 1F 00 00 E7 1F 00 00 F2 1F 00 00 F4 1F 00 00 F6 1F 00 00 F7 1F' + '00 00 7F 20 00 00 7F 20 00 00 0A 21 00 00 0A 21 00 00 0E 21 00 00 0F 21 00 00 13 21 00 00 13 21' + '00 00 2F 21 00 00 2F 21 00 00 34 21 00 00 34 21 00 00 39 21 00 00 39 21 00 00 00 FB 00 00 06 FB' + '00 00 13 FB 00 00 17 FB 00 00 41 FF 00 00 5A FF 00 00 02 0A 00 00 00 C5 01 00 00 C5 01 00 00 C8' + '01 00 00 C8 01 00 00 CB 01 00 00 CB 01 00 00 F2 01 00 00 F2 01 00 00 88 1F 00 00 8F 1F 00 00 98' + '1F 00 00 9F 1F 00 00 A8 1F 00 00 AF 1F 00 00 BC 1F 00 00 BC 1F 00 00 CC 1F 00 00 CC 1F 00 00 FC' + '1F 00 00 FC 1F 00 00 03 5D 00 00 00 00 03 00 00 4E 03 00 00 60 03 00 00 62 03 00 00 83 04 00 00' + '86 04 00 00 91 05 00 00 A1 05 00 00 A3 05 00 00 B9 05 00 00 BB 05 00 00 BD 05 00 00 BF 05 00 00' + 'BF 05 00 00 C1 05 00 00 C2 05 00 00 C4 05 00 00 C4 05 00 00 4B 06 00 00 55 06 00 00 70 06 00 00' + '70 06 00 00 D6 06 00 00 DC 06 00 00 DF 06 00 00 E4 06 00 00 E7 06 00 00 E8 06 00 00 EA 06 00 00' + 'ED 06 00 00 11 07 00 00 11 07 00 00 30 07 00 00 4A 07 00 00 A6 07 00 00 B0 07 00 00 01 09 00 00' + '02 09 00 00 3C 09 00 00 3C 09 00 00 41 09 00 00 48 09 00 00 4D 09 00 00 4D 09 00 00 51 09 00 00' + '54 09 00 00 62 09 00 00 63 09 00 00 81 09 00 00 81 09 00 00 BC 09 00 00 BC 09 00 00 C1 09 00 00' + 'C4 09 00 00 CD 09 00 00 CD 09 00 00 E2 09 00 00 E3 09 00 00 02 0A 00 00 02 0A 00 00 3C 0A 00 00' + '3C 0A 00 00 41 0A 00 00 42 0A 00 00 47 0A 00 00 48 0A 00 00 4B 0A 00 00 4D 0A 00 00 70 0A 00 00' + '71 0A 00 00 81 0A 00 00 82 0A 00 00 BC 0A 00 00 BC 0A 00 00 C1 0A 00 00 C5 0A 00 00 C7 0A 00 00' + 'C8 0A 00 00 CD 0A 00 00 CD 0A 00 00 01 0B 00 00 01 0B 00 00 3C 0B 00 00 3C 0B 00 00 3F 0B 00 00' + '3F 0B 00 00 41 0B 00 00 43 0B 00 00 4D 0B 00 00 4D 0B 00 00 56 0B 00 00 56 0B 00 00 82 0B 00 00' + '82 0B 00 00 C0 0B 00 00 C0 0B 00 00 CD 0B 00 00 CD 0B 00 00 3E 0C 00 00 40 0C 00 00 46 0C 00 00' + '48 0C 00 00 4A 0C 00 00 4D 0C 00 00 55 0C 00 00 56 0C 00 00 BF 0C 00 00 BF 0C 00 00 C6 0C 00 00' + 'C6 0C 00 00 CC 0C 00 00 CD 0C 00 00 41 0D 00 00 43 0D 00 00 4D 0D 00 00 4D 0D 00 00 CA 0D 00 00' + 'CA 0D 00 00 D2 0D 00 00 D4 0D 00 00 D6 0D 00 00 D6 0D 00 00 31 0E 00 00 31 0E 00 00 34 0E 00 00' + '3A 0E 00 00 47 0E 00 00 4E 0E 00 00 B1 0E 00 00 B1 0E 00 00 B4 0E 00 00 B9 0E 00 00 BB 0E 00 00' + 'BC 0E 00 00 C8 0E 00 00 CD 0E 00 00 18 0F 00 00 19 0F 00 00 35 0F 00 00 35 0F 00 00 37 0F 00 00' + '37 0F 00 00 39 0F 00 00 39 0F 00 00 71 0F 00 00 7E 0F 00 00 80 0F 00 00 84 0F 00 00 86 0F 00 00' + '87 0F 00 00 90 0F 00 00 97 0F 00 00 99 0F 00 00 BC 0F 00 00 C6 0F 00 00 C6 0F 00 00 2D 10 00 00' + '30 10 00 00 32 10 00 00 32 10 00 00 36 10 00 00 37 10 00 00 39 10 00 00 39 10 00 00 58 10 00 00' + '59 10 00 00 B7 17 00 00 BD 17 00 00 C6 17 00 00 C6 17 00 00 C9 17 00 00 D3 17 00 00 A9 18 00 00' + 'A9 18 00 00 D0 20 00 00 DC 20 00 00 E1 20 00 00 E1 20 00 00 2A 30 00 00 2F 30 00 00 99 30 00 00' + '9A 30 00 00 1E FB 00 00 1E FB 00 00 20 FE 00 00 23 FE 00 00 04 33 00 00 00 03 09 00 00 03 09 00' + '00 3E 09 00 00 40 09 00 00 49 09 00 00 4C 09 00 00 82 09 00 00 83 09 00 00 BE 09 00 00 C0 09 00' + '00 C7 09 00 00 C8 09 00 00 CB 09 00 00 CC 09 00 00 D7 09 00 00 D7 09 00 00 3E 0A 00 00 40 0A 00' + '00 83 0A 00 00 83 0A 00 00 BE 0A 00 00 C0 0A 00 00 C9 0A 00 00 C9 0A 00 00 CB 0A 00 00 CC 0A 00' + '00 02 0B 00 00 03 0B 00 00 3E 0B 00 00 3E 0B 00 00 40 0B 00 00 40 0B 00 00 47 0B 00 00 48 0B 00' + '00 4B 0B 00 00 4C 0B 00 00 57 0B 00 00 57 0B 00 00 83 0B 00 00 83 0B 00 00 BE 0B 00 00 BF 0B 00' + '00 C1 0B 00 00 C2 0B 00 00 C6 0B 00 00 C8 0B 00 00 CA 0B 00 00 CC 0B 00 00 D7 0B 00 00 D7 0B 00' + '00 01 0C 00 00 03 0C 00 00 41 0C 00 00 44 0C 00 00 82 0C 00 00 83 0C 00 00 BE 0C 00 00 BE 0C 00' + '00 C0 0C 00 00 C4 0C 00 00 C7 0C 00 00 C8 0C 00 00 CA 0C 00 00 CB 0C 00 00 D5 0C 00 00 D6 0C 00' + '00 02 0D 00 00 03 0D 00 00 3E 0D 00 00 40 0D 00 00 46 0D 00 00 48 0D 00 00 4A 0D 00 00 4C 0D 00' + '00 57 0D 00 00 57 0D 00 00 82 0D 00 00 83 0D 00 00 CF 0D 00 00 D1 0D 00 00 D8 0D 00 00 DF 0D 00' + '00 F2 0D 00 00 F3 0D 00 00 3E 0F 00 00 3F 0F 00 00 7F 0F 00 00 7F 0F 00 00 2C 10 00 00 2C 10 00' + '00 31 10 00 00 31 10 00 00 38 10 00 00 38 10 00 00 56 10 00 00 57 10 00 00 B4 17 00 00 B6 17 00' + '00 BE 17 00 00 C5 17 00 00 C7 17 00 00 C8 17 00 00 05 04 00 00 00 88 04 00 00 89 04 00 00 DD 06' + '00 00 DE 06 00 00 DD 20 00 00 E0 20 00 00 E2 20 00 00 E3 20 00 00 06 14 00 00 00 30 00 00 00 39' + '00 00 00 60 06 00 00 69 06 00 00 F0 06 00 00 F9 06 00 00 66 09 00 00 6F 09 00 00 E6 09 00 00 EF' + '09 00 00 66 0A 00 00 6F 0A 00 00 E6 0A 00 00 EF 0A 00 00 66 0B 00 00 6F 0B 00 00 E7 0B 00 00 EF' + '0B 00 00 66 0C 00 00 6F 0C 00 00 E6 0C 00 00 EF 0C 00 00 66 0D 00 00 6F 0D 00 00 50 0E 00 00 59' + '0E 00 00 D0 0E 00 00 D9 0E 00 00 20 0F 00 00 29 0F 00 00 40 10 00 00 49 10 00 00 69 13 00 00 71' + '13 00 00 E0 17 00 00 E9 17 00 00 10 18 00 00 19 18 00 00 10 FF 00 00 19 FF 00 00 07 04 00 00 00' + '60 21 00 00 83 21 00 00 07 30 00 00 07 30 00 00 21 30 00 00 29 30 00 00 38 30 00 00 3A 30 00 00' + '08 12 00 00 00 B2 00 00 00 B3 00 00 00 B9 00 00 00 B9 00 00 00 BC 00 00 00 BE 00 00 00 F4 09 00' + '00 F9 09 00 00 F0 0B 00 00 F2 0B 00 00 2A 0F 00 00 33 0F 00 00 72 13 00 00 7C 13 00 00 EE 16 00' + '00 F0 16 00 00 70 20 00 00 70 20 00 00 74 20 00 00 79 20 00 00 80 20 00 00 89 20 00 00 53 21 00' + '00 5F 21 00 00 60 24 00 00 9B 24 00 00 EA 24 00 00 EA 24 00 00 76 27 00 00 93 27 00 00 92 31 00' + '00 95 31 00 00 20 32 00 00 29 32 00 00 80 32 00 00 89 32 00 00 09 06 00 00 00 20 00 00 00 20 00' + '00 00 A0 00 00 00 A0 00 00 00 80 16 00 00 80 16 00 00 00 20 00 00 0B 20 00 00 2F 20 00 00 2F 20' + '00 00 00 30 00 00 00 30 00 00 0A 01 00 00 00 28 20 00 00 28 20 00 00 0B 01 00 00 00 29 20 00 00' + '29 20 00 00 0C 02 00 00 00 00 00 00 00 1F 00 00 00 7F 00 00 00 9F 00 00 00 0D 07 00 00 00 0F 07' + '00 00 0F 07 00 00 0B 18 00 00 0E 18 00 00 0C 20 00 00 0F 20 00 00 2A 20 00 00 2E 20 00 00 6A 20' + '00 00 6F 20 00 00 FF FE 00 00 FF FE 00 00 F9 FF 00 00 FB FF 00 00 0E 03 00 00 00 00 D8 00 00 7F' + 'DB 00 00 80 DB 00 00 FF DB 00 00 00 DC 00 00 FF DF 00 00 0F 03 00 00 00 00 E0 00 00 FF F8 00 00' + '00 00 0F 00 FD FF 0F 00 00 00 10 00 FD FF 10 00 11 12 00 00 00 B0 02 00 00 B8 02 00 00 BB 02 00' + '00 C1 02 00 00 D0 02 00 00 D1 02 00 00 E0 02 00 00 E4 02 00 00 EE 02 00 00 EE 02 00 00 7A 03 00' + '00 7A 03 00 00 59 05 00 00 59 05 00 00 40 06 00 00 40 06 00 00 E5 06 00 00 E6 06 00 00 46 0E 00' + '00 46 0E 00 00 C6 0E 00 00 C6 0E 00 00 43 18 00 00 43 18 00 00 05 30 00 00 05 30 00 00 31 30 00' + '00 35 30 00 00 9D 30 00 00 9E 30 00 00 FC 30 00 00 FE 30 00 00 70 FF 00 00 70 FF 00 00 9E FF 00' + '00 9F FF 00 00 12 BA 00 00 00 BB 01 00 00 BB 01 00 00 C0 01 00 00 C3 01 00 00 D0 05 00 00 EA 05' + '00 00 F0 05 00 00 F2 05 00 00 21 06 00 00 3A 06 00 00 41 06 00 00 4A 06 00 00 71 06 00 00 D3 06' + '00 00 D5 06 00 00 D5 06 00 00 FA 06 00 00 FC 06 00 00 10 07 00 00 10 07 00 00 12 07 00 00 2C 07' + '00 00 80 07 00 00 A5 07 00 00 05 09 00 00 39 09 00 00 3D 09 00 00 3D 09 00 00 50 09 00 00 50 09' + '00 00 58 09 00 00 61 09 00 00 85 09 00 00 8C 09 00 00 8F 09 00 00 90 09 00 00 93 09 00 00 A8 09' + '00 00 AA 09 00 00 B0 09 00 00 B2 09 00 00 B2 09 00 00 B6 09 00 00 B9 09 00 00 DC 09 00 00 DD 09' + '00 00 DF 09 00 00 E1 09 00 00 F0 09 00 00 F1 09 00 00 05 0A 00 00 0A 0A 00 00 0F 0A 00 00 10 0A' + '00 00 13 0A 00 00 28 0A 00 00 2A 0A 00 00 30 0A 00 00 32 0A 00 00 33 0A 00 00 35 0A 00 00 36 0A' + '00 00 38 0A 00 00 39 0A 00 00 59 0A 00 00 5C 0A 00 00 5E 0A 00 00 5E 0A 00 00 72 0A 00 00 74 0A' + '00 00 85 0A 00 00 8B 0A 00 00 8D 0A 00 00 8D 0A 00 00 8F 0A 00 00 91 0A 00 00 93 0A 00 00 A8 0A' + '00 00 AA 0A 00 00 B0 0A 00 00 B2 0A 00 00 B3 0A 00 00 B5 0A 00 00 B9 0A 00 00 BD 0A 00 00 BD 0A' + '00 00 D0 0A 00 00 D0 0A 00 00 E0 0A 00 00 E0 0A 00 00 05 0B 00 00 0C 0B 00 00 0F 0B 00 00 10 0B' + '00 00 13 0B 00 00 28 0B 00 00 2A 0B 00 00 30 0B 00 00 32 0B 00 00 33 0B 00 00 36 0B 00 00 39 0B' + '00 00 3D 0B 00 00 3D 0B 00 00 5C 0B 00 00 5D 0B 00 00 5F 0B 00 00 61 0B 00 00 85 0B 00 00 8A 0B' + '00 00 8E 0B 00 00 90 0B 00 00 92 0B 00 00 95 0B 00 00 99 0B 00 00 9A 0B 00 00 9C 0B 00 00 9C 0B' + '00 00 9E 0B 00 00 9F 0B 00 00 A3 0B 00 00 A4 0B 00 00 A8 0B 00 00 AA 0B 00 00 AE 0B 00 00 B5 0B' + '00 00 B7 0B 00 00 B9 0B 00 00 05 0C 00 00 0C 0C 00 00 0E 0C 00 00 10 0C 00 00 12 0C 00 00 28 0C' + '00 00 2A 0C 00 00 33 0C 00 00 35 0C 00 00 39 0C 00 00 60 0C 00 00 61 0C 00 00 85 0C 00 00 8C 0C' + '00 00 8E 0C 00 00 90 0C 00 00 92 0C 00 00 A8 0C 00 00 AA 0C 00 00 B3 0C 00 00 B5 0C 00 00 B9 0C' + '00 00 DE 0C 00 00 DE 0C 00 00 E0 0C 00 00 E1 0C 00 00 05 0D 00 00 0C 0D 00 00 0E 0D 00 00 10 0D' + '00 00 12 0D 00 00 28 0D 00 00 2A 0D 00 00 39 0D 00 00 60 0D 00 00 61 0D 00 00 85 0D 00 00 96 0D' + '00 00 9A 0D 00 00 B1 0D 00 00 B3 0D 00 00 BB 0D 00 00 BD 0D 00 00 BD 0D 00 00 C0 0D 00 00 C6 0D' + '00 00 01 0E 00 00 30 0E 00 00 32 0E 00 00 33 0E 00 00 40 0E 00 00 45 0E 00 00 81 0E 00 00 82 0E' + '00 00 84 0E 00 00 84 0E 00 00 87 0E 00 00 88 0E 00 00 8A 0E 00 00 8A 0E 00 00 8D 0E 00 00 8D 0E' + '00 00 94 0E 00 00 97 0E 00 00 99 0E 00 00 9F 0E 00 00 A1 0E 00 00 A3 0E 00 00 A5 0E 00 00 A5 0E' + '00 00 A7 0E 00 00 A7 0E 00 00 AA 0E 00 00 AB 0E 00 00 AD 0E 00 00 B0 0E 00 00 B2 0E 00 00 B3 0E' + '00 00 BD 0E 00 00 BD 0E 00 00 C0 0E 00 00 C4 0E 00 00 DC 0E 00 00 DD 0E 00 00 00 0F 00 00 00 0F' + '00 00 40 0F 00 00 47 0F 00 00 49 0F 00 00 6A 0F 00 00 88 0F 00 00 8B 0F 00 00 00 10 00 00 21 10' + '00 00 23 10 00 00 27 10 00 00 29 10 00 00 2A 10 00 00 50 10 00 00 55 10 00 00 D0 10 00 00 F6 10' + '00 00 00 11 00 00 59 11 00 00 5F 11 00 00 A2 11 00 00 A8 11 00 00 F9 11 00 00 00 12 00 00 06 12' + '00 00 08 12 00 00 46 12 00 00 48 12 00 00 48 12 00 00 4A 12 00 00 4D 12 00 00 50 12 00 00 56 12' + '00 00 58 12 00 00 58 12 00 00 5A 12 00 00 5D 12 00 00 60 12 00 00 86 12 00 00 88 12 00 00 88 12' + '00 00 8A 12 00 00 8D 12 00 00 90 12 00 00 AE 12 00 00 B0 12 00 00 B0 12 00 00 B2 12 00 00 B5 12' + '00 00 B8 12 00 00 BE 12 00 00 C0 12 00 00 C0 12 00 00 C2 12 00 00 C5 12 00 00 C8 12 00 00 CE 12' + '00 00 D0 12 00 00 D6 12 00 00 D8 12 00 00 EE 12 00 00 F0 12 00 00 0E 13 00 00 10 13 00 00 10 13' + '00 00 12 13 00 00 15 13 00 00 18 13 00 00 1E 13 00 00 20 13 00 00 46 13 00 00 48 13 00 00 5A 13' + '00 00 A0 13 00 00 F4 13 00 00 01 14 00 00 6C 16 00 00 6F 16 00 00 76 16 00 00 81 16 00 00 9A 16' + '00 00 A0 16 00 00 EA 16 00 00 80 17 00 00 B3 17 00 00 20 18 00 00 42 18 00 00 44 18 00 00 77 18' + '00 00 80 18 00 00 A8 18 00 00 35 21 00 00 38 21 00 00 06 30 00 00 06 30 00 00 41 30 00 00 94 30' + '00 00 A1 30 00 00 FA 30 00 00 05 31 00 00 2C 31 00 00 31 31 00 00 8E 31 00 00 A0 31 00 00 B7 31' + '00 00 00 34 00 00 B5 4D 00 00 00 4E 00 00 A5 9F 00 00 00 A0 00 00 8C A4 00 00 00 AC 00 00 A3 D7' + '00 00 00 F9 00 00 2D FA 00 00 1D FB 00 00 1D FB 00 00 1F FB 00 00 28 FB 00 00 2A FB 00 00 36 FB' + '00 00 38 FB 00 00 3C FB 00 00 3E FB 00 00 3E FB 00 00 40 FB 00 00 41 FB 00 00 43 FB 00 00 44 FB' + '00 00 46 FB 00 00 B1 FB 00 00 D3 FB 00 00 3D FD 00 00 50 FD 00 00 8F FD 00 00 92 FD 00 00 C7 FD' + '00 00 F0 FD 00 00 FB FD 00 00 70 FE 00 00 72 FE 00 00 74 FE 00 00 74 FE 00 00 76 FE 00 00 FC FE' + '00 00 66 FF 00 00 6F FF 00 00 71 FF 00 00 9D FF 00 00 A0 FF 00 00 BE FF 00 00 C2 FF 00 00 C7 FF' + '00 00 CA FF 00 00 CF FF 00 00 D2 FF 00 00 D7 FF 00 00 DA FF 00 00 DC FF 00 00 13 07 00 00 00 5F' + '00 00 00 5F 00 00 00 3F 20 00 00 40 20 00 00 FB 30 00 00 FB 30 00 00 33 FE 00 00 34 FE 00 00 4D' + 'FE 00 00 4F FE 00 00 3F FF 00 00 3F FF 00 00 65 FF 00 00 65 FF 00 00 14 0B 00 00 00 2D 00 00 00' + '2D 00 00 00 AD 00 00 00 AD 00 00 00 8A 05 00 00 8A 05 00 00 06 18 00 00 06 18 00 00 10 20 00 00' + '15 20 00 00 1C 30 00 00 1C 30 00 00 30 30 00 00 30 30 00 00 31 FE 00 00 32 FE 00 00 58 FE 00 00' + '58 FE 00 00 63 FE 00 00 63 FE 00 00 0D FF 00 00 0D FF 00 00 15 26 00 00 00 28 00 00 00 28 00 00' + '00 5B 00 00 00 5B 00 00 00 7B 00 00 00 7B 00 00 00 3A 0F 00 00 3A 0F 00 00 3C 0F 00 00 3C 0F 00' + '00 9B 16 00 00 9B 16 00 00 1A 20 00 00 1A 20 00 00 1E 20 00 00 1E 20 00 00 45 20 00 00 45 20 00' + '00 7D 20 00 00 7D 20 00 00 8D 20 00 00 8D 20 00 00 29 23 00 00 29 23 00 00 08 30 00 00 08 30 00' + '00 0A 30 00 00 0A 30 00 00 0C 30 00 00 0C 30 00 00 0E 30 00 00 0E 30 00 00 10 30 00 00 10 30 00' + '00 14 30 00 00 14 30 00 00 16 30 00 00 16 30 00 00 18 30 00 00 18 30 00 00 1A 30 00 00 1A 30 00' + '00 1D 30 00 00 1D 30 00 00 3E FD 00 00 3E FD 00 00 35 FE 00 00 35 FE 00 00 37 FE 00 00 37 FE 00' + '00 39 FE 00 00 39 FE 00 00 3B FE 00 00 3B FE 00 00 3D FE 00 00 3D FE 00 00 3F FE 00 00 3F FE 00' + '00 41 FE 00 00 41 FE 00 00 43 FE 00 00 43 FE 00 00 59 FE 00 00 59 FE 00 00 5B FE 00 00 5B FE 00' + '00 5D FE 00 00 5D FE 00 00 08 FF 00 00 08 FF 00 00 3B FF 00 00 3B FF 00 00 5B FF 00 00 5B FF 00' + '00 62 FF 00 00 62 FF 00 00 16 24 00 00 00 29 00 00 00 29 00 00 00 5D 00 00 00 5D 00 00 00 7D 00' + '00 00 7D 00 00 00 3B 0F 00 00 3B 0F 00 00 3D 0F 00 00 3D 0F 00 00 9C 16 00 00 9C 16 00 00 46 20' + '00 00 46 20 00 00 7E 20 00 00 7E 20 00 00 8E 20 00 00 8E 20 00 00 2A 23 00 00 2A 23 00 00 09 30' + '00 00 09 30 00 00 0B 30 00 00 0B 30 00 00 0D 30 00 00 0D 30 00 00 0F 30 00 00 0F 30 00 00 11 30' + '00 00 11 30 00 00 15 30 00 00 15 30 00 00 17 30 00 00 17 30 00 00 19 30 00 00 19 30 00 00 1B 30' + '00 00 1B 30 00 00 1E 30 00 00 1F 30 00 00 3F FD 00 00 3F FD 00 00 36 FE 00 00 36 FE 00 00 38 FE' + '00 00 38 FE 00 00 3A FE 00 00 3A FE 00 00 3C FE 00 00 3C FE 00 00 3E FE 00 00 3E FE 00 00 40 FE' + '00 00 40 FE 00 00 42 FE 00 00 42 FE 00 00 44 FE 00 00 44 FE 00 00 5A FE 00 00 5A FE 00 00 5C FE' + '00 00 5C FE 00 00 5E FE 00 00 5E FE 00 00 09 FF 00 00 09 FF 00 00 3D FF 00 00 3D FF 00 00 5D FF' + '00 00 5D FF 00 00 63 FF 00 00 63 FF 00 00 17 05 00 00 00 AB 00 00 00 AB 00 00 00 18 20 00 00 18' + '20 00 00 1B 20 00 00 1C 20 00 00 1F 20 00 00 1F 20 00 00 39 20 00 00 39 20 00 00 18 04 00 00 00' + 'BB 00 00 00 BB 00 00 00 19 20 00 00 19 20 00 00 1D 20 00 00 1D 20 00 00 3A 20 00 00 3A 20 00 00' + '19 41 00 00 00 21 00 00 00 23 00 00 00 25 00 00 00 27 00 00 00 2A 00 00 00 2A 00 00 00 2C 00 00' + '00 2C 00 00 00 2E 00 00 00 2F 00 00 00 3A 00 00 00 3B 00 00 00 3F 00 00 00 40 00 00 00 5C 00 00' + '00 5C 00 00 00 A1 00 00 00 A1 00 00 00 B7 00 00 00 B7 00 00 00 BF 00 00 00 BF 00 00 00 7E 03 00' + '00 7E 03 00 00 87 03 00 00 87 03 00 00 5A 05 00 00 5F 05 00 00 89 05 00 00 89 05 00 00 BE 05 00' + '00 BE 05 00 00 C0 05 00 00 C0 05 00 00 C3 05 00 00 C3 05 00 00 F3 05 00 00 F4 05 00 00 0C 06 00' + '00 0C 06 00 00 1B 06 00 00 1B 06 00 00 1F 06 00 00 1F 06 00 00 6A 06 00 00 6D 06 00 00 D4 06 00' + '00 D4 06 00 00 00 07 00 00 0D 07 00 00 64 09 00 00 65 09 00 00 70 09 00 00 70 09 00 00 F4 0D 00' + '00 F4 0D 00 00 4F 0E 00 00 4F 0E 00 00 5A 0E 00 00 5B 0E 00 00 04 0F 00 00 12 0F 00 00 85 0F 00' + '00 85 0F 00 00 4A 10 00 00 4F 10 00 00 FB 10 00 00 FB 10 00 00 61 13 00 00 68 13 00 00 6D 16 00' + '00 6E 16 00 00 EB 16 00 00 ED 16 00 00 D4 17 00 00 DA 17 00 00 DC 17 00 00 DC 17 00 00 00 18 00' + '00 05 18 00 00 07 18 00 00 0A 18 00 00 16 20 00 00 17 20 00 00 20 20 00 00 27 20 00 00 30 20 00' + '00 38 20 00 00 3B 20 00 00 3E 20 00 00 41 20 00 00 43 20 00 00 48 20 00 00 4D 20 00 00 01 30 00' + '00 03 30 00 00 30 FE 00 00 30 FE 00 00 49 FE 00 00 4C FE 00 00 50 FE 00 00 52 FE 00 00 54 FE 00' + '00 57 FE 00 00 5F FE 00 00 61 FE 00 00 68 FE 00 00 68 FE 00 00 6A FE 00 00 6B FE 00 00 01 FF 00' + '00 03 FF 00 00 05 FF 00 00 07 FF 00 00 0A FF 00 00 0A FF 00 00 0C FF 00 00 0C FF 00 00 0E FF 00' + '00 0F FF 00 00 1A FF 00 00 1B FF 00 00 1F FF 00 00 20 FF 00 00 3C FF 00 00 3C FF 00 00 61 FF 00' + '00 61 FF 00 00 64 FF 00 00 64 FF 00 00 1A 23 00 00 00 2B 00 00 00 2B 00 00 00 3C 00 00 00 3E 00' + '00 00 7C 00 00 00 7C 00 00 00 7E 00 00 00 7E 00 00 00 AC 00 00 00 AC 00 00 00 B1 00 00 00 B1 00' + '00 00 D7 00 00 00 D7 00 00 00 F7 00 00 00 F7 00 00 00 44 20 00 00 44 20 00 00 7A 20 00 00 7C 20' + '00 00 8A 20 00 00 8C 20 00 00 90 21 00 00 94 21 00 00 9A 21 00 00 9B 21 00 00 A0 21 00 00 A0 21' + '00 00 A3 21 00 00 A3 21 00 00 A6 21 00 00 A6 21 00 00 AE 21 00 00 AE 21 00 00 CE 21 00 00 CF 21' + '00 00 D2 21 00 00 D2 21 00 00 D4 21 00 00 D4 21 00 00 00 22 00 00 F1 22 00 00 08 23 00 00 0B 23' + '00 00 20 23 00 00 21 23 00 00 B7 25 00 00 B7 25 00 00 C1 25 00 00 C1 25 00 00 6F 26 00 00 6F 26' + '00 00 29 FB 00 00 29 FB 00 00 62 FE 00 00 62 FE 00 00 64 FE 00 00 66 FE 00 00 0B FF 00 00 0B FF' + '00 00 1C FF 00 00 1E FF 00 00 5C FF 00 00 5C FF 00 00 5E FF 00 00 5E FF 00 00 E2 FF 00 00 E2 FF' + '00 00 E9 FF 00 00 EC FF 00 00 1B 0A 00 00 00 24 00 00 00 24 00 00 00 A2 00 00 00 A5 00 00 00 F2' + '09 00 00 F3 09 00 00 3F 0E 00 00 3F 0E 00 00 DB 17 00 00 DB 17 00 00 A0 20 00 00 AF 20 00 00 69' + 'FE 00 00 69 FE 00 00 04 FF 00 00 04 FF 00 00 E0 FF 00 00 E1 FF 00 00 E5 FF 00 00 E6 FF 00 00 1C' + '16 00 00 00 5E 00 00 00 5E 00 00 00 60 00 00 00 60 00 00 00 A8 00 00 00 A8 00 00 00 AF 00 00 00' + 'AF 00 00 00 B4 00 00 00 B4 00 00 00 B8 00 00 00 B8 00 00 00 B9 02 00 00 BA 02 00 00 C2 02 00 00' + 'CF 02 00 00 D2 02 00 00 DF 02 00 00 E5 02 00 00 ED 02 00 00 74 03 00 00 75 03 00 00 84 03 00 00' + '85 03 00 00 BD 1F 00 00 BD 1F 00 00 BF 1F 00 00 C1 1F 00 00 CD 1F 00 00 CF 1F 00 00 DD 1F 00 00' + 'DF 1F 00 00 ED 1F 00 00 EF 1F 00 00 FD 1F 00 00 FE 1F 00 00 9B 30 00 00 9C 30 00 00 3E FF 00 00' + '3E FF 00 00 40 FF 00 00 40 FF 00 00 E3 FF 00 00 E3 FF 00 00 1D 62 00 00 00 A6 00 00 00 A7 00 00' + '00 A9 00 00 00 A9 00 00 00 AE 00 00 00 AE 00 00 00 B0 00 00 00 B0 00 00 00 B6 00 00 00 B6 00 00' + '00 82 04 00 00 82 04 00 00 E9 06 00 00 E9 06 00 00 FD 06 00 00 FE 06 00 00 FA 09 00 00 FA 09 00' + '00 70 0B 00 00 70 0B 00 00 01 0F 00 00 03 0F 00 00 13 0F 00 00 17 0F 00 00 1A 0F 00 00 1F 0F 00' + '00 34 0F 00 00 34 0F 00 00 36 0F 00 00 36 0F 00 00 38 0F 00 00 38 0F 00 00 BE 0F 00 00 C5 0F 00' + '00 C7 0F 00 00 CC 0F 00 00 CF 0F 00 00 CF 0F 00 00 00 21 00 00 01 21 00 00 03 21 00 00 06 21 00' + '00 08 21 00 00 09 21 00 00 14 21 00 00 14 21 00 00 16 21 00 00 18 21 00 00 1E 21 00 00 23 21 00' + '00 25 21 00 00 25 21 00 00 27 21 00 00 27 21 00 00 29 21 00 00 29 21 00 00 2E 21 00 00 2E 21 00' + '00 32 21 00 00 32 21 00 00 3A 21 00 00 3A 21 00 00 95 21 00 00 99 21 00 00 9C 21 00 00 9F 21 00' + '00 A1 21 00 00 A2 21 00 00 A4 21 00 00 A5 21 00 00 A7 21 00 00 AD 21 00 00 AF 21 00 00 CD 21 00' + '00 D0 21 00 00 D1 21 00 00 D3 21 00 00 D3 21 00 00 D5 21 00 00 F3 21 00 00 00 23 00 00 07 23 00' + '00 0C 23 00 00 1F 23 00 00 22 23 00 00 28 23 00 00 2B 23 00 00 7B 23 00 00 7D 23 00 00 9A 23 00' + '00 00 24 00 00 26 24 00 00 40 24 00 00 4A 24 00 00 9C 24 00 00 E9 24 00 00 00 25 00 00 95 25 00' + '00 A0 25 00 00 B6 25 00 00 B8 25 00 00 C0 25 00 00 C2 25 00 00 F7 25 00 00 00 26 00 00 13 26 00' + '00 19 26 00 00 6E 26 00 00 70 26 00 00 71 26 00 00 01 27 00 00 04 27 00 00 06 27 00 00 09 27 00' + '00 0C 27 00 00 27 27 00 00 29 27 00 00 4B 27 00 00 4D 27 00 00 4D 27 00 00 4F 27 00 00 52 27 00' + '00 56 27 00 00 56 27 00 00 58 27 00 00 5E 27 00 00 61 27 00 00 67 27 00 00 94 27 00 00 94 27 00' + '00 98 27 00 00 AF 27 00 00 B1 27 00 00 BE 27 00 00 00 28 00 00 FF 28 00 00 80 2E 00 00 99 2E 00' + '00 9B 2E 00 00 F3 2E 00 00 00 2F 00 00 D5 2F 00 00 F0 2F 00 00 FB 2F 00 00 04 30 00 00 04 30 00' + '00 12 30 00 00 13 30 00 00 20 30 00 00 20 30 00 00 36 30 00 00 37 30 00 00 3E 30 00 00 3F 30 00' + '00 90 31 00 00 91 31 00 00 96 31 00 00 9F 31 00 00 00 32 00 00 1C 32 00 00 2A 32 00 00 43 32 00' + '00 60 32 00 00 7B 32 00 00 7F 32 00 00 7F 32 00 00 8A 32 00 00 B0 32 00 00 C0 32 00 00 CB 32 00' + '00 D0 32 00 00 FE 32 00 00 00 33 00 00 76 33 00 00 7B 33 00 00 DD 33 00 00 E0 33 00 00 FE 33 00' + '00 90 A4 00 00 A1 A4 00 00 A4 A4 00 00 B3 A4 00 00 B5 A4 00 00 C0 A4 00 00 C2 A4 00 00 C4 A4 00' + '00 C6 A4 00 00 C6 A4 00 00 E4 FF 00 00 E4 FF 00 00 E8 FF 00 00 E8 FF 00 00 ED FF 00 00 EE FF 00' + '00 FC FF 00 00 FD FF 00 00 1E 3F 01 00 00 41 00 00 00 5A 00 00 00 61 00 00 00 7A 00 00 00 AA 00' + '00 00 AA 00 00 00 B5 00 00 00 B5 00 00 00 BA 00 00 00 BA 00 00 00 C0 00 00 00 D6 00 00 00 D8 00' + '00 00 F6 00 00 00 F8 00 00 00 1F 02 00 00 22 02 00 00 33 02 00 00 50 02 00 00 AD 02 00 00 B0 02' + '00 00 B8 02 00 00 BB 02 00 00 C1 02 00 00 D0 02 00 00 D1 02 00 00 E0 02 00 00 E4 02 00 00 EE 02' + '00 00 EE 02 00 00 7A 03 00 00 7A 03 00 00 86 03 00 00 86 03 00 00 88 03 00 00 8A 03 00 00 8C 03' + '00 00 8C 03 00 00 8E 03 00 00 A1 03 00 00 A3 03 00 00 CE 03 00 00 D0 03 00 00 D7 03 00 00 DA 03' + '00 00 F3 03 00 00 00 04 00 00 82 04 00 00 8C 04 00 00 C4 04 00 00 C7 04 00 00 C8 04 00 00 CB 04' + '00 00 CC 04 00 00 D0 04 00 00 F5 04 00 00 F8 04 00 00 F9 04 00 00 31 05 00 00 56 05 00 00 59 05' + '00 00 5F 05 00 00 61 05 00 00 87 05 00 00 89 05 00 00 89 05 00 00 03 09 00 00 03 09 00 00 05 09' + '00 00 39 09 00 00 3D 09 00 00 40 09 00 00 49 09 00 00 4C 09 00 00 50 09 00 00 50 09 00 00 58 09' + '00 00 61 09 00 00 64 09 00 00 70 09 00 00 82 09 00 00 83 09 00 00 85 09 00 00 8C 09 00 00 8F 09' + '00 00 90 09 00 00 93 09 00 00 A8 09 00 00 AA 09 00 00 B0 09 00 00 B2 09 00 00 B2 09 00 00 B6 09' + '00 00 B9 09 00 00 BE 09 00 00 C0 09 00 00 C7 09 00 00 C8 09 00 00 CB 09 00 00 CC 09 00 00 D7 09' + '00 00 D7 09 00 00 DC 09 00 00 DD 09 00 00 DF 09 00 00 E1 09 00 00 E6 09 00 00 F1 09 00 00 F4 09' + '00 00 FA 09 00 00 05 0A 00 00 0A 0A 00 00 0F 0A 00 00 10 0A 00 00 13 0A 00 00 28 0A 00 00 2A 0A' + '00 00 30 0A 00 00 32 0A 00 00 33 0A 00 00 35 0A 00 00 36 0A 00 00 38 0A 00 00 39 0A 00 00 3E 0A' + '00 00 40 0A 00 00 59 0A 00 00 5C 0A 00 00 5E 0A 00 00 5E 0A 00 00 66 0A 00 00 6F 0A 00 00 72 0A' + '00 00 74 0A 00 00 83 0A 00 00 83 0A 00 00 85 0A 00 00 8B 0A 00 00 8D 0A 00 00 8D 0A 00 00 8F 0A' + '00 00 91 0A 00 00 93 0A 00 00 A8 0A 00 00 AA 0A 00 00 B0 0A 00 00 B2 0A 00 00 B3 0A 00 00 B5 0A' + '00 00 B9 0A 00 00 BD 0A 00 00 C0 0A 00 00 C9 0A 00 00 C9 0A 00 00 CB 0A 00 00 CC 0A 00 00 D0 0A' + '00 00 D0 0A 00 00 E0 0A 00 00 E0 0A 00 00 E6 0A 00 00 EF 0A 00 00 02 0B 00 00 03 0B 00 00 05 0B' + '00 00 0C 0B 00 00 0F 0B 00 00 10 0B 00 00 13 0B 00 00 28 0B 00 00 2A 0B 00 00 30 0B 00 00 32 0B' + '00 00 33 0B 00 00 36 0B 00 00 39 0B 00 00 3D 0B 00 00 3E 0B 00 00 40 0B 00 00 40 0B 00 00 47 0B' + '00 00 48 0B 00 00 4B 0B 00 00 4C 0B 00 00 57 0B 00 00 57 0B 00 00 5C 0B 00 00 5D 0B 00 00 5F 0B' + '00 00 61 0B 00 00 66 0B 00 00 70 0B 00 00 83 0B 00 00 83 0B 00 00 85 0B 00 00 8A 0B 00 00 8E 0B' + '00 00 90 0B 00 00 92 0B 00 00 95 0B 00 00 99 0B 00 00 9A 0B 00 00 9C 0B 00 00 9C 0B 00 00 9E 0B' + '00 00 9F 0B 00 00 A3 0B 00 00 A4 0B 00 00 A8 0B 00 00 AA 0B 00 00 AE 0B 00 00 B5 0B 00 00 B7 0B' + '00 00 B9 0B 00 00 BE 0B 00 00 BF 0B 00 00 C1 0B 00 00 C2 0B 00 00 C6 0B 00 00 C8 0B 00 00 CA 0B' + '00 00 CC 0B 00 00 D7 0B 00 00 D7 0B 00 00 E7 0B 00 00 F2 0B 00 00 01 0C 00 00 03 0C 00 00 05 0C' + '00 00 0C 0C 00 00 0E 0C 00 00 10 0C 00 00 12 0C 00 00 28 0C 00 00 2A 0C 00 00 33 0C 00 00 35 0C' + '00 00 39 0C 00 00 41 0C 00 00 44 0C 00 00 60 0C 00 00 61 0C 00 00 66 0C 00 00 6F 0C 00 00 82 0C' + '00 00 83 0C 00 00 85 0C 00 00 8C 0C 00 00 8E 0C 00 00 90 0C 00 00 92 0C 00 00 A8 0C 00 00 AA 0C' + '00 00 B3 0C 00 00 B5 0C 00 00 B9 0C 00 00 BE 0C 00 00 BE 0C 00 00 C0 0C 00 00 C4 0C 00 00 C7 0C' + '00 00 C8 0C 00 00 CA 0C 00 00 CB 0C 00 00 D5 0C 00 00 D6 0C 00 00 DE 0C 00 00 DE 0C 00 00 E0 0C' + '00 00 E1 0C 00 00 E6 0C 00 00 EF 0C 00 00 02 0D 00 00 03 0D 00 00 05 0D 00 00 0C 0D 00 00 0E 0D' + '00 00 10 0D 00 00 12 0D 00 00 28 0D 00 00 2A 0D 00 00 39 0D 00 00 3E 0D 00 00 40 0D 00 00 46 0D' + '00 00 48 0D 00 00 4A 0D 00 00 4C 0D 00 00 57 0D 00 00 57 0D 00 00 60 0D 00 00 61 0D 00 00 66 0D' + '00 00 6F 0D 00 00 82 0D 00 00 83 0D 00 00 85 0D 00 00 96 0D 00 00 9A 0D 00 00 B1 0D 00 00 B3 0D' + '00 00 BB 0D 00 00 BD 0D 00 00 BD 0D 00 00 C0 0D 00 00 C6 0D 00 00 CF 0D 00 00 D1 0D 00 00 D8 0D' + '00 00 DF 0D 00 00 F2 0D 00 00 F4 0D 00 00 01 0E 00 00 30 0E 00 00 32 0E 00 00 33 0E 00 00 40 0E' + '00 00 46 0E 00 00 4F 0E 00 00 5B 0E 00 00 81 0E 00 00 82 0E 00 00 84 0E 00 00 84 0E 00 00 87 0E' + '00 00 88 0E 00 00 8A 0E 00 00 8A 0E 00 00 8D 0E 00 00 8D 0E 00 00 94 0E 00 00 97 0E 00 00 99 0E' + '00 00 9F 0E 00 00 A1 0E 00 00 A3 0E 00 00 A5 0E 00 00 A5 0E 00 00 A7 0E 00 00 A7 0E 00 00 AA 0E' + '00 00 AB 0E 00 00 AD 0E 00 00 B0 0E 00 00 B2 0E 00 00 B3 0E 00 00 BD 0E 00 00 BD 0E 00 00 C0 0E' + '00 00 C4 0E 00 00 C6 0E 00 00 C6 0E 00 00 D0 0E 00 00 D9 0E 00 00 DC 0E 00 00 DD 0E 00 00 00 0F' + '00 00 17 0F 00 00 1A 0F 00 00 34 0F 00 00 36 0F 00 00 36 0F 00 00 38 0F 00 00 38 0F 00 00 3E 0F' + '00 00 47 0F 00 00 49 0F 00 00 6A 0F 00 00 7F 0F 00 00 7F 0F 00 00 85 0F 00 00 85 0F 00 00 88 0F' + '00 00 8B 0F 00 00 BE 0F 00 00 C5 0F 00 00 C7 0F 00 00 CC 0F 00 00 CF 0F 00 00 CF 0F 00 00 00 10' + '00 00 21 10 00 00 23 10 00 00 27 10 00 00 29 10 00 00 2A 10 00 00 2C 10 00 00 2C 10 00 00 31 10' + '00 00 31 10 00 00 38 10 00 00 38 10 00 00 40 10 00 00 57 10 00 00 A0 10 00 00 C5 10 00 00 D0 10' + '00 00 F6 10 00 00 FB 10 00 00 FB 10 00 00 00 11 00 00 59 11 00 00 5F 11 00 00 A2 11 00 00 A8 11' + '00 00 F9 11 00 00 00 12 00 00 06 12 00 00 08 12 00 00 46 12 00 00 48 12 00 00 48 12 00 00 4A 12' + '00 00 4D 12 00 00 50 12 00 00 56 12 00 00 58 12 00 00 58 12 00 00 5A 12 00 00 5D 12 00 00 60 12' + '00 00 86 12 00 00 88 12 00 00 88 12 00 00 8A 12 00 00 8D 12 00 00 90 12 00 00 AE 12 00 00 B0 12' + '00 00 B0 12 00 00 B2 12 00 00 B5 12 00 00 B8 12 00 00 BE 12 00 00 C0 12 00 00 C0 12 00 00 C2 12' + '00 00 C5 12 00 00 C8 12 00 00 CE 12 00 00 D0 12 00 00 D6 12 00 00 D8 12 00 00 EE 12 00 00 F0 12' + '00 00 0E 13 00 00 10 13 00 00 10 13 00 00 12 13 00 00 15 13 00 00 18 13 00 00 1E 13 00 00 20 13' + '00 00 46 13 00 00 48 13 00 00 5A 13 00 00 61 13 00 00 7C 13 00 00 A0 13 00 00 F4 13 00 00 01 14' + '00 00 76 16 00 00 81 16 00 00 9A 16 00 00 A0 16 00 00 F0 16 00 00 80 17 00 00 B6 17 00 00 BE 17' + '00 00 C5 17 00 00 C7 17 00 00 C8 17 00 00 D4 17 00 00 DA 17 00 00 DC 17 00 00 DC 17 00 00 E0 17' + '00 00 E9 17 00 00 10 18 00 00 19 18 00 00 20 18 00 00 77 18 00 00 80 18 00 00 A8 18 00 00 00 1E' + '00 00 9B 1E 00 00 A0 1E 00 00 F9 1E 00 00 00 1F 00 00 15 1F 00 00 18 1F 00 00 1D 1F 00 00 20 1F' + '00 00 45 1F 00 00 48 1F 00 00 4D 1F 00 00 50 1F 00 00 57 1F 00 00 59 1F 00 00 59 1F 00 00 5B 1F' + '00 00 5B 1F 00 00 5D 1F 00 00 5D 1F 00 00 5F 1F 00 00 7D 1F 00 00 80 1F 00 00 B4 1F 00 00 B6 1F' + '00 00 BC 1F 00 00 BE 1F 00 00 BE 1F 00 00 C2 1F 00 00 C4 1F 00 00 C6 1F 00 00 CC 1F 00 00 D0 1F' + '00 00 D3 1F 00 00 D6 1F 00 00 DB 1F 00 00 E0 1F 00 00 EC 1F 00 00 F2 1F 00 00 F4 1F 00 00 F6 1F' + '00 00 FC 1F 00 00 0E 20 00 00 0E 20 00 00 7F 20 00 00 7F 20 00 00 02 21 00 00 02 21 00 00 07 21' + '00 00 07 21 00 00 0A 21 00 00 13 21 00 00 15 21 00 00 15 21 00 00 19 21 00 00 1D 21 00 00 24 21' + '00 00 24 21 00 00 26 21 00 00 26 21 00 00 28 21 00 00 28 21 00 00 2A 21 00 00 2D 21 00 00 2F 21' + '00 00 31 21 00 00 33 21 00 00 39 21 00 00 60 21 00 00 83 21 00 00 36 23 00 00 7A 23 00 00 95 23' + '00 00 95 23 00 00 9C 24 00 00 E9 24 00 00 05 30 00 00 07 30 00 00 21 30 00 00 29 30 00 00 31 30' + '00 00 35 30 00 00 38 30 00 00 3A 30 00 00 41 30 00 00 94 30 00 00 9D 30 00 00 9E 30 00 00 A1 30' + '00 00 FA 30 00 00 FC 30 00 00 FE 30 00 00 05 31 00 00 2C 31 00 00 31 31 00 00 8E 31 00 00 90 31' + '00 00 B7 31 00 00 00 32 00 00 1C 32 00 00 20 32 00 00 43 32 00 00 60 32 00 00 7B 32 00 00 7F 32' + '00 00 B0 32 00 00 C0 32 00 00 CB 32 00 00 D0 32 00 00 FE 32 00 00 00 33 00 00 76 33 00 00 7B 33' + '00 00 DD 33 00 00 E0 33 00 00 FE 33 00 00 00 34 00 00 B5 4D 00 00 00 4E 00 00 A5 9F 00 00 00 A0' + '00 00 8C A4 00 00 00 AC 00 00 A3 D7 00 00 00 D8 00 00 7F DB 00 00 80 DB 00 00 FF DB 00 00 00 DC' + '00 00 FF DF 00 00 00 E0 00 00 2D FA 00 00 00 FB 00 00 06 FB 00 00 13 FB 00 00 17 FB 00 00 21 FF' + '00 00 3A FF 00 00 41 FF 00 00 5A FF 00 00 66 FF 00 00 BE FF 00 00 C2 FF 00 00 C7 FF 00 00 CA FF' + '00 00 CF FF 00 00 D2 FF 00 00 D7 FF 00 00 DA FF 00 00 DC FF 00 00 00 00 0F 00 FD FF 0F 00 00 00' + '10 00 FD FF 10 00 1F 01 00 00 00 2A 20 00 00 2A 20 00 00 20 01 00 00 00 2D 20 00 00 2D 20 00 00' + '21 0E 00 00 00 BE 05 00 00 BE 05 00 00 C0 05 00 00 C0 05 00 00 C3 05 00 00 C3 05 00 00 D0 05 00' + '00 EA 05 00 00 F0 05 00 00 F4 05 00 00 0F 20 00 00 0F 20 00 00 1D FB 00 00 1D FB 00 00 1F FB 00' + '00 28 FB 00 00 2A FB 00 00 36 FB 00 00 38 FB 00 00 3C FB 00 00 3E FB 00 00 3E FB 00 00 40 FB 00' + '00 41 FB 00 00 43 FB 00 00 44 FB 00 00 46 FB 00 00 4F FB 00 00 22 14 00 00 00 1B 06 00 00 1B 06' + '00 00 1F 06 00 00 1F 06 00 00 21 06 00 00 3A 06 00 00 40 06 00 00 4A 06 00 00 6D 06 00 00 6D 06' + '00 00 71 06 00 00 D5 06 00 00 E5 06 00 00 E6 06 00 00 FA 06 00 00 FE 06 00 00 00 07 00 00 0D 07' + '00 00 10 07 00 00 10 07 00 00 12 07 00 00 2C 07 00 00 80 07 00 00 A5 07 00 00 50 FB 00 00 B1 FB' + '00 00 D3 FB 00 00 3D FD 00 00 50 FD 00 00 8F FD 00 00 92 FD 00 00 C7 FD 00 00 F0 FD 00 00 FB FD' + '00 00 70 FE 00 00 72 FE 00 00 74 FE 00 00 74 FE 00 00 76 FE 00 00 FC FE 00 00 23 01 00 00 00 2B' + '20 00 00 2B 20 00 00 24 01 00 00 00 2E 20 00 00 2E 20 00 00 25 01 00 00 00 2C 20 00 00 2C 20 00' + '00 26 0A 00 00 00 30 00 00 00 39 00 00 00 B2 00 00 00 B3 00 00 00 B9 00 00 00 B9 00 00 00 F0 06' + '00 00 F9 06 00 00 70 20 00 00 70 20 00 00 74 20 00 00 79 20 00 00 80 20 00 00 89 20 00 00 60 24' + '00 00 9B 24 00 00 EA 24 00 00 EA 24 00 00 10 FF 00 00 19 FF 00 00 27 02 00 00 00 2F 00 00 00 2F' + '00 00 00 0F FF 00 00 0F FF 00 00 28 18 00 00 00 23 00 00 00 25 00 00 00 2B 00 00 00 2B 00 00 00' + '2D 00 00 00 2D 00 00 00 A2 00 00 00 A5 00 00 00 B0 00 00 00 B1 00 00 00 6A 06 00 00 6A 06 00 00' + 'F2 09 00 00 F3 09 00 00 3F 0E 00 00 3F 0E 00 00 DB 17 00 00 DB 17 00 00 30 20 00 00 34 20 00 00' + '7A 20 00 00 7B 20 00 00 8A 20 00 00 8B 20 00 00 A0 20 00 00 AF 20 00 00 2E 21 00 00 2E 21 00 00' + '12 22 00 00 13 22 00 00 29 FB 00 00 29 FB 00 00 5F FE 00 00 5F FE 00 00 62 FE 00 00 63 FE 00 00' + '69 FE 00 00 6A FE 00 00 03 FF 00 00 05 FF 00 00 0B FF 00 00 0B FF 00 00 0D FF 00 00 0D FF 00 00' + 'E0 FF 00 00 E1 FF 00 00 E5 FF 00 00 E6 FF 00 00 29 02 00 00 00 60 06 00 00 69 06 00 00 6B 06 00' + '00 6C 06 00 00 2A 0B 00 00 00 2C 00 00 00 2C 00 00 00 2E 00 00 00 2E 00 00 00 3A 00 00 00 3A 00' + '00 00 A0 00 00 00 A0 00 00 00 0C 06 00 00 0C 06 00 00 50 FE 00 00 50 FE 00 00 52 FE 00 00 52 FE' + '00 00 55 FE 00 00 55 FE 00 00 0C FF 00 00 0C FF 00 00 0E FF 00 00 0E FF 00 00 1A FF 00 00 1A FF' + '00 00 2B 0A 00 00 00 00 00 00 00 08 00 00 00 0E 00 00 00 1B 00 00 00 7F 00 00 00 84 00 00 00 86' + '00 00 00 9F 00 00 00 0F 07 00 00 0F 07 00 00 0B 18 00 00 0E 18 00 00 0B 20 00 00 0D 20 00 00 6A' + '20 00 00 6F 20 00 00 FF FE 00 00 FF FE 00 00 F9 FF 00 00 FB FF 00 00 2C 03 00 00 00 09 00 00 00' + '09 00 00 00 0B 00 00 00 0B 00 00 00 1F 00 00 00 1F 00 00 00 2D 07 00 00 00 0C 00 00 00 0C 00 00' + '00 20 00 00 00 20 00 00 00 80 16 00 00 80 16 00 00 00 20 00 00 0A 20 00 00 28 20 00 00 28 20 00' + '00 2F 20 00 00 2F 20 00 00 00 30 00 00 00 30 00 00 2E 6E 00 00 00 21 00 00 00 22 00 00 00 26 00' + '00 00 2A 00 00 00 3B 00 00 00 40 00 00 00 5B 00 00 00 60 00 00 00 7B 00 00 00 7E 00 00 00 A1 00' + '00 00 A1 00 00 00 A6 00 00 00 A9 00 00 00 AB 00 00 00 AF 00 00 00 B4 00 00 00 B4 00 00 00 B6 00' + '00 00 B8 00 00 00 BB 00 00 00 BF 00 00 00 D7 00 00 00 D7 00 00 00 F7 00 00 00 F7 00 00 00 B9 02' + '00 00 BA 02 00 00 C2 02 00 00 CF 02 00 00 D2 02 00 00 DF 02 00 00 E5 02 00 00 ED 02 00 00 74 03' + '00 00 75 03 00 00 7E 03 00 00 7E 03 00 00 84 03 00 00 85 03 00 00 87 03 00 00 87 03 00 00 8A 05' + '00 00 8A 05 00 00 E9 06 00 00 E9 06 00 00 3A 0F 00 00 3D 0F 00 00 9B 16 00 00 9C 16 00 00 00 18' + '00 00 0A 18 00 00 BD 1F 00 00 BD 1F 00 00 BF 1F 00 00 C1 1F 00 00 CD 1F 00 00 CF 1F 00 00 DD 1F' + '00 00 DF 1F 00 00 ED 1F 00 00 EF 1F 00 00 FD 1F 00 00 FE 1F 00 00 10 20 00 00 27 20 00 00 35 20' + '00 00 46 20 00 00 48 20 00 00 4D 20 00 00 7C 20 00 00 7E 20 00 00 8C 20 00 00 8E 20 00 00 00 21' + '00 00 01 21 00 00 03 21 00 00 06 21 00 00 08 21 00 00 09 21 00 00 14 21 00 00 14 21 00 00 16 21' + '00 00 18 21 00 00 1E 21 00 00 23 21 00 00 25 21 00 00 25 21 00 00 27 21 00 00 27 21 00 00 29 21' + '00 00 29 21 00 00 32 21 00 00 32 21 00 00 3A 21 00 00 3A 21 00 00 53 21 00 00 5F 21 00 00 90 21' + '00 00 F3 21 00 00 00 22 00 00 11 22 00 00 14 22 00 00 F1 22 00 00 00 23 00 00 35 23 00 00 7B 23' + '00 00 7B 23 00 00 7D 23 00 00 94 23 00 00 96 23 00 00 9A 23 00 00 00 24 00 00 26 24 00 00 40 24' + '00 00 4A 24 00 00 00 25 00 00 95 25 00 00 A0 25 00 00 F7 25 00 00 00 26 00 00 13 26 00 00 19 26' + '00 00 71 26 00 00 01 27 00 00 04 27 00 00 06 27 00 00 09 27 00 00 0C 27 00 00 27 27 00 00 29 27' + '00 00 4B 27 00 00 4D 27 00 00 4D 27 00 00 4F 27 00 00 52 27 00 00 56 27 00 00 56 27 00 00 58 27' + '00 00 5E 27 00 00 61 27 00 00 67 27 00 00 76 27 00 00 94 27 00 00 98 27 00 00 AF 27 00 00 B1 27' + '00 00 BE 27 00 00 00 28 00 00 FF 28 00 00 80 2E 00 00 99 2E 00 00 9B 2E 00 00 F3 2E 00 00 00 2F' + '00 00 D5 2F 00 00 F0 2F 00 00 FB 2F 00 00 01 30 00 00 04 30 00 00 08 30 00 00 20 30 00 00 30 30' + '00 00 30 30 00 00 36 30 00 00 37 30 00 00 3E 30 00 00 3F 30 00 00 9B 30 00 00 9C 30 00 00 FB 30' + '00 00 FB 30 00 00 90 A4 00 00 A1 A4 00 00 A4 A4 00 00 B3 A4 00 00 B5 A4 00 00 C0 A4 00 00 C2 A4' + '00 00 C4 A4 00 00 C6 A4 00 00 C6 A4 00 00 3E FD 00 00 3F FD 00 00 30 FE 00 00 44 FE 00 00 49 FE' + '00 00 4F FE 00 00 51 FE 00 00 51 FE 00 00 54 FE 00 00 54 FE 00 00 56 FE 00 00 5E FE 00 00 60 FE' + '00 00 61 FE 00 00 64 FE 00 00 66 FE 00 00 68 FE 00 00 68 FE 00 00 6B FE 00 00 6B FE 00 00 01 FF' + '00 00 02 FF 00 00 06 FF 00 00 0A FF 00 00 1B FF 00 00 20 FF 00 00 3B FF 00 00 40 FF 00 00 5B FF' + '00 00 5E FF 00 00 61 FF 00 00 65 FF 00 00 E2 FF 00 00 E4 FF 00 00 E8 FF 00 00 EE FF 00 00 FC FF' + '00 00 FD FF 00 00 2F CD 00 00 00 C0 00 00 00 C5 00 00 00 C7 00 00 00 CF 00 00 00 D1 00 00 00 D6' + '00 00 00 D9 00 00 00 DD 00 00 00 E0 00 00 00 E5 00 00 00 E7 00 00 00 EF 00 00 00 F1 00 00 00 F6' + '00 00 00 F9 00 00 00 FD 00 00 00 FF 00 00 00 0F 01 00 00 12 01 00 00 25 01 00 00 28 01 00 00 30' + '01 00 00 34 01 00 00 37 01 00 00 39 01 00 00 3E 01 00 00 43 01 00 00 48 01 00 00 4C 01 00 00 51' + '01 00 00 54 01 00 00 65 01 00 00 68 01 00 00 7E 01 00 00 A0 01 00 00 A1 01 00 00 AF 01 00 00 B0' + '01 00 00 CD 01 00 00 DC 01 00 00 DE 01 00 00 E3 01 00 00 E6 01 00 00 F0 01 00 00 F4 01 00 00 F5' + '01 00 00 F8 01 00 00 1B 02 00 00 1E 02 00 00 1F 02 00 00 26 02 00 00 33 02 00 00 44 03 00 00 44' + '03 00 00 85 03 00 00 86 03 00 00 88 03 00 00 8A 03 00 00 8C 03 00 00 8C 03 00 00 8E 03 00 00 90' + '03 00 00 AA 03 00 00 B0 03 00 00 CA 03 00 00 CE 03 00 00 D3 03 00 00 D4 03 00 00 00 04 00 00 01' + '04 00 00 03 04 00 00 03 04 00 00 07 04 00 00 07 04 00 00 0C 04 00 00 0E 04 00 00 19 04 00 00 19' + '04 00 00 39 04 00 00 39 04 00 00 50 04 00 00 51 04 00 00 53 04 00 00 53 04 00 00 57 04 00 00 57' + '04 00 00 5C 04 00 00 5E 04 00 00 76 04 00 00 77 04 00 00 C1 04 00 00 C2 04 00 00 D0 04 00 00 D3' + '04 00 00 D6 04 00 00 D7 04 00 00 DA 04 00 00 DF 04 00 00 E2 04 00 00 E7 04 00 00 EA 04 00 00 F5' + '04 00 00 F8 04 00 00 F9 04 00 00 22 06 00 00 26 06 00 00 C0 06 00 00 C0 06 00 00 C2 06 00 00 C2' + '06 00 00 D3 06 00 00 D3 06 00 00 29 09 00 00 29 09 00 00 31 09 00 00 31 09 00 00 34 09 00 00 34' + '09 00 00 58 09 00 00 5F 09 00 00 CB 09 00 00 CC 09 00 00 DC 09 00 00 DD 09 00 00 DF 09 00 00 DF' + '09 00 00 33 0A 00 00 33 0A 00 00 36 0A 00 00 36 0A 00 00 59 0A 00 00 5B 0A 00 00 5E 0A 00 00 5E' + '0A 00 00 48 0B 00 00 48 0B 00 00 4B 0B 00 00 4C 0B 00 00 5C 0B 00 00 5D 0B 00 00 94 0B 00 00 94' + '0B 00 00 CA 0B 00 00 CC 0B 00 00 48 0C 00 00 48 0C 00 00 C0 0C 00 00 C0 0C 00 00 C7 0C 00 00 C8' + '0C 00 00 CA 0C 00 00 CB 0C 00 00 4A 0D 00 00 4C 0D 00 00 DA 0D 00 00 DA 0D 00 00 DC 0D 00 00 DE' + '0D 00 00 43 0F 00 00 43 0F 00 00 4D 0F 00 00 4D 0F 00 00 52 0F 00 00 52 0F 00 00 57 0F 00 00 57' + '0F 00 00 5C 0F 00 00 5C 0F 00 00 69 0F 00 00 69 0F 00 00 73 0F 00 00 73 0F 00 00 75 0F 00 00 76' + '0F 00 00 78 0F 00 00 78 0F 00 00 81 0F 00 00 81 0F 00 00 93 0F 00 00 93 0F 00 00 9D 0F 00 00 9D' + '0F 00 00 A2 0F 00 00 A2 0F 00 00 A7 0F 00 00 A7 0F 00 00 AC 0F 00 00 AC 0F 00 00 B9 0F 00 00 B9' + '0F 00 00 26 10 00 00 26 10 00 00 00 1E 00 00 99 1E 00 00 9B 1E 00 00 9B 1E 00 00 A0 1E 00 00 F9' + '1E 00 00 00 1F 00 00 15 1F 00 00 18 1F 00 00 1D 1F 00 00 20 1F 00 00 45 1F 00 00 48 1F 00 00 4D' + '1F 00 00 50 1F 00 00 57 1F 00 00 59 1F 00 00 59 1F 00 00 5B 1F 00 00 5B 1F 00 00 5D 1F 00 00 5D' + '1F 00 00 5F 1F 00 00 70 1F 00 00 72 1F 00 00 72 1F 00 00 74 1F 00 00 74 1F 00 00 76 1F 00 00 76' + '1F 00 00 78 1F 00 00 78 1F 00 00 7A 1F 00 00 7A 1F 00 00 7C 1F 00 00 7C 1F 00 00 80 1F 00 00 B4' + '1F 00 00 B6 1F 00 00 BA 1F 00 00 BC 1F 00 00 BC 1F 00 00 C1 1F 00 00 C4 1F 00 00 C6 1F 00 00 C8' + '1F 00 00 CA 1F 00 00 CA 1F 00 00 CC 1F 00 00 D2 1F 00 00 D6 1F 00 00 DA 1F 00 00 DD 1F 00 00 E2' + '1F 00 00 E4 1F 00 00 EA 1F 00 00 EC 1F 00 00 ED 1F 00 00 F2 1F 00 00 F4 1F 00 00 F6 1F 00 00 F8' + '1F 00 00 FA 1F 00 00 FA 1F 00 00 FC 1F 00 00 FC 1F 00 00 9A 21 00 00 9B 21 00 00 AE 21 00 00 AE' + '21 00 00 CD 21 00 00 CF 21 00 00 04 22 00 00 04 22 00 00 09 22 00 00 09 22 00 00 0C 22 00 00 0C' + '22 00 00 24 22 00 00 24 22 00 00 26 22 00 00 26 22 00 00 41 22 00 00 41 22 00 00 44 22 00 00 44' + '22 00 00 47 22 00 00 47 22 00 00 49 22 00 00 49 22 00 00 60 22 00 00 60 22 00 00 62 22 00 00 62' + '22 00 00 6D 22 00 00 71 22 00 00 74 22 00 00 75 22 00 00 78 22 00 00 79 22 00 00 80 22 00 00 81' + '22 00 00 84 22 00 00 85 22 00 00 88 22 00 00 89 22 00 00 AC 22 00 00 AF 22 00 00 E0 22 00 00 E3' + '22 00 00 EA 22 00 00 ED 22 00 00 4C 30 00 00 4C 30 00 00 4E 30 00 00 4E 30 00 00 50 30 00 00 50' + '30 00 00 52 30 00 00 52 30 00 00 54 30 00 00 54 30 00 00 56 30 00 00 56 30 00 00 58 30 00 00 58' + '30 00 00 5A 30 00 00 5A 30 00 00 5C 30 00 00 5C 30 00 00 5E 30 00 00 5E 30 00 00 60 30 00 00 60' + '30 00 00 62 30 00 00 62 30 00 00 65 30 00 00 65 30 00 00 67 30 00 00 67 30 00 00 69 30 00 00 69' + '30 00 00 70 30 00 00 71 30 00 00 73 30 00 00 74 30 00 00 76 30 00 00 77 30 00 00 79 30 00 00 7A' + '30 00 00 7C 30 00 00 7D 30 00 00 94 30 00 00 94 30 00 00 9E 30 00 00 9E 30 00 00 AC 30 00 00 AC' + '30 00 00 AE 30 00 00 AE 30 00 00 B0 30 00 00 B0 30 00 00 B2 30 00 00 B2 30 00 00 B4 30 00 00 B4' + '30 00 00 B6 30 00 00 B6 30 00 00 B8 30 00 00 B8 30 00 00 BA 30 00 00 BA 30 00 00 BC 30 00 00 BC' + '30 00 00 BE 30 00 00 BE 30 00 00 C0 30 00 00 C0 30 00 00 C2 30 00 00 C2 30 00 00 C5 30 00 00 C5' + '30 00 00 C7 30 00 00 C7 30 00 00 C9 30 00 00 C9 30 00 00 D0 30 00 00 D1 30 00 00 D3 30 00 00 D4' + '30 00 00 D6 30 00 00 D7 30 00 00 D9 30 00 00 DA 30 00 00 DC 30 00 00 DD 30 00 00 F4 30 00 00 F4' + '30 00 00 F7 30 00 00 FA 30 00 00 FE 30 00 00 FE 30 00 00 1D FB 00 00 1D FB 00 00 1F FB 00 00 1F' + 'FB 00 00 2A FB 00 00 36 FB 00 00 38 FB 00 00 3C FB 00 00 3E FB 00 00 3E FB 00 00 40 FB 00 00 41' + 'FB 00 00 43 FB 00 00 44 FB 00 00 46 FB 00 00 4E FB 00 00 36 68 01 00 00 00 00 00 00 1F 02 00 00' + '22 02 00 00 33 02 00 00 50 02 00 00 AD 02 00 00 B0 02 00 00 EE 02 00 00 00 03 00 00 4E 03 00 00' + '60 03 00 00 62 03 00 00 74 03 00 00 75 03 00 00 7A 03 00 00 7A 03 00 00 7E 03 00 00 7E 03 00 00' + '84 03 00 00 8A 03 00 00 8C 03 00 00 8C 03 00 00 8E 03 00 00 A1 03 00 00 A3 03 00 00 CE 03 00 00' + 'D0 03 00 00 D7 03 00 00 DA 03 00 00 F3 03 00 00 00 04 00 00 86 04 00 00 88 04 00 00 89 04 00 00' + '8C 04 00 00 C4 04 00 00 C7 04 00 00 C8 04 00 00 CB 04 00 00 CC 04 00 00 D0 04 00 00 F5 04 00 00' + 'F8 04 00 00 F9 04 00 00 31 05 00 00 56 05 00 00 59 05 00 00 5F 05 00 00 61 05 00 00 87 05 00 00' + '89 05 00 00 8A 05 00 00 91 05 00 00 A1 05 00 00 A3 05 00 00 B9 05 00 00 BB 05 00 00 C4 05 00 00' + 'D0 05 00 00 EA 05 00 00 F0 05 00 00 F4 05 00 00 0C 06 00 00 0C 06 00 00 1B 06 00 00 1B 06 00 00' + '1F 06 00 00 1F 06 00 00 21 06 00 00 3A 06 00 00 40 06 00 00 55 06 00 00 60 06 00 00 6D 06 00 00' + '70 06 00 00 ED 06 00 00 F0 06 00 00 FE 06 00 00 00 07 00 00 0D 07 00 00 0F 07 00 00 2C 07 00 00' + '30 07 00 00 4A 07 00 00 80 07 00 00 B0 07 00 00 01 09 00 00 03 09 00 00 05 09 00 00 39 09 00 00' + '3C 09 00 00 4D 09 00 00 50 09 00 00 54 09 00 00 58 09 00 00 70 09 00 00 81 09 00 00 83 09 00 00' + '85 09 00 00 8C 09 00 00 8F 09 00 00 90 09 00 00 93 09 00 00 A8 09 00 00 AA 09 00 00 B0 09 00 00' + 'B2 09 00 00 B2 09 00 00 B6 09 00 00 B9 09 00 00 BC 09 00 00 BC 09 00 00 BE 09 00 00 C4 09 00 00' + 'C7 09 00 00 C8 09 00 00 CB 09 00 00 CD 09 00 00 D7 09 00 00 D7 09 00 00 DC 09 00 00 DD 09 00 00' + 'DF 09 00 00 E3 09 00 00 E6 09 00 00 FA 09 00 00 02 0A 00 00 02 0A 00 00 05 0A 00 00 0A 0A 00 00' + '0F 0A 00 00 10 0A 00 00 13 0A 00 00 28 0A 00 00 2A 0A 00 00 30 0A 00 00 32 0A 00 00 33 0A 00 00' + '35 0A 00 00 36 0A 00 00 38 0A 00 00 39 0A 00 00 3C 0A 00 00 3C 0A 00 00 3E 0A 00 00 42 0A 00 00' + '47 0A 00 00 48 0A 00 00 4B 0A 00 00 4D 0A 00 00 59 0A 00 00 5C 0A 00 00 5E 0A 00 00 5E 0A 00 00' + '66 0A 00 00 74 0A 00 00 81 0A 00 00 83 0A 00 00 85 0A 00 00 8B 0A 00 00 8D 0A 00 00 8D 0A 00 00' + '8F 0A 00 00 91 0A 00 00 93 0A 00 00 A8 0A 00 00 AA 0A 00 00 B0 0A 00 00 B2 0A 00 00 B3 0A 00 00' + 'B5 0A 00 00 B9 0A 00 00 BC 0A 00 00 C5 0A 00 00 C7 0A 00 00 C9 0A 00 00 CB 0A 00 00 CD 0A 00 00' + 'D0 0A 00 00 D0 0A 00 00 E0 0A 00 00 E0 0A 00 00 E6 0A 00 00 EF 0A 00 00 01 0B 00 00 03 0B 00 00' + '05 0B 00 00 0C 0B 00 00 0F 0B 00 00 10 0B 00 00 13 0B 00 00 28 0B 00 00 2A 0B 00 00 30 0B 00 00' + '32 0B 00 00 33 0B 00 00 36 0B 00 00 39 0B 00 00 3C 0B 00 00 43 0B 00 00 47 0B 00 00 48 0B 00 00' + '4B 0B 00 00 4D 0B 00 00 56 0B 00 00 57 0B 00 00 5C 0B 00 00 5D 0B 00 00 5F 0B 00 00 61 0B 00 00' + '66 0B 00 00 70 0B 00 00 82 0B 00 00 83 0B 00 00 85 0B 00 00 8A 0B 00 00 8E 0B 00 00 90 0B 00 00' + '92 0B 00 00 95 0B 00 00 99 0B 00 00 9A 0B 00 00 9C 0B 00 00 9C 0B 00 00 9E 0B 00 00 9F 0B 00 00' + 'A3 0B 00 00 A4 0B 00 00 A8 0B 00 00 AA 0B 00 00 AE 0B 00 00 B5 0B 00 00 B7 0B 00 00 B9 0B 00 00' + 'BE 0B 00 00 C2 0B 00 00 C6 0B 00 00 C8 0B 00 00 CA 0B 00 00 CD 0B 00 00 D7 0B 00 00 D7 0B 00 00' + 'E7 0B 00 00 F2 0B 00 00 01 0C 00 00 03 0C 00 00 05 0C 00 00 0C 0C 00 00 0E 0C 00 00 10 0C 00 00' + '12 0C 00 00 28 0C 00 00 2A 0C 00 00 33 0C 00 00 35 0C 00 00 39 0C 00 00 3E 0C 00 00 44 0C 00 00' + '46 0C 00 00 48 0C 00 00 4A 0C 00 00 4D 0C 00 00 55 0C 00 00 56 0C 00 00 60 0C 00 00 61 0C 00 00' + '66 0C 00 00 6F 0C 00 00 82 0C 00 00 83 0C 00 00 85 0C 00 00 8C 0C 00 00 8E 0C 00 00 90 0C 00 00' + '92 0C 00 00 A8 0C 00 00 AA 0C 00 00 B3 0C 00 00 B5 0C 00 00 B9 0C 00 00 BE 0C 00 00 C4 0C 00 00' + 'C6 0C 00 00 C8 0C 00 00 CA 0C 00 00 CD 0C 00 00 D5 0C 00 00 D6 0C 00 00 DE 0C 00 00 DE 0C 00 00' + 'E0 0C 00 00 E1 0C 00 00 E6 0C 00 00 EF 0C 00 00 02 0D 00 00 03 0D 00 00 05 0D 00 00 0C 0D 00 00' + '0E 0D 00 00 10 0D 00 00 12 0D 00 00 28 0D 00 00 2A 0D 00 00 39 0D 00 00 3E 0D 00 00 43 0D 00 00' + '46 0D 00 00 48 0D 00 00 4A 0D 00 00 4D 0D 00 00 57 0D 00 00 57 0D 00 00 60 0D 00 00 61 0D 00 00' + '66 0D 00 00 6F 0D 00 00 82 0D 00 00 83 0D 00 00 85 0D 00 00 96 0D 00 00 9A 0D 00 00 B1 0D 00 00' + 'B3 0D 00 00 BB 0D 00 00 BD 0D 00 00 BD 0D 00 00 C0 0D 00 00 C6 0D 00 00 CA 0D 00 00 CA 0D 00 00' + 'CF 0D 00 00 D4 0D 00 00 D6 0D 00 00 D6 0D 00 00 D8 0D 00 00 DF 0D 00 00 F2 0D 00 00 F4 0D 00 00' + '01 0E 00 00 3A 0E 00 00 3F 0E 00 00 5B 0E 00 00 81 0E 00 00 82 0E 00 00 84 0E 00 00 84 0E 00 00' + '87 0E 00 00 88 0E 00 00 8A 0E 00 00 8A 0E 00 00 8D 0E 00 00 8D 0E 00 00 94 0E 00 00 97 0E 00 00' + '99 0E 00 00 9F 0E 00 00 A1 0E 00 00 A3 0E 00 00 A5 0E 00 00 A5 0E 00 00 A7 0E 00 00 A7 0E 00 00' + 'AA 0E 00 00 AB 0E 00 00 AD 0E 00 00 B9 0E 00 00 BB 0E 00 00 BD 0E 00 00 C0 0E 00 00 C4 0E 00 00' + 'C6 0E 00 00 C6 0E 00 00 C8 0E 00 00 CD 0E 00 00 D0 0E 00 00 D9 0E 00 00 DC 0E 00 00 DD 0E 00 00' + '00 0F 00 00 47 0F 00 00 49 0F 00 00 6A 0F 00 00 71 0F 00 00 8B 0F 00 00 90 0F 00 00 97 0F 00 00' + '99 0F 00 00 BC 0F 00 00 BE 0F 00 00 CC 0F 00 00 CF 0F 00 00 CF 0F 00 00 00 10 00 00 21 10 00 00' + '23 10 00 00 27 10 00 00 29 10 00 00 2A 10 00 00 2C 10 00 00 32 10 00 00 36 10 00 00 39 10 00 00' + '40 10 00 00 59 10 00 00 A0 10 00 00 C5 10 00 00 D0 10 00 00 F6 10 00 00 FB 10 00 00 FB 10 00 00' + '00 11 00 00 59 11 00 00 5F 11 00 00 A2 11 00 00 A8 11 00 00 F9 11 00 00 00 12 00 00 06 12 00 00' + '08 12 00 00 46 12 00 00 48 12 00 00 48 12 00 00 4A 12 00 00 4D 12 00 00 50 12 00 00 56 12 00 00' + '58 12 00 00 58 12 00 00 5A 12 00 00 5D 12 00 00 60 12 00 00 86 12 00 00 88 12 00 00 88 12 00 00' + '8A 12 00 00 8D 12 00 00 90 12 00 00 AE 12 00 00 B0 12 00 00 B0 12 00 00 B2 12 00 00 B5 12 00 00' + 'B8 12 00 00 BE 12 00 00 C0 12 00 00 C0 12 00 00 C2 12 00 00 C5 12 00 00 C8 12 00 00 CE 12 00 00' + 'D0 12 00 00 D6 12 00 00 D8 12 00 00 EE 12 00 00 F0 12 00 00 0E 13 00 00 10 13 00 00 10 13 00 00' + '12 13 00 00 15 13 00 00 18 13 00 00 1E 13 00 00 20 13 00 00 46 13 00 00 48 13 00 00 5A 13 00 00' + '61 13 00 00 7C 13 00 00 A0 13 00 00 F4 13 00 00 01 14 00 00 76 16 00 00 80 16 00 00 9C 16 00 00' + 'A0 16 00 00 F0 16 00 00 80 17 00 00 DC 17 00 00 E0 17 00 00 E9 17 00 00 00 18 00 00 0E 18 00 00' + '10 18 00 00 19 18 00 00 20 18 00 00 77 18 00 00 80 18 00 00 A9 18 00 00 00 1E 00 00 9B 1E 00 00' + 'A0 1E 00 00 F9 1E 00 00 00 1F 00 00 15 1F 00 00 18 1F 00 00 1D 1F 00 00 20 1F 00 00 45 1F 00 00' + '48 1F 00 00 4D 1F 00 00 50 1F 00 00 57 1F 00 00 59 1F 00 00 59 1F 00 00 5B 1F 00 00 5B 1F 00 00' + '5D 1F 00 00 5D 1F 00 00 5F 1F 00 00 7D 1F 00 00 80 1F 00 00 B4 1F 00 00 B6 1F 00 00 C4 1F 00 00' + 'C6 1F 00 00 D3 1F 00 00 D6 1F 00 00 DB 1F 00 00 DD 1F 00 00 EF 1F 00 00 F2 1F 00 00 F4 1F 00 00' + 'F6 1F 00 00 FE 1F 00 00 00 20 00 00 46 20 00 00 48 20 00 00 4D 20 00 00 6A 20 00 00 70 20 00 00' + '74 20 00 00 8E 20 00 00 A0 20 00 00 AF 20 00 00 D0 20 00 00 E3 20 00 00 00 21 00 00 3A 21 00 00' + '53 21 00 00 83 21 00 00 90 21 00 00 F3 21 00 00 00 22 00 00 F1 22 00 00 00 23 00 00 7B 23 00 00' + '7D 23 00 00 9A 23 00 00 00 24 00 00 26 24 00 00 40 24 00 00 4A 24 00 00 60 24 00 00 EA 24 00 00' + '00 25 00 00 95 25 00 00 A0 25 00 00 F7 25 00 00 00 26 00 00 13 26 00 00 19 26 00 00 71 26 00 00' + '01 27 00 00 04 27 00 00 06 27 00 00 09 27 00 00 0C 27 00 00 27 27 00 00 29 27 00 00 4B 27 00 00' + '4D 27 00 00 4D 27 00 00 4F 27 00 00 52 27 00 00 56 27 00 00 56 27 00 00 58 27 00 00 5E 27 00 00' + '61 27 00 00 67 27 00 00 76 27 00 00 94 27 00 00 98 27 00 00 AF 27 00 00 B1 27 00 00 BE 27 00 00' + '00 28 00 00 FF 28 00 00 80 2E 00 00 99 2E 00 00 9B 2E 00 00 F3 2E 00 00 00 2F 00 00 D5 2F 00 00' + 'F0 2F 00 00 FB 2F 00 00 00 30 00 00 3A 30 00 00 3E 30 00 00 3F 30 00 00 41 30 00 00 94 30 00 00' + '99 30 00 00 9E 30 00 00 A1 30 00 00 FE 30 00 00 05 31 00 00 2C 31 00 00 31 31 00 00 8E 31 00 00' + '90 31 00 00 B7 31 00 00 00 32 00 00 1C 32 00 00 20 32 00 00 43 32 00 00 60 32 00 00 7B 32 00 00' + '7F 32 00 00 B0 32 00 00 C0 32 00 00 CB 32 00 00 D0 32 00 00 FE 32 00 00 00 33 00 00 76 33 00 00' + '7B 33 00 00 DD 33 00 00 E0 33 00 00 FE 33 00 00 00 34 00 00 B5 4D 00 00 00 4E 00 00 A5 9F 00 00' + '00 A0 00 00 8C A4 00 00 90 A4 00 00 A1 A4 00 00 A4 A4 00 00 B3 A4 00 00 B5 A4 00 00 C0 A4 00 00' + 'C2 A4 00 00 C4 A4 00 00 C6 A4 00 00 C6 A4 00 00 00 AC 00 00 A3 D7 00 00 00 D8 00 00 7F DB 00 00' + '80 DB 00 00 FF DB 00 00 00 DC 00 00 FF DF 00 00 00 E0 00 00 2D FA 00 00 00 FB 00 00 06 FB 00 00' + '13 FB 00 00 17 FB 00 00 1D FB 00 00 36 FB 00 00 38 FB 00 00 3C FB 00 00 3E FB 00 00 3E FB 00 00' + '40 FB 00 00 41 FB 00 00 43 FB 00 00 44 FB 00 00 46 FB 00 00 B1 FB 00 00 D3 FB 00 00 3F FD 00 00' + '50 FD 00 00 8F FD 00 00 92 FD 00 00 C7 FD 00 00 F0 FD 00 00 FB FD 00 00 20 FE 00 00 23 FE 00 00' + '30 FE 00 00 44 FE 00 00 49 FE 00 00 52 FE 00 00 54 FE 00 00 66 FE 00 00 68 FE 00 00 6B FE 00 00' + '70 FE 00 00 72 FE 00 00 74 FE 00 00 74 FE 00 00 76 FE 00 00 FC FE 00 00 FF FE 00 00 FF FE 00 00' + '01 FF 00 00 5E FF 00 00 61 FF 00 00 BE FF 00 00 C2 FF 00 00 C7 FF 00 00 CA FF 00 00 CF FF 00 00' + 'D2 FF 00 00 D7 FF 00 00 DA FF 00 00 DC FF 00 00 E0 FF 00 00 E6 FF 00 00 E8 FF 00 00 EE FF 00 00' + 'F9 FF 00 00 FD FF 00 00 00 00 0F 00 FD FF 0F 00 00 00 10 00 FD FF 10 00' +} + + +CASE UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + 'A6 05 00 00 41 00 00 00 00 00 00 00 01 00 00 00 61 00 00 00 00 00 00 00 00 00 00 00 42 00 00 00' + '00 00 00 00 01 00 00 00 62 00 00 00 00 00 00 00 00 00 00 00 43 00 00 00 00 00 00 00 01 00 00 00' + '63 00 00 00 00 00 00 00 00 00 00 00 44 00 00 00 00 00 00 00 01 00 00 00 64 00 00 00 00 00 00 00' + '00 00 00 00 45 00 00 00 00 00 00 00 01 00 00 00 65 00 00 00 00 00 00 00 00 00 00 00 46 00 00 00' + '00 00 00 00 01 00 00 00 66 00 00 00 00 00 00 00 00 00 00 00 47 00 00 00 00 00 00 00 01 00 00 00' + '67 00 00 00 00 00 00 00 00 00 00 00 48 00 00 00 00 00 00 00 01 00 00 00 68 00 00 00 00 00 00 00' + '00 00 00 00 49 00 00 00 00 00 00 00 01 00 00 00 69 00 00 00 00 00 00 00 00 00 00 00 4A 00 00 00' + '00 00 00 00 01 00 00 00 6A 00 00 00 00 00 00 00 00 00 00 00 4B 00 00 00 00 00 00 00 01 00 00 00' + '6B 00 00 00 00 00 00 00 00 00 00 00 4C 00 00 00 00 00 00 00 01 00 00 00 6C 00 00 00 00 00 00 00' + '00 00 00 00 4D 00 00 00 00 00 00 00 01 00 00 00 6D 00 00 00 00 00 00 00 00 00 00 00 4E 00 00 00' + '00 00 00 00 01 00 00 00 6E 00 00 00 00 00 00 00 00 00 00 00 4F 00 00 00 00 00 00 00 01 00 00 00' + '6F 00 00 00 00 00 00 00 00 00 00 00 50 00 00 00 00 00 00 00 01 00 00 00 70 00 00 00 00 00 00 00' + '00 00 00 00 51 00 00 00 00 00 00 00 01 00 00 00 71 00 00 00 00 00 00 00 00 00 00 00 52 00 00 00' + '00 00 00 00 01 00 00 00 72 00 00 00 00 00 00 00 00 00 00 00 53 00 00 00 00 00 00 00 01 00 00 00' + '73 00 00 00 00 00 00 00 00 00 00 00 54 00 00 00 00 00 00 00 01 00 00 00 74 00 00 00 00 00 00 00' + '00 00 00 00 55 00 00 00 00 00 00 00 01 00 00 00 75 00 00 00 00 00 00 00 00 00 00 00 56 00 00 00' + '00 00 00 00 01 00 00 00 76 00 00 00 00 00 00 00 00 00 00 00 57 00 00 00 00 00 00 00 01 00 00 00' + '77 00 00 00 00 00 00 00 00 00 00 00 58 00 00 00 00 00 00 00 01 00 00 00 78 00 00 00 00 00 00 00' + '00 00 00 00 59 00 00 00 00 00 00 00 01 00 00 00 79 00 00 00 00 00 00 00 00 00 00 00 5A 00 00 00' + '00 00 00 00 01 00 00 00 7A 00 00 00 00 00 00 00 00 00 00 00 61 00 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 41 00 00 00 01 00 00 00 41 00 00 00 62 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '42 00 00 00 01 00 00 00 42 00 00 00 63 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 43 00 00 00' + '01 00 00 00 43 00 00 00 64 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 44 00 00 00 01 00 00 00' + '44 00 00 00 65 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 45 00 00 00 01 00 00 00 45 00 00 00' + '66 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 46 00 00 00 01 00 00 00 46 00 00 00 67 00 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 47 00 00 00 01 00 00 00 47 00 00 00 68 00 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 48 00 00 00 01 00 00 00 48 00 00 00 69 00 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 49 00 00 00 01 00 00 00 49 00 00 00 6A 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '4A 00 00 00 01 00 00 00 4A 00 00 00 6B 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4B 00 00 00' + '01 00 00 00 4B 00 00 00 6C 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4C 00 00 00 01 00 00 00' + '4C 00 00 00 6D 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4D 00 00 00 01 00 00 00 4D 00 00 00' + '6E 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4E 00 00 00 01 00 00 00 4E 00 00 00 6F 00 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 4F 00 00 00 01 00 00 00 4F 00 00 00 70 00 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 50 00 00 00 01 00 00 00 50 00 00 00 71 00 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 51 00 00 00 01 00 00 00 51 00 00 00 72 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '52 00 00 00 01 00 00 00 52 00 00 00 73 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 53 00 00 00' + '01 00 00 00 53 00 00 00 74 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 54 00 00 00 01 00 00 00' + '54 00 00 00 75 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 55 00 00 00 01 00 00 00 55 00 00 00' + '76 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 56 00 00 00 01 00 00 00 56 00 00 00 77 00 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 57 00 00 00 01 00 00 00 57 00 00 00 78 00 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 58 00 00 00 01 00 00 00 58 00 00 00 79 00 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 59 00 00 00 01 00 00 00 59 00 00 00 7A 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '5A 00 00 00 01 00 00 00 5A 00 00 00 B5 00 00 00 01 00 00 00 BC 03 00 00 00 00 00 00 01 00 00 00' + '9C 03 00 00 01 00 00 00 9C 03 00 00 C0 00 00 00 00 00 00 00 01 00 00 00 E0 00 00 00 00 00 00 00' + '00 00 00 00 C1 00 00 00 00 00 00 00 01 00 00 00 E1 00 00 00 00 00 00 00 00 00 00 00 C2 00 00 00' + '00 00 00 00 01 00 00 00 E2 00 00 00 00 00 00 00 00 00 00 00 C3 00 00 00 00 00 00 00 01 00 00 00' + 'E3 00 00 00 00 00 00 00 00 00 00 00 C4 00 00 00 00 00 00 00 01 00 00 00 E4 00 00 00 00 00 00 00' + '00 00 00 00 C5 00 00 00 00 00 00 00 01 00 00 00 E5 00 00 00 00 00 00 00 00 00 00 00 C6 00 00 00' + '00 00 00 00 01 00 00 00 E6 00 00 00 00 00 00 00 00 00 00 00 C7 00 00 00 00 00 00 00 01 00 00 00' + 'E7 00 00 00 00 00 00 00 00 00 00 00 C8 00 00 00 00 00 00 00 01 00 00 00 E8 00 00 00 00 00 00 00' + '00 00 00 00 C9 00 00 00 00 00 00 00 01 00 00 00 E9 00 00 00 00 00 00 00 00 00 00 00 CA 00 00 00' + '00 00 00 00 01 00 00 00 EA 00 00 00 00 00 00 00 00 00 00 00 CB 00 00 00 00 00 00 00 01 00 00 00' + 'EB 00 00 00 00 00 00 00 00 00 00 00 CC 00 00 00 00 00 00 00 01 00 00 00 EC 00 00 00 00 00 00 00' + '00 00 00 00 CD 00 00 00 00 00 00 00 01 00 00 00 ED 00 00 00 00 00 00 00 00 00 00 00 CE 00 00 00' + '00 00 00 00 01 00 00 00 EE 00 00 00 00 00 00 00 00 00 00 00 CF 00 00 00 00 00 00 00 01 00 00 00' + 'EF 00 00 00 00 00 00 00 00 00 00 00 D0 00 00 00 00 00 00 00 01 00 00 00 F0 00 00 00 00 00 00 00' + '00 00 00 00 D1 00 00 00 00 00 00 00 01 00 00 00 F1 00 00 00 00 00 00 00 00 00 00 00 D2 00 00 00' + '00 00 00 00 01 00 00 00 F2 00 00 00 00 00 00 00 00 00 00 00 D3 00 00 00 00 00 00 00 01 00 00 00' + 'F3 00 00 00 00 00 00 00 00 00 00 00 D4 00 00 00 00 00 00 00 01 00 00 00 F4 00 00 00 00 00 00 00' + '00 00 00 00 D5 00 00 00 00 00 00 00 01 00 00 00 F5 00 00 00 00 00 00 00 00 00 00 00 D6 00 00 00' + '00 00 00 00 01 00 00 00 F6 00 00 00 00 00 00 00 00 00 00 00 D8 00 00 00 00 00 00 00 01 00 00 00' + 'F8 00 00 00 00 00 00 00 00 00 00 00 D9 00 00 00 00 00 00 00 01 00 00 00 F9 00 00 00 00 00 00 00' + '00 00 00 00 DA 00 00 00 00 00 00 00 01 00 00 00 FA 00 00 00 00 00 00 00 00 00 00 00 DB 00 00 00' + '00 00 00 00 01 00 00 00 FB 00 00 00 00 00 00 00 00 00 00 00 DC 00 00 00 00 00 00 00 01 00 00 00' + 'FC 00 00 00 00 00 00 00 00 00 00 00 DD 00 00 00 00 00 00 00 01 00 00 00 FD 00 00 00 00 00 00 00' + '00 00 00 00 DE 00 00 00 00 00 00 00 01 00 00 00 FE 00 00 00 00 00 00 00 00 00 00 00 DF 00 00 00' + '02 00 00 00 73 00 00 00 73 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 E0 00 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 C0 00 00 00 01 00 00 00 C0 00 00 00 E1 00 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 C1 00 00 00 01 00 00 00 C1 00 00 00 E2 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'C2 00 00 00 01 00 00 00 C2 00 00 00 E3 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C3 00 00 00' + '01 00 00 00 C3 00 00 00 E4 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C4 00 00 00 01 00 00 00' + 'C4 00 00 00 E5 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C5 00 00 00 01 00 00 00 C5 00 00 00' + 'E6 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C6 00 00 00 01 00 00 00 C6 00 00 00 E7 00 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 C7 00 00 00 01 00 00 00 C7 00 00 00 E8 00 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 C8 00 00 00 01 00 00 00 C8 00 00 00 E9 00 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 C9 00 00 00 01 00 00 00 C9 00 00 00 EA 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'CA 00 00 00 01 00 00 00 CA 00 00 00 EB 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CB 00 00 00' + '01 00 00 00 CB 00 00 00 EC 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CC 00 00 00 01 00 00 00' + 'CC 00 00 00 ED 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CD 00 00 00 01 00 00 00 CD 00 00 00' + 'EE 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CE 00 00 00 01 00 00 00 CE 00 00 00 EF 00 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 CF 00 00 00 01 00 00 00 CF 00 00 00 F0 00 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 D0 00 00 00 01 00 00 00 D0 00 00 00 F1 00 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 D1 00 00 00 01 00 00 00 D1 00 00 00 F2 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'D2 00 00 00 01 00 00 00 D2 00 00 00 F3 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D3 00 00 00' + '01 00 00 00 D3 00 00 00 F4 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D4 00 00 00 01 00 00 00' + 'D4 00 00 00 F5 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D5 00 00 00 01 00 00 00 D5 00 00 00' + 'F6 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D6 00 00 00 01 00 00 00 D6 00 00 00 F8 00 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 D8 00 00 00 01 00 00 00 D8 00 00 00 F9 00 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 D9 00 00 00 01 00 00 00 D9 00 00 00 FA 00 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 DA 00 00 00 01 00 00 00 DA 00 00 00 FB 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'DB 00 00 00 01 00 00 00 DB 00 00 00 FC 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DC 00 00 00' + '01 00 00 00 DC 00 00 00 FD 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DD 00 00 00 01 00 00 00' + 'DD 00 00 00 FE 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DE 00 00 00 01 00 00 00 DE 00 00 00' + 'FF 00 00 00 00 00 00 00 00 00 00 00 01 00 00 00 78 01 00 00 01 00 00 00 78 01 00 00 00 01 00 00' + '00 00 00 00 01 00 00 00 01 01 00 00 00 00 00 00 00 00 00 00 01 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 00 01 00 00 01 00 00 00 00 01 00 00 02 01 00 00 00 00 00 00 01 00 00 00 03 01 00 00' + '00 00 00 00 00 00 00 00 03 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 02 01 00 00 01 00 00 00' + '02 01 00 00 04 01 00 00 00 00 00 00 01 00 00 00 05 01 00 00 00 00 00 00 00 00 00 00 05 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 04 01 00 00 01 00 00 00 04 01 00 00 06 01 00 00 00 00 00 00' + '01 00 00 00 07 01 00 00 00 00 00 00 00 00 00 00 07 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '06 01 00 00 01 00 00 00 06 01 00 00 08 01 00 00 00 00 00 00 01 00 00 00 09 01 00 00 00 00 00 00' + '00 00 00 00 09 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 08 01 00 00 01 00 00 00 08 01 00 00' + '0A 01 00 00 00 00 00 00 01 00 00 00 0B 01 00 00 00 00 00 00 00 00 00 00 0B 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 0A 01 00 00 01 00 00 00 0A 01 00 00 0C 01 00 00 00 00 00 00 01 00 00 00' + '0D 01 00 00 00 00 00 00 00 00 00 00 0D 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 0C 01 00 00' + '01 00 00 00 0C 01 00 00 0E 01 00 00 00 00 00 00 01 00 00 00 0F 01 00 00 00 00 00 00 00 00 00 00' + '0F 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 0E 01 00 00 01 00 00 00 0E 01 00 00 10 01 00 00' + '00 00 00 00 01 00 00 00 11 01 00 00 00 00 00 00 00 00 00 00 11 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 10 01 00 00 01 00 00 00 10 01 00 00 12 01 00 00 00 00 00 00 01 00 00 00 13 01 00 00' + '00 00 00 00 00 00 00 00 13 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 12 01 00 00 01 00 00 00' + '12 01 00 00 14 01 00 00 00 00 00 00 01 00 00 00 15 01 00 00 00 00 00 00 00 00 00 00 15 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 14 01 00 00 01 00 00 00 14 01 00 00 16 01 00 00 00 00 00 00' + '01 00 00 00 17 01 00 00 00 00 00 00 00 00 00 00 17 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '16 01 00 00 01 00 00 00 16 01 00 00 18 01 00 00 00 00 00 00 01 00 00 00 19 01 00 00 00 00 00 00' + '00 00 00 00 19 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 18 01 00 00 01 00 00 00 18 01 00 00' + '1A 01 00 00 00 00 00 00 01 00 00 00 1B 01 00 00 00 00 00 00 00 00 00 00 1B 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 1A 01 00 00 01 00 00 00 1A 01 00 00 1C 01 00 00 00 00 00 00 01 00 00 00' + '1D 01 00 00 00 00 00 00 00 00 00 00 1D 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 1C 01 00 00' + '01 00 00 00 1C 01 00 00 1E 01 00 00 00 00 00 00 01 00 00 00 1F 01 00 00 00 00 00 00 00 00 00 00' + '1F 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 1E 01 00 00 01 00 00 00 1E 01 00 00 20 01 00 00' + '00 00 00 00 01 00 00 00 21 01 00 00 00 00 00 00 00 00 00 00 21 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 20 01 00 00 01 00 00 00 20 01 00 00 22 01 00 00 00 00 00 00 01 00 00 00 23 01 00 00' + '00 00 00 00 00 00 00 00 23 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 22 01 00 00 01 00 00 00' + '22 01 00 00 24 01 00 00 00 00 00 00 01 00 00 00 25 01 00 00 00 00 00 00 00 00 00 00 25 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 24 01 00 00 01 00 00 00 24 01 00 00 26 01 00 00 00 00 00 00' + '01 00 00 00 27 01 00 00 00 00 00 00 00 00 00 00 27 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '26 01 00 00 01 00 00 00 26 01 00 00 28 01 00 00 00 00 00 00 01 00 00 00 29 01 00 00 00 00 00 00' + '00 00 00 00 29 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 28 01 00 00 01 00 00 00 28 01 00 00' + '2A 01 00 00 00 00 00 00 01 00 00 00 2B 01 00 00 00 00 00 00 00 00 00 00 2B 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 2A 01 00 00 01 00 00 00 2A 01 00 00 2C 01 00 00 00 00 00 00 01 00 00 00' + '2D 01 00 00 00 00 00 00 00 00 00 00 2D 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2C 01 00 00' + '01 00 00 00 2C 01 00 00 2E 01 00 00 00 00 00 00 01 00 00 00 2F 01 00 00 00 00 00 00 00 00 00 00' + '2F 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2E 01 00 00 01 00 00 00 2E 01 00 00 30 01 00 00' + '00 00 00 00 01 00 00 00 69 00 00 00 00 00 00 00 00 00 00 00 31 01 00 00 01 00 00 00 69 00 00 00' + '00 00 00 00 01 00 00 00 49 00 00 00 01 00 00 00 49 00 00 00 32 01 00 00 00 00 00 00 01 00 00 00' + '33 01 00 00 00 00 00 00 00 00 00 00 33 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 32 01 00 00' + '01 00 00 00 32 01 00 00 34 01 00 00 00 00 00 00 01 00 00 00 35 01 00 00 00 00 00 00 00 00 00 00' + '35 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 34 01 00 00 01 00 00 00 34 01 00 00 36 01 00 00' + '00 00 00 00 01 00 00 00 37 01 00 00 00 00 00 00 00 00 00 00 37 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 36 01 00 00 01 00 00 00 36 01 00 00 39 01 00 00 00 00 00 00 01 00 00 00 3A 01 00 00' + '00 00 00 00 00 00 00 00 3A 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 39 01 00 00 01 00 00 00' + '39 01 00 00 3B 01 00 00 00 00 00 00 01 00 00 00 3C 01 00 00 00 00 00 00 00 00 00 00 3C 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 3B 01 00 00 01 00 00 00 3B 01 00 00 3D 01 00 00 00 00 00 00' + '01 00 00 00 3E 01 00 00 00 00 00 00 00 00 00 00 3E 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '3D 01 00 00 01 00 00 00 3D 01 00 00 3F 01 00 00 00 00 00 00 01 00 00 00 40 01 00 00 00 00 00 00' + '00 00 00 00 40 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 3F 01 00 00 01 00 00 00 3F 01 00 00' + '41 01 00 00 00 00 00 00 01 00 00 00 42 01 00 00 00 00 00 00 00 00 00 00 42 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 41 01 00 00 01 00 00 00 41 01 00 00 43 01 00 00 00 00 00 00 01 00 00 00' + '44 01 00 00 00 00 00 00 00 00 00 00 44 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 43 01 00 00' + '01 00 00 00 43 01 00 00 45 01 00 00 00 00 00 00 01 00 00 00 46 01 00 00 00 00 00 00 00 00 00 00' + '46 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 45 01 00 00 01 00 00 00 45 01 00 00 47 01 00 00' + '00 00 00 00 01 00 00 00 48 01 00 00 00 00 00 00 00 00 00 00 48 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 47 01 00 00 01 00 00 00 47 01 00 00 49 01 00 00 02 00 00 00 BC 02 00 00 6E 00 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 4A 01 00 00 00 00 00 00 01 00 00 00 4B 01 00 00 00 00 00 00' + '00 00 00 00 4B 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4A 01 00 00 01 00 00 00 4A 01 00 00' + '4C 01 00 00 00 00 00 00 01 00 00 00 4D 01 00 00 00 00 00 00 00 00 00 00 4D 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 4C 01 00 00 01 00 00 00 4C 01 00 00 4E 01 00 00 00 00 00 00 01 00 00 00' + '4F 01 00 00 00 00 00 00 00 00 00 00 4F 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4E 01 00 00' + '01 00 00 00 4E 01 00 00 50 01 00 00 00 00 00 00 01 00 00 00 51 01 00 00 00 00 00 00 00 00 00 00' + '51 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 50 01 00 00 01 00 00 00 50 01 00 00 52 01 00 00' + '00 00 00 00 01 00 00 00 53 01 00 00 00 00 00 00 00 00 00 00 53 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 52 01 00 00 01 00 00 00 52 01 00 00 54 01 00 00 00 00 00 00 01 00 00 00 55 01 00 00' + '00 00 00 00 00 00 00 00 55 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 54 01 00 00 01 00 00 00' + '54 01 00 00 56 01 00 00 00 00 00 00 01 00 00 00 57 01 00 00 00 00 00 00 00 00 00 00 57 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 56 01 00 00 01 00 00 00 56 01 00 00 58 01 00 00 00 00 00 00' + '01 00 00 00 59 01 00 00 00 00 00 00 00 00 00 00 59 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '58 01 00 00 01 00 00 00 58 01 00 00 5A 01 00 00 00 00 00 00 01 00 00 00 5B 01 00 00 00 00 00 00' + '00 00 00 00 5B 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 5A 01 00 00 01 00 00 00 5A 01 00 00' + '5C 01 00 00 00 00 00 00 01 00 00 00 5D 01 00 00 00 00 00 00 00 00 00 00 5D 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 5C 01 00 00 01 00 00 00 5C 01 00 00 5E 01 00 00 00 00 00 00 01 00 00 00' + '5F 01 00 00 00 00 00 00 00 00 00 00 5F 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 5E 01 00 00' + '01 00 00 00 5E 01 00 00 60 01 00 00 00 00 00 00 01 00 00 00 61 01 00 00 00 00 00 00 00 00 00 00' + '61 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 60 01 00 00 01 00 00 00 60 01 00 00 62 01 00 00' + '00 00 00 00 01 00 00 00 63 01 00 00 00 00 00 00 00 00 00 00 63 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 62 01 00 00 01 00 00 00 62 01 00 00 64 01 00 00 00 00 00 00 01 00 00 00 65 01 00 00' + '00 00 00 00 00 00 00 00 65 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 64 01 00 00 01 00 00 00' + '64 01 00 00 66 01 00 00 00 00 00 00 01 00 00 00 67 01 00 00 00 00 00 00 00 00 00 00 67 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 66 01 00 00 01 00 00 00 66 01 00 00 68 01 00 00 00 00 00 00' + '01 00 00 00 69 01 00 00 00 00 00 00 00 00 00 00 69 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '68 01 00 00 01 00 00 00 68 01 00 00 6A 01 00 00 00 00 00 00 01 00 00 00 6B 01 00 00 00 00 00 00' + '00 00 00 00 6B 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6A 01 00 00 01 00 00 00 6A 01 00 00' + '6C 01 00 00 00 00 00 00 01 00 00 00 6D 01 00 00 00 00 00 00 00 00 00 00 6D 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 6C 01 00 00 01 00 00 00 6C 01 00 00 6E 01 00 00 00 00 00 00 01 00 00 00' + '6F 01 00 00 00 00 00 00 00 00 00 00 6F 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6E 01 00 00' + '01 00 00 00 6E 01 00 00 70 01 00 00 00 00 00 00 01 00 00 00 71 01 00 00 00 00 00 00 00 00 00 00' + '71 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 70 01 00 00 01 00 00 00 70 01 00 00 72 01 00 00' + '00 00 00 00 01 00 00 00 73 01 00 00 00 00 00 00 00 00 00 00 73 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 72 01 00 00 01 00 00 00 72 01 00 00 74 01 00 00 00 00 00 00 01 00 00 00 75 01 00 00' + '00 00 00 00 00 00 00 00 75 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 74 01 00 00 01 00 00 00' + '74 01 00 00 76 01 00 00 00 00 00 00 01 00 00 00 77 01 00 00 00 00 00 00 00 00 00 00 77 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 76 01 00 00 01 00 00 00 76 01 00 00 78 01 00 00 00 00 00 00' + '01 00 00 00 FF 00 00 00 00 00 00 00 00 00 00 00 79 01 00 00 00 00 00 00 01 00 00 00 7A 01 00 00' + '00 00 00 00 00 00 00 00 7A 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 79 01 00 00 01 00 00 00' + '79 01 00 00 7B 01 00 00 00 00 00 00 01 00 00 00 7C 01 00 00 00 00 00 00 00 00 00 00 7C 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 7B 01 00 00 01 00 00 00 7B 01 00 00 7D 01 00 00 00 00 00 00' + '01 00 00 00 7E 01 00 00 00 00 00 00 00 00 00 00 7E 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '7D 01 00 00 01 00 00 00 7D 01 00 00 7F 01 00 00 01 00 00 00 73 00 00 00 00 00 00 00 01 00 00 00' + '53 00 00 00 01 00 00 00 53 00 00 00 81 01 00 00 00 00 00 00 01 00 00 00 53 02 00 00 00 00 00 00' + '00 00 00 00 82 01 00 00 00 00 00 00 01 00 00 00 83 01 00 00 00 00 00 00 00 00 00 00 83 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 82 01 00 00 01 00 00 00 82 01 00 00 84 01 00 00 00 00 00 00' + '01 00 00 00 85 01 00 00 00 00 00 00 00 00 00 00 85 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '84 01 00 00 01 00 00 00 84 01 00 00 86 01 00 00 00 00 00 00 01 00 00 00 54 02 00 00 00 00 00 00' + '00 00 00 00 87 01 00 00 00 00 00 00 01 00 00 00 88 01 00 00 00 00 00 00 00 00 00 00 88 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 87 01 00 00 01 00 00 00 87 01 00 00 89 01 00 00 00 00 00 00' + '01 00 00 00 56 02 00 00 00 00 00 00 00 00 00 00 8A 01 00 00 00 00 00 00 01 00 00 00 57 02 00 00' + '00 00 00 00 00 00 00 00 8B 01 00 00 00 00 00 00 01 00 00 00 8C 01 00 00 00 00 00 00 00 00 00 00' + '8C 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 8B 01 00 00 01 00 00 00 8B 01 00 00 8E 01 00 00' + '00 00 00 00 01 00 00 00 DD 01 00 00 00 00 00 00 00 00 00 00 8F 01 00 00 00 00 00 00 01 00 00 00' + '59 02 00 00 00 00 00 00 00 00 00 00 90 01 00 00 00 00 00 00 01 00 00 00 5B 02 00 00 00 00 00 00' + '00 00 00 00 91 01 00 00 00 00 00 00 01 00 00 00 92 01 00 00 00 00 00 00 00 00 00 00 92 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 91 01 00 00 01 00 00 00 91 01 00 00 93 01 00 00 00 00 00 00' + '01 00 00 00 60 02 00 00 00 00 00 00 00 00 00 00 94 01 00 00 00 00 00 00 01 00 00 00 63 02 00 00' + '00 00 00 00 00 00 00 00 95 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 F6 01 00 00 01 00 00 00' + 'F6 01 00 00 96 01 00 00 00 00 00 00 01 00 00 00 69 02 00 00 00 00 00 00 00 00 00 00 97 01 00 00' + '00 00 00 00 01 00 00 00 68 02 00 00 00 00 00 00 00 00 00 00 98 01 00 00 00 00 00 00 01 00 00 00' + '99 01 00 00 00 00 00 00 00 00 00 00 99 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 98 01 00 00' + '01 00 00 00 98 01 00 00 9C 01 00 00 00 00 00 00 01 00 00 00 6F 02 00 00 00 00 00 00 00 00 00 00' + '9D 01 00 00 00 00 00 00 01 00 00 00 72 02 00 00 00 00 00 00 00 00 00 00 9F 01 00 00 00 00 00 00' + '01 00 00 00 75 02 00 00 00 00 00 00 00 00 00 00 A0 01 00 00 00 00 00 00 01 00 00 00 A1 01 00 00' + '00 00 00 00 00 00 00 00 A1 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A0 01 00 00 01 00 00 00' + 'A0 01 00 00 A2 01 00 00 00 00 00 00 01 00 00 00 A3 01 00 00 00 00 00 00 00 00 00 00 A3 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 A2 01 00 00 01 00 00 00 A2 01 00 00 A4 01 00 00 00 00 00 00' + '01 00 00 00 A5 01 00 00 00 00 00 00 00 00 00 00 A5 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'A4 01 00 00 01 00 00 00 A4 01 00 00 A6 01 00 00 00 00 00 00 01 00 00 00 80 02 00 00 00 00 00 00' + '00 00 00 00 A7 01 00 00 00 00 00 00 01 00 00 00 A8 01 00 00 00 00 00 00 00 00 00 00 A8 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 A7 01 00 00 01 00 00 00 A7 01 00 00 A9 01 00 00 00 00 00 00' + '01 00 00 00 83 02 00 00 00 00 00 00 00 00 00 00 AC 01 00 00 00 00 00 00 01 00 00 00 AD 01 00 00' + '00 00 00 00 00 00 00 00 AD 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 AC 01 00 00 01 00 00 00' + 'AC 01 00 00 AE 01 00 00 00 00 00 00 01 00 00 00 88 02 00 00 00 00 00 00 00 00 00 00 AF 01 00 00' + '00 00 00 00 01 00 00 00 B0 01 00 00 00 00 00 00 00 00 00 00 B0 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 AF 01 00 00 01 00 00 00 AF 01 00 00 B1 01 00 00 00 00 00 00 01 00 00 00 8A 02 00 00' + '00 00 00 00 00 00 00 00 B2 01 00 00 00 00 00 00 01 00 00 00 8B 02 00 00 00 00 00 00 00 00 00 00' + 'B3 01 00 00 00 00 00 00 01 00 00 00 B4 01 00 00 00 00 00 00 00 00 00 00 B4 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 B3 01 00 00 01 00 00 00 B3 01 00 00 B5 01 00 00 00 00 00 00 01 00 00 00' + 'B6 01 00 00 00 00 00 00 00 00 00 00 B6 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B5 01 00 00' + '01 00 00 00 B5 01 00 00 B7 01 00 00 00 00 00 00 01 00 00 00 92 02 00 00 00 00 00 00 00 00 00 00' + 'B8 01 00 00 00 00 00 00 01 00 00 00 B9 01 00 00 00 00 00 00 00 00 00 00 B9 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 B8 01 00 00 01 00 00 00 B8 01 00 00 BC 01 00 00 00 00 00 00 01 00 00 00' + 'BD 01 00 00 00 00 00 00 00 00 00 00 BD 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BC 01 00 00' + '01 00 00 00 BC 01 00 00 BF 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 F7 01 00 00 01 00 00 00' + 'F7 01 00 00 C4 01 00 00 00 00 00 00 01 00 00 00 C6 01 00 00 01 00 00 00 C5 01 00 00 00 00 00 00' + 'C5 01 00 00 00 00 00 00 01 00 00 00 C6 01 00 00 00 00 00 00 01 00 00 00 C4 01 00 00 C6 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 C5 01 00 00 01 00 00 00 C4 01 00 00 C7 01 00 00 00 00 00 00' + '01 00 00 00 C9 01 00 00 01 00 00 00 C8 01 00 00 00 00 00 00 C8 01 00 00 00 00 00 00 01 00 00 00' + 'C9 01 00 00 00 00 00 00 01 00 00 00 C7 01 00 00 C9 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'C8 01 00 00 01 00 00 00 C7 01 00 00 CA 01 00 00 00 00 00 00 01 00 00 00 CC 01 00 00 01 00 00 00' + 'CB 01 00 00 00 00 00 00 CB 01 00 00 00 00 00 00 01 00 00 00 CC 01 00 00 00 00 00 00 01 00 00 00' + 'CA 01 00 00 CC 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CB 01 00 00 01 00 00 00 CA 01 00 00' + 'CD 01 00 00 00 00 00 00 01 00 00 00 CE 01 00 00 00 00 00 00 00 00 00 00 CE 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 CD 01 00 00 01 00 00 00 CD 01 00 00 CF 01 00 00 00 00 00 00 01 00 00 00' + 'D0 01 00 00 00 00 00 00 00 00 00 00 D0 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CF 01 00 00' + '01 00 00 00 CF 01 00 00 D1 01 00 00 00 00 00 00 01 00 00 00 D2 01 00 00 00 00 00 00 00 00 00 00' + 'D2 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D1 01 00 00 01 00 00 00 D1 01 00 00 D3 01 00 00' + '00 00 00 00 01 00 00 00 D4 01 00 00 00 00 00 00 00 00 00 00 D4 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 D3 01 00 00 01 00 00 00 D3 01 00 00 D5 01 00 00 00 00 00 00 01 00 00 00 D6 01 00 00' + '00 00 00 00 00 00 00 00 D6 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D5 01 00 00 01 00 00 00' + 'D5 01 00 00 D7 01 00 00 00 00 00 00 01 00 00 00 D8 01 00 00 00 00 00 00 00 00 00 00 D8 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 D7 01 00 00 01 00 00 00 D7 01 00 00 D9 01 00 00 00 00 00 00' + '01 00 00 00 DA 01 00 00 00 00 00 00 00 00 00 00 DA 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'D9 01 00 00 01 00 00 00 D9 01 00 00 DB 01 00 00 00 00 00 00 01 00 00 00 DC 01 00 00 00 00 00 00' + '00 00 00 00 DC 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DB 01 00 00 01 00 00 00 DB 01 00 00' + 'DD 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 8E 01 00 00 01 00 00 00 8E 01 00 00 DE 01 00 00' + '00 00 00 00 01 00 00 00 DF 01 00 00 00 00 00 00 00 00 00 00 DF 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 DE 01 00 00 01 00 00 00 DE 01 00 00 E0 01 00 00 00 00 00 00 01 00 00 00 E1 01 00 00' + '00 00 00 00 00 00 00 00 E1 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 01 00 00 01 00 00 00' + 'E0 01 00 00 E2 01 00 00 00 00 00 00 01 00 00 00 E3 01 00 00 00 00 00 00 00 00 00 00 E3 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 E2 01 00 00 01 00 00 00 E2 01 00 00 E4 01 00 00 00 00 00 00' + '01 00 00 00 E5 01 00 00 00 00 00 00 00 00 00 00 E5 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'E4 01 00 00 01 00 00 00 E4 01 00 00 E6 01 00 00 00 00 00 00 01 00 00 00 E7 01 00 00 00 00 00 00' + '00 00 00 00 E7 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E6 01 00 00 01 00 00 00 E6 01 00 00' + 'E8 01 00 00 00 00 00 00 01 00 00 00 E9 01 00 00 00 00 00 00 00 00 00 00 E9 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 E8 01 00 00 01 00 00 00 E8 01 00 00 EA 01 00 00 00 00 00 00 01 00 00 00' + 'EB 01 00 00 00 00 00 00 00 00 00 00 EB 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EA 01 00 00' + '01 00 00 00 EA 01 00 00 EC 01 00 00 00 00 00 00 01 00 00 00 ED 01 00 00 00 00 00 00 00 00 00 00' + 'ED 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EC 01 00 00 01 00 00 00 EC 01 00 00 EE 01 00 00' + '00 00 00 00 01 00 00 00 EF 01 00 00 00 00 00 00 00 00 00 00 EF 01 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 EE 01 00 00 01 00 00 00 EE 01 00 00 F0 01 00 00 02 00 00 00 6A 00 00 00 0C 03 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 F1 01 00 00 00 00 00 00 01 00 00 00 F3 01 00 00 01 00 00 00' + 'F2 01 00 00 00 00 00 00 F2 01 00 00 00 00 00 00 01 00 00 00 F3 01 00 00 00 00 00 00 01 00 00 00' + 'F1 01 00 00 F3 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 F2 01 00 00 01 00 00 00 F1 01 00 00' + 'F4 01 00 00 00 00 00 00 01 00 00 00 F5 01 00 00 00 00 00 00 00 00 00 00 F5 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 F4 01 00 00 01 00 00 00 F4 01 00 00 F6 01 00 00 00 00 00 00 01 00 00 00' + '95 01 00 00 00 00 00 00 00 00 00 00 F7 01 00 00 00 00 00 00 01 00 00 00 BF 01 00 00 00 00 00 00' + '00 00 00 00 F8 01 00 00 00 00 00 00 01 00 00 00 F9 01 00 00 00 00 00 00 00 00 00 00 F9 01 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 F8 01 00 00 01 00 00 00 F8 01 00 00 FA 01 00 00 00 00 00 00' + '01 00 00 00 FB 01 00 00 00 00 00 00 00 00 00 00 FB 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'FA 01 00 00 01 00 00 00 FA 01 00 00 FC 01 00 00 00 00 00 00 01 00 00 00 FD 01 00 00 00 00 00 00' + '00 00 00 00 FD 01 00 00 00 00 00 00 00 00 00 00 01 00 00 00 FC 01 00 00 01 00 00 00 FC 01 00 00' + 'FE 01 00 00 00 00 00 00 01 00 00 00 FF 01 00 00 00 00 00 00 00 00 00 00 FF 01 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 FE 01 00 00 01 00 00 00 FE 01 00 00 00 02 00 00 00 00 00 00 01 00 00 00' + '01 02 00 00 00 00 00 00 00 00 00 00 01 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 00 02 00 00' + '01 00 00 00 00 02 00 00 02 02 00 00 00 00 00 00 01 00 00 00 03 02 00 00 00 00 00 00 00 00 00 00' + '03 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 02 02 00 00 01 00 00 00 02 02 00 00 04 02 00 00' + '00 00 00 00 01 00 00 00 05 02 00 00 00 00 00 00 00 00 00 00 05 02 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 04 02 00 00 01 00 00 00 04 02 00 00 06 02 00 00 00 00 00 00 01 00 00 00 07 02 00 00' + '00 00 00 00 00 00 00 00 07 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 06 02 00 00 01 00 00 00' + '06 02 00 00 08 02 00 00 00 00 00 00 01 00 00 00 09 02 00 00 00 00 00 00 00 00 00 00 09 02 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 08 02 00 00 01 00 00 00 08 02 00 00 0A 02 00 00 00 00 00 00' + '01 00 00 00 0B 02 00 00 00 00 00 00 00 00 00 00 0B 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '0A 02 00 00 01 00 00 00 0A 02 00 00 0C 02 00 00 00 00 00 00 01 00 00 00 0D 02 00 00 00 00 00 00' + '00 00 00 00 0D 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 0C 02 00 00 01 00 00 00 0C 02 00 00' + '0E 02 00 00 00 00 00 00 01 00 00 00 0F 02 00 00 00 00 00 00 00 00 00 00 0F 02 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 0E 02 00 00 01 00 00 00 0E 02 00 00 10 02 00 00 00 00 00 00 01 00 00 00' + '11 02 00 00 00 00 00 00 00 00 00 00 11 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 10 02 00 00' + '01 00 00 00 10 02 00 00 12 02 00 00 00 00 00 00 01 00 00 00 13 02 00 00 00 00 00 00 00 00 00 00' + '13 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 12 02 00 00 01 00 00 00 12 02 00 00 14 02 00 00' + '00 00 00 00 01 00 00 00 15 02 00 00 00 00 00 00 00 00 00 00 15 02 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 14 02 00 00 01 00 00 00 14 02 00 00 16 02 00 00 00 00 00 00 01 00 00 00 17 02 00 00' + '00 00 00 00 00 00 00 00 17 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 16 02 00 00 01 00 00 00' + '16 02 00 00 18 02 00 00 00 00 00 00 01 00 00 00 19 02 00 00 00 00 00 00 00 00 00 00 19 02 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 18 02 00 00 01 00 00 00 18 02 00 00 1A 02 00 00 00 00 00 00' + '01 00 00 00 1B 02 00 00 00 00 00 00 00 00 00 00 1B 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '1A 02 00 00 01 00 00 00 1A 02 00 00 1C 02 00 00 00 00 00 00 01 00 00 00 1D 02 00 00 00 00 00 00' + '00 00 00 00 1D 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 1C 02 00 00 01 00 00 00 1C 02 00 00' + '1E 02 00 00 00 00 00 00 01 00 00 00 1F 02 00 00 00 00 00 00 00 00 00 00 1F 02 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 1E 02 00 00 01 00 00 00 1E 02 00 00 22 02 00 00 00 00 00 00 01 00 00 00' + '23 02 00 00 00 00 00 00 00 00 00 00 23 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 22 02 00 00' + '01 00 00 00 22 02 00 00 24 02 00 00 00 00 00 00 01 00 00 00 25 02 00 00 00 00 00 00 00 00 00 00' + '25 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 24 02 00 00 01 00 00 00 24 02 00 00 26 02 00 00' + '00 00 00 00 01 00 00 00 27 02 00 00 00 00 00 00 00 00 00 00 27 02 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 26 02 00 00 01 00 00 00 26 02 00 00 28 02 00 00 00 00 00 00 01 00 00 00 29 02 00 00' + '00 00 00 00 00 00 00 00 29 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 28 02 00 00 01 00 00 00' + '28 02 00 00 2A 02 00 00 00 00 00 00 01 00 00 00 2B 02 00 00 00 00 00 00 00 00 00 00 2B 02 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 2A 02 00 00 01 00 00 00 2A 02 00 00 2C 02 00 00 00 00 00 00' + '01 00 00 00 2D 02 00 00 00 00 00 00 00 00 00 00 2D 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '2C 02 00 00 01 00 00 00 2C 02 00 00 2E 02 00 00 00 00 00 00 01 00 00 00 2F 02 00 00 00 00 00 00' + '00 00 00 00 2F 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2E 02 00 00 01 00 00 00 2E 02 00 00' + '30 02 00 00 00 00 00 00 01 00 00 00 31 02 00 00 00 00 00 00 00 00 00 00 31 02 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 30 02 00 00 01 00 00 00 30 02 00 00 32 02 00 00 00 00 00 00 01 00 00 00' + '33 02 00 00 00 00 00 00 00 00 00 00 33 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 32 02 00 00' + '01 00 00 00 32 02 00 00 53 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 81 01 00 00 01 00 00 00' + '81 01 00 00 54 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 86 01 00 00 01 00 00 00 86 01 00 00' + '56 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 89 01 00 00 01 00 00 00 89 01 00 00 57 02 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 8A 01 00 00 01 00 00 00 8A 01 00 00 59 02 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 8F 01 00 00 01 00 00 00 8F 01 00 00 5B 02 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 90 01 00 00 01 00 00 00 90 01 00 00 60 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '93 01 00 00 01 00 00 00 93 01 00 00 63 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 94 01 00 00' + '01 00 00 00 94 01 00 00 68 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 97 01 00 00 01 00 00 00' + '97 01 00 00 69 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 96 01 00 00 01 00 00 00 96 01 00 00' + '6F 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 9C 01 00 00 01 00 00 00 9C 01 00 00 72 02 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 9D 01 00 00 01 00 00 00 9D 01 00 00 75 02 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 9F 01 00 00 01 00 00 00 9F 01 00 00 80 02 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 A6 01 00 00 01 00 00 00 A6 01 00 00 83 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'A9 01 00 00 01 00 00 00 A9 01 00 00 88 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 AE 01 00 00' + '01 00 00 00 AE 01 00 00 8A 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B1 01 00 00 01 00 00 00' + 'B1 01 00 00 8B 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B2 01 00 00 01 00 00 00 B2 01 00 00' + '92 02 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B7 01 00 00 01 00 00 00 B7 01 00 00 45 03 00 00' + '01 00 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 99 03 00 00 01 00 00 00 99 03 00 00 86 03 00 00' + '00 00 00 00 01 00 00 00 AC 03 00 00 00 00 00 00 00 00 00 00 88 03 00 00 00 00 00 00 01 00 00 00' + 'AD 03 00 00 00 00 00 00 00 00 00 00 89 03 00 00 00 00 00 00 01 00 00 00 AE 03 00 00 00 00 00 00' + '00 00 00 00 8A 03 00 00 00 00 00 00 01 00 00 00 AF 03 00 00 00 00 00 00 00 00 00 00 8C 03 00 00' + '00 00 00 00 01 00 00 00 CC 03 00 00 00 00 00 00 00 00 00 00 8E 03 00 00 00 00 00 00 01 00 00 00' + 'CD 03 00 00 00 00 00 00 00 00 00 00 8F 03 00 00 00 00 00 00 01 00 00 00 CE 03 00 00 00 00 00 00' + '00 00 00 00 90 03 00 00 03 00 00 00 B9 03 00 00 08 03 00 00 01 03 00 00 00 00 00 00 00 00 00 00' + '00 00 00 00 91 03 00 00 00 00 00 00 01 00 00 00 B1 03 00 00 00 00 00 00 00 00 00 00 92 03 00 00' + '00 00 00 00 01 00 00 00 B2 03 00 00 00 00 00 00 00 00 00 00 93 03 00 00 00 00 00 00 01 00 00 00' + 'B3 03 00 00 00 00 00 00 00 00 00 00 94 03 00 00 00 00 00 00 01 00 00 00 B4 03 00 00 00 00 00 00' + '00 00 00 00 95 03 00 00 00 00 00 00 01 00 00 00 B5 03 00 00 00 00 00 00 00 00 00 00 96 03 00 00' + '00 00 00 00 01 00 00 00 B6 03 00 00 00 00 00 00 00 00 00 00 97 03 00 00 00 00 00 00 01 00 00 00' + 'B7 03 00 00 00 00 00 00 00 00 00 00 98 03 00 00 00 00 00 00 01 00 00 00 B8 03 00 00 00 00 00 00' + '00 00 00 00 99 03 00 00 00 00 00 00 01 00 00 00 B9 03 00 00 00 00 00 00 00 00 00 00 9A 03 00 00' + '00 00 00 00 01 00 00 00 BA 03 00 00 00 00 00 00 00 00 00 00 9B 03 00 00 00 00 00 00 01 00 00 00' + 'BB 03 00 00 00 00 00 00 00 00 00 00 9C 03 00 00 00 00 00 00 01 00 00 00 BC 03 00 00 00 00 00 00' + '00 00 00 00 9D 03 00 00 00 00 00 00 01 00 00 00 BD 03 00 00 00 00 00 00 00 00 00 00 9E 03 00 00' + '00 00 00 00 01 00 00 00 BE 03 00 00 00 00 00 00 00 00 00 00 9F 03 00 00 00 00 00 00 01 00 00 00' + 'BF 03 00 00 00 00 00 00 00 00 00 00 A0 03 00 00 00 00 00 00 01 00 00 00 C0 03 00 00 00 00 00 00' + '00 00 00 00 A1 03 00 00 00 00 00 00 01 00 00 00 C1 03 00 00 00 00 00 00 00 00 00 00 A3 03 00 00' + '01 00 00 00 C2 03 00 00 01 00 00 00 C3 03 00 00 00 00 00 00 00 00 00 00 A4 03 00 00 00 00 00 00' + '01 00 00 00 C4 03 00 00 00 00 00 00 00 00 00 00 A5 03 00 00 00 00 00 00 01 00 00 00 C5 03 00 00' + '00 00 00 00 00 00 00 00 A6 03 00 00 00 00 00 00 01 00 00 00 C6 03 00 00 00 00 00 00 00 00 00 00' + 'A7 03 00 00 00 00 00 00 01 00 00 00 C7 03 00 00 00 00 00 00 00 00 00 00 A8 03 00 00 00 00 00 00' + '01 00 00 00 C8 03 00 00 00 00 00 00 00 00 00 00 A9 03 00 00 00 00 00 00 01 00 00 00 C9 03 00 00' + '00 00 00 00 00 00 00 00 AA 03 00 00 00 00 00 00 01 00 00 00 CA 03 00 00 00 00 00 00 00 00 00 00' + 'AB 03 00 00 00 00 00 00 01 00 00 00 CB 03 00 00 00 00 00 00 00 00 00 00 AC 03 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 86 03 00 00 01 00 00 00 86 03 00 00 AD 03 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 88 03 00 00 01 00 00 00 88 03 00 00 AE 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '89 03 00 00 01 00 00 00 89 03 00 00 AF 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 8A 03 00 00' + '01 00 00 00 8A 03 00 00 B0 03 00 00 03 00 00 00 C5 03 00 00 08 03 00 00 01 03 00 00 00 00 00 00' + '00 00 00 00 00 00 00 00 B1 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 91 03 00 00 01 00 00 00' + '91 03 00 00 B2 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 92 03 00 00 01 00 00 00 92 03 00 00' + 'B3 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 93 03 00 00 01 00 00 00 93 03 00 00 B4 03 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 94 03 00 00 01 00 00 00 94 03 00 00 B5 03 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 95 03 00 00 01 00 00 00 95 03 00 00 B6 03 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 96 03 00 00 01 00 00 00 96 03 00 00 B7 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '97 03 00 00 01 00 00 00 97 03 00 00 B8 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 98 03 00 00' + '01 00 00 00 98 03 00 00 B9 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 99 03 00 00 01 00 00 00' + '99 03 00 00 BA 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 9A 03 00 00 01 00 00 00 9A 03 00 00' + 'BB 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 9B 03 00 00 01 00 00 00 9B 03 00 00 BC 03 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 9C 03 00 00 01 00 00 00 9C 03 00 00 BD 03 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 9D 03 00 00 01 00 00 00 9D 03 00 00 BE 03 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 9E 03 00 00 01 00 00 00 9E 03 00 00 BF 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '9F 03 00 00 01 00 00 00 9F 03 00 00 C0 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A0 03 00 00' + '01 00 00 00 A0 03 00 00 C1 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A1 03 00 00 01 00 00 00' + 'A1 03 00 00 C2 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A3 03 00 00 01 00 00 00 A3 03 00 00' + 'C3 03 00 00 01 00 00 00 C2 03 00 00 00 00 00 00 01 00 00 00 A3 03 00 00 01 00 00 00 A3 03 00 00' + 'C4 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A4 03 00 00 01 00 00 00 A4 03 00 00 C5 03 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 A5 03 00 00 01 00 00 00 A5 03 00 00 C6 03 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 A6 03 00 00 01 00 00 00 A6 03 00 00 C7 03 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 A7 03 00 00 01 00 00 00 A7 03 00 00 C8 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'A8 03 00 00 01 00 00 00 A8 03 00 00 C9 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A9 03 00 00' + '01 00 00 00 A9 03 00 00 CA 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 AA 03 00 00 01 00 00 00' + 'AA 03 00 00 CB 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 AB 03 00 00 01 00 00 00 AB 03 00 00' + 'CC 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 8C 03 00 00 01 00 00 00 8C 03 00 00 CD 03 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 8E 03 00 00 01 00 00 00 8E 03 00 00 CE 03 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 8F 03 00 00 01 00 00 00 8F 03 00 00 D0 03 00 00 01 00 00 00 B2 03 00 00' + '00 00 00 00 01 00 00 00 92 03 00 00 01 00 00 00 92 03 00 00 D1 03 00 00 01 00 00 00 B8 03 00 00' + '00 00 00 00 01 00 00 00 98 03 00 00 01 00 00 00 98 03 00 00 D5 03 00 00 01 00 00 00 C6 03 00 00' + '00 00 00 00 01 00 00 00 A6 03 00 00 01 00 00 00 A6 03 00 00 D6 03 00 00 01 00 00 00 C0 03 00 00' + '00 00 00 00 01 00 00 00 A0 03 00 00 01 00 00 00 A0 03 00 00 DA 03 00 00 00 00 00 00 01 00 00 00' + 'DB 03 00 00 00 00 00 00 00 00 00 00 DB 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DA 03 00 00' + '01 00 00 00 DA 03 00 00 DC 03 00 00 00 00 00 00 01 00 00 00 DD 03 00 00 00 00 00 00 00 00 00 00' + 'DD 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DC 03 00 00 01 00 00 00 DC 03 00 00 DE 03 00 00' + '00 00 00 00 01 00 00 00 DF 03 00 00 00 00 00 00 00 00 00 00 DF 03 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 DE 03 00 00 01 00 00 00 DE 03 00 00 E0 03 00 00 00 00 00 00 01 00 00 00 E1 03 00 00' + '00 00 00 00 00 00 00 00 E1 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 03 00 00 01 00 00 00' + 'E0 03 00 00 E2 03 00 00 00 00 00 00 01 00 00 00 E3 03 00 00 00 00 00 00 00 00 00 00 E3 03 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 E2 03 00 00 01 00 00 00 E2 03 00 00 E4 03 00 00 00 00 00 00' + '01 00 00 00 E5 03 00 00 00 00 00 00 00 00 00 00 E5 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'E4 03 00 00 01 00 00 00 E4 03 00 00 E6 03 00 00 00 00 00 00 01 00 00 00 E7 03 00 00 00 00 00 00' + '00 00 00 00 E7 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E6 03 00 00 01 00 00 00 E6 03 00 00' + 'E8 03 00 00 00 00 00 00 01 00 00 00 E9 03 00 00 00 00 00 00 00 00 00 00 E9 03 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 E8 03 00 00 01 00 00 00 E8 03 00 00 EA 03 00 00 00 00 00 00 01 00 00 00' + 'EB 03 00 00 00 00 00 00 00 00 00 00 EB 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EA 03 00 00' + '01 00 00 00 EA 03 00 00 EC 03 00 00 00 00 00 00 01 00 00 00 ED 03 00 00 00 00 00 00 00 00 00 00' + 'ED 03 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EC 03 00 00 01 00 00 00 EC 03 00 00 EE 03 00 00' + '00 00 00 00 01 00 00 00 EF 03 00 00 00 00 00 00 00 00 00 00 EF 03 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 EE 03 00 00 01 00 00 00 EE 03 00 00 F0 03 00 00 01 00 00 00 BA 03 00 00 00 00 00 00' + '01 00 00 00 9A 03 00 00 01 00 00 00 9A 03 00 00 F1 03 00 00 01 00 00 00 C1 03 00 00 00 00 00 00' + '01 00 00 00 A1 03 00 00 01 00 00 00 A1 03 00 00 F2 03 00 00 01 00 00 00 C2 03 00 00 00 00 00 00' + '01 00 00 00 A3 03 00 00 01 00 00 00 A3 03 00 00 00 04 00 00 00 00 00 00 01 00 00 00 50 04 00 00' + '00 00 00 00 00 00 00 00 01 04 00 00 00 00 00 00 01 00 00 00 51 04 00 00 00 00 00 00 00 00 00 00' + '02 04 00 00 00 00 00 00 01 00 00 00 52 04 00 00 00 00 00 00 00 00 00 00 03 04 00 00 00 00 00 00' + '01 00 00 00 53 04 00 00 00 00 00 00 00 00 00 00 04 04 00 00 00 00 00 00 01 00 00 00 54 04 00 00' + '00 00 00 00 00 00 00 00 05 04 00 00 00 00 00 00 01 00 00 00 55 04 00 00 00 00 00 00 00 00 00 00' + '06 04 00 00 00 00 00 00 01 00 00 00 56 04 00 00 00 00 00 00 00 00 00 00 07 04 00 00 00 00 00 00' + '01 00 00 00 57 04 00 00 00 00 00 00 00 00 00 00 08 04 00 00 00 00 00 00 01 00 00 00 58 04 00 00' + '00 00 00 00 00 00 00 00 09 04 00 00 00 00 00 00 01 00 00 00 59 04 00 00 00 00 00 00 00 00 00 00' + '0A 04 00 00 00 00 00 00 01 00 00 00 5A 04 00 00 00 00 00 00 00 00 00 00 0B 04 00 00 00 00 00 00' + '01 00 00 00 5B 04 00 00 00 00 00 00 00 00 00 00 0C 04 00 00 00 00 00 00 01 00 00 00 5C 04 00 00' + '00 00 00 00 00 00 00 00 0D 04 00 00 00 00 00 00 01 00 00 00 5D 04 00 00 00 00 00 00 00 00 00 00' + '0E 04 00 00 00 00 00 00 01 00 00 00 5E 04 00 00 00 00 00 00 00 00 00 00 0F 04 00 00 00 00 00 00' + '01 00 00 00 5F 04 00 00 00 00 00 00 00 00 00 00 10 04 00 00 00 00 00 00 01 00 00 00 30 04 00 00' + '00 00 00 00 00 00 00 00 11 04 00 00 00 00 00 00 01 00 00 00 31 04 00 00 00 00 00 00 00 00 00 00' + '12 04 00 00 00 00 00 00 01 00 00 00 32 04 00 00 00 00 00 00 00 00 00 00 13 04 00 00 00 00 00 00' + '01 00 00 00 33 04 00 00 00 00 00 00 00 00 00 00 14 04 00 00 00 00 00 00 01 00 00 00 34 04 00 00' + '00 00 00 00 00 00 00 00 15 04 00 00 00 00 00 00 01 00 00 00 35 04 00 00 00 00 00 00 00 00 00 00' + '16 04 00 00 00 00 00 00 01 00 00 00 36 04 00 00 00 00 00 00 00 00 00 00 17 04 00 00 00 00 00 00' + '01 00 00 00 37 04 00 00 00 00 00 00 00 00 00 00 18 04 00 00 00 00 00 00 01 00 00 00 38 04 00 00' + '00 00 00 00 00 00 00 00 19 04 00 00 00 00 00 00 01 00 00 00 39 04 00 00 00 00 00 00 00 00 00 00' + '1A 04 00 00 00 00 00 00 01 00 00 00 3A 04 00 00 00 00 00 00 00 00 00 00 1B 04 00 00 00 00 00 00' + '01 00 00 00 3B 04 00 00 00 00 00 00 00 00 00 00 1C 04 00 00 00 00 00 00 01 00 00 00 3C 04 00 00' + '00 00 00 00 00 00 00 00 1D 04 00 00 00 00 00 00 01 00 00 00 3D 04 00 00 00 00 00 00 00 00 00 00' + '1E 04 00 00 00 00 00 00 01 00 00 00 3E 04 00 00 00 00 00 00 00 00 00 00 1F 04 00 00 00 00 00 00' + '01 00 00 00 3F 04 00 00 00 00 00 00 00 00 00 00 20 04 00 00 00 00 00 00 01 00 00 00 40 04 00 00' + '00 00 00 00 00 00 00 00 21 04 00 00 00 00 00 00 01 00 00 00 41 04 00 00 00 00 00 00 00 00 00 00' + '22 04 00 00 00 00 00 00 01 00 00 00 42 04 00 00 00 00 00 00 00 00 00 00 23 04 00 00 00 00 00 00' + '01 00 00 00 43 04 00 00 00 00 00 00 00 00 00 00 24 04 00 00 00 00 00 00 01 00 00 00 44 04 00 00' + '00 00 00 00 00 00 00 00 25 04 00 00 00 00 00 00 01 00 00 00 45 04 00 00 00 00 00 00 00 00 00 00' + '26 04 00 00 00 00 00 00 01 00 00 00 46 04 00 00 00 00 00 00 00 00 00 00 27 04 00 00 00 00 00 00' + '01 00 00 00 47 04 00 00 00 00 00 00 00 00 00 00 28 04 00 00 00 00 00 00 01 00 00 00 48 04 00 00' + '00 00 00 00 00 00 00 00 29 04 00 00 00 00 00 00 01 00 00 00 49 04 00 00 00 00 00 00 00 00 00 00' + '2A 04 00 00 00 00 00 00 01 00 00 00 4A 04 00 00 00 00 00 00 00 00 00 00 2B 04 00 00 00 00 00 00' + '01 00 00 00 4B 04 00 00 00 00 00 00 00 00 00 00 2C 04 00 00 00 00 00 00 01 00 00 00 4C 04 00 00' + '00 00 00 00 00 00 00 00 2D 04 00 00 00 00 00 00 01 00 00 00 4D 04 00 00 00 00 00 00 00 00 00 00' + '2E 04 00 00 00 00 00 00 01 00 00 00 4E 04 00 00 00 00 00 00 00 00 00 00 2F 04 00 00 00 00 00 00' + '01 00 00 00 4F 04 00 00 00 00 00 00 00 00 00 00 30 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '10 04 00 00 01 00 00 00 10 04 00 00 31 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 11 04 00 00' + '01 00 00 00 11 04 00 00 32 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 12 04 00 00 01 00 00 00' + '12 04 00 00 33 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 13 04 00 00 01 00 00 00 13 04 00 00' + '34 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 14 04 00 00 01 00 00 00 14 04 00 00 35 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 15 04 00 00 01 00 00 00 15 04 00 00 36 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 16 04 00 00 01 00 00 00 16 04 00 00 37 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 17 04 00 00 01 00 00 00 17 04 00 00 38 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '18 04 00 00 01 00 00 00 18 04 00 00 39 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 19 04 00 00' + '01 00 00 00 19 04 00 00 3A 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 1A 04 00 00 01 00 00 00' + '1A 04 00 00 3B 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 1B 04 00 00 01 00 00 00 1B 04 00 00' + '3C 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 1C 04 00 00 01 00 00 00 1C 04 00 00 3D 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 1D 04 00 00 01 00 00 00 1D 04 00 00 3E 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 1E 04 00 00 01 00 00 00 1E 04 00 00 3F 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 1F 04 00 00 01 00 00 00 1F 04 00 00 40 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '20 04 00 00 01 00 00 00 20 04 00 00 41 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 21 04 00 00' + '01 00 00 00 21 04 00 00 42 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 22 04 00 00 01 00 00 00' + '22 04 00 00 43 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 23 04 00 00 01 00 00 00 23 04 00 00' + '44 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 24 04 00 00 01 00 00 00 24 04 00 00 45 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 25 04 00 00 01 00 00 00 25 04 00 00 46 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 26 04 00 00 01 00 00 00 26 04 00 00 47 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 27 04 00 00 01 00 00 00 27 04 00 00 48 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '28 04 00 00 01 00 00 00 28 04 00 00 49 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 29 04 00 00' + '01 00 00 00 29 04 00 00 4A 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2A 04 00 00 01 00 00 00' + '2A 04 00 00 4B 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2B 04 00 00 01 00 00 00 2B 04 00 00' + '4C 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2C 04 00 00 01 00 00 00 2C 04 00 00 4D 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 2D 04 00 00 01 00 00 00 2D 04 00 00 4E 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 2E 04 00 00 01 00 00 00 2E 04 00 00 4F 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 2F 04 00 00 01 00 00 00 2F 04 00 00 50 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '00 04 00 00 01 00 00 00 00 04 00 00 51 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 01 04 00 00' + '01 00 00 00 01 04 00 00 52 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 02 04 00 00 01 00 00 00' + '02 04 00 00 53 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 03 04 00 00 01 00 00 00 03 04 00 00' + '54 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 04 04 00 00 01 00 00 00 04 04 00 00 55 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 05 04 00 00 01 00 00 00 05 04 00 00 56 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 06 04 00 00 01 00 00 00 06 04 00 00 57 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 07 04 00 00 01 00 00 00 07 04 00 00 58 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '08 04 00 00 01 00 00 00 08 04 00 00 59 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 09 04 00 00' + '01 00 00 00 09 04 00 00 5A 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 0A 04 00 00 01 00 00 00' + '0A 04 00 00 5B 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 0B 04 00 00 01 00 00 00 0B 04 00 00' + '5C 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 0C 04 00 00 01 00 00 00 0C 04 00 00 5D 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 0D 04 00 00 01 00 00 00 0D 04 00 00 5E 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 0E 04 00 00 01 00 00 00 0E 04 00 00 5F 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 0F 04 00 00 01 00 00 00 0F 04 00 00 60 04 00 00 00 00 00 00 01 00 00 00 61 04 00 00' + '00 00 00 00 00 00 00 00 61 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 60 04 00 00 01 00 00 00' + '60 04 00 00 62 04 00 00 00 00 00 00 01 00 00 00 63 04 00 00 00 00 00 00 00 00 00 00 63 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 62 04 00 00 01 00 00 00 62 04 00 00 64 04 00 00 00 00 00 00' + '01 00 00 00 65 04 00 00 00 00 00 00 00 00 00 00 65 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '64 04 00 00 01 00 00 00 64 04 00 00 66 04 00 00 00 00 00 00 01 00 00 00 67 04 00 00 00 00 00 00' + '00 00 00 00 67 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 66 04 00 00 01 00 00 00 66 04 00 00' + '68 04 00 00 00 00 00 00 01 00 00 00 69 04 00 00 00 00 00 00 00 00 00 00 69 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 68 04 00 00 01 00 00 00 68 04 00 00 6A 04 00 00 00 00 00 00 01 00 00 00' + '6B 04 00 00 00 00 00 00 00 00 00 00 6B 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6A 04 00 00' + '01 00 00 00 6A 04 00 00 6C 04 00 00 00 00 00 00 01 00 00 00 6D 04 00 00 00 00 00 00 00 00 00 00' + '6D 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6C 04 00 00 01 00 00 00 6C 04 00 00 6E 04 00 00' + '00 00 00 00 01 00 00 00 6F 04 00 00 00 00 00 00 00 00 00 00 6F 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 6E 04 00 00 01 00 00 00 6E 04 00 00 70 04 00 00 00 00 00 00 01 00 00 00 71 04 00 00' + '00 00 00 00 00 00 00 00 71 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 70 04 00 00 01 00 00 00' + '70 04 00 00 72 04 00 00 00 00 00 00 01 00 00 00 73 04 00 00 00 00 00 00 00 00 00 00 73 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 72 04 00 00 01 00 00 00 72 04 00 00 74 04 00 00 00 00 00 00' + '01 00 00 00 75 04 00 00 00 00 00 00 00 00 00 00 75 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '74 04 00 00 01 00 00 00 74 04 00 00 76 04 00 00 00 00 00 00 01 00 00 00 77 04 00 00 00 00 00 00' + '00 00 00 00 77 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 76 04 00 00 01 00 00 00 76 04 00 00' + '78 04 00 00 00 00 00 00 01 00 00 00 79 04 00 00 00 00 00 00 00 00 00 00 79 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 78 04 00 00 01 00 00 00 78 04 00 00 7A 04 00 00 00 00 00 00 01 00 00 00' + '7B 04 00 00 00 00 00 00 00 00 00 00 7B 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 7A 04 00 00' + '01 00 00 00 7A 04 00 00 7C 04 00 00 00 00 00 00 01 00 00 00 7D 04 00 00 00 00 00 00 00 00 00 00' + '7D 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 7C 04 00 00 01 00 00 00 7C 04 00 00 7E 04 00 00' + '00 00 00 00 01 00 00 00 7F 04 00 00 00 00 00 00 00 00 00 00 7F 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 7E 04 00 00 01 00 00 00 7E 04 00 00 80 04 00 00 00 00 00 00 01 00 00 00 81 04 00 00' + '00 00 00 00 00 00 00 00 81 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 80 04 00 00 01 00 00 00' + '80 04 00 00 8C 04 00 00 00 00 00 00 01 00 00 00 8D 04 00 00 00 00 00 00 00 00 00 00 8D 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 8C 04 00 00 01 00 00 00 8C 04 00 00 8E 04 00 00 00 00 00 00' + '01 00 00 00 8F 04 00 00 00 00 00 00 00 00 00 00 8F 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '8E 04 00 00 01 00 00 00 8E 04 00 00 90 04 00 00 00 00 00 00 01 00 00 00 91 04 00 00 00 00 00 00' + '00 00 00 00 91 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 90 04 00 00 01 00 00 00 90 04 00 00' + '92 04 00 00 00 00 00 00 01 00 00 00 93 04 00 00 00 00 00 00 00 00 00 00 93 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 92 04 00 00 01 00 00 00 92 04 00 00 94 04 00 00 00 00 00 00 01 00 00 00' + '95 04 00 00 00 00 00 00 00 00 00 00 95 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 94 04 00 00' + '01 00 00 00 94 04 00 00 96 04 00 00 00 00 00 00 01 00 00 00 97 04 00 00 00 00 00 00 00 00 00 00' + '97 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 96 04 00 00 01 00 00 00 96 04 00 00 98 04 00 00' + '00 00 00 00 01 00 00 00 99 04 00 00 00 00 00 00 00 00 00 00 99 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 98 04 00 00 01 00 00 00 98 04 00 00 9A 04 00 00 00 00 00 00 01 00 00 00 9B 04 00 00' + '00 00 00 00 00 00 00 00 9B 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 9A 04 00 00 01 00 00 00' + '9A 04 00 00 9C 04 00 00 00 00 00 00 01 00 00 00 9D 04 00 00 00 00 00 00 00 00 00 00 9D 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 9C 04 00 00 01 00 00 00 9C 04 00 00 9E 04 00 00 00 00 00 00' + '01 00 00 00 9F 04 00 00 00 00 00 00 00 00 00 00 9F 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '9E 04 00 00 01 00 00 00 9E 04 00 00 A0 04 00 00 00 00 00 00 01 00 00 00 A1 04 00 00 00 00 00 00' + '00 00 00 00 A1 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A0 04 00 00 01 00 00 00 A0 04 00 00' + 'A2 04 00 00 00 00 00 00 01 00 00 00 A3 04 00 00 00 00 00 00 00 00 00 00 A3 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 A2 04 00 00 01 00 00 00 A2 04 00 00 A4 04 00 00 00 00 00 00 01 00 00 00' + 'A5 04 00 00 00 00 00 00 00 00 00 00 A5 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A4 04 00 00' + '01 00 00 00 A4 04 00 00 A6 04 00 00 00 00 00 00 01 00 00 00 A7 04 00 00 00 00 00 00 00 00 00 00' + 'A7 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A6 04 00 00 01 00 00 00 A6 04 00 00 A8 04 00 00' + '00 00 00 00 01 00 00 00 A9 04 00 00 00 00 00 00 00 00 00 00 A9 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 A8 04 00 00 01 00 00 00 A8 04 00 00 AA 04 00 00 00 00 00 00 01 00 00 00 AB 04 00 00' + '00 00 00 00 00 00 00 00 AB 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 AA 04 00 00 01 00 00 00' + 'AA 04 00 00 AC 04 00 00 00 00 00 00 01 00 00 00 AD 04 00 00 00 00 00 00 00 00 00 00 AD 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 AC 04 00 00 01 00 00 00 AC 04 00 00 AE 04 00 00 00 00 00 00' + '01 00 00 00 AF 04 00 00 00 00 00 00 00 00 00 00 AF 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'AE 04 00 00 01 00 00 00 AE 04 00 00 B0 04 00 00 00 00 00 00 01 00 00 00 B1 04 00 00 00 00 00 00' + '00 00 00 00 B1 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B0 04 00 00 01 00 00 00 B0 04 00 00' + 'B2 04 00 00 00 00 00 00 01 00 00 00 B3 04 00 00 00 00 00 00 00 00 00 00 B3 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 B2 04 00 00 01 00 00 00 B2 04 00 00 B4 04 00 00 00 00 00 00 01 00 00 00' + 'B5 04 00 00 00 00 00 00 00 00 00 00 B5 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B4 04 00 00' + '01 00 00 00 B4 04 00 00 B6 04 00 00 00 00 00 00 01 00 00 00 B7 04 00 00 00 00 00 00 00 00 00 00' + 'B7 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B6 04 00 00 01 00 00 00 B6 04 00 00 B8 04 00 00' + '00 00 00 00 01 00 00 00 B9 04 00 00 00 00 00 00 00 00 00 00 B9 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 B8 04 00 00 01 00 00 00 B8 04 00 00 BA 04 00 00 00 00 00 00 01 00 00 00 BB 04 00 00' + '00 00 00 00 00 00 00 00 BB 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BA 04 00 00 01 00 00 00' + 'BA 04 00 00 BC 04 00 00 00 00 00 00 01 00 00 00 BD 04 00 00 00 00 00 00 00 00 00 00 BD 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 BC 04 00 00 01 00 00 00 BC 04 00 00 BE 04 00 00 00 00 00 00' + '01 00 00 00 BF 04 00 00 00 00 00 00 00 00 00 00 BF 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'BE 04 00 00 01 00 00 00 BE 04 00 00 C1 04 00 00 00 00 00 00 01 00 00 00 C2 04 00 00 00 00 00 00' + '00 00 00 00 C2 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C1 04 00 00 01 00 00 00 C1 04 00 00' + 'C3 04 00 00 00 00 00 00 01 00 00 00 C4 04 00 00 00 00 00 00 00 00 00 00 C4 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 C3 04 00 00 01 00 00 00 C3 04 00 00 C7 04 00 00 00 00 00 00 01 00 00 00' + 'C8 04 00 00 00 00 00 00 00 00 00 00 C8 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C7 04 00 00' + '01 00 00 00 C7 04 00 00 CB 04 00 00 00 00 00 00 01 00 00 00 CC 04 00 00 00 00 00 00 00 00 00 00' + 'CC 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CB 04 00 00 01 00 00 00 CB 04 00 00 D0 04 00 00' + '00 00 00 00 01 00 00 00 D1 04 00 00 00 00 00 00 00 00 00 00 D1 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 D0 04 00 00 01 00 00 00 D0 04 00 00 D2 04 00 00 00 00 00 00 01 00 00 00 D3 04 00 00' + '00 00 00 00 00 00 00 00 D3 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D2 04 00 00 01 00 00 00' + 'D2 04 00 00 D4 04 00 00 00 00 00 00 01 00 00 00 D5 04 00 00 00 00 00 00 00 00 00 00 D5 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 D4 04 00 00 01 00 00 00 D4 04 00 00 D6 04 00 00 00 00 00 00' + '01 00 00 00 D7 04 00 00 00 00 00 00 00 00 00 00 D7 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'D6 04 00 00 01 00 00 00 D6 04 00 00 D8 04 00 00 00 00 00 00 01 00 00 00 D9 04 00 00 00 00 00 00' + '00 00 00 00 D9 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D8 04 00 00 01 00 00 00 D8 04 00 00' + 'DA 04 00 00 00 00 00 00 01 00 00 00 DB 04 00 00 00 00 00 00 00 00 00 00 DB 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 DA 04 00 00 01 00 00 00 DA 04 00 00 DC 04 00 00 00 00 00 00 01 00 00 00' + 'DD 04 00 00 00 00 00 00 00 00 00 00 DD 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DC 04 00 00' + '01 00 00 00 DC 04 00 00 DE 04 00 00 00 00 00 00 01 00 00 00 DF 04 00 00 00 00 00 00 00 00 00 00' + 'DF 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DE 04 00 00 01 00 00 00 DE 04 00 00 E0 04 00 00' + '00 00 00 00 01 00 00 00 E1 04 00 00 00 00 00 00 00 00 00 00 E1 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 E0 04 00 00 01 00 00 00 E0 04 00 00 E2 04 00 00 00 00 00 00 01 00 00 00 E3 04 00 00' + '00 00 00 00 00 00 00 00 E3 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E2 04 00 00 01 00 00 00' + 'E2 04 00 00 E4 04 00 00 00 00 00 00 01 00 00 00 E5 04 00 00 00 00 00 00 00 00 00 00 E5 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 E4 04 00 00 01 00 00 00 E4 04 00 00 E6 04 00 00 00 00 00 00' + '01 00 00 00 E7 04 00 00 00 00 00 00 00 00 00 00 E7 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'E6 04 00 00 01 00 00 00 E6 04 00 00 E8 04 00 00 00 00 00 00 01 00 00 00 E9 04 00 00 00 00 00 00' + '00 00 00 00 E9 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E8 04 00 00 01 00 00 00 E8 04 00 00' + 'EA 04 00 00 00 00 00 00 01 00 00 00 EB 04 00 00 00 00 00 00 00 00 00 00 EB 04 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 EA 04 00 00 01 00 00 00 EA 04 00 00 EC 04 00 00 00 00 00 00 01 00 00 00' + 'ED 04 00 00 00 00 00 00 00 00 00 00 ED 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EC 04 00 00' + '01 00 00 00 EC 04 00 00 EE 04 00 00 00 00 00 00 01 00 00 00 EF 04 00 00 00 00 00 00 00 00 00 00' + 'EF 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EE 04 00 00 01 00 00 00 EE 04 00 00 F0 04 00 00' + '00 00 00 00 01 00 00 00 F1 04 00 00 00 00 00 00 00 00 00 00 F1 04 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 F0 04 00 00 01 00 00 00 F0 04 00 00 F2 04 00 00 00 00 00 00 01 00 00 00 F3 04 00 00' + '00 00 00 00 00 00 00 00 F3 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00 F2 04 00 00 01 00 00 00' + 'F2 04 00 00 F4 04 00 00 00 00 00 00 01 00 00 00 F5 04 00 00 00 00 00 00 00 00 00 00 F5 04 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 F4 04 00 00 01 00 00 00 F4 04 00 00 F8 04 00 00 00 00 00 00' + '01 00 00 00 F9 04 00 00 00 00 00 00 00 00 00 00 F9 04 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'F8 04 00 00 01 00 00 00 F8 04 00 00 31 05 00 00 00 00 00 00 01 00 00 00 61 05 00 00 00 00 00 00' + '00 00 00 00 32 05 00 00 00 00 00 00 01 00 00 00 62 05 00 00 00 00 00 00 00 00 00 00 33 05 00 00' + '00 00 00 00 01 00 00 00 63 05 00 00 00 00 00 00 00 00 00 00 34 05 00 00 00 00 00 00 01 00 00 00' + '64 05 00 00 00 00 00 00 00 00 00 00 35 05 00 00 00 00 00 00 01 00 00 00 65 05 00 00 00 00 00 00' + '00 00 00 00 36 05 00 00 00 00 00 00 01 00 00 00 66 05 00 00 00 00 00 00 00 00 00 00 37 05 00 00' + '00 00 00 00 01 00 00 00 67 05 00 00 00 00 00 00 00 00 00 00 38 05 00 00 00 00 00 00 01 00 00 00' + '68 05 00 00 00 00 00 00 00 00 00 00 39 05 00 00 00 00 00 00 01 00 00 00 69 05 00 00 00 00 00 00' + '00 00 00 00 3A 05 00 00 00 00 00 00 01 00 00 00 6A 05 00 00 00 00 00 00 00 00 00 00 3B 05 00 00' + '00 00 00 00 01 00 00 00 6B 05 00 00 00 00 00 00 00 00 00 00 3C 05 00 00 00 00 00 00 01 00 00 00' + '6C 05 00 00 00 00 00 00 00 00 00 00 3D 05 00 00 00 00 00 00 01 00 00 00 6D 05 00 00 00 00 00 00' + '00 00 00 00 3E 05 00 00 00 00 00 00 01 00 00 00 6E 05 00 00 00 00 00 00 00 00 00 00 3F 05 00 00' + '00 00 00 00 01 00 00 00 6F 05 00 00 00 00 00 00 00 00 00 00 40 05 00 00 00 00 00 00 01 00 00 00' + '70 05 00 00 00 00 00 00 00 00 00 00 41 05 00 00 00 00 00 00 01 00 00 00 71 05 00 00 00 00 00 00' + '00 00 00 00 42 05 00 00 00 00 00 00 01 00 00 00 72 05 00 00 00 00 00 00 00 00 00 00 43 05 00 00' + '00 00 00 00 01 00 00 00 73 05 00 00 00 00 00 00 00 00 00 00 44 05 00 00 00 00 00 00 01 00 00 00' + '74 05 00 00 00 00 00 00 00 00 00 00 45 05 00 00 00 00 00 00 01 00 00 00 75 05 00 00 00 00 00 00' + '00 00 00 00 46 05 00 00 00 00 00 00 01 00 00 00 76 05 00 00 00 00 00 00 00 00 00 00 47 05 00 00' + '00 00 00 00 01 00 00 00 77 05 00 00 00 00 00 00 00 00 00 00 48 05 00 00 00 00 00 00 01 00 00 00' + '78 05 00 00 00 00 00 00 00 00 00 00 49 05 00 00 00 00 00 00 01 00 00 00 79 05 00 00 00 00 00 00' + '00 00 00 00 4A 05 00 00 00 00 00 00 01 00 00 00 7A 05 00 00 00 00 00 00 00 00 00 00 4B 05 00 00' + '00 00 00 00 01 00 00 00 7B 05 00 00 00 00 00 00 00 00 00 00 4C 05 00 00 00 00 00 00 01 00 00 00' + '7C 05 00 00 00 00 00 00 00 00 00 00 4D 05 00 00 00 00 00 00 01 00 00 00 7D 05 00 00 00 00 00 00' + '00 00 00 00 4E 05 00 00 00 00 00 00 01 00 00 00 7E 05 00 00 00 00 00 00 00 00 00 00 4F 05 00 00' + '00 00 00 00 01 00 00 00 7F 05 00 00 00 00 00 00 00 00 00 00 50 05 00 00 00 00 00 00 01 00 00 00' + '80 05 00 00 00 00 00 00 00 00 00 00 51 05 00 00 00 00 00 00 01 00 00 00 81 05 00 00 00 00 00 00' + '00 00 00 00 52 05 00 00 00 00 00 00 01 00 00 00 82 05 00 00 00 00 00 00 00 00 00 00 53 05 00 00' + '00 00 00 00 01 00 00 00 83 05 00 00 00 00 00 00 00 00 00 00 54 05 00 00 00 00 00 00 01 00 00 00' + '84 05 00 00 00 00 00 00 00 00 00 00 55 05 00 00 00 00 00 00 01 00 00 00 85 05 00 00 00 00 00 00' + '00 00 00 00 56 05 00 00 00 00 00 00 01 00 00 00 86 05 00 00 00 00 00 00 00 00 00 00 61 05 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 31 05 00 00 01 00 00 00 31 05 00 00 62 05 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 32 05 00 00 01 00 00 00 32 05 00 00 63 05 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 33 05 00 00 01 00 00 00 33 05 00 00 64 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '34 05 00 00 01 00 00 00 34 05 00 00 65 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 35 05 00 00' + '01 00 00 00 35 05 00 00 66 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 36 05 00 00 01 00 00 00' + '36 05 00 00 67 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 37 05 00 00 01 00 00 00 37 05 00 00' + '68 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 38 05 00 00 01 00 00 00 38 05 00 00 69 05 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 39 05 00 00 01 00 00 00 39 05 00 00 6A 05 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 3A 05 00 00 01 00 00 00 3A 05 00 00 6B 05 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 3B 05 00 00 01 00 00 00 3B 05 00 00 6C 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '3C 05 00 00 01 00 00 00 3C 05 00 00 6D 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 3D 05 00 00' + '01 00 00 00 3D 05 00 00 6E 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 3E 05 00 00 01 00 00 00' + '3E 05 00 00 6F 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 3F 05 00 00 01 00 00 00 3F 05 00 00' + '70 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 40 05 00 00 01 00 00 00 40 05 00 00 71 05 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 41 05 00 00 01 00 00 00 41 05 00 00 72 05 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 42 05 00 00 01 00 00 00 42 05 00 00 73 05 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 43 05 00 00 01 00 00 00 43 05 00 00 74 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '44 05 00 00 01 00 00 00 44 05 00 00 75 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 45 05 00 00' + '01 00 00 00 45 05 00 00 76 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 46 05 00 00 01 00 00 00' + '46 05 00 00 77 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 47 05 00 00 01 00 00 00 47 05 00 00' + '78 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 48 05 00 00 01 00 00 00 48 05 00 00 79 05 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 49 05 00 00 01 00 00 00 49 05 00 00 7A 05 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 4A 05 00 00 01 00 00 00 4A 05 00 00 7B 05 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 4B 05 00 00 01 00 00 00 4B 05 00 00 7C 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '4C 05 00 00 01 00 00 00 4C 05 00 00 7D 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4D 05 00 00' + '01 00 00 00 4D 05 00 00 7E 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4E 05 00 00 01 00 00 00' + '4E 05 00 00 7F 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4F 05 00 00 01 00 00 00 4F 05 00 00' + '80 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 50 05 00 00 01 00 00 00 50 05 00 00 81 05 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 51 05 00 00 01 00 00 00 51 05 00 00 82 05 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 52 05 00 00 01 00 00 00 52 05 00 00 83 05 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 53 05 00 00 01 00 00 00 53 05 00 00 84 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '54 05 00 00 01 00 00 00 54 05 00 00 85 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 55 05 00 00' + '01 00 00 00 55 05 00 00 86 05 00 00 00 00 00 00 00 00 00 00 01 00 00 00 56 05 00 00 01 00 00 00' + '56 05 00 00 87 05 00 00 02 00 00 00 65 05 00 00 82 05 00 00 00 00 00 00 00 00 00 00 00 00 00 00' + '00 1E 00 00 00 00 00 00 01 00 00 00 01 1E 00 00 00 00 00 00 00 00 00 00 01 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 00 1E 00 00 01 00 00 00 00 1E 00 00 02 1E 00 00 00 00 00 00 01 00 00 00' + '03 1E 00 00 00 00 00 00 00 00 00 00 03 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 02 1E 00 00' + '01 00 00 00 02 1E 00 00 04 1E 00 00 00 00 00 00 01 00 00 00 05 1E 00 00 00 00 00 00 00 00 00 00' + '05 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 04 1E 00 00 01 00 00 00 04 1E 00 00 06 1E 00 00' + '00 00 00 00 01 00 00 00 07 1E 00 00 00 00 00 00 00 00 00 00 07 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 06 1E 00 00 01 00 00 00 06 1E 00 00 08 1E 00 00 00 00 00 00 01 00 00 00 09 1E 00 00' + '00 00 00 00 00 00 00 00 09 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 08 1E 00 00 01 00 00 00' + '08 1E 00 00 0A 1E 00 00 00 00 00 00 01 00 00 00 0B 1E 00 00 00 00 00 00 00 00 00 00 0B 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 0A 1E 00 00 01 00 00 00 0A 1E 00 00 0C 1E 00 00 00 00 00 00' + '01 00 00 00 0D 1E 00 00 00 00 00 00 00 00 00 00 0D 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '0C 1E 00 00 01 00 00 00 0C 1E 00 00 0E 1E 00 00 00 00 00 00 01 00 00 00 0F 1E 00 00 00 00 00 00' + '00 00 00 00 0F 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 0E 1E 00 00 01 00 00 00 0E 1E 00 00' + '10 1E 00 00 00 00 00 00 01 00 00 00 11 1E 00 00 00 00 00 00 00 00 00 00 11 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 10 1E 00 00 01 00 00 00 10 1E 00 00 12 1E 00 00 00 00 00 00 01 00 00 00' + '13 1E 00 00 00 00 00 00 00 00 00 00 13 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 12 1E 00 00' + '01 00 00 00 12 1E 00 00 14 1E 00 00 00 00 00 00 01 00 00 00 15 1E 00 00 00 00 00 00 00 00 00 00' + '15 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 14 1E 00 00 01 00 00 00 14 1E 00 00 16 1E 00 00' + '00 00 00 00 01 00 00 00 17 1E 00 00 00 00 00 00 00 00 00 00 17 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 16 1E 00 00 01 00 00 00 16 1E 00 00 18 1E 00 00 00 00 00 00 01 00 00 00 19 1E 00 00' + '00 00 00 00 00 00 00 00 19 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 18 1E 00 00 01 00 00 00' + '18 1E 00 00 1A 1E 00 00 00 00 00 00 01 00 00 00 1B 1E 00 00 00 00 00 00 00 00 00 00 1B 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 1A 1E 00 00 01 00 00 00 1A 1E 00 00 1C 1E 00 00 00 00 00 00' + '01 00 00 00 1D 1E 00 00 00 00 00 00 00 00 00 00 1D 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '1C 1E 00 00 01 00 00 00 1C 1E 00 00 1E 1E 00 00 00 00 00 00 01 00 00 00 1F 1E 00 00 00 00 00 00' + '00 00 00 00 1F 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 1E 1E 00 00 01 00 00 00 1E 1E 00 00' + '20 1E 00 00 00 00 00 00 01 00 00 00 21 1E 00 00 00 00 00 00 00 00 00 00 21 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 20 1E 00 00 01 00 00 00 20 1E 00 00 22 1E 00 00 00 00 00 00 01 00 00 00' + '23 1E 00 00 00 00 00 00 00 00 00 00 23 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 22 1E 00 00' + '01 00 00 00 22 1E 00 00 24 1E 00 00 00 00 00 00 01 00 00 00 25 1E 00 00 00 00 00 00 00 00 00 00' + '25 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 24 1E 00 00 01 00 00 00 24 1E 00 00 26 1E 00 00' + '00 00 00 00 01 00 00 00 27 1E 00 00 00 00 00 00 00 00 00 00 27 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 26 1E 00 00 01 00 00 00 26 1E 00 00 28 1E 00 00 00 00 00 00 01 00 00 00 29 1E 00 00' + '00 00 00 00 00 00 00 00 29 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 28 1E 00 00 01 00 00 00' + '28 1E 00 00 2A 1E 00 00 00 00 00 00 01 00 00 00 2B 1E 00 00 00 00 00 00 00 00 00 00 2B 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 2A 1E 00 00 01 00 00 00 2A 1E 00 00 2C 1E 00 00 00 00 00 00' + '01 00 00 00 2D 1E 00 00 00 00 00 00 00 00 00 00 2D 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '2C 1E 00 00 01 00 00 00 2C 1E 00 00 2E 1E 00 00 00 00 00 00 01 00 00 00 2F 1E 00 00 00 00 00 00' + '00 00 00 00 2F 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2E 1E 00 00 01 00 00 00 2E 1E 00 00' + '30 1E 00 00 00 00 00 00 01 00 00 00 31 1E 00 00 00 00 00 00 00 00 00 00 31 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 30 1E 00 00 01 00 00 00 30 1E 00 00 32 1E 00 00 00 00 00 00 01 00 00 00' + '33 1E 00 00 00 00 00 00 00 00 00 00 33 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 32 1E 00 00' + '01 00 00 00 32 1E 00 00 34 1E 00 00 00 00 00 00 01 00 00 00 35 1E 00 00 00 00 00 00 00 00 00 00' + '35 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 34 1E 00 00 01 00 00 00 34 1E 00 00 36 1E 00 00' + '00 00 00 00 01 00 00 00 37 1E 00 00 00 00 00 00 00 00 00 00 37 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 36 1E 00 00 01 00 00 00 36 1E 00 00 38 1E 00 00 00 00 00 00 01 00 00 00 39 1E 00 00' + '00 00 00 00 00 00 00 00 39 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 38 1E 00 00 01 00 00 00' + '38 1E 00 00 3A 1E 00 00 00 00 00 00 01 00 00 00 3B 1E 00 00 00 00 00 00 00 00 00 00 3B 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 3A 1E 00 00 01 00 00 00 3A 1E 00 00 3C 1E 00 00 00 00 00 00' + '01 00 00 00 3D 1E 00 00 00 00 00 00 00 00 00 00 3D 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '3C 1E 00 00 01 00 00 00 3C 1E 00 00 3E 1E 00 00 00 00 00 00 01 00 00 00 3F 1E 00 00 00 00 00 00' + '00 00 00 00 3F 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 3E 1E 00 00 01 00 00 00 3E 1E 00 00' + '40 1E 00 00 00 00 00 00 01 00 00 00 41 1E 00 00 00 00 00 00 00 00 00 00 41 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 40 1E 00 00 01 00 00 00 40 1E 00 00 42 1E 00 00 00 00 00 00 01 00 00 00' + '43 1E 00 00 00 00 00 00 00 00 00 00 43 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 42 1E 00 00' + '01 00 00 00 42 1E 00 00 44 1E 00 00 00 00 00 00 01 00 00 00 45 1E 00 00 00 00 00 00 00 00 00 00' + '45 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 44 1E 00 00 01 00 00 00 44 1E 00 00 46 1E 00 00' + '00 00 00 00 01 00 00 00 47 1E 00 00 00 00 00 00 00 00 00 00 47 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 46 1E 00 00 01 00 00 00 46 1E 00 00 48 1E 00 00 00 00 00 00 01 00 00 00 49 1E 00 00' + '00 00 00 00 00 00 00 00 49 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 48 1E 00 00 01 00 00 00' + '48 1E 00 00 4A 1E 00 00 00 00 00 00 01 00 00 00 4B 1E 00 00 00 00 00 00 00 00 00 00 4B 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 4A 1E 00 00 01 00 00 00 4A 1E 00 00 4C 1E 00 00 00 00 00 00' + '01 00 00 00 4D 1E 00 00 00 00 00 00 00 00 00 00 4D 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '4C 1E 00 00 01 00 00 00 4C 1E 00 00 4E 1E 00 00 00 00 00 00 01 00 00 00 4F 1E 00 00 00 00 00 00' + '00 00 00 00 4F 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 4E 1E 00 00 01 00 00 00 4E 1E 00 00' + '50 1E 00 00 00 00 00 00 01 00 00 00 51 1E 00 00 00 00 00 00 00 00 00 00 51 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 50 1E 00 00 01 00 00 00 50 1E 00 00 52 1E 00 00 00 00 00 00 01 00 00 00' + '53 1E 00 00 00 00 00 00 00 00 00 00 53 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 52 1E 00 00' + '01 00 00 00 52 1E 00 00 54 1E 00 00 00 00 00 00 01 00 00 00 55 1E 00 00 00 00 00 00 00 00 00 00' + '55 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 54 1E 00 00 01 00 00 00 54 1E 00 00 56 1E 00 00' + '00 00 00 00 01 00 00 00 57 1E 00 00 00 00 00 00 00 00 00 00 57 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 56 1E 00 00 01 00 00 00 56 1E 00 00 58 1E 00 00 00 00 00 00 01 00 00 00 59 1E 00 00' + '00 00 00 00 00 00 00 00 59 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 58 1E 00 00 01 00 00 00' + '58 1E 00 00 5A 1E 00 00 00 00 00 00 01 00 00 00 5B 1E 00 00 00 00 00 00 00 00 00 00 5B 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 5A 1E 00 00 01 00 00 00 5A 1E 00 00 5C 1E 00 00 00 00 00 00' + '01 00 00 00 5D 1E 00 00 00 00 00 00 00 00 00 00 5D 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '5C 1E 00 00 01 00 00 00 5C 1E 00 00 5E 1E 00 00 00 00 00 00 01 00 00 00 5F 1E 00 00 00 00 00 00' + '00 00 00 00 5F 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 5E 1E 00 00 01 00 00 00 5E 1E 00 00' + '60 1E 00 00 00 00 00 00 01 00 00 00 61 1E 00 00 00 00 00 00 00 00 00 00 61 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 60 1E 00 00 01 00 00 00 60 1E 00 00 62 1E 00 00 00 00 00 00 01 00 00 00' + '63 1E 00 00 00 00 00 00 00 00 00 00 63 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 62 1E 00 00' + '01 00 00 00 62 1E 00 00 64 1E 00 00 00 00 00 00 01 00 00 00 65 1E 00 00 00 00 00 00 00 00 00 00' + '65 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 64 1E 00 00 01 00 00 00 64 1E 00 00 66 1E 00 00' + '00 00 00 00 01 00 00 00 67 1E 00 00 00 00 00 00 00 00 00 00 67 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 66 1E 00 00 01 00 00 00 66 1E 00 00 68 1E 00 00 00 00 00 00 01 00 00 00 69 1E 00 00' + '00 00 00 00 00 00 00 00 69 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 68 1E 00 00 01 00 00 00' + '68 1E 00 00 6A 1E 00 00 00 00 00 00 01 00 00 00 6B 1E 00 00 00 00 00 00 00 00 00 00 6B 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 6A 1E 00 00 01 00 00 00 6A 1E 00 00 6C 1E 00 00 00 00 00 00' + '01 00 00 00 6D 1E 00 00 00 00 00 00 00 00 00 00 6D 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '6C 1E 00 00 01 00 00 00 6C 1E 00 00 6E 1E 00 00 00 00 00 00 01 00 00 00 6F 1E 00 00 00 00 00 00' + '00 00 00 00 6F 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6E 1E 00 00 01 00 00 00 6E 1E 00 00' + '70 1E 00 00 00 00 00 00 01 00 00 00 71 1E 00 00 00 00 00 00 00 00 00 00 71 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 70 1E 00 00 01 00 00 00 70 1E 00 00 72 1E 00 00 00 00 00 00 01 00 00 00' + '73 1E 00 00 00 00 00 00 00 00 00 00 73 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 72 1E 00 00' + '01 00 00 00 72 1E 00 00 74 1E 00 00 00 00 00 00 01 00 00 00 75 1E 00 00 00 00 00 00 00 00 00 00' + '75 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 74 1E 00 00 01 00 00 00 74 1E 00 00 76 1E 00 00' + '00 00 00 00 01 00 00 00 77 1E 00 00 00 00 00 00 00 00 00 00 77 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 76 1E 00 00 01 00 00 00 76 1E 00 00 78 1E 00 00 00 00 00 00 01 00 00 00 79 1E 00 00' + '00 00 00 00 00 00 00 00 79 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 78 1E 00 00 01 00 00 00' + '78 1E 00 00 7A 1E 00 00 00 00 00 00 01 00 00 00 7B 1E 00 00 00 00 00 00 00 00 00 00 7B 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 7A 1E 00 00 01 00 00 00 7A 1E 00 00 7C 1E 00 00 00 00 00 00' + '01 00 00 00 7D 1E 00 00 00 00 00 00 00 00 00 00 7D 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '7C 1E 00 00 01 00 00 00 7C 1E 00 00 7E 1E 00 00 00 00 00 00 01 00 00 00 7F 1E 00 00 00 00 00 00' + '00 00 00 00 7F 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 7E 1E 00 00 01 00 00 00 7E 1E 00 00' + '80 1E 00 00 00 00 00 00 01 00 00 00 81 1E 00 00 00 00 00 00 00 00 00 00 81 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 80 1E 00 00 01 00 00 00 80 1E 00 00 82 1E 00 00 00 00 00 00 01 00 00 00' + '83 1E 00 00 00 00 00 00 00 00 00 00 83 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 82 1E 00 00' + '01 00 00 00 82 1E 00 00 84 1E 00 00 00 00 00 00 01 00 00 00 85 1E 00 00 00 00 00 00 00 00 00 00' + '85 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 84 1E 00 00 01 00 00 00 84 1E 00 00 86 1E 00 00' + '00 00 00 00 01 00 00 00 87 1E 00 00 00 00 00 00 00 00 00 00 87 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 86 1E 00 00 01 00 00 00 86 1E 00 00 88 1E 00 00 00 00 00 00 01 00 00 00 89 1E 00 00' + '00 00 00 00 00 00 00 00 89 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 88 1E 00 00 01 00 00 00' + '88 1E 00 00 8A 1E 00 00 00 00 00 00 01 00 00 00 8B 1E 00 00 00 00 00 00 00 00 00 00 8B 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 8A 1E 00 00 01 00 00 00 8A 1E 00 00 8C 1E 00 00 00 00 00 00' + '01 00 00 00 8D 1E 00 00 00 00 00 00 00 00 00 00 8D 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '8C 1E 00 00 01 00 00 00 8C 1E 00 00 8E 1E 00 00 00 00 00 00 01 00 00 00 8F 1E 00 00 00 00 00 00' + '00 00 00 00 8F 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 8E 1E 00 00 01 00 00 00 8E 1E 00 00' + '90 1E 00 00 00 00 00 00 01 00 00 00 91 1E 00 00 00 00 00 00 00 00 00 00 91 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 90 1E 00 00 01 00 00 00 90 1E 00 00 92 1E 00 00 00 00 00 00 01 00 00 00' + '93 1E 00 00 00 00 00 00 00 00 00 00 93 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 92 1E 00 00' + '01 00 00 00 92 1E 00 00 94 1E 00 00 00 00 00 00 01 00 00 00 95 1E 00 00 00 00 00 00 00 00 00 00' + '95 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 94 1E 00 00 01 00 00 00 94 1E 00 00 96 1E 00 00' + '02 00 00 00 68 00 00 00 31 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 97 1E 00 00 02 00 00 00' + '74 00 00 00 08 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 98 1E 00 00 02 00 00 00 77 00 00 00' + '0A 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 99 1E 00 00 02 00 00 00 79 00 00 00 0A 03 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 9A 1E 00 00 02 00 00 00 61 00 00 00 BE 02 00 00 00 00 00 00' + '00 00 00 00 00 00 00 00 9B 1E 00 00 01 00 00 00 61 1E 00 00 00 00 00 00 01 00 00 00 60 1E 00 00' + '01 00 00 00 60 1E 00 00 A0 1E 00 00 00 00 00 00 01 00 00 00 A1 1E 00 00 00 00 00 00 00 00 00 00' + 'A1 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A0 1E 00 00 01 00 00 00 A0 1E 00 00 A2 1E 00 00' + '00 00 00 00 01 00 00 00 A3 1E 00 00 00 00 00 00 00 00 00 00 A3 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 A2 1E 00 00 01 00 00 00 A2 1E 00 00 A4 1E 00 00 00 00 00 00 01 00 00 00 A5 1E 00 00' + '00 00 00 00 00 00 00 00 A5 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 A4 1E 00 00 01 00 00 00' + 'A4 1E 00 00 A6 1E 00 00 00 00 00 00 01 00 00 00 A7 1E 00 00 00 00 00 00 00 00 00 00 A7 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 A6 1E 00 00 01 00 00 00 A6 1E 00 00 A8 1E 00 00 00 00 00 00' + '01 00 00 00 A9 1E 00 00 00 00 00 00 00 00 00 00 A9 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'A8 1E 00 00 01 00 00 00 A8 1E 00 00 AA 1E 00 00 00 00 00 00 01 00 00 00 AB 1E 00 00 00 00 00 00' + '00 00 00 00 AB 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 AA 1E 00 00 01 00 00 00 AA 1E 00 00' + 'AC 1E 00 00 00 00 00 00 01 00 00 00 AD 1E 00 00 00 00 00 00 00 00 00 00 AD 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 AC 1E 00 00 01 00 00 00 AC 1E 00 00 AE 1E 00 00 00 00 00 00 01 00 00 00' + 'AF 1E 00 00 00 00 00 00 00 00 00 00 AF 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 AE 1E 00 00' + '01 00 00 00 AE 1E 00 00 B0 1E 00 00 00 00 00 00 01 00 00 00 B1 1E 00 00 00 00 00 00 00 00 00 00' + 'B1 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B0 1E 00 00 01 00 00 00 B0 1E 00 00 B2 1E 00 00' + '00 00 00 00 01 00 00 00 B3 1E 00 00 00 00 00 00 00 00 00 00 B3 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 B2 1E 00 00 01 00 00 00 B2 1E 00 00 B4 1E 00 00 00 00 00 00 01 00 00 00 B5 1E 00 00' + '00 00 00 00 00 00 00 00 B5 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B4 1E 00 00 01 00 00 00' + 'B4 1E 00 00 B6 1E 00 00 00 00 00 00 01 00 00 00 B7 1E 00 00 00 00 00 00 00 00 00 00 B7 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 B6 1E 00 00 01 00 00 00 B6 1E 00 00 B8 1E 00 00 00 00 00 00' + '01 00 00 00 B9 1E 00 00 00 00 00 00 00 00 00 00 B9 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'B8 1E 00 00 01 00 00 00 B8 1E 00 00 BA 1E 00 00 00 00 00 00 01 00 00 00 BB 1E 00 00 00 00 00 00' + '00 00 00 00 BB 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BA 1E 00 00 01 00 00 00 BA 1E 00 00' + 'BC 1E 00 00 00 00 00 00 01 00 00 00 BD 1E 00 00 00 00 00 00 00 00 00 00 BD 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 BC 1E 00 00 01 00 00 00 BC 1E 00 00 BE 1E 00 00 00 00 00 00 01 00 00 00' + 'BF 1E 00 00 00 00 00 00 00 00 00 00 BF 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BE 1E 00 00' + '01 00 00 00 BE 1E 00 00 C0 1E 00 00 00 00 00 00 01 00 00 00 C1 1E 00 00 00 00 00 00 00 00 00 00' + 'C1 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C0 1E 00 00 01 00 00 00 C0 1E 00 00 C2 1E 00 00' + '00 00 00 00 01 00 00 00 C3 1E 00 00 00 00 00 00 00 00 00 00 C3 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 C2 1E 00 00 01 00 00 00 C2 1E 00 00 C4 1E 00 00 00 00 00 00 01 00 00 00 C5 1E 00 00' + '00 00 00 00 00 00 00 00 C5 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C4 1E 00 00 01 00 00 00' + 'C4 1E 00 00 C6 1E 00 00 00 00 00 00 01 00 00 00 C7 1E 00 00 00 00 00 00 00 00 00 00 C7 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 C6 1E 00 00 01 00 00 00 C6 1E 00 00 C8 1E 00 00 00 00 00 00' + '01 00 00 00 C9 1E 00 00 00 00 00 00 00 00 00 00 C9 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'C8 1E 00 00 01 00 00 00 C8 1E 00 00 CA 1E 00 00 00 00 00 00 01 00 00 00 CB 1E 00 00 00 00 00 00' + '00 00 00 00 CB 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CA 1E 00 00 01 00 00 00 CA 1E 00 00' + 'CC 1E 00 00 00 00 00 00 01 00 00 00 CD 1E 00 00 00 00 00 00 00 00 00 00 CD 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 CC 1E 00 00 01 00 00 00 CC 1E 00 00 CE 1E 00 00 00 00 00 00 01 00 00 00' + 'CF 1E 00 00 00 00 00 00 00 00 00 00 CF 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CE 1E 00 00' + '01 00 00 00 CE 1E 00 00 D0 1E 00 00 00 00 00 00 01 00 00 00 D1 1E 00 00 00 00 00 00 00 00 00 00' + 'D1 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D0 1E 00 00 01 00 00 00 D0 1E 00 00 D2 1E 00 00' + '00 00 00 00 01 00 00 00 D3 1E 00 00 00 00 00 00 00 00 00 00 D3 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 D2 1E 00 00 01 00 00 00 D2 1E 00 00 D4 1E 00 00 00 00 00 00 01 00 00 00 D5 1E 00 00' + '00 00 00 00 00 00 00 00 D5 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 D4 1E 00 00 01 00 00 00' + 'D4 1E 00 00 D6 1E 00 00 00 00 00 00 01 00 00 00 D7 1E 00 00 00 00 00 00 00 00 00 00 D7 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 D6 1E 00 00 01 00 00 00 D6 1E 00 00 D8 1E 00 00 00 00 00 00' + '01 00 00 00 D9 1E 00 00 00 00 00 00 00 00 00 00 D9 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'D8 1E 00 00 01 00 00 00 D8 1E 00 00 DA 1E 00 00 00 00 00 00 01 00 00 00 DB 1E 00 00 00 00 00 00' + '00 00 00 00 DB 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DA 1E 00 00 01 00 00 00 DA 1E 00 00' + 'DC 1E 00 00 00 00 00 00 01 00 00 00 DD 1E 00 00 00 00 00 00 00 00 00 00 DD 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 DC 1E 00 00 01 00 00 00 DC 1E 00 00 DE 1E 00 00 00 00 00 00 01 00 00 00' + 'DF 1E 00 00 00 00 00 00 00 00 00 00 DF 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DE 1E 00 00' + '01 00 00 00 DE 1E 00 00 E0 1E 00 00 00 00 00 00 01 00 00 00 E1 1E 00 00 00 00 00 00 00 00 00 00' + 'E1 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E0 1E 00 00 01 00 00 00 E0 1E 00 00 E2 1E 00 00' + '00 00 00 00 01 00 00 00 E3 1E 00 00 00 00 00 00 00 00 00 00 E3 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 E2 1E 00 00 01 00 00 00 E2 1E 00 00 E4 1E 00 00 00 00 00 00 01 00 00 00 E5 1E 00 00' + '00 00 00 00 00 00 00 00 E5 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E4 1E 00 00 01 00 00 00' + 'E4 1E 00 00 E6 1E 00 00 00 00 00 00 01 00 00 00 E7 1E 00 00 00 00 00 00 00 00 00 00 E7 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 E6 1E 00 00 01 00 00 00 E6 1E 00 00 E8 1E 00 00 00 00 00 00' + '01 00 00 00 E9 1E 00 00 00 00 00 00 00 00 00 00 E9 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'E8 1E 00 00 01 00 00 00 E8 1E 00 00 EA 1E 00 00 00 00 00 00 01 00 00 00 EB 1E 00 00 00 00 00 00' + '00 00 00 00 EB 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EA 1E 00 00 01 00 00 00 EA 1E 00 00' + 'EC 1E 00 00 00 00 00 00 01 00 00 00 ED 1E 00 00 00 00 00 00 00 00 00 00 ED 1E 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 EC 1E 00 00 01 00 00 00 EC 1E 00 00 EE 1E 00 00 00 00 00 00 01 00 00 00' + 'EF 1E 00 00 00 00 00 00 00 00 00 00 EF 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EE 1E 00 00' + '01 00 00 00 EE 1E 00 00 F0 1E 00 00 00 00 00 00 01 00 00 00 F1 1E 00 00 00 00 00 00 00 00 00 00' + 'F1 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 F0 1E 00 00 01 00 00 00 F0 1E 00 00 F2 1E 00 00' + '00 00 00 00 01 00 00 00 F3 1E 00 00 00 00 00 00 00 00 00 00 F3 1E 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 F2 1E 00 00 01 00 00 00 F2 1E 00 00 F4 1E 00 00 00 00 00 00 01 00 00 00 F5 1E 00 00' + '00 00 00 00 00 00 00 00 F5 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00 F4 1E 00 00 01 00 00 00' + 'F4 1E 00 00 F6 1E 00 00 00 00 00 00 01 00 00 00 F7 1E 00 00 00 00 00 00 00 00 00 00 F7 1E 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 F6 1E 00 00 01 00 00 00 F6 1E 00 00 F8 1E 00 00 00 00 00 00' + '01 00 00 00 F9 1E 00 00 00 00 00 00 00 00 00 00 F9 1E 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'F8 1E 00 00 01 00 00 00 F8 1E 00 00 00 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 08 1F 00 00' + '01 00 00 00 08 1F 00 00 01 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 09 1F 00 00 01 00 00 00' + '09 1F 00 00 02 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 0A 1F 00 00 01 00 00 00 0A 1F 00 00' + '03 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 0B 1F 00 00 01 00 00 00 0B 1F 00 00 04 1F 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 0C 1F 00 00 01 00 00 00 0C 1F 00 00 05 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 0D 1F 00 00 01 00 00 00 0D 1F 00 00 06 1F 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 0E 1F 00 00 01 00 00 00 0E 1F 00 00 07 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '0F 1F 00 00 01 00 00 00 0F 1F 00 00 08 1F 00 00 00 00 00 00 01 00 00 00 00 1F 00 00 00 00 00 00' + '00 00 00 00 09 1F 00 00 00 00 00 00 01 00 00 00 01 1F 00 00 00 00 00 00 00 00 00 00 0A 1F 00 00' + '00 00 00 00 01 00 00 00 02 1F 00 00 00 00 00 00 00 00 00 00 0B 1F 00 00 00 00 00 00 01 00 00 00' + '03 1F 00 00 00 00 00 00 00 00 00 00 0C 1F 00 00 00 00 00 00 01 00 00 00 04 1F 00 00 00 00 00 00' + '00 00 00 00 0D 1F 00 00 00 00 00 00 01 00 00 00 05 1F 00 00 00 00 00 00 00 00 00 00 0E 1F 00 00' + '00 00 00 00 01 00 00 00 06 1F 00 00 00 00 00 00 00 00 00 00 0F 1F 00 00 00 00 00 00 01 00 00 00' + '07 1F 00 00 00 00 00 00 00 00 00 00 10 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 18 1F 00 00' + '01 00 00 00 18 1F 00 00 11 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 19 1F 00 00 01 00 00 00' + '19 1F 00 00 12 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 1A 1F 00 00 01 00 00 00 1A 1F 00 00' + '13 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 1B 1F 00 00 01 00 00 00 1B 1F 00 00 14 1F 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 1C 1F 00 00 01 00 00 00 1C 1F 00 00 15 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 1D 1F 00 00 01 00 00 00 1D 1F 00 00 18 1F 00 00 00 00 00 00 01 00 00 00' + '10 1F 00 00 00 00 00 00 00 00 00 00 19 1F 00 00 00 00 00 00 01 00 00 00 11 1F 00 00 00 00 00 00' + '00 00 00 00 1A 1F 00 00 00 00 00 00 01 00 00 00 12 1F 00 00 00 00 00 00 00 00 00 00 1B 1F 00 00' + '00 00 00 00 01 00 00 00 13 1F 00 00 00 00 00 00 00 00 00 00 1C 1F 00 00 00 00 00 00 01 00 00 00' + '14 1F 00 00 00 00 00 00 00 00 00 00 1D 1F 00 00 00 00 00 00 01 00 00 00 15 1F 00 00 00 00 00 00' + '00 00 00 00 20 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 28 1F 00 00 01 00 00 00 28 1F 00 00' + '21 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 29 1F 00 00 01 00 00 00 29 1F 00 00 22 1F 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 2A 1F 00 00 01 00 00 00 2A 1F 00 00 23 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 2B 1F 00 00 01 00 00 00 2B 1F 00 00 24 1F 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 2C 1F 00 00 01 00 00 00 2C 1F 00 00 25 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '2D 1F 00 00 01 00 00 00 2D 1F 00 00 26 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2E 1F 00 00' + '01 00 00 00 2E 1F 00 00 27 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2F 1F 00 00 01 00 00 00' + '2F 1F 00 00 28 1F 00 00 00 00 00 00 01 00 00 00 20 1F 00 00 00 00 00 00 00 00 00 00 29 1F 00 00' + '00 00 00 00 01 00 00 00 21 1F 00 00 00 00 00 00 00 00 00 00 2A 1F 00 00 00 00 00 00 01 00 00 00' + '22 1F 00 00 00 00 00 00 00 00 00 00 2B 1F 00 00 00 00 00 00 01 00 00 00 23 1F 00 00 00 00 00 00' + '00 00 00 00 2C 1F 00 00 00 00 00 00 01 00 00 00 24 1F 00 00 00 00 00 00 00 00 00 00 2D 1F 00 00' + '00 00 00 00 01 00 00 00 25 1F 00 00 00 00 00 00 00 00 00 00 2E 1F 00 00 00 00 00 00 01 00 00 00' + '26 1F 00 00 00 00 00 00 00 00 00 00 2F 1F 00 00 00 00 00 00 01 00 00 00 27 1F 00 00 00 00 00 00' + '00 00 00 00 30 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 38 1F 00 00 01 00 00 00 38 1F 00 00' + '31 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 39 1F 00 00 01 00 00 00 39 1F 00 00 32 1F 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 3A 1F 00 00 01 00 00 00 3A 1F 00 00 33 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 3B 1F 00 00 01 00 00 00 3B 1F 00 00 34 1F 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 3C 1F 00 00 01 00 00 00 3C 1F 00 00 35 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '3D 1F 00 00 01 00 00 00 3D 1F 00 00 36 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 3E 1F 00 00' + '01 00 00 00 3E 1F 00 00 37 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 3F 1F 00 00 01 00 00 00' + '3F 1F 00 00 38 1F 00 00 00 00 00 00 01 00 00 00 30 1F 00 00 00 00 00 00 00 00 00 00 39 1F 00 00' + '00 00 00 00 01 00 00 00 31 1F 00 00 00 00 00 00 00 00 00 00 3A 1F 00 00 00 00 00 00 01 00 00 00' + '32 1F 00 00 00 00 00 00 00 00 00 00 3B 1F 00 00 00 00 00 00 01 00 00 00 33 1F 00 00 00 00 00 00' + '00 00 00 00 3C 1F 00 00 00 00 00 00 01 00 00 00 34 1F 00 00 00 00 00 00 00 00 00 00 3D 1F 00 00' + '00 00 00 00 01 00 00 00 35 1F 00 00 00 00 00 00 00 00 00 00 3E 1F 00 00 00 00 00 00 01 00 00 00' + '36 1F 00 00 00 00 00 00 00 00 00 00 3F 1F 00 00 00 00 00 00 01 00 00 00 37 1F 00 00 00 00 00 00' + '00 00 00 00 40 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 48 1F 00 00 01 00 00 00 48 1F 00 00' + '41 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 49 1F 00 00 01 00 00 00 49 1F 00 00 42 1F 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 4A 1F 00 00 01 00 00 00 4A 1F 00 00 43 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 4B 1F 00 00 01 00 00 00 4B 1F 00 00 44 1F 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 4C 1F 00 00 01 00 00 00 4C 1F 00 00 45 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '4D 1F 00 00 01 00 00 00 4D 1F 00 00 48 1F 00 00 00 00 00 00 01 00 00 00 40 1F 00 00 00 00 00 00' + '00 00 00 00 49 1F 00 00 00 00 00 00 01 00 00 00 41 1F 00 00 00 00 00 00 00 00 00 00 4A 1F 00 00' + '00 00 00 00 01 00 00 00 42 1F 00 00 00 00 00 00 00 00 00 00 4B 1F 00 00 00 00 00 00 01 00 00 00' + '43 1F 00 00 00 00 00 00 00 00 00 00 4C 1F 00 00 00 00 00 00 01 00 00 00 44 1F 00 00 00 00 00 00' + '00 00 00 00 4D 1F 00 00 00 00 00 00 01 00 00 00 45 1F 00 00 00 00 00 00 00 00 00 00 50 1F 00 00' + '02 00 00 00 C5 03 00 00 13 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 51 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 59 1F 00 00 01 00 00 00 59 1F 00 00 52 1F 00 00 03 00 00 00 C5 03 00 00' + '13 03 00 00 00 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 53 1F 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 5B 1F 00 00 01 00 00 00 5B 1F 00 00 54 1F 00 00 03 00 00 00 C5 03 00 00 13 03 00 00' + '01 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 55 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '5D 1F 00 00 01 00 00 00 5D 1F 00 00 56 1F 00 00 03 00 00 00 C5 03 00 00 13 03 00 00 42 03 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 57 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 5F 1F 00 00' + '01 00 00 00 5F 1F 00 00 59 1F 00 00 00 00 00 00 01 00 00 00 51 1F 00 00 00 00 00 00 00 00 00 00' + '5B 1F 00 00 00 00 00 00 01 00 00 00 53 1F 00 00 00 00 00 00 00 00 00 00 5D 1F 00 00 00 00 00 00' + '01 00 00 00 55 1F 00 00 00 00 00 00 00 00 00 00 5F 1F 00 00 00 00 00 00 01 00 00 00 57 1F 00 00' + '00 00 00 00 00 00 00 00 60 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 68 1F 00 00 01 00 00 00' + '68 1F 00 00 61 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 69 1F 00 00 01 00 00 00 69 1F 00 00' + '62 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6A 1F 00 00 01 00 00 00 6A 1F 00 00 63 1F 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 6B 1F 00 00 01 00 00 00 6B 1F 00 00 64 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 6C 1F 00 00 01 00 00 00 6C 1F 00 00 65 1F 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 6D 1F 00 00 01 00 00 00 6D 1F 00 00 66 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '6E 1F 00 00 01 00 00 00 6E 1F 00 00 67 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6F 1F 00 00' + '01 00 00 00 6F 1F 00 00 68 1F 00 00 00 00 00 00 01 00 00 00 60 1F 00 00 00 00 00 00 00 00 00 00' + '69 1F 00 00 00 00 00 00 01 00 00 00 61 1F 00 00 00 00 00 00 00 00 00 00 6A 1F 00 00 00 00 00 00' + '01 00 00 00 62 1F 00 00 00 00 00 00 00 00 00 00 6B 1F 00 00 00 00 00 00 01 00 00 00 63 1F 00 00' + '00 00 00 00 00 00 00 00 6C 1F 00 00 00 00 00 00 01 00 00 00 64 1F 00 00 00 00 00 00 00 00 00 00' + '6D 1F 00 00 00 00 00 00 01 00 00 00 65 1F 00 00 00 00 00 00 00 00 00 00 6E 1F 00 00 00 00 00 00' + '01 00 00 00 66 1F 00 00 00 00 00 00 00 00 00 00 6F 1F 00 00 00 00 00 00 01 00 00 00 67 1F 00 00' + '00 00 00 00 00 00 00 00 70 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BA 1F 00 00 01 00 00 00' + 'BA 1F 00 00 71 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BB 1F 00 00 01 00 00 00 BB 1F 00 00' + '72 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C8 1F 00 00 01 00 00 00 C8 1F 00 00 73 1F 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 C9 1F 00 00 01 00 00 00 C9 1F 00 00 74 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 CA 1F 00 00 01 00 00 00 CA 1F 00 00 75 1F 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 CB 1F 00 00 01 00 00 00 CB 1F 00 00 76 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'DA 1F 00 00 01 00 00 00 DA 1F 00 00 77 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 DB 1F 00 00' + '01 00 00 00 DB 1F 00 00 78 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 F8 1F 00 00 01 00 00 00' + 'F8 1F 00 00 79 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 F9 1F 00 00 01 00 00 00 F9 1F 00 00' + '7A 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EA 1F 00 00 01 00 00 00 EA 1F 00 00 7B 1F 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 EB 1F 00 00 01 00 00 00 EB 1F 00 00 7C 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 FA 1F 00 00 01 00 00 00 FA 1F 00 00 7D 1F 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 FB 1F 00 00 01 00 00 00 FB 1F 00 00 80 1F 00 00 02 00 00 00 00 1F 00 00 B9 03 00 00' + '00 00 00 00 01 00 00 00 88 1F 00 00 01 00 00 00 88 1F 00 00 81 1F 00 00 02 00 00 00 01 1F 00 00' + 'B9 03 00 00 00 00 00 00 01 00 00 00 89 1F 00 00 01 00 00 00 89 1F 00 00 82 1F 00 00 02 00 00 00' + '02 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 8A 1F 00 00 01 00 00 00 8A 1F 00 00 83 1F 00 00' + '02 00 00 00 03 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 8B 1F 00 00 01 00 00 00 8B 1F 00 00' + '84 1F 00 00 02 00 00 00 04 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 8C 1F 00 00 01 00 00 00' + '8C 1F 00 00 85 1F 00 00 02 00 00 00 05 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 8D 1F 00 00' + '01 00 00 00 8D 1F 00 00 86 1F 00 00 02 00 00 00 06 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00' + '8E 1F 00 00 01 00 00 00 8E 1F 00 00 87 1F 00 00 02 00 00 00 07 1F 00 00 B9 03 00 00 00 00 00 00' + '01 00 00 00 8F 1F 00 00 01 00 00 00 8F 1F 00 00 88 1F 00 00 02 00 00 00 00 1F 00 00 B9 03 00 00' + '01 00 00 00 80 1F 00 00 00 00 00 00 00 00 00 00 89 1F 00 00 02 00 00 00 01 1F 00 00 B9 03 00 00' + '01 00 00 00 81 1F 00 00 00 00 00 00 00 00 00 00 8A 1F 00 00 02 00 00 00 02 1F 00 00 B9 03 00 00' + '01 00 00 00 82 1F 00 00 00 00 00 00 00 00 00 00 8B 1F 00 00 02 00 00 00 03 1F 00 00 B9 03 00 00' + '01 00 00 00 83 1F 00 00 00 00 00 00 00 00 00 00 8C 1F 00 00 02 00 00 00 04 1F 00 00 B9 03 00 00' + '01 00 00 00 84 1F 00 00 00 00 00 00 00 00 00 00 8D 1F 00 00 02 00 00 00 05 1F 00 00 B9 03 00 00' + '01 00 00 00 85 1F 00 00 00 00 00 00 00 00 00 00 8E 1F 00 00 02 00 00 00 06 1F 00 00 B9 03 00 00' + '01 00 00 00 86 1F 00 00 00 00 00 00 00 00 00 00 8F 1F 00 00 02 00 00 00 07 1F 00 00 B9 03 00 00' + '01 00 00 00 87 1F 00 00 00 00 00 00 00 00 00 00 90 1F 00 00 02 00 00 00 20 1F 00 00 B9 03 00 00' + '00 00 00 00 01 00 00 00 98 1F 00 00 01 00 00 00 98 1F 00 00 91 1F 00 00 02 00 00 00 21 1F 00 00' + 'B9 03 00 00 00 00 00 00 01 00 00 00 99 1F 00 00 01 00 00 00 99 1F 00 00 92 1F 00 00 02 00 00 00' + '22 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 9A 1F 00 00 01 00 00 00 9A 1F 00 00 93 1F 00 00' + '02 00 00 00 23 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 9B 1F 00 00 01 00 00 00 9B 1F 00 00' + '94 1F 00 00 02 00 00 00 24 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 9C 1F 00 00 01 00 00 00' + '9C 1F 00 00 95 1F 00 00 02 00 00 00 25 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 9D 1F 00 00' + '01 00 00 00 9D 1F 00 00 96 1F 00 00 02 00 00 00 26 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00' + '9E 1F 00 00 01 00 00 00 9E 1F 00 00 97 1F 00 00 02 00 00 00 27 1F 00 00 B9 03 00 00 00 00 00 00' + '01 00 00 00 9F 1F 00 00 01 00 00 00 9F 1F 00 00 98 1F 00 00 02 00 00 00 20 1F 00 00 B9 03 00 00' + '01 00 00 00 90 1F 00 00 00 00 00 00 00 00 00 00 99 1F 00 00 02 00 00 00 21 1F 00 00 B9 03 00 00' + '01 00 00 00 91 1F 00 00 00 00 00 00 00 00 00 00 9A 1F 00 00 02 00 00 00 22 1F 00 00 B9 03 00 00' + '01 00 00 00 92 1F 00 00 00 00 00 00 00 00 00 00 9B 1F 00 00 02 00 00 00 23 1F 00 00 B9 03 00 00' + '01 00 00 00 93 1F 00 00 00 00 00 00 00 00 00 00 9C 1F 00 00 02 00 00 00 24 1F 00 00 B9 03 00 00' + '01 00 00 00 94 1F 00 00 00 00 00 00 00 00 00 00 9D 1F 00 00 02 00 00 00 25 1F 00 00 B9 03 00 00' + '01 00 00 00 95 1F 00 00 00 00 00 00 00 00 00 00 9E 1F 00 00 02 00 00 00 26 1F 00 00 B9 03 00 00' + '01 00 00 00 96 1F 00 00 00 00 00 00 00 00 00 00 9F 1F 00 00 02 00 00 00 27 1F 00 00 B9 03 00 00' + '01 00 00 00 97 1F 00 00 00 00 00 00 00 00 00 00 A0 1F 00 00 02 00 00 00 60 1F 00 00 B9 03 00 00' + '00 00 00 00 01 00 00 00 A8 1F 00 00 01 00 00 00 A8 1F 00 00 A1 1F 00 00 02 00 00 00 61 1F 00 00' + 'B9 03 00 00 00 00 00 00 01 00 00 00 A9 1F 00 00 01 00 00 00 A9 1F 00 00 A2 1F 00 00 02 00 00 00' + '62 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 AA 1F 00 00 01 00 00 00 AA 1F 00 00 A3 1F 00 00' + '02 00 00 00 63 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 AB 1F 00 00 01 00 00 00 AB 1F 00 00' + 'A4 1F 00 00 02 00 00 00 64 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 AC 1F 00 00 01 00 00 00' + 'AC 1F 00 00 A5 1F 00 00 02 00 00 00 65 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 AD 1F 00 00' + '01 00 00 00 AD 1F 00 00 A6 1F 00 00 02 00 00 00 66 1F 00 00 B9 03 00 00 00 00 00 00 01 00 00 00' + 'AE 1F 00 00 01 00 00 00 AE 1F 00 00 A7 1F 00 00 02 00 00 00 67 1F 00 00 B9 03 00 00 00 00 00 00' + '01 00 00 00 AF 1F 00 00 01 00 00 00 AF 1F 00 00 A8 1F 00 00 02 00 00 00 60 1F 00 00 B9 03 00 00' + '01 00 00 00 A0 1F 00 00 00 00 00 00 00 00 00 00 A9 1F 00 00 02 00 00 00 61 1F 00 00 B9 03 00 00' + '01 00 00 00 A1 1F 00 00 00 00 00 00 00 00 00 00 AA 1F 00 00 02 00 00 00 62 1F 00 00 B9 03 00 00' + '01 00 00 00 A2 1F 00 00 00 00 00 00 00 00 00 00 AB 1F 00 00 02 00 00 00 63 1F 00 00 B9 03 00 00' + '01 00 00 00 A3 1F 00 00 00 00 00 00 00 00 00 00 AC 1F 00 00 02 00 00 00 64 1F 00 00 B9 03 00 00' + '01 00 00 00 A4 1F 00 00 00 00 00 00 00 00 00 00 AD 1F 00 00 02 00 00 00 65 1F 00 00 B9 03 00 00' + '01 00 00 00 A5 1F 00 00 00 00 00 00 00 00 00 00 AE 1F 00 00 02 00 00 00 66 1F 00 00 B9 03 00 00' + '01 00 00 00 A6 1F 00 00 00 00 00 00 00 00 00 00 AF 1F 00 00 02 00 00 00 67 1F 00 00 B9 03 00 00' + '01 00 00 00 A7 1F 00 00 00 00 00 00 00 00 00 00 B0 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'B8 1F 00 00 01 00 00 00 B8 1F 00 00 B1 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B9 1F 00 00' + '01 00 00 00 B9 1F 00 00 B2 1F 00 00 02 00 00 00 70 1F 00 00 B9 03 00 00 00 00 00 00 00 00 00 00' + '00 00 00 00 B3 1F 00 00 02 00 00 00 B1 03 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 BC 1F 00 00' + '01 00 00 00 BC 1F 00 00 B4 1F 00 00 02 00 00 00 AC 03 00 00 B9 03 00 00 00 00 00 00 00 00 00 00' + '00 00 00 00 B6 1F 00 00 02 00 00 00 B1 03 00 00 42 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00' + 'B7 1F 00 00 03 00 00 00 B1 03 00 00 42 03 00 00 B9 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00' + 'B8 1F 00 00 00 00 00 00 01 00 00 00 B0 1F 00 00 00 00 00 00 00 00 00 00 B9 1F 00 00 00 00 00 00' + '01 00 00 00 B1 1F 00 00 00 00 00 00 00 00 00 00 BA 1F 00 00 00 00 00 00 01 00 00 00 70 1F 00 00' + '00 00 00 00 00 00 00 00 BB 1F 00 00 00 00 00 00 01 00 00 00 71 1F 00 00 00 00 00 00 00 00 00 00' + 'BC 1F 00 00 02 00 00 00 B1 03 00 00 B9 03 00 00 01 00 00 00 B3 1F 00 00 00 00 00 00 00 00 00 00' + 'BE 1F 00 00 01 00 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 99 03 00 00 01 00 00 00 99 03 00 00' + 'C2 1F 00 00 02 00 00 00 74 1F 00 00 B9 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 C3 1F 00 00' + '02 00 00 00 B7 03 00 00 B9 03 00 00 00 00 00 00 01 00 00 00 CC 1F 00 00 01 00 00 00 CC 1F 00 00' + 'C4 1F 00 00 02 00 00 00 AE 03 00 00 B9 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 C6 1F 00 00' + '02 00 00 00 B7 03 00 00 42 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 C7 1F 00 00 03 00 00 00' + 'B7 03 00 00 42 03 00 00 B9 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 C8 1F 00 00 00 00 00 00' + '01 00 00 00 72 1F 00 00 00 00 00 00 00 00 00 00 C9 1F 00 00 00 00 00 00 01 00 00 00 73 1F 00 00' + '00 00 00 00 00 00 00 00 CA 1F 00 00 00 00 00 00 01 00 00 00 74 1F 00 00 00 00 00 00 00 00 00 00' + 'CB 1F 00 00 00 00 00 00 01 00 00 00 75 1F 00 00 00 00 00 00 00 00 00 00 CC 1F 00 00 02 00 00 00' + 'B7 03 00 00 B9 03 00 00 01 00 00 00 C3 1F 00 00 00 00 00 00 00 00 00 00 D0 1F 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 D8 1F 00 00 01 00 00 00 D8 1F 00 00 D1 1F 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 D9 1F 00 00 01 00 00 00 D9 1F 00 00 D2 1F 00 00 03 00 00 00 B9 03 00 00 08 03 00 00' + '00 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 D3 1F 00 00 03 00 00 00 B9 03 00 00 08 03 00 00' + '01 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 D6 1F 00 00 02 00 00 00 B9 03 00 00 42 03 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 D7 1F 00 00 03 00 00 00 B9 03 00 00 08 03 00 00 42 03 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 D8 1F 00 00 00 00 00 00 01 00 00 00 D0 1F 00 00 00 00 00 00' + '00 00 00 00 D9 1F 00 00 00 00 00 00 01 00 00 00 D1 1F 00 00 00 00 00 00 00 00 00 00 DA 1F 00 00' + '00 00 00 00 01 00 00 00 76 1F 00 00 00 00 00 00 00 00 00 00 DB 1F 00 00 00 00 00 00 01 00 00 00' + '77 1F 00 00 00 00 00 00 00 00 00 00 E0 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E8 1F 00 00' + '01 00 00 00 E8 1F 00 00 E1 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 E9 1F 00 00 01 00 00 00' + 'E9 1F 00 00 E2 1F 00 00 03 00 00 00 C5 03 00 00 08 03 00 00 00 03 00 00 00 00 00 00 00 00 00 00' + '00 00 00 00 E3 1F 00 00 03 00 00 00 C5 03 00 00 08 03 00 00 01 03 00 00 00 00 00 00 00 00 00 00' + '00 00 00 00 E4 1F 00 00 02 00 00 00 C1 03 00 00 13 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00' + 'E5 1F 00 00 00 00 00 00 00 00 00 00 01 00 00 00 EC 1F 00 00 01 00 00 00 EC 1F 00 00 E6 1F 00 00' + '02 00 00 00 C5 03 00 00 42 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 E7 1F 00 00 03 00 00 00' + 'C5 03 00 00 08 03 00 00 42 03 00 00 00 00 00 00 00 00 00 00 00 00 00 00 E8 1F 00 00 00 00 00 00' + '01 00 00 00 E0 1F 00 00 00 00 00 00 00 00 00 00 E9 1F 00 00 00 00 00 00 01 00 00 00 E1 1F 00 00' + '00 00 00 00 00 00 00 00 EA 1F 00 00 00 00 00 00 01 00 00 00 7A 1F 00 00 00 00 00 00 00 00 00 00' + 'EB 1F 00 00 00 00 00 00 01 00 00 00 7B 1F 00 00 00 00 00 00 00 00 00 00 EC 1F 00 00 00 00 00 00' + '01 00 00 00 E5 1F 00 00 00 00 00 00 00 00 00 00 F2 1F 00 00 02 00 00 00 7C 1F 00 00 B9 03 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 F3 1F 00 00 02 00 00 00 C9 03 00 00 B9 03 00 00 00 00 00 00' + '01 00 00 00 FC 1F 00 00 01 00 00 00 FC 1F 00 00 F4 1F 00 00 02 00 00 00 CE 03 00 00 B9 03 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 F6 1F 00 00 02 00 00 00 C9 03 00 00 42 03 00 00 00 00 00 00' + '00 00 00 00 00 00 00 00 F7 1F 00 00 03 00 00 00 C9 03 00 00 42 03 00 00 B9 03 00 00 00 00 00 00' + '00 00 00 00 00 00 00 00 F8 1F 00 00 00 00 00 00 01 00 00 00 78 1F 00 00 00 00 00 00 00 00 00 00' + 'F9 1F 00 00 00 00 00 00 01 00 00 00 79 1F 00 00 00 00 00 00 00 00 00 00 FA 1F 00 00 00 00 00 00' + '01 00 00 00 7C 1F 00 00 00 00 00 00 00 00 00 00 FB 1F 00 00 00 00 00 00 01 00 00 00 7D 1F 00 00' + '00 00 00 00 00 00 00 00 FC 1F 00 00 02 00 00 00 C9 03 00 00 B9 03 00 00 01 00 00 00 F3 1F 00 00' + '00 00 00 00 00 00 00 00 26 21 00 00 00 00 00 00 01 00 00 00 C9 03 00 00 00 00 00 00 00 00 00 00' + '2A 21 00 00 00 00 00 00 01 00 00 00 6B 00 00 00 00 00 00 00 00 00 00 00 2B 21 00 00 00 00 00 00' + '01 00 00 00 E5 00 00 00 00 00 00 00 00 00 00 00 60 21 00 00 00 00 00 00 01 00 00 00 70 21 00 00' + '00 00 00 00 00 00 00 00 61 21 00 00 00 00 00 00 01 00 00 00 71 21 00 00 00 00 00 00 00 00 00 00' + '62 21 00 00 00 00 00 00 01 00 00 00 72 21 00 00 00 00 00 00 00 00 00 00 63 21 00 00 00 00 00 00' + '01 00 00 00 73 21 00 00 00 00 00 00 00 00 00 00 64 21 00 00 00 00 00 00 01 00 00 00 74 21 00 00' + '00 00 00 00 00 00 00 00 65 21 00 00 00 00 00 00 01 00 00 00 75 21 00 00 00 00 00 00 00 00 00 00' + '66 21 00 00 00 00 00 00 01 00 00 00 76 21 00 00 00 00 00 00 00 00 00 00 67 21 00 00 00 00 00 00' + '01 00 00 00 77 21 00 00 00 00 00 00 00 00 00 00 68 21 00 00 00 00 00 00 01 00 00 00 78 21 00 00' + '00 00 00 00 00 00 00 00 69 21 00 00 00 00 00 00 01 00 00 00 79 21 00 00 00 00 00 00 00 00 00 00' + '6A 21 00 00 00 00 00 00 01 00 00 00 7A 21 00 00 00 00 00 00 00 00 00 00 6B 21 00 00 00 00 00 00' + '01 00 00 00 7B 21 00 00 00 00 00 00 00 00 00 00 6C 21 00 00 00 00 00 00 01 00 00 00 7C 21 00 00' + '00 00 00 00 00 00 00 00 6D 21 00 00 00 00 00 00 01 00 00 00 7D 21 00 00 00 00 00 00 00 00 00 00' + '6E 21 00 00 00 00 00 00 01 00 00 00 7E 21 00 00 00 00 00 00 00 00 00 00 6F 21 00 00 00 00 00 00' + '01 00 00 00 7F 21 00 00 00 00 00 00 00 00 00 00 70 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '60 21 00 00 01 00 00 00 60 21 00 00 71 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00 61 21 00 00' + '01 00 00 00 61 21 00 00 72 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00 62 21 00 00 01 00 00 00' + '62 21 00 00 73 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00 63 21 00 00 01 00 00 00 63 21 00 00' + '74 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00 64 21 00 00 01 00 00 00 64 21 00 00 75 21 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 65 21 00 00 01 00 00 00 65 21 00 00 76 21 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 66 21 00 00 01 00 00 00 66 21 00 00 77 21 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 67 21 00 00 01 00 00 00 67 21 00 00 78 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '68 21 00 00 01 00 00 00 68 21 00 00 79 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00 69 21 00 00' + '01 00 00 00 69 21 00 00 7A 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6A 21 00 00 01 00 00 00' + '6A 21 00 00 7B 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6B 21 00 00 01 00 00 00 6B 21 00 00' + '7C 21 00 00 00 00 00 00 00 00 00 00 01 00 00 00 6C 21 00 00 01 00 00 00 6C 21 00 00 7D 21 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 6D 21 00 00 01 00 00 00 6D 21 00 00 7E 21 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 6E 21 00 00 01 00 00 00 6E 21 00 00 7F 21 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 6F 21 00 00 01 00 00 00 6F 21 00 00 B6 24 00 00 00 00 00 00 01 00 00 00 D0 24 00 00' + '00 00 00 00 00 00 00 00 B7 24 00 00 00 00 00 00 01 00 00 00 D1 24 00 00 00 00 00 00 00 00 00 00' + 'B8 24 00 00 00 00 00 00 01 00 00 00 D2 24 00 00 00 00 00 00 00 00 00 00 B9 24 00 00 00 00 00 00' + '01 00 00 00 D3 24 00 00 00 00 00 00 00 00 00 00 BA 24 00 00 00 00 00 00 01 00 00 00 D4 24 00 00' + '00 00 00 00 00 00 00 00 BB 24 00 00 00 00 00 00 01 00 00 00 D5 24 00 00 00 00 00 00 00 00 00 00' + 'BC 24 00 00 00 00 00 00 01 00 00 00 D6 24 00 00 00 00 00 00 00 00 00 00 BD 24 00 00 00 00 00 00' + '01 00 00 00 D7 24 00 00 00 00 00 00 00 00 00 00 BE 24 00 00 00 00 00 00 01 00 00 00 D8 24 00 00' + '00 00 00 00 00 00 00 00 BF 24 00 00 00 00 00 00 01 00 00 00 D9 24 00 00 00 00 00 00 00 00 00 00' + 'C0 24 00 00 00 00 00 00 01 00 00 00 DA 24 00 00 00 00 00 00 00 00 00 00 C1 24 00 00 00 00 00 00' + '01 00 00 00 DB 24 00 00 00 00 00 00 00 00 00 00 C2 24 00 00 00 00 00 00 01 00 00 00 DC 24 00 00' + '00 00 00 00 00 00 00 00 C3 24 00 00 00 00 00 00 01 00 00 00 DD 24 00 00 00 00 00 00 00 00 00 00' + 'C4 24 00 00 00 00 00 00 01 00 00 00 DE 24 00 00 00 00 00 00 00 00 00 00 C5 24 00 00 00 00 00 00' + '01 00 00 00 DF 24 00 00 00 00 00 00 00 00 00 00 C6 24 00 00 00 00 00 00 01 00 00 00 E0 24 00 00' + '00 00 00 00 00 00 00 00 C7 24 00 00 00 00 00 00 01 00 00 00 E1 24 00 00 00 00 00 00 00 00 00 00' + 'C8 24 00 00 00 00 00 00 01 00 00 00 E2 24 00 00 00 00 00 00 00 00 00 00 C9 24 00 00 00 00 00 00' + '01 00 00 00 E3 24 00 00 00 00 00 00 00 00 00 00 CA 24 00 00 00 00 00 00 01 00 00 00 E4 24 00 00' + '00 00 00 00 00 00 00 00 CB 24 00 00 00 00 00 00 01 00 00 00 E5 24 00 00 00 00 00 00 00 00 00 00' + 'CC 24 00 00 00 00 00 00 01 00 00 00 E6 24 00 00 00 00 00 00 00 00 00 00 CD 24 00 00 00 00 00 00' + '01 00 00 00 E7 24 00 00 00 00 00 00 00 00 00 00 CE 24 00 00 00 00 00 00 01 00 00 00 E8 24 00 00' + '00 00 00 00 00 00 00 00 CF 24 00 00 00 00 00 00 01 00 00 00 E9 24 00 00 00 00 00 00 00 00 00 00' + 'D0 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 B6 24 00 00 01 00 00 00 B6 24 00 00 D1 24 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 B7 24 00 00 01 00 00 00 B7 24 00 00 D2 24 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 B8 24 00 00 01 00 00 00 B8 24 00 00 D3 24 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 B9 24 00 00 01 00 00 00 B9 24 00 00 D4 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'BA 24 00 00 01 00 00 00 BA 24 00 00 D5 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BB 24 00 00' + '01 00 00 00 BB 24 00 00 D6 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BC 24 00 00 01 00 00 00' + 'BC 24 00 00 D7 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BD 24 00 00 01 00 00 00 BD 24 00 00' + 'D8 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 BE 24 00 00 01 00 00 00 BE 24 00 00 D9 24 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 BF 24 00 00 01 00 00 00 BF 24 00 00 DA 24 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 C0 24 00 00 01 00 00 00 C0 24 00 00 DB 24 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 C1 24 00 00 01 00 00 00 C1 24 00 00 DC 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'C2 24 00 00 01 00 00 00 C2 24 00 00 DD 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C3 24 00 00' + '01 00 00 00 C3 24 00 00 DE 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C4 24 00 00 01 00 00 00' + 'C4 24 00 00 DF 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C5 24 00 00 01 00 00 00 C5 24 00 00' + 'E0 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 C6 24 00 00 01 00 00 00 C6 24 00 00 E1 24 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 C7 24 00 00 01 00 00 00 C7 24 00 00 E2 24 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 C8 24 00 00 01 00 00 00 C8 24 00 00 E3 24 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 C9 24 00 00 01 00 00 00 C9 24 00 00 E4 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + 'CA 24 00 00 01 00 00 00 CA 24 00 00 E5 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CB 24 00 00' + '01 00 00 00 CB 24 00 00 E6 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CC 24 00 00 01 00 00 00' + 'CC 24 00 00 E7 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CD 24 00 00 01 00 00 00 CD 24 00 00' + 'E8 24 00 00 00 00 00 00 00 00 00 00 01 00 00 00 CE 24 00 00 01 00 00 00 CE 24 00 00 E9 24 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 CF 24 00 00 01 00 00 00 CF 24 00 00 00 FB 00 00 02 00 00 00' + '66 00 00 00 66 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 01 FB 00 00 02 00 00 00 66 00 00 00' + '69 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 02 FB 00 00 02 00 00 00 66 00 00 00 6C 00 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 03 FB 00 00 03 00 00 00 66 00 00 00 66 00 00 00 69 00 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 04 FB 00 00 03 00 00 00 66 00 00 00 66 00 00 00 6C 00 00 00' + '00 00 00 00 00 00 00 00 00 00 00 00 05 FB 00 00 02 00 00 00 73 00 00 00 74 00 00 00 00 00 00 00' + '00 00 00 00 00 00 00 00 06 FB 00 00 02 00 00 00 73 00 00 00 74 00 00 00 00 00 00 00 00 00 00 00' + '00 00 00 00 13 FB 00 00 02 00 00 00 74 05 00 00 76 05 00 00 00 00 00 00 00 00 00 00 00 00 00 00' + '14 FB 00 00 02 00 00 00 74 05 00 00 65 05 00 00 00 00 00 00 00 00 00 00 00 00 00 00 15 FB 00 00' + '02 00 00 00 74 05 00 00 6B 05 00 00 00 00 00 00 00 00 00 00 00 00 00 00 16 FB 00 00 02 00 00 00' + '7E 05 00 00 76 05 00 00 00 00 00 00 00 00 00 00 00 00 00 00 17 FB 00 00 02 00 00 00 74 05 00 00' + '6D 05 00 00 00 00 00 00 00 00 00 00 00 00 00 00 21 FF 00 00 00 00 00 00 01 00 00 00 41 FF 00 00' + '00 00 00 00 00 00 00 00 22 FF 00 00 00 00 00 00 01 00 00 00 42 FF 00 00 00 00 00 00 00 00 00 00' + '23 FF 00 00 00 00 00 00 01 00 00 00 43 FF 00 00 00 00 00 00 00 00 00 00 24 FF 00 00 00 00 00 00' + '01 00 00 00 44 FF 00 00 00 00 00 00 00 00 00 00 25 FF 00 00 00 00 00 00 01 00 00 00 45 FF 00 00' + '00 00 00 00 00 00 00 00 26 FF 00 00 00 00 00 00 01 00 00 00 46 FF 00 00 00 00 00 00 00 00 00 00' + '27 FF 00 00 00 00 00 00 01 00 00 00 47 FF 00 00 00 00 00 00 00 00 00 00 28 FF 00 00 00 00 00 00' + '01 00 00 00 48 FF 00 00 00 00 00 00 00 00 00 00 29 FF 00 00 00 00 00 00 01 00 00 00 49 FF 00 00' + '00 00 00 00 00 00 00 00 2A FF 00 00 00 00 00 00 01 00 00 00 4A FF 00 00 00 00 00 00 00 00 00 00' + '2B FF 00 00 00 00 00 00 01 00 00 00 4B FF 00 00 00 00 00 00 00 00 00 00 2C FF 00 00 00 00 00 00' + '01 00 00 00 4C FF 00 00 00 00 00 00 00 00 00 00 2D FF 00 00 00 00 00 00 01 00 00 00 4D FF 00 00' + '00 00 00 00 00 00 00 00 2E FF 00 00 00 00 00 00 01 00 00 00 4E FF 00 00 00 00 00 00 00 00 00 00' + '2F FF 00 00 00 00 00 00 01 00 00 00 4F FF 00 00 00 00 00 00 00 00 00 00 30 FF 00 00 00 00 00 00' + '01 00 00 00 50 FF 00 00 00 00 00 00 00 00 00 00 31 FF 00 00 00 00 00 00 01 00 00 00 51 FF 00 00' + '00 00 00 00 00 00 00 00 32 FF 00 00 00 00 00 00 01 00 00 00 52 FF 00 00 00 00 00 00 00 00 00 00' + '33 FF 00 00 00 00 00 00 01 00 00 00 53 FF 00 00 00 00 00 00 00 00 00 00 34 FF 00 00 00 00 00 00' + '01 00 00 00 54 FF 00 00 00 00 00 00 00 00 00 00 35 FF 00 00 00 00 00 00 01 00 00 00 55 FF 00 00' + '00 00 00 00 00 00 00 00 36 FF 00 00 00 00 00 00 01 00 00 00 56 FF 00 00 00 00 00 00 00 00 00 00' + '37 FF 00 00 00 00 00 00 01 00 00 00 57 FF 00 00 00 00 00 00 00 00 00 00 38 FF 00 00 00 00 00 00' + '01 00 00 00 58 FF 00 00 00 00 00 00 00 00 00 00 39 FF 00 00 00 00 00 00 01 00 00 00 59 FF 00 00' + '00 00 00 00 00 00 00 00 3A FF 00 00 00 00 00 00 01 00 00 00 5A FF 00 00 00 00 00 00 00 00 00 00' + '41 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 21 FF 00 00 01 00 00 00 21 FF 00 00 42 FF 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 22 FF 00 00 01 00 00 00 22 FF 00 00 43 FF 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 23 FF 00 00 01 00 00 00 23 FF 00 00 44 FF 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 24 FF 00 00 01 00 00 00 24 FF 00 00 45 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '25 FF 00 00 01 00 00 00 25 FF 00 00 46 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 26 FF 00 00' + '01 00 00 00 26 FF 00 00 47 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 27 FF 00 00 01 00 00 00' + '27 FF 00 00 48 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 28 FF 00 00 01 00 00 00 28 FF 00 00' + '49 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 29 FF 00 00 01 00 00 00 29 FF 00 00 4A FF 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 2A FF 00 00 01 00 00 00 2A FF 00 00 4B FF 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 2B FF 00 00 01 00 00 00 2B FF 00 00 4C FF 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 2C FF 00 00 01 00 00 00 2C FF 00 00 4D FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '2D FF 00 00 01 00 00 00 2D FF 00 00 4E FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2E FF 00 00' + '01 00 00 00 2E FF 00 00 4F FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 2F FF 00 00 01 00 00 00' + '2F FF 00 00 50 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 30 FF 00 00 01 00 00 00 30 FF 00 00' + '51 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 31 FF 00 00 01 00 00 00 31 FF 00 00 52 FF 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 32 FF 00 00 01 00 00 00 32 FF 00 00 53 FF 00 00 00 00 00 00' + '00 00 00 00 01 00 00 00 33 FF 00 00 01 00 00 00 33 FF 00 00 54 FF 00 00 00 00 00 00 00 00 00 00' + '01 00 00 00 34 FF 00 00 01 00 00 00 34 FF 00 00 55 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00' + '35 FF 00 00 01 00 00 00 35 FF 00 00 56 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 36 FF 00 00' + '01 00 00 00 36 FF 00 00 57 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 37 FF 00 00 01 00 00 00' + '37 FF 00 00 58 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 38 FF 00 00 01 00 00 00 38 FF 00 00' + '59 FF 00 00 00 00 00 00 00 00 00 00 01 00 00 00 39 FF 00 00 01 00 00 00 39 FF 00 00 5A FF 00 00' + '00 00 00 00 00 00 00 00 01 00 00 00 3A FF 00 00 01 00 00 00 3A FF 00 00' +} + + +DECOMPOSITION UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + 'DC 03 00 00 C0 00 00 00 02 00 00 00 41 00 00 00 00 03 00 00 C1 00 00 00 02 00 00 00 41 00 00 00' + '01 03 00 00 C2 00 00 00 02 00 00 00 41 00 00 00 02 03 00 00 C3 00 00 00 02 00 00 00 41 00 00 00' + '03 03 00 00 C4 00 00 00 02 00 00 00 41 00 00 00 08 03 00 00 C5 00 00 00 02 00 00 00 41 00 00 00' + '0A 03 00 00 C7 00 00 00 02 00 00 00 43 00 00 00 27 03 00 00 C8 00 00 00 02 00 00 00 45 00 00 00' + '00 03 00 00 C9 00 00 00 02 00 00 00 45 00 00 00 01 03 00 00 CA 00 00 00 02 00 00 00 45 00 00 00' + '02 03 00 00 CB 00 00 00 02 00 00 00 45 00 00 00 08 03 00 00 CC 00 00 00 02 00 00 00 49 00 00 00' + '00 03 00 00 CD 00 00 00 02 00 00 00 49 00 00 00 01 03 00 00 CE 00 00 00 02 00 00 00 49 00 00 00' + '02 03 00 00 CF 00 00 00 02 00 00 00 49 00 00 00 08 03 00 00 D1 00 00 00 02 00 00 00 4E 00 00 00' + '03 03 00 00 D2 00 00 00 02 00 00 00 4F 00 00 00 00 03 00 00 D3 00 00 00 02 00 00 00 4F 00 00 00' + '01 03 00 00 D4 00 00 00 02 00 00 00 4F 00 00 00 02 03 00 00 D5 00 00 00 02 00 00 00 4F 00 00 00' + '03 03 00 00 D6 00 00 00 02 00 00 00 4F 00 00 00 08 03 00 00 D9 00 00 00 02 00 00 00 55 00 00 00' + '00 03 00 00 DA 00 00 00 02 00 00 00 55 00 00 00 01 03 00 00 DB 00 00 00 02 00 00 00 55 00 00 00' + '02 03 00 00 DC 00 00 00 02 00 00 00 55 00 00 00 08 03 00 00 DD 00 00 00 02 00 00 00 59 00 00 00' + '01 03 00 00 E0 00 00 00 02 00 00 00 61 00 00 00 00 03 00 00 E1 00 00 00 02 00 00 00 61 00 00 00' + '01 03 00 00 E2 00 00 00 02 00 00 00 61 00 00 00 02 03 00 00 E3 00 00 00 02 00 00 00 61 00 00 00' + '03 03 00 00 E4 00 00 00 02 00 00 00 61 00 00 00 08 03 00 00 E5 00 00 00 02 00 00 00 61 00 00 00' + '0A 03 00 00 E7 00 00 00 02 00 00 00 63 00 00 00 27 03 00 00 E8 00 00 00 02 00 00 00 65 00 00 00' + '00 03 00 00 E9 00 00 00 02 00 00 00 65 00 00 00 01 03 00 00 EA 00 00 00 02 00 00 00 65 00 00 00' + '02 03 00 00 EB 00 00 00 02 00 00 00 65 00 00 00 08 03 00 00 EC 00 00 00 02 00 00 00 69 00 00 00' + '00 03 00 00 ED 00 00 00 02 00 00 00 69 00 00 00 01 03 00 00 EE 00 00 00 02 00 00 00 69 00 00 00' + '02 03 00 00 EF 00 00 00 02 00 00 00 69 00 00 00 08 03 00 00 F1 00 00 00 02 00 00 00 6E 00 00 00' + '03 03 00 00 F2 00 00 00 02 00 00 00 6F 00 00 00 00 03 00 00 F3 00 00 00 02 00 00 00 6F 00 00 00' + '01 03 00 00 F4 00 00 00 02 00 00 00 6F 00 00 00 02 03 00 00 F5 00 00 00 02 00 00 00 6F 00 00 00' + '03 03 00 00 F6 00 00 00 02 00 00 00 6F 00 00 00 08 03 00 00 F9 00 00 00 02 00 00 00 75 00 00 00' + '00 03 00 00 FA 00 00 00 02 00 00 00 75 00 00 00 01 03 00 00 FB 00 00 00 02 00 00 00 75 00 00 00' + '02 03 00 00 FC 00 00 00 02 00 00 00 75 00 00 00 08 03 00 00 FD 00 00 00 02 00 00 00 79 00 00 00' + '01 03 00 00 FF 00 00 00 02 00 00 00 79 00 00 00 08 03 00 00 00 01 00 00 02 00 00 00 41 00 00 00' + '04 03 00 00 01 01 00 00 02 00 00 00 61 00 00 00 04 03 00 00 02 01 00 00 02 00 00 00 41 00 00 00' + '06 03 00 00 03 01 00 00 02 00 00 00 61 00 00 00 06 03 00 00 04 01 00 00 02 00 00 00 41 00 00 00' + '28 03 00 00 05 01 00 00 02 00 00 00 61 00 00 00 28 03 00 00 06 01 00 00 02 00 00 00 43 00 00 00' + '01 03 00 00 07 01 00 00 02 00 00 00 63 00 00 00 01 03 00 00 08 01 00 00 02 00 00 00 43 00 00 00' + '02 03 00 00 09 01 00 00 02 00 00 00 63 00 00 00 02 03 00 00 0A 01 00 00 02 00 00 00 43 00 00 00' + '07 03 00 00 0B 01 00 00 02 00 00 00 63 00 00 00 07 03 00 00 0C 01 00 00 02 00 00 00 43 00 00 00' + '0C 03 00 00 0D 01 00 00 02 00 00 00 63 00 00 00 0C 03 00 00 0E 01 00 00 02 00 00 00 44 00 00 00' + '0C 03 00 00 0F 01 00 00 02 00 00 00 64 00 00 00 0C 03 00 00 12 01 00 00 02 00 00 00 45 00 00 00' + '04 03 00 00 13 01 00 00 02 00 00 00 65 00 00 00 04 03 00 00 14 01 00 00 02 00 00 00 45 00 00 00' + '06 03 00 00 15 01 00 00 02 00 00 00 65 00 00 00 06 03 00 00 16 01 00 00 02 00 00 00 45 00 00 00' + '07 03 00 00 17 01 00 00 02 00 00 00 65 00 00 00 07 03 00 00 18 01 00 00 02 00 00 00 45 00 00 00' + '28 03 00 00 19 01 00 00 02 00 00 00 65 00 00 00 28 03 00 00 1A 01 00 00 02 00 00 00 45 00 00 00' + '0C 03 00 00 1B 01 00 00 02 00 00 00 65 00 00 00 0C 03 00 00 1C 01 00 00 02 00 00 00 47 00 00 00' + '02 03 00 00 1D 01 00 00 02 00 00 00 67 00 00 00 02 03 00 00 1E 01 00 00 02 00 00 00 47 00 00 00' + '06 03 00 00 1F 01 00 00 02 00 00 00 67 00 00 00 06 03 00 00 20 01 00 00 02 00 00 00 47 00 00 00' + '07 03 00 00 21 01 00 00 02 00 00 00 67 00 00 00 07 03 00 00 22 01 00 00 02 00 00 00 47 00 00 00' + '27 03 00 00 23 01 00 00 02 00 00 00 67 00 00 00 27 03 00 00 24 01 00 00 02 00 00 00 48 00 00 00' + '02 03 00 00 25 01 00 00 02 00 00 00 68 00 00 00 02 03 00 00 28 01 00 00 02 00 00 00 49 00 00 00' + '03 03 00 00 29 01 00 00 02 00 00 00 69 00 00 00 03 03 00 00 2A 01 00 00 02 00 00 00 49 00 00 00' + '04 03 00 00 2B 01 00 00 02 00 00 00 69 00 00 00 04 03 00 00 2C 01 00 00 02 00 00 00 49 00 00 00' + '06 03 00 00 2D 01 00 00 02 00 00 00 69 00 00 00 06 03 00 00 2E 01 00 00 02 00 00 00 49 00 00 00' + '28 03 00 00 2F 01 00 00 02 00 00 00 69 00 00 00 28 03 00 00 30 01 00 00 02 00 00 00 49 00 00 00' + '07 03 00 00 34 01 00 00 02 00 00 00 4A 00 00 00 02 03 00 00 35 01 00 00 02 00 00 00 6A 00 00 00' + '02 03 00 00 36 01 00 00 02 00 00 00 4B 00 00 00 27 03 00 00 37 01 00 00 02 00 00 00 6B 00 00 00' + '27 03 00 00 39 01 00 00 02 00 00 00 4C 00 00 00 01 03 00 00 3A 01 00 00 02 00 00 00 6C 00 00 00' + '01 03 00 00 3B 01 00 00 02 00 00 00 4C 00 00 00 27 03 00 00 3C 01 00 00 02 00 00 00 6C 00 00 00' + '27 03 00 00 3D 01 00 00 02 00 00 00 4C 00 00 00 0C 03 00 00 3E 01 00 00 02 00 00 00 6C 00 00 00' + '0C 03 00 00 43 01 00 00 02 00 00 00 4E 00 00 00 01 03 00 00 44 01 00 00 02 00 00 00 6E 00 00 00' + '01 03 00 00 45 01 00 00 02 00 00 00 4E 00 00 00 27 03 00 00 46 01 00 00 02 00 00 00 6E 00 00 00' + '27 03 00 00 47 01 00 00 02 00 00 00 4E 00 00 00 0C 03 00 00 48 01 00 00 02 00 00 00 6E 00 00 00' + '0C 03 00 00 4C 01 00 00 02 00 00 00 4F 00 00 00 04 03 00 00 4D 01 00 00 02 00 00 00 6F 00 00 00' + '04 03 00 00 4E 01 00 00 02 00 00 00 4F 00 00 00 06 03 00 00 4F 01 00 00 02 00 00 00 6F 00 00 00' + '06 03 00 00 50 01 00 00 02 00 00 00 4F 00 00 00 0B 03 00 00 51 01 00 00 02 00 00 00 6F 00 00 00' + '0B 03 00 00 54 01 00 00 02 00 00 00 52 00 00 00 01 03 00 00 55 01 00 00 02 00 00 00 72 00 00 00' + '01 03 00 00 56 01 00 00 02 00 00 00 52 00 00 00 27 03 00 00 57 01 00 00 02 00 00 00 72 00 00 00' + '27 03 00 00 58 01 00 00 02 00 00 00 52 00 00 00 0C 03 00 00 59 01 00 00 02 00 00 00 72 00 00 00' + '0C 03 00 00 5A 01 00 00 02 00 00 00 53 00 00 00 01 03 00 00 5B 01 00 00 02 00 00 00 73 00 00 00' + '01 03 00 00 5C 01 00 00 02 00 00 00 53 00 00 00 02 03 00 00 5D 01 00 00 02 00 00 00 73 00 00 00' + '02 03 00 00 5E 01 00 00 02 00 00 00 53 00 00 00 27 03 00 00 5F 01 00 00 02 00 00 00 73 00 00 00' + '27 03 00 00 60 01 00 00 02 00 00 00 53 00 00 00 0C 03 00 00 61 01 00 00 02 00 00 00 73 00 00 00' + '0C 03 00 00 62 01 00 00 02 00 00 00 54 00 00 00 27 03 00 00 63 01 00 00 02 00 00 00 74 00 00 00' + '27 03 00 00 64 01 00 00 02 00 00 00 54 00 00 00 0C 03 00 00 65 01 00 00 02 00 00 00 74 00 00 00' + '0C 03 00 00 68 01 00 00 02 00 00 00 55 00 00 00 03 03 00 00 69 01 00 00 02 00 00 00 75 00 00 00' + '03 03 00 00 6A 01 00 00 02 00 00 00 55 00 00 00 04 03 00 00 6B 01 00 00 02 00 00 00 75 00 00 00' + '04 03 00 00 6C 01 00 00 02 00 00 00 55 00 00 00 06 03 00 00 6D 01 00 00 02 00 00 00 75 00 00 00' + '06 03 00 00 6E 01 00 00 02 00 00 00 55 00 00 00 0A 03 00 00 6F 01 00 00 02 00 00 00 75 00 00 00' + '0A 03 00 00 70 01 00 00 02 00 00 00 55 00 00 00 0B 03 00 00 71 01 00 00 02 00 00 00 75 00 00 00' + '0B 03 00 00 72 01 00 00 02 00 00 00 55 00 00 00 28 03 00 00 73 01 00 00 02 00 00 00 75 00 00 00' + '28 03 00 00 74 01 00 00 02 00 00 00 57 00 00 00 02 03 00 00 75 01 00 00 02 00 00 00 77 00 00 00' + '02 03 00 00 76 01 00 00 02 00 00 00 59 00 00 00 02 03 00 00 77 01 00 00 02 00 00 00 79 00 00 00' + '02 03 00 00 78 01 00 00 02 00 00 00 59 00 00 00 08 03 00 00 79 01 00 00 02 00 00 00 5A 00 00 00' + '01 03 00 00 7A 01 00 00 02 00 00 00 7A 00 00 00 01 03 00 00 7B 01 00 00 02 00 00 00 5A 00 00 00' + '07 03 00 00 7C 01 00 00 02 00 00 00 7A 00 00 00 07 03 00 00 7D 01 00 00 02 00 00 00 5A 00 00 00' + '0C 03 00 00 7E 01 00 00 02 00 00 00 7A 00 00 00 0C 03 00 00 A0 01 00 00 02 00 00 00 4F 00 00 00' + '1B 03 00 00 A1 01 00 00 02 00 00 00 6F 00 00 00 1B 03 00 00 AF 01 00 00 02 00 00 00 55 00 00 00' + '1B 03 00 00 B0 01 00 00 02 00 00 00 75 00 00 00 1B 03 00 00 CD 01 00 00 02 00 00 00 41 00 00 00' + '0C 03 00 00 CE 01 00 00 02 00 00 00 61 00 00 00 0C 03 00 00 CF 01 00 00 02 00 00 00 49 00 00 00' + '0C 03 00 00 D0 01 00 00 02 00 00 00 69 00 00 00 0C 03 00 00 D1 01 00 00 02 00 00 00 4F 00 00 00' + '0C 03 00 00 D2 01 00 00 02 00 00 00 6F 00 00 00 0C 03 00 00 D3 01 00 00 02 00 00 00 55 00 00 00' + '0C 03 00 00 D4 01 00 00 02 00 00 00 75 00 00 00 0C 03 00 00 D5 01 00 00 03 00 00 00 55 00 00 00' + '08 03 00 00 04 03 00 00 D6 01 00 00 03 00 00 00 75 00 00 00 08 03 00 00 04 03 00 00 D7 01 00 00' + '03 00 00 00 55 00 00 00 08 03 00 00 01 03 00 00 D8 01 00 00 03 00 00 00 75 00 00 00 08 03 00 00' + '01 03 00 00 D9 01 00 00 03 00 00 00 55 00 00 00 08 03 00 00 0C 03 00 00 DA 01 00 00 03 00 00 00' + '75 00 00 00 08 03 00 00 0C 03 00 00 DB 01 00 00 03 00 00 00 55 00 00 00 08 03 00 00 00 03 00 00' + 'DC 01 00 00 03 00 00 00 75 00 00 00 08 03 00 00 00 03 00 00 DE 01 00 00 03 00 00 00 41 00 00 00' + '08 03 00 00 04 03 00 00 DF 01 00 00 03 00 00 00 61 00 00 00 08 03 00 00 04 03 00 00 E0 01 00 00' + '03 00 00 00 41 00 00 00 07 03 00 00 04 03 00 00 E1 01 00 00 03 00 00 00 61 00 00 00 07 03 00 00' + '04 03 00 00 E2 01 00 00 02 00 00 00 C6 00 00 00 04 03 00 00 E3 01 00 00 02 00 00 00 E6 00 00 00' + '04 03 00 00 E6 01 00 00 02 00 00 00 47 00 00 00 0C 03 00 00 E7 01 00 00 02 00 00 00 67 00 00 00' + '0C 03 00 00 E8 01 00 00 02 00 00 00 4B 00 00 00 0C 03 00 00 E9 01 00 00 02 00 00 00 6B 00 00 00' + '0C 03 00 00 EA 01 00 00 02 00 00 00 4F 00 00 00 28 03 00 00 EB 01 00 00 02 00 00 00 6F 00 00 00' + '28 03 00 00 EC 01 00 00 03 00 00 00 4F 00 00 00 28 03 00 00 04 03 00 00 ED 01 00 00 03 00 00 00' + '6F 00 00 00 28 03 00 00 04 03 00 00 EE 01 00 00 02 00 00 00 B7 01 00 00 0C 03 00 00 EF 01 00 00' + '02 00 00 00 92 02 00 00 0C 03 00 00 F0 01 00 00 02 00 00 00 6A 00 00 00 0C 03 00 00 F4 01 00 00' + '02 00 00 00 47 00 00 00 01 03 00 00 F5 01 00 00 02 00 00 00 67 00 00 00 01 03 00 00 F8 01 00 00' + '02 00 00 00 4E 00 00 00 00 03 00 00 F9 01 00 00 02 00 00 00 6E 00 00 00 00 03 00 00 FA 01 00 00' + '03 00 00 00 41 00 00 00 0A 03 00 00 01 03 00 00 FB 01 00 00 03 00 00 00 61 00 00 00 0A 03 00 00' + '01 03 00 00 FC 01 00 00 02 00 00 00 C6 00 00 00 01 03 00 00 FD 01 00 00 02 00 00 00 E6 00 00 00' + '01 03 00 00 FE 01 00 00 02 00 00 00 D8 00 00 00 01 03 00 00 FF 01 00 00 02 00 00 00 F8 00 00 00' + '01 03 00 00 00 02 00 00 02 00 00 00 41 00 00 00 0F 03 00 00 01 02 00 00 02 00 00 00 61 00 00 00' + '0F 03 00 00 02 02 00 00 02 00 00 00 41 00 00 00 11 03 00 00 03 02 00 00 02 00 00 00 61 00 00 00' + '11 03 00 00 04 02 00 00 02 00 00 00 45 00 00 00 0F 03 00 00 05 02 00 00 02 00 00 00 65 00 00 00' + '0F 03 00 00 06 02 00 00 02 00 00 00 45 00 00 00 11 03 00 00 07 02 00 00 02 00 00 00 65 00 00 00' + '11 03 00 00 08 02 00 00 02 00 00 00 49 00 00 00 0F 03 00 00 09 02 00 00 02 00 00 00 69 00 00 00' + '0F 03 00 00 0A 02 00 00 02 00 00 00 49 00 00 00 11 03 00 00 0B 02 00 00 02 00 00 00 69 00 00 00' + '11 03 00 00 0C 02 00 00 02 00 00 00 4F 00 00 00 0F 03 00 00 0D 02 00 00 02 00 00 00 6F 00 00 00' + '0F 03 00 00 0E 02 00 00 02 00 00 00 4F 00 00 00 11 03 00 00 0F 02 00 00 02 00 00 00 6F 00 00 00' + '11 03 00 00 10 02 00 00 02 00 00 00 52 00 00 00 0F 03 00 00 11 02 00 00 02 00 00 00 72 00 00 00' + '0F 03 00 00 12 02 00 00 02 00 00 00 52 00 00 00 11 03 00 00 13 02 00 00 02 00 00 00 72 00 00 00' + '11 03 00 00 14 02 00 00 02 00 00 00 55 00 00 00 0F 03 00 00 15 02 00 00 02 00 00 00 75 00 00 00' + '0F 03 00 00 16 02 00 00 02 00 00 00 55 00 00 00 11 03 00 00 17 02 00 00 02 00 00 00 75 00 00 00' + '11 03 00 00 18 02 00 00 02 00 00 00 53 00 00 00 26 03 00 00 19 02 00 00 02 00 00 00 73 00 00 00' + '26 03 00 00 1A 02 00 00 02 00 00 00 54 00 00 00 26 03 00 00 1B 02 00 00 02 00 00 00 74 00 00 00' + '26 03 00 00 1E 02 00 00 02 00 00 00 48 00 00 00 0C 03 00 00 1F 02 00 00 02 00 00 00 68 00 00 00' + '0C 03 00 00 26 02 00 00 02 00 00 00 41 00 00 00 07 03 00 00 27 02 00 00 02 00 00 00 61 00 00 00' + '07 03 00 00 28 02 00 00 02 00 00 00 45 00 00 00 27 03 00 00 29 02 00 00 02 00 00 00 65 00 00 00' + '27 03 00 00 2A 02 00 00 03 00 00 00 4F 00 00 00 08 03 00 00 04 03 00 00 2B 02 00 00 03 00 00 00' + '6F 00 00 00 08 03 00 00 04 03 00 00 2C 02 00 00 03 00 00 00 4F 00 00 00 03 03 00 00 04 03 00 00' + '2D 02 00 00 03 00 00 00 6F 00 00 00 03 03 00 00 04 03 00 00 2E 02 00 00 02 00 00 00 4F 00 00 00' + '07 03 00 00 2F 02 00 00 02 00 00 00 6F 00 00 00 07 03 00 00 30 02 00 00 03 00 00 00 4F 00 00 00' + '07 03 00 00 04 03 00 00 31 02 00 00 03 00 00 00 6F 00 00 00 07 03 00 00 04 03 00 00 32 02 00 00' + '02 00 00 00 59 00 00 00 04 03 00 00 33 02 00 00 02 00 00 00 79 00 00 00 04 03 00 00 44 03 00 00' + '02 00 00 00 08 03 00 00 01 03 00 00 85 03 00 00 02 00 00 00 A8 00 00 00 01 03 00 00 86 03 00 00' + '02 00 00 00 91 03 00 00 01 03 00 00 88 03 00 00 02 00 00 00 95 03 00 00 01 03 00 00 89 03 00 00' + '02 00 00 00 97 03 00 00 01 03 00 00 8A 03 00 00 02 00 00 00 99 03 00 00 01 03 00 00 8C 03 00 00' + '02 00 00 00 9F 03 00 00 01 03 00 00 8E 03 00 00 02 00 00 00 A5 03 00 00 01 03 00 00 8F 03 00 00' + '02 00 00 00 A9 03 00 00 01 03 00 00 90 03 00 00 03 00 00 00 B9 03 00 00 08 03 00 00 01 03 00 00' + 'AA 03 00 00 02 00 00 00 99 03 00 00 08 03 00 00 AB 03 00 00 02 00 00 00 A5 03 00 00 08 03 00 00' + 'AC 03 00 00 02 00 00 00 B1 03 00 00 01 03 00 00 AD 03 00 00 02 00 00 00 B5 03 00 00 01 03 00 00' + 'AE 03 00 00 02 00 00 00 B7 03 00 00 01 03 00 00 AF 03 00 00 02 00 00 00 B9 03 00 00 01 03 00 00' + 'B0 03 00 00 03 00 00 00 C5 03 00 00 08 03 00 00 01 03 00 00 CA 03 00 00 02 00 00 00 B9 03 00 00' + '08 03 00 00 CB 03 00 00 02 00 00 00 C5 03 00 00 08 03 00 00 CC 03 00 00 02 00 00 00 BF 03 00 00' + '01 03 00 00 CD 03 00 00 02 00 00 00 C5 03 00 00 01 03 00 00 CE 03 00 00 02 00 00 00 C9 03 00 00' + '01 03 00 00 D3 03 00 00 02 00 00 00 D2 03 00 00 01 03 00 00 D4 03 00 00 02 00 00 00 D2 03 00 00' + '08 03 00 00 00 04 00 00 02 00 00 00 15 04 00 00 00 03 00 00 01 04 00 00 02 00 00 00 15 04 00 00' + '08 03 00 00 03 04 00 00 02 00 00 00 13 04 00 00 01 03 00 00 07 04 00 00 02 00 00 00 06 04 00 00' + '08 03 00 00 0C 04 00 00 02 00 00 00 1A 04 00 00 01 03 00 00 0D 04 00 00 02 00 00 00 18 04 00 00' + '00 03 00 00 0E 04 00 00 02 00 00 00 23 04 00 00 06 03 00 00 19 04 00 00 02 00 00 00 18 04 00 00' + '06 03 00 00 39 04 00 00 02 00 00 00 38 04 00 00 06 03 00 00 50 04 00 00 02 00 00 00 35 04 00 00' + '00 03 00 00 51 04 00 00 02 00 00 00 35 04 00 00 08 03 00 00 53 04 00 00 02 00 00 00 33 04 00 00' + '01 03 00 00 57 04 00 00 02 00 00 00 56 04 00 00 08 03 00 00 5C 04 00 00 02 00 00 00 3A 04 00 00' + '01 03 00 00 5D 04 00 00 02 00 00 00 38 04 00 00 00 03 00 00 5E 04 00 00 02 00 00 00 43 04 00 00' + '06 03 00 00 76 04 00 00 02 00 00 00 74 04 00 00 0F 03 00 00 77 04 00 00 02 00 00 00 75 04 00 00' + '0F 03 00 00 C1 04 00 00 02 00 00 00 16 04 00 00 06 03 00 00 C2 04 00 00 02 00 00 00 36 04 00 00' + '06 03 00 00 D0 04 00 00 02 00 00 00 10 04 00 00 06 03 00 00 D1 04 00 00 02 00 00 00 30 04 00 00' + '06 03 00 00 D2 04 00 00 02 00 00 00 10 04 00 00 08 03 00 00 D3 04 00 00 02 00 00 00 30 04 00 00' + '08 03 00 00 D6 04 00 00 02 00 00 00 15 04 00 00 06 03 00 00 D7 04 00 00 02 00 00 00 35 04 00 00' + '06 03 00 00 DA 04 00 00 02 00 00 00 D8 04 00 00 08 03 00 00 DB 04 00 00 02 00 00 00 D9 04 00 00' + '08 03 00 00 DC 04 00 00 02 00 00 00 16 04 00 00 08 03 00 00 DD 04 00 00 02 00 00 00 36 04 00 00' + '08 03 00 00 DE 04 00 00 02 00 00 00 17 04 00 00 08 03 00 00 DF 04 00 00 02 00 00 00 37 04 00 00' + '08 03 00 00 E2 04 00 00 02 00 00 00 18 04 00 00 04 03 00 00 E3 04 00 00 02 00 00 00 38 04 00 00' + '04 03 00 00 E4 04 00 00 02 00 00 00 18 04 00 00 08 03 00 00 E5 04 00 00 02 00 00 00 38 04 00 00' + '08 03 00 00 E6 04 00 00 02 00 00 00 1E 04 00 00 08 03 00 00 E7 04 00 00 02 00 00 00 3E 04 00 00' + '08 03 00 00 EA 04 00 00 02 00 00 00 E8 04 00 00 08 03 00 00 EB 04 00 00 02 00 00 00 E9 04 00 00' + '08 03 00 00 EC 04 00 00 02 00 00 00 2D 04 00 00 08 03 00 00 ED 04 00 00 02 00 00 00 4D 04 00 00' + '08 03 00 00 EE 04 00 00 02 00 00 00 23 04 00 00 04 03 00 00 EF 04 00 00 02 00 00 00 43 04 00 00' + '04 03 00 00 F0 04 00 00 02 00 00 00 23 04 00 00 08 03 00 00 F1 04 00 00 02 00 00 00 43 04 00 00' + '08 03 00 00 F2 04 00 00 02 00 00 00 23 04 00 00 0B 03 00 00 F3 04 00 00 02 00 00 00 43 04 00 00' + '0B 03 00 00 F4 04 00 00 02 00 00 00 27 04 00 00 08 03 00 00 F5 04 00 00 02 00 00 00 47 04 00 00' + '08 03 00 00 F8 04 00 00 02 00 00 00 2B 04 00 00 08 03 00 00 F9 04 00 00 02 00 00 00 4B 04 00 00' + '08 03 00 00 22 06 00 00 02 00 00 00 27 06 00 00 53 06 00 00 23 06 00 00 02 00 00 00 27 06 00 00' + '54 06 00 00 24 06 00 00 02 00 00 00 48 06 00 00 54 06 00 00 25 06 00 00 02 00 00 00 27 06 00 00' + '55 06 00 00 26 06 00 00 02 00 00 00 4A 06 00 00 54 06 00 00 C0 06 00 00 02 00 00 00 D5 06 00 00' + '54 06 00 00 C2 06 00 00 02 00 00 00 C1 06 00 00 54 06 00 00 D3 06 00 00 02 00 00 00 D2 06 00 00' + '54 06 00 00 29 09 00 00 02 00 00 00 28 09 00 00 3C 09 00 00 31 09 00 00 02 00 00 00 30 09 00 00' + '3C 09 00 00 34 09 00 00 02 00 00 00 33 09 00 00 3C 09 00 00 58 09 00 00 02 00 00 00 15 09 00 00' + '3C 09 00 00 59 09 00 00 02 00 00 00 16 09 00 00 3C 09 00 00 5A 09 00 00 02 00 00 00 17 09 00 00' + '3C 09 00 00 5B 09 00 00 02 00 00 00 1C 09 00 00 3C 09 00 00 5C 09 00 00 02 00 00 00 21 09 00 00' + '3C 09 00 00 5D 09 00 00 02 00 00 00 22 09 00 00 3C 09 00 00 5E 09 00 00 02 00 00 00 2B 09 00 00' + '3C 09 00 00 5F 09 00 00 02 00 00 00 2F 09 00 00 3C 09 00 00 CB 09 00 00 02 00 00 00 C7 09 00 00' + 'BE 09 00 00 CC 09 00 00 02 00 00 00 C7 09 00 00 D7 09 00 00 DC 09 00 00 02 00 00 00 A1 09 00 00' + 'BC 09 00 00 DD 09 00 00 02 00 00 00 A2 09 00 00 BC 09 00 00 DF 09 00 00 02 00 00 00 AF 09 00 00' + 'BC 09 00 00 33 0A 00 00 02 00 00 00 32 0A 00 00 3C 0A 00 00 36 0A 00 00 02 00 00 00 38 0A 00 00' + '3C 0A 00 00 59 0A 00 00 02 00 00 00 16 0A 00 00 3C 0A 00 00 5A 0A 00 00 02 00 00 00 17 0A 00 00' + '3C 0A 00 00 5B 0A 00 00 02 00 00 00 1C 0A 00 00 3C 0A 00 00 5E 0A 00 00 02 00 00 00 2B 0A 00 00' + '3C 0A 00 00 48 0B 00 00 02 00 00 00 47 0B 00 00 56 0B 00 00 4B 0B 00 00 02 00 00 00 47 0B 00 00' + '3E 0B 00 00 4C 0B 00 00 02 00 00 00 47 0B 00 00 57 0B 00 00 5C 0B 00 00 02 00 00 00 21 0B 00 00' + '3C 0B 00 00 5D 0B 00 00 02 00 00 00 22 0B 00 00 3C 0B 00 00 94 0B 00 00 02 00 00 00 92 0B 00 00' + 'D7 0B 00 00 CA 0B 00 00 02 00 00 00 C6 0B 00 00 BE 0B 00 00 CB 0B 00 00 02 00 00 00 C7 0B 00 00' + 'BE 0B 00 00 CC 0B 00 00 02 00 00 00 C6 0B 00 00 D7 0B 00 00 48 0C 00 00 02 00 00 00 46 0C 00 00' + '56 0C 00 00 C0 0C 00 00 02 00 00 00 BF 0C 00 00 D5 0C 00 00 C7 0C 00 00 02 00 00 00 C6 0C 00 00' + 'D5 0C 00 00 C8 0C 00 00 02 00 00 00 C6 0C 00 00 D6 0C 00 00 CA 0C 00 00 02 00 00 00 C6 0C 00 00' + 'C2 0C 00 00 CB 0C 00 00 03 00 00 00 C6 0C 00 00 C2 0C 00 00 D5 0C 00 00 4A 0D 00 00 02 00 00 00' + '46 0D 00 00 3E 0D 00 00 4B 0D 00 00 02 00 00 00 47 0D 00 00 3E 0D 00 00 4C 0D 00 00 02 00 00 00' + '46 0D 00 00 57 0D 00 00 DA 0D 00 00 02 00 00 00 D9 0D 00 00 CA 0D 00 00 DC 0D 00 00 02 00 00 00' + 'D9 0D 00 00 CF 0D 00 00 DD 0D 00 00 03 00 00 00 D9 0D 00 00 CF 0D 00 00 CA 0D 00 00 DE 0D 00 00' + '02 00 00 00 D9 0D 00 00 DF 0D 00 00 43 0F 00 00 02 00 00 00 42 0F 00 00 B7 0F 00 00 4D 0F 00 00' + '02 00 00 00 4C 0F 00 00 B7 0F 00 00 52 0F 00 00 02 00 00 00 51 0F 00 00 B7 0F 00 00 57 0F 00 00' + '02 00 00 00 56 0F 00 00 B7 0F 00 00 5C 0F 00 00 02 00 00 00 5B 0F 00 00 B7 0F 00 00 69 0F 00 00' + '02 00 00 00 40 0F 00 00 B5 0F 00 00 73 0F 00 00 02 00 00 00 71 0F 00 00 72 0F 00 00 75 0F 00 00' + '02 00 00 00 71 0F 00 00 74 0F 00 00 76 0F 00 00 02 00 00 00 B2 0F 00 00 80 0F 00 00 78 0F 00 00' + '02 00 00 00 B3 0F 00 00 80 0F 00 00 81 0F 00 00 02 00 00 00 71 0F 00 00 80 0F 00 00 93 0F 00 00' + '02 00 00 00 92 0F 00 00 B7 0F 00 00 9D 0F 00 00 02 00 00 00 9C 0F 00 00 B7 0F 00 00 A2 0F 00 00' + '02 00 00 00 A1 0F 00 00 B7 0F 00 00 A7 0F 00 00 02 00 00 00 A6 0F 00 00 B7 0F 00 00 AC 0F 00 00' + '02 00 00 00 AB 0F 00 00 B7 0F 00 00 B9 0F 00 00 02 00 00 00 90 0F 00 00 B5 0F 00 00 26 10 00 00' + '02 00 00 00 25 10 00 00 2E 10 00 00 00 1E 00 00 02 00 00 00 41 00 00 00 25 03 00 00 01 1E 00 00' + '02 00 00 00 61 00 00 00 25 03 00 00 02 1E 00 00 02 00 00 00 42 00 00 00 07 03 00 00 03 1E 00 00' + '02 00 00 00 62 00 00 00 07 03 00 00 04 1E 00 00 02 00 00 00 42 00 00 00 23 03 00 00 05 1E 00 00' + '02 00 00 00 62 00 00 00 23 03 00 00 06 1E 00 00 02 00 00 00 42 00 00 00 31 03 00 00 07 1E 00 00' + '02 00 00 00 62 00 00 00 31 03 00 00 08 1E 00 00 03 00 00 00 43 00 00 00 27 03 00 00 01 03 00 00' + '09 1E 00 00 03 00 00 00 63 00 00 00 27 03 00 00 01 03 00 00 0A 1E 00 00 02 00 00 00 44 00 00 00' + '07 03 00 00 0B 1E 00 00 02 00 00 00 64 00 00 00 07 03 00 00 0C 1E 00 00 02 00 00 00 44 00 00 00' + '23 03 00 00 0D 1E 00 00 02 00 00 00 64 00 00 00 23 03 00 00 0E 1E 00 00 02 00 00 00 44 00 00 00' + '31 03 00 00 0F 1E 00 00 02 00 00 00 64 00 00 00 31 03 00 00 10 1E 00 00 02 00 00 00 44 00 00 00' + '27 03 00 00 11 1E 00 00 02 00 00 00 64 00 00 00 27 03 00 00 12 1E 00 00 02 00 00 00 44 00 00 00' + '2D 03 00 00 13 1E 00 00 02 00 00 00 64 00 00 00 2D 03 00 00 14 1E 00 00 03 00 00 00 45 00 00 00' + '04 03 00 00 00 03 00 00 15 1E 00 00 03 00 00 00 65 00 00 00 04 03 00 00 00 03 00 00 16 1E 00 00' + '03 00 00 00 45 00 00 00 04 03 00 00 01 03 00 00 17 1E 00 00 03 00 00 00 65 00 00 00 04 03 00 00' + '01 03 00 00 18 1E 00 00 02 00 00 00 45 00 00 00 2D 03 00 00 19 1E 00 00 02 00 00 00 65 00 00 00' + '2D 03 00 00 1A 1E 00 00 02 00 00 00 45 00 00 00 30 03 00 00 1B 1E 00 00 02 00 00 00 65 00 00 00' + '30 03 00 00 1C 1E 00 00 03 00 00 00 45 00 00 00 27 03 00 00 06 03 00 00 1D 1E 00 00 03 00 00 00' + '65 00 00 00 27 03 00 00 06 03 00 00 1E 1E 00 00 02 00 00 00 46 00 00 00 07 03 00 00 1F 1E 00 00' + '02 00 00 00 66 00 00 00 07 03 00 00 20 1E 00 00 02 00 00 00 47 00 00 00 04 03 00 00 21 1E 00 00' + '02 00 00 00 67 00 00 00 04 03 00 00 22 1E 00 00 02 00 00 00 48 00 00 00 07 03 00 00 23 1E 00 00' + '02 00 00 00 68 00 00 00 07 03 00 00 24 1E 00 00 02 00 00 00 48 00 00 00 23 03 00 00 25 1E 00 00' + '02 00 00 00 68 00 00 00 23 03 00 00 26 1E 00 00 02 00 00 00 48 00 00 00 08 03 00 00 27 1E 00 00' + '02 00 00 00 68 00 00 00 08 03 00 00 28 1E 00 00 02 00 00 00 48 00 00 00 27 03 00 00 29 1E 00 00' + '02 00 00 00 68 00 00 00 27 03 00 00 2A 1E 00 00 02 00 00 00 48 00 00 00 2E 03 00 00 2B 1E 00 00' + '02 00 00 00 68 00 00 00 2E 03 00 00 2C 1E 00 00 02 00 00 00 49 00 00 00 30 03 00 00 2D 1E 00 00' + '02 00 00 00 69 00 00 00 30 03 00 00 2E 1E 00 00 03 00 00 00 49 00 00 00 08 03 00 00 01 03 00 00' + '2F 1E 00 00 03 00 00 00 69 00 00 00 08 03 00 00 01 03 00 00 30 1E 00 00 02 00 00 00 4B 00 00 00' + '01 03 00 00 31 1E 00 00 02 00 00 00 6B 00 00 00 01 03 00 00 32 1E 00 00 02 00 00 00 4B 00 00 00' + '23 03 00 00 33 1E 00 00 02 00 00 00 6B 00 00 00 23 03 00 00 34 1E 00 00 02 00 00 00 4B 00 00 00' + '31 03 00 00 35 1E 00 00 02 00 00 00 6B 00 00 00 31 03 00 00 36 1E 00 00 02 00 00 00 4C 00 00 00' + '23 03 00 00 37 1E 00 00 02 00 00 00 6C 00 00 00 23 03 00 00 38 1E 00 00 03 00 00 00 4C 00 00 00' + '23 03 00 00 04 03 00 00 39 1E 00 00 03 00 00 00 6C 00 00 00 23 03 00 00 04 03 00 00 3A 1E 00 00' + '02 00 00 00 4C 00 00 00 31 03 00 00 3B 1E 00 00 02 00 00 00 6C 00 00 00 31 03 00 00 3C 1E 00 00' + '02 00 00 00 4C 00 00 00 2D 03 00 00 3D 1E 00 00 02 00 00 00 6C 00 00 00 2D 03 00 00 3E 1E 00 00' + '02 00 00 00 4D 00 00 00 01 03 00 00 3F 1E 00 00 02 00 00 00 6D 00 00 00 01 03 00 00 40 1E 00 00' + '02 00 00 00 4D 00 00 00 07 03 00 00 41 1E 00 00 02 00 00 00 6D 00 00 00 07 03 00 00 42 1E 00 00' + '02 00 00 00 4D 00 00 00 23 03 00 00 43 1E 00 00 02 00 00 00 6D 00 00 00 23 03 00 00 44 1E 00 00' + '02 00 00 00 4E 00 00 00 07 03 00 00 45 1E 00 00 02 00 00 00 6E 00 00 00 07 03 00 00 46 1E 00 00' + '02 00 00 00 4E 00 00 00 23 03 00 00 47 1E 00 00 02 00 00 00 6E 00 00 00 23 03 00 00 48 1E 00 00' + '02 00 00 00 4E 00 00 00 31 03 00 00 49 1E 00 00 02 00 00 00 6E 00 00 00 31 03 00 00 4A 1E 00 00' + '02 00 00 00 4E 00 00 00 2D 03 00 00 4B 1E 00 00 02 00 00 00 6E 00 00 00 2D 03 00 00 4C 1E 00 00' + '03 00 00 00 4F 00 00 00 03 03 00 00 01 03 00 00 4D 1E 00 00 03 00 00 00 6F 00 00 00 03 03 00 00' + '01 03 00 00 4E 1E 00 00 03 00 00 00 4F 00 00 00 03 03 00 00 08 03 00 00 4F 1E 00 00 03 00 00 00' + '6F 00 00 00 03 03 00 00 08 03 00 00 50 1E 00 00 03 00 00 00 4F 00 00 00 04 03 00 00 00 03 00 00' + '51 1E 00 00 03 00 00 00 6F 00 00 00 04 03 00 00 00 03 00 00 52 1E 00 00 03 00 00 00 4F 00 00 00' + '04 03 00 00 01 03 00 00 53 1E 00 00 03 00 00 00 6F 00 00 00 04 03 00 00 01 03 00 00 54 1E 00 00' + '02 00 00 00 50 00 00 00 01 03 00 00 55 1E 00 00 02 00 00 00 70 00 00 00 01 03 00 00 56 1E 00 00' + '02 00 00 00 50 00 00 00 07 03 00 00 57 1E 00 00 02 00 00 00 70 00 00 00 07 03 00 00 58 1E 00 00' + '02 00 00 00 52 00 00 00 07 03 00 00 59 1E 00 00 02 00 00 00 72 00 00 00 07 03 00 00 5A 1E 00 00' + '02 00 00 00 52 00 00 00 23 03 00 00 5B 1E 00 00 02 00 00 00 72 00 00 00 23 03 00 00 5C 1E 00 00' + '03 00 00 00 52 00 00 00 23 03 00 00 04 03 00 00 5D 1E 00 00 03 00 00 00 72 00 00 00 23 03 00 00' + '04 03 00 00 5E 1E 00 00 02 00 00 00 52 00 00 00 31 03 00 00 5F 1E 00 00 02 00 00 00 72 00 00 00' + '31 03 00 00 60 1E 00 00 02 00 00 00 53 00 00 00 07 03 00 00 61 1E 00 00 02 00 00 00 73 00 00 00' + '07 03 00 00 62 1E 00 00 02 00 00 00 53 00 00 00 23 03 00 00 63 1E 00 00 02 00 00 00 73 00 00 00' + '23 03 00 00 64 1E 00 00 03 00 00 00 53 00 00 00 01 03 00 00 07 03 00 00 65 1E 00 00 03 00 00 00' + '73 00 00 00 01 03 00 00 07 03 00 00 66 1E 00 00 03 00 00 00 53 00 00 00 0C 03 00 00 07 03 00 00' + '67 1E 00 00 03 00 00 00 73 00 00 00 0C 03 00 00 07 03 00 00 68 1E 00 00 03 00 00 00 53 00 00 00' + '23 03 00 00 07 03 00 00 69 1E 00 00 03 00 00 00 73 00 00 00 23 03 00 00 07 03 00 00 6A 1E 00 00' + '02 00 00 00 54 00 00 00 07 03 00 00 6B 1E 00 00 02 00 00 00 74 00 00 00 07 03 00 00 6C 1E 00 00' + '02 00 00 00 54 00 00 00 23 03 00 00 6D 1E 00 00 02 00 00 00 74 00 00 00 23 03 00 00 6E 1E 00 00' + '02 00 00 00 54 00 00 00 31 03 00 00 6F 1E 00 00 02 00 00 00 74 00 00 00 31 03 00 00 70 1E 00 00' + '02 00 00 00 54 00 00 00 2D 03 00 00 71 1E 00 00 02 00 00 00 74 00 00 00 2D 03 00 00 72 1E 00 00' + '02 00 00 00 55 00 00 00 24 03 00 00 73 1E 00 00 02 00 00 00 75 00 00 00 24 03 00 00 74 1E 00 00' + '02 00 00 00 55 00 00 00 30 03 00 00 75 1E 00 00 02 00 00 00 75 00 00 00 30 03 00 00 76 1E 00 00' + '02 00 00 00 55 00 00 00 2D 03 00 00 77 1E 00 00 02 00 00 00 75 00 00 00 2D 03 00 00 78 1E 00 00' + '03 00 00 00 55 00 00 00 03 03 00 00 01 03 00 00 79 1E 00 00 03 00 00 00 75 00 00 00 03 03 00 00' + '01 03 00 00 7A 1E 00 00 03 00 00 00 55 00 00 00 04 03 00 00 08 03 00 00 7B 1E 00 00 03 00 00 00' + '75 00 00 00 04 03 00 00 08 03 00 00 7C 1E 00 00 02 00 00 00 56 00 00 00 03 03 00 00 7D 1E 00 00' + '02 00 00 00 76 00 00 00 03 03 00 00 7E 1E 00 00 02 00 00 00 56 00 00 00 23 03 00 00 7F 1E 00 00' + '02 00 00 00 76 00 00 00 23 03 00 00 80 1E 00 00 02 00 00 00 57 00 00 00 00 03 00 00 81 1E 00 00' + '02 00 00 00 77 00 00 00 00 03 00 00 82 1E 00 00 02 00 00 00 57 00 00 00 01 03 00 00 83 1E 00 00' + '02 00 00 00 77 00 00 00 01 03 00 00 84 1E 00 00 02 00 00 00 57 00 00 00 08 03 00 00 85 1E 00 00' + '02 00 00 00 77 00 00 00 08 03 00 00 86 1E 00 00 02 00 00 00 57 00 00 00 07 03 00 00 87 1E 00 00' + '02 00 00 00 77 00 00 00 07 03 00 00 88 1E 00 00 02 00 00 00 57 00 00 00 23 03 00 00 89 1E 00 00' + '02 00 00 00 77 00 00 00 23 03 00 00 8A 1E 00 00 02 00 00 00 58 00 00 00 07 03 00 00 8B 1E 00 00' + '02 00 00 00 78 00 00 00 07 03 00 00 8C 1E 00 00 02 00 00 00 58 00 00 00 08 03 00 00 8D 1E 00 00' + '02 00 00 00 78 00 00 00 08 03 00 00 8E 1E 00 00 02 00 00 00 59 00 00 00 07 03 00 00 8F 1E 00 00' + '02 00 00 00 79 00 00 00 07 03 00 00 90 1E 00 00 02 00 00 00 5A 00 00 00 02 03 00 00 91 1E 00 00' + '02 00 00 00 7A 00 00 00 02 03 00 00 92 1E 00 00 02 00 00 00 5A 00 00 00 23 03 00 00 93 1E 00 00' + '02 00 00 00 7A 00 00 00 23 03 00 00 94 1E 00 00 02 00 00 00 5A 00 00 00 31 03 00 00 95 1E 00 00' + '02 00 00 00 7A 00 00 00 31 03 00 00 96 1E 00 00 02 00 00 00 68 00 00 00 31 03 00 00 97 1E 00 00' + '02 00 00 00 74 00 00 00 08 03 00 00 98 1E 00 00 02 00 00 00 77 00 00 00 0A 03 00 00 99 1E 00 00' + '02 00 00 00 79 00 00 00 0A 03 00 00 9B 1E 00 00 02 00 00 00 7F 01 00 00 07 03 00 00 A0 1E 00 00' + '02 00 00 00 41 00 00 00 23 03 00 00 A1 1E 00 00 02 00 00 00 61 00 00 00 23 03 00 00 A2 1E 00 00' + '02 00 00 00 41 00 00 00 09 03 00 00 A3 1E 00 00 02 00 00 00 61 00 00 00 09 03 00 00 A4 1E 00 00' + '03 00 00 00 41 00 00 00 02 03 00 00 01 03 00 00 A5 1E 00 00 03 00 00 00 61 00 00 00 02 03 00 00' + '01 03 00 00 A6 1E 00 00 03 00 00 00 41 00 00 00 02 03 00 00 00 03 00 00 A7 1E 00 00 03 00 00 00' + '61 00 00 00 02 03 00 00 00 03 00 00 A8 1E 00 00 03 00 00 00 41 00 00 00 02 03 00 00 09 03 00 00' + 'A9 1E 00 00 03 00 00 00 61 00 00 00 02 03 00 00 09 03 00 00 AA 1E 00 00 03 00 00 00 41 00 00 00' + '02 03 00 00 03 03 00 00 AB 1E 00 00 03 00 00 00 61 00 00 00 02 03 00 00 03 03 00 00 AC 1E 00 00' + '03 00 00 00 41 00 00 00 23 03 00 00 02 03 00 00 AD 1E 00 00 03 00 00 00 61 00 00 00 23 03 00 00' + '02 03 00 00 AE 1E 00 00 03 00 00 00 41 00 00 00 06 03 00 00 01 03 00 00 AF 1E 00 00 03 00 00 00' + '61 00 00 00 06 03 00 00 01 03 00 00 B0 1E 00 00 03 00 00 00 41 00 00 00 06 03 00 00 00 03 00 00' + 'B1 1E 00 00 03 00 00 00 61 00 00 00 06 03 00 00 00 03 00 00 B2 1E 00 00 03 00 00 00 41 00 00 00' + '06 03 00 00 09 03 00 00 B3 1E 00 00 03 00 00 00 61 00 00 00 06 03 00 00 09 03 00 00 B4 1E 00 00' + '03 00 00 00 41 00 00 00 06 03 00 00 03 03 00 00 B5 1E 00 00 03 00 00 00 61 00 00 00 06 03 00 00' + '03 03 00 00 B6 1E 00 00 03 00 00 00 41 00 00 00 23 03 00 00 06 03 00 00 B7 1E 00 00 03 00 00 00' + '61 00 00 00 23 03 00 00 06 03 00 00 B8 1E 00 00 02 00 00 00 45 00 00 00 23 03 00 00 B9 1E 00 00' + '02 00 00 00 65 00 00 00 23 03 00 00 BA 1E 00 00 02 00 00 00 45 00 00 00 09 03 00 00 BB 1E 00 00' + '02 00 00 00 65 00 00 00 09 03 00 00 BC 1E 00 00 02 00 00 00 45 00 00 00 03 03 00 00 BD 1E 00 00' + '02 00 00 00 65 00 00 00 03 03 00 00 BE 1E 00 00 03 00 00 00 45 00 00 00 02 03 00 00 01 03 00 00' + 'BF 1E 00 00 03 00 00 00 65 00 00 00 02 03 00 00 01 03 00 00 C0 1E 00 00 03 00 00 00 45 00 00 00' + '02 03 00 00 00 03 00 00 C1 1E 00 00 03 00 00 00 65 00 00 00 02 03 00 00 00 03 00 00 C2 1E 00 00' + '03 00 00 00 45 00 00 00 02 03 00 00 09 03 00 00 C3 1E 00 00 03 00 00 00 65 00 00 00 02 03 00 00' + '09 03 00 00 C4 1E 00 00 03 00 00 00 45 00 00 00 02 03 00 00 03 03 00 00 C5 1E 00 00 03 00 00 00' + '65 00 00 00 02 03 00 00 03 03 00 00 C6 1E 00 00 03 00 00 00 45 00 00 00 23 03 00 00 02 03 00 00' + 'C7 1E 00 00 03 00 00 00 65 00 00 00 23 03 00 00 02 03 00 00 C8 1E 00 00 02 00 00 00 49 00 00 00' + '09 03 00 00 C9 1E 00 00 02 00 00 00 69 00 00 00 09 03 00 00 CA 1E 00 00 02 00 00 00 49 00 00 00' + '23 03 00 00 CB 1E 00 00 02 00 00 00 69 00 00 00 23 03 00 00 CC 1E 00 00 02 00 00 00 4F 00 00 00' + '23 03 00 00 CD 1E 00 00 02 00 00 00 6F 00 00 00 23 03 00 00 CE 1E 00 00 02 00 00 00 4F 00 00 00' + '09 03 00 00 CF 1E 00 00 02 00 00 00 6F 00 00 00 09 03 00 00 D0 1E 00 00 03 00 00 00 4F 00 00 00' + '02 03 00 00 01 03 00 00 D1 1E 00 00 03 00 00 00 6F 00 00 00 02 03 00 00 01 03 00 00 D2 1E 00 00' + '03 00 00 00 4F 00 00 00 02 03 00 00 00 03 00 00 D3 1E 00 00 03 00 00 00 6F 00 00 00 02 03 00 00' + '00 03 00 00 D4 1E 00 00 03 00 00 00 4F 00 00 00 02 03 00 00 09 03 00 00 D5 1E 00 00 03 00 00 00' + '6F 00 00 00 02 03 00 00 09 03 00 00 D6 1E 00 00 03 00 00 00 4F 00 00 00 02 03 00 00 03 03 00 00' + 'D7 1E 00 00 03 00 00 00 6F 00 00 00 02 03 00 00 03 03 00 00 D8 1E 00 00 03 00 00 00 4F 00 00 00' + '23 03 00 00 02 03 00 00 D9 1E 00 00 03 00 00 00 6F 00 00 00 23 03 00 00 02 03 00 00 DA 1E 00 00' + '03 00 00 00 4F 00 00 00 1B 03 00 00 01 03 00 00 DB 1E 00 00 03 00 00 00 6F 00 00 00 1B 03 00 00' + '01 03 00 00 DC 1E 00 00 03 00 00 00 4F 00 00 00 1B 03 00 00 00 03 00 00 DD 1E 00 00 03 00 00 00' + '6F 00 00 00 1B 03 00 00 00 03 00 00 DE 1E 00 00 03 00 00 00 4F 00 00 00 1B 03 00 00 09 03 00 00' + 'DF 1E 00 00 03 00 00 00 6F 00 00 00 1B 03 00 00 09 03 00 00 E0 1E 00 00 03 00 00 00 4F 00 00 00' + '1B 03 00 00 03 03 00 00 E1 1E 00 00 03 00 00 00 6F 00 00 00 1B 03 00 00 03 03 00 00 E2 1E 00 00' + '03 00 00 00 4F 00 00 00 1B 03 00 00 23 03 00 00 E3 1E 00 00 03 00 00 00 6F 00 00 00 1B 03 00 00' + '23 03 00 00 E4 1E 00 00 02 00 00 00 55 00 00 00 23 03 00 00 E5 1E 00 00 02 00 00 00 75 00 00 00' + '23 03 00 00 E6 1E 00 00 02 00 00 00 55 00 00 00 09 03 00 00 E7 1E 00 00 02 00 00 00 75 00 00 00' + '09 03 00 00 E8 1E 00 00 03 00 00 00 55 00 00 00 1B 03 00 00 01 03 00 00 E9 1E 00 00 03 00 00 00' + '75 00 00 00 1B 03 00 00 01 03 00 00 EA 1E 00 00 03 00 00 00 55 00 00 00 1B 03 00 00 00 03 00 00' + 'EB 1E 00 00 03 00 00 00 75 00 00 00 1B 03 00 00 00 03 00 00 EC 1E 00 00 03 00 00 00 55 00 00 00' + '1B 03 00 00 09 03 00 00 ED 1E 00 00 03 00 00 00 75 00 00 00 1B 03 00 00 09 03 00 00 EE 1E 00 00' + '03 00 00 00 55 00 00 00 1B 03 00 00 03 03 00 00 EF 1E 00 00 03 00 00 00 75 00 00 00 1B 03 00 00' + '03 03 00 00 F0 1E 00 00 03 00 00 00 55 00 00 00 1B 03 00 00 23 03 00 00 F1 1E 00 00 03 00 00 00' + '75 00 00 00 1B 03 00 00 23 03 00 00 F2 1E 00 00 02 00 00 00 59 00 00 00 00 03 00 00 F3 1E 00 00' + '02 00 00 00 79 00 00 00 00 03 00 00 F4 1E 00 00 02 00 00 00 59 00 00 00 23 03 00 00 F5 1E 00 00' + '02 00 00 00 79 00 00 00 23 03 00 00 F6 1E 00 00 02 00 00 00 59 00 00 00 09 03 00 00 F7 1E 00 00' + '02 00 00 00 79 00 00 00 09 03 00 00 F8 1E 00 00 02 00 00 00 59 00 00 00 03 03 00 00 F9 1E 00 00' + '02 00 00 00 79 00 00 00 03 03 00 00 00 1F 00 00 02 00 00 00 B1 03 00 00 13 03 00 00 01 1F 00 00' + '02 00 00 00 B1 03 00 00 14 03 00 00 02 1F 00 00 03 00 00 00 B1 03 00 00 13 03 00 00 00 03 00 00' + '03 1F 00 00 03 00 00 00 B1 03 00 00 14 03 00 00 00 03 00 00 04 1F 00 00 03 00 00 00 B1 03 00 00' + '13 03 00 00 01 03 00 00 05 1F 00 00 03 00 00 00 B1 03 00 00 14 03 00 00 01 03 00 00 06 1F 00 00' + '03 00 00 00 B1 03 00 00 13 03 00 00 42 03 00 00 07 1F 00 00 03 00 00 00 B1 03 00 00 14 03 00 00' + '42 03 00 00 08 1F 00 00 02 00 00 00 91 03 00 00 13 03 00 00 09 1F 00 00 02 00 00 00 91 03 00 00' + '14 03 00 00 0A 1F 00 00 03 00 00 00 91 03 00 00 13 03 00 00 00 03 00 00 0B 1F 00 00 03 00 00 00' + '91 03 00 00 14 03 00 00 00 03 00 00 0C 1F 00 00 03 00 00 00 91 03 00 00 13 03 00 00 01 03 00 00' + '0D 1F 00 00 03 00 00 00 91 03 00 00 14 03 00 00 01 03 00 00 0E 1F 00 00 03 00 00 00 91 03 00 00' + '13 03 00 00 42 03 00 00 0F 1F 00 00 03 00 00 00 91 03 00 00 14 03 00 00 42 03 00 00 10 1F 00 00' + '02 00 00 00 B5 03 00 00 13 03 00 00 11 1F 00 00 02 00 00 00 B5 03 00 00 14 03 00 00 12 1F 00 00' + '03 00 00 00 B5 03 00 00 13 03 00 00 00 03 00 00 13 1F 00 00 03 00 00 00 B5 03 00 00 14 03 00 00' + '00 03 00 00 14 1F 00 00 03 00 00 00 B5 03 00 00 13 03 00 00 01 03 00 00 15 1F 00 00 03 00 00 00' + 'B5 03 00 00 14 03 00 00 01 03 00 00 18 1F 00 00 02 00 00 00 95 03 00 00 13 03 00 00 19 1F 00 00' + '02 00 00 00 95 03 00 00 14 03 00 00 1A 1F 00 00 03 00 00 00 95 03 00 00 13 03 00 00 00 03 00 00' + '1B 1F 00 00 03 00 00 00 95 03 00 00 14 03 00 00 00 03 00 00 1C 1F 00 00 03 00 00 00 95 03 00 00' + '13 03 00 00 01 03 00 00 1D 1F 00 00 03 00 00 00 95 03 00 00 14 03 00 00 01 03 00 00 20 1F 00 00' + '02 00 00 00 B7 03 00 00 13 03 00 00 21 1F 00 00 02 00 00 00 B7 03 00 00 14 03 00 00 22 1F 00 00' + '03 00 00 00 B7 03 00 00 13 03 00 00 00 03 00 00 23 1F 00 00 03 00 00 00 B7 03 00 00 14 03 00 00' + '00 03 00 00 24 1F 00 00 03 00 00 00 B7 03 00 00 13 03 00 00 01 03 00 00 25 1F 00 00 03 00 00 00' + 'B7 03 00 00 14 03 00 00 01 03 00 00 26 1F 00 00 03 00 00 00 B7 03 00 00 13 03 00 00 42 03 00 00' + '27 1F 00 00 03 00 00 00 B7 03 00 00 14 03 00 00 42 03 00 00 28 1F 00 00 02 00 00 00 97 03 00 00' + '13 03 00 00 29 1F 00 00 02 00 00 00 97 03 00 00 14 03 00 00 2A 1F 00 00 03 00 00 00 97 03 00 00' + '13 03 00 00 00 03 00 00 2B 1F 00 00 03 00 00 00 97 03 00 00 14 03 00 00 00 03 00 00 2C 1F 00 00' + '03 00 00 00 97 03 00 00 13 03 00 00 01 03 00 00 2D 1F 00 00 03 00 00 00 97 03 00 00 14 03 00 00' + '01 03 00 00 2E 1F 00 00 03 00 00 00 97 03 00 00 13 03 00 00 42 03 00 00 2F 1F 00 00 03 00 00 00' + '97 03 00 00 14 03 00 00 42 03 00 00 30 1F 00 00 02 00 00 00 B9 03 00 00 13 03 00 00 31 1F 00 00' + '02 00 00 00 B9 03 00 00 14 03 00 00 32 1F 00 00 03 00 00 00 B9 03 00 00 13 03 00 00 00 03 00 00' + '33 1F 00 00 03 00 00 00 B9 03 00 00 14 03 00 00 00 03 00 00 34 1F 00 00 03 00 00 00 B9 03 00 00' + '13 03 00 00 01 03 00 00 35 1F 00 00 03 00 00 00 B9 03 00 00 14 03 00 00 01 03 00 00 36 1F 00 00' + '03 00 00 00 B9 03 00 00 13 03 00 00 42 03 00 00 37 1F 00 00 03 00 00 00 B9 03 00 00 14 03 00 00' + '42 03 00 00 38 1F 00 00 02 00 00 00 99 03 00 00 13 03 00 00 39 1F 00 00 02 00 00 00 99 03 00 00' + '14 03 00 00 3A 1F 00 00 03 00 00 00 99 03 00 00 13 03 00 00 00 03 00 00 3B 1F 00 00 03 00 00 00' + '99 03 00 00 14 03 00 00 00 03 00 00 3C 1F 00 00 03 00 00 00 99 03 00 00 13 03 00 00 01 03 00 00' + '3D 1F 00 00 03 00 00 00 99 03 00 00 14 03 00 00 01 03 00 00 3E 1F 00 00 03 00 00 00 99 03 00 00' + '13 03 00 00 42 03 00 00 3F 1F 00 00 03 00 00 00 99 03 00 00 14 03 00 00 42 03 00 00 40 1F 00 00' + '02 00 00 00 BF 03 00 00 13 03 00 00 41 1F 00 00 02 00 00 00 BF 03 00 00 14 03 00 00 42 1F 00 00' + '03 00 00 00 BF 03 00 00 13 03 00 00 00 03 00 00 43 1F 00 00 03 00 00 00 BF 03 00 00 14 03 00 00' + '00 03 00 00 44 1F 00 00 03 00 00 00 BF 03 00 00 13 03 00 00 01 03 00 00 45 1F 00 00 03 00 00 00' + 'BF 03 00 00 14 03 00 00 01 03 00 00 48 1F 00 00 02 00 00 00 9F 03 00 00 13 03 00 00 49 1F 00 00' + '02 00 00 00 9F 03 00 00 14 03 00 00 4A 1F 00 00 03 00 00 00 9F 03 00 00 13 03 00 00 00 03 00 00' + '4B 1F 00 00 03 00 00 00 9F 03 00 00 14 03 00 00 00 03 00 00 4C 1F 00 00 03 00 00 00 9F 03 00 00' + '13 03 00 00 01 03 00 00 4D 1F 00 00 03 00 00 00 9F 03 00 00 14 03 00 00 01 03 00 00 50 1F 00 00' + '02 00 00 00 C5 03 00 00 13 03 00 00 51 1F 00 00 02 00 00 00 C5 03 00 00 14 03 00 00 52 1F 00 00' + '03 00 00 00 C5 03 00 00 13 03 00 00 00 03 00 00 53 1F 00 00 03 00 00 00 C5 03 00 00 14 03 00 00' + '00 03 00 00 54 1F 00 00 03 00 00 00 C5 03 00 00 13 03 00 00 01 03 00 00 55 1F 00 00 03 00 00 00' + 'C5 03 00 00 14 03 00 00 01 03 00 00 56 1F 00 00 03 00 00 00 C5 03 00 00 13 03 00 00 42 03 00 00' + '57 1F 00 00 03 00 00 00 C5 03 00 00 14 03 00 00 42 03 00 00 59 1F 00 00 02 00 00 00 A5 03 00 00' + '14 03 00 00 5B 1F 00 00 03 00 00 00 A5 03 00 00 14 03 00 00 00 03 00 00 5D 1F 00 00 03 00 00 00' + 'A5 03 00 00 14 03 00 00 01 03 00 00 5F 1F 00 00 03 00 00 00 A5 03 00 00 14 03 00 00 42 03 00 00' + '60 1F 00 00 02 00 00 00 C9 03 00 00 13 03 00 00 61 1F 00 00 02 00 00 00 C9 03 00 00 14 03 00 00' + '62 1F 00 00 03 00 00 00 C9 03 00 00 13 03 00 00 00 03 00 00 63 1F 00 00 03 00 00 00 C9 03 00 00' + '14 03 00 00 00 03 00 00 64 1F 00 00 03 00 00 00 C9 03 00 00 13 03 00 00 01 03 00 00 65 1F 00 00' + '03 00 00 00 C9 03 00 00 14 03 00 00 01 03 00 00 66 1F 00 00 03 00 00 00 C9 03 00 00 13 03 00 00' + '42 03 00 00 67 1F 00 00 03 00 00 00 C9 03 00 00 14 03 00 00 42 03 00 00 68 1F 00 00 02 00 00 00' + 'A9 03 00 00 13 03 00 00 69 1F 00 00 02 00 00 00 A9 03 00 00 14 03 00 00 6A 1F 00 00 03 00 00 00' + 'A9 03 00 00 13 03 00 00 00 03 00 00 6B 1F 00 00 03 00 00 00 A9 03 00 00 14 03 00 00 00 03 00 00' + '6C 1F 00 00 03 00 00 00 A9 03 00 00 13 03 00 00 01 03 00 00 6D 1F 00 00 03 00 00 00 A9 03 00 00' + '14 03 00 00 01 03 00 00 6E 1F 00 00 03 00 00 00 A9 03 00 00 13 03 00 00 42 03 00 00 6F 1F 00 00' + '03 00 00 00 A9 03 00 00 14 03 00 00 42 03 00 00 70 1F 00 00 02 00 00 00 B1 03 00 00 00 03 00 00' + '72 1F 00 00 02 00 00 00 B5 03 00 00 00 03 00 00 74 1F 00 00 02 00 00 00 B7 03 00 00 00 03 00 00' + '76 1F 00 00 02 00 00 00 B9 03 00 00 00 03 00 00 78 1F 00 00 02 00 00 00 BF 03 00 00 00 03 00 00' + '7A 1F 00 00 02 00 00 00 C5 03 00 00 00 03 00 00 7C 1F 00 00 02 00 00 00 C9 03 00 00 00 03 00 00' + '80 1F 00 00 03 00 00 00 B1 03 00 00 13 03 00 00 45 03 00 00 81 1F 00 00 03 00 00 00 B1 03 00 00' + '14 03 00 00 45 03 00 00 82 1F 00 00 04 00 00 00 B1 03 00 00 13 03 00 00 00 03 00 00 45 03 00 00' + '83 1F 00 00 04 00 00 00 B1 03 00 00 14 03 00 00 00 03 00 00 45 03 00 00 84 1F 00 00 04 00 00 00' + 'B1 03 00 00 13 03 00 00 01 03 00 00 45 03 00 00 85 1F 00 00 04 00 00 00 B1 03 00 00 14 03 00 00' + '01 03 00 00 45 03 00 00 86 1F 00 00 04 00 00 00 B1 03 00 00 13 03 00 00 42 03 00 00 45 03 00 00' + '87 1F 00 00 04 00 00 00 B1 03 00 00 14 03 00 00 42 03 00 00 45 03 00 00 88 1F 00 00 03 00 00 00' + '91 03 00 00 13 03 00 00 45 03 00 00 89 1F 00 00 03 00 00 00 91 03 00 00 14 03 00 00 45 03 00 00' + '8A 1F 00 00 04 00 00 00 91 03 00 00 13 03 00 00 00 03 00 00 45 03 00 00 8B 1F 00 00 04 00 00 00' + '91 03 00 00 14 03 00 00 00 03 00 00 45 03 00 00 8C 1F 00 00 04 00 00 00 91 03 00 00 13 03 00 00' + '01 03 00 00 45 03 00 00 8D 1F 00 00 04 00 00 00 91 03 00 00 14 03 00 00 01 03 00 00 45 03 00 00' + '8E 1F 00 00 04 00 00 00 91 03 00 00 13 03 00 00 42 03 00 00 45 03 00 00 8F 1F 00 00 04 00 00 00' + '91 03 00 00 14 03 00 00 42 03 00 00 45 03 00 00 90 1F 00 00 03 00 00 00 B7 03 00 00 13 03 00 00' + '45 03 00 00 91 1F 00 00 03 00 00 00 B7 03 00 00 14 03 00 00 45 03 00 00 92 1F 00 00 04 00 00 00' + 'B7 03 00 00 13 03 00 00 00 03 00 00 45 03 00 00 93 1F 00 00 04 00 00 00 B7 03 00 00 14 03 00 00' + '00 03 00 00 45 03 00 00 94 1F 00 00 04 00 00 00 B7 03 00 00 13 03 00 00 01 03 00 00 45 03 00 00' + '95 1F 00 00 04 00 00 00 B7 03 00 00 14 03 00 00 01 03 00 00 45 03 00 00 96 1F 00 00 04 00 00 00' + 'B7 03 00 00 13 03 00 00 42 03 00 00 45 03 00 00 97 1F 00 00 04 00 00 00 B7 03 00 00 14 03 00 00' + '42 03 00 00 45 03 00 00 98 1F 00 00 03 00 00 00 97 03 00 00 13 03 00 00 45 03 00 00 99 1F 00 00' + '03 00 00 00 97 03 00 00 14 03 00 00 45 03 00 00 9A 1F 00 00 04 00 00 00 97 03 00 00 13 03 00 00' + '00 03 00 00 45 03 00 00 9B 1F 00 00 04 00 00 00 97 03 00 00 14 03 00 00 00 03 00 00 45 03 00 00' + '9C 1F 00 00 04 00 00 00 97 03 00 00 13 03 00 00 01 03 00 00 45 03 00 00 9D 1F 00 00 04 00 00 00' + '97 03 00 00 14 03 00 00 01 03 00 00 45 03 00 00 9E 1F 00 00 04 00 00 00 97 03 00 00 13 03 00 00' + '42 03 00 00 45 03 00 00 9F 1F 00 00 04 00 00 00 97 03 00 00 14 03 00 00 42 03 00 00 45 03 00 00' + 'A0 1F 00 00 03 00 00 00 C9 03 00 00 13 03 00 00 45 03 00 00 A1 1F 00 00 03 00 00 00 C9 03 00 00' + '14 03 00 00 45 03 00 00 A2 1F 00 00 04 00 00 00 C9 03 00 00 13 03 00 00 00 03 00 00 45 03 00 00' + 'A3 1F 00 00 04 00 00 00 C9 03 00 00 14 03 00 00 00 03 00 00 45 03 00 00 A4 1F 00 00 04 00 00 00' + 'C9 03 00 00 13 03 00 00 01 03 00 00 45 03 00 00 A5 1F 00 00 04 00 00 00 C9 03 00 00 14 03 00 00' + '01 03 00 00 45 03 00 00 A6 1F 00 00 04 00 00 00 C9 03 00 00 13 03 00 00 42 03 00 00 45 03 00 00' + 'A7 1F 00 00 04 00 00 00 C9 03 00 00 14 03 00 00 42 03 00 00 45 03 00 00 A8 1F 00 00 03 00 00 00' + 'A9 03 00 00 13 03 00 00 45 03 00 00 A9 1F 00 00 03 00 00 00 A9 03 00 00 14 03 00 00 45 03 00 00' + 'AA 1F 00 00 04 00 00 00 A9 03 00 00 13 03 00 00 00 03 00 00 45 03 00 00 AB 1F 00 00 04 00 00 00' + 'A9 03 00 00 14 03 00 00 00 03 00 00 45 03 00 00 AC 1F 00 00 04 00 00 00 A9 03 00 00 13 03 00 00' + '01 03 00 00 45 03 00 00 AD 1F 00 00 04 00 00 00 A9 03 00 00 14 03 00 00 01 03 00 00 45 03 00 00' + 'AE 1F 00 00 04 00 00 00 A9 03 00 00 13 03 00 00 42 03 00 00 45 03 00 00 AF 1F 00 00 04 00 00 00' + 'A9 03 00 00 14 03 00 00 42 03 00 00 45 03 00 00 B0 1F 00 00 02 00 00 00 B1 03 00 00 06 03 00 00' + 'B1 1F 00 00 02 00 00 00 B1 03 00 00 04 03 00 00 B2 1F 00 00 03 00 00 00 B1 03 00 00 00 03 00 00' + '45 03 00 00 B3 1F 00 00 02 00 00 00 B1 03 00 00 45 03 00 00 B4 1F 00 00 03 00 00 00 B1 03 00 00' + '01 03 00 00 45 03 00 00 B6 1F 00 00 02 00 00 00 B1 03 00 00 42 03 00 00 B7 1F 00 00 03 00 00 00' + 'B1 03 00 00 42 03 00 00 45 03 00 00 B8 1F 00 00 02 00 00 00 91 03 00 00 06 03 00 00 B9 1F 00 00' + '02 00 00 00 91 03 00 00 04 03 00 00 BA 1F 00 00 02 00 00 00 91 03 00 00 00 03 00 00 BC 1F 00 00' + '02 00 00 00 91 03 00 00 45 03 00 00 C1 1F 00 00 02 00 00 00 A8 00 00 00 42 03 00 00 C2 1F 00 00' + '03 00 00 00 B7 03 00 00 00 03 00 00 45 03 00 00 C3 1F 00 00 02 00 00 00 B7 03 00 00 45 03 00 00' + 'C4 1F 00 00 03 00 00 00 B7 03 00 00 01 03 00 00 45 03 00 00 C6 1F 00 00 02 00 00 00 B7 03 00 00' + '42 03 00 00 C7 1F 00 00 03 00 00 00 B7 03 00 00 42 03 00 00 45 03 00 00 C8 1F 00 00 02 00 00 00' + '95 03 00 00 00 03 00 00 CA 1F 00 00 02 00 00 00 97 03 00 00 00 03 00 00 CC 1F 00 00 02 00 00 00' + '97 03 00 00 45 03 00 00 CD 1F 00 00 02 00 00 00 BF 1F 00 00 00 03 00 00 CE 1F 00 00 02 00 00 00' + 'BF 1F 00 00 01 03 00 00 CF 1F 00 00 02 00 00 00 BF 1F 00 00 42 03 00 00 D0 1F 00 00 02 00 00 00' + 'B9 03 00 00 06 03 00 00 D1 1F 00 00 02 00 00 00 B9 03 00 00 04 03 00 00 D2 1F 00 00 03 00 00 00' + 'B9 03 00 00 08 03 00 00 00 03 00 00 D6 1F 00 00 02 00 00 00 B9 03 00 00 42 03 00 00 D7 1F 00 00' + '03 00 00 00 B9 03 00 00 08 03 00 00 42 03 00 00 D8 1F 00 00 02 00 00 00 99 03 00 00 06 03 00 00' + 'D9 1F 00 00 02 00 00 00 99 03 00 00 04 03 00 00 DA 1F 00 00 02 00 00 00 99 03 00 00 00 03 00 00' + 'DD 1F 00 00 02 00 00 00 FE 1F 00 00 00 03 00 00 DE 1F 00 00 02 00 00 00 FE 1F 00 00 01 03 00 00' + 'DF 1F 00 00 02 00 00 00 FE 1F 00 00 42 03 00 00 E0 1F 00 00 02 00 00 00 C5 03 00 00 06 03 00 00' + 'E1 1F 00 00 02 00 00 00 C5 03 00 00 04 03 00 00 E2 1F 00 00 03 00 00 00 C5 03 00 00 08 03 00 00' + '00 03 00 00 E4 1F 00 00 02 00 00 00 C1 03 00 00 13 03 00 00 E5 1F 00 00 02 00 00 00 C1 03 00 00' + '14 03 00 00 E6 1F 00 00 02 00 00 00 C5 03 00 00 42 03 00 00 E7 1F 00 00 03 00 00 00 C5 03 00 00' + '08 03 00 00 42 03 00 00 E8 1F 00 00 02 00 00 00 A5 03 00 00 06 03 00 00 E9 1F 00 00 02 00 00 00' + 'A5 03 00 00 04 03 00 00 EA 1F 00 00 02 00 00 00 A5 03 00 00 00 03 00 00 EC 1F 00 00 02 00 00 00' + 'A1 03 00 00 14 03 00 00 ED 1F 00 00 02 00 00 00 A8 00 00 00 00 03 00 00 F2 1F 00 00 03 00 00 00' + 'C9 03 00 00 00 03 00 00 45 03 00 00 F3 1F 00 00 02 00 00 00 C9 03 00 00 45 03 00 00 F4 1F 00 00' + '03 00 00 00 C9 03 00 00 01 03 00 00 45 03 00 00 F6 1F 00 00 02 00 00 00 C9 03 00 00 42 03 00 00' + 'F7 1F 00 00 03 00 00 00 C9 03 00 00 42 03 00 00 45 03 00 00 F8 1F 00 00 02 00 00 00 9F 03 00 00' + '00 03 00 00 FA 1F 00 00 02 00 00 00 A9 03 00 00 00 03 00 00 FC 1F 00 00 02 00 00 00 A9 03 00 00' + '45 03 00 00 9A 21 00 00 02 00 00 00 90 21 00 00 38 03 00 00 9B 21 00 00 02 00 00 00 92 21 00 00' + '38 03 00 00 AE 21 00 00 02 00 00 00 94 21 00 00 38 03 00 00 CD 21 00 00 02 00 00 00 D0 21 00 00' + '38 03 00 00 CE 21 00 00 02 00 00 00 D4 21 00 00 38 03 00 00 CF 21 00 00 02 00 00 00 D2 21 00 00' + '38 03 00 00 04 22 00 00 02 00 00 00 03 22 00 00 38 03 00 00 09 22 00 00 02 00 00 00 08 22 00 00' + '38 03 00 00 0C 22 00 00 02 00 00 00 0B 22 00 00 38 03 00 00 24 22 00 00 02 00 00 00 23 22 00 00' + '38 03 00 00 26 22 00 00 02 00 00 00 25 22 00 00 38 03 00 00 41 22 00 00 02 00 00 00 3C 22 00 00' + '38 03 00 00 44 22 00 00 02 00 00 00 43 22 00 00 38 03 00 00 47 22 00 00 02 00 00 00 45 22 00 00' + '38 03 00 00 49 22 00 00 02 00 00 00 48 22 00 00 38 03 00 00 60 22 00 00 02 00 00 00 3D 00 00 00' + '38 03 00 00 62 22 00 00 02 00 00 00 61 22 00 00 38 03 00 00 6D 22 00 00 02 00 00 00 4D 22 00 00' + '38 03 00 00 6E 22 00 00 02 00 00 00 3C 00 00 00 38 03 00 00 6F 22 00 00 02 00 00 00 3E 00 00 00' + '38 03 00 00 70 22 00 00 02 00 00 00 64 22 00 00 38 03 00 00 71 22 00 00 02 00 00 00 65 22 00 00' + '38 03 00 00 74 22 00 00 02 00 00 00 72 22 00 00 38 03 00 00 75 22 00 00 02 00 00 00 73 22 00 00' + '38 03 00 00 78 22 00 00 02 00 00 00 76 22 00 00 38 03 00 00 79 22 00 00 02 00 00 00 77 22 00 00' + '38 03 00 00 80 22 00 00 02 00 00 00 7A 22 00 00 38 03 00 00 81 22 00 00 02 00 00 00 7B 22 00 00' + '38 03 00 00 84 22 00 00 02 00 00 00 82 22 00 00 38 03 00 00 85 22 00 00 02 00 00 00 83 22 00 00' + '38 03 00 00 88 22 00 00 02 00 00 00 86 22 00 00 38 03 00 00 89 22 00 00 02 00 00 00 87 22 00 00' + '38 03 00 00 AC 22 00 00 02 00 00 00 A2 22 00 00 38 03 00 00 AD 22 00 00 02 00 00 00 A8 22 00 00' + '38 03 00 00 AE 22 00 00 02 00 00 00 A9 22 00 00 38 03 00 00 AF 22 00 00 02 00 00 00 AB 22 00 00' + '38 03 00 00 E0 22 00 00 02 00 00 00 7C 22 00 00 38 03 00 00 E1 22 00 00 02 00 00 00 7D 22 00 00' + '38 03 00 00 E2 22 00 00 02 00 00 00 91 22 00 00 38 03 00 00 E3 22 00 00 02 00 00 00 92 22 00 00' + '38 03 00 00 EA 22 00 00 02 00 00 00 B2 22 00 00 38 03 00 00 EB 22 00 00 02 00 00 00 B3 22 00 00' + '38 03 00 00 EC 22 00 00 02 00 00 00 B4 22 00 00 38 03 00 00 ED 22 00 00 02 00 00 00 B5 22 00 00' + '38 03 00 00 4C 30 00 00 02 00 00 00 4B 30 00 00 99 30 00 00 4E 30 00 00 02 00 00 00 4D 30 00 00' + '99 30 00 00 50 30 00 00 02 00 00 00 4F 30 00 00 99 30 00 00 52 30 00 00 02 00 00 00 51 30 00 00' + '99 30 00 00 54 30 00 00 02 00 00 00 53 30 00 00 99 30 00 00 56 30 00 00 02 00 00 00 55 30 00 00' + '99 30 00 00 58 30 00 00 02 00 00 00 57 30 00 00 99 30 00 00 5A 30 00 00 02 00 00 00 59 30 00 00' + '99 30 00 00 5C 30 00 00 02 00 00 00 5B 30 00 00 99 30 00 00 5E 30 00 00 02 00 00 00 5D 30 00 00' + '99 30 00 00 60 30 00 00 02 00 00 00 5F 30 00 00 99 30 00 00 62 30 00 00 02 00 00 00 61 30 00 00' + '99 30 00 00 65 30 00 00 02 00 00 00 64 30 00 00 99 30 00 00 67 30 00 00 02 00 00 00 66 30 00 00' + '99 30 00 00 69 30 00 00 02 00 00 00 68 30 00 00 99 30 00 00 70 30 00 00 02 00 00 00 6F 30 00 00' + '99 30 00 00 71 30 00 00 02 00 00 00 6F 30 00 00 9A 30 00 00 73 30 00 00 02 00 00 00 72 30 00 00' + '99 30 00 00 74 30 00 00 02 00 00 00 72 30 00 00 9A 30 00 00 76 30 00 00 02 00 00 00 75 30 00 00' + '99 30 00 00 77 30 00 00 02 00 00 00 75 30 00 00 9A 30 00 00 79 30 00 00 02 00 00 00 78 30 00 00' + '99 30 00 00 7A 30 00 00 02 00 00 00 78 30 00 00 9A 30 00 00 7C 30 00 00 02 00 00 00 7B 30 00 00' + '99 30 00 00 7D 30 00 00 02 00 00 00 7B 30 00 00 9A 30 00 00 94 30 00 00 02 00 00 00 46 30 00 00' + '99 30 00 00 9E 30 00 00 02 00 00 00 9D 30 00 00 99 30 00 00 AC 30 00 00 02 00 00 00 AB 30 00 00' + '99 30 00 00 AE 30 00 00 02 00 00 00 AD 30 00 00 99 30 00 00 B0 30 00 00 02 00 00 00 AF 30 00 00' + '99 30 00 00 B2 30 00 00 02 00 00 00 B1 30 00 00 99 30 00 00 B4 30 00 00 02 00 00 00 B3 30 00 00' + '99 30 00 00 B6 30 00 00 02 00 00 00 B5 30 00 00 99 30 00 00 B8 30 00 00 02 00 00 00 B7 30 00 00' + '99 30 00 00 BA 30 00 00 02 00 00 00 B9 30 00 00 99 30 00 00 BC 30 00 00 02 00 00 00 BB 30 00 00' + '99 30 00 00 BE 30 00 00 02 00 00 00 BD 30 00 00 99 30 00 00 C0 30 00 00 02 00 00 00 BF 30 00 00' + '99 30 00 00 C2 30 00 00 02 00 00 00 C1 30 00 00 99 30 00 00 C5 30 00 00 02 00 00 00 C4 30 00 00' + '99 30 00 00 C7 30 00 00 02 00 00 00 C6 30 00 00 99 30 00 00 C9 30 00 00 02 00 00 00 C8 30 00 00' + '99 30 00 00 D0 30 00 00 02 00 00 00 CF 30 00 00 99 30 00 00 D1 30 00 00 02 00 00 00 CF 30 00 00' + '9A 30 00 00 D3 30 00 00 02 00 00 00 D2 30 00 00 99 30 00 00 D4 30 00 00 02 00 00 00 D2 30 00 00' + '9A 30 00 00 D6 30 00 00 02 00 00 00 D5 30 00 00 99 30 00 00 D7 30 00 00 02 00 00 00 D5 30 00 00' + '9A 30 00 00 D9 30 00 00 02 00 00 00 D8 30 00 00 99 30 00 00 DA 30 00 00 02 00 00 00 D8 30 00 00' + '9A 30 00 00 DC 30 00 00 02 00 00 00 DB 30 00 00 99 30 00 00 DD 30 00 00 02 00 00 00 DB 30 00 00' + '9A 30 00 00 F4 30 00 00 02 00 00 00 A6 30 00 00 99 30 00 00 F7 30 00 00 02 00 00 00 EF 30 00 00' + '99 30 00 00 F8 30 00 00 02 00 00 00 F0 30 00 00 99 30 00 00 F9 30 00 00 02 00 00 00 F1 30 00 00' + '99 30 00 00 FA 30 00 00 02 00 00 00 F2 30 00 00 99 30 00 00 FE 30 00 00 02 00 00 00 FD 30 00 00' + '99 30 00 00 1D FB 00 00 02 00 00 00 D9 05 00 00 B4 05 00 00 1F FB 00 00 02 00 00 00 F2 05 00 00' + 'B7 05 00 00 2A FB 00 00 02 00 00 00 E9 05 00 00 C1 05 00 00 2B FB 00 00 02 00 00 00 E9 05 00 00' + 'C2 05 00 00 2C FB 00 00 03 00 00 00 E9 05 00 00 BC 05 00 00 C1 05 00 00 2D FB 00 00 03 00 00 00' + 'E9 05 00 00 BC 05 00 00 C2 05 00 00 2E FB 00 00 02 00 00 00 D0 05 00 00 B7 05 00 00 2F FB 00 00' + '02 00 00 00 D0 05 00 00 B8 05 00 00 30 FB 00 00 02 00 00 00 D0 05 00 00 BC 05 00 00 31 FB 00 00' + '02 00 00 00 D1 05 00 00 BC 05 00 00 32 FB 00 00 02 00 00 00 D2 05 00 00 BC 05 00 00 33 FB 00 00' + '02 00 00 00 D3 05 00 00 BC 05 00 00 34 FB 00 00 02 00 00 00 D4 05 00 00 BC 05 00 00 35 FB 00 00' + '02 00 00 00 D5 05 00 00 BC 05 00 00 36 FB 00 00 02 00 00 00 D6 05 00 00 BC 05 00 00 38 FB 00 00' + '02 00 00 00 D8 05 00 00 BC 05 00 00 39 FB 00 00 02 00 00 00 D9 05 00 00 BC 05 00 00 3A FB 00 00' + '02 00 00 00 DA 05 00 00 BC 05 00 00 3B FB 00 00 02 00 00 00 DB 05 00 00 BC 05 00 00 3C FB 00 00' + '02 00 00 00 DC 05 00 00 BC 05 00 00 3E FB 00 00 02 00 00 00 DE 05 00 00 BC 05 00 00 40 FB 00 00' + '02 00 00 00 E0 05 00 00 BC 05 00 00 41 FB 00 00 02 00 00 00 E1 05 00 00 BC 05 00 00 43 FB 00 00' + '02 00 00 00 E3 05 00 00 BC 05 00 00 44 FB 00 00 02 00 00 00 E4 05 00 00 BC 05 00 00 46 FB 00 00' + '02 00 00 00 E6 05 00 00 BC 05 00 00 47 FB 00 00 02 00 00 00 E7 05 00 00 BC 05 00 00 48 FB 00 00' + '02 00 00 00 E8 05 00 00 BC 05 00 00 49 FB 00 00 02 00 00 00 E9 05 00 00 BC 05 00 00 4A FB 00 00' + '02 00 00 00 EA 05 00 00 BC 05 00 00 4B FB 00 00 02 00 00 00 D5 05 00 00 B9 05 00 00 4C FB 00 00' + '02 00 00 00 D1 05 00 00 BF 05 00 00 4D FB 00 00 02 00 00 00 DB 05 00 00 BF 05 00 00 4E FB 00 00' + '02 00 00 00 E4 05 00 00 BF 05 00 00' +} + + +COMBINING UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '01 00 00 00 03 00 00 00 34 03 00 00 38 03 00 00 D2 20 00 00 D3 20 00 00 D8 20 00 00 DA 20 00 00' + '07 00 00 00 06 00 00 00 3C 09 00 00 3C 09 00 00 BC 09 00 00 BC 09 00 00 3C 0A 00 00 3C 0A 00 00' + 'BC 0A 00 00 BC 0A 00 00 3C 0B 00 00 3C 0B 00 00 37 10 00 00 37 10 00 00 08 00 00 00 01 00 00 00' + '99 30 00 00 9A 30 00 00 09 00 00 00 0E 00 00 00 4D 09 00 00 4D 09 00 00 CD 09 00 00 CD 09 00 00' + '4D 0A 00 00 4D 0A 00 00 CD 0A 00 00 CD 0A 00 00 4D 0B 00 00 4D 0B 00 00 CD 0B 00 00 CD 0B 00 00' + '4D 0C 00 00 4D 0C 00 00 CD 0C 00 00 CD 0C 00 00 4D 0D 00 00 4D 0D 00 00 CA 0D 00 00 CA 0D 00 00' + '3A 0E 00 00 3A 0E 00 00 84 0F 00 00 84 0F 00 00 39 10 00 00 39 10 00 00 D2 17 00 00 D2 17 00 00' + '0A 00 00 00 01 00 00 00 B0 05 00 00 B0 05 00 00 0B 00 00 00 01 00 00 00 B1 05 00 00 B1 05 00 00' + '0C 00 00 00 01 00 00 00 B2 05 00 00 B2 05 00 00 0D 00 00 00 01 00 00 00 B3 05 00 00 B3 05 00 00' + '0E 00 00 00 01 00 00 00 B4 05 00 00 B4 05 00 00 0F 00 00 00 01 00 00 00 B5 05 00 00 B5 05 00 00' + '10 00 00 00 01 00 00 00 B6 05 00 00 B6 05 00 00 11 00 00 00 01 00 00 00 B7 05 00 00 B7 05 00 00' + '12 00 00 00 01 00 00 00 B8 05 00 00 B8 05 00 00 13 00 00 00 01 00 00 00 B9 05 00 00 B9 05 00 00' + '14 00 00 00 01 00 00 00 BB 05 00 00 BB 05 00 00 15 00 00 00 01 00 00 00 BC 05 00 00 BC 05 00 00' + '16 00 00 00 01 00 00 00 BD 05 00 00 BD 05 00 00 17 00 00 00 01 00 00 00 BF 05 00 00 BF 05 00 00' + '18 00 00 00 01 00 00 00 C1 05 00 00 C1 05 00 00 19 00 00 00 01 00 00 00 C2 05 00 00 C2 05 00 00' + '1A 00 00 00 01 00 00 00 1E FB 00 00 1E FB 00 00 1B 00 00 00 01 00 00 00 4B 06 00 00 4B 06 00 00' + '1C 00 00 00 01 00 00 00 4C 06 00 00 4C 06 00 00 1D 00 00 00 01 00 00 00 4D 06 00 00 4D 06 00 00' + '1E 00 00 00 01 00 00 00 4E 06 00 00 4E 06 00 00 1F 00 00 00 01 00 00 00 4F 06 00 00 4F 06 00 00' + '20 00 00 00 01 00 00 00 50 06 00 00 50 06 00 00 21 00 00 00 01 00 00 00 51 06 00 00 51 06 00 00' + '22 00 00 00 01 00 00 00 52 06 00 00 52 06 00 00 23 00 00 00 01 00 00 00 70 06 00 00 70 06 00 00' + '24 00 00 00 01 00 00 00 11 07 00 00 11 07 00 00 54 00 00 00 01 00 00 00 55 0C 00 00 55 0C 00 00' + '5B 00 00 00 01 00 00 00 56 0C 00 00 56 0C 00 00 67 00 00 00 01 00 00 00 38 0E 00 00 39 0E 00 00' + '6B 00 00 00 01 00 00 00 48 0E 00 00 4B 0E 00 00 76 00 00 00 01 00 00 00 B8 0E 00 00 B9 0E 00 00' + '7A 00 00 00 01 00 00 00 C8 0E 00 00 CB 0E 00 00 81 00 00 00 01 00 00 00 71 0F 00 00 71 0F 00 00' + '82 00 00 00 03 00 00 00 72 0F 00 00 72 0F 00 00 7A 0F 00 00 7D 0F 00 00 80 0F 00 00 80 0F 00 00' + '84 00 00 00 01 00 00 00 74 0F 00 00 74 0F 00 00 CA 00 00 00 02 00 00 00 21 03 00 00 22 03 00 00' + '27 03 00 00 28 03 00 00 D8 00 00 00 02 00 00 00 1B 03 00 00 1B 03 00 00 39 0F 00 00 39 0F 00 00' + 'DA 00 00 00 01 00 00 00 2A 30 00 00 2A 30 00 00 DC 00 00 00 1E 00 00 00 16 03 00 00 19 03 00 00' + '1C 03 00 00 20 03 00 00 23 03 00 00 26 03 00 00 29 03 00 00 33 03 00 00 39 03 00 00 3C 03 00 00' + '47 03 00 00 49 03 00 00 4D 03 00 00 4E 03 00 00 91 05 00 00 91 05 00 00 96 05 00 00 96 05 00 00' + '9B 05 00 00 9B 05 00 00 A3 05 00 00 A7 05 00 00 AA 05 00 00 AA 05 00 00 55 06 00 00 55 06 00 00' + 'E3 06 00 00 E3 06 00 00 EA 06 00 00 EA 06 00 00 ED 06 00 00 ED 06 00 00 31 07 00 00 31 07 00 00' + '34 07 00 00 34 07 00 00 37 07 00 00 39 07 00 00 3B 07 00 00 3C 07 00 00 3E 07 00 00 3E 07 00 00' + '42 07 00 00 42 07 00 00 44 07 00 00 44 07 00 00 46 07 00 00 46 07 00 00 48 07 00 00 48 07 00 00' + '52 09 00 00 52 09 00 00 18 0F 00 00 19 0F 00 00 35 0F 00 00 35 0F 00 00 37 0F 00 00 37 0F 00 00' + 'C6 0F 00 00 C6 0F 00 00 DE 00 00 00 03 00 00 00 9A 05 00 00 9A 05 00 00 AD 05 00 00 AD 05 00 00' + '2D 30 00 00 2D 30 00 00 E0 00 00 00 01 00 00 00 2E 30 00 00 2F 30 00 00 E4 00 00 00 03 00 00 00' + 'AE 05 00 00 AE 05 00 00 A9 18 00 00 A9 18 00 00 2B 30 00 00 2B 30 00 00 E6 00 00 00 25 00 00 00' + '00 03 00 00 14 03 00 00 3D 03 00 00 44 03 00 00 46 03 00 00 46 03 00 00 4A 03 00 00 4C 03 00 00' + '83 04 00 00 86 04 00 00 92 05 00 00 95 05 00 00 97 05 00 00 99 05 00 00 9C 05 00 00 A1 05 00 00' + 'A8 05 00 00 A9 05 00 00 AB 05 00 00 AC 05 00 00 AF 05 00 00 AF 05 00 00 C4 05 00 00 C4 05 00 00' + '53 06 00 00 54 06 00 00 D6 06 00 00 DC 06 00 00 DF 06 00 00 E2 06 00 00 E4 06 00 00 E4 06 00 00' + 'E7 06 00 00 E8 06 00 00 EB 06 00 00 EC 06 00 00 30 07 00 00 30 07 00 00 32 07 00 00 33 07 00 00' + '35 07 00 00 36 07 00 00 3A 07 00 00 3A 07 00 00 3D 07 00 00 3D 07 00 00 3F 07 00 00 41 07 00 00' + '43 07 00 00 43 07 00 00 45 07 00 00 45 07 00 00 47 07 00 00 47 07 00 00 49 07 00 00 4A 07 00 00' + '51 09 00 00 51 09 00 00 53 09 00 00 54 09 00 00 82 0F 00 00 83 0F 00 00 86 0F 00 00 87 0F 00 00' + 'D0 20 00 00 D1 20 00 00 D4 20 00 00 D7 20 00 00 DB 20 00 00 DC 20 00 00 E1 20 00 00 E1 20 00 00' + '20 FE 00 00 23 FE 00 00 E8 00 00 00 03 00 00 00 15 03 00 00 15 03 00 00 1A 03 00 00 1A 03 00 00' + '2C 30 00 00 2C 30 00 00 E9 00 00 00 01 00 00 00 62 03 00 00 62 03 00 00 EA 00 00 00 01 00 00 00' + '60 03 00 00 61 03 00 00 F0 00 00 00 01 00 00 00 45 03 00 00 45 03 00 00' +} + + +NUMBERS UNICODEDATA LOADONCALL MOVEABLE DISCARDABLE +{ + '39 00 00 00 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 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 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 03 00 00 00 02 00 00 00' + '03 00 00 00 01 00 00 00 05 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 01 00 00 00 08 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 0D 00 00 00 01 00 00 00 0E 00 00 00' + '01 00 00 00 0F 00 00 00 01 00 00 00 AD 01 00 00 30 00 00 00 00 00 00 00 31 00 00 00 01 00 00 00' + '32 00 00 00 02 00 00 00 33 00 00 00 03 00 00 00 34 00 00 00 04 00 00 00 35 00 00 00 05 00 00 00' + '36 00 00 00 06 00 00 00 37 00 00 00 07 00 00 00 38 00 00 00 08 00 00 00 39 00 00 00 09 00 00 00' + 'B2 00 00 00 02 00 00 00 B3 00 00 00 03 00 00 00 B9 00 00 00 01 00 00 00 BC 00 00 00 0A 00 00 00' + 'BD 00 00 00 0B 00 00 00 BE 00 00 00 0C 00 00 00 60 06 00 00 00 00 00 00 61 06 00 00 01 00 00 00' + '62 06 00 00 02 00 00 00 63 06 00 00 03 00 00 00 64 06 00 00 04 00 00 00 65 06 00 00 05 00 00 00' + '66 06 00 00 06 00 00 00 67 06 00 00 07 00 00 00 68 06 00 00 08 00 00 00 69 06 00 00 09 00 00 00' + 'F0 06 00 00 00 00 00 00 F1 06 00 00 01 00 00 00 F2 06 00 00 02 00 00 00 F3 06 00 00 03 00 00 00' + 'F4 06 00 00 04 00 00 00 F5 06 00 00 05 00 00 00 F6 06 00 00 06 00 00 00 F7 06 00 00 07 00 00 00' + 'F8 06 00 00 08 00 00 00 F9 06 00 00 09 00 00 00 66 09 00 00 00 00 00 00 67 09 00 00 01 00 00 00' + '68 09 00 00 02 00 00 00 69 09 00 00 03 00 00 00 6A 09 00 00 04 00 00 00 6B 09 00 00 05 00 00 00' + '6C 09 00 00 06 00 00 00 6D 09 00 00 07 00 00 00 6E 09 00 00 08 00 00 00 6F 09 00 00 09 00 00 00' + 'E6 09 00 00 00 00 00 00 E7 09 00 00 01 00 00 00 E8 09 00 00 02 00 00 00 E9 09 00 00 03 00 00 00' + 'EA 09 00 00 04 00 00 00 EB 09 00 00 05 00 00 00 EC 09 00 00 06 00 00 00 ED 09 00 00 07 00 00 00' + 'EE 09 00 00 08 00 00 00 EF 09 00 00 09 00 00 00 F4 09 00 00 01 00 00 00 F5 09 00 00 02 00 00 00' + 'F6 09 00 00 03 00 00 00 F7 09 00 00 04 00 00 00 F9 09 00 00 0D 00 00 00 66 0A 00 00 00 00 00 00' + '67 0A 00 00 01 00 00 00 68 0A 00 00 02 00 00 00 69 0A 00 00 03 00 00 00 6A 0A 00 00 04 00 00 00' + '6B 0A 00 00 05 00 00 00 6C 0A 00 00 06 00 00 00 6D 0A 00 00 07 00 00 00 6E 0A 00 00 08 00 00 00' + '6F 0A 00 00 09 00 00 00 E6 0A 00 00 00 00 00 00 E7 0A 00 00 01 00 00 00 E8 0A 00 00 02 00 00 00' + 'E9 0A 00 00 03 00 00 00 EA 0A 00 00 04 00 00 00 EB 0A 00 00 05 00 00 00 EC 0A 00 00 06 00 00 00' + 'ED 0A 00 00 07 00 00 00 EE 0A 00 00 08 00 00 00 EF 0A 00 00 09 00 00 00 66 0B 00 00 00 00 00 00' + '67 0B 00 00 01 00 00 00 68 0B 00 00 02 00 00 00 69 0B 00 00 03 00 00 00 6A 0B 00 00 04 00 00 00' + '6B 0B 00 00 05 00 00 00 6C 0B 00 00 06 00 00 00 6D 0B 00 00 07 00 00 00 6E 0B 00 00 08 00 00 00' + '6F 0B 00 00 09 00 00 00 E7 0B 00 00 01 00 00 00 E8 0B 00 00 02 00 00 00 E9 0B 00 00 03 00 00 00' + 'EA 0B 00 00 04 00 00 00 EB 0B 00 00 05 00 00 00 EC 0B 00 00 06 00 00 00 ED 0B 00 00 07 00 00 00' + 'EE 0B 00 00 08 00 00 00 EF 0B 00 00 09 00 00 00 F0 0B 00 00 0E 00 00 00 F1 0B 00 00 0F 00 00 00' + 'F2 0B 00 00 10 00 00 00 66 0C 00 00 00 00 00 00 67 0C 00 00 01 00 00 00 68 0C 00 00 02 00 00 00' + '69 0C 00 00 03 00 00 00 6A 0C 00 00 04 00 00 00 6B 0C 00 00 05 00 00 00 6C 0C 00 00 06 00 00 00' + '6D 0C 00 00 07 00 00 00 6E 0C 00 00 08 00 00 00 6F 0C 00 00 09 00 00 00 E6 0C 00 00 00 00 00 00' + 'E7 0C 00 00 01 00 00 00 E8 0C 00 00 02 00 00 00 E9 0C 00 00 03 00 00 00 EA 0C 00 00 04 00 00 00' + 'EB 0C 00 00 05 00 00 00 EC 0C 00 00 06 00 00 00 ED 0C 00 00 07 00 00 00 EE 0C 00 00 08 00 00 00' + 'EF 0C 00 00 09 00 00 00 66 0D 00 00 00 00 00 00 67 0D 00 00 01 00 00 00 68 0D 00 00 02 00 00 00' + '69 0D 00 00 03 00 00 00 6A 0D 00 00 04 00 00 00 6B 0D 00 00 05 00 00 00 6C 0D 00 00 06 00 00 00' + '6D 0D 00 00 07 00 00 00 6E 0D 00 00 08 00 00 00 6F 0D 00 00 09 00 00 00 50 0E 00 00 00 00 00 00' + '51 0E 00 00 01 00 00 00 52 0E 00 00 02 00 00 00 53 0E 00 00 03 00 00 00 54 0E 00 00 04 00 00 00' + '55 0E 00 00 05 00 00 00 56 0E 00 00 06 00 00 00 57 0E 00 00 07 00 00 00 58 0E 00 00 08 00 00 00' + '59 0E 00 00 09 00 00 00 D0 0E 00 00 00 00 00 00 D1 0E 00 00 01 00 00 00 D2 0E 00 00 02 00 00 00' + 'D3 0E 00 00 03 00 00 00 D4 0E 00 00 04 00 00 00 D5 0E 00 00 05 00 00 00 D6 0E 00 00 06 00 00 00' + 'D7 0E 00 00 07 00 00 00 D8 0E 00 00 08 00 00 00 D9 0E 00 00 09 00 00 00 20 0F 00 00 00 00 00 00' + '21 0F 00 00 01 00 00 00 22 0F 00 00 02 00 00 00 23 0F 00 00 03 00 00 00 24 0F 00 00 04 00 00 00' + '25 0F 00 00 05 00 00 00 26 0F 00 00 06 00 00 00 27 0F 00 00 07 00 00 00 28 0F 00 00 08 00 00 00' + '29 0F 00 00 09 00 00 00 2A 0F 00 00 0B 00 00 00 2B 0F 00 00 11 00 00 00 2C 0F 00 00 12 00 00 00' + '2D 0F 00 00 13 00 00 00 2E 0F 00 00 14 00 00 00 2F 0F 00 00 15 00 00 00 30 0F 00 00 16 00 00 00' + '31 0F 00 00 17 00 00 00 32 0F 00 00 18 00 00 00 33 0F 00 00 19 00 00 00 40 10 00 00 00 00 00 00' + '41 10 00 00 01 00 00 00 42 10 00 00 02 00 00 00 43 10 00 00 03 00 00 00 44 10 00 00 04 00 00 00' + '45 10 00 00 05 00 00 00 46 10 00 00 06 00 00 00 47 10 00 00 07 00 00 00 48 10 00 00 08 00 00 00' + '49 10 00 00 09 00 00 00 69 13 00 00 01 00 00 00 6A 13 00 00 02 00 00 00 6B 13 00 00 03 00 00 00' + '6C 13 00 00 04 00 00 00 6D 13 00 00 05 00 00 00 6E 13 00 00 06 00 00 00 6F 13 00 00 07 00 00 00' + '70 13 00 00 08 00 00 00 71 13 00 00 09 00 00 00 72 13 00 00 0E 00 00 00 73 13 00 00 1A 00 00 00' + '74 13 00 00 1B 00 00 00 75 13 00 00 1C 00 00 00 76 13 00 00 1D 00 00 00 77 13 00 00 1E 00 00 00' + '78 13 00 00 1F 00 00 00 79 13 00 00 20 00 00 00 7A 13 00 00 21 00 00 00 7B 13 00 00 0F 00 00 00' + '7C 13 00 00 22 00 00 00 EE 16 00 00 23 00 00 00 EF 16 00 00 24 00 00 00 F0 16 00 00 25 00 00 00' + 'E0 17 00 00 00 00 00 00 E1 17 00 00 01 00 00 00 E2 17 00 00 02 00 00 00 E3 17 00 00 03 00 00 00' + 'E4 17 00 00 04 00 00 00 E5 17 00 00 05 00 00 00 E6 17 00 00 06 00 00 00 E7 17 00 00 07 00 00 00' + 'E8 17 00 00 08 00 00 00 E9 17 00 00 09 00 00 00 10 18 00 00 00 00 00 00 11 18 00 00 01 00 00 00' + '12 18 00 00 02 00 00 00 13 18 00 00 03 00 00 00 14 18 00 00 04 00 00 00 15 18 00 00 05 00 00 00' + '16 18 00 00 06 00 00 00 17 18 00 00 07 00 00 00 18 18 00 00 08 00 00 00 19 18 00 00 09 00 00 00' + '70 20 00 00 00 00 00 00 74 20 00 00 04 00 00 00 75 20 00 00 05 00 00 00 76 20 00 00 06 00 00 00' + '77 20 00 00 07 00 00 00 78 20 00 00 08 00 00 00 79 20 00 00 09 00 00 00 80 20 00 00 00 00 00 00' + '81 20 00 00 01 00 00 00 82 20 00 00 02 00 00 00 83 20 00 00 03 00 00 00 84 20 00 00 04 00 00 00' + '85 20 00 00 05 00 00 00 86 20 00 00 06 00 00 00 87 20 00 00 07 00 00 00 88 20 00 00 08 00 00 00' + '89 20 00 00 09 00 00 00 53 21 00 00 26 00 00 00 54 21 00 00 27 00 00 00 55 21 00 00 28 00 00 00' + '56 21 00 00 29 00 00 00 57 21 00 00 2A 00 00 00 58 21 00 00 2B 00 00 00 59 21 00 00 2C 00 00 00' + '5A 21 00 00 2D 00 00 00 5B 21 00 00 2E 00 00 00 5C 21 00 00 2F 00 00 00 5D 21 00 00 30 00 00 00' + '5E 21 00 00 31 00 00 00 5F 21 00 00 01 00 00 00 60 21 00 00 01 00 00 00 61 21 00 00 02 00 00 00' + '62 21 00 00 03 00 00 00 63 21 00 00 04 00 00 00 64 21 00 00 05 00 00 00 65 21 00 00 06 00 00 00' + '66 21 00 00 07 00 00 00 67 21 00 00 08 00 00 00 68 21 00 00 09 00 00 00 69 21 00 00 0E 00 00 00' + '6A 21 00 00 32 00 00 00 6B 21 00 00 33 00 00 00 6C 21 00 00 1D 00 00 00 6D 21 00 00 0F 00 00 00' + '6E 21 00 00 34 00 00 00 6F 21 00 00 10 00 00 00 70 21 00 00 01 00 00 00 71 21 00 00 02 00 00 00' + '72 21 00 00 03 00 00 00 73 21 00 00 04 00 00 00 74 21 00 00 05 00 00 00 75 21 00 00 06 00 00 00' + '76 21 00 00 07 00 00 00 77 21 00 00 08 00 00 00 78 21 00 00 09 00 00 00 79 21 00 00 0E 00 00 00' + '7A 21 00 00 32 00 00 00 7B 21 00 00 33 00 00 00 7C 21 00 00 1D 00 00 00 7D 21 00 00 0F 00 00 00' + '7E 21 00 00 34 00 00 00 7F 21 00 00 10 00 00 00 80 21 00 00 10 00 00 00 81 21 00 00 35 00 00 00' + '82 21 00 00 22 00 00 00 60 24 00 00 01 00 00 00 61 24 00 00 02 00 00 00 62 24 00 00 03 00 00 00' + '63 24 00 00 04 00 00 00 64 24 00 00 05 00 00 00 65 24 00 00 06 00 00 00 66 24 00 00 07 00 00 00' + '67 24 00 00 08 00 00 00 68 24 00 00 09 00 00 00 69 24 00 00 0E 00 00 00 6A 24 00 00 32 00 00 00' + '6B 24 00 00 33 00 00 00 6C 24 00 00 36 00 00 00 6D 24 00 00 37 00 00 00 6E 24 00 00 38 00 00 00' + '6F 24 00 00 0D 00 00 00 70 24 00 00 23 00 00 00 71 24 00 00 24 00 00 00 72 24 00 00 25 00 00 00' + '73 24 00 00 1A 00 00 00 74 24 00 00 01 00 00 00 75 24 00 00 02 00 00 00 76 24 00 00 03 00 00 00' + '77 24 00 00 04 00 00 00 78 24 00 00 05 00 00 00 79 24 00 00 06 00 00 00 7A 24 00 00 07 00 00 00' + '7B 24 00 00 08 00 00 00 7C 24 00 00 09 00 00 00 7D 24 00 00 0E 00 00 00 7E 24 00 00 32 00 00 00' + '7F 24 00 00 33 00 00 00 80 24 00 00 36 00 00 00 81 24 00 00 37 00 00 00 82 24 00 00 38 00 00 00' + '83 24 00 00 0D 00 00 00 84 24 00 00 23 00 00 00 85 24 00 00 24 00 00 00 86 24 00 00 25 00 00 00' + '87 24 00 00 1A 00 00 00 88 24 00 00 01 00 00 00 89 24 00 00 02 00 00 00 8A 24 00 00 03 00 00 00' + '8B 24 00 00 04 00 00 00 8C 24 00 00 05 00 00 00 8D 24 00 00 06 00 00 00 8E 24 00 00 07 00 00 00' + '8F 24 00 00 08 00 00 00 90 24 00 00 09 00 00 00 91 24 00 00 0E 00 00 00 92 24 00 00 32 00 00 00' + '93 24 00 00 33 00 00 00 94 24 00 00 36 00 00 00 95 24 00 00 37 00 00 00 96 24 00 00 38 00 00 00' + '97 24 00 00 0D 00 00 00 98 24 00 00 23 00 00 00 99 24 00 00 24 00 00 00 9A 24 00 00 25 00 00 00' + '9B 24 00 00 1A 00 00 00 EA 24 00 00 00 00 00 00 76 27 00 00 01 00 00 00 77 27 00 00 02 00 00 00' + '78 27 00 00 03 00 00 00 79 27 00 00 04 00 00 00 7A 27 00 00 05 00 00 00 7B 27 00 00 06 00 00 00' + '7C 27 00 00 07 00 00 00 7D 27 00 00 08 00 00 00 7E 27 00 00 09 00 00 00 7F 27 00 00 0E 00 00 00' + '80 27 00 00 01 00 00 00 81 27 00 00 02 00 00 00 82 27 00 00 03 00 00 00 83 27 00 00 04 00 00 00' + '84 27 00 00 05 00 00 00 85 27 00 00 06 00 00 00 86 27 00 00 07 00 00 00 87 27 00 00 08 00 00 00' + '88 27 00 00 09 00 00 00 89 27 00 00 0E 00 00 00 8A 27 00 00 01 00 00 00 8B 27 00 00 02 00 00 00' + '8C 27 00 00 03 00 00 00 8D 27 00 00 04 00 00 00 8E 27 00 00 05 00 00 00 8F 27 00 00 06 00 00 00' + '90 27 00 00 07 00 00 00 91 27 00 00 08 00 00 00 92 27 00 00 09 00 00 00 93 27 00 00 0E 00 00 00' + '07 30 00 00 00 00 00 00 21 30 00 00 01 00 00 00 22 30 00 00 02 00 00 00 23 30 00 00 03 00 00 00' + '24 30 00 00 04 00 00 00 25 30 00 00 05 00 00 00 26 30 00 00 06 00 00 00 27 30 00 00 07 00 00 00' + '28 30 00 00 08 00 00 00 29 30 00 00 09 00 00 00 38 30 00 00 0E 00 00 00 39 30 00 00 1A 00 00 00' + '3A 30 00 00 1B 00 00 00 92 31 00 00 01 00 00 00 93 31 00 00 02 00 00 00 94 31 00 00 03 00 00 00' + '95 31 00 00 04 00 00 00 20 32 00 00 01 00 00 00 21 32 00 00 02 00 00 00 22 32 00 00 03 00 00 00' + '23 32 00 00 04 00 00 00 24 32 00 00 05 00 00 00 25 32 00 00 06 00 00 00 26 32 00 00 07 00 00 00' + '27 32 00 00 08 00 00 00 28 32 00 00 09 00 00 00 29 32 00 00 0E 00 00 00 80 32 00 00 01 00 00 00' + '81 32 00 00 02 00 00 00 82 32 00 00 03 00 00 00 83 32 00 00 04 00 00 00 84 32 00 00 05 00 00 00' + '85 32 00 00 06 00 00 00 86 32 00 00 07 00 00 00 87 32 00 00 08 00 00 00 88 32 00 00 09 00 00 00' + '89 32 00 00 0E 00 00 00 10 FF 00 00 00 00 00 00 11 FF 00 00 01 00 00 00 12 FF 00 00 02 00 00 00' + '13 FF 00 00 03 00 00 00 14 FF 00 00 04 00 00 00 15 FF 00 00 05 00 00 00 16 FF 00 00 06 00 00 00' + '17 FF 00 00 07 00 00 00 18 FF 00 00 08 00 00 00 19 FF 00 00 09 00 00 00' +} + + +COMPOSITION UNICODEDATA DISCARDABLE +{ + '9A030000 38033C00 6E220000 38033D00 60220000 38033E00 6F220000 00034100 C0000000 01034100 C1000000' + '02034100 C2000000 03034100 C3000000 04034100 00010000 06034100 02010000 07034100 26020000 08034100' + 'C4000000 09034100 A21E0000 0A034100 C5000000 0C034100 CD010000 0F034100 00020000 11034100 02020000' + '23034100 A01E0000 25034100 001E0000 28034100 04010000 07034200 021E0000 23034200 041E0000 31034200' + '061E0000 01034300 06010000 02034300 08010000 07034300 0A010000 0C034300 0C010000 27034300 C7000000' + '07034400 0A1E0000 0C034400 0E010000 23034400 0C1E0000 27034400 101E0000 2D034400 121E0000 31034400' + '0E1E0000 00034500 C8000000 01034500 C9000000 02034500 CA000000 03034500 BC1E0000 04034500 12010000' + '06034500 14010000 07034500 16010000 08034500 CB000000 09034500 BA1E0000 0C034500 1A010000 0F034500' + '04020000 11034500 06020000 23034500 B81E0000 27034500 28020000 28034500 18010000 2D034500 181E0000' + '30034500 1A1E0000 07034600 1E1E0000 01034700 F4010000 02034700 1C010000 04034700 201E0000 06034700' + '1E010000 07034700 20010000 0C034700 E6010000 27034700 22010000 02034800 24010000 07034800 221E0000' + '08034800 261E0000 0C034800 1E020000 23034800 241E0000 27034800 281E0000 2E034800 2A1E0000 00034900' + 'CC000000 01034900 CD000000 02034900 CE000000 03034900 28010000 04034900 2A010000 06034900 2C010000' + '07034900 30010000 08034900 CF000000 09034900 C81E0000 0C034900 CF010000 0F034900 08020000 11034900' + '0A020000 23034900 CA1E0000 28034900 2E010000 30034900 2C1E0000 02034A00 34010000 01034B00 301E0000' + '0C034B00 E8010000 23034B00 321E0000 27034B00 36010000 31034B00 341E0000 01034C00 39010000 0C034C00' + '3D010000 23034C00 361E0000 27034C00 3B010000 2D034C00 3C1E0000 31034C00 3A1E0000 01034D00 3E1E0000' + '07034D00 401E0000 23034D00 421E0000 00034E00 F8010000 01034E00 43010000 03034E00 D1000000 07034E00' + '441E0000 0C034E00 47010000 23034E00 461E0000 27034E00 45010000 2D034E00 4A1E0000 31034E00 481E0000' + '00034F00 D2000000 01034F00 D3000000 02034F00 D4000000 03034F00 D5000000 04034F00 4C010000 06034F00' + '4E010000 07034F00 2E020000 08034F00 D6000000 09034F00 CE1E0000 0B034F00 50010000 0C034F00 D1010000' + '0F034F00 0C020000 11034F00 0E020000 1B034F00 A0010000 23034F00 CC1E0000 28034F00 EA010000 01035000' + '541E0000 07035000 561E0000 01035200 54010000 07035200 581E0000 0C035200 58010000 0F035200 10020000' + '11035200 12020000 23035200 5A1E0000 27035200 56010000 31035200 5E1E0000 01035300 5A010000 02035300' + '5C010000 07035300 601E0000 0C035300 60010000 23035300 621E0000 26035300 18020000 27035300 5E010000' + '07035400 6A1E0000 0C035400 64010000 23035400 6C1E0000 26035400 1A020000 27035400 62010000 2D035400' + '701E0000 31035400 6E1E0000 00035500 D9000000 01035500 DA000000 02035500 DB000000 03035500 68010000' + '04035500 6A010000 06035500 6C010000 08035500 DC000000 09035500 E61E0000 0A035500 6E010000 0B035500' + '70010000 0C035500 D3010000 0F035500 14020000 11035500 16020000 1B035500 AF010000 23035500 E41E0000' + '24035500 721E0000 28035500 72010000 2D035500 761E0000 30035500 741E0000 03035600 7C1E0000 23035600' + '7E1E0000 00035700 801E0000 01035700 821E0000 02035700 74010000 07035700 861E0000 08035700 841E0000' + '23035700 881E0000 07035800 8A1E0000 08035800 8C1E0000 00035900 F21E0000 01035900 DD000000 02035900' + '76010000 03035900 F81E0000 04035900 32020000 07035900 8E1E0000 08035900 78010000 09035900 F61E0000' + '23035900 F41E0000 01035A00 79010000 02035A00 901E0000 07035A00 7B010000 0C035A00 7D010000 23035A00' + '921E0000 31035A00 941E0000 00036100 E0000000 01036100 E1000000 02036100 E2000000 03036100 E3000000' + '04036100 01010000 06036100 03010000 07036100 27020000 08036100 E4000000 09036100 A31E0000 0A036100' + 'E5000000 0C036100 CE010000 0F036100 01020000 11036100 03020000 23036100 A11E0000 25036100 011E0000' + '28036100 05010000 07036200 031E0000 23036200 051E0000 31036200 071E0000 01036300 07010000 02036300' + '09010000 07036300 0B010000 0C036300 0D010000 27036300 E7000000 07036400 0B1E0000 0C036400 0F010000' + '23036400 0D1E0000 27036400 111E0000 2D036400 131E0000 31036400 0F1E0000 00036500 E8000000 01036500' + 'E9000000 02036500 EA000000 03036500 BD1E0000 04036500 13010000 06036500 15010000 07036500 17010000' + '08036500 EB000000 09036500 BB1E0000 0C036500 1B010000 0F036500 05020000 11036500 07020000 23036500' + 'B91E0000 27036500 29020000 28036500 19010000 2D036500 191E0000 30036500 1B1E0000 07036600 1F1E0000' + '01036700 F5010000 02036700 1D010000 04036700 211E0000 06036700 1F010000 07036700 21010000 0C036700' + 'E7010000 27036700 23010000 02036800 25010000 07036800 231E0000 08036800 271E0000 0C036800 1F020000' + '23036800 251E0000 27036800 291E0000 2E036800 2B1E0000 31036800 961E0000 00036900 EC000000 01036900' + 'ED000000 02036900 EE000000 03036900 29010000 04036900 2B010000 06036900 2D010000 08036900 EF000000' + '09036900 C91E0000 0C036900 D0010000 0F036900 09020000 11036900 0B020000 23036900 CB1E0000 28036900' + '2F010000 30036900 2D1E0000 02036A00 35010000 0C036A00 F0010000 01036B00 311E0000 0C036B00 E9010000' + '23036B00 331E0000 27036B00 37010000 31036B00 351E0000 01036C00 3A010000 0C036C00 3E010000 23036C00' + '371E0000 27036C00 3C010000 2D036C00 3D1E0000 31036C00 3B1E0000 01036D00 3F1E0000 07036D00 411E0000' + '23036D00 431E0000 00036E00 F9010000 01036E00 44010000 03036E00 F1000000 07036E00 451E0000 0C036E00' + '48010000 23036E00 471E0000 27036E00 46010000 2D036E00 4B1E0000 31036E00 491E0000 00036F00 F2000000' + '01036F00 F3000000 02036F00 F4000000 03036F00 F5000000 04036F00 4D010000 06036F00 4F010000 07036F00' + '2F020000 08036F00 F6000000 09036F00 CF1E0000 0B036F00 51010000 0C036F00 D2010000 0F036F00 0D020000' + '11036F00 0F020000 1B036F00 A1010000 23036F00 CD1E0000 28036F00 EB010000 01037000 551E0000 07037000' + '571E0000 01037200 55010000 07037200 591E0000 0C037200 59010000 0F037200 11020000 11037200 13020000' + '23037200 5B1E0000 27037200 57010000 31037200 5F1E0000 01037300 5B010000 02037300 5D010000 07037300' + '611E0000 0C037300 61010000 23037300 631E0000 26037300 19020000 27037300 5F010000 07037400 6B1E0000' + '08037400 971E0000 0C037400 65010000 23037400 6D1E0000 26037400 1B020000 27037400 63010000 2D037400' + '711E0000 31037400 6F1E0000 00037500 F9000000 01037500 FA000000 02037500 FB000000 03037500 69010000' + '04037500 6B010000 06037500 6D010000 08037500 FC000000 09037500 E71E0000 0A037500 6F010000 0B037500' + '71010000 0C037500 D4010000 0F037500 15020000 11037500 17020000 1B037500 B0010000 23037500 E51E0000' + '24037500 731E0000 28037500 73010000 2D037500 771E0000 30037500 751E0000 03037600 7D1E0000 23037600' + '7F1E0000 00037700 811E0000 01037700 831E0000 02037700 75010000 07037700 871E0000 08037700 851E0000' + '0A037700 981E0000 23037700 891E0000 07037800 8B1E0000 08037800 8D1E0000 00037900 F31E0000 01037900' + 'FD000000 02037900 77010000 03037900 F91E0000 04037900 33020000 07037900 8F1E0000 08037900 FF000000' + '09037900 F71E0000 0A037900 991E0000 23037900 F51E0000 01037A00 7A010000 02037A00 911E0000 07037A00' + '7C010000 0C037A00 7E010000 23037A00 931E0000 31037A00 951E0000 0003A800 ED1F0000 0103A800 85030000' + '4203A800 C11F0000 0003C200 A61E0000 0103C200 A41E0000 0303C200 AA1E0000 0903C200 A81E0000 0403C400' + 'DE010000 0103C500 FA010000 0103C600 FC010000 0403C600 E2010000 0103C700 081E0000 0003CA00 C01E0000' + '0103CA00 BE1E0000 0303CA00 C41E0000 0903CA00 C21E0000 0103CF00 2E1E0000 0003D400 D21E0000 0103D400' + 'D01E0000 0303D400 D61E0000 0903D400 D41E0000 0103D500 4C1E0000 0403D500 2C020000 0803D500 4E1E0000' + '0403D600 2A020000 0103D800 FE010000 0003DC00 DB010000 0103DC00 D7010000 0403DC00 D5010000 0C03DC00' + 'D9010000 0003E200 A71E0000 0103E200 A51E0000 0303E200 AB1E0000 0903E200 A91E0000 0403E400 DF010000' + '0103E500 FB010000 0103E600 FD010000 0403E600 E3010000 0103E700 091E0000 0003EA00 C11E0000 0103EA00' + 'BF1E0000 0303EA00 C51E0000 0903EA00 C31E0000 0103EF00 2F1E0000 0003F400 D31E0000 0103F400 D11E0000' + '0303F400 D71E0000 0903F400 D51E0000 0103F500 4D1E0000 0403F500 2D020000 0803F500 4F1E0000 0403F600' + '2B020000 0103F800 FF010000 0003FC00 DC010000 0103FC00 D8010000 0403FC00 D6010000 0C03FC00 DA010000' + '00030201 B01E0000 01030201 AE1E0000 03030201 B41E0000 09030201 B21E0000 00030301 B11E0000 01030301' + 'AF1E0000 03030301 B51E0000 09030301 B31E0000 00031201 141E0000 01031201 161E0000 00031301 151E0000' + '01031301 171E0000 00034C01 501E0000 01034C01 521E0000 00034D01 511E0000 01034D01 531E0000 07035A01' + '641E0000 07035B01 651E0000 07036001 661E0000 07036101 671E0000 01036801 781E0000 01036901 791E0000' + '08036A01 7A1E0000 08036B01 7B1E0000 07037F01 9B1E0000 0003A001 DC1E0000 0103A001 DA1E0000 0303A001' + 'E01E0000 0903A001 DE1E0000 2303A001 E21E0000 0003A101 DD1E0000 0103A101 DB1E0000 0303A101 E11E0000' + '0903A101 DF1E0000 2303A101 E31E0000 0003AF01 EA1E0000 0103AF01 E81E0000 0303AF01 EE1E0000 0903AF01' + 'EC1E0000 2303AF01 F01E0000 0003B001 EB1E0000 0103B001 E91E0000 0303B001 EF1E0000 0903B001 ED1E0000' + '2303B001 F11E0000 0C03B701 EE010000 0403EA01 EC010000 0403EB01 ED010000 04032602 E0010000 04032702' + 'E1010000 06032802 1C1E0000 06032902 1D1E0000 04032E02 30020000 04032F02 31020000 0C039202 EF010000' + '01030803 44030000 00039103 BA1F0000 01039103 86030000 04039103 B91F0000 06039103 B81F0000 13039103' + '081F0000 14039103 091F0000 45039103 BC1F0000 00039503 C81F0000 01039503 88030000 13039503 181F0000' + '14039503 191F0000 00039703 CA1F0000 01039703 89030000 13039703 281F0000 14039703 291F0000 45039703' + 'CC1F0000 00039903 DA1F0000 01039903 8A030000 04039903 D91F0000 06039903 D81F0000 08039903 AA030000' + '13039903 381F0000 14039903 391F0000 00039F03 F81F0000 01039F03 8C030000 13039F03 481F0000 14039F03' + '491F0000 1403A103 EC1F0000 0003A503 EA1F0000 0103A503 8E030000 0403A503 E91F0000 0603A503 E81F0000' + '0803A503 AB030000 1403A503 591F0000 0003A903 FA1F0000 0103A903 8F030000 1303A903 681F0000 1403A903' + '691F0000 4503A903 FC1F0000 4503AC03 B41F0000 4503AE03 C41F0000 0003B103 701F0000 0103B103 AC030000' + '0403B103 B11F0000 0603B103 B01F0000 1303B103 001F0000 1403B103 011F0000 4203B103 B61F0000 4503B103' + 'B31F0000 0003B503 721F0000 0103B503 AD030000 1303B503 101F0000 1403B503 111F0000 0003B703 741F0000' + '0103B703 AE030000 1303B703 201F0000 1403B703 211F0000 4203B703 C61F0000 4503B703 C31F0000 0003B903' + '761F0000 0103B903 AF030000 0403B903 D11F0000 0603B903 D01F0000 0803B903 CA030000 1303B903 301F0000' + '1403B903 311F0000 4203B903 D61F0000 0003BF03 781F0000 0103BF03 CC030000 1303BF03 401F0000 1403BF03' + '411F0000 1303C103 E41F0000 1403C103 E51F0000 0003C503 7A1F0000 0103C503 CD030000 0403C503 E11F0000' + '0603C503 E01F0000 0803C503 CB030000 1303C503 501F0000 1403C503 511F0000 4203C503 E61F0000 0003C903' + '7C1F0000 0103C903 CE030000 1303C903 601F0000 1403C903 611F0000 4203C903 F61F0000 4503C903 F31F0000' + '0003CA03 D21F0000 0103CA03 90030000 4203CA03 D71F0000 0003CB03 E21F0000 0103CB03 B0030000 4203CB03' + 'E71F0000 4503CE03 F41F0000 0103D203 D3030000 0803D203 D4030000 08030604 07040000 06031004 D0040000' + '08031004 D2040000 01031304 03040000 00031504 00040000 06031504 D6040000 08031504 01040000 06031604' + 'C1040000 08031604 DC040000 08031704 DE040000 00031804 0D040000 04031804 E2040000 06031804 19040000' + '08031804 E4040000 01031A04 0C040000 08031E04 E6040000 04032304 EE040000 06032304 0E040000 08032304' + 'F0040000 0B032304 F2040000 08032704 F4040000 08032B04 F8040000 08032D04 EC040000 06033004 D1040000' + '08033004 D3040000 01033304 53040000 00033504 50040000 06033504 D7040000 08033504 51040000 06033604' + 'C2040000 08033604 DD040000 08033704 DF040000 00033804 5D040000 04033804 E3040000 06033804 39040000' + '08033804 E5040000 01033A04 5C040000 08033E04 E7040000 04034304 EF040000 06034304 5E040000 08034304' + 'F1040000 0B034304 F3040000 08034704 F5040000 08034B04 F9040000 08034D04 ED040000 08035604 57040000' + '0F037404 76040000 0F037504 77040000 0803D804 DA040000 0803D904 DB040000 0803E804 EA040000 0803E904' + 'EB040000 B405D905 1DFB0000 53062706 22060000 54062706 23060000 55062706 25060000 54064806 24060000' + '54064A06 26060000 5406C106 C2060000 5406D206 D3060000 5406D506 C0060000 3C092809 29090000 3C093009' + '31090000 3C093309 34090000 BE09C709 CB090000 D709C709 CC090000 3E0B470B 4B0B0000 560B470B 480B0000' + '570B470B 4C0B0000 D70B920B 940B0000 BE0BC60B CA0B0000 D70BC60B CC0B0000 BE0BC70B CB0B0000 560C460C' + '480C0000 D50CBF0C C00C0000 C20CC60C CA0C0000 D50CC60C C70C0000 D60CC60C C80C0000 D50CCA0C CB0C0000' + '3E0D460D 4A0D0000 570D460D 4C0D0000 3E0D470D 4B0D0000 CA0DD90D DA0D0000 CF0DD90D DC0D0000 DF0DD90D' + 'DE0D0000 CA0DDC0D DD0D0000 720F710F 730F0000 740F710F 750F0000 800F710F 810F0000 2E102510 26100000' + '0403361E 381E0000 0403371E 391E0000 04035A1E 5C1E0000 04035B1E 5D1E0000 0703621E 681E0000 0703631E' + '691E0000 0203A01E AC1E0000 0603A01E B61E0000 0203A11E AD1E0000 0603A11E B71E0000 0203B81E C61E0000' + '0203B91E C71E0000 0203CC1E D81E0000 0203CD1E D91E0000 0003001F 021F0000 0103001F 041F0000 4203001F' + '061F0000 4503001F 801F0000 0003011F 031F0000 0103011F 051F0000 4203011F 071F0000 4503011F 811F0000' + '4503021F 821F0000 4503031F 831F0000 4503041F 841F0000 4503051F 851F0000 4503061F 861F0000 4503071F' + '871F0000 0003081F 0A1F0000 0103081F 0C1F0000 4203081F 0E1F0000 4503081F 881F0000 0003091F 0B1F0000' + '0103091F 0D1F0000 4203091F 0F1F0000 4503091F 891F0000 45030A1F 8A1F0000 45030B1F 8B1F0000 45030C1F' + '8C1F0000 45030D1F 8D1F0000 45030E1F 8E1F0000 45030F1F 8F1F0000 0003101F 121F0000 0103101F 141F0000' + '0003111F 131F0000 0103111F 151F0000 0003181F 1A1F0000 0103181F 1C1F0000 0003191F 1B1F0000 0103191F' + '1D1F0000 0003201F 221F0000 0103201F 241F0000 4203201F 261F0000 4503201F 901F0000 0003211F 231F0000' + '0103211F 251F0000 4203211F 271F0000 4503211F 911F0000 4503221F 921F0000 4503231F 931F0000 4503241F' + '941F0000 4503251F 951F0000 4503261F 961F0000 4503271F 971F0000 0003281F 2A1F0000 0103281F 2C1F0000' + '4203281F 2E1F0000 4503281F 981F0000 0003291F 2B1F0000 0103291F 2D1F0000 4203291F 2F1F0000 4503291F' + '991F0000 45032A1F 9A1F0000 45032B1F 9B1F0000 45032C1F 9C1F0000 45032D1F 9D1F0000 45032E1F 9E1F0000' + '45032F1F 9F1F0000 0003301F 321F0000 0103301F 341F0000 4203301F 361F0000 0003311F 331F0000 0103311F' + '351F0000 4203311F 371F0000 0003381F 3A1F0000 0103381F 3C1F0000 4203381F 3E1F0000 0003391F 3B1F0000' + '0103391F 3D1F0000 4203391F 3F1F0000 0003401F 421F0000 0103401F 441F0000 0003411F 431F0000 0103411F' + '451F0000 0003481F 4A1F0000 0103481F 4C1F0000 0003491F 4B1F0000 0103491F 4D1F0000 0003501F 521F0000' + '0103501F 541F0000 4203501F 561F0000 0003511F 531F0000 0103511F 551F0000 4203511F 571F0000 0003591F' + '5B1F0000 0103591F 5D1F0000 4203591F 5F1F0000 0003601F 621F0000 0103601F 641F0000 4203601F 661F0000' + '4503601F A01F0000 0003611F 631F0000 0103611F 651F0000 4203611F 671F0000 4503611F A11F0000 4503621F' + 'A21F0000 4503631F A31F0000 4503641F A41F0000 4503651F A51F0000 4503661F A61F0000 4503671F A71F0000' + '0003681F 6A1F0000 0103681F 6C1F0000 4203681F 6E1F0000 4503681F A81F0000 0003691F 6B1F0000 0103691F' + '6D1F0000 4203691F 6F1F0000 4503691F A91F0000 45036A1F AA1F0000 45036B1F AB1F0000 45036C1F AC1F0000' + '45036D1F AD1F0000 45036E1F AE1F0000 45036F1F AF1F0000 4503701F B21F0000 4503741F C21F0000 45037C1F' + 'F21F0000 4503B61F B71F0000 0003BF1F CD1F0000 0103BF1F CE1F0000 4203BF1F CF1F0000 4503C61F C71F0000' + '4503F61F F71F0000 0003FE1F DD1F0000 0103FE1F DE1F0000 4203FE1F DF1F0000 38039021 9A210000 38039221' + '9B210000 38039421 AE210000 3803D021 CD210000 3803D221 CF210000 3803D421 CE210000 38030322 04220000' + '38030822 09220000 38030B22 0C220000 38032322 24220000 38032522 26220000 38033C22 41220000 38034322' + '44220000 38034522 47220000 38034822 49220000 38034D22 6D220000 38036122 62220000 38036422 70220000' + '38036522 71220000 38037222 74220000 38037322 75220000 38037622 78220000 38037722 79220000 38037A22' + '80220000 38037B22 81220000 38037C22 E0220000 38037D22 E1220000 38038222 84220000 38038322 85220000' + '38038622 88220000 38038722 89220000 38039122 E2220000 38039222 E3220000 3803A222 AC220000 3803A822' + 'AD220000 3803A922 AE220000 3803AB22 AF220000 3803B222 EA220000 3803B322 EB220000 3803B422 EC220000' + '3803B522 ED220000 99304630 94300000 99304B30 4C300000 99304D30 4E300000 99304F30 50300000 99305130' + '52300000 99305330 54300000 99305530 56300000 99305730 58300000 99305930 5A300000 99305B30 5C300000' + '99305D30 5E300000 99305F30 60300000 99306130 62300000 99306430 65300000 99306630 67300000 99306830' + '69300000 99306F30 70300000 9A306F30 71300000 99307230 73300000 9A307230 74300000 99307530 76300000' + '9A307530 77300000 99307830 79300000 9A307830 7A300000 99307B30 7C300000 9A307B30 7D300000 99309D30' + '9E300000 9930A630 F4300000 9930AB30 AC300000 9930AD30 AE300000 9930AF30 B0300000 9930B130 B2300000' + '9930B330 B4300000 9930B530 B6300000 9930B730 B8300000 9930B930 BA300000 9930BB30 BC300000 9930BD30' + 'BE300000 9930BF30 C0300000 9930C130 C2300000 9930C430 C5300000 9930C630 C7300000 9930C830 C9300000' + '9930CF30 D0300000 9A30CF30 D1300000 9930D230 D3300000 9A30D230 D4300000 9930D530 D6300000 9A30D530' + 'D7300000 9930D830 D9300000 9A30D830 DA300000 9930DB30 DC300000 9A30DB30 DD300000 9930EF30 F7300000' + '9930F030 F8300000 9930F130 F9300000 9930F230 FA300000 9930FD30 FE300000' +} diff --git a/official/1.96/source/windows/JclUnicode.res b/official/1.96/source/windows/JclUnicode.res new file mode 100644 index 0000000..0e8644c Binary files /dev/null and b/official/1.96/source/windows/JclUnicode.res differ diff --git a/official/1.96/source/windows/JclWideFormat.pas b/official/1.96/source/windows/JclWideFormat.pas new file mode 100644 index 0000000..85fb744 --- /dev/null +++ b/official/1.96/source/windows/JclWideFormat.pas @@ -0,0 +1,909 @@ +{**************************************************************************************************} +{ } +{ 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 FormatW.pas. } +{ } +{ The Initial Developer of the Original Code is Rob Kennedy, rkennedy att cs dott wisc dott edu. } +{ Portions created by Rob Kennedy are Copyright Rob Kennedy. All rights reserved. } +{ } +{ Contributors (in alphabetical order): } +{ } +{**************************************************************************************************} +{ } +{ Comments by Rob Kennedy: } +{ } +{ This unit provides a Unicode version of the SysUtils.Format function for } +{ Delphi 5. Later Delphi versions already have such a function. To the best of } +{ my knowledge, this function is bug-free. (Famous last words?) If there are any } +{ questions regarding the workings of the format parser's state machine, please } +{ do not hesitate to contact me. I understand all the state transitions, but } +{ find it hard to document en masse. } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2006/01/15 12:29:49 $ +// For history see end of file + +{ TODO : Replacing the calls to MultiBytetoWideChar is all what's needed to make this crossplatform } +{ TODO : Fix Internal Error DBG1384 in BCB 6 compilation } + +unit JclWideFormat; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +{ With FORMAT_EXTENSIONS defined, WideFormat will accept more argument types + than Borland's Format function. In particular, it will accept Variant + arguments for the D, E, F, G, M, N, U, and X format types, it will accept + Boolean and TClass arguments for the S format type, and it will accept PChar, + PWideChar, interface, and object arguments for the P format type. + In addition, WideFormat can use Int64 and Variant arguments for index, width, + and precision specifiers used by the asterisk character. } +{$DEFINE FORMAT_EXTENSIONS} + +{ If the format type is D, U, or X, and if the format string contains a + precision specifier greater than 16, then the precision specifier is ignored. + This is consistent with observed Format behavior, although it is not so + documented. Likewise, if the format type is E, F, G, M, or N and the precision + specifier is greater than 18, then it too will be ignored. + + There is one known difference between the behaviors of Format and WideFormat. + WideFormat interprets a width specifier as a signed 32-bit integer. If it is + negative, then it will be treated as 0. Format interprets it as a very large + unsigned integer, which can lead to an access violation or buffer overrun. + + WideFormat detects the same errors as Format, but it reports them differently. + Because of differences in the parsers, WideFormat is unable to provide the + entire format string in the error message every time. When the full string is + not available, it will provide the offending character index instead. In the + case of an invalid argument type, WideFormat will include the allowed types + and the argument index in the error message. Despite the different error + messages, the exception class is still EConvertError. } +function WideFormat(const Format: WideString; const Args: array of const): WideString; + +implementation + +uses + Windows, // for MultiBytetoWideChar + {$IFDEF FORMAT_EXTENSIONS} + {$IFDEF HAS_UNIT_VARIANTS} + Variants, // for VarType + {$ENDIF HAS_UNIT_VARIANTS} + {$ENDIF FORMAT_EXTENSIONS} + SysUtils, // for exceptions and FloatToText + Classes, // for TStrings, in error-reporting code + JclBase, // for PByte and PCardinal + JclMath, // for TDelphiSet + JclResources, // for resourcestrings + JclStrings, // for BooleanToStr, StrLen + JclWideStrings; // for StrLenW, MoveWideChar + +type + { WideFormat uses a finite-state machine to do its parsing. The states are + represented by the TState type below. The progression from one state to the + next is determined by the StateTable constant, which combines the previous + state with the class of the current character (represented by the TCharClass + type). + + Some anomolies: It's possible to go directly from stDot to one of the + specifier states, which according to the documentation should be a syntax + error, but SysUtils.Format accepts it and uses the default -1 for Prec. + Therefore, there are special stPrecDigit and stPrecStar modes that differ + from stDigit and stStar by checking for and overriding the default Prec + value when necessary. } + TState = (stError, stBeginAcc, stAcc, stPercent, stDigit, stPrecDigit, stStar, stPrecStar, stColon, stDash, stDot, stFloat, stInt, stPointer, stString); + TCharClass = (ccOther, ccPercent, ccDigit, ccStar, ccColon, ccDash, ccDot, ccSpecF, ccSpecI, ccSpecP, ccSpecS); + + { The buffer is 64 bytes long. When converting a floating-point value, this + buffer holds AnsiChars. This is the size of the buffer that SysUtils.Format + uses, so we assume it's large enough. When converting an integer value, this + buffer holds WideChars. This buffer can hold 32 WideChars, which is enough + for any 64-bit integer represented in decimal or hexadecimal form. Thus, + this fixed-size buffer does not have the potential to overflow. } + PConversionBuffer = ^TConversionBuffer; + TConversionBuffer = array [0..63] of Byte; + +const + WidePercent = WideChar('%'); + WideLittleX = WideChar('x'); + WideSpace = WideChar(' '); // Also defined in JclUnicode; should be consolidated into JclWideStrings + + NoPrecision = Cardinal(-1); + + // For converting strings + DefaultCodePage = cp_ACP; + + { This array classifies characters within the range of characters considered + special to the format syntax. Characters outside the range are implicitly + classified as ccOther. The value from this table combines with the current + state to yield the next state, as determined by StateTable below. } + CharClassTable: array [WidePercent..WideLittleX] of TCharClass = ( + {%}ccPercent, {&}ccOther, {'}ccOther, {(}ccOther, {)}ccOther, {*}ccStar, + {+}ccOther, {,}ccOther, {-}ccDash, {.}ccDot, {/}ccOther, {0}ccDigit, + {1}ccDigit, {2}ccDigit, {3}ccDigit, {4}ccDigit, {5}ccDigit, {6}ccDigit, + {7}ccDigit, {8}ccDigit, {9}ccDigit, {:}ccColon, {;}ccOther, {<}ccOther, + {=}ccOther, {>}ccOther, {?}ccOther, {@}ccOther, {A}ccOther, {B}ccOther, + {C}ccOther, {D}ccSpecI, {E}ccSpecF, {F}ccSpecF, {G}ccSpecF, {H}ccOther, + {I}ccOther, {J}ccOther, {K}ccOther, {L}ccOther, {M}ccSpecF, {N}ccSpecF, + {O}ccOther, {P}ccSpecP, {Q}ccOther, {R}ccOther, {S}ccSpecS, {T}ccOther, + {U}ccSpecI, {V}ccOther, {W}ccOther, {X}ccSpecI, {Y}ccOther, {Z}ccOther, + {[}ccOther, {\}ccOther, {]}ccOther, {^}ccOther, {_}ccOther, {`}ccOther, + {a}ccOther, {b}ccOther, {c}ccOther, {d}ccSpecI, {e}ccSpecF, {f}ccSpecF, + {g}ccSpecF, {h}ccOther, {i}ccOther, {j}ccOther, {k}ccOther, {l}ccOther, + {m}ccSpecF, {n}ccSpecF, {o}ccOther, {p}ccSpecP, {q}ccOther, {r}ccOther, + {s}ccSpecS, {t}ccOther, {u}ccSpecI, {v}ccOther, {w}ccOther, {x}ccSpecI + ); + { Given the previous state and the class of the current character, this table + determines what the next state should be. } + StateTable: array [TState{old state}, TCharClass{new char}] of TState {new state}= ( + { ccOther, ccPercent, ccDigit, ccStar, ccColon, ccDash, ccDot, ccSpecF, ccSpecI, ccSpecP, ccSpecS } + {stError} (stBeginAcc, stPercent, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc), + {stBeginAcc} (stAcc, stPercent, stAcc, stAcc, stAcc, stAcc, stAcc, stAcc, stAcc, stAcc, stAcc), + {stAcc} (stAcc, stPercent, stAcc, stAcc, stAcc, stAcc, stAcc, stAcc, stAcc, stAcc, stAcc), + {stPercent} (stError, stBeginAcc, stDigit, stStar, stError, stDash, stDot, stFloat, stInt, stPointer, stString), + {stDigit} (stError, stError, stDigit, stError, stColon, stError, stDot, stFloat, stInt, stPointer, stString), + {stPrecDigit}(stError, stError, stPrecDigit, stError, stError, stError, stError, stFloat, stInt, stPointer, stString), + {stStar} (stError, stError, stError, stError, stColon, stError, stDot, stFloat, stInt, stPointer, stString), + {stPrecStar} (stError, stError, stError, stError, stError, stError, stError, stFloat, stInt, stPointer, stString), + {stColon} (stError, stError, stDigit, stStar, stError, stDash, stDot, stFloat, stInt, stPointer, stString), + {stDash} (stError, stError, stDigit, stStar, stError, stError, stDot, stFloat, stInt, stPointer, stString), + {stDot} (stError, stError, stPrecDigit, stPrecStar, stError, stError, stError, stFloat, stInt, stPointer, stString), + {stFloat} (stBeginAcc, stPercent, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc), + {stInt} (stBeginAcc, stPercent, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc), + {stPointer} (stBeginAcc, stPercent, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc), + {stString} (stBeginAcc, stPercent, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc, stBeginAcc) + ); + { This table is used in converting an ordinal value to a string in either + decimal or hexadecimal format. } + ConvertChars: array [0..$f] of WideChar = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'); + +// Argument-prepration routines +procedure FetchStarArgument(const Arg: PVarRec; const ArgIndex: Cardinal; + out Value: Cardinal); forward; +function PrepareFloat(const Format: WideString; const C: WideChar; Prec: Cardinal; + const Buffer: PConversionBuffer; const FormatStart, Src, ArgIndex: Cardinal; + const Arg: PVarRec; out CharCount: Cardinal): PAnsiChar; forward; +function PrepareInt(const Format: WideString; const C: WideChar; Prec: Cardinal; + const Buffer: PConversionBuffer; const FormatStart, Src, ArgIndex: Cardinal; + const Arg: PVarRec; out CharCount: Cardinal): PWideChar; forward; +function PreparePointer(const Format: WideString; const Buffer: PConversionBuffer; + const FormatStart, Src, ArgIndex: Cardinal; const Arg: PVarRec; + out CharCount: Cardinal): PWideChar; forward; +function PrepareString(const Format: WideString; const Buffer: PConversionBuffer; + const FormatStart, Src, ArgIndex: Cardinal; const Arg: PVarRec; + out CharCount: Cardinal): Pointer; forward; + +// WideFormat support routines +function EnsureStringLen(const NeededLen, CurrentLen: Cardinal; var S: WideString): Cardinal; forward; +procedure CopyBuffer(var Dest: WideString; const CharCount: Cardinal; const Source: Pointer; var ResultLen, DestIndex: Cardinal); forward; +function FillWideChar(var X; Count: Cardinal; const Value: WideChar): Cardinal; forward; + +{ Error-reporting routines + + Using separate functions for creating exceptions helps to streamline the + WideFormat code. The stack is not cluttered with space for temporary strings + and open arrays needed for calling the exceptions' constructors, and the + function's prologue and epilogue don't execute code for initializing and + finalizing those hidden stack variables. The extra stack space is thus only + used in the case when WideFormat actually needs to raise an exception. By + returning the Exception object instead of raising it within these functions, + we move the "raise" command into WideFormat, which allows the compiler to + detect which execution paths use variables and which don't, and that reduces + the number of inaccurate compiler hints and warnings. } +function FormatNoArgumentError(const ArgIndex: Cardinal): Exception; forward; +function FormatNoArgumentErrorEx(const Format: WideString; const FormatStart, FormatEnd, ArgIndex: Cardinal): Exception; forward; +function FormatSyntaxError(const CharIndex: Cardinal): Exception; forward; +function FormatBadArgumentTypeError(const VType: Byte; const ArgIndex: Cardinal; const Allowed: TDelphiSet): Exception; forward; +function FormatBadArgumentTypeErrorEx(const Format: WideString; const FormatStart, FormatEnd: Cardinal; const VType: Byte; const ArgIndex: Cardinal; const Allowed: TDelphiSet): Exception; forward; + +// === WideFormat ============================================================== + +function WideFormat(const Format: WideString; const Args: array of const): WideString; +var + // Basic parsing values + State: TState; // Maintain the finite-state machine + C: WideChar; // Cache value of Format[Src] + Src, Dest: Cardinal; // Indices into Format and Result + FormatLen: Cardinal; // Alias for Length(Format) + ResultLen: Cardinal; // Alias for Length(Result) + // Parser's formatting variables + ArgIndex: Cardinal; // Which argument to read from the Args array + Arg: PVarRec; // Pointer to current argument + LeftAlign: Boolean; // Whether the "-" character is present + Width: Cardinal; // Value of width specifier + Prec: Cardinal; // Value of precision specifier + // Error-reporting support + FormatStart: Cardinal; // First character of a format string + // Variables for generating the result + P: Pointer; // Pointer to character buffer. Either Wide or Ansi. + Wide: Boolean; // Tells whether P is PWideChar or PAnsiChar + CharCount: Cardinal; // How many characters are pointed to by P + AnsiCount: Cardinal; + Buffer: TConversionBuffer; // Buffer for numerical conversions + TempWS: WideString; // Buffer for Variant and Boolean string conversions + MinWidth, SpacesNeeded: Cardinal; +begin + FormatLen := Length(Format); + // Start with an estimated result length + ResultLen := FormatLen * 4; + SetLength(Result, ResultLen); + if FormatLen = 0 then + Exit; + + Dest := 1; + State := stError; + ArgIndex := 0; + CharCount := 0; + + // Avoid compiler warnings + LeftAlign := False; + AnsiCount := 0; + FormatStart := 0; + P := nil; + + for Src := 1 to FormatLen do + begin + C := Format[Src]; + if (Low(CharClassTable) <= C) and (C <= High(CharClassTable)) then + State := StateTable[State, CharClassTable[C]] + else + State := StateTable[State, ccOther]; + case State of + stError: + raise FormatSyntaxError(Src); // syntax error at index [Src] + stBeginAcc: + begin + // Begin accumulating characters to copy to Result + P := @Format[Src]; + CharCount := 1; + end; + stAcc: + Inc(CharCount); + stPercent: + begin + if CharCount > 0 then + begin + // Copy accumulated characters into result + CopyBuffer(Result, CharCount, P, ResultLen, Dest); + CharCount := 0; + end; + // Prepare a new format string + Width := 0; + Prec := NoPrecision; + FormatStart := Src; + LeftAlign := False; + end; + stDigit: + begin + // We read into Width, but we might actually be reading the ArgIndex + // value. If that turns out to be the case, it gets addressed in the + // stColon state below and Width is reset to its default value, 0. + Width := Width * 10 + Cardinal(Ord(C) - Ord('0')); + end; + stPrecDigit: + begin + if Prec = NoPrecision then + Prec := 0; + Prec := Prec * 10 + Cardinal(Ord(C) - Ord('0')); + end; + stStar, stPrecStar: + begin + if ArgIndex > Cardinal(High(Args)) then + raise FormatNoArgumentError(ArgIndex); + // (Prec|Width) := Args[ArgIndex++] + Arg := @Args[ArgIndex]; + if State = stStar then + FetchStarArgument(Arg, ArgIndex, Width) + else + FetchStarArgument(Arg, ArgIndex, Prec); + Inc(ArgIndex); + end; + stColon: + begin + ArgIndex := Width; + Width := 0; + end; + stDash: + LeftAlign := True; + stDot: ; + stFloat, stInt, stPointer, stString: + begin + if ArgIndex > Cardinal(High(Args)) then + raise FormatNoArgumentErrorEx(Format, FormatStart, Src, ArgIndex); + Arg := @Args[ArgIndex]; + case State of + stFloat: + begin + P := PrepareFloat(Format, C, Prec, @Buffer, FormatStart, Src, ArgIndex, Arg, AnsiCount); + CharCount := AnsiCount; + Wide := False; + end; + stInt: + begin + P := PrepareInt(Format, C, Prec, @Buffer, FormatStart, Src, ArgIndex, Arg, CharCount); + Wide := True; + end; + stPointer: + begin + P := PreparePointer(Format, @Buffer, FormatStart, Src, ArgIndex, Arg, CharCount); + Wide := True; + end; + else {stString:} + begin + Wide := Arg^.VType in [vtWideChar, vtPWideChar, vtBoolean, vtVariant, vtWideString]; + case Arg^.VType of + vtVariant: + begin + TempWS := Arg^.VVariant^; + CharCount := Length(TempWS); + P := Pointer(TempWS); + end; + {$IFDEF FORMAT_EXTENSIONS} + vtBoolean: + begin + TempWS := BooleanToStr(Arg^.VBoolean); + CharCount := Length(TempWS); + P := Pointer(TempWS); + end; + {$ENDIF FORMAT_EXTENSIONS} + else + P := PrepareString(Format, @Buffer, FormatStart, Src, ArgIndex, Arg, CharCount); + end; + // We want the length in WideChars, not AnsiChars; they aren't + // necessarily the same. + if not Wide then + begin + AnsiCount := CharCount; + if CharCount > 0 then + CharCount := MultiByteToWideChar(DefaultCodePage, 0, P, AnsiCount, nil, 0); + end; + // For strings, Prec can only truncate, never lengthen. + if Prec < CharCount then + CharCount := Prec; + end; // stString case + end; // case State + Inc(ArgIndex); + + if Integer(Width) < 0 then + Width := 0; + if (Width = 0) and (CharCount = 0) then continue; + + // This code prepares for the buffer-copying code. + MinWidth := CharCount; + if Width > MinWidth then + SpacesNeeded := Width - MinWidth + else + SpacesNeeded := 0; + ResultLen := EnsureStringLen(Pred(Dest + MinWidth + SpacesNeeded), ResultLen, Result); + + // This code fills the resultant buffer. + if (SpacesNeeded > 0) and not LeftAlign then + Inc(Dest, FillWideChar(Result[Dest], SpacesNeeded, WideSpace)); + if Wide then + MoveWideChar(P^, Result[Dest], CharCount) + else + MultiByteToWideChar(DefaultCodePage, 0, P, Integer(AnsiCount), @Result[Dest], Integer(CharCount)); + Inc(Dest, CharCount); + CharCount := 0; + if (SpacesNeeded > 0) and LeftAlign then + Inc(Dest, FillWideChar(Result[Dest], SpacesNeeded, WideSpace)); + end; // case stFloat, stInt, stPointer, stString + end; // case C + end; // for + if CharCount > 0 then + CopyBuffer(Result, CharCount, P, ResultLen, Dest); + if ResultLen >= Dest then + SetLength(Result, Pred(Dest)); + { I would prefer to call the following, instead of SetLength, because + SetLength _always_ re-allocates the string buffer whereas this function + will sometimes just change the string's length field and return the + original value. Using this function, though, goes contrary to the goal of + having this unit be cross-platform. } + // SysReAllocStringLen(PWideChar(Pointer(Result)), PWideChar(Pointer(Result)), Dest - 1); +end; + +// === Argument-prepration support routines ==================================== + +function ModDiv32(const Dividend, Divisor: Cardinal; out Quotient: Cardinal): Cardinal; +{ Returns the quotient and modulus of the two inputs while performing only one + division operation. + Quotient := Dividend div Divisor; + Result := Dividend mod Divisor; } +asm + PUSH ECX + MOV ECX, EDX + XOR EDX, EDX + DIV ECX + POP ECX + MOV [ECX], EAX + MOV EAX, EDX +end; + +function ConvertInt32(Value: Cardinal; const Base: Cardinal; var Buffer: PWideChar): Cardinal; +// Buffer: Pointer to the END of the buffer to be filled. Upon return, Buffer +// will point to the first character in the string. The buffer will NOT be +// null-terminated. +// Result: Number of characters filled in buffer +begin + Result := 0; + repeat + Inc(Result); + Dec(Buffer); + Buffer^ := ConvertChars[ModDiv32(Value, Base, Value)]; + until Value = 0; +end; + +function ModDiv64(var Dividend: Int64; const Divisor: Cardinal; out Quotient: Int64): Int64; +{ Returns the quotient and modulus of the two inputs using unsigned division + Unsigned 64-bit division is not available in Delphi 5, but the System unit + does provide division and modulus functions accessible through assembler. + Quotient := Dividend div Divisor; + Result := Dividend mod Divisor; } +asm + PUSH 0 // prepare for second division + PUSH EDX + + PUSH DWORD PTR [EAX] // save dividend + PUSH DWORD PTR [EAX+4] + + PUSH ECX // save quotient + + PUSH 0 // prepare for first division + PUSH EDX + MOV EDX, [EAX+4] + MOV EAX, [EAX] + CALL System.@_lludiv + POP ECX // restore quotient + MOV [ECX], EAX // store quotient + MOV [ECX+4], EDX + + POP EDX // restore dividend + POP EAX + CALL System.@_llumod +end; + +function ConvertInt64(Value: Int64; const Base: Cardinal; var Buffer: PWideChar): Cardinal; +{ See ConvertInt32 for details + Result: Number of characters filled in buffer + Buffer: Pointer to first valid character in buffer } +begin + Result := 0; + repeat + Inc(Result); + Dec(Buffer); + Buffer^ := ConvertChars[ModDiv64(Value, Base, Value)]; + until Value = 0; +end; + +{$IFDEF FORMAT_EXTENSIONS} +function GetPClassName(const Cls: TClass): PShortString; +{ GetPClassName is similar to calling Cls.ClassName, but avoids the necessary + memory copy inherent in the function call. It also avoids a conversion from + ShortString to AnsiString, which would happen when the function's result got + type cast to PChar. Since all we really need is a pointer to the first byte + of the string, the bytes in the VMT are just as good as the bytes in a normal + AnsiString. + Result := JclSysUtils.GetVirtualMethod(Cls, vmtClassName div SizeOf(Pointer)); } +asm + MOV EAX, [EAX].vmtClassName +end; +{$ENDIF FORMAT_EXTENSIONS} + +{ The compiler's overflow checking must be disabled for the following two + procedures, which negate integers. For the rest of the code in this unit, + overflow isn't relevant. } + +{$Q-} + +procedure SafeNegate32(var Int: Integer); +begin + Int := -Int; +end; + +procedure SafeNegate64(var Int: Int64); +begin + Int := -Int; +end; + +{$IFDEF OVERFLOWCHECKS_ON} +{$Q+} +{$ENDIF OVERFLOWCHECKS_ON} + +// === Argument-preparation routines =========================================== + +procedure FetchStarArgument(const Arg: PVarRec; const ArgIndex: Cardinal; out Value: Cardinal); +const + AllowedStarTypes: TDelphiSet = [vtInteger{$IFDEF FORMAT_EXTENSIONS}, vtInt64, vtVariant{$ENDIF}]; +begin + case Arg^.VType of + vtInteger: + Value := Arg^.VInteger; + {$IFDEF FORMAT_EXTENSIONS} + vtVariant: + Value := Arg^.VVariant^; + vtInt64: + Value := Arg^.VInt64^; + {$ENDIF FORMAT_EXTENSIONS} + else + raise FormatBadArgumentTypeError(Arg.VType, ArgIndex, AllowedStarTypes); + end; +end; + +function PrepareFloat(const Format: WideString; const C: WideChar; + Prec: Cardinal; const Buffer: PConversionBuffer; const FormatStart, Src, ArgIndex: Cardinal; + const Arg: PVarRec; out CharCount: Cardinal): PAnsiChar; +{ The floating-point formats are all similar. The conversion eventually happens + in FloatToText. } +const + AllowedFloatTypes: TDelphiSet = [vtExtended, vtCurrency{$IFDEF FORMAT_EXTENSIONS}, vtVariant{$ENDIF}]; + // These default values are taken from the behavior of SysUtils.Format. + DefaultGeneralPrecision = 15; + GeneralDigits = 3; + DefaultFixedDigits = 2; + FixedPrecision = 18; + MaxFloatPrecision = 18; +var + ValueType: TFloatValue; + FloatVal: Pointer; + FloatFormat: TFloatFormat; + {$IFDEF FORMAT_EXTENSIONS} + TempCurr: Currency; + TempExt: Extended; + {$ENDIF FORMAT_EXTENSIONS} +begin + case Arg.VType of + vtExtended: + begin + ValueType := fvExtended; + FloatVal := Arg.VExtended; + end; + vtCurrency: + begin + ValueType := fvCurrency; + FloatVal := Arg.VCurrency; + end; + {$IFDEF FORMAT_EXTENSIONS} + vtVariant: + begin + // We can't give FloatToText a pointer to a Variant, so we extract the + // Variant's value and point to a temporary value instead. + if VarType(Arg.VVariant^) and varCurrency <> 0 then + begin + TempCurr := Arg.VVariant^; + FloatVal := @TempCurr; + ValueType := fvCurrency; + end + else + begin + TempExt := Arg.VVariant^; + FloatVal := @TempExt; + ValueType := fvExtended; + end; + end; + {$ENDIF FORMAT_EXTENSIONS} + else + raise FormatBadArgumentTypeErrorEx(Format, FormatStart, Src, Arg.VType, ArgIndex, AllowedFloatTypes); + end; // case Arg.VType + case C of + 'e', 'E': + FloatFormat := ffExponent; + 'f', 'F': + FloatFormat := ffFixed; + 'g', 'G': + FloatFormat := ffGeneral; + 'm', 'M': + FloatFormat := ffCurrency; + else {'n', 'N':} + FloatFormat := ffNumber; + end; + Result := PAnsiChar(Buffer); + // Prec is interpeted differently depending on the format. + if FloatFormat in [ffGeneral, ffExponent] then + begin + if (Prec = NoPrecision) or (Prec > MaxFloatPrecision) then + Prec := DefaultGeneralPrecision; + CharCount := FloatToText(Result, FloatVal^, ValueType, FloatFormat, Prec, GeneralDigits); + end + else {[ffFixed, ffNumber, ffCurrency]} + begin + if (Prec = NoPrecision) or (Prec > MaxFloatPrecision) then + begin + if FloatFormat = ffCurrency then + Prec := SysUtils.CurrencyDecimals + else + Prec := DefaultFixedDigits; + end; + CharCount := FloatToText(Result, FloatVal^, ValueType, FloatFormat, FixedPrecision, Prec); + end; +end; + +function PrepareInt(const Format: WideString; const C: WideChar; Prec: Cardinal; + const Buffer: PConversionBuffer; const FormatStart, Src, ArgIndex: Cardinal; + const Arg: PVarRec; out CharCount: Cardinal): PWideChar; +const + MaxIntPrecision = 16; + AllowedIntegerTypes: TDelphiSet = [vtInteger, vtInt64{$IFDEF FORMAT_EXTENSIONS}, vtVariant{$ENDIF}]; +var + // Integer-conversion variables + Base: Cardinal; // For decimal or hexadecimal + Temp32: Cardinal; + Temp64: Int64; + Neg: Boolean; +begin + if (C = 'x') or (C = 'X') then + Base := 16 + else + Base := 10; + case Arg^.VType of + vtInteger {$IFDEF FORMAT_EXTENSIONS}, vtVariant {$ENDIF}: + begin + {$IFDEF FORMAT_EXTENSIONS} + if Arg^.VType <> vtInteger then + Temp32 := Arg^.VVariant^ + else + {$ENDIF FORMAT_EXTENSIONS} + Temp32 := Cardinal(Arg^.VInteger); + // The value may be signed and negative, but the converter only + // interprets unsigned values. + Neg := ((C = 'd') or (C = 'D')) and (Integer(Temp32) < 0); + if Neg then + SafeNegate32(Integer(Temp32)); + Result := @Buffer[High(Buffer^)]; + CharCount := ConvertInt32(Temp32, Base, Result); + end; + vtInt64: + begin + Temp64 := Arg^.VInt64^; + // The value may be signed and negative, but the converter only + // interprets unsigned values. + Neg := ((C = 'd') or (C = 'D')) and (Temp64 < 0); + if Neg then + SafeNegate64(Temp64); + Result := @Buffer[High(Buffer^)]; + CharCount := ConvertInt64(Temp64, Base, Result); + end; + else + raise FormatBadArgumentTypeErrorEx(Format, FormatStart, Src, Arg.VType, ArgIndex, AllowedIntegerTypes); + end; + // If Prec was specified, then we need to see whether any + // zero-padding is necessary + if Prec > MaxIntPrecision then + Prec := NoPrecision; + if Prec <> NoPrecision then + while Prec > CharCount do + begin + Dec(PWideChar(Result)); + PWideChar(Result)^ := '0'; + Inc(CharCount); + end; + if Neg then + begin + Dec(PWideChar(Result)); + PWideChar(Result)^ := '-'; + Inc(CharCount); + end; + Assert(PWideChar(Result) >= Buffer); +end; + +function PreparePointer(const Format: WideString; const Buffer: PConversionBuffer; + const FormatStart, Src, ArgIndex: Cardinal; const Arg: PVarRec; + out CharCount: Cardinal): PWideChar; +{ The workings are similar to the integer-converting code above, but the pointer + specifier accepts a few more types that make it worth writing separate code. } +const + AllowedPointerTypes: TDelphiSet = [vtPointer{$IFDEF FORMAT_EXTENSIONS}, vtInterface, vtObject, vtPChar, vtPWideChar{$ENDIF}]; +begin + if Arg.VType in AllowedPointerTypes then + begin + Result := @Buffer[High(Buffer^)]; + CharCount := ConvertInt32(Cardinal(Arg.VInteger), 16, Result); + end + else + raise FormatBadArgumentTypeErrorEx(Format, FormatStart, Src, Arg.VType, ArgIndex, AllowedPointerTypes); + // Prec is ignored. Alternatively, it is assumed to be 8 + while (2 * SizeOf(Pointer)) > CharCount do + begin + Dec(PWideChar(Result)); + PWideChar(Result)^ := '0'; + Inc(CharCount); + end; + Assert(PWideChar(Result) >= Buffer); +end; + +function PrepareString(const Format: WideString; const Buffer: PConversionBuffer; + const FormatStart, Src, ArgIndex: Cardinal; const Arg: PVarRec; + out CharCount: Cardinal): Pointer; +{ This routine does not handle ALL the argument types for the %s specifier. It + does not handle Variant, and when FORMAT_EXTENSIONS is defined, it does not + handle Boolean, either. Those types require use of a temporary WideString + variable (TempWS), and if that were assigned here, then the pointer that this + function returns would be invalidated when the string goes out of scope. } +const + AllowedStringTypes: TDelphiSet = [vtChar, vtWideChar, vtString, vtPChar, vtPWideChar, vtVariant, vtAnsiString, vtWideString{$IFDEF FORMAT_EXTENSIONS}, vtBoolean, vtClass{$ENDIF}]; +begin + case Arg^.VType of + vtChar, vtWideChar: + begin + Assert(@Arg^.VChar = @Arg^.VWideChar); + Result := @Arg^.VChar; + CharCount := 1; + end; + vtString: // ShortString + begin + CharCount := Length(Arg^.VString^); + Result := @Arg^.VString^[1]; + end; + vtPChar: + begin + Result := Arg^.VPChar; + CharCount := StrLen(Result); + end; + vtPWideChar: + begin + Result := Arg^.VPWideChar; + CharCount := StrLenW(Result) + end; + {$IFDEF FORMAT_EXTENSIONS} + vtClass: + begin + Result := GetPClassName(Arg^.VClass); + CharCount := Length(PShortString(Result)^); + Inc(PAnsiChar(Result)); + end; + {$ENDIF FORMAT_EXTENSIONS} + vtAnsiString: + begin + Result := Arg^.VAnsiString; + CharCount := Length(AnsiString(Result)); + end; + vtWideString: + begin + Result := Arg^.VWideString; + CharCount := Length(WideString(Result)) + end; + else + raise FormatBadArgumentTypeErrorEx(Format, FormatStart, Src, Arg.VType, ArgIndex, AllowedStringTypes); + end; +end; + +// === WideFormat support routines ============================================= + +function EnsureStringLen(const NeededLen, CurrentLen: Cardinal; var S: WideString): Cardinal; +{ Lengthens a string, but always by doubling the current length. Returns the + string's new length. } +begin + // Assert(Cardinal(Length(S)) = CurrentLen); + Result := CurrentLen; + if NeededLen > Result then + begin + repeat + Result := Result * 2; + until NeededLen <= Result; + SetLength(S, Result); + end; + // Assert(Cardinal(Length(S)) >= NeededLen); +end; + +procedure CopyBuffer(var Dest: WideString; const CharCount: Cardinal; const Source: Pointer; var ResultLen, DestIndex: Cardinal); +begin + ResultLen := EnsureStringLen(DestIndex + CharCount - 1, ResultLen, Dest); + MoveWideChar(Source^, Dest[DestIndex], CharCount); + Inc(DestIndex, CharCount); +end; + +function FillWideChar(var X; Count: Cardinal; const Value: WideChar): Cardinal; +var + PW: PWideChar; +begin + Result := Count; + PW := @X; + for Count := Count downto 1 do + begin + PW^ := Value; + Inc(PW); + end; +end; + +// === Error-handling functions ================================================ + +function FormatNoArgumentError(const ArgIndex: Cardinal): Exception; +begin + Result := EConvertError.CreateResFmt(PResStringRec(@RsFormatNoArgument), [ArgIndex]); +end; + +function FormatNoArgumentErrorEx(const Format: WideString; const FormatStart, FormatEnd, ArgIndex: Cardinal): Exception; +begin + Result := EConvertError.CreateResFmt(PResStringRec(@RsFormatNoArgumentEx), [ArgIndex, Copy(Format, FormatStart, FormatStart - FormatEnd + 1)]); +end; + +function FormatSyntaxError(const CharIndex: Cardinal): Exception; +begin + Result := EConvertError.CreateResFmt(PResStringRec(@RsFormatSyntaxError), [CharIndex]); +end; + +const + VarRecTypes: array [vtInteger..vtInt64] of PChar = ( + 'Integer', 'Boolean', 'Char', 'Extended', 'ShortString', 'Pointer', 'PChar', + 'TObject', 'TClass', 'WideChar', 'PWideChar', 'AnsiString', 'Currency', + 'Variant', 'IUnknown', 'WideString', 'Int64' + ); + +function GetTypeList(const Types: TDelphiSet): string; +var + T: Byte; + List: TStrings; +begin + List := TStringList.Create; + try + for T := Low(VarRecTypes) to High(VarRecTypes) do + begin + if T in Types then + List.Add(VarRecTypes[T]); + end; + Result := List.CommaText; + finally + List.Free; + end; +end; + +function FormatBadArgumentTypeError(const VType: Byte; const ArgIndex: Cardinal; const Allowed: TDelphiSet): Exception; +var + FoundType, AllowedTypes: string; +begin + FoundType := VarRecTypes[VType]; + AllowedTypes := GetTypeList(Allowed); + Result := EConvertError.CreateResFmt(PResStringRec(@RsFormatBadArgumentType), [FoundType, ArgIndex, AllowedTypes]); +end; + +function FormatBadArgumentTypeErrorEx(const Format: WideString; const FormatStart, FormatEnd: Cardinal; const VType: Byte; const ArgIndex: Cardinal; const Allowed: TDelphiSet): Exception; +var + FoundType, AllowedTypes: string; +begin + FoundType := VarRecTypes[VType]; + AllowedTypes := GetTypeList(Allowed); + Result := EConvertError.CreateResFmt(PResStringRec(@RsFormatBadArgumentTypeEx), [FoundType, ArgIndex, Copy(Format, FormatStart, FormatEnd - FormatStart + 1), AllowedTypes]); +end; + +// History: + +// $Log: JclWideFormat.pas,v $ +// Revision 1.10 2006/01/15 12:29:49 outchy +// IT3393: WideFormat not formating because of a dandling pointer +// +// Revision 1.9 2005/03/11 20:31:05 rrossmair +// - refactored (and tested with D5 & D9) by Rob Kennedy +// +// Revision 1.7 2005/03/08 08:33:23 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.6 2005/03/01 00:55:50 ahuser +// Delphi 2005 compiler bug workaround +// +// Revision 1.5 2005/02/27 07:27:47 marquardt +// moved resourcestrings to JclResource.pas +// +// Revision 1.4 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.3 2005/02/24 07:36:25 marquardt +// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas +// +// Revision 1.2 2005/02/22 07:55:18 rrossmair +// - issue #2662 fixed (internal error C6662 when compiling with D2005) +// +// Revision 1.1 2005/02/14 00:45:50 rrossmair +// - initial check-in +// + +end. diff --git a/official/1.96/source/windows/JclWin32.pas b/official/1.96/source/windows/JclWin32.pas new file mode 100644 index 0000000..945b262 --- /dev/null +++ b/official/1.96/source/windows/JclWin32.pas @@ -0,0 +1,7690 @@ +{**************************************************************************************************} +{ 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) } +{ } +{**************************************************************************************************} +{ } +{ 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: 2005/12/12 21:54:10 $ + +unit JclWin32; + +{$I jcl.inc} + + +{$MINENUMSIZE 4} +{$ALIGN ON} +{$WARNINGS OFF} + +interface + +uses + Windows, SysUtils, + {$IFNDEF FPC} + {$IFDEF CLR} + System.Runtime.InteropServices, System.Security, + {$ELSE} + AccCtrl, + {$ENDIF CLR} + ActiveX, + {$ENDIF ~FPC} + JclBase; + +{$HPPEMIT ''} +{$HPPEMIT '#include "WinDef.h"'} +{$HPPEMIT '#include "WinNT.h"'} +{$HPPEMIT '#include "WinBase.h"'} +{$HPPEMIT '#include "BaseTsd.h"'} +{$HPPEMIT '#include "ImageHlp.h"'} +{$HPPEMIT '#include "lm.h"'} +{$HPPEMIT '#include "Nb30.h"'} +{$HPPEMIT '#include "RasDlg.h"'} +{$HPPEMIT '#include "Reason.h"'} +{$HPPEMIT '#include "ShlWApi.h"'} +{$HPPEMIT '#include "WinError.h"'} +{$HPPEMIT '#include "WinIoCtl.h"'} +{$HPPEMIT '#include "WinUser.h"'} + +{$HPPEMIT '#include '} +{$HPPEMIT ''} + +{$IFDEF CLR} +type + LPSTR = string; + LPWSTR = string; + LPCSTR = string; + LPCWSTR = string; + LPCTSTR = string; + PLongWord = ^LongWord; + PByte = IntPtr; +{$ENDIF CLR} + +{$IFDEF FPC} +// include file for FPC compatibility +// JclWin32 include file for FPC compatibility + +// from unit Windows +const + + // from WinReg.h + HKEY_CLASSES_ROOT = DWORD($80000000); + HKEY_CURRENT_USER = DWORD($80000001); + HKEY_LOCAL_MACHINE = DWORD($80000002); + HKEY_USERS = DWORD($80000003); + HKEY_PERFORMANCE_DATA = DWORD($80000004); + HKEY_CURRENT_CONFIG = DWORD($80000005); + HKEY_DYN_DATA = DWORD($80000006); + + // from WinVer.h + VOS__BASE = 0; + VOS__WINDOWS16 = 1; + VOS__PM16 = 2; + VOS__PM32 = 3; + VOS__WINDOWS32 = 4; + +{ VS_VERSION.dwFileSubtype for VFT_WINDOWS_DRV } + + VFT2_UNKNOWN = 0; + VFT2_DRV_PRINTER = 1; + VFT2_DRV_KEYBOARD = 2; + VFT2_DRV_LANGUAGE = 3; + VFT2_DRV_DISPLAY = 4; + VFT2_DRV_MOUSE = 5; + VFT2_DRV_NETWORK = 6; + VFT2_DRV_SYSTEM = 7; + VFT2_DRV_INSTALLABLE = 8; + VFT2_DRV_SOUND = 9; + VFT2_DRV_COMM = 10; + +type + // from WinBase.h + _GET_FILEEX_INFO_LEVELS = (GetFileExInfoStandard, GetFileExMaxInfoLevel); + TGetFileExInfoLevels = _GET_FILEEX_INFO_LEVELS; + GET_FILEEX_INFO_LEVELS = _GET_FILEEX_INFO_LEVELS; + +type + PKeyboardState = ^TKeyboardState; + TKeyboardState = array [0..255] of Byte; + +// from unit AccCtrl +type + SE_OBJECT_TYPE = ( + SE_UNKNOWN_OBJECT_TYPE, + SE_FILE_OBJECT, + SE_SERVICE, + SE_PRINTER, + SE_REGISTRY_KEY, + SE_LMSHARE, + SE_KERNEL_OBJECT, + SE_WINDOW_OBJECT, + SE_DS_OBJECT, + SE_DS_OBJECT_ALL, + SE_PROVIDER_DEFINED_OBJECT, + SE_WMIGUID_OBJECT + ); + +// from ActiveX +const + // from OleIdl.h, OleIdl.Idl + DROPEFFECT_NONE = 0; + DROPEFFECT_COPY = 1; + DROPEFFECT_MOVE = 2; + DROPEFFECT_LINK = 4; + DROPEFFECT_SCROLL = DWORD($80000000); + + +{$ENDIF FPC} + +type + +// +// Unsigned Basics +// + + USHORT = Word; + {$EXTERNALSYM USHORT} + + +//================================================================================================== +// presumable from any older WinNT.h or from WinIfs.h +//================================================================================================== + +{$IFNDEF CLR} +//-------------------------------------------------------------------------------------------------- +// 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 and MountPointReparseBuffer + SubstituteNameOffset: Word; + SubstituteNameLength: Word; + PrintNameOffset: Word; + PrintNameLength: Word; + PathBuffer: array [0..0] of WCHAR); + 1: ( // GenericReparseBuffer + DataBuffer: array [0..0] of Byte); + 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); +{$ENDIF ~CLR} + +//================================================================================================== + +// from JwaWinNT.pas (few declarations from JwaWinType) + +type + ULONGLONG = Int64; + {$EXTERNALSYM ULONGLONG} + +const + MAXLONGLONG = $7fffffffffffffff; + {$EXTERNALSYM MAXLONGLONG} + +type + PLONGLONG = ^LONGLONG; + {$EXTERNALSYM PLONGLONG} + PULONGLONG = ^ULONGLONG; + {$EXTERNALSYM PULONGLONG} + +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} + +// 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[] - - - - - - - - -+ +// | | +// +---------------------------------------------------------------+ +// +// + +type + // 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; + +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} + + {$IFNDEF CLR} + SECURITY_MAX_SID_SIZE = SizeOf(SID) - SizeOf(DWORD) + (SID_MAX_SUB_AUTHORITIES * SizeOf(DWORD)); + {$EXTERNALSYM SECURITY_MAX_SID_SIZE} + {$ENDIF ~CLR} + +{$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} +{$ENDIF ~FPC} + +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; + +///////////////////////////////////////////////////////////////////////////// +// // +// 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} + + +// line 2686 + +// +// Token information class structures +// + +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; + +// 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_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_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 CLR} + +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; + +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. +// + +{$IFDEF FPC} + +type + PIMAGE_DATA_DIRECTORY = ^IMAGE_DATA_DIRECTORY; + {$EXTERNALSYM PIMAGE_DATA_DIRECTORY} + _IMAGE_DATA_DIRECTORY = record + VirtualAddress: DWORD; + Size: DWORD; + end; + {$EXTERNALSYM _IMAGE_DATA_DIRECTORY} + IMAGE_DATA_DIRECTORY = _IMAGE_DATA_DIRECTORY; + {$EXTERNALSYM IMAGE_DATA_DIRECTORY} + TImageDataDirectory = IMAGE_DATA_DIRECTORY; + PImageDataDirectory = PIMAGE_DATA_DIRECTORY; + +{$ENDIF FPC} + +const + IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16; + {$EXTERNALSYM IMAGE_NUMBEROF_DIRECTORY_ENTRIES} + +// +// Optional header format. +// + +type + PIMAGE_OPTIONAL_HEADER32 = ^IMAGE_OPTIONAL_HEADER32; + {$EXTERNALSYM PIMAGE_OPTIONAL_HEADER32} + +{$IFDEF FPC} + + _IMAGE_OPTIONAL_HEADER = record + // + // Standard fields. + // + Magic: Word; + MajorLinkerVersion: Byte; + MinorLinkerVersion: Byte; + SizeOfCode: DWORD; + SizeOfInitializedData: DWORD; + SizeOfUninitializedData: DWORD; + AddressOfEntryPoint: DWORD; + BaseOfCode: DWORD; + BaseOfData: DWORD; + // + // NT additional fields. + // + ImageBase: DWORD; + 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: DWORD; + SizeOfStackCommit: DWORD; + SizeOfHeapReserve: DWORD; + SizeOfHeapCommit: DWORD; + LoaderFlags: DWORD; + NumberOfRvaAndSizes: DWORD; + DataDirectory: array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of IMAGE_DATA_DIRECTORY; + end; + {$EXTERNALSYM _IMAGE_OPTIONAL_HEADER} + +{$ENDIF FPC} + + 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; + +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} + +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; + +{$IFDEF FPC} + + PIMAGE_ROM_HEADERS = ^IMAGE_ROM_HEADERS; + {$EXTERNALSYM PIMAGE_ROM_HEADERS} + _IMAGE_ROM_HEADERS = record + FileHeader: IMAGE_FILE_HEADER; + OptionalHeader: IMAGE_ROM_OPTIONAL_HEADER; + end; + {$EXTERNALSYM _IMAGE_ROM_HEADERS} + IMAGE_ROM_HEADERS = _IMAGE_ROM_HEADERS; + {$EXTERNALSYM IMAGE_ROM_HEADERS} + TImageRomHeaders = IMAGE_ROM_HEADERS; + PImageRomHeaders = PIMAGE_ROM_HEADERS; + + IMAGE_NT_HEADERS = IMAGE_NT_HEADERS32; + {$EXTERNALSYM IMAGE_NT_HEADERS} + PIMAGE_NT_HEADERS = PIMAGE_NT_HEADERS32; + {$EXTERNALSYM PIMAGE_NT_HEADERS} + + PImageNtHeaders = PIMAGE_NT_HEADERS; + +{$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 +{$IFDEF FPC} + + TImgSecHdrMisc = record + case Integer of + 0: (PhysicalAddress: DWORD); + 1: (VirtualSize: DWORD); + end; + + PIMAGE_SECTION_HEADER = ^IMAGE_SECTION_HEADER; + {$EXTERNALSYM PIMAGE_SECTION_HEADER} + _IMAGE_SECTION_HEADER = record + Name: array [0..IMAGE_SIZEOF_SHORT_NAME - 1] of BYTE; + Misc: TImgSecHdrMisc; + VirtualAddress: DWORD; + SizeOfRawData: DWORD; + PointerToRawData: DWORD; + PointerToRelocations: DWORD; + PointerToLinenumbers: DWORD; + NumberOfRelocations: WORD; + NumberOfLinenumbers: WORD; + Characteristics: DWORD; + end; + {$EXTERNALSYM _IMAGE_SECTION_HEADER} + IMAGE_SECTION_HEADER = _IMAGE_SECTION_HEADER; + {$EXTERNALSYM IMAGE_SECTION_HEADER} + TImageSectionHeader = IMAGE_SECTION_HEADER; + PImageSectionHeader = PIMAGE_SECTION_HEADER; + +{$ENDIF FPC} + + 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; + PImageTlsDirectory64 = PIMAGE_TLS_DIRECTORY64; + + 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; + PImageTlsDirectory32 = PIMAGE_TLS_DIRECTORY32; + +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; + PImageTlsDirectory = PImageTlsDirectory32; + + 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 CHAR; + 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 +// + +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; + +// 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} +*) +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; + +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 + +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; + +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. +// + + 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; + +// +// 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} + +{$ENDIF ~CLR} + +// 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; + {$EXTERNALSYM IMAGE_COR20_HEADER} + PIMAGE_COR20_HEADER = ^IMAGE_COR20_HEADER; + {$EXTERNALSYM PIMAGE_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 CHAR; // 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 UNICODE} + + OSVERSIONINFOEX = OSVERSIONINFOEXW; + {$EXTERNALSYM OSVERSIONINFOEX} + POSVERSIONINFOEX = POSVERSIONINFOEXW; + {$EXTERNALSYM POSVERSIONINFOEX} + LPOSVERSIONINFOEX = LPOSVERSIONINFOEXW; + {$EXTERNALSYM LPOSVERSIONINFOEX} + TOSVersionInfoEx = TOSVersionInfoExW; + +{$ELSE} + + OSVERSIONINFOEX = OSVERSIONINFOEXA; + {$EXTERNALSYM OSVERSIONINFOEX} + POSVERSIONINFOEX = POSVERSIONINFOEXA; + {$EXTERNALSYM POSVERSIONINFOEX} + LPOSVERSIONINFOEX = LPOSVERSIONINFOEXA; + {$EXTERNALSYM LPOSVERSIONINFOEX} + TOSVersionInfoEx = TOSVersionInfoExA; + +{$ENDIF} + +// +// 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} + +// 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 3189 + + +function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; + out lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; var lpContext: {$IFDEF CLR}IntPtr{$ELSE}Pointer{$ENDIF}): BOOL; stdcall; + {$IFDEF CLR}external kernel32 name 'BackupSeek';{$ENDIF} +{$EXTERNALSYM BackupSeek} + +// line 5454 + +function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; + const NewState: TTokenPrivileges; BufferLength: DWORD; + {$IFDEF CLR} + out PreviousState: TTokenPrivileges; + out ReturnLength: DWORD + {$ELSE} + PreviousState: PTokenPrivileges; + ReturnLength: PDWORD + {$ENDIF CLR} + ): BOOL; stdcall; + {$IFDEF CLR} external advapi32 name 'AdjustTokenPrivileges';{$ENDIF} +{$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 +} +{$IFNDEF CLR} +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: DWORD; lpName: PChar): THandle; stdcall; +{$EXTERNALSYM CreateMutex} +{$ENDIF ~CLR} + +// alternative conversion for WinNT 4.0 SP6 and later (OSVersionInfoEx instead of OSVersionInfo) +{$EXTERNALSYM GetVersionEx} +function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall; overload; + {$IFDEF CLR}external version name 'GetVersionEx';{$ENDIF} +{$IFNDEF CLR} +{$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 SetFileSecurityA} + +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 GetFileSecurityA} + +// WinBase.h line 10251 + +function SetVolumeMountPoint(lpszVolumeMountPoint, lpszVolumeName: LPCSTR): BOOL; stdcall; +{$EXTERNALSYM SetVolumeMountPoint} + +function DeleteVolumeMountPoint(lpszVolumeMountPoint: LPCSTR): BOOL; stdcall; +{$EXTERNALSYM DeleteVolumeMountPoint} + +function GetVolumeNameForVolumeMountPoint(lpszVolumeMountPoint: LPCSTR; + lpszVolumeName: LPSTR; cchBufferLength: DWORD): BOOL; stdcall; +{$EXTERNALSYM GetVolumeNameForVolumeMountPoint} + +{$ENDIF ~CLR} + +type + {$EXTERNALSYM ULONG_PTR} + ULONG_PTR = LongWord; // Need to have the same size like Pointer + {$EXTERNALSYM DWORD_PTR} + DWORD_PTR = ULONG_PTR; + {$EXTERNALSYM PDWORD_PTR} + PDWORD_PTR = ^PLongWord; + +// From JwaAclApi + +// line 185 + +{$IFNDEF CLR} +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: PChar; + hFile: THandle; + MappedAddress: PAnsiChar; // 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; + +// line 152 + +function ReBaseImage(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL; + fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG; + var OldImageSize: ULONG; var OldImageBase: ULONG_PTR; var NewImageSize: ULONG; + var NewImageBase: ULONG_PTR; TimeStamp: ULONG): BOOL; stdcall; +{$EXTERNALSYM ReBaseImage} + +// 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: PChar; 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 ~CLR} + +// 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} + +function UnDecorateSymbolName(DecoratedName: {$IFDEF CLR}string{$ELSE}PAnsiChar{$ENDIF}; + UnDecoratedName: {$IFDEF CLR}string{$ELSE}PAnsiChar{$ENDIF}; UndecoratedLength: DWORD; Flags: DWORD): DWORD; stdcall; + {$IFDEF CLR}external 'imagehlp.dll' name 'UnDecorateSymbolName';{$ENDIF} +{$EXTERNALSYM UnDecorateSymbolName} + + + + +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} + +type + LMSTR = LPSTR; + {$EXTERNALSYM LMSTR} + LMCSTR = LPCSTR; + {$EXTERNALSYM LMCSTR} + +{$ENDIF} + + +// +// 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 +// + +{$IFNDEF CLR} + +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 ~CLR} +// +// Data Structures - User +// + +type + 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; + + 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; + + 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: {$IFDEF CLR}IntPtr{$ELSE}PBYTE{$ENDIF}; + 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; + +// 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 +// + +{$IFNDEF CLR} + +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 ~CLR} + +// +// 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 +// + +{$IFNDEF CLR} + +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 ~CLR} + +// +// Data Structures - LocalGroup +// + +type + 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; + + 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; + + 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; + + 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; + + 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; + +{$IFNDEF CLR} + +function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall; +{$EXTERNALSYM NetApiBufferFree} + +(**************************************************************** + * * + * 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 + PNCB = ^NCB; + + TNcbPost = procedure (P: PNCB); stdcall; + + _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: PChar; // address of message buffer + ncb_length: Word; // size of message buffer + ncb_callname: array [0..NCBNAMSZ - 1] of Char; // blank-padded name of remote + ncb_name: array [0..NCBNAMSZ - 1] of Char; // 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 Char; // reserved, used by BIOS + {$ELSE} + ncb_reserve: array [0..9] of Char; // reserved, used by BIOS + {$ENDIF} + 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; + +// +// Structure returned to the NCB command NCBASTAT is ADAPTER_STATUS followed +// by an array of NAME_BUFFER structures. +// + + _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 Char; + 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; + +// 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. +// + +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; + +// 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. +// + +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; + +// +// Structure returned to the NCB command NCBFINDNAME is FIND_NAME_HEADER followed +// by an array of FIND_NAME_BUFFER structures. +// + +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; + +// Values for transport_id + +const + ALL_TRANSPORTS = 'M'#0#0#0; + {$EXTERNALSYM ALL_TRANSPORTS} + MS_NBF = 'MNBF'; + {$EXTERNALSYM MS_NBF} + +{$ENDIF ~CLR} + +(**************************************************************** + * * + * 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 ); * + ****************************************************************) + +{$IFNDEF CLR} +function Netbios(pncb: PNCB): UCHAR; stdcall; +{$EXTERNALSYM Netbios} +{$ENDIF ~CLR} + +type + PRasDialDlg = ^TRasDialDlg; + tagRASDIALDLG = packed record + dwSize: DWORD; + hwndOwner: THandle; + 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_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_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_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} + + +{ 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_ENUMPROCEXA = function (lpCalendarInfoString: LPSTR; Calendar: CALID): BOOL; stdcall; + {$EXTERNALSYM CALINFO_ENUMPROCEXA} + TCalInfoEnumProcExA = CALINFO_ENUMPROCEXA; + +// line 1635 + + +{$IFNDEF CLR} +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 EnumCalendarInfoExA(lpCalInfoEnumProcEx: CALINFO_ENUMPROCEXA; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall; +{$EXTERNALSYM EnumCalendarInfoExA} + +{$ENDIF ~CLR} + +type + {$IFDEF CLR} + MAKEINTRESOURCEA = Integer; + MAKEINTRESOURCEW = Integer; + {$ELSE} + MAKEINTRESOURCEA = LPSTR; + {$EXTERNALSYM MAKEINTRESOURCEA} + MAKEINTRESOURCEW = LPWSTR; + {$EXTERNALSYM MAKEINTRESOURCEW} + {$ENDIF CLR} +{$IFDEF UNICODE} + MAKEINTRESOURCE = MAKEINTRESOURCEW; + {$EXTERNALSYM MAKEINTRESOURCE} +{$ELSE} + MAKEINTRESOURCE = MAKEINTRESOURCEA; + {$EXTERNALSYM MAKEINTRESOURCE} +{$ENDIF} + +// +// 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} + + + +{$IFNDEF CLR} + +type + { TODO : Source unknown } + {$EXTERNALSYM ImgDelayDescr} + ImgDelayDescr = packed record + grAttrs: DWORD; // attributes + szName: DWORD; // pointer to dll name + phmod: PDWORD; // address of module handle + { TODO : probably wrong declaration } + pIAT: TImageThunkData; // address of the IAT + { TODO : probably wrong declaration } + pINT: TImageThunkData; // address of the INT + { TODO : probably wrong declaration } + pBoundIAT: TImageThunkData; // address of the optional bound IAT + { TODO : probably wrong declaration } + pUnloadIAT: TImageThunkData; // 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; + TImgDelayDescr = ImgDelayDescr; + PImgDelayDescr = ^ImgDelayDescr; + +(* + // DelayImp.h, Borland BCC 5.5 + {$EXTERNALSYM ImgDelayDescr} + ImgDelayDescr = packed record + grAttrs: DWORD; // attributes + szName: LPCSTR; // pointer to dll name + { TODO : probably wrong declaration } + hmod: HMODULE; // address of module handle + pIAT: PIMAGE_THUNK_DATA; // address of the IAT + pINT: PIMAGE_THUNK_DATA; // address of the INT + pBoundIAT: PIMAGE_THUNK_DATA; // address of the optional bound IAT + pUnloadIAT: PIMAGE_THUNK_DATA; // 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; + TImgDelayDescr = ImgDelayDescr; + PImgDelayDescr = ^ImgDelayDescr; + + + // Microsoft version (64 bit SDK) + {$EXTERNALSYM RVA} + RVA = DWORD; + + {$EXTERNALSYM ImgDelayDescr} + ImgDelayDescr = 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 PImgDelayDescr} + PImgDelayDescr = ImgDelayDescr; + TImgDelayDescr = ImgDelayDescr; +*) + +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; + + RtdlEnumCalendarInfoExA: function(lpCalInfoEnumProc: TCalInfoEnumProcExA; + Locale: LCID; Calendar: CALID; CalType: CALTYPE): BOOL; stdcall = EnumCalendarInfoExA; + + RtdlGetVolumeNameForVolumeMountPoint: function(lpszVolumeMountPoint: LPCSTR; + lpszVolumeName: LPSTR; cchBufferLength: DWORD): BOOL; stdcall = GetVolumeNameForVolumeMountPoint; + + RtdlSetVolumeMountPoint: function(lpszVolumeMountPoint: LPCSTR; + lpszVolumeName: LPCSTR): BOOL; stdcall = SetVolumeMountPoint; + + RtdlDeleteVolumeMountPoint: function(lpszVolumeMountPoint: LPCSTR): BOOL; + stdcall = DeleteVolumeMountPoint; + + RtdlNetBios: function(P: PNCB): UCHAR; stdcall = NetBios; + +{$ENDIF ~CLR} + +implementation + +uses + JclResources; + +const + {$IFDEF UNICODE} + AWSuffix = 'W'; + {$ELSE ~UNICODE} + AWSuffix = 'A'; + {$ENDIF ~UNICODE} + +{$IFNDEF CLR} + +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 := LoadLibrary(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; + + +const + aclapilib = 'advapi32.dll'; + +var + _SetNamedSecurityInfoW: Pointer; + +function SetNamedSecurityInfoW; +begin + GetProcedureAddress(_SetNamedSecurityInfoW, aclapilib, 'SetNamedSecurityInfoW'); + asm + mov esp, ebp + pop ebp + jmp [_SetNamedSecurityInfoW] + end; +end; + + + +const + ImageHlpLib = 'imagehlp.dll'; + +var + _ReBaseImage: Pointer; + +function ReBaseImage; +begin + GetProcedureAddress(_ReBaseImage, ImageHlpLib, 'ReBaseImage'); + asm + mov esp, ebp + pop ebp + jmp [_ReBaseImage] + end; +end; + +var + _CheckSumMappedFile: Pointer; + +function CheckSumMappedFile; +begin + GetProcedureAddress(_CheckSumMappedFile, ImageHlpLib, 'CheckSumMappedFile'); + asm + mov esp, ebp + pop ebp + jmp [_CheckSumMappedFile] + end; +end; + +var + _GetImageUnusedHeaderBytes: Pointer; + +function GetImageUnusedHeaderBytes; +begin + GetProcedureAddress(_GetImageUnusedHeaderBytes, ImageHlpLib, 'GetImageUnusedHeaderBytes'); + asm + mov esp, ebp + pop ebp + jmp [_GetImageUnusedHeaderBytes] + end; +end; + +var + _MapAndLoad: Pointer; + +function MapAndLoad; +begin + GetProcedureAddress(_MapAndLoad, ImageHlpLib, 'MapAndLoad'); + asm + mov esp, ebp + pop ebp + jmp [_MapAndLoad] + end; +end; + +var + _UnMapAndLoad: Pointer; + +function UnMapAndLoad; +begin + GetProcedureAddress(_UnMapAndLoad, ImageHlpLib, 'UnMapAndLoad'); + asm + mov esp, ebp + pop ebp + jmp [_UnMapAndLoad] + end; +end; + +var + _TouchFileTimes: Pointer; + +function TouchFileTimes; +begin + GetProcedureAddress(_TouchFileTimes, ImageHlpLib, 'TouchFileTimes'); + asm + mov esp, ebp + pop ebp + jmp [_TouchFileTimes] + end; +end; + +var + _ImageDirectoryEntryToData: Pointer; + +function ImageDirectoryEntryToData; +begin + GetProcedureAddress(_ImageDirectoryEntryToData, ImageHlpLib, 'ImageDirectoryEntryToData'); + asm + mov esp, ebp + pop ebp + jmp [_ImageDirectoryEntryToData] + end; +end; + +var + _ImageRvaToSection: Pointer; + +function ImageRvaToSection; +begin + GetProcedureAddress(_ImageRvaToSection, ImageHlpLib, 'ImageRvaToSection'); + asm + mov esp, ebp + pop ebp + jmp [_ImageRvaToSection] + end; +end; + +var + _ImageRvaToVa: Pointer; + +function ImageRvaToVa; +begin + GetProcedureAddress(_ImageRvaToVa, ImageHlpLib, 'ImageRvaToVa'); + asm + mov esp, ebp + pop ebp + jmp [_ImageRvaToVa] + end; +end; + +var + _UnDecorateSymbolName: Pointer; + +function UnDecorateSymbolName; +begin + GetProcedureAddress(_UnDecorateSymbolName, ImageHlpLib, 'UnDecorateSymbolName'); + asm + mov esp, ebp + pop ebp + jmp [_UnDecorateSymbolName] + end; +end; + + + + +var + _NetUserAdd: Pointer; + +function NetUserAdd; +begin + GetProcedureAddress(_NetUserAdd, netapi32, 'NetUserAdd'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserAdd] + end; +end; + +var + _NetUserEnum: Pointer; + +function NetUserEnum; +begin + GetProcedureAddress(_NetUserEnum, netapi32, 'NetUserEnum'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserEnum] + end; +end; + +var + _NetUserGetInfo: Pointer; + +function NetUserGetInfo; +begin + GetProcedureAddress(_NetUserGetInfo, netapi32, 'NetUserGetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserGetInfo] + end; +end; + +var + _NetUserSetInfo: Pointer; + +function NetUserSetInfo; +begin + GetProcedureAddress(_NetUserSetInfo, netapi32, 'NetUserSetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserSetInfo] + end; +end; + +var + _NetUserDel: Pointer; + +function NetUserDel; +begin + GetProcedureAddress(_NetUserDel, netapi32, 'NetUserDel'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserDel] + end; +end; + +var + _NetUserGetGroups: Pointer; + +function NetUserGetGroups; +begin + GetProcedureAddress(_NetUserGetGroups, netapi32, 'NetUserGetGroups'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserGetGroups] + end; +end; + +var + _NetUserSetGroups: Pointer; + +function NetUserSetGroups; +begin + GetProcedureAddress(_NetUserSetGroups, netapi32, 'NetUserSetGroups'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserSetGroups] + end; +end; + +var + _NetUserGetLocalGroups: Pointer; + +function NetUserGetLocalGroups; +begin + GetProcedureAddress(_NetUserGetLocalGroups, netapi32, 'NetUserGetLocalGroups'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserGetLocalGroups] + end; +end; + +var + _NetUserModalsGet: Pointer; + +function NetUserModalsGet; +begin + GetProcedureAddress(_NetUserModalsGet, netapi32, 'NetUserModalsGet'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserModalsGet] + end; +end; + +var + _NetUserModalsSet: Pointer; + +function NetUserModalsSet; +begin + GetProcedureAddress(_NetUserModalsSet, netapi32, 'NetUserModalsSet'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserModalsSet] + end; +end; + +var + _NetUserChangePassword: Pointer; + +function NetUserChangePassword; +begin + GetProcedureAddress(_NetUserChangePassword, netapi32, 'NetUserChangePassword'); + asm + mov esp, ebp + pop ebp + jmp [_NetUserChangePassword] + end; +end; + +var + _NetGroupAdd: Pointer; + +function NetGroupAdd; +begin + GetProcedureAddress(_NetGroupAdd, netapi32, 'NetGroupAdd'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupAdd] + end; +end; + +var + _NetGroupAddUser: Pointer; + +function NetGroupAddUser; +begin + GetProcedureAddress(_NetGroupAddUser, netapi32, 'NetGroupAddUser'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupAddUser] + end; +end; + +var + _NetGroupEnum: Pointer; + +function NetGroupEnum; +begin + GetProcedureAddress(_NetGroupEnum, netapi32, 'NetGroupEnum'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupEnum] + end; +end; + +var + _NetGroupGetInfo: Pointer; + +function NetGroupGetInfo; +begin + GetProcedureAddress(_NetGroupGetInfo, netapi32, 'NetGroupGetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupGetInfo] + end; +end; + +var + _NetGroupSetInfo: Pointer; + +function NetGroupSetInfo; +begin + GetProcedureAddress(_NetGroupSetInfo, netapi32, 'NetGroupSetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupSetInfo] + end; +end; + +var + _NetGroupDel: Pointer; + +function NetGroupDel; +begin + GetProcedureAddress(_NetGroupDel, netapi32, 'NetGroupDel'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupDel] + end; +end; + +var + _NetGroupDelUser: Pointer; + +function NetGroupDelUser; +begin + GetProcedureAddress(_NetGroupDelUser, netapi32, 'NetGroupDelUser'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupDelUser] + end; +end; + +var + _NetGroupGetUsers: Pointer; + +function NetGroupGetUsers; +begin + GetProcedureAddress(_NetGroupGetUsers, netapi32, 'NetGroupGetUsers'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupGetUsers] + end; +end; + +var + _NetGroupSetUsers: Pointer; + +function NetGroupSetUsers; +begin + GetProcedureAddress(_NetGroupSetUsers, netapi32, 'NetGroupSetUsers'); + asm + mov esp, ebp + pop ebp + jmp [_NetGroupSetUsers] + end; +end; + +var + _NetLocalGroupAdd: Pointer; + +function NetLocalGroupAdd; +begin + GetProcedureAddress(_NetLocalGroupAdd, netapi32, 'NetLocalGroupAdd'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupAdd] + end; +end; + +var + _NetLocalGroupAddMember: Pointer; + +function NetLocalGroupAddMember; +begin + GetProcedureAddress(_NetLocalGroupAddMember, netapi32, 'NetLocalGroupAddMember'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupAddMember] + end; +end; + +var + _NetLocalGroupEnum: Pointer; + +function NetLocalGroupEnum; +begin + GetProcedureAddress(_NetLocalGroupEnum, netapi32, 'NetLocalGroupEnum'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupEnum] + end; +end; + +var + _NetLocalGroupGetInfo: Pointer; + +function NetLocalGroupGetInfo; +begin + GetProcedureAddress(_NetLocalGroupGetInfo, netapi32, 'NetLocalGroupGetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupGetInfo] + end; +end; + +var + _NetLocalGroupSetInfo: Pointer; + +function NetLocalGroupSetInfo; +begin + GetProcedureAddress(_NetLocalGroupSetInfo, netapi32, 'NetLocalGroupSetInfo'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupSetInfo] + end; +end; + +var + _NetLocalGroupDel: Pointer; + +function NetLocalGroupDel; +begin + GetProcedureAddress(_NetLocalGroupDel, netapi32, 'NetLocalGroupDel'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupDel] + end; +end; + +var + _NetLocalGroupDelMember: Pointer; + +function NetLocalGroupDelMember; +begin + GetProcedureAddress(_NetLocalGroupDelMember, netapi32, 'NetLocalGroupDelMember'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupDelMember] + end; +end; + +var + _NetLocalGroupGetMembers: Pointer; + +function NetLocalGroupGetMembers; +begin + GetProcedureAddress(_NetLocalGroupGetMembers, netapi32, 'NetLocalGroupGetMembers'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupGetMembers] + end; +end; + +var + _NetLocalGroupSetMembers: Pointer; + +function NetLocalGroupSetMembers; +begin + GetProcedureAddress(_NetLocalGroupSetMembers, netapi32, 'NetLocalGroupSetMembers'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupSetMembers] + end; +end; + +var + _NetLocalGroupAddMembers: Pointer; + +function NetLocalGroupAddMembers; +begin + GetProcedureAddress(_NetLocalGroupAddMembers, netapi32, 'NetLocalGroupAddMembers'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupAddMembers] + end; +end; + +var + _NetLocalGroupDelMembers: Pointer; + +function NetLocalGroupDelMembers; +begin + GetProcedureAddress(_NetLocalGroupDelMembers, netapi32, 'NetLocalGroupDelMembers'); + asm + mov esp, ebp + pop ebp + jmp [_NetLocalGroupDelMembers] + end; +end; + + + +var + _NetApiBufferFree: Pointer; + +function NetApiBufferFree; +begin + GetProcedureAddress(_NetApiBufferFree, netapi32, 'NetApiBufferFree'); + asm + mov esp, ebp + pop ebp + jmp [_NetApiBufferFree] + end; +end; + + + +var + _Netbios: Pointer; + +function Netbios; +begin + GetProcedureAddress(_Netbios, 'netapi32.dll', 'Netbios'); + asm + mov esp, ebp + pop ebp + jmp [_Netbios] + end; +end; + + + +var + _BackupSeek: Pointer; + +function BackupSeek; +begin + GetProcedureAddress(_BackupSeek, kernel32, 'BackupSeek'); + asm + mov esp, ebp + pop ebp + jmp [_BackupSeek] + end; +end; + +var + _AdjustTokenPrivileges: Pointer; + +function AdjustTokenPrivileges; +begin + GetProcedureAddress(_AdjustTokenPrivileges, advapi32, 'AdjustTokenPrivileges'); + asm + mov esp, ebp + pop ebp + jmp [_AdjustTokenPrivileges] + end; +end; + +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: DWORD; lpName: PChar): THandle; stdcall; + external kernel32 name 'CreateMutexA'; + +function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall; + external kernel32 name 'GetVersionExA'; +function GetVersionEx(lpVersionInformation: POSVersionInfoEx): BOOL; stdcall; + external kernel32 name 'GetVersionExA'; + +var + _SetWaitableTimer: Pointer; + +function SetWaitableTimer; +begin + GetProcedureAddress(_SetWaitableTimer, kernel32, 'SetWaitableTimer'); + asm + mov esp, ebp + pop ebp + jmp [_SetWaitableTimer] + end; +end; +var + _SetFileSecurityA: Pointer; + +function SetFileSecurityA; +begin + GetProcedureAddress(_SetFileSecurityA, advapi32, 'SetFileSecurityA'); + asm + MOV ESP, EBP + POP EBP + JMP [_SetFileSecurityA] + end; +end; + +var + _SetFileSecurityW: Pointer; + +function SetFileSecurityW; +begin + GetProcedureAddress(_SetFileSecurityW, advapi32, 'SetFileSecurityW'); + asm + MOV ESP, EBP + POP EBP + JMP [_SetFileSecurityW] + end; +end; + +var + _SetFileSecurity: Pointer; + +function SetFileSecurity; +begin + GetProcedureAddress(_SetFileSecurity, advapi32, 'SetFileSecurity' + AWSuffix); + asm + MOV ESP, EBP + POP EBP + JMP [_SetFileSecurity] + end; +end; + +var + _GetFileSecurityA: Pointer; + +function GetFileSecurityA; +begin + GetProcedureAddress(_GetFileSecurityA, advapi32, 'GetFileSecurityA'); + asm + MOV ESP, EBP + POP EBP + JMP [_GetFileSecurityA] + end; +end; + +var + _GetFileSecurityW: Pointer; + +function GetFileSecurityW; +begin + GetProcedureAddress(_GetFileSecurityW, advapi32, 'GetFileSecurityW'); + asm + MOV ESP, EBP + POP EBP + JMP [_GetFileSecurityW] + end; +end; + +var + _GetFileSecurity: Pointer; + +function GetFileSecurity; +begin + GetProcedureAddress(_GetFileSecurity, advapi32, 'GetFileSecurity' + AWSuffix); + asm + MOV ESP, EBP + POP EBP + JMP [_GetFileSecurity] + end; +end; + +var + _SetVolumeMountPoint: Pointer; + +function SetVolumeMountPoint; +begin + GetProcedureAddress(_SetVolumeMountPoint, kernel32, 'SetVolumeMountPointA'); + asm + mov esp, ebp + pop ebp + jmp [_SetVolumeMountPoint] + end; +end; + +var + _DeleteVolumeMountPoint: Pointer; + +function DeleteVolumeMountPoint; +begin + GetProcedureAddress(_DeleteVolumeMountPoint, kernel32, 'DeleteVolumeMountPointA'); + asm + mov esp, ebp + pop ebp + jmp [_DeleteVolumeMountPoint] + end; +end; + +var + _GetVolumeNameForVolMountPoint: Pointer; + +function GetVolumeNameForVolumeMountPoint; +begin + GetProcedureAddress(_GetVolumeNameForVolMountPoint, kernel32, 'GetVolumeNameForVolumeMountPointA'); + asm + mov esp, ebp + pop ebp + jmp [_GetVolumeNameForVolMountPoint] + end; +end; + + + +var + _GetCalendarInfoA: Pointer; + +function GetCalendarInfoA; +begin + GetProcedureAddress(_GetCalendarInfoA, kernel32, 'GetCalendarInfoA'); + asm + mov esp, ebp + pop ebp + jmp [_GetCalendarInfoA] + end; +end; + +var + _GetCalendarInfoW: Pointer; + +function GetCalendarInfoW; +begin + GetProcedureAddress(_GetCalendarInfoW, kernel32, 'GetCalendarInfoW'); + asm + mov esp, ebp + pop ebp + jmp [_GetCalendarInfoW] + end; +end; + +var + _EnumCalendarInfoExA: Pointer; + +function EnumCalendarInfoExA; +begin + GetProcedureAddress(_EnumCalendarInfoExA, kernel32, 'EnumCalendarInfoExA'); + asm + mov esp, ebp + pop ebp + jmp [_EnumCalendarInfoExA] + end; +end; + +{$ENDIF ~CLR} + +// 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; + +// 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; + +{$IFNDEF CLR} + +// IMAGE_FIRST_SECTION by Nico Bendlin - supplied by Markus Fuchs + +function FieldOffset(const Struc; const Field): Cardinal; +begin + Result := Cardinal(@Field) - Cardinal(@Struc); +end; + +function IMAGE_FIRST_SECTION(NtHeader: PImageNtHeaders): PImageSectionHeader; +begin + Result := PImageSectionHeader(Cardinal(NtHeader) + + FieldOffset(NtHeader^, NtHeader^.OptionalHeader) + + NtHeader^.FileHeader.SizeOfOptionalHeader); +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; + +{$ENDIF ~CLR} + + +// History of source\prototypes\JclWin32.pas: + +// Revision 1.4 2005/03/08 08:33:19 marquardt +// overhaul of exceptions and resourcestrings, minor style cleaning +// +// Revision 1.3 2005/03/07 07:49:12 marquardt +// made the generator not remove IFDEF MSWINDOWS and UNIX +// +// Revision 1.2 2004/12/23 04:31:43 rrossmair +// - check-in for JCL 1.94 RC 1 +// +// Revision 1.1 2004/12/03 04:05:19 rrossmair +// JclWin32 a unit generated from prototype now +// +// History of source\windows\JclWin32.pas: +// +// Revision 1.32 2004/11/04 12:55:21 obones +// BCB compatibility fix: aclapi.h and shlobj.h must not be included. +// +// Revision 1.31 2004/10/30 08:20:09 rrossmair +// fixed BCB-related bugs +// +// Revision 1.30 2004/10/21 08:40:11 marquardt +// style cleaning +// +// Revision 1.29 2004/10/19 21:28:41 rrossmair +// - rewrite from scratch, cannibalizing MvB's Win32API distribution +// +// Revision 1.28 2004/10/09 13:58:52 marquardt +// style cleaning JclPrint +// remove WinSpool related functions from JclWin32 +// +// Revision 1.27 2004/08/02 06:34:59 marquardt +// minor string literal improvements +// +// Revision 1.26 2004/08/01 05:50:00 marquardt +// fix JclFreeLibrary +// +// Revision 1.25 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.24 2004/07/28 18:00:55 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.23 2004/06/14 13:05:22 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.22 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.21 2004/06/02 03:23:47 rrossmair +// cosmetic changes in several units (code formatting, help TODOs processed etc.) +// +// Revision 1.20 2004/05/28 14:00:46 obones +// BCB5 compatibility +// +// Revision 1.19 2004/05/06 05:09:55 rrossmair +// Changes for FPC v1.9.4 compatibility +// +// Revision 1.18 2004/05/05 05:38:38 rrossmair +// Changes for FPC compatibility; header updated according to new policy: initial developers, contributors listed +// +// Revision 1.17 2004/04/18 00:45:05 +// add run-time dynamic linking support for GetOpenGLVersion +// +// Revision 1.16 2004/04/11 22:16:20 mthoma +// Modifications for GetDefaultPrinterName. Added GetDefaultPrinter API function. +// +// Revision 1.15 2004/04/08 19:59:11 ahuser +// BCB compatibility +// +// Revision 1.14 2004/04/08 10:27:15 rrossmair +// GetVersionEx overload added. +// +end. + + + diff --git a/official/1.96/source/windows/JclWinMIDI.pas b/official/1.96/source/windows/JclWinMIDI.pas new file mode 100644 index 0000000..3001137 --- /dev/null +++ b/official/1.96/source/windows/JclWinMIDI.pas @@ -0,0 +1,309 @@ +{**************************************************************************************************} +{ } +{ 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 } +{ } +{ Unit owner: Robert Rossmair } +{ } +{**************************************************************************************************} + +// Last modified: $Date: 2005/02/25 07:20:16 $ +// For history see end of file + +unit JclWinMidi; + +{$I jcl.inc} +{$I windowsonly.inc} + +interface + +uses + SysUtils, Classes, Windows, MMSystem, + 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; + +function MidiOut(DeviceID: Cardinal): IJclWinMidiOut; +procedure GetMidiOutputs(const List: TStrings); +procedure MidiOutCheck(Code: MMResult); + +// MIDI In +procedure MidiInCheck(Code: MMResult); + +implementation + +uses + JclResources, JclStrings; + +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 + begin + if (midiOutGetDevCaps(I, @Caps, SizeOf(Caps)) = MMSYSERR_NOERROR) then + FMidiOutputs.Add(Caps.szPName); + end; + 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; + +//=== { TMidiOut } =========================================================== + +type + TMidiOut = class(TJclMidiOut, IJclWinMidiOut) + private + FHandle: HMIDIOUT; + FDeviceID: Cardinal; + FDeviceCaps: MIDIOUTCAPS; + FVolume: DWord; + function GetChannelVolume(Channel: TStereoChannel): Word; + procedure SetChannelVolume(Channel: TStereoChannel; const Value: Word); + function GetVolume: Word; + procedure SetVolume(const Value: Word); + procedure SetLRVolume(const LeftValue, RightValue: Word); + protected + function GetName: string; override; + 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; + property Name: string read GetName; + property ChannelVolume[Channel: TStereoChannel]: Word read GetChannelVolume write SetChannelVolume; + property Volume: Word read GetVolume write SetVolume; + end; + +var + MidiMapperDeviceID: Cardinal = MIDI_MAPPER; + +function MidiOut(DeviceID: Cardinal): IJclWinMidiOut; +var + Device: TMidiOut; +begin + if DeviceID = MIDI_MAPPER then + DeviceID := MidiMapperDeviceID; + Device := nil; + if DeviceID <> MIDI_MAPPER then + Device := TMidiOut(MidiOutputs.Objects[DeviceID]); + // make instance a singleton for a given device ID + if not Assigned(Device) then + begin + Device := TMidiOut.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 TMidiOut.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 TMidiOut.Destroy; +begin + inherited Destroy; + midiOutClose(FHandle); + MidiOutputs.Objects[FDeviceID] := nil; +end; + +function TMidiOut.GetName: string; +begin + Result := FDeviceCaps.szPName; +end; + +procedure TMidiOut.LongMessage(const Data: array of Byte); +var + Hdr: MIDIHDR; +begin + FillChar(Hdr, SizeOf(Hdr), 0); + 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 TMidiOut.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 TMidiOut.GetChannelVolume(Channel: TStereoChannel): Word; +begin + midiOutGetVolume(FHandle, @FVolume); + Result := FVolume; +end; + +procedure TMidiOut.SetChannelVolume(Channel: TStereoChannel; const Value: Word); +begin + if Channel = scLeft then + SetLRVolume(Value, ChannelVolume[scRight]) + else + SetLRVolume(ChannelVolume[scLeft], Value); +end; + +function TMidiOut.GetVolume: Word; +begin + Result := GetChannelVolume(scLeft); +end; + +procedure TMidiOut.SetVolume(const Value: Word); +begin + SetLRVolume(Value, Value); +end; + +procedure TMidiOut.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 + +finalization + FreeAndNil(FMidiOutputs); + +// History: + +// $Log: JclWinMIDI.pas,v $ +// Revision 1.13 2005/02/25 07:20:16 marquardt +// add section lines +// +// Revision 1.12 2005/02/24 16:34:53 marquardt +// remove divider lines, add section lines (unfinished) +// +// Revision 1.11 2004/10/17 21:00:16 mthoma +// cleaning +// +// Revision 1.10 2004/07/31 06:21:03 marquardt +// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved +// +// Revision 1.9 2004/07/28 18:00:55 marquardt +// various style cleanings, some minor fixes +// +// Revision 1.8 2004/06/16 07:30:31 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.7 2004/06/14 11:05:53 marquardt +// symbols added to all ENDIFs and some other minor style changes like removing IFOPT +// +// Revision 1.6 2004/05/05 07:33:49 rrossmair +// header updated according to new policy: initial developers & contributors listed +// +// Revision 1.5 2004/04/06 04:55:18 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/MSTask.pas b/official/1.96/source/windows/MSTask.pas new file mode 100644 index 0000000..39de393 --- /dev/null +++ b/official/1.96/source/windows/MSTask.pas @@ -0,0 +1,648 @@ +(***************************************************************************** + 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; + +{$ALIGN ON} +{$MINENUMSIZE 4} +{$WEAKPACKAGEUNIT} +interface + +uses + Windows, + ActiveX; + + +(*$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; + +type +{$EXTERNALSYM HPROPSHEETPAGE} + HPROPSHEETPAGE = ^_PSP; + +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)); + +implementation + +end. + diff --git a/official/1.96/source/windows/Snmp.pas b/official/1.96/source/windows/Snmp.pas new file mode 100644 index 0000000..1c76a14 --- /dev/null +++ b/official/1.96/source/windows/Snmp.pas @@ -0,0 +1,918 @@ +{******************************************************************************} +{ } +{ Borland 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 home } +{ page, located at http://delphi-jedi.org } +{ } +{ Contributor(s): } +{ } +{******************************************************************************} + +// Last modified: $Date: 2004/10/17 21:00:16 $ +// For history see end of file + +unit Snmp; + +interface + +{$I jcl.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} + +uses + Windows; + +(*$HPPEMIT '#include '*) + +type + PAsnOctetString = ^TAsnOctetString; + TAsnOctetString = record + stream: PChar; + 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: TAsnObjectIdentifier); 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): PChar; stdcall; + SnmpUtilIdsToA: function(Ids: PUINT; IdLength: UINT): PChar; 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} + +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): PChar; stdcall; +function SnmpUtilIdsToA(Ids: PUINT; IdLength: UINT): PChar; 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: PChar); stdcall; + +{$ELSE SNMP_DYNAMIC_LINK} + +var + SnmpUtilDbgPrint: procedure (nLogLevel: Integer; szFormat: PChar); 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} + +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} + +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} + +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 := LoadLibrary(PChar(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 := LoadLibrary(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} + +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} + +{$IFDEF SNMP_DYNAMIC_LINK} +{$IFNDEF SNMP_DYNAMIC_LINK_EXPLICIT} + +initialization + LoadSnmp; + +finalization + UnloadSnmp; + +{$ENDIF ~SNMP_DYNAMIC_LINK_EXPLICIT} +{$ENDIF SNMP_DYNAMIC_LINK} + +// History: + +// $Log: Snmp.pas,v $ +// Revision 1.8 2004/10/17 21:00:16 mthoma +// cleaning +// +// Revision 1.7 2004/06/16 07:30:31 marquardt +// added tilde to all IFNDEF ENDIFs, inherited qualified +// +// Revision 1.6 2004/06/14 13:05:22 marquardt +// style cleaning ENDIF, Tabs +// +// Revision 1.5 2004/05/05 05:32:38 rrossmair +// CVS key word typo corrected: $Data$ -> $Date: 2004/10/17 21:00:16 $ +// +// Revision 1.4 2004/04/06 04:59:07 +// adapt compiler conditions, add log entry +// + +end. diff --git a/official/1.96/source/windows/dirinfo.txt b/official/1.96/source/windows/dirinfo.txt new file mode 100644 index 0000000..01430eb --- /dev/null +++ b/official/1.96/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/official/1.96/source/windows/mscoree_TLB.pas b/official/1.96/source/windows/mscoree_TLB.pas new file mode 100644 index 0000000..9e2ab4c --- /dev/null +++ b/official/1.96/source/windows/mscoree_TLB.pas @@ -0,0 +1,427 @@ +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: 1.3 $ +// 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. +{ $WARN SYMBOL_PLATFORM OFF} +{ $WRITEABLECONST ON} +{ $VARPROPSETTER ON} +interface + +uses ActiveX, Classes, OleServer; + + +// *********************************************************************// +// 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; + IMarshal = interface; + ISequentialStream = interface; + IStream = interface; + 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; {*} + + ULONG_PTR = LongWord; + + _LARGE_INTEGER = packed record + QuadPart: Int64; + end; + + _ULARGE_INTEGER = packed record + QuadPart: Largeuint; + end; + + _FILETIME = packed record + dwLowDateTime: LongWord; + dwHighDateTime: LongWord; + end; + + 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; + + _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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +implementation + +uses ComObj; + +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; + +end. diff --git a/official/1.96/source/windows/mscorlib_TLB.pas b/official/1.96/source/windows/mscorlib_TLB.pas new file mode 100644 index 0000000..4e354e4 --- /dev/null +++ b/official/1.96/source/windows/mscorlib_TLB.pas @@ -0,0 +1,31649 @@ +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: 1.2 $ +// 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. +{ $WARN SYMBOL_PLATFORM OFF} +{ $WRITEABLECONST ON} +{ $VARPROPSETTER ON} +interface + +uses ActiveX, Classes; + + +// *********************************************************************// +// 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; + + UInt64 = packed record + m_value: Largeuint; + end; + + 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +// *********************************************************************// +// 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; + +implementation + +uses ComObj; + +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; + +end. diff --git a/official/1.96/source/windows/obj/adler32.obj b/official/1.96/source/windows/obj/adler32.obj new file mode 100644 index 0000000..153f2e3 Binary files /dev/null and b/official/1.96/source/windows/obj/adler32.obj differ diff --git a/official/1.96/source/windows/obj/compress.obj b/official/1.96/source/windows/obj/compress.obj new file mode 100644 index 0000000..a55c629 Binary files /dev/null and b/official/1.96/source/windows/obj/compress.obj differ diff --git a/official/1.96/source/windows/obj/crc32.obj b/official/1.96/source/windows/obj/crc32.obj new file mode 100644 index 0000000..ce5a727 Binary files /dev/null and b/official/1.96/source/windows/obj/crc32.obj differ diff --git a/official/1.96/source/windows/obj/deflate.obj b/official/1.96/source/windows/obj/deflate.obj new file mode 100644 index 0000000..8850095 Binary files /dev/null and b/official/1.96/source/windows/obj/deflate.obj differ diff --git a/official/1.96/source/windows/obj/dirinfo.txt b/official/1.96/source/windows/obj/dirinfo.txt new file mode 100644 index 0000000..5fdc709 --- /dev/null +++ b/official/1.96/source/windows/obj/dirinfo.txt @@ -0,0 +1 @@ +This is the directory where object files for Win32-specific units reside. \ No newline at end of file diff --git a/official/1.96/source/windows/obj/gzio.obj b/official/1.96/source/windows/obj/gzio.obj new file mode 100644 index 0000000..ab9fc6f Binary files /dev/null and b/official/1.96/source/windows/obj/gzio.obj differ diff --git a/official/1.96/source/windows/obj/infback.obj b/official/1.96/source/windows/obj/infback.obj new file mode 100644 index 0000000..6c7fd5d Binary files /dev/null and b/official/1.96/source/windows/obj/infback.obj differ diff --git a/official/1.96/source/windows/obj/inffast.obj b/official/1.96/source/windows/obj/inffast.obj new file mode 100644 index 0000000..a6de8b3 Binary files /dev/null and b/official/1.96/source/windows/obj/inffast.obj differ diff --git a/official/1.96/source/windows/obj/inflate.obj b/official/1.96/source/windows/obj/inflate.obj new file mode 100644 index 0000000..f3a142b Binary files /dev/null and b/official/1.96/source/windows/obj/inflate.obj differ diff --git a/official/1.96/source/windows/obj/inftrees.obj b/official/1.96/source/windows/obj/inftrees.obj new file mode 100644 index 0000000..eb93b73 Binary files /dev/null and b/official/1.96/source/windows/obj/inftrees.obj differ diff --git a/official/1.96/source/windows/obj/makefile.mak b/official/1.96/source/windows/obj/makefile.mak new file mode 100644 index 0000000..c436559 --- /dev/null +++ b/official/1.96/source/windows/obj/makefile.mak @@ -0,0 +1,230 @@ +# +# makefile to make zlib .obj files using Borland's C++ compiler bcc32 +# derived from a makefile generated by BCB6' bpr2mak +# +# if zlib source directory is different from $(JLC)\source\zlib-1.2.2, use +# "make -Dzlibsrc=" 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 +# +# 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 +# +# Note: This assumes -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl +# +# Robert Rossmair, 2004-10-16 +# + +CallingConvention = -pr -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl + +!if !$d(BCB) +BCB = $(MAKEDIR)\.. +!endif + +BCC = $(BCB) + +!if !$d(zlibsrc) +zlibsrc = ..\..\zlib-1.2.2 +!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 = .\zutil.obj .\compress.obj .\crc32.obj .\deflate.obj .\gzio.obj \ + .\infback.obj .\inffast.obj .\inflate.obj .\inftrees.obj .\trees.obj \ + .\uncompr.obj .\adler32.obj +RESFILES = +RESDEPEN = $(RESFILES) +LIBFILES = +IDLFILES = +IDLGENFILES = +LIBRARIES = rtl.lib +PACKAGES = rtl.bpi +SPARELIBS = rtl.lib +DEFFILE = +OTHERFILES = +# --------------------------------------------------------------------------- +DEBUGLIBPATH = $(BCB)\lib\debug +RELEASELIBPATH = $(BCB)\lib\release +USERDEFINES = +SYSDEFINES = NO_STRICT +INCLUDEPATH = $(zlibsrc);$(BCC)\include;$(BCB)\include\vcl +LIBPATH = $(zlibsrc) +WARNINGS= -w-par -w-aus +PATHCPP = .;$(zlibsrc) +PATHASM = .; +PATHPAS = .; +PATHRC = .; +PATHOBJ = .;$(LIBPATH) +# --------------------------------------------------------------------------- +CFLAG1 = -O2 -Ve -X- -a8 -$(CPU) -b -d -k- -vi -tWM $(CallingConvention) +IDLCFLAGS = -I$(zlibsrc) -I$(BCC)\include -I$(BCB)\include\vcl -src_suffix cpp \ + -boa +PFLAGS = -$Y- -$L- -$I- -$D- -$A8 -v -M -JPHNE +RFLAGS = +AFLAGS = /mx /w2 /zn +LFLAGS = +# --------------------------------------------------------------------------- +ALLOBJ = +ALLRES = +ALLLIB = +# --------------------------------------------------------------------------- +!ifdef IDEOPTIONS + +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 + +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= + +[Debugging] +DebugSourceDirs=$(BCB)\source\vcl + +!endif + + + + + +# --------------------------------------------------------------------------- +# 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 "$(USERDEFINES)" != "" +AUSERDEFINES = -d$(USERDEFINES:;= -d) +!else +AUSERDEFINES = +!endif + +!if !$d(BCC32) +BCC32 = bcc32 +!endif + +!if !$d(CPP32) +CPP32 = cpp32 +!endif + +!if !$d(DCC32) +DCC32 = dcc32 +!endif + +!if !$d(TASM32) +TASM32 = tasm32 +!endif + +!if !$d(LINKER) +LINKER = ilink32 +!endif + +!if !$d(BRCC32) +BRCC32 = brcc32 +!endif + + +# --------------------------------------------------------------------------- +!if $d(PATHCPP) +.PATH.CPP = $(PATHCPP) +.PATH.C = $(PATHCPP) +!endif + +!if $d(PATHPAS) +.PATH.PAS = $(PATHPAS) +!endif + +!if $d(PATHASM) +.PATH.ASM = $(PATHASM) +!endif + +!if $d(PATHRC) +.PATH.RC = $(PATHRC) +!endif + +!if $d(PATHOBJ) +.PATH.OBJ = $(PATHOBJ) +!endif +# --------------------------------------------------------------------------- +zlib: $(OTHERFILES) $(IDLGENFILES) $(OBJFILES) $(RESDEPEN) $(DEFFILE) + +# --------------------------------------------------------------------------- +.pas.hpp: + $(BCB)\BIN\$(DCC32) $(PFLAGS) -U$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -O$(INCLUDEPATH) --BCB {$< } + +.pas.obj: + $(BCB)\BIN\$(DCC32) $(PFLAGS) -U$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -O$(INCLUDEPATH) --BCB {$< } + +.cpp.obj: + $(BCC)\BIN\$(BCC32) $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n$(@D) {$< } + +.c.obj: + $(BCC)\BIN\$(BCC32) -c $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n$(@D) {$< } + +.c.i: + $(BCC)\BIN\$(CPP32) $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n. {$< } + +.cpp.i: + $(BCC)\BIN\$(CPP32) $(CFLAG1) $(WARNINGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -n. {$< } + +.asm.obj: + $(BCB)\BIN\$(TASM32) $(AFLAGS) -i$(INCLUDEPATH:;= -i) $(AUSERDEFINES) -d$(SYSDEFINES:;= -d) $<, $@ + +.rc.res: + $(BCC)\BIN\$(BRCC32) $(RFLAGS) -I$(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $< + + + +# --------------------------------------------------------------------------- + + + + diff --git a/official/1.96/source/windows/obj/trees.obj b/official/1.96/source/windows/obj/trees.obj new file mode 100644 index 0000000..be3465f Binary files /dev/null and b/official/1.96/source/windows/obj/trees.obj differ diff --git a/official/1.96/source/windows/obj/uncompr.obj b/official/1.96/source/windows/obj/uncompr.obj new file mode 100644 index 0000000..64897b5 Binary files /dev/null and b/official/1.96/source/windows/obj/uncompr.obj differ diff --git a/official/1.96/source/windows/obj/zutil.obj b/official/1.96/source/windows/obj/zutil.obj new file mode 100644 index 0000000..7e608aa Binary files /dev/null and b/official/1.96/source/windows/obj/zutil.obj differ diff --git a/official/1.96/source/windows/zlibh.pas b/official/1.96/source/windows/zlibh.pas new file mode 100644 index 0000000..4e31d94 --- /dev/null +++ b/official/1.96/source/windows/zlibh.pas @@ -0,0 +1,1636 @@ +{**************************************************************************************************} +{ WARNING: JEDI preprocessor generated unit. Do not edit. } +{**************************************************************************************************} + +{ 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). +} + +{$I jedi.inc} + +{* Set this DEFINE to allow this unit to be linked against a .SO/.DLL + * The name "DLL" was used because e.g. the wxWidgets projects also uses + * this name to refer to dynamic libraries (even on *nix systems). + *} + +{ $DEFINE ZLIB_DLL} + +{ $DEFINE STATIC_GZIO} + +{ TODO: cdecl = zlib1.dll calling convention? } + +{$HPPEMIT '#define ZEXPORT __fastcall'} + +{$IFDEF ZEXPORT_CDECL} +{$HPPEMIT '#define ZEXPORT __cdecl'} +{$ENDIF ZEXPORT_CDECL} + +{$HPPEMIT '#define ZEXPORTVA __cdecl'} + +{$HPPEMIT '#include '} + +unit zlibh; + +interface + +uses + Windows; +type + uShort = Word; + {$EXTERNALSYM uShort} + size_t = Longint; + {$EXTERNALSYM size_t} + +//----------------------------------------------------------------------------- +// 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.2'; + {$EXTERNALSYM ZLIB_VERNUM} + ZLIB_VERNUM =$1210; + +{* + 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; + {$EXTERNALSYM free_func} + free_func = procedure(opaque:voidpf; address:voidpf); + TFNAllocFunc = alloc_func; + TFNFreeFunc = free_func; + +type + {$EXTERNALSYM internal_state} + internal_state = packed record end; + TInternalState = internal_state; // backward compatibility + PInternalState = ^internal_state; // backward compatibility + +type + {$EXTERNALSYM z_stream_s} + z_stream_s = packed 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: PChar; // 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; + + {$EXTERNALSYM z_stream} + z_stream = z_stream_s; + {$EXTERNALSYM z_streamp} + z_streamp = ^z_stream_s; + + TZStreamRec = z_stream_s; + 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; + +{* 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_DEFAULT_STRATEGY} + Z_DEFAULT_STRATEGY = 0; +{* compression strategy; see deflateInit2() below for details *} + + {$EXTERNALSYM Z_BINARY} + Z_BINARY = 0; + {$EXTERNALSYM Z_ASCII} + Z_ASCII = 1; + {$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 *} + +{* for compatibility with versions < 1.0.2 *} + + {* basic functions *} + +{$EXTERNALSYM zlibVersion} +function zlibVersion(): PChar; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* 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. + *} + +{$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(). +*} + +{$EXTERNALSYM deflate} +function deflate(var strm: TZStreamRec; flush: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM deflateEnd} +function deflateEnd(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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). +*} + +{$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.) +*} + +{$EXTERNALSYM inflate} +function inflate(strm: TZStreamRec; flush: Integer): Integer; +{* + 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. +*} + +{$EXTERNALSYM inflateEnd} +function inflateEnd(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$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(). +*} + +{$EXTERNALSYM deflateSetDictionary} +function deflateSetDictionary(var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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(). +*} + +{$EXTERNALSYM deflateCopy} +function deflateCopy(var dest: TZStreamRec; + var source: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM deflateReset} +function deflateReset(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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). +*} + +{$EXTERNALSYM deflateParams} +function deflateParams(var strm: TZStreamRec; + level: Integer; + strategy: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM deflateBound} +function deflateBound(var strm: TZStreamRec; + sourceLen:uLong):uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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(). +*} + +{$EXTERNALSYM deflatePrime} +function deflatePrime(var strm: TZStreamRec; + bits: Integer; + value: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$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.) +*} + +{$EXTERNALSYM inflateSetDictionary} +function inflateSetDictionary(var strm: TZStreamRec; + {const} dictionary: PBytef; + dictLength:uInt): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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(). +*} + +{$EXTERNALSYM inflateSync} +function inflateSync(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM inflateCopy} +function inflateCopy(var dest: TZStreamRec; + var source: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM inflateReset} +function inflateReset(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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). +*} + +{$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; + TFNInFunc = in_func; + TFNOutFunc = out_func; + +{$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 ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM inflateBackEnd} +function inflateBackEnd(var strm: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + All memory allocated by inflateBackInit() is freed. + + inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream + state was inconsistent. +*} + +{$EXTERNALSYM zlibCompileFlags} +function zlibCompileFlags():uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* 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. +*} + +{$EXTERNALSYM compress} +function compress(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM compress2} +function compress2(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong; + level: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM compressBound} +function compressBound(sourceLen:uLong):uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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. +*} + +{$EXTERNALSYM uncompress} +function uncompress(dest: PBytef; + var destLen:uLongf; + {const} source: PBytef; + sourceLen:uLong): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +{* + 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: PChar; mode: PChar):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: PChar):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: PChar, ...): 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: PChar): 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: PChar; len: Integer): PChar; +{* + 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): PChar; +{* + 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. +*} + +{$EXTERNALSYM adler32} +function adler32(adler:uLong; {const} buf: PBytef; len:uInt):uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +(* + 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(); +*) + +{$EXTERNALSYM crc32} +function crc32 (crc:uLong; {const} buf: PBytef; len:uInt):uLong; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} +(* + 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: + *} +{$EXTERNALSYM deflateInit_} +function deflateInit_(var strm:z_stream; + level: Integer; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM inflateInit_} +function inflateInit_(var strm:z_stream; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM deflateInit2_} +function deflateInit2_(var strm:z_stream; + level: Integer; + method: Integer; + windowBits: Integer; + memLevel: Integer; + strategy: Integer; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM inflateInit2_} +function inflateInit2_(var strm:z_stream; + windowBits: Integer; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM inflateBackInit_} +function inflateBackInit_(var strm:z_stream; + windowBits: Integer; + window: PByte; + {const} version: PChar; + stream_size: Integer): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM zError} +function zError(err: Integer): PChar; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM inflateSyncPoint} +function inflateSyncPoint(var z: TZStreamRec): Integer; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +{$EXTERNALSYM get_crc_table} +function get_crc_table():PuLongf; +{$IFDEF ZEXPORT_CDECL} cdecl; {$ENDIF} + +//----------------------------------------------------------------------------- +// 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} + +implementation + + +{$LINK obj\adler32.obj} // OS: CHECKTHIS - Kylix version may need forward slashes? +{$LINK obj\compress.obj} +{$LINK obj\crc32.obj} +{$LINK obj\deflate.obj} +{$LINK obj\infback.obj} +{$LINK obj\inffast.obj} +{$LINK obj\inflate.obj} +{$LINK obj\inftrees.obj} +{$LINK obj\trees.obj} +{$LINK obj\uncompr.obj} +{$LINK obj\zutil.obj} + + {$IFDEF LINK_LIBC} + {$DEFINE LINKTO_MSVCRT_DLL} + {$ENDIF LINK_LIBC} + + +// 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 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: PChar; mode: PChar): Pointer; cdecl; external szMSVCRT name 'fopen'; +function _fdopen(handle: Integer; mode: PChar): Pointer; cdecl; external szMSVCRT name '_fdopen'; +function _fprintf(stream: Pointer; format: PChar {, ...}): Integer; cdecl; external szMSVCRT name 'fprintf'; +function _ftell(stream: Pointer): Longint; cdecl; external szMSVCRT name 'ftell'; +function _sprintf(buffer: PChar; format: PChar {, ...}): 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: PChar; count: size_t; format: PChar; 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: PChar; strSource: PChar): PChar; cdecl; external szMSVCRT name 'strcat'; +function _strlen(str: PChar): size_t; cdecl; external szMSVCRT name 'strlen'; +procedure _clearerr(stream: Pointer); cdecl; external szMSVCRT name 'clearerr'; + +{$ENDIF LINK_TO_MSVCRT} +{$IFNDEF LINK_LIBC} + +procedure _memcpy(dest, src: Pointer; count: size_t); cdecl; +begin + Move(src^, dest^, count); +end; + +procedure _memset(dest: Pointer; val: Integer; count: size_t); cdecl; +begin + FillChar(dest^, count, val); +end; + +function _malloc(size: size_t): Pointer; cdecl; +begin + GetMem(Result, size); +end; + +procedure _free(pBlock: Pointer); cdecl; +begin + FreeMem(pBlock); +end; + +{$ENDIF ~LINK_LIBC} + +//----------------------------------------------------------------------------- +// +// 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; + +end. + + + + diff --git a/official/1.96/source/windowsonly.inc b/official/1.96/source/windowsonly.inc new file mode 100644 index 0000000..5c77a1c --- /dev/null +++ b/official/1.96/source/windowsonly.inc @@ -0,0 +1,73 @@ +{$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/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed 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 http://homepages.borland.com/jedi/jcl/ + +Known Issues: +-----------------------------------------------------------------------------} + +// Last modified: $Date: 2004/08/12 17:22:30 $ +// For history see end of file + +{$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} + +// History: + +// $Log: windowsonly.inc,v $ +// Revision 1.6 2004/08/12 17:22:30 marquardt +// removed XPLATFORM_RTL +// +// Revision 1.5 2004/08/10 00:52:06 rrossmair +// don't allow missing jedi.inc/wrong inclusion order to happen unnoticed. +// +// Revision 1.4 2004/07/30 07:16:47 marquardt +// added a tilde +// +// Revision 1.3 2004/07/29 07:58:21 marquardt +// inc files updated +// +// Revision 1.2 2004/06/21 01:17:51 rrossmair +// - $IFDEFed contents (to prevent from repeated inclusion) +// - use of feature friendly symbol names +// - header text adapted for JCL +// + +{$ENDIF ~WINDOWSONLY_INC} + diff --git a/official/1.96/want.exe b/official/1.96/want.exe new file mode 100644 index 0000000..e247548 Binary files /dev/null and b/official/1.96/want.exe differ diff --git a/official/1.96/want.xml b/official/1.96/want.xml new file mode 100644 index 0000000..e27e1f0 --- /dev/null +++ b/official/1.96/want.xml @@ -0,0 +1,244 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +