diff --git a/official/1.104/Install multiple profiles.bat b/official/1.104/Install multiple profiles.bat
new file mode 100644
index 0000000..4a0506e
--- /dev/null
+++ b/official/1.104/Install multiple profiles.bat
@@ -0,0 +1 @@
+Install Latest /MultipleProfiles
\ No newline at end of file
diff --git a/official/1.104/Install turbo delphi.bat b/official/1.104/Install turbo delphi.bat
new file mode 100644
index 0000000..640538a
--- /dev/null
+++ b/official/1.104/Install turbo delphi.bat
@@ -0,0 +1,20 @@
+@echo off
+
+echo Launching JCL installer...
+
+start .\bin\JediInstaller.exe %2 %3 %4 %5 %6 %7 %8 %9
+if ERRORLEVEL 1 goto FailStart
+goto FINI
+
+:FailStart
+.\bin\JediInstaller.exe %2 %3 %4 %5 %6 %7 %8 %9
+goto FINI
+
+:FailedCompile
+echo.
+echo.
+echo An error occured while compiling the installer. Installation aborted.
+echo.
+pause
+
+:FINI
diff --git a/official/1.104/Install.bat b/official/1.104/Install.bat
new file mode 100644
index 0000000..1feda50
--- /dev/null
+++ b/official/1.104/Install.bat
@@ -0,0 +1,42 @@
+@echo off
+
+SET DELPHIVERSION=%1
+
+cd install
+
+::jpp prototypes
+
+..\devtools\jpp.exe -c -dVCL -dMSWINDOWS -uVisualCLX -uUnix -uKYLIX -xVclGui\ prototypes\JediGUIMain.pas
+if ERRORLEVEL 1 goto FailedCompile
+..\devtools\jpp.exe -c -dVCL -dMSWINDOWS -uVisualCLX -uUnix -uKYLIX -xVclGui\ prototypes\JediGUIReadme.pas
+if ERRORLEVEL 1 goto FailedCompile
+..\devtools\jpp.exe -c -dVCL -dMSWINDOWS -uVisualCLX -uUnix -uKYLIX -xVclGui\ prototypes\JediGUIInstall.pas
+if ERRORLEVEL 1 goto FailedCompile
+
+
+:: compile installer
+
+build\dcc32ex.exe --runtime-package-rtl --runtime-package-vcl --preserve-config -q -w -dJCLINSTALL -E..\bin -I..\source\include -U..\source\common;..\source\windows JediInstaller.dpr
+if ERRORLEVEL 1 goto FailedCompile
+
+
+echo Launching JCL installer...
+
+start ..\bin\JediInstaller.exe %2 %3 %4 %5 %6 %7 %8 %9
+if ERRORLEVEL 1 goto FailStart
+goto FINI
+
+:FailStart
+..\bin\JediInstaller.exe %2 %3 %4 %5 %6 %7 %8 %9
+goto FINI
+
+:FailedCompile
+echo.
+echo.
+echo An error occured while compiling the installer. Installation aborted.
+echo.
+pause
+
+:FINI
+cd ..
+SET DELPHIVERSION=
diff --git a/official/1.104/Install.txt b/official/1.104/Install.txt
new file mode 100644
index 0000000..116d935
--- /dev/null
+++ b/official/1.104/Install.txt
@@ -0,0 +1,71 @@
+JEDI Code Library v 1.104 Installation
+
+Supported development tools versions:
+
+- Delphi 2009 and C++Builder 2009
+- CodeGear RAD Studio 2007 (also known as Delphi 2007 for Win32, C++Builder 2007)
+- Borland Developer Studio 2006 (also known as Delphi 2006, C++Builder 2006)
+- Borland Kylix 3
+- Borland Delphi 7
+- Borland Delphi 6 Update Pack #2 (including Personal Edition)
+- Borland Delphi 5 Update Pack #1
+- Borland C++ Builder 6
+- Borland C++ Builder 5
+
+For more detailed information, see docs\Readme.html.
+
+Please make sure you have installed latest update packs. You can download them
+from CodeGear Support web page:
+
+Delphi: http://support.codegear.com/delphi
+C++Builder: http://support.codegear.com/cppbuilder
+
+******************************* 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. *
+* *
+********************************************************************************
+
+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"
+
+ or
+
+ >install d5
+
+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 2009-01-21
diff --git a/official/1.104/LICENSE-BZIP2.txt b/official/1.104/LICENSE-BZIP2.txt
new file mode 100644
index 0000000..75a3c9f
--- /dev/null
+++ b/official/1.104/LICENSE-BZIP2.txt
@@ -0,0 +1,42 @@
+
+--------------------------------------------------------------------------
+
+This program, "bzip2", the associated library "libbzip2", and all
+documentation, are copyright (C) 1996-2007 Julian R Seward. 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. 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.
+
+3. Altered source versions must be plainly marked as such, and must
+ not be misrepresented as being the original software.
+
+4. The name of the author may not be used to endorse or promote
+ products derived from this software without specific prior written
+ permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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.
+
+Julian Seward, jseward@bzip.org
+bzip2/libbzip2 version 1.0.5 of 10 December 2007
+
+--------------------------------------------------------------------------
diff --git a/official/1.104/LICENSE-DRYICONS.txt b/official/1.104/LICENSE-DRYICONS.txt
new file mode 100644
index 0000000..a00cb60
--- /dev/null
+++ b/official/1.104/LICENSE-DRYICONS.txt
@@ -0,0 +1,34 @@
+DryIcons Free License Agreement
+
+Read Full Legal Code
+
+DryIcons is a service provided by our team of enthusiastic graphic and web designers and programmers. The purpose of this service is to provide only high-quality, free icons and free icon sets, as well as free vector graphics to the general public, with a specific target to designers, software and web developers.
+All DryIcons' Works (meaning "icons, icon sets and graphics") are free of charge, but please read further under what Terms and Conditions.
+All DryIcons Works are licensed under a DryIcons Free License. This means that you can use our icons, icon sets and graphics in any publicly accessible web site, web application or any form of presentation publicly accessible through the World Wide Web only according to the DryIcons Free License Terms and Conditions:
+
+ * You must put a back link with credits to http://dryicons.com on every page where DryIcons' Works are used (example: Icons by DryIcons);
+ * You must include the correct back link to DryIcons website, which is: http://dryicons.com;
+ * You must place the link on an easy-to-see, recognizable place, so there is no confusion about the Original Author of the Works (DryIcons);
+ * When copying, or paraphrasing description text (or title) on one of the Works, you must make sure there are no spelling mistakes;
+ * Do not try to take credit or imply in any way that you and not DryIcons is the Original Author of the Licensed Material (icons, icon sets and graphics).
+
+What you CAN DO:
+
+ 1. All DryIcons' Works are being provided to You under the Terms of this agreement, which allows for use of our Works but does not transfer ownership. All DryIcons' Works remain property of DryIcons;
+ 2. You may use DryIcons' Works in any personal or commercial project unlimited number of times according to the DryIcons Free License Terms and Conditions;
+ 3. You may use DryIcons' Works in any Open Source project and application according to the DryIcons Free License Terms and Conditions;
+ 4. Your rights to DryIcons' Works are worldwide and for the duration of DryIcons' rights in the Works;
+ 5. Any uses other than the ones mentioned above must be approved by DryIcons in writing;
+ 6. Unauthorized use will result in immediate termination of this License, and with it, your rights to use DryIcons' Works.
+
+What you CAN NOT DO:
+
+ 1. You may not alter, crop, modify, manipulate and create derivative works of DryIcons' Works. All Works must be used "AS IS";
+ 2. You may not redistribute, license, sell, lease, assign, convey or transfer DryIcons' Works, or offer free downloads in their present form or in a modified form to any third party;
+ 3. You may not distribute the DryIcons' Works (icons, icon sets and graphics) online in a downloadable format or enable them to be distributed via mobile devices. You may link to http://dryicons.com instead;
+ 4. You may not incorporate DryIcons' Works into a logo, trademark or service mark;
+ 5. You may not use DryIcons' Works directly from dryicons.com or any other location hosted on the dryicons.com domain or any other domain owned by DryIcons.
+
+Copyright
+
+ 1. DryIcons.com reserves the copyrights and ownership rights of all DryIcons' Works downloaded from this website. We reserve the right to change parts of this License without notice and at our sole discretion.
diff --git a/official/1.104/LICENSE-PCRE.txt b/official/1.104/LICENSE-PCRE.txt
new file mode 100644
index 0000000..afe9b6a
--- /dev/null
+++ b/official/1.104/LICENSE-PCRE.txt
@@ -0,0 +1,68 @@
+PCRE LICENCE
+------------
+
+PCRE is a library of functions to support regular expressions whose syntax
+and semantics are as close as possible to those of the Perl 5 language.
+
+Release 7 of PCRE is distributed under the terms of the "BSD" licence, as
+specified below. The documentation for PCRE, supplied in the "doc"
+directory, is distributed under the same terms as the software itself.
+
+The basic library functions are written in C and are freestanding. Also
+included in the distribution is a set of C++ wrapper functions.
+
+
+THE BASIC LIBRARY FUNCTIONS
+---------------------------
+
+Written by: Philip Hazel
+Email local part: ph10
+Email domain: cam.ac.uk
+
+University of Cambridge Computing Service,
+Cambridge, England.
+
+Copyright (c) 1997-2008 University of Cambridge
+All rights reserved.
+
+
+THE C++ WRAPPER FUNCTIONS
+-------------------------
+
+Contributed by: Google Inc.
+
+Copyright (c) 2007-2008, Google Inc.
+All rights reserved.
+
+
+THE "BSD" LICENCE
+-----------------
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ * 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.
+
+ * Neither the name of the University of Cambridge nor the name of Google
+ Inc. nor the names of their contributors may 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 COPYRIGHT OWNER 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.
+
+End
diff --git a/official/1.104/LICENSE-SEVENZIP.txt b/official/1.104/LICENSE-SEVENZIP.txt
new file mode 100644
index 0000000..984332e
--- /dev/null
+++ b/official/1.104/LICENSE-SEVENZIP.txt
@@ -0,0 +1,57 @@
+ 7-Zip
+ ~~~~~
+ License for use and distribution
+ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+ 7-Zip Copyright (C) 1999-2008 Igor Pavlov.
+
+ Licenses for files are:
+
+ 1) 7z.dll: GNU LGPL + unRAR restriction
+ 2) All other files: GNU LGPL
+
+ The GNU LGPL + unRAR restriction means that you must follow both
+ GNU LGPL rules and unRAR restriction rules.
+
+
+ Note:
+ You can use 7-Zip on any computer, including a computer in a commercial
+ organization. You don't need to register or pay for 7-Zip.
+
+
+ GNU LGPL information
+ --------------------
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+ unRAR restriction
+ -----------------
+
+ The decompression engine for RAR archives was developed using source
+ code of unRAR program.
+ All copyrights to original unRAR code are owned by Alexander Roshal.
+
+ The license for original unRAR code has the following restriction:
+
+ The unRAR sources cannot be used to re-create the RAR compression algorithm,
+ which is proprietary. Distribution of modified unRAR sources in separate form
+ or as a part of other software is permitted, provided that it is clearly
+ stated in the documentation and source comments that the code may
+ not be used to develop a RAR (WinRAR) compatible archiver.
+
+
+ --
+ Igor Pavlov
diff --git a/official/1.104/LICENSE-ZLIB.txt b/official/1.104/LICENSE-ZLIB.txt
new file mode 100644
index 0000000..91ed849
--- /dev/null
+++ b/official/1.104/LICENSE-ZLIB.txt
@@ -0,0 +1,25 @@
+/* zlib.h -- interface of the 'zlib' general purpose compression library
+ version 1.2.3, July 18th, 2005
+
+ Copyright (C) 1995-2005 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 jloup@gzip.org
+ Mark Adler madler@alumni.caltech.edu
+
+*/
diff --git a/official/1.104/LICENSE.txt b/official/1.104/LICENSE.txt
new file mode 100644
index 0000000..7a45bfe
--- /dev/null
+++ b/official/1.104/LICENSE.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.104/bin/JCL-install.ini b/official/1.104/bin/JCL-install.ini
new file mode 100644
index 0000000..f1e29e5
--- /dev/null
+++ b/official/1.104/bin/JCL-install.ini
@@ -0,0 +1,152 @@
+[RAD Studio 2009]
+JclJediCodeLibrary=1
+JclJCLDef=1
+JclJCLDefMath=1
+JclJCLDefDebug=0
+JclJCLDefEDI=0
+JclJCLDefPCRE=1
+JclJCLDefBZip2=1
+JclJCLDefZLib=1
+JclJCLDefUnicode=1
+JclJCLDefContainer=1
+JclJCLDef7z=1
+JclJCLDefThreadSafe=1
+JclJCLDefDropObsoleteCode=1
+JclJCLDefUnitVersioning=1
+JclJCLDefMathPrecSingle=0
+JclJCLDefMathPrecDouble=0
+JclJCLDefMathPrecExtended=1
+JclJCLDefMathExtremeValues=1
+JclJCLDefHookDllExceptions=0
+JclJCLDefDebugNoBinary=0
+JclJCLDefDebugNoTD32=0
+JclJCLDefDebugNoMap=0
+JclJCLDefDebugNoExports=0
+JclJCLDefDebugNoSymbols=0
+JclJCLDefEDIWeakPackageUnits=0
+JclJCLDefPCREStaticLink=1
+JclJCLDefPCRELinkDLL=0
+JclJCLDefPCRELinkOnRequest=0
+JclJCLDefBZip2StaticLink=1
+JclJCLDefBZip2LinkDLL=0
+JclJCLDefBZip2LinkOnRequest=0
+JclJCLDefZLibStaticLink=1
+JclJCLDefZLibLinkDLL=0
+JclJCLDefZLibLinkOnRequest=0
+JclJCLDefUnicodeSilentFailure=1
+JclJCLDefUnicodeRawData=1
+JclJCLDefUnicodeZLibData=0
+JclJCLDefUnicodeBZip2Data=0
+JclJCLDefContainerAnsiStr=0
+JclJCLDefContainerWideStr=0
+JclJCLDefContainerUnicodeStr=1
+JclJCLDefContainerNoStr=0
+JclJCLDef7zLinkDLL=0
+JclJCLDef7zLinkOnRequest=1
+JclJCLEnvironment=0
+JclJCLEnvLibPath=0
+JclJCLEnvBrowsingPath=0
+JclJCLEnvDebugDCUPath=0
+JclJCLMake=1
+JclJCLMakeRelease=1
+JclJCLMakeReleaseVClx=0
+JclJCLMakeReleaseVCL=1
+JclJCLMakeDebug=1
+JclJCLMakeDebugVClx=0
+JclJCLMakeDebugVCL=1
+JclJCLCopyHppFiles=0
+JclJCLCheckHppFiles=0
+JclJCLPackages=1
+JclJCLVclPackage=1
+JclJCLClxPackage=0
+JclJCLDualPackages=0
+JclJCLCopyPackagesHppFiles=0
+JclJCLPdbCreate=0
+JclJCLMapCreate=0
+JclJCLJdbgCreate=0
+JclJCLJdbgInsert=0
+JclJCLMapDelete=0
+JclJCLExperts=0
+JclJCLExpertsDsgnPackages=1
+JclJCLExpertsDLL=0
+JclJCLExpertDebug=0
+JclJCLExpertAnalyzer=0
+JclJCLExpertFavorite=0
+JclJCLExpertRepository=0
+JclJCLExpertThreadNames=0
+JclJCLExpertUses=0
+JclJCLExpertSimdView=0
+JclJCLExpertVersionControl=0
+JclJCLExceptDlg=0
+JclJCLExceptDlgVCL=0
+JclJCLExceptDlgVCLSnd=0
+JclJCLExceptDlgCLX=0
+JclJCLHelp=0
+JclJCLHelpHlp=0
+JclJCLHelpChm=0
+JclJCLHelpHxS=0
+JclJCLHelpHxSPlugin=0
+JclJCLMakeDemos=0
+BPL-Path=C:\jcl\lib\d12\
+DCP-Path=C:\jcl\lib\d12\
+
+[RAD Studio 2009 demos]
+examples\common\containers\algorithms\AlgorithmsExample.dpr=0
+examples\windows\peimage\ApiHookExample.dpr=0
+examples\windows\appinst\AppInstExample.dpr=0
+examples\windows\compression\archive\ArchiveDemo.dpr=0
+examples\common\graphics\ClipLineDemo.dpr=0
+examples\windows\clr\ClrDemo.dpr=0
+examples\windows\ConsoleExamples.dpr=0
+examples\common\containers\performance\ContainerPerformance.dpr=0
+examples\windows\asuser\CreateProcAsUserExample.dpr=0
+examples\windows\delphitools\dependencyviewer\DependView.dpr=0
+examples\windows\edisdk\EDICOMExample.dpr=0
+examples\windows\edisdk\comserver\EDISDK.dpr=0
+examples\common\sysinfo\EnvironmentExample.dpr=0
+examples\windows\debug\reportconverter\ExceptionReportConverter.dpr=0
+examples\common\expreval\ExprEvalExample.dpr=0
+examples\common\filesearch\FileSearchDemo.dpr=0
+examples\windows\filesummary\FileSummaryExample.dpr=0
+examples\windows\debug\framestrack\FramesTrackExample.dpr=0
+examples\common\containers\hashing\HashingExample.dpr=0
+examples\windows\ntfs\JEDISoftLinks.dpr=0
+examples\windows\lanman\LanManExample.dpr=0
+examples\common\containers\lists\ListExample.dpr=0
+examples\windows\locales\LocalesExample.dpr=0
+examples\windows\mapi\MapiExample.dpr=0
+examples\common\multimedia\MidiOutExample.dpr=0
+examples\windows\multimedia\MultiMediaExample.dpr=0
+examples\windows\ntservice\NtSvcExample.dpr=0
+examples\common\numformat\NumFormatExample.dpr=0
+examples\common\pcre\PCREDemo.dpr=0
+examples\windows\peimage\PeFuncExample.dpr=0
+examples\windows\delphitools\peviewer\PeViewer.dpr=0
+examples\windows\mapi\ReadMailExample.dpr=0
+examples\windows\registry\RegistryExample.dpr=0
+examples\windows\delphitools\resfix\ResFix.dpr=0
+examples\common\rtti\RTTIExample.dpr=0
+examples\windows\delphitools\screenjpg\ScreenJPG.dpr=0
+examples\windows\appinst\SingleInstExample.dpr=0
+examples\windows\debug\sourceloc\SourceLocExample.dpr=0
+examples\windows\debug\stacktrack\StackTrackDLLsComLibrary.dpr=0
+examples\windows\debug\stacktrack\StackTrackDLLsDynamicLibrary.dpr=0
+examples\windows\debug\stacktrack\StackTrackDLLsExample.dpr=0
+examples\windows\debug\stacktrack\StackTrackDLLsStaticLibrary.dpr=0
+examples\windows\debug\stacktrack\StackTrackExample.dpr=0
+examples\common\graphics\StretchGraphicExample.dpr=0
+examples\windows\structstorage\StructStorageExample.dpr=0
+examples\windows\sysinfo\SysInfoExample.dpr=0
+examples\windows\tasks\TaskDemo.dpr=0
+examples\common\textconverter\TextConverter.dpr=0
+examples\common\textreader\TextReaderExample.dpr=0
+examples\windows\debug\threadexcept\ThreadExceptExample.dpr=0
+examples\windows\delphitools\toolhelpview\ToolHelpViewer.dpr=0
+examples\common\containers\trees\TreeExample.dpr=0
+examples\common\containers\trees\TreeStructure.dpr=0
+examples\common\unitversioning\UnitVersioningTest.dpr=0
+examples\common\unitversioning\UnitVersioningTestDLL.dpr=0
+examples\windows\peimage\UnmangleNameExample.dpr=0
+examples\windows\fileversion\VerInfoExample.dpr=0
+examples\windows\widestring\WideStringExample.dpr=0
+
diff --git a/official/1.104/bin/JediInstaller.exe b/official/1.104/bin/JediInstaller.exe
new file mode 100644
index 0000000..45dae5f
Binary files /dev/null and b/official/1.104/bin/JediInstaller.exe differ
diff --git a/official/1.104/bin/RAD Studio 2009.log b/official/1.104/bin/RAD Studio 2009.log
new file mode 100644
index 0000000..86f9fb3
--- /dev/null
+++ b/official/1.104/bin/RAD Studio 2009.log
@@ -0,0 +1,77 @@
+================================================================================
+JCL 1.104 Release Build 3248
+==========RAD Studio 2009=======================================================
+Installed personalities :
+32 bit Delphi
+================================================================================
+Single profile installation
+================================================================================
+Saving conditional defines...
+Loaded template for include file C:\jcl\source\include\jcl.template.inc
+Saved include file C:\jcl\source\include\jcld12.inc
+Making common library units for RAD Studio 2009
+Compiling .dcu files...
+"C:\Archivos de programa\CodeGear\RAD Studio\6.0\bin\dcc32.exe" bzip2 Jcl8087 JclAbstractContainers JclAlgorithms JclAnsiStrings JclArrayLists JclArraySets JclBase JclBinaryTrees JclBorlandTools JclComplex JclCompression JclContainerIntf JclCounter JclDateTime JclEDI JclEDISEF JclEDITranslators JclEDIXML JclEDI_ANSIX12 JclEDI_ANSIX12_Ext JclEDI_UNEDIFACT JclEDI_UNEDIFACT_Ext JclExprEval JclFileUtils JclHashMaps JclHashSets JclIniFiles JclLinkedLists JclLogic JclMath JclMIDI JclMime JclPCRE JclQueues JclResources JclRTTI JclSchedule JclSimpleXml JclSortedMaps JclStacks JclStatistics JclStreams JclStrHashMap JclStringConversions JclStringLists JclStrings JclSynch JclSysInfo JclSysUtils JclTrees JclUnicode JclUnitConv JclUnitVersioning JclUnitVersioningProviders JclValidation JclVectors JclWideStrings pcre zlibh --no-config -U"..\..\..\ARCHIV~1\codegear\RADSTU~1\6.0\lib" -M -$C- -$D- -$I- -$L- -$O+ -$Q- -$R- -$W- -$Y- -N"..\..\lib\d12" -I"..\include" -U".;..\windows;..\vcl;..\visclx" -R".;..\windows;..\vcl;..\visclx"
+CodeGear Delphi for Win32 compiler version 20.0
+Copyright (c) 1983,2008 CodeGear
+539425 lines, 4.86 seconds, 50250 bytes code, 16736 bytes data.
+Making windows library units for RAD Studio 2009
+Compiling .dcu files...
+"C:\Archivos de programa\CodeGear\RAD Studio\6.0\bin\dcc32.exe" Hardlinks JclAppInst JclCIL JclCLR JclCOM JclConsole JclDebug JclDotNet JclHookExcept JclLANMan JclLocales JclMapi JclMetadata JclMiscel JclMsdosSys JclMultimedia JclNTFS JclPeImage JclRegistry JclSecurity JclShell JclStructStorage JclSvcCtrl JclTask JclTD32 JclWideFormat JclWin32 JclWin32Ex JclWinMIDI mscoree_TLB mscorlib_TLB MSHelpServices_TLB MSTask sevenzip Snmp --no-config -U"..\..\..\ARCHIV~1\codegear\RADSTU~1\6.0\lib" -M -$C- -$D- -$I- -$L- -$O+ -$Q- -$R- -$W- -$Y- -N"..\..\lib\d12" -I"..\include" -U"..\common;.;..\vcl;..\visclx" -R"..\common;.;..\vcl;..\visclx"
+CodeGear Delphi for Win32 compiler version 20.0
+Copyright (c) 1983,2008 CodeGear
+189148 lines, 1.88 seconds, 2448 bytes code, 164 bytes data.
+Making vcl library units for RAD Studio 2009
+Compiling .dcu files...
+"C:\Archivos de programa\CodeGear\RAD Studio\6.0\bin\dcc32.exe" JclFont JclGraphics JclGraphUtils JclPrint JclVersionControl JclVersionCtrlCVSImpl JclVersionCtrlSVNImpl --no-config -U"..\..\..\ARCHIV~1\codegear\RADSTU~1\6.0\lib" -M -$C- -$D- -$I- -$L- -$O+ -$Q- -$R- -$W- -$Y- -N"..\..\lib\d12" -I"..\include" -U"..\common;..\windows;.;..\visclx" -R"..\common;..\windows;.;..\visclx"
+CodeGear Delphi for Win32 compiler version 20.0
+Copyright (c) 1983,2008 CodeGear
+25539 lines, 0.69 seconds, 4364 bytes code, 36 bytes data.
+Making common library debug units for RAD Studio 2009
+Compiling .dcu files...
+"C:\Archivos de programa\CodeGear\RAD Studio\6.0\bin\dcc32.exe" bzip2 Jcl8087 JclAbstractContainers JclAlgorithms JclAnsiStrings JclArrayLists JclArraySets JclBase JclBinaryTrees JclBorlandTools JclComplex JclCompression JclContainerIntf JclCounter JclDateTime JclEDI JclEDISEF JclEDITranslators JclEDIXML JclEDI_ANSIX12 JclEDI_ANSIX12_Ext JclEDI_UNEDIFACT JclEDI_UNEDIFACT_Ext JclExprEval JclFileUtils JclHashMaps JclHashSets JclIniFiles JclLinkedLists JclLogic JclMath JclMIDI JclMime JclPCRE JclQueues JclResources JclRTTI JclSchedule JclSimpleXml JclSortedMaps JclStacks JclStatistics JclStreams JclStrHashMap JclStringConversions JclStringLists JclStrings JclSynch JclSysInfo JclSysUtils JclTrees JclUnicode JclUnitConv JclUnitVersioning JclUnitVersioningProviders JclValidation JclVectors JclWideStrings pcre zlibh --no-config -U"..\..\..\ARCHIV~1\codegear\RADSTU~1\6.0\lib" -M -$C+ -$D+ -$I+ -$L+ -$O- -$Q+ -$R+ -$W+ -$Y+ -N"..\..\lib\d12\debug" -I"..\include" -U".;..\windows;..\vcl;..\visclx" -R".;..\windows;..\vcl;..\visclx"
+CodeGear Delphi for Win32 compiler version 20.0
+Copyright (c) 1983,2008 CodeGear
+540180 lines, 5.01 seconds, 50418 bytes code, 16736 bytes data.
+Making windows library debug units for RAD Studio 2009
+Compiling .dcu files...
+"C:\Archivos de programa\CodeGear\RAD Studio\6.0\bin\dcc32.exe" Hardlinks JclAppInst JclCIL JclCLR JclCOM JclConsole JclDebug JclDotNet JclHookExcept JclLANMan JclLocales JclMapi JclMetadata JclMiscel JclMsdosSys JclMultimedia JclNTFS JclPeImage JclRegistry JclSecurity JclShell JclStructStorage JclSvcCtrl JclTask JclTD32 JclWideFormat JclWin32 JclWin32Ex JclWinMIDI mscoree_TLB mscorlib_TLB MSHelpServices_TLB MSTask sevenzip Snmp --no-config -U"..\..\..\ARCHIV~1\codegear\RADSTU~1\6.0\lib" -M -$C+ -$D+ -$I+ -$L+ -$O- -$Q+ -$R+ -$W+ -$Y+ -N"..\..\lib\d12\debug" -I"..\include" -U"..\common;.;..\vcl;..\visclx" -R"..\common;.;..\vcl;..\visclx"
+CodeGear Delphi for Win32 compiler version 20.0
+Copyright (c) 1983,2008 CodeGear
+189148 lines, 2.06 seconds, 2585 bytes code, 164 bytes data.
+Making vcl library debug units for RAD Studio 2009
+Compiling .dcu files...
+"C:\Archivos de programa\CodeGear\RAD Studio\6.0\bin\dcc32.exe" JclFont JclGraphics JclGraphUtils JclPrint JclVersionControl JclVersionCtrlCVSImpl JclVersionCtrlSVNImpl --no-config -U"..\..\..\ARCHIV~1\codegear\RADSTU~1\6.0\lib" -M -$C+ -$D+ -$I+ -$L+ -$O- -$Q+ -$R+ -$W+ -$Y+ -N"..\..\lib\d12\debug" -I"..\include" -U"..\common;..\windows;.;..\visclx" -R"..\common;..\windows;.;..\visclx"
+CodeGear Delphi for Win32 compiler version 20.0
+Copyright (c) 1983,2008 CodeGear
+25539 lines, 0.61 seconds, 4650 bytes code, 36 bytes data.
+Compiling package C:\jcl\packages\d12\Jcl.dpk...
+Cleaning package cache for Jcl120.bpl
+Cleaning ok
+Compiling package C:\jcl\packages\d12\Jcl.dpk
+"C:\Archivos de programa\CodeGear\RAD Studio\6.0\bin\dcc32.exe" "C:\jcl\packages\d12\Jcl.dpk" --no-config -U"..\..\..\ARCHIV~1\codegear\RADSTU~1\6.0\lib" -N"..\..\lib\d12" -I"..\..\lib\d12;..\..\source\include" -R"..\..\lib\d12;..\..\source\include" -DRELEASE;$(DCC_Define) -U"..\..\lib\d12;..\..\..\DOCUME~1\ALLUSE~1\DOCUME~1\RADSTU~1\6.0\dcp;..\..\lib\d12;..\..\source\include" -LN"..\..\lib\d12" -LE"..\..\lib\d12"
+CodeGear Delphi for Win32 compiler version 20.0
+Copyright (c) 1983,2008 CodeGear
+128 lines, 0.67 seconds, 1358076 bytes code, 675596 bytes data.
+Compilation success
+...done.
+Compiling package C:\jcl\packages\d12\JclContainers.dpk...
+Cleaning package cache for JclContainers120.bpl
+Cleaning ok
+Compiling package C:\jcl\packages\d12\JclContainers.dpk
+"C:\Archivos de programa\CodeGear\RAD Studio\6.0\bin\dcc32.exe" "C:\jcl\packages\d12\JclContainers.dpk" --no-config -U"..\..\..\ARCHIV~1\codegear\RADSTU~1\6.0\lib" -N"..\..\lib\d12" -I"..\..\lib\d12;..\..\source\include" -R"..\..\lib\d12;..\..\source\include" -DRELEASE;$(DCC_Define) -U"..\..\lib\d12;..\..\..\DOCUME~1\ALLUSE~1\DOCUME~1\RADSTU~1\6.0\dcp;..\..\lib\d12;..\..\source\include" -LN"..\..\lib\d12" -LE"..\..\lib\d12"
+CodeGear Delphi for Win32 compiler version 20.0
+Copyright (c) 1983,2008 CodeGear
+62 lines, 0.78 seconds, 1460836 bytes code, 816 bytes data.
+Compilation success
+...done.
+Compiling package C:\jcl\packages\d12\JclVcl.dpk...
+Cleaning package cache for JclVcl120.bpl
+Cleaning ok
+Compiling package C:\jcl\packages\d12\JclVcl.dpk
+"C:\Archivos de programa\CodeGear\RAD Studio\6.0\bin\dcc32.exe" "C:\jcl\packages\d12\JclVcl.dpk" --no-config -U"..\..\..\ARCHIV~1\codegear\RADSTU~1\6.0\lib" -N"..\..\lib\d12" -I"..\..\lib\d12;..\..\source\include" -R"..\..\lib\d12;..\..\source\include" -DRELEASE;$(DCC_Define) -U"..\..\lib\d12;..\..\..\DOCUME~1\ALLUSE~1\DOCUME~1\RADSTU~1\6.0\dcp;..\..\lib\d12;..\..\source\include" -LN"..\..\lib\d12" -LE"..\..\lib\d12"
+CodeGear Delphi for Win32 compiler version 20.0
+Copyright (c) 1983,2008 CodeGear
+57 lines, 0.25 seconds, 90620 bytes code, 1612 bytes data.
+Compilation success
+...done.
diff --git a/official/1.104/bin/dirinfo.txt b/official/1.104/bin/dirinfo.txt
new file mode 100644
index 0000000..38bc9b2
--- /dev/null
+++ b/official/1.104/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.104/clean.bat b/official/1.104/clean.bat
new file mode 100644
index 0000000..b9af953
--- /dev/null
+++ b/official/1.104/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 *.local *.identcache *.rsp
+@cd..
\ No newline at end of file
diff --git a/official/1.104/clean.sh b/official/1.104/clean.sh
new file mode 100644
index 0000000..a74b87f
--- /dev/null
+++ b/official/1.104/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.104/devtools/included_files.bat b/official/1.104/devtools/included_files.bat
new file mode 100644
index 0000000..bda4a9c
--- /dev/null
+++ b/official/1.104/devtools/included_files.bat
@@ -0,0 +1,19 @@
+rem shell script to create templates
+
+copy ..\source\include\jcl.template.inc ..\source\include\jclc5.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jclc6.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jclkc3.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jclkd3.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld5.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld6.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld7.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jclcs1.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld8.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld9.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld9.net.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld10.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld10.net.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld11.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld11.net.inc
+copy ..\source\include\jcl.template.inc ..\source\include\jcld12.inc
+
diff --git a/official/1.104/devtools/included_files.sh b/official/1.104/devtools/included_files.sh
new file mode 100644
index 0000000..912953e
--- /dev/null
+++ b/official/1.104/devtools/included_files.sh
@@ -0,0 +1,21 @@
+#!/bin/sh
+#
+# shell script to create templates
+
+cp ../source/include/jcl.template.inc ../source/include/jclc5.inc
+cp ../source/include/jcl.template.inc ../source/include/jclc6.inc
+cp ../source/include/jcl.template.inc ../source/include/jclkc3.inc
+cp ../source/include/jcl.template.inc ../source/include/jclkd3.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld5.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld6.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld7.inc
+cp ../source/include/jcl.template.inc ../source/include/jclcs1.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld8.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld9.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld9.net.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld10.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld10.net.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld11.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld11.net.inc
+cp ../source/include/jcl.template.inc ../source/include/jcld12.inc
+
diff --git a/official/1.104/devtools/jpp b/official/1.104/devtools/jpp
new file mode 100644
index 0000000..b03f3d5
Binary files /dev/null and b/official/1.104/devtools/jpp differ
diff --git a/official/1.104/devtools/jpp.exe b/official/1.104/devtools/jpp.exe
new file mode 100644
index 0000000..8af9cf0
Binary files /dev/null and b/official/1.104/devtools/jpp.exe differ
diff --git a/official/1.104/devtools/pgEdit.exe b/official/1.104/devtools/pgEdit.exe
new file mode 100644
index 0000000..d18ba02
Binary files /dev/null and b/official/1.104/devtools/pgEdit.exe differ
diff --git a/official/1.104/devtools/pgEdit.xml b/official/1.104/devtools/pgEdit.xml
new file mode 100644
index 0000000..0614b73
--- /dev/null
+++ b/official/1.104/devtools/pgEdit.xml
@@ -0,0 +1,107 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/official/1.104/docs/Contacting authors.html b/official/1.104/docs/Contacting authors.html
new file mode 100644
index 0000000..ca21885
--- /dev/null
+++ b/official/1.104/docs/Contacting authors.html
@@ -0,0 +1,33 @@
+
+
+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 .
+
+
+
\ No newline at end of file
diff --git a/official/1.104/docs/Contributors.html b/official/1.104/docs/Contributors.html
new file mode 100644
index 0000000..4e52f9d
--- /dev/null
+++ b/official/1.104/docs/Contributors.html
@@ -0,0 +1,398 @@
+
+
+
+
+ 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 .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/official/1.104/docs/Contributors.txt b/official/1.104/docs/Contributors.txt
new file mode 100644
index 0000000..fcb7bf7
--- /dev/null
+++ b/official/1.104/docs/Contributors.txt
@@ -0,0 +1,116 @@
+aa=aa@bitsmart.com
+Alan Lloyd=alanglloyd@aol.com
+Alex Denissov=denisso@uwindsor.ca
+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=barry.j.kelly@gmail.com
+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=
+Christoph Lindeman=christoph@lindemann.nu
+Clayton Collie=
+Corrie Engelbrecht=sahfs@iafrica.com
+Cybertron_549672=Cybertron_549672@yahoo.com
+Daniel Mller=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=cycocrew@orange.fr
+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 Vgsther 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 F. S. Liljendal=pelle.liljendal@firstconcern.com
+Peter Friese=freter@gmx.net
+Peter McMahon=fmcmp02@kc.kzn.school.za
+Peter Panino=peter-panino@aon.at
+Peter Thrnquist=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.104/docs/Experts.html b/official/1.104/docs/Experts.html
new file mode 100644
index 0000000..98d5c52
--- /dev/null
+++ b/official/1.104/docs/Experts.html
@@ -0,0 +1,160 @@
+
+
+
+ JEDI Code Library Release 1.103
+ JEDI Code Library
+Release 1.104
+Content of this file
+
+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, Borland Developer Studio 2006 and Turbo Delphi Professional,
+experts are installed as design time packages.
+
+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. The IDE expert can automatically create this file
+when the project is compiled (see below).
+ Insert JCL Debug info into executable file. 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. The IDE expert can automatically insert these informations
+when the project is compiled (see below).
+ 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.
+
+
+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 created
+from the detailled MAP file. The behavior of this conversion can be customized in
+the JCL options dialog (in the Tools menu of the IDE): the debug informations can
+be exported as .jdbg files or inserted in the binary file. The expert outputs a
+message in the IDE message view to display details about the data being generated.
+
+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
+ DBG and PDB debug informations (for system DLLs)
+ Library or Borland package export tables
+
+It is also possible to create JCL debug data programmatically from a MAP file
+by using MakeJclDbg command line tool in jcl\examples\windows\delphitools folder.
+This utility can either export data as a separate .jdbg file or insert them in the
+executable. 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\dialog folder. 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 ... |
+Delphi Projects | Delphi Files, Select 'JCL Exception Dialog for XXX' (where XXX is
+either Delphi or C++Builder depending on your project). A wizard will appear to
+configure the options for this dialog.
+
+ Check "Project" | "Insert JCL Debug data" menu item
+
+ Do Project | Build
+
+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.
+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 properly work. 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).
+This dialog provides enhancement to the debugger of Delphi and C++Builder regarding
+XMM registers. These registers were introduced in SSE instructions (and are still
+used in SSE2, SSE3 and SSSE3 instructions). This dialog can be displayed by clicking
+on menu View | Debug Windows | SIMD (keyboard shortcut Ctrl+Alt+D).
+It is divided in to panes following the style of the FPU window: the left pane
+displays content of registers and the right pane displays MXCSR flags. The format
+of the registers can be modified from the context. All registers and flags can be
+modified and changes will be applied to the debugged process.
+This expert modifies the IDE Open/Save dialogs and add a combobox to store your
+favorite directories. Items can be added and deleted using the button at the right
+of the combobox.
+
+
+
diff --git a/official/1.104/docs/MPL FAQ.html b/official/1.104/docs/MPL FAQ.html
new file mode 100644
index 0000000..90cc6c2
--- /dev/null
+++ b/official/1.104/docs/MPL FAQ.html
@@ -0,0 +1,131 @@
+
+
+MPL FAQ
+
+
+
+ Mozilla Public License FAQ Draft 1.0, 4/10/2000
+
+
+Please email Comments to Michael Beck Official FAQ from Mozilla
+
+
Author perspective
+
+ Q: Do I retain copyright once I publish source under the MPL?A: Absolutely. You still retain all your copyrights.
+ 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.
+ 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.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
+
+ 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".
+ Q: Must I release the source code of used components?A: Only of those covered by MPL, together with any modifications to them.
+ 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.
+ 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.
+ 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.
+ 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)
+ 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.
+ 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.
+ 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:
+
+ 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.
+ 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.
+
+ 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.104/docs/MPL-1.1.txt b/official/1.104/docs/MPL-1.1.txt
new file mode 100644
index 0000000..7a45bfe
--- /dev/null
+++ b/official/1.104/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.104/docs/Readme.html b/official/1.104/docs/Readme.html
new file mode 100644
index 0000000..0540ad3
--- /dev/null
+++ b/official/1.104/docs/Readme.html
@@ -0,0 +1,406 @@
+
+
+
+ JEDI Code Library Beta 1.103
+ JEDI Code Library
+
+Release 1.104
+
+Content of this file
+
+
+
+JCL release 1.104 provides an updated support for all targets (including Delphi 2009 and C++Builder 2009).
+
+As always, multiple bugs have been fixed; for detailed change logs,
+use the facilities of our Subversion repository at Sourceforge.net
+http://sourceforge.net/projects/jcl/
+, see below.
+
+Head changes:
+
+
+
+
+ improved Unicode support for Delphi 2009 and C++Builder 2009;
+ support for late and static binding to ZLib code;
+ version control actions for CVS and SVN added to JCL runtime;
+ the polynomial of CRC computations can be customized;
+ speed improvement of TJclBufferedStream during write operations;
+ new archive compression format provided with 7-zip: lzma, pe, elf, macho, udf, xar, mub, hfs, dmg; the wrapper has previous support for the compression and the decompression of zip, bzip2, gzip, 7z, tar and for the decompression of rar, iso, chm, deb, cab...
+ new string conversion functions with failure detection.
+
+
+
+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, BDS 2006, RAD Studio 2007, Delphi 2009 and C++Builder 2009); a different suffix
+is added for each target to the BPL file name (for Delphi and C++Builder 2009, the library file is named jcl120.bpl).
+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 or be converted to .jdbg files.
+Once linked MAP files could be deleted. These options are subnodes of the "Packages" node.
+
+For BDS 2006, RAD Studio 2007 and C++Builder 2009, the compiler introduced a new option to make the same packages
+available in C++, by checking the "Dual packages" option of the "Packages" node, you will be able
+to call functions of the JCL from C++ code.
+
+.net Framework support:
+
+A subset of JCL units was worked over to support Delphi.Net (Delphi 2005, BDS 2006 and RAD
+Studio 2007). The packages belong to the Jedi.Jcl namespace.
+
+The JEDI Code Library can be compiled and installed in the following environments
+
+Only runtime support:
+
+
+
+
+Only design-time support (only experts):
+
+
+
+Both supports (run time and design time):
+
+
+
+ Delphi version 5, 6, 7;
+
+ C++Builder version 5 & 6;
+
+ Delphi 2005 (Delphi.net personality);
+
+ Borland Developer Studio 2006 (Delphi for Win32, C++Builder Win32, Delphi.net and C#Builder personalities);
+
+ Turbo Delphi (explorer and professional - cf Installation notes );
+
+ CodeGear RAD Studio 2007 (Delphi for Win32 and C++Builder for Win32 personalities);
+
+ Delphi 2009 and C++Builder 2009.
+
+
+
+
+
+ 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 Delphi/C++ installation is back but specific code has not been tested with the latest
+ versions of the kernel. Please ensure you use the flavor of the JCL with Unix EOL.
+
+ Free Pascal (http://www.freepascal.org/ )
+ 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 for Turbo Delphi
+
+The JEDI Code Library can be compiled targetting Turbo Delphi Explorer and Turbo Delphi Professional.
+Turbo Delphi Professional is recognized as BDS 2006, you have to download its command line compiler from
+CodeGear website at http://www.codegear.com/Default.aspx?tabid=160
+to install the full JCL on this tool.
+
+To install the JCL targetting Turbo Delphi Explorer, consider the following checks:
+
+
+
+ If you have an other supported version of Delphi/C++Builder on this computer, it should automatically be
+ detected and the installer will process as usual.
+
+ If you only have Turbo Delphi Explorer (and no other tools) on the computer, the installer cannot be
+ compiled. You have to use the Turbo Explorer flavor of the JCL that contains a precompiled installer. However,
+ you will not be able to install any experts.
+
+
+
+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.codegear.com/ ).
+ The item (http://codecentral.codegear.com/Download.aspx?id=21333 )
+ contains the native compiler to be installed in Delphi 8.
+ The item (http://codecentral.codegear.com/Download.aspx?id=21334 )
+ contains the native compiler to be installed in C#Builder 1.
+ These zip files have to be extracted in the products directory using the standard pattern:
+
+
+
+ Executable files (exe and dll) - BDS\X.0\bin
+
+Default installation
+
+For all others versions of Delphi, C++Builder and BDS, simply launch Install.bat
+and the installer window will let you configure options and install the library.
+
+Although it is not recommended, a manual installation is possible. You will have
+to manually configure options for the library. That is done by modifying an included
+file.
+
+
+
+For each tool you want to install the JCL in, repeat the following steps:
+
+
+
+ Open and edit included file to customize options:
+
+
+ For Kylix 3 (Delphi): source\include\jclkd3.inc
+
+ For Kylix 3 (C++Builder): source\include\jclkc3.inc
+
+ For C++Builder 5: source\include\jclc5.inc
+
+ For C++Builder 6: source\include\jclc6.inc
+
+ For Delphi 5: source\include\jcld5.inc
+
+ For Delphi 6: source\include\jcld6.inc
+
+ For Delphi 7: source\include\jcld7.inc
+
+ For Delphi 2005: source\include\jcld9.inc
+
+ For Delphi.net 2005: source\include\jcld9.net.inc
+
+ For BDS 2006 (Delphi and C++Builder): source\include\jcld10.inc
+
+ For Delphi.net 2006: source\include\jcld10.net.inc
+
+ For CodeGear RAD Studio 2007 (Delphi for Win32 and C++Builder): source\include\jcld11.inc
+
+ For Delphi.net 2007: source\include\jcld11.net.inc
+
+ For Delphi 2009 and C++Builder 2009: source\include\jcld12.inc
+
+
+ In the IDE, open and compile package Jcl.dpk (or Jcl.bpk for C++Builder)
+ located in a subdirectory of the "packages" directory matching your version of
+ the IDE. This package doesn't have to be installed since it doesn't provide
+ any components.
+
+ If you want to install experts, open package JclBaseExpert.dpk and compile it,
+ then you can install all the experts you want (packages are located in the same
+ directory).
+
+
+
+Install.bat - Compile and run VCL version of the JCL Installer (Win32)
+
+The general rule is: If you want to get a
+bug fixed you need to log it!
+
+An issue tracking tool can be accessed via ('Code Library' category):
+http://homepages.codegear.com/jedi/issuetracker/
+
+Please be aware that you are allowed there to enter feature request and code donations as well.
+
+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
+
+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
+
+
+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 Subversion repository updated every day in the JCL daily page
+ http://jcl.sourceforge.net/daily/
+
+To always have access to the most recent changes in the JCL, you
+should install a Subversion client (we recommend TortoiseSVN http://tortoisesvn.tigris.org/
+and RapidSVN http://rapidsvn.tigris.org/ ) and download the
+SVN repository files to your computer as explained in the repository page of the JEDI Wiki at
+http://homepages.codegear.com/jedi/wiki/index.php?title=Repository
+With the SVN client, you can update your local repository at any time.
+You can also view the repository online via the web interface at http://jcl.svn.sourceforge.net/
+
+
+
+ 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.codegear.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 Subversion repository if the fi
+is satisfactory. If you report and fix a lot of bugs, you might even get developer
+access to SVN so you can update the JCL files directly.
+
+
+
diff --git a/official/1.104/docs/Readme.txt b/official/1.104/docs/Readme.txt
new file mode 100644
index 0000000..690771c
--- /dev/null
+++ b/official/1.104/docs/Readme.txt
@@ -0,0 +1,323 @@
+--------------------------------------------------------------------------------
+
+JEDI Code Library
+Release 1.104
+Build 3248
+21-January-2009
+
+--------------------------------------------------------------------------------
+
+Content of this file
+About this release
+Supported tools
+Installation notes
+Manual installation
+Distribution content
+Giving your feedback
+Reporting bugs
+Downloads of stable sources
+Development sources
+Getting involved in JCL development
+
+--------------------------------------------------------------------------------
+
+About this release
+JCL release 1.104 provides an updated support for all targets
+(including Delphi 2009 and C++Builder 2009).
+
+As always, multiple bugs have been fixed; for detailed change logs, use the
+facilities of our Subversion repository at Sourceforge.net
+http://sourceforge.net/projects/jcl/, see below.
+
+Head changes:
+
+ - improved Unicode support for Delphi 2009 and C++Builder 2009;
+ - support for late and static binding to ZLib code;
+ - version control actions for CVS and SVN added to JCL runtime;
+ - the polyniomal of CRC computations can be customized;
+ - speed improvement of TJclBufferedStream during write operations;
+ - new archive compression format provided with 7-zip: lzma, pe, elf, macho,
+ udf, xar, mub, hfs, dmg; the wrapper has previous support for the compression
+ and the decompression of zip, bzip2, gzip, 7z, tar and for the decompression
+ of rar, iso, chm, deb, cab...
+ - new string conversion functions with failure detection.
+
+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, BDS 2006, RAD Studio 2007,
+ Delphi 2009 and C++Builder 2009); a different suffix is added for each target
+ to the BPL file name (for Delphi 2009, the library file is named jcl120.bpl).
+ 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 or be
+converted to .jdbg files. Once linked MAP files could be deleted. These options
+are subnodes of the "Packages" node.
+
+ For BDS 2006, RAD Studio 2007 and C++Builder 2009, the compiler introduced
+a new option to make the same packages available in C++, by checking the
+"Dual packages" option of the "Packages" node, you will be able to call functions
+of the JCL from C++ code.
+
+.net Framework support:
+
+ A subset of JCL units was worked over to support Delphi.Net (Delphi 2005, BDS 2006
+and RAD Studio 2007). The packages belong to the Jedi.Jcl namespace.
+
+--------------------------------------------------------------------------------
+
+Supported Tools
+The JCL can be compiled and installed in the following environments
+
+Only runtime support:
+ - Kylix 3 (cf Installation notes)
+
+Only design-time support (only experts):
+ - C#Builder 1 (cf Installation notes);
+ - Delphi 8.net (cf Installation notes).
+
+Both supports (run time and design time):
+ - Delphi version 5, 6, 7;
+ - C++Builder version 5 & 6;
+ - Delphi 2005 (Delphi.net personality);
+ - Borland Developer Studio 2006 (Delphi for Win32, C++Builder for Win32,
+ Delphi.net and C#Builder personalities);
+ - Turbo Delphi (explorer and professional - cf Installation notes);
+ - CodeGear RAD Studio 2007 (Delphi for Win32 and C++Builder for Win32
+ personalities);
+ - CodeGear Delphi 2009 and C++Builder 2009.
+
+--------------------------------------------------------------------------------
+
+Installation 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 Delphi/C++ installation is back but specific code has not been tested
+ with the latest versions of the kernel. Please ensure you use the flavor of
+ the JCL with Unix EOL.
+
+ - Free Pascal (http://www.freepascal.org/) support has not been updated for
+ this release; most units fromsource/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 for Turbo Delphi
+
+The JEDI Code Library can be compiled targetting Turbo Delphi Explorer and Turbo
+Delphi Professional. Turbo Delphi Professional is recognized as BDS 2006, you
+have to download its command line compiler from CodeGear website at
+http://www.codegear.com/Default.aspx?tabid=160 to install the full JCL on this
+tool.
+
+To install the JCL targetting Turbo Delphi Explorer, consider the following
+checks:
+
+ - If you have an other supported version of Delphi/C++Builder on this computer,
+ it should automatically be detected and the installer will process as usual.
+ - If you only have Turbo Delphi Explorer (and no other tools) on the computer,
+ the installer cannot becompiled. You have to use the Turbo Explorer flavor of
+ the JCL that contains a precompiled installer. However, you will not be able
+ to install any experts.
+
+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.codegear.com/). The item
+ (http://codecentral.codegear.com/Download.aspx?id=21333) contains the native
+ compiler to be installed in Delphi 8. The item
+ (http://codecentral.codegear.com/Download.aspx?id=21334) contains the native
+ compiler to be installed in C#Builder 1. These zip files have to be extracted
+ in the products directory 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
+
+Default installation
+
+For all others versions of Delphi, C++Builder and BDS, simply launch Install.bat
+and the installer window will let you configure options and install the library.
+
+--------------------------------------------------------------------------------
+
+Manual Installation
+Although it is not recommended, a manual installation is possible. You will have
+to manually configure options for the library. That is done by modifying an
+included file.
+
+For each tool you want to install the JCL in, repeat the following steps:
+
+1. Open and edit included file to customize options:
+ - For Kylix 3 (Delphi): source\include\jclkd3.inc
+ - For Kylix 3 (C++Builder): source\include\jclkc3.inc
+ - For C++Builder 5: source\include\jclc5.inc
+ - For C++Builder 6: source\include\jclc6.inc
+ - For Delphi 5: source\include\jcld5.inc
+ - For Delphi 6: source\include\jcld6.inc
+ - For Delphi 7: source\include\jcld7.inc
+ - For Delphi 2005: source\include\jcld9.inc
+ - For Delphi.net 2005: source\include\jcld9.net.inc
+ - For BDS 2006 (Delphi and C++Builder): source\include\jcld10.inc
+ - For Delphi.net 2006: source\include\jcld10.net.inc
+ - For CodeGear Delphi 2007 for Win32 and C++Builder 2007: source\include\jcld11.inc
+ - For Delphi.net 2007: source\include\jcld11.net.inc
+ - For Delphi 2009 and C++Builder 2009: source\include\include\jcld12.inc
+
+2. In the IDE, open and compile package Jcl.dpk (or Jcl.bpk for C++Builder)
+located in a subdirectory of the "packages" directory matching your version of
+the IDE. This package doesn't have to be installed since it doesn't provide any
+components.
+
+3. If you want to install experts, open package JclBaseExpert.dpk and compile
+it, then you can install all the experts you want (packages are located in the
+same directory).
+
+--------------------------------------------------------------------------------
+
+Distribution content
+Install.bat - Compile and run VCL version of the 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
+docs\Readme.html - This file
+docs\Experts.html - Readme file about the experts
+docs\MPL-1.1.txt - The Mozilla Public Licence (MPL) version 1.1
+docs\MPL FAQ.html - Frequently Asked Questions about the MPL
+docs\cps.html - Cross Platform Strategy
+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\repository - Repository expert
+experts\useswizard - JCL uses wizard
+experts\versioncontrol - Integration of TortoiseCVS and TortoiseSVN in the IDE
+examples - JCL example applications
+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 (distributed in a separate archive)
+install - Installer source code
+packages - JCL package sources
+source - JCL source code
+
+--------------------------------------------------------------------------------
+
+Giving your 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://tech.groups.yahoo.com/group/JEDI-JCL/You can also use
+ this list to voice your opinion, comments or suggestions.
+
+--------------------------------------------------------------------------------
+
+Reporting bugs
+
+The general rule is: If you want to get a bug fixed you need to log it!
+
+An issue tracking tool can be accessed via ('Code Library' category):
+http://homepages.codegear.com/jedi/issuetracker/
+
+Please be aware that you are allowed there to enter feature request and code
+donations as well.
+
+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
+
+--------------------------------------------------------------------------------
+
+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 Subversion repository updated every day in the
+JCL daily page http://jcl.sourceforge.net/daily/
+
+To always have access to the most recent changes in the JCL, you should install
+a Subversion client (we recommend TortoiseSVN http://tortoisesvn.tigris.org/and
+RapidSVN http://rapidsvn.tigris.org/) and download the SVN repository files to
+your computer as explained in the repository page of the JEDI Wiki at
+http://homepages.codegear.com/jedi/wiki/index.php?title=Repository With the SVN
+client, you can update your local repository at any time. You can also view the
+repository online via the web interface at http://jcl.svn.sourceforge.net/
+
+--------------------------------------------------------------------------------
+
+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.codegear.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 Subversion
+repository if the fi is satisfactory. If you report and fix a lot of bugs, you
+might even get developer access to SVN so you can update the JCL files directly.
+
diff --git a/official/1.104/docs/ThreadSafe.txt b/official/1.104/docs/ThreadSafe.txt
new file mode 100644
index 0000000..2e7359f
--- /dev/null
+++ b/official/1.104/docs/ThreadSafe.txt
@@ -0,0 +1,28 @@
+------------------------------------------------------------------------------
+JEDI Code Library
+HomePage: http://jcl.sourceforge.net/
+------------------------------------------------------------------------------
+
+Thread safe support
+
+Some pieces of code can handle read/write accesses from multiples threads
+without writing specific code.
+This support can be enabled:
+- by defining the THREADSAFE compiler symbol {$DEFINE THREADSAFE} when JCL
+ units are part of a project.
+- by checking the Enable thread safe code node in the installer options
+
+Presently only the following units have some pieces of code that implicitly
+handles thread safe accesses:
+source\common\JclAbstractContainers.pas
+source\common\JclArrayLists.pas
+source\common\JclArraySets.pas
+source\common\JclBinaryTrees.pas
+source\common\JclHashMaps.pas
+source\common\JclLinkedLists.pas
+source\common\JclQueues.pas
+source\common\JclStacks.pas
+
+This support is made using critical sections, if you want other piece of code
+to be thread safe, please create a feature request in the Code Library category
+of the mantiss at http://homepages.borland.com/jedi/issuetracker/
diff --git a/official/1.104/docs/cps.html b/official/1.104/docs/cps.html
new file mode 100644
index 0000000..ecdcf7d
--- /dev/null
+++ b/official/1.104/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:
+
+
+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
+
+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
+
+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
+
+
+
+
+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/
+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.
+
+
+
+
+
+
+
+ Name Delphi
+(Windows) Kylix
+for Delphi Delphi.NET Free
+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
+ + -
+ -
+ ?
+
+
+ JclTask
+ platform
+ -
+ -
+ ?
+
+
+ JclSysUtils
+ + (+)
+ -
+ ?
+
+
+ JclSysInfo
+ + (+)
+ -
+ ?
+
+
+ JclTD32
+ + -
+ -
+ ?
+
+
+ JclUnicode
+ + -
+ -
+ ?
+
+
+ JclUnitConv
+ + + -
+ ?
+
+
+ JclWin32
+ platform
+ -
+ -
+ ?
+
+
+ JclWinMidi
+ platform
+ -
+ -
+ ?
+
+
+
+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}
+Packages
+
+
diff --git a/official/1.104/docs/cps_files/strucv1.jpg b/official/1.104/docs/cps_files/strucv1.jpg
new file mode 100644
index 0000000..4c2fddc
Binary files /dev/null and b/official/1.104/docs/cps_files/strucv1.jpg differ
diff --git a/official/1.104/docs/cps_files/test.css b/official/1.104/docs/cps_files/test.css
new file mode 100644
index 0000000..435698a
--- /dev/null
+++ b/official/1.104/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.104/docs/styles/default.css b/official/1.104/docs/styles/default.css
new file mode 100644
index 0000000..feabecf
--- /dev/null
+++ b/official/1.104/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.104/examples/C10.exc b/official/1.104/examples/C10.exc
new file mode 100644
index 0000000..74c5bb0
--- /dev/null
+++ b/official/1.104/examples/C10.exc
@@ -0,0 +1 @@
+ExtraRequirements.exc
diff --git a/official/1.104/examples/C5.exc b/official/1.104/examples/C5.exc
new file mode 100644
index 0000000..74c5bb0
--- /dev/null
+++ b/official/1.104/examples/C5.exc
@@ -0,0 +1 @@
+ExtraRequirements.exc
diff --git a/official/1.104/examples/C6.exc b/official/1.104/examples/C6.exc
new file mode 100644
index 0000000..74c5bb0
--- /dev/null
+++ b/official/1.104/examples/C6.exc
@@ -0,0 +1 @@
+ExtraRequirements.exc
diff --git a/official/1.104/examples/D10.exc b/official/1.104/examples/D10.exc
new file mode 100644
index 0000000..74c5bb0
--- /dev/null
+++ b/official/1.104/examples/D10.exc
@@ -0,0 +1 @@
+ExtraRequirements.exc
diff --git a/official/1.104/examples/D11.exc b/official/1.104/examples/D11.exc
new file mode 100644
index 0000000..74c5bb0
--- /dev/null
+++ b/official/1.104/examples/D11.exc
@@ -0,0 +1 @@
+ExtraRequirements.exc
diff --git a/official/1.104/examples/D5.exc b/official/1.104/examples/D5.exc
new file mode 100644
index 0000000..74c5bb0
--- /dev/null
+++ b/official/1.104/examples/D5.exc
@@ -0,0 +1 @@
+ExtraRequirements.exc
diff --git a/official/1.104/examples/D6.exc b/official/1.104/examples/D6.exc
new file mode 100644
index 0000000..74c5bb0
--- /dev/null
+++ b/official/1.104/examples/D6.exc
@@ -0,0 +1 @@
+ExtraRequirements.exc
diff --git a/official/1.104/examples/D7.exc b/official/1.104/examples/D7.exc
new file mode 100644
index 0000000..74c5bb0
--- /dev/null
+++ b/official/1.104/examples/D7.exc
@@ -0,0 +1 @@
+ExtraRequirements.exc
diff --git a/official/1.104/examples/D9.exc b/official/1.104/examples/D9.exc
new file mode 100644
index 0000000..74c5bb0
--- /dev/null
+++ b/official/1.104/examples/D9.exc
@@ -0,0 +1 @@
+ExtraRequirements.exc
diff --git a/official/1.104/examples/ExtraRequirements.exc b/official/1.104/examples/ExtraRequirements.exc
new file mode 100644
index 0000000..c903f3e
--- /dev/null
+++ b/official/1.104/examples/ExtraRequirements.exc
@@ -0,0 +1,5 @@
+common\multimedia\MidiOutExample.dpr=spin.dcu
+common\numformat\NumFormatExample.dpr=spin.dcu
+windows\debug\sourceloc\SourceLocExample.dpr=spin.dcu
+windows\delphitools\peviewer\PeViewer.dpr=spin.dcu
+windows\tasks\TaskDemo.dpr=MsHtml.dcu
diff --git a/official/1.104/examples/JclDebugExamples.bdsgroup b/official/1.104/examples/JclDebugExamples.bdsgroup
new file mode 100644
index 0000000..c5489e2
--- /dev/null
+++ b/official/1.104/examples/JclDebugExamples.bdsgroup
@@ -0,0 +1,23 @@
+
+
+
+
+ Default.Personality
+ 1.0
+ {DA6232CE-74D4-4FD2-95D5-44C5C155C336}
+
+
+
+
+
+ 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.104/examples/JclDebugExamples.bpg b/official/1.104/examples/JclDebugExamples.bpg
new file mode 100644
index 0000000..fbf9f71
--- /dev/null
+++ b/official/1.104/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.104/examples/common/containers/algorithms/AlgorithmsExample.dof b/official/1.104/examples/common/containers/algorithms/AlgorithmsExample.dof
new file mode 100644
index 0000000..c22fe7f
--- /dev/null
+++ b/official/1.104/examples/common/containers/algorithms/AlgorithmsExample.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=..\..\..\..\bin
diff --git a/official/1.104/examples/common/containers/algorithms/AlgorithmsExample.dpr b/official/1.104/examples/common/containers/algorithms/AlgorithmsExample.dpr
new file mode 100644
index 0000000..6777a41
--- /dev/null
+++ b/official/1.104/examples/common/containers/algorithms/AlgorithmsExample.dpr
@@ -0,0 +1,21 @@
+program AlgorithmsExample;
+
+{$I jcl.inc}
+
+uses
+ {$IFDEF MSWINDOWS}
+ Forms,
+ {$ENDIF MSWINDOWS}
+ {$IFDEF LINUX}
+ QForms,
+ {$ENDIF LINUX}
+ AlgorithmsExampleMain in 'AlgorithmsExampleMain.pas' {MainForm};
+
+{$R *.res}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/containers/algorithms/AlgorithmsExample.res b/official/1.104/examples/common/containers/algorithms/AlgorithmsExample.res
new file mode 100644
index 0000000..b111060
Binary files /dev/null and b/official/1.104/examples/common/containers/algorithms/AlgorithmsExample.res differ
diff --git a/official/1.104/examples/common/containers/algorithms/AlgorithmsExampleMain.dfm b/official/1.104/examples/common/containers/algorithms/AlgorithmsExampleMain.dfm
new file mode 100644
index 0000000..9647041
--- /dev/null
+++ b/official/1.104/examples/common/containers/algorithms/AlgorithmsExampleMain.dfm
@@ -0,0 +1,250 @@
+object MainForm: TMainForm
+ Left = 280
+ Top = 180
+ ClientWidth = 384
+ ClientHeight = 304
+ 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
+ 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.104/examples/common/containers/algorithms/AlgorithmsExampleMain.pas b/official/1.104/examples/common/containers/algorithms/AlgorithmsExampleMain.pas
new file mode 100644
index 0000000..6c0becf
--- /dev/null
+++ b/official/1.104/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.104/examples/common/containers/hashing/HashingExample.dof b/official/1.104/examples/common/containers/hashing/HashingExample.dof
new file mode 100644
index 0000000..aaf85f5
--- /dev/null
+++ b/official/1.104/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.104/examples/common/containers/hashing/HashingExample.dpr b/official/1.104/examples/common/containers/hashing/HashingExample.dpr
new file mode 100644
index 0000000..7f67ae6
--- /dev/null
+++ b/official/1.104/examples/common/containers/hashing/HashingExample.dpr
@@ -0,0 +1,21 @@
+program HashingExample;
+
+{$I jcl.inc}
+
+uses
+ {$IFDEF MSWINDOWS}
+ Forms,
+ {$ENDIF MSWINDOWS}
+ {$IFDEF LINUX}
+ QForms,
+ {$ENDIF LINUX}
+ HashingExampleMain in 'HashingExampleMain.pas' {MainForm};
+
+{$R *.res}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/containers/hashing/HashingExample.res b/official/1.104/examples/common/containers/hashing/HashingExample.res
new file mode 100644
index 0000000..b111060
Binary files /dev/null and b/official/1.104/examples/common/containers/hashing/HashingExample.res differ
diff --git a/official/1.104/examples/common/containers/hashing/HashingExampleMain.dfm b/official/1.104/examples/common/containers/hashing/HashingExampleMain.dfm
new file mode 100644
index 0000000..bdaaebb
--- /dev/null
+++ b/official/1.104/examples/common/containers/hashing/HashingExampleMain.dfm
@@ -0,0 +1,173 @@
+object MainForm: TMainForm
+ Left = 281
+ Top = 201
+ Width = 513
+ Height = 280
+ HorzScrollBar.Range = 476
+ VertScrollBar.Range = 209
+ ActiveControl = btnIntfIntfHashMap
+ 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
+ PixelsPerInch = 96
+ TextHeight = 13
+ object btnIntfIntfHashMap: TButton
+ Left = 8
+ Top = 8
+ Width = 89
+ Height = 25
+ Caption = 'IntfIntfHashMap'
+ TabOrder = 0
+ OnClick = btnIntfIntfHashMapClick
+ end
+ object btnIntfHashSet: TButton
+ Left = 103
+ Top = 8
+ Width = 89
+ Height = 25
+ Caption = 'IntfHashSet'
+ TabOrder = 5
+ OnClick = btnIntfHashSetClick
+ end
+ object btnHashMap: TButton
+ Left = 8
+ Top = 220
+ Width = 89
+ Height = 25
+ Caption = 'HashMap'
+ TabOrder = 4
+ OnClick = btnHashMapClick
+ end
+ object btnHashSet: TButton
+ Left = 103
+ Top = 220
+ Width = 89
+ Height = 25
+ Caption = 'HashSet'
+ TabOrder = 7
+ OnClick = btnHashSetClick
+ end
+ object btnAnsiStrIntfHashMap: TButton
+ Left = 8
+ Top = 47
+ Width = 138
+ Height = 25
+ Caption = 'AnsiStrIntfHashMap'
+ TabOrder = 1
+ OnClick = btnAnsiStrIntfHashMapClick
+ end
+ object btnIntfArraySet: TButton
+ Left = 198
+ Top = 8
+ Width = 89
+ Height = 25
+ Caption = 'IntfArraySet'
+ TabOrder = 8
+ OnClick = btnIntfArraySetClick
+ end
+ object btnArraySet: TButton
+ Left = 198
+ Top = 220
+ Width = 89
+ Height = 25
+ Caption = 'ArraySet'
+ TabOrder = 10
+ OnClick = btnArraySetClick
+ end
+ object btnAnsiStrAnsiStrHashMap: TButton
+ Left = 8
+ Top = 78
+ Width = 138
+ Height = 25
+ Caption = 'AnsiStrAnsiStrHashMap'
+ TabOrder = 2
+ OnClick = btnAnsiStrAnsiStrHashMapClick
+ end
+ object btnAnsiStrHashMap: TButton
+ Left = 8
+ Top = 171
+ Width = 138
+ Height = 25
+ Caption = 'AnsiStrHashMap'
+ TabOrder = 3
+ OnClick = btnAnsiStrHashMapClick
+ end
+ object btnAnsiStrHashSet: TButton
+ Left = 8
+ Top = 109
+ Width = 138
+ Height = 25
+ Caption = 'AnsiStrHashSet'
+ TabOrder = 6
+ OnClick = btnAnsiStrHashSetClick
+ end
+ object btnAnsiStrArraySet: TButton
+ Left = 8
+ Top = 140
+ Width = 138
+ Height = 25
+ Caption = 'AnsiStrArraySet'
+ TabOrder = 9
+ OnClick = btnAnsiStrArraySetClick
+ end
+ object memResult: TListBox
+ Left = 304
+ Top = 0
+ Width = 185
+ Height = 248
+ Anchors = [akTop, akRight, akBottom]
+ ItemHeight = 13
+ TabOrder = 11
+ end
+ object btnWideStrIntfHashMap: TButton
+ Left = 152
+ Top = 47
+ Width = 135
+ Height = 25
+ Caption = 'WideStrIntfHashMap'
+ TabOrder = 12
+ OnClick = btnWideStrIntfHashMapClick
+ end
+ object btnWideStrWideStrHashMap: TButton
+ Left = 152
+ Top = 78
+ Width = 135
+ Height = 25
+ Caption = 'WideStrWideStrHashMap'
+ TabOrder = 13
+ OnClick = btnWideStrWideStrHashMapClick
+ end
+ object btnWideStrHashSet: TButton
+ Left = 152
+ Top = 109
+ Width = 135
+ Height = 25
+ Caption = 'WideStrHashSet'
+ TabOrder = 14
+ OnClick = btnWideStrHashSetClick
+ end
+ object btnWideStrArraySet: TButton
+ Left = 152
+ Top = 140
+ Width = 135
+ Height = 25
+ Caption = 'WideStrArraySet'
+ TabOrder = 15
+ OnClick = btnWideStrArraySetClick
+ end
+ object btnWideStrHashMap: TButton
+ Left = 152
+ Top = 171
+ Width = 135
+ Height = 25
+ Caption = 'AnsiStrHashMap'
+ TabOrder = 16
+ OnClick = btnWideStrHashMapClick
+ end
+end
diff --git a/official/1.104/examples/common/containers/hashing/HashingExampleMain.pas b/official/1.104/examples/common/containers/hashing/HashingExampleMain.pas
new file mode 100644
index 0000000..403b1b0
--- /dev/null
+++ b/official/1.104/examples/common/containers/hashing/HashingExampleMain.pas
@@ -0,0 +1,442 @@
+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;
+ btnAnsiStrIntfHashMap: TButton;
+ btnIntfArraySet: TButton;
+ btnArraySet: TButton;
+ btnAnsiStrAnsiStrHashMap: TButton;
+ btnAnsiStrHashMap: TButton;
+ btnAnsiStrHashSet: TButton;
+ btnAnsiStrArraySet: TButton;
+ memResult: TListBox;
+ btnWideStrIntfHashMap: TButton;
+ btnWideStrWideStrHashMap: TButton;
+ btnWideStrHashSet: TButton;
+ btnWideStrArraySet: TButton;
+ btnWideStrHashMap: TButton;
+ procedure btnIntfIntfHashMapClick(Sender: TObject);
+ procedure btnAnsiStrIntfHashMapClick(Sender: TObject);
+ procedure btnWideStrIntfHashMapClick(Sender: TObject);
+ procedure btnHashMapClick(Sender: TObject);
+ procedure btnIntfHashSetClick(Sender: TObject);
+ procedure btnHashSetClick(Sender: TObject);
+ procedure btnIntfArraySetClick(Sender: TObject);
+ procedure btnArraySetClick(Sender: TObject);
+ procedure btnAnsiStrAnsiStrHashMapClick(Sender: TObject);
+ procedure btnWideStrWideStrHashMapClick(Sender: TObject);
+ procedure btnAnsiStrHashMapClick(Sender: TObject);
+ procedure btnWideStrHashMapClick(Sender: TObject);
+ procedure btnAnsiStrHashSetClick(Sender: TObject);
+ procedure btnWideStrHashSetClick(Sender: TObject);
+ procedure btnAnsiStrArraySetClick(Sender: TObject);
+ procedure btnWideStrArraySetClick(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(DefaultContainerCapacity);
+ 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.btnAnsiStrIntfHashMapClick(Sender: TObject);
+var
+ Map: IJclAnsiStrIntfMap;
+ MyObject: IIntfMyObject;
+begin
+ Map := TJclAnsiStrIntfHashMap.Create(DefaultContainerCapacity);
+ 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.btnWideStrIntfHashMapClick(Sender: TObject);
+var
+ Map: IJclWideStrIntfMap;
+ MyObject: IIntfMyObject;
+begin
+ Map := TJclWideStrIntfHashMap.Create(DefaultContainerCapacity);
+ 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(DefaultContainerCapacity, False, False);
+ 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;
+ KeyObject.Free;
+ end;
+end;
+
+procedure TMainForm.btnIntfHashSetClick(Sender: TObject);
+var
+ MySet: IJclIntfSet;
+ MyObject: IIntfMyObject;
+ It: IJclIntfIterator;
+begin
+ MySet := TJclIntfHashSet.Create(DefaultContainerCapacity);
+ 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(DefaultContainerCapacity, False);
+ 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(DefaultContainerCapacity);
+ 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(DefaultContainerCapacity, False);
+ MyObject := TMyObject.Create;
+ try
+ 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('--------------------------------------------------------');
+ finally
+ MyObject.Free;
+ end;
+end;
+
+procedure TMainForm.btnAnsiStrAnsiStrHashMapClick(Sender: TObject);
+var
+ Map: IJclAnsiStrAnsiStrMap;
+ It: IJclAnsiStrIterator;
+begin
+ Map := TJclAnsiStrAnsiStrHashMap.Create(DefaultContainerCapacity);
+ Map.PutValue('MyKey1', 'MyString1');
+ Map.PutValue('MyKey2', 'MyString2');
+ Map.PutValue('MyKey3', 'MyString3');
+ It := Map.KeySet.First;
+ while It.HasNext do
+ memResult.Items.Add(string(It.Next));
+ It := Map.Values.First;
+ while It.HasNext do
+ memResult.Items.Add(string(It.Next));
+ Map.PutValue('MyKey2', 'AnotherString2');
+ memResult.Items.Add(string(Map.GetValue('MyKey2')));
+ memResult.Items.Add('--------------------------------------------------------');
+end;
+
+procedure TMainForm.btnWideStrWideStrHashMapClick(Sender: TObject);
+var
+ Map: IJclWideStrWideStrMap;
+ It: IJclWideStrIterator;
+begin
+ Map := TJclWideStrWideStrHashMap.Create(DefaultContainerCapacity);
+ 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;
+
+procedure TMainForm.btnAnsiStrHashMapClick(Sender: TObject);
+var
+ Map: IJclAnsiStrMap;
+ MyObject: TMyObject;
+ It: IJclAnsiStrIterator;
+begin
+ Map := TJclAnsiStrHashMap.Create(DefaultContainerCapacity, False);
+ MyObject := TMyObject.Create;
+ try
+ 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(string(It.Next));
+ memResult.Items.Add('--------------------------------------------------------');
+ finally
+ MyObject.Free;
+ end;
+end;
+
+procedure TMainForm.btnWideStrHashMapClick(Sender: TObject);
+var
+ Map: IJclWideStrMap;
+ MyObject: TMyObject;
+ It: IJclWideStrIterator;
+begin
+ Map := TJclWideStrHashMap.Create(DefaultContainerCapacity, False);
+ MyObject := TMyObject.Create;
+ try
+ 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('--------------------------------------------------------');
+ finally
+ MyObject.Free;
+ end;
+end;
+
+procedure TMainForm.btnAnsiStrHashSetClick(Sender: TObject);
+var
+ MySet: IJclAnsiStrSet;
+ It: IJclAnsiStrIterator;
+begin
+ MySet := TJclAnsiStrHashSet.Create(DefaultContainerCapacity);
+ MySet.Add('MyString');
+ MySet.Add('MyString');
+ It := MySet.First;
+ while It.HasNext do
+ memResult.Items.Add(string(It.Next));
+ memResult.Items.Add(IntToStr(MySet.Size));
+ memResult.Items.Add('--------------------------------------------------------');
+end;
+
+procedure TMainForm.btnWideStrHashSetClick(Sender: TObject);
+var
+ MySet: IJclWideStrSet;
+ It: IJclWideStrIterator;
+begin
+ MySet := TJclWideStrHashSet.Create(DefaultContainerCapacity);
+ 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.btnAnsiStrArraySetClick(Sender: TObject);
+var
+ MySet: IJclAnsiStrSet;
+ It: IJclAnsiStrIterator;
+ I: Integer;
+begin
+ MySet := TJclAnsiStrArraySet.Create(DefaultContainerCapacity);
+ for I := 1 to 8 do
+ MySet.Add(AnsiString(IntToStr(I)));
+ for I := 8 downto 1 do
+ MySet.Add(AnsiString(IntToStr(I)));
+ MySet.Add('MyString');
+ MySet.Add('MyString');
+ It := MySet.First;
+ while It.HasNext do
+ memResult.Items.Add(string(It.Next));
+ memResult.Items.Add(IntToStr(MySet.Size));
+ memResult.Items.Add('--------------------------------------------------------');
+end;
+
+procedure TMainForm.btnWideStrArraySetClick(Sender: TObject);
+var
+ MySet: IJclWideStrSet;
+ It: IJclWideStrIterator;
+ I: Integer;
+begin
+ MySet := TJclWideStrArraySet.Create(DefaultContainerCapacity);
+ 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.104/examples/common/containers/lists/ListExample.dof b/official/1.104/examples/common/containers/lists/ListExample.dof
new file mode 100644
index 0000000..aaf85f5
--- /dev/null
+++ b/official/1.104/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.104/examples/common/containers/lists/ListExample.dpr b/official/1.104/examples/common/containers/lists/ListExample.dpr
new file mode 100644
index 0000000..193f3ef
--- /dev/null
+++ b/official/1.104/examples/common/containers/lists/ListExample.dpr
@@ -0,0 +1,22 @@
+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}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/containers/lists/ListExample.res b/official/1.104/examples/common/containers/lists/ListExample.res
new file mode 100644
index 0000000..b111060
Binary files /dev/null and b/official/1.104/examples/common/containers/lists/ListExample.res differ
diff --git a/official/1.104/examples/common/containers/lists/ListExampleMain.dfm b/official/1.104/examples/common/containers/lists/ListExampleMain.dfm
new file mode 100644
index 0000000..abcb40b
--- /dev/null
+++ b/official/1.104/examples/common/containers/lists/ListExampleMain.dfm
@@ -0,0 +1,145 @@
+object MainForm: TMainForm
+ Left = 276
+ Top = 195
+ Width = 564
+ Height = 277
+ HorzScrollBar.Range = 508
+ VertScrollBar.Range = 217
+ ActiveControl = btnIntfArrayList
+ 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
+ PixelsPerInch = 96
+ TextHeight = 13
+ object btnIntfArrayList: TButton
+ Left = 24
+ Top = 24
+ Width = 89
+ Height = 25
+ Caption = 'IntfArrayList'
+ TabOrder = 0
+ OnClick = btnIntfArrayListClick
+ end
+ object btnIntfLinkedList: TButton
+ Left = 152
+ Top = 24
+ Width = 89
+ Height = 25
+ Caption = 'IntfLinkedList'
+ TabOrder = 3
+ OnClick = btnIntfLinkedListClick
+ end
+ object btnIntfVector: TButton
+ Left = 272
+ Top = 24
+ Width = 89
+ Height = 25
+ Caption = 'IntfVector'
+ TabOrder = 6
+ OnClick = btnIntfVectorClick
+ end
+ object btnArrayList: TButton
+ Left = 24
+ Top = 168
+ Width = 89
+ Height = 25
+ Caption = 'ArrayList'
+ TabOrder = 2
+ OnClick = btnArrayListClick
+ end
+ object btnLinkedList: TButton
+ Left = 152
+ Top = 168
+ Width = 89
+ Height = 25
+ Caption = 'LinkedList'
+ TabOrder = 5
+ OnClick = btnLinkedListClick
+ end
+ object btnVector: TButton
+ Left = 272
+ Top = 168
+ Width = 89
+ Height = 25
+ Caption = 'Vector'
+ TabOrder = 8
+ OnClick = btnVectorClick
+ end
+ object memResult: TMemo
+ Left = 395
+ Top = 0
+ Width = 161
+ Height = 243
+ Align = alRight
+ TabOrder = 10
+ end
+ object btnMyObjectList: TButton
+ Left = 152
+ Top = 216
+ Width = 89
+ Height = 25
+ Caption = 'MyObjectList'
+ TabOrder = 9
+ OnClick = btnMyObjectListClick
+ end
+ object btnAnsiStrArrayList: TButton
+ Left = 24
+ Top = 72
+ Width = 89
+ Height = 25
+ Caption = 'AnsiStrArrayList'
+ TabOrder = 1
+ OnClick = btnAnsiStrArrayListClick
+ end
+ object btnAnsiStrLinkedList: TButton
+ Left = 152
+ Top = 72
+ Width = 89
+ Height = 25
+ Caption = 'AnsiStrLinkedList'
+ TabOrder = 4
+ OnClick = btnAnsiStrLinkedListClick
+ end
+ object btnAnsiStrVector: TButton
+ Left = 272
+ Top = 72
+ Width = 89
+ Height = 25
+ Caption = 'AnsiStrVector'
+ TabOrder = 7
+ OnClick = btnAnsiStrVectorClick
+ end
+ object btnWideStrArrayList: TButton
+ Left = 24
+ Top = 120
+ Width = 89
+ Height = 25
+ Caption = 'WideStrArrayList'
+ TabOrder = 11
+ OnClick = btnWideStrArrayListClick
+ end
+ object btnWideStrLinkedList: TButton
+ Left = 152
+ Top = 120
+ Width = 89
+ Height = 25
+ Caption = 'WideStrLinkedList'
+ TabOrder = 12
+ OnClick = btnWideStrLinkedListClick
+ end
+ object btnWideStrVector: TButton
+ Left = 272
+ Top = 120
+ Width = 89
+ Height = 25
+ Caption = 'WideStrVector'
+ TabOrder = 13
+ OnClick = btnWideStrVectorClick
+ end
+end
diff --git a/official/1.104/examples/common/containers/lists/ListExampleMain.pas b/official/1.104/examples/common/containers/lists/ListExampleMain.pas
new file mode 100644
index 0000000..0eeb303
--- /dev/null
+++ b/official/1.104/examples/common/containers/lists/ListExampleMain.pas
@@ -0,0 +1,575 @@
+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;
+ btnAnsiStrArrayList: TButton;
+ btnAnsiStrLinkedList: TButton;
+ btnAnsiStrVector: TButton;
+ btnWideStrArrayList: TButton;
+ btnWideStrLinkedList: TButton;
+ btnWideStrVector: 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 btnAnsiStrArrayListClick(Sender: TObject);
+ procedure btnWideStrArrayListClick(Sender: TObject);
+ procedure btnAnsiStrLinkedListClick(Sender: TObject);
+ procedure btnWideStrLinkedListClick(Sender: TObject);
+ procedure btnAnsiStrVectorClick(Sender: TObject);
+ procedure btnWideStrVectorClick(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(DefaultContainerCapacity);
+ 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(nil);
+ 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: IJclIntfList;
+ MyObject: IIntfMyObject;
+ It: IJclIntfIterator;
+ I: Integer;
+begin
+ memResult.Lines.Clear;
+ List := TJclIntfVector.Create(DefaultContainerCapacity);
+ 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.Objects[I]);
+ memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str);
+ end;
+ List.Clear;
+ finally
+ It := nil; // Force release Iterator before free list !
+ end;
+end;
+
+procedure TMainForm.btnArrayListClick(Sender: TObject);
+var
+ List: IJclList;
+ MyObject: TMyObject;
+ It: IJclIterator;
+begin
+ memResult.Lines.Clear;
+ List := TJclArrayList.Create(DefaultContainerCapacity, True);
+ 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
+ begin
+ It.Next;
+ It.Remove;
+ end;
+end;
+
+procedure TMainForm.btnLinkedListClick(Sender: TObject);
+var
+ List: IJclList;
+ MyObject: TMyObject;
+ It: IJclIterator;
+begin
+ memResult.Lines.Clear;
+ List := TJclLinkedList.Create(nil, True);
+ 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: IJclList;
+ MyObject: TMyObject;
+ It: IJclIterator;
+ I: Integer;
+begin
+ memResult.Lines.Clear;
+ List := TJclVector.Create(DefaultContainerCapacity, True);
+ 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.Objects[I]);
+ memResult.Lines.Add(IntToStr(MyObject.Int) + ' ' + MyObject.Str);
+ end;
+ List.Clear;
+ finally
+ It := nil; // Force release Iterator before free list !
+ List := nil;
+ end;
+end;
+
+procedure TMainForm.btnMyObjectListClick(Sender: TObject);
+var
+ List: IMyObjectList;
+ MyObject: TMyObject;
+begin
+ memResult.Lines.Clear;
+ List := TMyObjectList.Create(DefaultContainerCapacity, True);
+ 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.btnAnsiStrArrayListClick(Sender: TObject);
+var
+ List, Sub: IJclAnsiStrList;
+ MyArray: IJclAnsiStrArray;
+ It: IJclAnsiStrIterator;
+ I: Integer;
+ S: string;
+begin
+ memResult.Lines.Clear;
+ List := TJclAnsiStrArrayList.Create(DefaultContainerCapacity);
+ List.Add('MyString');
+
+ S := string(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 := string(It.Next);
+ memResult.Lines.Add(S);
+ end;
+ // use [] default of Items[]
+ MyArray := List as IJclAnsiStrArray;
+ for I := 0 to MyArray.Size - 1 do
+ begin
+ S := string(MyArray[I]);
+ memResult.Lines.Add(S);
+ end;
+end;
+
+procedure TMainForm.btnWideStrArrayListClick(Sender: TObject);
+var
+ List, Sub: IJclWideStrList;
+ MyArray: IJclWideStrArray;
+ It: IJclWideStrIterator;
+ I: Integer;
+ S: string;
+begin
+ memResult.Lines.Clear;
+ List := TJclWideStrArrayList.Create(DefaultContainerCapacity);
+ 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 IJclWideStrArray;
+ 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.btnAnsiStrLinkedListClick(Sender: TObject);
+var
+ List, Sub: IJclAnsiStrList;
+ S: string;
+ It: IJclAnsiStrIterator;
+begin
+ memResult.Lines.Clear;
+ List := TJclAnsiStrLinkedList.Create(nil);
+ List.Add('MyString');
+ memResult.Lines.Add(string(List.GetString(0)));
+
+ List.Add('AnotherString');
+
+ Sub := List.SubList(1, 10);
+
+ It := Sub.First;
+ while It.HasNext do
+ begin
+ S := string(It.Next);
+ memResult.Lines.Add(S);
+ end;
+end;
+
+procedure TMainForm.btnWideStrLinkedListClick(Sender: TObject);
+var
+ List, Sub: IJclWideStrList;
+ S: string;
+ It: IJclWideStrIterator;
+begin
+ memResult.Lines.Clear;
+ List := TJclWideStrLinkedList.Create(nil);
+ 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.btnAnsiStrVectorClick(Sender: TObject);
+var
+ List: IJclAnsiStrList;
+ S: string;
+ It: IJclAnsiStrIterator;
+ I: Integer;
+begin
+ memResult.Lines.Clear;
+ List := TJclAnsiStrVector.Create(DefaultContainerCapacity);
+ try
+ List.Add('MyString');
+ S := string(List.GetString(0));
+ memResult.Lines.Add(S);
+
+ List.Add('AnotherString');
+
+ It := List.First;
+ while It.HasNext do
+ begin
+ S := string(It.Next);
+ memResult.Lines.Add(S);
+ end;
+ // Fastest way
+ for I := 0 to List.Size - 1 do
+ begin
+ S := string(List.Strings[I]);
+ memResult.Lines.Add(S);
+ end;
+ List.Clear;
+ finally
+ It := nil; // Force release Iterator before free list !
+ List := nil;
+ end;
+end;
+
+procedure TMainForm.btnWideStrVectorClick(Sender: TObject);
+var
+ List: IJclWideStrList;
+ S: string;
+ It: IJclWideStrIterator;
+ I: Integer;
+begin
+ memResult.Lines.Clear;
+ List := TJclWideStrVector.Create(DefaultContainerCapacity);
+ 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.Strings[I];
+ memResult.Lines.Add(S);
+ end;
+ List.Clear;
+ finally
+ It := nil; // Force release Iterator before free list !
+ List := nil;
+ end;
+end;
+
+end.
+
diff --git a/official/1.104/examples/common/containers/lists/MyObjectList.pas b/official/1.104/examples/common/containers/lists/MyObjectList.pas
new file mode 100644
index 0000000..d5b100c
--- /dev/null
+++ b/official/1.104/examples/common/containers/lists/MyObjectList.pas
@@ -0,0 +1,133 @@
+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(const ACollection: IJclCollection): Boolean; overload;
+ procedure Clear;
+ function Contains(AObject: TMyObject): Boolean;
+ function ContainsAll(const ACollection: IJclCollection): Boolean;
+ function Equals(const ACollection: IJclCollection): Boolean;
+ function First: IJclIterator;
+ function IsEmpty: Boolean;
+ function Last: IJclIterator;
+ function Remove(AObject: TMyObject): Boolean; overload;
+ function RemoveAll(const ACollection: IJclCollection): Boolean;
+ function RetainAll(const ACollection: IJclCollection): Boolean;
+ function Size: Integer;
+
+ procedure Add(Index: Integer; AObject: TMyObject); overload;
+ function AddAll(Index: Integer; const ACollection: IJclCollection): Boolean; overload;
+ function GetObject(Index: Integer): TMyObject;
+ function IndexOf(AObject: TMyObject): Integer;
+ function LastIndexOf(AObject: TMyObject): Integer;
+ function Delete(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(const ACollection: IJclCollection): Boolean; overload;
+ procedure IMyObjectList.Clear = Clear;
+ function Contains(AObject: TMyObject): Boolean;
+ function IMyObjectList.ContainsAll = ContainsAll;
+ function IMyObjectList.Equals = CollectionEquals;
+ 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; const ACollection: IJclCollection): Boolean; overload;
+ function GetObject(Index: Integer): TMyObject;
+ function IndexOf(AObject: TMyObject): Integer;
+ function LastIndexOf(AObject: TMyObject): Integer;
+ function Delete(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(const ACollection: IJclCollection): Boolean;
+begin
+ Result := inherited AddAll(ACollection);
+end;
+
+function TMyObjectList.AddAll(Index: Integer; const 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.Delete(Index: Integer): TMyObject;
+begin
+ Result := TMyObject(inherited Delete(Index));
+end;
+
+procedure TMyObjectList.SetObject(Index: Integer; AObject: TMyObject);
+begin
+ inherited SetObject(Index, AObject);
+end;
+
+end.
+
diff --git a/official/1.104/examples/common/containers/performance/ContainerPerformance.dof b/official/1.104/examples/common/containers/performance/ContainerPerformance.dof
new file mode 100644
index 0000000..e957ac9
--- /dev/null
+++ b/official/1.104/examples/common/containers/performance/ContainerPerformance.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\..\bin
+
diff --git a/official/1.104/examples/common/containers/performance/ContainerPerformance.dpr b/official/1.104/examples/common/containers/performance/ContainerPerformance.dpr
new file mode 100644
index 0000000..a8f537f
--- /dev/null
+++ b/official/1.104/examples/common/containers/performance/ContainerPerformance.dpr
@@ -0,0 +1,22 @@
+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}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/containers/performance/ContainerPerformance.res b/official/1.104/examples/common/containers/performance/ContainerPerformance.res
new file mode 100644
index 0000000..b111060
Binary files /dev/null and b/official/1.104/examples/common/containers/performance/ContainerPerformance.res differ
diff --git a/official/1.104/examples/common/containers/performance/ContainerPerformanceMain.dfm b/official/1.104/examples/common/containers/performance/ContainerPerformanceMain.dfm
new file mode 100644
index 0000000..513ed6a
--- /dev/null
+++ b/official/1.104/examples/common/containers/performance/ContainerPerformanceMain.dfm
@@ -0,0 +1,101 @@
+object MainForm: TMainForm
+ Left = 402
+ Top = 120
+ 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
+ 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
+ ColCount = 6
+ DefaultColWidth = 90
+ 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 mnJclAnsiStrAnsiStrHashMap: TMenuItem
+ Caption = 'TJclAnsiStrAnsiStrHashMap'
+ OnClick = mnJclAnsiStrAnsiStrHashMapClick
+ end
+ object mnJclWideStrWideStrHashMap: TMenuItem
+ Caption = 'TJclWideStrWideStrHashMap'
+ OnClick = mnJclWideStrWideStrHashMapClick
+ end
+ object N2: TMenuItem
+ Caption = '-'
+ end
+ object mnAllTest: TMenuItem
+ Caption = 'All'
+ OnClick = mnAllTestClick
+ end
+ end
+ end
+end
diff --git a/official/1.104/examples/common/containers/performance/ContainerPerformanceMain.pas b/official/1.104/examples/common/containers/performance/ContainerPerformanceMain.pas
new file mode 100644
index 0000000..295e296
--- /dev/null
+++ b/official/1.104/examples/common/containers/performance/ContainerPerformanceMain.pas
@@ -0,0 +1,158 @@
+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;
+ mnJclAnsiStrAnsiStrHashMap: TMenuItem;
+ N2: TMenuItem;
+ mnAllTest: TMenuItem;
+ HashPerformanceGrid: TStringGrid;
+ mnJclWideStrWideStrHashMap: TMenuItem;
+ 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 mnJclAnsiStrAnsiStrHashMapClick(Sender: TObject);
+ procedure mnJclWideStrWideStrHashMapClick(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] := 'TJclAnsiStrAnsiStrHashMap';
+ HashPerformanceGrid.Cells[5, 0] := 'TJclWideStrWideStrHashMap';
+ 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;
+ TestJclAnsiStrAnsiStrHashMap(HashPerformanceGrid.Cols[4]);
+ Application.ProcessMessages;
+ TestJclWideStrWideStrHashMap(HashPerformanceGrid.Cols[5]);
+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.mnJclAnsiStrAnsiStrHashMapClick(Sender: TObject);
+begin
+ TestJclAnsiStrAnsiStrHashMap(HashPerformanceGrid.Cols[4]);
+end;
+
+procedure TMainForm.mnJclWideStrWideStrHashMapClick(Sender: TObject);
+begin
+ TestJclWideStrWideStrHashMap(HashPerformanceGrid.Cols[5]);
+end;
+
+procedure TMainForm.Exit1Click(Sender: TObject);
+begin
+ Close;
+end;
+
+end.
+
diff --git a/official/1.104/examples/common/containers/performance/ContainerPerformanceTests.pas b/official/1.104/examples/common/containers/performance/ContainerPerformanceTests.pas
new file mode 100644
index 0000000..df2d38a
--- /dev/null
+++ b/official/1.104/examples/common/containers/performance/ContainerPerformanceTests.pas
@@ -0,0 +1,353 @@
+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 TestJclAnsiStrAnsiStrHashMap(Results: TStrings);
+procedure TestJclWideStrWideStrHashMap(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}
+
+var
+ Res: Integer;
+
+procedure TestList(Results: TStrings);
+var
+ List: TList;
+ I: 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: 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
+ Res := 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: 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
+ Res := 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: IJclList;
+ I: 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.Objects[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 := List.Size - 1 downto 20 do
+ List.Objects[I - 10] := List.Objects[I];
+ for I := 0 to 10 do
+ List.Objects[I + 10] := TObject(I);
+ Results[4] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]);
+ Start := Now;
+ List.Clear;
+ Results[5] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]);
+ finally
+ List := nil;
+ Screen.Cursor := crDefault;
+ end;
+end;
+
+procedure TestBucketList(Results: TStrings);
+{$IFDEF RTL140_UP}
+var
+ I: 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: Integer;
+ Start: TDateTime;
+begin
+ Randomize;
+ Screen.Cursor := crHourGlass;
+ try
+ Start := Now;
+ Map := JclHashMaps.TJclHashMap.Create(256, False, 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;
+ 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
+ Res := 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 TestJclAnsiStrAnsiStrHashMap(Results: TStrings);
+var
+ Map: IJclAnsiStrAnsiStrMap;
+ I: Integer;
+ Res: string;
+ Start: TDateTime;
+begin
+ Randomize;
+ Screen.Cursor := crHourGlass;
+ try
+ Start := Now;
+ Map := TJclAnsiStrAnsiStrHashMap.Create(256);
+ for I := 0 to 100000 do
+ Map.PutValue(AnsiString(GenId(123)), '');
+ Results[1] := Format(ResultFormat, [(Now - Start) * MsecsPerDay]);
+ Start := Now;
+ for I := 0 to 100000 do
+ Res := string(Map.GetValue(AnsiString(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;
+
+procedure TestJclWideStrWideStrHashMap(Results: TStrings);
+var
+ Map: IJclWideStrWideStrMap;
+ I: Integer;
+ Res: string;
+ Start: TDateTime;
+begin
+ Randomize;
+ Screen.Cursor := crHourGlass;
+ try
+ Start := Now;
+ Map := TJclWideStrWideStrHashMap.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.104/examples/common/containers/trees/TreeExample.dof b/official/1.104/examples/common/containers/trees/TreeExample.dof
new file mode 100644
index 0000000..c22fe7f
--- /dev/null
+++ b/official/1.104/examples/common/containers/trees/TreeExample.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=..\..\..\..\bin
diff --git a/official/1.104/examples/common/containers/trees/TreeExample.dpr b/official/1.104/examples/common/containers/trees/TreeExample.dpr
new file mode 100644
index 0000000..c156c49
--- /dev/null
+++ b/official/1.104/examples/common/containers/trees/TreeExample.dpr
@@ -0,0 +1,21 @@
+program TreeExample;
+
+{$I jcl.inc}
+
+uses
+ {$IFDEF MSWINDOWS}
+ Forms,
+ {$ENDIF MSWINDOWS}
+ {$IFDEF LINUX}
+ QForms,
+ {$ENDIF LINUX}
+ TreeExampleMain in 'TreeExampleMain.pas' {MainForm};
+
+{$R *.res}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/containers/trees/TreeExample.res b/official/1.104/examples/common/containers/trees/TreeExample.res
new file mode 100644
index 0000000..b38c22a
Binary files /dev/null and b/official/1.104/examples/common/containers/trees/TreeExample.res differ
diff --git a/official/1.104/examples/common/containers/trees/TreeExampleMain.dfm b/official/1.104/examples/common/containers/trees/TreeExampleMain.dfm
new file mode 100644
index 0000000..9188c3d
--- /dev/null
+++ b/official/1.104/examples/common/containers/trees/TreeExampleMain.dfm
@@ -0,0 +1,62 @@
+object MainForm: TMainForm
+ Left = 328
+ Top = 237
+ Caption = 'Binary Tree'
+ ClientHeight = 259
+ ClientWidth = 462
+ 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 = 64
+ Top = 24
+ Width = 97
+ Height = 25
+ Caption = 'IntfBinaryTree'
+ TabOrder = 1
+ OnClick = btnIntfArrayTreeClick
+ end
+ object memoResult: TMemo
+ Left = 230
+ Top = 0
+ Width = 232
+ Height = 259
+ Align = alRight
+ ScrollBars = ssVertical
+ TabOrder = 2
+ end
+ object btnArrayTree: TButton
+ Left = 64
+ Top = 192
+ Width = 97
+ Height = 25
+ Caption = 'BinaryTree'
+ TabOrder = 0
+ OnClick = btnArrayTreeClick
+ end
+ object btnAnsiStrBinaryTree: TButton
+ Left = 64
+ Top = 80
+ Width = 97
+ Height = 25
+ Caption = 'AnsiStrBinaryTree'
+ TabOrder = 3
+ OnClick = btnAnsiStrBinaryTreeClick
+ end
+ object btnWideStrBinaryTree: TButton
+ Left = 64
+ Top = 136
+ Width = 97
+ Height = 25
+ Caption = 'WideStrBinaryTree'
+ TabOrder = 4
+ OnClick = btnWideStrBinaryTreeClick
+ end
+end
diff --git a/official/1.104/examples/common/containers/trees/TreeExampleMain.pas b/official/1.104/examples/common/containers/trees/TreeExampleMain.pas
new file mode 100644
index 0000000..4f05359
--- /dev/null
+++ b/official/1.104/examples/common/containers/trees/TreeExampleMain.pas
@@ -0,0 +1,168 @@
+unit TreeExampleMain;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, JclBase;
+
+type
+ TMainForm = class(TForm)
+ btnIntfArrayTree: TButton;
+ memoResult: TMemo;
+ btnArrayTree: TButton;
+ btnAnsiStrBinaryTree: TButton;
+ btnWideStrBinaryTree: TButton;
+ procedure btnIntfArrayTreeClick(Sender: TObject);
+ procedure btnArrayTreeClick(Sender: TObject);
+ procedure btnAnsiStrBinaryTreeClick(Sender: TObject);
+ procedure btnWideStrBinaryTreeClick(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(const 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;
+
+ Obj := TIntfInteger.Create(15);
+ if Tree.Contains(Obj) 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
+ begin
+ It.Next;
+ It.Remove;
+ end;
+end;
+
+procedure TMainForm.btnArrayTreeClick(Sender: TObject);
+var
+ Tree: IJclTree;
+ I: Integer;
+ It: IJclIterator;
+begin
+ memoResult.Lines.Clear;
+ Tree := TJclBinaryTree.Create(JclAlgorithms.IntegerCompare, {OwnsObjects:}False);
+ 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.btnAnsiStrBinaryTreeClick(Sender: TObject);
+var
+ Tree: IJclAnsiStrTree;
+ I: Integer;
+ It: IJclAnsiStrIterator;
+begin
+ memoResult.Lines.Clear;
+ Tree := TJclAnsiStrBinaryTree.Create(JclAlgorithms.AnsiStrSimpleCompare);
+ for I := 0 to 17 do
+ Tree.Add(AnsiString(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(string(It.Next));
+end;
+
+procedure TMainForm.btnWideStrBinaryTreeClick(Sender: TObject);
+var
+ Tree: IJclWideStrTree;
+ I: Integer;
+ It: IJclWideStrIterator;
+begin
+ memoResult.Lines.Clear;
+ Tree := TJclWideStrBinaryTree.Create(JclAlgorithms.WideStrSimpleCompare);
+ 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.104/examples/common/containers/trees/TreeStructure.dof b/official/1.104/examples/common/containers/trees/TreeStructure.dof
new file mode 100644
index 0000000..c22fe7f
--- /dev/null
+++ b/official/1.104/examples/common/containers/trees/TreeStructure.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=..\..\..\..\bin
diff --git a/official/1.104/examples/common/containers/trees/TreeStructure.dpr b/official/1.104/examples/common/containers/trees/TreeStructure.dpr
new file mode 100644
index 0000000..68234fb
--- /dev/null
+++ b/official/1.104/examples/common/containers/trees/TreeStructure.dpr
@@ -0,0 +1,14 @@
+program TreeStructure;
+
+uses
+ Forms,
+ TreeStructureMain in 'TreeStructureMain.pas' {Form1};
+
+{$R *.res}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/containers/trees/TreeStructure.res b/official/1.104/examples/common/containers/trees/TreeStructure.res
new file mode 100644
index 0000000..b38c22a
Binary files /dev/null and b/official/1.104/examples/common/containers/trees/TreeStructure.res differ
diff --git a/official/1.104/examples/common/containers/trees/TreeStructureMain.dfm b/official/1.104/examples/common/containers/trees/TreeStructureMain.dfm
new file mode 100644
index 0000000..e0a8583
--- /dev/null
+++ b/official/1.104/examples/common/containers/trees/TreeStructureMain.dfm
@@ -0,0 +1,247 @@
+object Form1: TForm1
+ Left = 0
+ Top = 0
+ Caption = 'Form1'
+ ClientHeight = 423
+ ClientWidth = 426
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ OnCreate = FormCreate
+ PixelsPerInch = 96
+ TextHeight = 13
+ object GroupBoxOptions: TGroupBox
+ Left = 8
+ Top = 8
+ Width = 410
+ Height = 129
+ Anchors = [akLeft, akTop, akRight]
+ Caption = 'Options:'
+ TabOrder = 0
+ object CheckBoxBinaryTree: TCheckBox
+ Left = 16
+ Top = 24
+ Width = 161
+ Height = 17
+ Action = ActionBinaryTree
+ TabOrder = 0
+ end
+ object CheckBoxGeneralPurposeTree: TCheckBox
+ Left = 16
+ Top = 48
+ Width = 161
+ Height = 17
+ Action = ActionGeneralPurposeTree
+ State = cbChecked
+ TabOrder = 1
+ end
+ object CheckBoxCaseSensitive: TCheckBox
+ Left = 16
+ Top = 96
+ Width = 97
+ Height = 17
+ Action = ActionCaseSensitive
+ TabOrder = 2
+ end
+ object CheckBoxAllowDefault: TCheckBox
+ Left = 199
+ Top = 24
+ Width = 178
+ Height = 17
+ Action = ActionAllowDefault
+ TabOrder = 3
+ end
+ object CheckBoxAllowDuplicates: TCheckBox
+ Left = 200
+ Top = 48
+ Width = 177
+ Height = 17
+ Action = ActionAllowDuplicates
+ TabOrder = 4
+ end
+ object CheckBoxIgnoreDuplicates: TCheckBox
+ Left = 216
+ Top = 72
+ Width = 161
+ Height = 17
+ Action = ActionIgnoreDuplicates
+ TabOrder = 5
+ end
+ object CheckBoxRemoveSingle: TCheckBox
+ Left = 200
+ Top = 96
+ Width = 177
+ Height = 17
+ Action = ActionRemoveSingle
+ TabOrder = 6
+ end
+ end
+ object TreeViewResults: TTreeView
+ Left = 8
+ Top = 143
+ Width = 193
+ Height = 272
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ Indent = 19
+ TabOrder = 1
+ end
+ object GroupBoxActions: TGroupBox
+ Left = 207
+ Top = 143
+ Width = 211
+ Height = 272
+ Anchors = [akTop, akRight, akBottom]
+ Caption = 'Actions:'
+ TabOrder = 2
+ object ButtonGenerateRandom: TButton
+ Left = 16
+ Top = 24
+ Width = 177
+ Height = 25
+ Action = ActionGenerateRandom
+ TabOrder = 0
+ end
+ object ButtonRemoveSelected: TButton
+ Left = 16
+ Top = 56
+ Width = 177
+ Height = 25
+ Action = ActionRemoveSelected
+ TabOrder = 1
+ end
+ object EditNewItem: TEdit
+ Left = 16
+ Top = 168
+ Width = 177
+ Height = 21
+ TabOrder = 2
+ Text = 'New item'
+ end
+ object ButtonAddNew: TButton
+ Left = 16
+ Top = 200
+ Width = 177
+ Height = 25
+ Action = ActionAddNew
+ TabOrder = 3
+ end
+ object ButtonAddNewChild: TButton
+ Left = 16
+ Top = 231
+ Width = 177
+ Height = 25
+ Action = ActionAddNewChild
+ TabOrder = 4
+ end
+ object Button1: TButton
+ Left = 16
+ Top = 87
+ Width = 177
+ Height = 25
+ Action = ActionPack
+ TabOrder = 5
+ end
+ object Button2: TButton
+ Left = 16
+ Top = 120
+ Width = 177
+ Height = 25
+ Action = ActionTestTree
+ TabOrder = 6
+ end
+ end
+ object ActionListMain: TActionList
+ Left = 160
+ Top = 112
+ object ActionAllowDuplicates: TAction
+ Category = 'Tree options'
+ AutoCheck = True
+ Caption = 'Allow duplicates'
+ OnExecute = ActionDuplicatesExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionIgnoreDuplicates: TAction
+ Category = 'Tree options'
+ AutoCheck = True
+ Caption = 'Ignore duplicates'
+ OnExecute = ActionDuplicatesExecute
+ OnUpdate = ActionIgnoreDuplicatesUpdate
+ end
+ object ActionAllowDefault: TAction
+ Category = 'Tree options'
+ AutoCheck = True
+ Caption = 'Allow defaults (empty strings)'
+ OnExecute = ActionAllowDefaultExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionRemoveSingle: TAction
+ Category = 'Tree options'
+ AutoCheck = True
+ Caption = 'Remove single element'
+ OnExecute = ActionRemoveSingleExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionCaseSensitive: TAction
+ Category = 'Tree options'
+ AutoCheck = True
+ Caption = 'Case sensitive'
+ OnExecute = ActionCaseSensitiveExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionGenerateRandom: TAction
+ Category = 'Tree actions'
+ Caption = 'Generate random tree'
+ OnExecute = ActionGenerateRandomExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionAddNew: TAction
+ Category = 'Tree actions'
+ Caption = 'Add new'
+ OnExecute = ActionAddNewExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionRemoveSelected: TAction
+ Category = 'Tree actions'
+ Caption = 'Remove selected'
+ OnExecute = ActionRemoveSelectedExecute
+ OnUpdate = ActionRemoveSelectedUpdate
+ end
+ object ActionAddNewChild: TAction
+ Category = 'Tree actions'
+ Caption = 'Add new child'
+ OnExecute = ActionAddNewChildExecute
+ OnUpdate = ActionAddNewChildUpdate
+ end
+ object ActionBinaryTree: TAction
+ Category = 'Tree options'
+ AutoCheck = True
+ Caption = 'Binary tree'
+ OnExecute = ActionBinaryTreeExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionGeneralPurposeTree: TAction
+ Category = 'Tree options'
+ AutoCheck = True
+ Caption = 'General purpose tree'
+ Checked = True
+ OnExecute = ActionGeneralPurposeTreeExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionPack: TAction
+ Category = 'Tree actions'
+ Caption = 'Pack'
+ OnExecute = ActionPackExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionTestTree: TAction
+ Category = 'Tree actions'
+ Caption = 'Test tree'
+ OnExecute = ActionTestTreeExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ end
+end
diff --git a/official/1.104/examples/common/containers/trees/TreeStructureMain.pas b/official/1.104/examples/common/containers/trees/TreeStructureMain.pas
new file mode 100644
index 0000000..2635fe6
--- /dev/null
+++ b/official/1.104/examples/common/containers/trees/TreeStructureMain.pas
@@ -0,0 +1,344 @@
+unit TreeStructureMain;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ActnList, ComCtrls,
+ JclContainerIntf;
+
+type
+ TForm1 = class(TForm)
+ GroupBoxOptions: TGroupBox;
+ ActionListMain: TActionList;
+ ActionAllowDuplicates: TAction;
+ ActionIgnoreDuplicates: TAction;
+ ActionAllowDefault: TAction;
+ ActionRemoveSingle: TAction;
+ ActionCaseSensitive: TAction;
+ ActionGenerateRandom: TAction;
+ ActionAddNew: TAction;
+ ActionRemoveSelected: TAction;
+ TreeViewResults: TTreeView;
+ GroupBoxActions: TGroupBox;
+ ButtonGenerateRandom: TButton;
+ ButtonRemoveSelected: TButton;
+ EditNewItem: TEdit;
+ ButtonAddNew: TButton;
+ ActionAddNewChild: TAction;
+ ButtonAddNewChild: TButton;
+ CheckBoxBinaryTree: TCheckBox;
+ ActionBinaryTree: TAction;
+ ActionGeneralPurposeTree: TAction;
+ CheckBoxGeneralPurposeTree: TCheckBox;
+ CheckBoxCaseSensitive: TCheckBox;
+ CheckBoxAllowDefault: TCheckBox;
+ CheckBoxAllowDuplicates: TCheckBox;
+ CheckBoxIgnoreDuplicates: TCheckBox;
+ CheckBoxRemoveSingle: TCheckBox;
+ ActionPack: TAction;
+ Button1: TButton;
+ ActionTestTree: TAction;
+ Button2: TButton;
+ procedure FormCreate(Sender: TObject);
+ procedure ActionGeneralPurposeTreeExecute(Sender: TObject);
+ procedure ActionAlwaysEnabled(Sender: TObject);
+ procedure ActionBinaryTreeExecute(Sender: TObject);
+ procedure ActionCaseSensitiveExecute(Sender: TObject);
+ procedure ActionRemoveSingleExecute(Sender: TObject);
+ procedure ActionAllowDefaultExecute(Sender: TObject);
+ procedure ActionDuplicatesExecute(Sender: TObject);
+ procedure ActionIgnoreDuplicatesUpdate(Sender: TObject);
+ procedure ActionGenerateRandomExecute(Sender: TObject);
+ procedure ActionPackExecute(Sender: TObject);
+ procedure ActionAddNewExecute(Sender: TObject);
+ procedure ActionAddNewChildUpdate(Sender: TObject);
+ procedure ActionAddNewChildExecute(Sender: TObject);
+ procedure ActionRemoveSelectedExecute(Sender: TObject);
+ procedure ActionRemoveSelectedUpdate(Sender: TObject);
+ procedure ActionTestTreeExecute(Sender: TObject);
+ private
+ FTree: IJclWideStrTree;
+ function GetSelectedIterator: IJclWideStrTreeIterator;
+ procedure PrintTree;
+ public
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+uses
+ JclBinaryTrees,
+ JclTrees;
+
+{$R *.dfm}
+
+procedure TForm1.ActionBinaryTreeExecute(Sender: TObject);
+begin
+ if ActionBinaryTree.Checked then
+ begin
+ ActionGeneralPurposeTree.Checked := False;
+
+ FTree := TJclWideStrBinaryTree.Create(nil);
+
+ ActionCaseSensitiveExecute(ActionCaseSensitive);
+ ActionRemoveSingleExecute(ActionRemoveSingle);
+ ActionAllowDefaultExecute(ActionAllowDefault);
+ ActionDuplicatesExecute(nil);
+ PrintTree;
+ end;
+end;
+
+procedure TForm1.ActionCaseSensitiveExecute(Sender: TObject);
+begin
+ FTree.CaseSensitive := (Sender as TAction).Checked;
+end;
+
+procedure TForm1.ActionGeneralPurposeTreeExecute(Sender: TObject);
+begin
+ if ActionGeneralPurposeTree.Checked then
+ begin
+ ActionBinaryTree.Checked := False;
+
+ FTree := TJclWideStrTree.Create;
+
+ ActionCaseSensitiveExecute(ActionCaseSensitive);
+ ActionRemoveSingleExecute(ActionRemoveSingle);
+ ActionAllowDefaultExecute(ActionAllowDefault);
+ ActionDuplicatesExecute(nil);
+ PrintTree;
+ end;
+end;
+
+procedure TForm1.ActionGenerateRandomExecute(Sender: TObject);
+ var
+ CurrentItem: Integer;
+ function GenerateItem: WideString;
+ begin
+ if FTree.Duplicates = dupAccept then
+ Result := Format('Item %.3d', [Random(10)])
+ else
+ begin
+ Result := Format('Item %.3d', [CurrentItem]);
+ Inc(CurrentItem);
+ end;
+ end;
+
+ procedure GenerateRandomChild(const AIterator: IJclWideStrIterator; Count: Integer);
+ begin
+ while Count > 0 do
+ begin
+ (AIterator as IJclWideStrTreeIterator).AddChild(GenerateItem);
+ Dec(Count);
+ end;
+ end;
+
+ procedure GenerateRandom(Count: Integer);
+ begin
+ while Count > 0 do
+ begin
+ FTree.Add(GenerateItem);
+ Dec(Count);
+ end;
+ end;
+var
+ Index1, Index2: Integer;
+ Iterator0, Iterator1, Iterator2: IJclWideStrTreeIterator;
+begin
+ CurrentItem := 0;
+ FTree.Clear;
+
+ if ActionGeneralPurposeTree.Checked then
+ begin
+ // general purpose tree
+ GenerateRandom(5);
+ Iterator0 := FTree.Root;
+ for Index1 := 0 to Iterator0.ChildrenCount - 1 do
+ begin
+ Iterator1 := (Iterator0 as IJclIntfCloneable).IntfClone as IJclWideStrTreeIterator;
+ Iterator1.GetChild(Index1);
+ GenerateRandomChild(Iterator1, 5);
+ for Index2 := 0 to Iterator1.ChildrenCount - 1 do
+ begin
+ Iterator2 := (Iterator1 as IJclIntfCloneable).IntfClone as IJclWideStrTreeIterator;
+ Iterator2.GetChild(Index2);
+ GenerateRandomChild(Iterator2, 5);
+ end;
+ end;
+ end
+ else
+ begin
+ // binary tree
+ GenerateRandom(100);
+ end;
+ PrintTree;
+end;
+
+procedure TForm1.ActionIgnoreDuplicatesUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := not CheckBoxAllowDuplicates.Checked;
+end;
+
+procedure TForm1.ActionPackExecute(Sender: TObject);
+begin
+ (FTree as IJclPackable).Pack;
+ PrintTree;
+end;
+
+procedure TForm1.ActionRemoveSelectedExecute(Sender: TObject);
+begin
+ GetSelectedIterator.Remove;
+ PrintTree;
+end;
+
+procedure TForm1.ActionRemoveSelectedUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := TreeViewResults.Selected <> nil;
+end;
+
+procedure TForm1.ActionRemoveSingleExecute(Sender: TObject);
+begin
+ FTree.RemoveSingleElement := (Sender as TAction).Checked;
+end;
+
+procedure TForm1.ActionTestTreeExecute(Sender: TObject);
+ procedure CheckNode(const AIterator: IJclWideStrTreeIterator);
+ var
+ Index: Integer;
+ ChildIterator, ParentIterator: IJclWideStrTreeIterator;
+ begin
+ for Index := 0 to AIterator.ChildrenCount - 1 do
+ begin
+ ChildIterator := (AIterator as IJclIntfCloneable).IntfClone as IJclWideStrTreeIterator;
+ ChildIterator.GetChild(Index);
+
+ try
+ ParentIterator := (ChildIterator as IJclIntfCloneable).IntfClone as IJclWideStrTreeIterator;
+ ParentIterator.Parent;
+
+ if not AIterator.IteratorEquals(ParentIterator) then
+ ShowMessage('difference at parent of node ' + string(ChildIterator.GetString));
+ except
+ ShowMessage('error at parent of node ' + string(ChildIterator.GetString));
+ end;
+
+ CheckNode(ChildIterator);
+ end;
+ end;
+var
+ ARootIterator: IJclWideStrTreeIterator;
+begin
+ ARootIterator := FTree.Root;
+ ARootIterator.Next; // unlock
+ CheckNode(ARootIterator);
+ ShowMessage('end of test');
+end;
+
+procedure TForm1.ActionAddNewChildExecute(Sender: TObject);
+begin
+ if GetSelectedIterator.AddChild(EditNewItem.Text) then
+ ShowMessage('Success')
+ else
+ ShowMessage('Duplicate');
+ PrintTree;
+end;
+
+procedure TForm1.ActionAddNewChildUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := ActionGeneralPurposeTree.Checked and (TreeViewResults.Selected <> nil);
+end;
+
+procedure TForm1.ActionAddNewExecute(Sender: TObject);
+begin
+ if FTree.Add(EditNewItem.Text) then
+ ShowMessage('Success')
+ else
+ ShowMessage('Duplicate');
+ PrintTree;
+end;
+
+procedure TForm1.ActionAllowDefaultExecute(Sender: TObject);
+begin
+ FTree.AllowDefaultElements := (Sender as TAction).Checked;
+end;
+
+procedure TForm1.ActionDuplicatesExecute(Sender: TObject);
+begin
+ if ActionAllowDuplicates.Checked then
+ FTree.Duplicates := dupAccept
+ else
+ if ActionIgnoreDuplicates.Checked then
+ FTree.Duplicates := dupIgnore
+ else
+ FTree.Duplicates := dupError;
+end;
+
+procedure TForm1.ActionAlwaysEnabled(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := True;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+ Randomize;
+ ActionGeneralPurposeTreeExecute(ActionGeneralPurposeTree);
+end;
+
+function TForm1.GetSelectedIterator: IJclWideStrTreeIterator;
+var
+ Indexes: array of Integer;
+ I: Integer;
+ ANode: TTreeNode;
+begin
+ Result := nil;
+ ANode := TreeViewResults.Selected;
+ if ANode <> nil then
+ begin
+ while ANode.Parent <> nil do
+ begin
+ SetLength(Indexes, Length(Indexes) + 1);
+ Indexes[High(Indexes)] := ANode.Index;
+ ANode := ANode.Parent;
+ end;
+ Result := FTree.Root;
+ for I := High(Indexes) downto Low(Indexes) do
+ Result.GetChild(Indexes[I]);
+ Result.Next;
+ end;
+end;
+
+procedure TForm1.PrintTree;
+ procedure ProcessNode(const AIterator: IJclWideStrTreeIterator; ANode: TTreeNode);
+ var
+ Index: Integer;
+ ChildIterator: IJclWideStrTreeIterator;
+ ChildNode: TTreeNode;
+ begin
+ ANode.Text := string(AIterator.GetString);
+ for Index := 0 to AIterator.ChildrenCount - 1 do
+ begin
+ ChildIterator := (AIterator as IJclIntfCloneable).IntfClone as IJclWideStrTreeIterator;
+ ChildIterator.GetChild(Index);
+ ChildNode := TreeViewResults.Items.AddChild(ANode, '');
+ ProcessNode(ChildIterator, ChildNode);
+ end;
+ end;
+var
+ ARootIterator: IJclWideStrTreeIterator;
+ ARootNode: TTreeNode;
+begin
+ TreeViewResults.Items.Clear;
+ if FTree.Size > 0 then
+ begin
+ ARootIterator := FTree.Root;
+ ARootIterator.Next; // unlock
+ ARootNode := TreeViewResults.Items.Add(nil, '');
+ ProcessNode(ARootIterator, ARootNode);
+ ARootNode.Expand(True);
+ ARootNode.MakeVisible;
+ end;
+end;
+
+end.
diff --git a/official/1.104/examples/common/expreval/ExprEvalExample.dof b/official/1.104/examples/common/expreval/ExprEvalExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/common/expreval/ExprEvalExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/common/expreval/ExprEvalExample.dpr b/official/1.104/examples/common/expreval/ExprEvalExample.dpr
new file mode 100644
index 0000000..b5d8c0a
--- /dev/null
+++ b/official/1.104/examples/common/expreval/ExprEvalExample.dpr
@@ -0,0 +1,19 @@
+program ExprEvalExample;
+
+{$I jcl.inc}
+
+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}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/expreval/ExprEvalExample.res b/official/1.104/examples/common/expreval/ExprEvalExample.res
new file mode 100644
index 0000000..ff24fa7
Binary files /dev/null and b/official/1.104/examples/common/expreval/ExprEvalExample.res differ
diff --git a/official/1.104/examples/common/expreval/ExprEvalExampleLogic.pas b/official/1.104/examples/common/expreval/ExprEvalExampleLogic.pas
new file mode 100644
index 0000000..7c258ec
--- /dev/null
+++ b/official/1.104/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.104/examples/common/expreval/ExprEvalExampleMain.dfm b/official/1.104/examples/common/expreval/ExprEvalExampleMain.dfm
new file mode 100644
index 0000000..7b67763
--- /dev/null
+++ b/official/1.104/examples/common/expreval/ExprEvalExampleMain.dfm
@@ -0,0 +1,71 @@
+object Form1: TForm1
+ Left = 222
+ Top = 107
+ ClientWidth = 479
+ ClientHeight = 321
+ 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.104/examples/common/expreval/ExprEvalExampleMain.pas b/official/1.104/examples/common/expreval/ExprEvalExampleMain.pas
new file mode 100644
index 0000000..ec090c4
--- /dev/null
+++ b/official/1.104/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.104/examples/common/filesearch/FileSearchDemo.dof b/official/1.104/examples/common/filesearch/FileSearchDemo.dof
new file mode 100644
index 0000000..d447a0b
--- /dev/null
+++ b/official/1.104/examples/common/filesearch/FileSearchDemo.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=../../../bin
diff --git a/official/1.104/examples/common/filesearch/FileSearchDemo.dpr b/official/1.104/examples/common/filesearch/FileSearchDemo.dpr
new file mode 100644
index 0000000..3375e92
--- /dev/null
+++ b/official/1.104/examples/common/filesearch/FileSearchDemo.dpr
@@ -0,0 +1,16 @@
+program FileSearchDemo;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ FileSearchDemoMain in 'FileSearchDemoMain.pas' {FileSearchForm};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TFileSearchForm, FileSearchForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/filesearch/FileSearchDemo.res b/official/1.104/examples/common/filesearch/FileSearchDemo.res
new file mode 100644
index 0000000..ff24fa7
Binary files /dev/null and b/official/1.104/examples/common/filesearch/FileSearchDemo.res differ
diff --git a/official/1.104/examples/common/filesearch/FileSearchDemoMain.dfm b/official/1.104/examples/common/filesearch/FileSearchDemoMain.dfm
new file mode 100644
index 0000000..a322ab6
--- /dev/null
+++ b/official/1.104/examples/common/filesearch/FileSearchDemoMain.dfm
@@ -0,0 +1,364 @@
+object FileSearchForm: TFileSearchForm
+ Left = 258
+ Top = 301
+ Width = 855
+ Height = 509
+ HorzScrollBar.Range = 378
+ VertScrollBar.Range = 252
+ ActiveControl = StartBtn
+ 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
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ PixelsPerInch = 96
+ TextHeight = 13
+ object StatusBar: TStatusBar
+ Left = 0
+ Top = 461
+ Width = 847
+ 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 = 847
+ Height = 280
+ 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
+ end
+ object Panel1: TPanel
+ Left = 0
+ Top = 0
+ Width = 847
+ 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
+ object SaveBtn: TButton
+ Left = 760
+ Top = 8
+ Width = 75
+ Height = 25
+ Caption = 'Save'
+ TabOrder = 5
+ OnClick = SaveBtnClick
+ end
+ end
+ object DetailsPanel: TPanel
+ Left = 0
+ Top = 49
+ Width = 847
+ 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
+ object SaveDialog: TSaveDialog
+ DefaultExt = '*.txt'
+ Filter = 'Text files (*.txt)|*.txt|All files (*.*)|*.*'
+ Left = 216
+ Top = 96
+ end
+end
diff --git a/official/1.104/examples/common/filesearch/FileSearchDemoMain.pas b/official/1.104/examples/common/filesearch/FileSearchDemoMain.pas
new file mode 100644
index 0000000..35e9cca
--- /dev/null
+++ b/official/1.104/examples/common/filesearch/FileSearchDemoMain.pas
@@ -0,0 +1,260 @@
+//
+// Robert Rossmair, 2003
+//
+unit FileSearchDemoMain;
+
+{$INCLUDE jcl.inc}
+
+interface
+
+uses
+ SysUtils, Classes,
+ Graphics, StdCtrls, Controls, ExtCtrls, ComCtrls, Forms, Dialogs,
+ JclStrings, JclFileUtils;
+
+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 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;
+ FTaskID: TFileSearchTaskID;
+ FT0: TDateTime;
+ 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 *.dfm}
+
+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;
+begin
+ ListItem := FileList.Items.Add;
+ with ListItem do
+ begin
+ Caption := Directory + FileInfo.Name;
+ SubItems.Add(IntToStr(GetSizeOfFile(FileInfo)));
+ 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]);
+ 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;
+
+ FT0 := Now;
+ FTaskID := FFileEnumerator.ForEach(AddFile);
+end;
+
+procedure TFileSearchForm.StopBtnClick(Sender: TObject);
+begin
+ FFileEnumerator.StopTask(FTaskID);
+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.104/examples/common/graphics/ClipLineDemo.dof b/official/1.104/examples/common/graphics/ClipLineDemo.dof
new file mode 100644
index 0000000..b13ef5f
--- /dev/null
+++ b/official/1.104/examples/common/graphics/ClipLineDemo.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=../../../bin
+
diff --git a/official/1.104/examples/common/graphics/ClipLineDemo.dpr b/official/1.104/examples/common/graphics/ClipLineDemo.dpr
new file mode 100644
index 0000000..b74227a
--- /dev/null
+++ b/official/1.104/examples/common/graphics/ClipLineDemo.dpr
@@ -0,0 +1,16 @@
+program ClipLineDemo;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ ClipLineDemoMain in 'ClipLineDemoMain.pas' {Form1};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/graphics/ClipLineDemo.res b/official/1.104/examples/common/graphics/ClipLineDemo.res
new file mode 100644
index 0000000..0930265
Binary files /dev/null and b/official/1.104/examples/common/graphics/ClipLineDemo.res differ
diff --git a/official/1.104/examples/common/graphics/ClipLineDemoMain.dfm b/official/1.104/examples/common/graphics/ClipLineDemoMain.dfm
new file mode 100644
index 0000000..3cada53
--- /dev/null
+++ b/official/1.104/examples/common/graphics/ClipLineDemoMain.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.104/examples/common/graphics/ClipLineDemoMain.pas b/official/1.104/examples/common/graphics/ClipLineDemoMain.pas
new file mode 100644
index 0000000..3711ce0
--- /dev/null
+++ b/official/1.104/examples/common/graphics/ClipLineDemoMain.pas
@@ -0,0 +1,85 @@
+unit ClipLineDemoMain;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ SysUtils, Classes,
+{$IFDEF MSWINDOWS}
+ Windows,
+{$ENDIF}
+ Graphics, ExtCtrls, Forms, JclGraphUtils,
+ 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
+
+{$R *.dfm}
+
+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.104/examples/common/graphics/StretchGraphicDemoMain.dfm b/official/1.104/examples/common/graphics/StretchGraphicDemoMain.dfm
new file mode 100644
index 0000000..8a55a35
--- /dev/null
+++ b/official/1.104/examples/common/graphics/StretchGraphicDemoMain.dfm
@@ -0,0 +1,217 @@
+object StretchDemoForm: TStretchDemoForm
+ Left = 255
+ Top = 208
+ ClientWidth = 780
+ ClientHeight = 583
+ 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
+ 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.104/examples/common/graphics/StretchGraphicDemoMain.pas b/official/1.104/examples/common/graphics/StretchGraphicDemoMain.pas
new file mode 100644
index 0000000..ac7cc23
--- /dev/null
+++ b/official/1.104/examples/common/graphics/StretchGraphicDemoMain.pas
@@ -0,0 +1,503 @@
+//
+// 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}
+ Graphics, Controls, Forms,
+ Dialogs, ComCtrls, StdCtrls, Menus, ExtCtrls, ExtDlgs,
+ JclGraphics,
+ {$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.104/examples/common/graphics/StretchGraphicExample.dof b/official/1.104/examples/common/graphics/StretchGraphicExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/common/graphics/StretchGraphicExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/common/graphics/StretchGraphicExample.dpr b/official/1.104/examples/common/graphics/StretchGraphicExample.dpr
new file mode 100644
index 0000000..491af7b
--- /dev/null
+++ b/official/1.104/examples/common/graphics/StretchGraphicExample.dpr
@@ -0,0 +1,16 @@
+program StretchGraphicExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ StretchGraphicDemoMain in 'StretchGraphicDemoMain.pas' {StretchDemoForm};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TStretchDemoForm, StretchDemoForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/graphics/StretchGraphicExample.res b/official/1.104/examples/common/graphics/StretchGraphicExample.res
new file mode 100644
index 0000000..0930265
Binary files /dev/null and b/official/1.104/examples/common/graphics/StretchGraphicExample.res differ
diff --git a/official/1.104/examples/common/multimedia/MidiOutExample.dof b/official/1.104/examples/common/multimedia/MidiOutExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/common/multimedia/MidiOutExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/common/multimedia/MidiOutExample.dpr b/official/1.104/examples/common/multimedia/MidiOutExample.dpr
new file mode 100644
index 0000000..c45a25f
--- /dev/null
+++ b/official/1.104/examples/common/multimedia/MidiOutExample.dpr
@@ -0,0 +1,16 @@
+program MidiOutExample;
+
+uses
+ Forms,
+ MidiOutExampleMain in 'MidiOutExampleMain.pas' {Keyboard},
+ MidiOutExampleTuningDlg in 'MidiOutExampleTuningDlg.pas' {TuningDialog};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TKeyboard, Keyboard);
+ Application.CreateForm(TTuningDialog, TuningDialog);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/multimedia/MidiOutExample.res b/official/1.104/examples/common/multimedia/MidiOutExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/common/multimedia/MidiOutExample.res differ
diff --git a/official/1.104/examples/common/multimedia/MidiOutExampleMain.dfm b/official/1.104/examples/common/multimedia/MidiOutExampleMain.dfm
new file mode 100644
index 0000000..4a2b7cc
--- /dev/null
+++ b/official/1.104/examples/common/multimedia/MidiOutExampleMain.dfm
@@ -0,0 +1,488 @@
+object Keyboard: TKeyboard
+ Left = 145
+ Top = 347
+ ClientWidth = 520
+ ClientHeight = 223
+ 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
+ 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.104/examples/common/multimedia/MidiOutExampleMain.pas b/official/1.104/examples/common/multimedia/MidiOutExampleMain.pas
new file mode 100644
index 0000000..ed0e4a8
--- /dev/null
+++ b/official/1.104/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.104/examples/common/multimedia/MidiOutExampleTuningDlg.dfm b/official/1.104/examples/common/multimedia/MidiOutExampleTuningDlg.dfm
new file mode 100644
index 0000000..f35bbc4
--- /dev/null
+++ b/official/1.104/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.104/examples/common/multimedia/MidiOutExampleTuningDlg.pas b/official/1.104/examples/common/multimedia/MidiOutExampleTuningDlg.pas
new file mode 100644
index 0000000..7de83f5
--- /dev/null
+++ b/official/1.104/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.104/examples/common/numformat/NumFormatExample.dof b/official/1.104/examples/common/numformat/NumFormatExample.dof
new file mode 100644
index 0000000..d447a0b
--- /dev/null
+++ b/official/1.104/examples/common/numformat/NumFormatExample.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=../../../bin
diff --git a/official/1.104/examples/common/numformat/NumFormatExample.dpr b/official/1.104/examples/common/numformat/NumFormatExample.dpr
new file mode 100644
index 0000000..7b7e548
--- /dev/null
+++ b/official/1.104/examples/common/numformat/NumFormatExample.dpr
@@ -0,0 +1,16 @@
+program NumFormatExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ NumFormatExampleMain in 'NumFormatExampleMain.pas' {MainForm};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/numformat/NumFormatExample.res b/official/1.104/examples/common/numformat/NumFormatExample.res
new file mode 100644
index 0000000..ff24fa7
Binary files /dev/null and b/official/1.104/examples/common/numformat/NumFormatExample.res differ
diff --git a/official/1.104/examples/common/numformat/NumFormatExampleMain.dfm b/official/1.104/examples/common/numformat/NumFormatExampleMain.dfm
new file mode 100644
index 0000000..dc8d155
--- /dev/null
+++ b/official/1.104/examples/common/numformat/NumFormatExampleMain.dfm
@@ -0,0 +1,208 @@
+object MainForm: TMainForm
+ Left = 234
+ Top = 223
+ Width = 800
+ Height = 581
+ ActiveControl = ValueEdit
+ Caption = 'TJclNumericFormat Example'
+ 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
+ MaxValue = 64
+ MinValue = 1
+ TabOrder = 1
+ Value = 9
+ OnChange = PrecisionEditChange
+ end
+ object Output: TMemo
+ Left = 0
+ Top = 120
+ Width = 800
+ Height = 461
+ Align = alBottom
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ Font.Color = clBlack
+ Font.Height = 16
+ Font.Name = 'Courier'
+ 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
+ OnChange = BlockSizeEditChange
+ 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
+ MaxValue = 12
+ MinValue = 1
+ TabOrder = 3
+ Value = 3
+ OnChange = ExpDivisionEditChange
+ end
+ object WidthEdit: TSpinEdit
+ Left = 380
+ Top = 92
+ Width = 81
+ Height = 23
+ TabOrder = 4
+ Value = 4
+ OnChange = WidthEditChange
+ 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
+ MaxValue = 64
+ TabOrder = 2
+ Value = 6
+ OnChange = FractionDigitsEditChange
+ end
+end
diff --git a/official/1.104/examples/common/numformat/NumFormatExampleMain.pas b/official/1.104/examples/common/numformat/NumFormatExampleMain.pas
new file mode 100644
index 0000000..60721ff
--- /dev/null
+++ b/official/1.104/examples/common/numformat/NumFormatExampleMain.pas
@@ -0,0 +1,221 @@
+unit NumFormatExampleMain;
+
+interface
+
+uses
+ Math, SysUtils, Classes,
+ Windows, Graphics, Controls, Forms, StdCtrls, ComCtrls, Spin,
+ 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 BlockSizeEditChange(Sender: TObject; NewValue: Integer);
+ procedure BlockSeparatorSelectorChange(Sender: TObject);
+ procedure PrecisionEditChange(Sender: TObject; NewValue: Integer);
+ procedure cbShowPlusSignClick(Sender: TObject);
+ procedure ExpDivisionEditChange(Sender: TObject; NewValue: Integer);
+ procedure WidthEditChange(Sender: TObject; NewValue: Integer);
+ procedure cbZeroPaddingClick(Sender: TObject);
+ procedure MultiplierSelectorChange(Sender: TObject);
+ procedure FractionDigitsEditChange(Sender: TObject;
+ NewValue: Integer);
+ private
+ { Private declarations }
+ FNumFormat: TJclNumericFormat;
+ procedure Display;
+ public
+ { Public declarations }
+ end;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.dfm}
+
+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;
+ {$IFDEF COMPILER6_UP}
+ C: TPoint;
+ {$ENDIF COMPILER6_UP}
+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;
+ {$IFDEF COMPILER6_UP}
+ C.X := 0;
+ C.Y := 0;
+ Output.CaretPos := C;
+ {$ENDIF COMPILER6_UP}
+ 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.BlockSizeEditChange(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 := Char(BlockSeparatorSelector.Text[1]);
+ Display;
+ end;
+end;
+
+procedure TMainForm.PrecisionEditChange(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.ExpDivisionEditChange(Sender: TObject;
+ NewValue: Integer);
+begin
+ if Assigned(FNumFormat) then
+ begin
+ FNumFormat.ExponentDivision := ExpDivisionEdit.Value;
+ Display;
+ end;
+end;
+
+procedure TMainForm.WidthEditChange(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.FractionDigitsEditChange(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.104/examples/common/pcre/PCREDemo.dof b/official/1.104/examples/common/pcre/PCREDemo.dof
new file mode 100644
index 0000000..abe45c2
--- /dev/null
+++ b/official/1.104/examples/common/pcre/PCREDemo.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=..\..\..\bin
diff --git a/official/1.104/examples/common/pcre/PCREDemo.dpr b/official/1.104/examples/common/pcre/PCREDemo.dpr
new file mode 100644
index 0000000..94dfc52
--- /dev/null
+++ b/official/1.104/examples/common/pcre/PCREDemo.dpr
@@ -0,0 +1,17 @@
+program PCREDemo;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ PCREDemoMain in 'PCREDemoMain.pas' {frmMain};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'JclPCRE Demo';
+ Application.CreateForm(TfrmMain, frmMain);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/pcre/PCREDemo.res b/official/1.104/examples/common/pcre/PCREDemo.res
new file mode 100644
index 0000000..ff24fa7
Binary files /dev/null and b/official/1.104/examples/common/pcre/PCREDemo.res differ
diff --git a/official/1.104/examples/common/pcre/PCREDemoMain.dfm b/official/1.104/examples/common/pcre/PCREDemoMain.dfm
new file mode 100644
index 0000000..6fae74a
--- /dev/null
+++ b/official/1.104/examples/common/pcre/PCREDemoMain.dfm
@@ -0,0 +1,233 @@
+object frmMain: TfrmMain
+ Left = 300
+ Top = 115
+ ClientWidth = 462
+ ClientHeight = 334
+ 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.104/examples/common/pcre/PCREDemoMain.pas b/official/1.104/examples/common/pcre/PCREDemoMain.pas
new file mode 100644
index 0000000..ed0f523
--- /dev/null
+++ b/official/1.104/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: TJclRegEx;
+ FMatchIndex: integer;
+ procedure SelectText(Range: TJclCaptureRange);
+ procedure Match;
+ function GetUIOptions: TJclRegExOptions;
+ 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 := TJclRegEx.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(Range: TJclCaptureRange);
+begin
+ reFile.SelStart := Range.FirstPos - 1;
+ reFile.SelLength := Range.LastPos - Range.FirstPos + 1;
+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.CaptureRanges[0]);
+ FMatchIndex := RE.CaptureRanges[0].LastPos + 1;
+ end;
+ UpdateUIOptions;
+end;
+
+function TfrmMain.GetUIOptions: TJclRegExOptions;
+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: TJclRegExOptions;
+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.104/examples/common/rtti/RTTIDemoMain.dfm b/official/1.104/examples/common/rtti/RTTIDemoMain.dfm
new file mode 100644
index 0000000..dd998b3
--- /dev/null
+++ b/official/1.104/examples/common/rtti/RTTIDemoMain.dfm
@@ -0,0 +1,71 @@
+object Form1: TForm1
+ Left = 98
+ Top = 153
+ ClientWidth = 967
+ ClientHeight = 440
+ 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.104/examples/common/rtti/RTTIDemoMain.pas b/official/1.104/examples/common/rtti/RTTIDemoMain.pas
new file mode 100644
index 0000000..d87c17f
--- /dev/null
+++ b/official/1.104/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.104/examples/common/rtti/RTTIExample.dof b/official/1.104/examples/common/rtti/RTTIExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/common/rtti/RTTIExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/common/rtti/RTTIExample.dpr b/official/1.104/examples/common/rtti/RTTIExample.dpr
new file mode 100644
index 0000000..5981f58
--- /dev/null
+++ b/official/1.104/examples/common/rtti/RTTIExample.dpr
@@ -0,0 +1,16 @@
+program RTTIExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ RTTIDemoMain in 'RTTIDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/rtti/RTTIExample.res b/official/1.104/examples/common/rtti/RTTIExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/common/rtti/RTTIExample.res differ
diff --git a/official/1.104/examples/common/sysinfo/EnvironmentExample.dof b/official/1.104/examples/common/sysinfo/EnvironmentExample.dof
new file mode 100644
index 0000000..b13ef5f
--- /dev/null
+++ b/official/1.104/examples/common/sysinfo/EnvironmentExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=../../../bin
+
diff --git a/official/1.104/examples/common/sysinfo/EnvironmentExample.dpr b/official/1.104/examples/common/sysinfo/EnvironmentExample.dpr
new file mode 100644
index 0000000..825d34c
--- /dev/null
+++ b/official/1.104/examples/common/sysinfo/EnvironmentExample.dpr
@@ -0,0 +1,16 @@
+program EnvironmentExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ EnvironmentExampleMain in 'EnvironmentExampleMain.pas' {Form1};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/sysinfo/EnvironmentExample.res b/official/1.104/examples/common/sysinfo/EnvironmentExample.res
new file mode 100644
index 0000000..0930265
Binary files /dev/null and b/official/1.104/examples/common/sysinfo/EnvironmentExample.res differ
diff --git a/official/1.104/examples/common/sysinfo/EnvironmentExampleMain.dfm b/official/1.104/examples/common/sysinfo/EnvironmentExampleMain.dfm
new file mode 100644
index 0000000..5c38237
--- /dev/null
+++ b/official/1.104/examples/common/sysinfo/EnvironmentExampleMain.dfm
@@ -0,0 +1,34 @@
+object Form1: TForm1
+ Left = 228
+ Top = 165
+ Width = 729
+ Height = 540
+ ActiveControl = EnvironmentView
+ Caption = 'Environment Variables'
+ 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
+ TabOrder = 0
+ ViewStyle = vsReport
+ end
+end
diff --git a/official/1.104/examples/common/sysinfo/EnvironmentExampleMain.pas b/official/1.104/examples/common/sysinfo/EnvironmentExampleMain.pas
new file mode 100644
index 0000000..e5e5ce5
--- /dev/null
+++ b/official/1.104/examples/common/sysinfo/EnvironmentExampleMain.pas
@@ -0,0 +1,76 @@
+unit EnvironmentExampleMain;
+
+interface
+
+uses
+ SysUtils, Classes, Controls, Forms, ComCtrls,
+ 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 *.dfm}
+
+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.104/examples/common/textconverter/TextConverter.dof b/official/1.104/examples/common/textconverter/TextConverter.dof
new file mode 100644
index 0000000..b13ef5f
--- /dev/null
+++ b/official/1.104/examples/common/textconverter/TextConverter.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=../../../bin
+
diff --git a/official/1.104/examples/common/textconverter/TextConverter.dpr b/official/1.104/examples/common/textconverter/TextConverter.dpr
new file mode 100644
index 0000000..88a82e0
--- /dev/null
+++ b/official/1.104/examples/common/textconverter/TextConverter.dpr
@@ -0,0 +1,13 @@
+program TextConverter;
+
+uses
+ Forms,
+ TextConverterMain in 'TextConverterMain.pas' {Form1};
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/textconverter/TextConverter.res b/official/1.104/examples/common/textconverter/TextConverter.res
new file mode 100644
index 0000000..b5c859f
Binary files /dev/null and b/official/1.104/examples/common/textconverter/TextConverter.res differ
diff --git a/official/1.104/examples/common/textconverter/TextConverterMain.dfm b/official/1.104/examples/common/textconverter/TextConverterMain.dfm
new file mode 100644
index 0000000..80873f2
--- /dev/null
+++ b/official/1.104/examples/common/textconverter/TextConverterMain.dfm
@@ -0,0 +1,141 @@
+object Form1: TForm1
+ Left = 438
+ Top = 259
+ BorderStyle = bsDialog
+ Caption = 'Form1'
+ ClientHeight = 173
+ ClientWidth = 375
+ 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 ButtonAnsiToAnsi: TButton
+ Left = 16
+ Top = 16
+ Width = 105
+ Height = 25
+ Caption = 'Ansi --> Ansi'
+ Enabled = False
+ TabOrder = 0
+ end
+ object ButtonAnsiToUTF8: TButton
+ Left = 136
+ Top = 16
+ Width = 105
+ Height = 25
+ Caption = 'Ansi --> UTF8'
+ TabOrder = 1
+ OnClick = ButtonAnsiToUTF8Click
+ end
+ object ButtonAnsiToUTF16: TButton
+ Left = 256
+ Top = 16
+ Width = 105
+ Height = 25
+ Caption = 'Ansi --> UTF16'
+ TabOrder = 2
+ OnClick = ButtonAnsiToUTF16Click
+ end
+ object ButtonUTF8ToAnsi: TButton
+ Left = 16
+ Top = 56
+ Width = 105
+ Height = 25
+ Caption = 'UTF8 --> Ansi'
+ TabOrder = 3
+ OnClick = ButtonUTF8ToAnsiClick
+ end
+ object ButtonUTF8ToUTF8: TButton
+ Left = 136
+ Top = 56
+ Width = 105
+ Height = 25
+ Caption = 'UTF8 --> UTF8'
+ Enabled = False
+ TabOrder = 4
+ end
+ object ButtonUTF8ToUTF16: TButton
+ Left = 256
+ Top = 56
+ Width = 105
+ Height = 25
+ Caption = 'UTF8 --> UTF16'
+ TabOrder = 5
+ OnClick = ButtonUTF8ToUTF16Click
+ end
+ object ButtonUTF16ToAnsi: TButton
+ Left = 16
+ Top = 96
+ Width = 105
+ Height = 25
+ Caption = 'UTF16 --> Ansi'
+ TabOrder = 6
+ OnClick = ButtonUTF16ToAnsiClick
+ end
+ object ButtonUTF16ToUTF8: TButton
+ Left = 136
+ Top = 96
+ Width = 105
+ Height = 25
+ Caption = 'UTF16 --> UTF8'
+ TabOrder = 7
+ OnClick = ButtonUTF16ToUTF8Click
+ end
+ object ButtonUTF16ToUTF16: TButton
+ Left = 256
+ Top = 96
+ Width = 105
+ Height = 25
+ Caption = 'UTF16 --> UTF16'
+ Enabled = False
+ TabOrder = 8
+ end
+ object ButtonAutoToAnsi: TButton
+ Left = 16
+ Top = 136
+ Width = 105
+ Height = 25
+ Caption = 'Auto --> Ansi'
+ TabOrder = 9
+ OnClick = ButtonAutoToAnsiClick
+ end
+ object ButtonAutoToUTF8: TButton
+ Left = 136
+ Top = 136
+ Width = 105
+ Height = 25
+ Caption = 'Auto --> UTF8'
+ TabOrder = 10
+ OnClick = ButtonAutoToUTF8Click
+ end
+ object ButtonAutoToUTF16: TButton
+ Left = 256
+ Top = 136
+ Width = 105
+ Height = 25
+ Caption = 'Auto --> UTF16'
+ TabOrder = 11
+ OnClick = ButtonAutoToUTF16Click
+ end
+ object OpenDialogTxt: TOpenDialog
+ DefaultExt = 'txt'
+ Filter = 'Text files (*.txt)|*.txt|All files (*.*)|*.*'
+ Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Title = 'Text file to convert...'
+ Left = 88
+ Top = 48
+ end
+ object SaveDialogTxt: TSaveDialog
+ DefaultExt = 'txt'
+ Filter = 'Text files (*.txt)|*.txt|All files (*.*)|*.*'
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing]
+ Title = 'Save result as...'
+ Left = 128
+ Top = 48
+ end
+end
diff --git a/official/1.104/examples/common/textconverter/TextConverterMain.pas b/official/1.104/examples/common/textconverter/TextConverterMain.pas
new file mode 100644
index 0000000..ab2b027
--- /dev/null
+++ b/official/1.104/examples/common/textconverter/TextConverterMain.pas
@@ -0,0 +1,146 @@
+unit TextConverterMain;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls,
+ JclStreams;
+
+type
+ TForm1 = class(TForm)
+ ButtonAnsiToAnsi: TButton;
+ ButtonAnsiToUTF8: TButton;
+ ButtonAnsiToUTF16: TButton;
+ ButtonUTF8ToAnsi: TButton;
+ ButtonUTF8ToUTF8: TButton;
+ ButtonUTF8ToUTF16: TButton;
+ ButtonUTF16ToAnsi: TButton;
+ ButtonUTF16ToUTF8: TButton;
+ ButtonUTF16ToUTF16: TButton;
+ OpenDialogTxt: TOpenDialog;
+ SaveDialogTxt: TSaveDialog;
+ ButtonAutoToAnsi: TButton;
+ ButtonAutoToUTF8: TButton;
+ ButtonAutoToUTF16: TButton;
+ procedure ButtonAnsiToUTF8Click(Sender: TObject);
+ procedure ButtonAnsiToUTF16Click(Sender: TObject);
+ procedure ButtonUTF8ToAnsiClick(Sender: TObject);
+ procedure ButtonUTF8ToUTF16Click(Sender: TObject);
+ procedure ButtonUTF16ToAnsiClick(Sender: TObject);
+ procedure ButtonUTF16ToUTF8Click(Sender: TObject);
+ procedure ButtonAutoToAnsiClick(Sender: TObject);
+ procedure ButtonAutoToUTF8Click(Sender: TObject);
+ procedure ButtonAutoToUTF16Click(Sender: TObject);
+ private
+ public
+ procedure ConvertFile(ReaderClass, WriterClass: TJclStringStreamClass);
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+uses
+ JclStrings, JclFileUtils;
+
+{$R *.dfm}
+
+procedure TForm1.ButtonAnsiToUTF8Click(Sender: TObject);
+begin
+ ConvertFile(TJclAnsiStream, TJclUTF8Stream);
+end;
+
+procedure TForm1.ButtonAutoToAnsiClick(Sender: TObject);
+begin
+ ConvertFile(TJclAutoStream, TJclAnsiStream);
+end;
+
+procedure TForm1.ButtonAutoToUTF16Click(Sender: TObject);
+begin
+ ConvertFile(TJclAutoStream, TJclUTF16Stream);
+end;
+
+procedure TForm1.ButtonAutoToUTF8Click(Sender: TObject);
+begin
+ ConvertFile(TJclAutoStream, TJclUTF8Stream);
+end;
+
+procedure TForm1.ButtonAnsiToUTF16Click(Sender: TObject);
+begin
+ ConvertFile(TJclAnsiStream, TJclUTF16Stream);
+end;
+
+procedure TForm1.ButtonUTF8ToAnsiClick(Sender: TObject);
+begin
+ ConvertFile(TJclUTF8Stream, TJclAnsiStream);
+end;
+
+procedure TForm1.ButtonUTF8ToUTF16Click(Sender: TObject);
+begin
+ ConvertFile(TJclUTF8Stream, TJclUTF16Stream);
+end;
+
+procedure TForm1.ButtonUTF16ToAnsiClick(Sender: TObject);
+begin
+ ConvertFile(TJclUTF16Stream, TJclAnsiStream);
+end;
+
+procedure TForm1.ButtonUTF16ToUTF8Click(Sender: TObject);
+begin
+ ConvertFile(TJclUTF16Stream, TJclUTF8Stream);
+end;
+
+procedure TForm1.ConvertFile(ReaderClass,
+ WriterClass: TJclStringStreamClass);
+ procedure ConvertFiles(const SourceFileName, DestFileName: TFileName);
+ var
+ SourceStream, DestStream: TStream;
+ Reader, Writer: TJclStringStream;
+ begin
+ SourceStream := TFileStream.Create(SourceFileName, fmOpenRead or fmShareDenyWrite);
+ try
+ DestStream := TFileStream.Create(DestFileName, fmCreate or fmShareExclusive);
+ try
+ Reader := ReaderClass.Create(SourceStream, False);
+ try
+ Writer := WriterClass.Create(DestStream, False);
+ try
+ Reader.SkipBOM;
+ Writer.WriteBOM;
+ JclStreams.WideStringStreamCopy(Reader, Writer);
+ Writer.Flush;
+ finally
+ Writer.Free;
+ end;
+ finally
+ Reader.Free;
+ end;
+ finally
+ DestStream.Free;
+ end;
+ finally
+ SourceStream.Free;
+ end;
+ end;
+var
+ SourceFileName, DestFileName, TmpFileName: TFileName;
+begin
+ if OpenDialogTxt.Execute and SaveDialogTxt.Execute then
+ begin
+ SourceFileName := OpenDialogTxt.FileName;
+ DestFileName := SaveDialogTxt.FileName;
+ if StrSame(SourceFileName, DestFileName) then
+ begin
+ // in place conversion
+ TmpFileName := FileGetTempName('');
+ ConvertFiles(SourceFileName, TmpFileName);
+ FileMove(TmpFileName, DestFileName, True);
+ end
+ else
+ ConvertFiles(SourceFileName, DestFileName);
+ end;
+end;
+
+end.
diff --git a/official/1.104/examples/common/textreader/TextReaderDemoMain.dfm b/official/1.104/examples/common/textreader/TextReaderDemoMain.dfm
new file mode 100644
index 0000000..02ce337
--- /dev/null
+++ b/official/1.104/examples/common/textreader/TextReaderDemoMain.dfm
@@ -0,0 +1,94 @@
+object MainForm: TMainForm
+ Left = 275
+ Top = 163
+ ClientWidth = 763
+ ClientHeight = 605
+ 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.104/examples/common/textreader/TextReaderDemoMain.pas b/official/1.104/examples/common/textreader/TextReaderDemoMain.pas
new file mode 100644
index 0000000..2ec2788
--- /dev/null
+++ b/official/1.104/examples/common/textreader/TextReaderDemoMain.pas
@@ -0,0 +1,152 @@
+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: TJclAnsiMappedTextReader;
+ 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 := TJclAnsiMappedTextReader.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
+ Item.Caption := string(FTextReader.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: TJclAnsiMappedTextReader;
+ SL: TStringList;
+ T: TextFile;
+begin
+ if FFileName = '' then
+ Exit;
+ Screen.Cursor := crHourGlass;
+ try
+ ClearLabels;
+ // TJclAnsiMappedTextReader
+ LineCount := 0;
+ StartCount(C);
+ Reader := TJclAnsiMappedTextReader.Create(FFileName);
+ try
+ Reader.GoBegin;
+ while not Reader.Eof do
+ begin
+ S := string(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, TJclAnsiMappedTextReader: %.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.104/examples/common/textreader/TextReaderExample.dof b/official/1.104/examples/common/textreader/TextReaderExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/common/textreader/TextReaderExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/common/textreader/TextReaderExample.dpr b/official/1.104/examples/common/textreader/TextReaderExample.dpr
new file mode 100644
index 0000000..e4ec087
--- /dev/null
+++ b/official/1.104/examples/common/textreader/TextReaderExample.dpr
@@ -0,0 +1,16 @@
+program TextReaderExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ TextReaderDemoMain in 'TextReaderDemoMain.pas' {MainForm};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/textreader/TextReaderExample.res b/official/1.104/examples/common/textreader/TextReaderExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/common/textreader/TextReaderExample.res differ
diff --git a/official/1.104/examples/common/unitversioning/UnitVersioningTest.dof b/official/1.104/examples/common/unitversioning/UnitVersioningTest.dof
new file mode 100644
index 0000000..a45efdc
--- /dev/null
+++ b/official/1.104/examples/common/unitversioning/UnitVersioningTest.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=..\..\..\bin
\ No newline at end of file
diff --git a/official/1.104/examples/common/unitversioning/UnitVersioningTest.dpr b/official/1.104/examples/common/unitversioning/UnitVersioningTest.dpr
new file mode 100644
index 0000000..fe79e66
--- /dev/null
+++ b/official/1.104/examples/common/unitversioning/UnitVersioningTest.dpr
@@ -0,0 +1,46 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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: 2007-04-18 19:27:51 +0200 (mer., 18 avr. 2007) $
+
+program UnitVersioningTest;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ UnitVersioningTestMain in 'UnitVersioningTestMain.pas' {frmUnitVersioningTestMain};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TfrmUnitVersioningTestMain, frmUnitVersioningTestMain);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/common/unitversioning/UnitVersioningTest.res b/official/1.104/examples/common/unitversioning/UnitVersioningTest.res
new file mode 100644
index 0000000..b111060
Binary files /dev/null and b/official/1.104/examples/common/unitversioning/UnitVersioningTest.res differ
diff --git a/official/1.104/examples/common/unitversioning/UnitVersioningTestDLL.dof b/official/1.104/examples/common/unitversioning/UnitVersioningTestDLL.dof
new file mode 100644
index 0000000..a45efdc
--- /dev/null
+++ b/official/1.104/examples/common/unitversioning/UnitVersioningTestDLL.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=..\..\..\bin
\ No newline at end of file
diff --git a/official/1.104/examples/common/unitversioning/UnitVersioningTestDLL.dpr b/official/1.104/examples/common/unitversioning/UnitVersioningTestDLL.dpr
new file mode 100644
index 0000000..c1662a6
--- /dev/null
+++ b/official/1.104/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: 2006-05-18 18:04:47 +0200 (jeu., 18 mai 2006) $
+
+library UnitVersioningTestDLL;
+
+{$I jcl.inc}
+
+uses
+ JclUnitVersioning;
+
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$RCSfile$';
+ Revision: '$Revision: 1658 $';
+ Date: '$Date: 2006-05-18 18:04:47 +0200 (jeu., 18 mai 2006) $';
+ LogPath: '';
+ );
+
+begin
+ RegisterUnitVersion(HInstance, UnitVersioning);
+end.
diff --git a/official/1.104/examples/common/unitversioning/UnitVersioningTestMain.dfm b/official/1.104/examples/common/unitversioning/UnitVersioningTestMain.dfm
new file mode 100644
index 0000000..3f880f1
--- /dev/null
+++ b/official/1.104/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.104/examples/common/unitversioning/UnitVersioningTestMain.pas b/official/1.104/examples/common/unitversioning/UnitVersioningTestMain.pas
new file mode 100644
index 0000000..c48fb4e
--- /dev/null
+++ b/official/1.104/examples/common/unitversioning/UnitVersioningTestMain.pas
@@ -0,0 +1,290 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $
+
+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;
+
+end.
diff --git a/official/1.104/examples/dotnet/JCLNetDemo/AssemblyInfo.cs b/official/1.104/examples/dotnet/JCLNetDemo/AssemblyInfo.cs
new file mode 100644
index 0000000..b67641b
--- /dev/null
+++ b/official/1.104/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 gehrenden Informationen zu modifizieren.
+//
+[assembly: AssemblyTitle("")]
+[assembly: AssemblyDescription("")]
+[assembly: AssemblyConfiguration("")]
+[assembly: AssemblyCompany("")]
+[assembly: AssemblyProduct("")]
+[assembly: AssemblyCopyright("")]
+[assembly: AssemblyTrademark("")]
+[assembly: AssemblyCulture("")]
+
+// Die Versionsinformation einer Assemblierung enthlt die folgenden vier Werte:
+// Hauptversion
+// Nebenversion
+// Build-Nummer
+// Revision
+// Sie knnen alle vier Werte festlegen oder fr Revision und Build-Nummer die
+// Standardwerte mit '*' - wie nachfolgend gezeigt - verwenden:
+
+[assembly: AssemblyVersion("1.0.*")]
+
+//
+// Zum Signieren einer Assemblierung mssen Sie einen Schlssel angeben. Weitere Informationen
+// ber das Signieren von Assemblierungen finden Sie in der Microsoft .NET Framework-Dokumentation.
+// Mit den folgenden Attributen steuern Sie, welcher Schlssel fr die Signatur verwendet wird.
+// Hinweise:
+// (*) Wenn kein Schlssel angegeben wird, ist die Assemblierung nicht signiert.
+// (*) KeyName verweist auf einen Schlssel, der im Crypto Service Provider
+// (CSP) auf Ihrem Rechner installiert wurde. KeyFile verweist auf eine
+// Datei, die einen Schlssel enthlt.
+// (*) Wenn sowohl der KeyFile- als auch der KeyName-Wert angegeben ist, wird
+// die folgende Verarbeitung durchgefhrt:
+// (1) Wenn KeyName in dem CSP gefunden wird, wird dieser Schlssel verwendet.
+// (2) Wenn KeyName nicht, aber KeyFile vorhanden ist, wird der Schlssel
+// in KeyFile im CSP installiert und verwendet.
+// (*) Ein KeyFile knnen 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, wrden Sie das Attribut
+// AssemblyKeyFile folgendermaen festlegen:
+// [assembly: AssemblyKeyFile("..\\..\\mykey.snk")]
+// (*) Verzgerte Signatur ist eine erweiterte Option; nhere 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.
+// Standardmig ist die gesamte Assemblierung fr COM sichtbar. Die Einstellung false fr ComVisible
+// ist die fr Ihre Assemblierung empfohlene Vorgabe. Um dann eine Klasse und ein Interface fr COM
+// bereitzustellen, setzen Sie jeweils ComVisible auf true. Es wird auch empfohlen das Attribut
+// Guid hinzuzufgen.
+//
+
+[assembly: ComVisible(false)]
+//[assembly: Guid("")]
+//[assembly: TypeLibVersion(1, 0)]
+
diff --git a/official/1.104/examples/dotnet/JCLNetDemo/JCLNet.FrmMain.resources b/official/1.104/examples/dotnet/JCLNetDemo/JCLNet.FrmMain.resources
new file mode 100644
index 0000000..791098b
Binary files /dev/null and b/official/1.104/examples/dotnet/JCLNetDemo/JCLNet.FrmMain.resources differ
diff --git a/official/1.104/examples/dotnet/JCLNetDemo/JCLNet.WinForm.resources b/official/1.104/examples/dotnet/JCLNetDemo/JCLNet.WinForm.resources
new file mode 100644
index 0000000..35b0574
Binary files /dev/null and b/official/1.104/examples/dotnet/JCLNetDemo/JCLNet.WinForm.resources differ
diff --git a/official/1.104/examples/dotnet/JCLNetDemo/JCLNet.bdsproj b/official/1.104/examples/dotnet/JCLNetDemo/JCLNet.bdsproj
new file mode 100644
index 0000000..018f089
--- /dev/null
+++ b/official/1.104/examples/dotnet/JCLNetDemo/JCLNet.bdsproj
@@ -0,0 +1,102 @@
+
+
+
+
+ CSharp.Personality
+ Application
+ 1.0
+ {E9F18793-8EBC-4D0B-AE38-4970CE0A0826}
+
+
+
+
+
+ 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.104/examples/dotnet/JCLNetDemo/WinForm.cs b/official/1.104/examples/dotnet/JCLNetDemo/WinForm.cs
new file mode 100644
index 0000000..4d5c6b7
--- /dev/null
+++ b/official/1.104/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 fr 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 fr die Untersttzung des Windows-Form-Designer
+ //
+ InitializeComponent();
+
+ //
+ // TODO: Konstruktorcode nach dem Aufruf von InitializeComponent hinzufgen
+ //
+ }
+
+ ///
+ /// 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 Untersttzung 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 fr 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.104/examples/dotnet/JCLNetDemo/WinForm.resx b/official/1.104/examples/dotnet/JCLNetDemo/WinForm.resx
new file mode 100644
index 0000000..d42084d
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/ConsoleExamples.dof b/official/1.104/examples/windows/ConsoleExamples.dof
new file mode 100644
index 0000000..27cbb59
--- /dev/null
+++ b/official/1.104/examples/windows/ConsoleExamples.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\bin
+SearchPath=$(DELPHI)\Lib\Debug;
diff --git a/official/1.104/examples/windows/ConsoleExamples.dpr b/official/1.104/examples/windows/ConsoleExamples.dpr
new file mode 100644
index 0000000..f21652b
--- /dev/null
+++ b/official/1.104/examples/windows/ConsoleExamples.dpr
@@ -0,0 +1,409 @@
+program ConsoleExamples;
+
+{$APPTYPE CONSOLE}
+
+{$I jcl.inc}
+{$IFDEF SUPPORTS_PLATFORM_WARNINGS}
+ {$WARN SYMBOL_PLATFORM OFF}
+{$ENDIF SUPPORTS_PLATFORM_WARNINGS}
+
+uses
+ SysUtils,
+ Windows,
+ TypInfo,
+ JclConsole;
+
+{$R ..\..\source\windows\JclNoDepAsInvoker.res}
+
+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.104/examples/windows/appinst/AppInstDemoMain.dfm b/official/1.104/examples/windows/appinst/AppInstDemoMain.dfm
new file mode 100644
index 0000000..5a11a5c
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/appinst/AppInstDemoMain.pas b/official/1.104/examples/windows/appinst/AppInstDemoMain.pas
new file mode 100644
index 0000000..422071b
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/appinst/AppInstExample.dof b/official/1.104/examples/windows/appinst/AppInstExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/appinst/AppInstExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/appinst/AppInstExample.dpr b/official/1.104/examples/windows/appinst/AppInstExample.dpr
new file mode 100644
index 0000000..039499b
--- /dev/null
+++ b/official/1.104/examples/windows/appinst/AppInstExample.dpr
@@ -0,0 +1,16 @@
+program AppInstExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ AppInstDemoMain in 'AppInstDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/appinst/AppInstExample.res b/official/1.104/examples/windows/appinst/AppInstExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/appinst/AppInstExample.res differ
diff --git a/official/1.104/examples/windows/appinst/SingleInstDemoMain.dfm b/official/1.104/examples/windows/appinst/SingleInstDemoMain.dfm
new file mode 100644
index 0000000..b61255e
--- /dev/null
+++ b/official/1.104/examples/windows/appinst/SingleInstDemoMain.dfm
@@ -0,0 +1,25 @@
+object Form1: TForm1
+ Left = 194
+ Top = 107
+ ClientWidth = 270
+ ClientHeight = 145
+ 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.104/examples/windows/appinst/SingleInstDemoMain.pas b/official/1.104/examples/windows/appinst/SingleInstDemoMain.pas
new file mode 100644
index 0000000..1344a63
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/appinst/SingleInstExample.dof b/official/1.104/examples/windows/appinst/SingleInstExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/appinst/SingleInstExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/appinst/SingleInstExample.dpr b/official/1.104/examples/windows/appinst/SingleInstExample.dpr
new file mode 100644
index 0000000..1160492
--- /dev/null
+++ b/official/1.104/examples/windows/appinst/SingleInstExample.dpr
@@ -0,0 +1,18 @@
+program SingleInstExample;
+
+{$I jcl.inc}
+
+uses
+ JclAppInst, // Added JclAppInst unit
+ Forms,
+ SingleInstDemoMain in 'SingleInstDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ JclAppInstances.CheckSingleInstance; // Added instance checking
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/appinst/SingleInstExample.res b/official/1.104/examples/windows/appinst/SingleInstExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/appinst/SingleInstExample.res differ
diff --git a/official/1.104/examples/windows/asuser/CreateProcAsUserDemoMain.dfm b/official/1.104/examples/windows/asuser/CreateProcAsUserDemoMain.dfm
new file mode 100644
index 0000000..99ef677
--- /dev/null
+++ b/official/1.104/examples/windows/asuser/CreateProcAsUserDemoMain.dfm
@@ -0,0 +1,194 @@
+object Form1: TForm1
+ Left = 386
+ Top = 230
+ ClientWidth = 390
+ ClientHeight = 344
+ 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.104/examples/windows/asuser/CreateProcAsUserDemoMain.pas b/official/1.104/examples/windows/asuser/CreateProcAsUserDemoMain.pas
new file mode 100644
index 0000000..1b84f54
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/asuser/CreateProcAsUserExample.dof b/official/1.104/examples/windows/asuser/CreateProcAsUserExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/asuser/CreateProcAsUserExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/asuser/CreateProcAsUserExample.dpr b/official/1.104/examples/windows/asuser/CreateProcAsUserExample.dpr
new file mode 100644
index 0000000..d78c9e5
--- /dev/null
+++ b/official/1.104/examples/windows/asuser/CreateProcAsUserExample.dpr
@@ -0,0 +1,17 @@
+program CreateProcAsUserExample;
+
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ CreateProcAsUserDemoMain in 'CreateProcAsUserDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/asuser/CreateProcAsUserExample.res b/official/1.104/examples/windows/asuser/CreateProcAsUserExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/asuser/CreateProcAsUserExample.res differ
diff --git a/official/1.104/examples/windows/clr/ClrDemo.dof b/official/1.104/examples/windows/clr/ClrDemo.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/clr/ClrDemo.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/clr/ClrDemo.dpr b/official/1.104/examples/windows/clr/ClrDemo.dpr
new file mode 100644
index 0000000..8ec09f3
--- /dev/null
+++ b/official/1.104/examples/windows/clr/ClrDemo.dpr
@@ -0,0 +1,24 @@
+program ClrDemo;
+
+{$I jcl.inc}
+
+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}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TfrmMain, frmMain);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/clr/ClrDemo.res b/official/1.104/examples/windows/clr/ClrDemo.res
new file mode 100644
index 0000000..82939cc
Binary files /dev/null and b/official/1.104/examples/windows/clr/ClrDemo.res differ
diff --git a/official/1.104/examples/windows/clr/ClrDemoAbstractFrame.dfm b/official/1.104/examples/windows/clr/ClrDemoAbstractFrame.dfm
new file mode 100644
index 0000000..8252c1c
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoAbstractFrame.pas b/official/1.104/examples/windows/clr/ClrDemoAbstractFrame.pas
new file mode 100644
index 0000000..2c49099
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoBlobForm.dfm b/official/1.104/examples/windows/clr/ClrDemoBlobForm.dfm
new file mode 100644
index 0000000..cd4bb39
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoBlobForm.pas b/official/1.104/examples/windows/clr/ClrDemoBlobForm.pas
new file mode 100644
index 0000000..ef8bf69
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoCLRFrame.dfm b/official/1.104/examples/windows/clr/ClrDemoCLRFrame.dfm
new file mode 100644
index 0000000..99dd6f2
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoCLRFrame.pas b/official/1.104/examples/windows/clr/ClrDemoCLRFrame.pas
new file mode 100644
index 0000000..38da0e0
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoGuidForm.dfm b/official/1.104/examples/windows/clr/ClrDemoGuidForm.dfm
new file mode 100644
index 0000000..252c632
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoGuidForm.pas b/official/1.104/examples/windows/clr/ClrDemoGuidForm.pas
new file mode 100644
index 0000000..0814a97
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoMain.dfm b/official/1.104/examples/windows/clr/ClrDemoMain.dfm
new file mode 100644
index 0000000..4566ad1
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoMain.pas b/official/1.104/examples/windows/clr/ClrDemoMain.pas
new file mode 100644
index 0000000..a0687c3
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoMetaDataFrame.dfm b/official/1.104/examples/windows/clr/ClrDemoMetaDataFrame.dfm
new file mode 100644
index 0000000..da945dc
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoMetaDataFrame.pas b/official/1.104/examples/windows/clr/ClrDemoMetaDataFrame.pas
new file mode 100644
index 0000000..e1e4264
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoStringsForm.dfm b/official/1.104/examples/windows/clr/ClrDemoStringsForm.dfm
new file mode 100644
index 0000000..6803682
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoStringsForm.pas b/official/1.104/examples/windows/clr/ClrDemoStringsForm.pas
new file mode 100644
index 0000000..a9364bf
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoTableForm.dfm b/official/1.104/examples/windows/clr/ClrDemoTableForm.dfm
new file mode 100644
index 0000000..1106400
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoTableForm.pas b/official/1.104/examples/windows/clr/ClrDemoTableForm.pas
new file mode 100644
index 0000000..65f384f
--- /dev/null
+++ b/official/1.104/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, JclSysUtils, 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.104/examples/windows/clr/ClrDemoUserStringsForm.dfm b/official/1.104/examples/windows/clr/ClrDemoUserStringsForm.dfm
new file mode 100644
index 0000000..9630d9b
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/clr/ClrDemoUserStringsForm.pas b/official/1.104/examples/windows/clr/ClrDemoUserStringsForm.pas
new file mode 100644
index 0000000..8bde438
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/compression/archive/ArchiveDemo.dof b/official/1.104/examples/windows/compression/archive/ArchiveDemo.dof
new file mode 100644
index 0000000..e957ac9
--- /dev/null
+++ b/official/1.104/examples/windows/compression/archive/ArchiveDemo.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\..\bin
+
diff --git a/official/1.104/examples/windows/compression/archive/ArchiveDemo.dpr b/official/1.104/examples/windows/compression/archive/ArchiveDemo.dpr
new file mode 100644
index 0000000..251bbc1
--- /dev/null
+++ b/official/1.104/examples/windows/compression/archive/ArchiveDemo.dpr
@@ -0,0 +1,15 @@
+program ArchiveDemo;
+
+uses
+ Forms,
+ UMain in 'UMain.pas' {FormMain},
+ UProperties in 'UProperties.pas' {FormArchiveSettings};
+
+{$R *.res}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TFormMain, FormMain);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/compression/archive/ArchiveDemo.res b/official/1.104/examples/windows/compression/archive/ArchiveDemo.res
new file mode 100644
index 0000000..119d171
Binary files /dev/null and b/official/1.104/examples/windows/compression/archive/ArchiveDemo.res differ
diff --git a/official/1.104/examples/windows/compression/archive/UMain.dfm b/official/1.104/examples/windows/compression/archive/UMain.dfm
new file mode 100644
index 0000000..6bdf66f
--- /dev/null
+++ b/official/1.104/examples/windows/compression/archive/UMain.dfm
@@ -0,0 +1,359 @@
+object FormMain: TFormMain
+ Left = 0
+ Top = 0
+ Caption = 'FormMain'
+ ClientHeight = 301
+ ClientWidth = 771
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ PixelsPerInch = 96
+ TextHeight = 13
+ object ListView1: TListView
+ Left = 0
+ Top = 81
+ Width = 771
+ Height = 204
+ Align = alClient
+ Columns = <
+ item
+ Caption = 'Local name'
+ Width = 150
+ end
+ item
+ Caption = 'Archive name'
+ Width = 150
+ end
+ item
+ Caption = 'Size'
+ Width = 30
+ end
+ item
+ Caption = 'Compressed'
+ Width = 30
+ end
+ item
+ Caption = 'Creation'
+ end
+ item
+ Caption = 'Last access'
+ end
+ item
+ Caption = 'Last write'
+ end
+ item
+ Caption = 'Comment'
+ Width = 30
+ end
+ item
+ Caption = 'OS'
+ Width = 20
+ end
+ item
+ Caption = 'FS'
+ Width = 20
+ end
+ item
+ Caption = 'User'
+ Width = 20
+ end
+ item
+ Caption = 'Group'
+ Width = 20
+ end
+ item
+ Caption = 'CRC'
+ end>
+ MultiSelect = True
+ OwnerData = True
+ RowSelect = True
+ TabOrder = 0
+ ViewStyle = vsReport
+ OnData = ListView1Data
+ end
+ object ProgressBar1: TProgressBar
+ Left = 0
+ Top = 285
+ Width = 771
+ Height = 16
+ Align = alBottom
+ TabOrder = 1
+ end
+ object PageControl1: TPageControl
+ Left = 0
+ Top = 0
+ Width = 771
+ Height = 81
+ ActivePage = TabSheetReadOnly
+ Align = alTop
+ TabOrder = 2
+ object TabSheetReadOnly: TTabSheet
+ Caption = 'Read-only'
+ object ButtonOpen: TButton
+ Left = 16
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionOpenRO
+ TabOrder = 0
+ end
+ object ButtonExtractSelected: TButton
+ Left = 97
+ Top = 16
+ Width = 96
+ Height = 25
+ Action = ActionExtractSelectedRO
+ TabOrder = 1
+ end
+ object ButtonExtractAll: TButton
+ Left = 199
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionExtractAllRO
+ TabOrder = 2
+ end
+ object ButtonROProperties: TButton
+ Left = 280
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionProperties
+ TabOrder = 3
+ end
+ end
+ object TabSheetWriteOnly: TTabSheet
+ Caption = 'Write-only'
+ ImageIndex = 1
+ object ButtonNew: TButton
+ Left = 16
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionNewWO
+ TabOrder = 0
+ end
+ object ButtonAddFile: TButton
+ Left = 97
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionAddFile
+ TabOrder = 1
+ end
+ object ButtonAddDirectory: TButton
+ Left = 178
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionAddDirectory
+ TabOrder = 2
+ end
+ object ButtonSave: TButton
+ Left = 259
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionSave
+ TabOrder = 3
+ end
+ object ButtonPropertiesWO: TButton
+ Left = 340
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionProperties
+ TabOrder = 4
+ end
+ end
+ object TabSheetReadWrite: TTabSheet
+ Caption = 'Read and write'
+ ImageIndex = 2
+ object ButtonNewRW: TButton
+ Left = 16
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionNewRW
+ TabOrder = 0
+ end
+ object ButtonOpenRW: TButton
+ Left = 97
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionOpenRW
+ TabOrder = 1
+ end
+ object ButtonDeleteRW: TButton
+ Left = 178
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionDeleteRW
+ TabOrder = 2
+ end
+ object ButtonAddFileRW: TButton
+ Left = 259
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionAddFile
+ TabOrder = 3
+ end
+ object ButtonAddDirectoryRW: TButton
+ Left = 340
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionAddDirectory
+ TabOrder = 4
+ end
+ object ButtonExtractSelectedRW: TButton
+ Left = 421
+ Top = 16
+ Width = 92
+ Height = 25
+ Action = ActionExtractSelectedRO
+ TabOrder = 5
+ end
+ object ButtonExtractAllRW: TButton
+ Left = 519
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionExtractAllRO
+ TabOrder = 6
+ end
+ object ButtonSaveRW: TButton
+ Left = 600
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionSave
+ TabOrder = 7
+ end
+ object ButtonPropertiesRW: TButton
+ Left = 681
+ Top = 16
+ Width = 75
+ Height = 25
+ Action = ActionProperties
+ TabOrder = 8
+ end
+ end
+ end
+ object ActionList1: TActionList
+ Left = 64
+ Top = 152
+ object ActionOpenRO: TAction
+ Category = 'ReadOnly'
+ Caption = '&Open'
+ OnExecute = ActionOpenROExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionExtractSelectedRO: TAction
+ Category = 'ReadOnly'
+ Caption = '&Extract selected'
+ OnExecute = ActionExtractSelectedROExecute
+ OnUpdate = ActionExtractSelectedROUpdate
+ end
+ object ActionExtractAllRO: TAction
+ Category = 'ReadOnly'
+ Caption = 'Extract &all'
+ OnExecute = ActionExtractAllROExecute
+ OnUpdate = ActionExtractAllROUpdate
+ end
+ object ActionNewWO: TAction
+ Category = 'WriteOnly'
+ Caption = '&New'
+ OnExecute = ActionNewWOExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionAddFile: TAction
+ Category = 'Write'
+ Caption = 'Add &file'
+ OnExecute = ActionAddFileExecute
+ OnUpdate = ActionAddFileUpdate
+ end
+ object ActionAddDirectory: TAction
+ Category = 'Write'
+ Caption = 'Add &directory'
+ OnExecute = ActionAddDirectoryExecute
+ OnUpdate = ActionAddDirectoryUpdate
+ end
+ object ActionSave: TAction
+ Category = 'Write'
+ Caption = '&Save'
+ OnExecute = ActionSaveExecute
+ OnUpdate = ActionSaveUpdate
+ end
+ object ActionDeleteRW: TAction
+ Category = 'ReadWrite'
+ Caption = '&Delete'
+ OnExecute = ActionDeleteRWExecute
+ OnUpdate = ActionDeleteRWUpdate
+ end
+ object ActionNewRW: TAction
+ Category = 'ReadWrite'
+ Caption = '&New'
+ OnExecute = ActionNewRWExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionOpenRW: TAction
+ Category = 'ReadWrite'
+ Caption = '&Open'
+ OnExecute = ActionOpenRWExecute
+ OnUpdate = ActionAlwaysEnabled
+ end
+ object ActionProperties: TAction
+ Category = 'ReadWrite'
+ Caption = '&Properties'
+ OnExecute = ActionPropertiesExecute
+ OnUpdate = ActionPropertiesUpdate
+ end
+ end
+ object OpenDialogArchiveRO: TOpenDialog
+ FilterIndex = 0
+ Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Title = 'Open an archive for extraction'
+ Left = 104
+ Top = 152
+ end
+ object SaveDialogArchiveWO: TSaveDialog
+ DefaultExt = '*.zip'
+ FilterIndex = 0
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofCreatePrompt, ofNoReadOnlyReturn, ofEnableSizing]
+ Title = 'Create a new archive'
+ Left = 144
+ Top = 152
+ end
+ object OpenDialogFile: TOpenDialog
+ Filter = 'All files (*.*)|*.*'
+ FilterIndex = 0
+ Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Left = 184
+ Top = 152
+ end
+ object OpenDialogArchiveRW: TOpenDialog
+ FilterIndex = 0
+ Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Title = 'Open an archive for modification'
+ Left = 104
+ Top = 184
+ end
+ object SaveDialogArchiveRW: TSaveDialog
+ DefaultExt = '*.zip'
+ FilterIndex = 0
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofCreatePrompt, ofNoReadOnlyReturn, ofEnableSizing]
+ Title = 'Create a new archive'
+ Left = 144
+ Top = 184
+ end
+end
diff --git a/official/1.104/examples/windows/compression/archive/UMain.pas b/official/1.104/examples/windows/compression/archive/UMain.pas
new file mode 100644
index 0000000..10975f6
--- /dev/null
+++ b/official/1.104/examples/windows/compression/archive/UMain.pas
@@ -0,0 +1,568 @@
+unit UMain;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls, ActnList, ComCtrls, ImgList, JclCompression;
+
+type
+ TFormMain = class(TForm)
+ ActionList1: TActionList;
+ ActionOpenRO: TAction;
+ ActionExtractSelectedRO: TAction;
+ ActionExtractAllRO: TAction;
+ ActionNewWO: TAction;
+ ActionAddFile: TAction;
+ ActionAddDirectory: TAction;
+ ActionSave: TAction;
+ ListView1: TListView;
+ OpenDialogArchiveRO: TOpenDialog;
+ SaveDialogArchiveWO: TSaveDialog;
+ OpenDialogFile: TOpenDialog;
+ ProgressBar1: TProgressBar;
+ PageControl1: TPageControl;
+ TabSheetReadOnly: TTabSheet;
+ TabSheetWriteOnly: TTabSheet;
+ TabSheetReadWrite: TTabSheet;
+ ButtonOpen: TButton;
+ ButtonExtractSelected: TButton;
+ ButtonExtractAll: TButton;
+ ButtonNew: TButton;
+ ButtonAddFile: TButton;
+ ButtonAddDirectory: TButton;
+ ButtonSave: TButton;
+ ActionDeleteRW: TAction;
+ ActionNewRW: TAction;
+ ActionOpenRW: TAction;
+ ButtonNewRW: TButton;
+ ButtonOpenRW: TButton;
+ ButtonDeleteRW: TButton;
+ ButtonAddFileRW: TButton;
+ ButtonAddDirectoryRW: TButton;
+ ButtonExtractSelectedRW: TButton;
+ ButtonExtractAllRW: TButton;
+ ButtonSaveRW: TButton;
+ OpenDialogArchiveRW: TOpenDialog;
+ SaveDialogArchiveRW: TSaveDialog;
+ ButtonROProperties: TButton;
+ ActionProperties: TAction;
+ ButtonPropertiesWO: TButton;
+ ButtonPropertiesRW: TButton;
+ procedure ActionAlwaysEnabled(Sender: TObject);
+ procedure ActionExtractSelectedROUpdate(Sender: TObject);
+ procedure ActionExtractAllROUpdate(Sender: TObject);
+ procedure ActionAddFileUpdate(Sender: TObject);
+ procedure ActionAddDirectoryUpdate(Sender: TObject);
+ procedure ActionSaveUpdate(Sender: TObject);
+ procedure ActionNewWOExecute(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure ActionAddFileExecute(Sender: TObject);
+ procedure ActionAddDirectoryExecute(Sender: TObject);
+ procedure ActionSaveExecute(Sender: TObject);
+ procedure ActionOpenROExecute(Sender: TObject);
+ procedure ListView1Data(Sender: TObject; Item: TListItem);
+ procedure ActionExtractAllROExecute(Sender: TObject);
+ procedure ActionExtractSelectedROExecute(Sender: TObject);
+ procedure ActionDeleteRWUpdate(Sender: TObject);
+ procedure ActionDeleteRWExecute(Sender: TObject);
+ procedure ActionNewRWExecute(Sender: TObject);
+ procedure ActionOpenRWExecute(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure ActionPropertiesUpdate(Sender: TObject);
+ procedure ActionPropertiesExecute(Sender: TObject);
+ private
+ FArchive: TJclCompressionArchive;
+ FArchiveReference: IUnknown;
+ procedure CloseArchive;
+ procedure ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
+ public
+ end;
+
+var
+ FormMain: TFormMain;
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclAnsiStrings, Sevenzip, FileCtrl,
+ UProperties;
+
+function FileTimeToString(const FileTime: TFileTime): string;
+var
+ LocalFileTime: TFileTime;
+ SystemTime: TSystemTime;
+begin
+ if FileTimeToLocalFileTime(FileTime, LocalFileTime)
+ and FileTimeToSystemTime(LocalFileTime, SystemTime) then
+ Result := DateTimeToStr(EncodeDate(SystemTime.wYear, SystemTime.wMonth, SystemTime.wDay)
+ + EncodeTime(SystemTime.wHour, SystemTime.wMinute, SystemTime.wSecond, SystemTime.wMilliseconds))
+ else
+ Result := '';
+end;
+
+procedure TFormMain.ActionAddDirectoryExecute(Sender: TObject);
+var
+ Directory: string;
+begin
+ if FileCtrl.SelectDirectory('Select directory', '', Directory {$IFDEF COMPILER9_UP} , [sdNewUI], Self {$ENDIF}) then
+ begin
+ (FArchive as TJclCompressArchive).AddDirectory(ExtractFileName(Directory), Directory, True, True);
+ ListView1.Items.BeginUpdate;
+ try
+ while ListView1.Items.Count < FArchive.ItemCount do
+ ListView1.Items.Add;
+ finally
+ ListView1.Items.EndUpdate;
+ end;
+ end;
+end;
+
+procedure TFormMain.ActionAddDirectoryUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := (FArchive is TJclCompressArchive) and FArchive.MultipleItemContainer;
+end;
+
+procedure TFormMain.ActionAddFileExecute(Sender: TObject);
+begin
+ if OpenDialogFile.Execute then
+ begin
+ (FArchive as TJclCompressArchive).AddFile(ExtractFileName(OpenDialogFile.FileName), OpenDialogFile.FileName);
+ ListView1.Items.Add;
+ end;
+end;
+
+procedure TFormMain.ActionAddFileUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := (FArchive is TJclCompressArchive)
+ and (FArchive.MultipleItemContainer or (ListView1.Items.Count = 0));
+end;
+
+procedure TFormMain.ActionAlwaysEnabled(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := True;
+end;
+
+procedure TFormMain.ActionDeleteRWExecute(Sender: TObject);
+var
+ Index: Integer;
+begin
+ for Index := ListView1.Items.Count - 1 downto 0 do
+ if ListView1.Items[Index].Selected then
+ begin
+ (FArchive as TJclUpdateArchive).DeleteItem(Index);
+ Break;
+ end;
+
+ ListView1.Items.Count := FArchive.ItemCount;
+end;
+
+procedure TFormMain.ActionDeleteRWUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := (FArchive is TJclUpdateArchive) and (ListView1.SelCount = 1);
+end;
+
+procedure TFormMain.ActionExtractAllROExecute(Sender: TObject);
+var
+ Directory: string;
+begin
+ if FileCtrl.SelectDirectory('Target directory', '', Directory {$IFDEF COMPILER9_UP} , [sdNewUI], Self {$ENDIF}) then
+ begin
+ if FArchive is TJclDecompressArchive then
+ TJclDecompressArchive(FArchive).ExtractAll(Directory, True)
+ else
+ if FArchive is TJclUpdateArchive then
+ TJclUpdateArchive(FArchive).ExtractAll(Directory, True);
+ end;
+end;
+
+procedure TFormMain.ActionExtractAllROUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := (FArchive is TJclDecompressArchive) or (FArchive is TJclUpdateArchive);
+end;
+
+procedure TFormMain.ActionExtractSelectedROExecute(Sender: TObject);
+var
+ Directory: string;
+ Index: Integer;
+begin
+ if FileCtrl.SelectDirectory('Target directory', '', Directory {$IFDEF COMPILER9_UP} , [sdNewUI], Self {$ENDIF}) then
+ begin
+ for Index := 0 to ListView1.Items.Count - 1 do
+ FArchive.Items[Index].Selected := ListView1.Items.Item[Index].Selected;
+
+ if FArchive is TJclDecompressArchive then
+ TJclDecompressArchive(FArchive).ExtractSelected(Directory, True)
+ else
+ if FArchive is TJclUpdateArchive then
+ TJclUpdateArchive(FArchive).ExtractSelected(Directory, True);
+ end;
+end;
+
+procedure TFormMain.ActionExtractSelectedROUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := ((FArchive is TJclDecompressArchive) or (FArchive is TJclUpdateArchive))
+ and (ListView1.SelCount > 0);
+end;
+
+procedure TFormMain.ActionNewWOExecute(Sender: TObject);
+var
+ ArchiveFileName, VolumeSizeStr, Password: string;
+ AFormat: TJclCompressArchiveClass;
+ VolumeSize: Int64;
+ Code: Integer;
+begin
+ if SaveDialogArchiveWO.Execute then
+ begin
+ CloseArchive;
+
+ ArchiveFileName := SaveDialogArchiveWO.FileName;
+
+ AFormat := GetArchiveFormats.FindCompressFormat(ArchiveFileName);
+
+ if AFormat <> nil then
+ begin
+ VolumeSizeStr := '0';
+ repeat
+ if InputQuery('Split archive?', 'Volume size in byte:', VolumeSizeStr) then
+ Val(VolumeSizeStr, VolumeSize, Code)
+ else
+ begin
+ VolumeSize := 0;
+ Code := 0;
+ end;
+ until Code = 0;
+
+ InputQuery('Archive password', 'Value', Password);
+
+ if VolumeSize <> 0 then
+ ArchiveFileName := ArchiveFileName + '.%.3d';
+
+ FArchive := AFormat.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0);
+ FArchiveReference := FArchive;
+ FArchive.Password := Password;
+ FArchive.OnProgress := ArchiveProgress;
+ end
+ else
+ ShowMessage('not a supported format');
+ end;
+end;
+
+procedure TFormMain.ActionNewRWExecute(Sender: TObject);
+var
+ ArchiveFileName, VolumeSizeStr, Password: string;
+ AFormat: TJclUpdateArchiveClass;
+ VolumeSize: Int64;
+ Code: Integer;
+begin
+ if SaveDialogArchiveRW.Execute then
+ begin
+ CloseArchive;
+
+ ArchiveFileName := SaveDialogArchiveRW.FileName;
+
+ AFormat := GetArchiveFormats.FindUpdateFormat(ArchiveFileName);
+
+ if AFormat <> nil then
+ begin
+ VolumeSizeStr := '0';
+ repeat
+ if InputQuery('Split archive?', 'Volume size in byte:', VolumeSizeStr) then
+ Val(VolumeSizeStr, VolumeSize, Code)
+ else
+ begin
+ VolumeSize := 0;
+ Code := 0;
+ end;
+ until Code = 0;
+
+ InputQuery('Archive password', 'Value', Password);
+
+ if VolumeSize <> 0 then
+ ArchiveFileName := ArchiveFileName + '.%.3d';
+
+ FArchive := AFormat.Create(ArchiveFileName, VolumeSize, VolumeSize <> 0);
+ FArchiveReference := FArchive;
+ FArchive.Password := Password;
+ FArchive.OnProgress := ArchiveProgress;
+ end
+ else
+ ShowMessage('not a supported format');
+ end;
+end;
+
+procedure TFormMain.ActionOpenROExecute(Sender: TObject);
+var
+ ArchiveFileName, Password: string;
+ AFormat: TJclDecompressArchiveClass;
+ SplitArchive: Boolean;
+begin
+ if OpenDialogArchiveRO.Execute then
+ begin
+ CloseArchive;
+
+ ArchiveFileName := OpenDialogArchiveRO.FileName;
+ SplitArchive := AnsiSameText(ExtractFileExt(ArchiveFileName), '.001');
+ if SplitArchive then
+ ArchiveFileName := ChangeFileExt(ArchiveFileName, '');
+
+ AFormat := GetArchiveFormats.FindDecompressFormat(ArchiveFileName);
+
+ if AFormat <> nil then
+ begin
+ if SplitArchive then
+ ArchiveFileName := ArchiveFileName + '.%.3d';
+
+ InputQuery('Archive password', 'Value', Password);
+
+ FArchive := AFormat.Create(ArchiveFileName, 0, SplitArchive);
+ FArchiveReference := FArchive;
+ FArchive.Password := Password;
+ FArchive.OnProgress := ArchiveProgress;
+
+ if FArchive is TJclDecompressArchive then
+ TJclDecompressArchive(FArchive).ListFiles
+ else
+ if FArchive is TJclUpdateArchive then
+ TJclUpdateArchive(FArchive).ListFiles;
+
+ ListView1.Items.BeginUpdate;
+ try
+ while ListView1.Items.Count < FArchive.ItemCount do
+ ListView1.Items.Add;
+ finally
+ ListView1.Items.EndUpdate;
+ end;
+ end
+ else
+ ShowMessage('not a supported format');
+ end;
+end;
+
+procedure TFormMain.ActionOpenRWExecute(Sender: TObject);
+var
+ ArchiveFileName, Password: string;
+ AFormat: TJclUpdateArchiveClass;
+ SplitArchive: Boolean;
+begin
+ if OpenDialogArchiveRW.Execute then
+ begin
+ CloseArchive;
+
+ ArchiveFileName := OpenDialogArchiveRW.FileName;
+ SplitArchive := AnsiSameText(ExtractFileExt(ArchiveFileName), '.001');
+ if SplitArchive then
+ ArchiveFileName := ChangeFileExt(ArchiveFileName, '');
+
+ AFormat := GetArchiveFormats.FindUpdateFormat(ArchiveFileName);
+
+ if AFormat <> nil then
+ begin
+ if SplitArchive then
+ ArchiveFileName := ArchiveFileName + '.%.3d';
+
+ InputQuery('Archive password', 'Value', Password);
+
+ FArchive := AFormat.Create(ArchiveFileName, 0, SplitArchive);
+ FArchiveReference := FArchive;
+ FArchive.Password := Password;
+ FArchive.OnProgress := ArchiveProgress;
+
+ if FArchive is TJclDecompressArchive then
+ TJclDecompressArchive(FArchive).ListFiles
+ else
+ if FArchive is TJclUpdateArchive then
+ TJclUpdateArchive(FArchive).ListFiles;
+
+ ListView1.Items.BeginUpdate;
+ try
+ while ListView1.Items.Count < FArchive.ItemCount do
+ ListView1.Items.Add;
+ finally
+ ListView1.Items.EndUpdate;
+ end;
+ end
+ else
+ ShowMessage('not a supported format');
+ end;
+end;
+
+procedure TFormMain.ActionPropertiesExecute(Sender: TObject);
+begin
+ TFormArchiveSettings.Execute(FArchive);
+end;
+
+procedure TFormMain.ActionPropertiesUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := Assigned(FArchive);
+end;
+
+procedure TFormMain.ActionSaveExecute(Sender: TObject);
+begin
+ (FArchive as TJclCompressArchive).Compress;
+ CloseArchive;
+end;
+
+procedure TFormMain.ActionSaveUpdate(Sender: TObject);
+begin
+ (Sender as TAction).Enabled := (FArchive is TJclCompressArchive) and (ListView1.Items.Count > 0);
+end;
+
+procedure TFormMain.ArchiveProgress(Sender: TObject; const Value, MaxValue: Int64);
+var
+ MyValue, MyMaxValue: Int64;
+begin
+ MyValue := Value;
+ MyMaxValue := MaxValue;
+
+ while MyMaxValue > High(Word) do
+ begin
+ MyMaxValue := MyMaxValue shr 8;
+ MyValue := MyValue shr 8;
+ end;
+ ProgressBar1.Max := MyMaxValue;
+ ProgressBar1.Position := MyValue;
+end;
+
+procedure TFormMain.CloseArchive;
+begin
+ FArchiveReference := nil; // free
+ FArchive := nil;
+ ListView1.Items.Clear;
+end;
+
+procedure TFormMain.FormCreate(Sender: TObject);
+ procedure MergeFilters(var AFilter, AllExtensions: string; AFormat: TJclCompressionArchiveClass);
+ var
+ AName, AExtensions: string;
+ begin
+ AName := AFormat.ArchiveName;
+ AExtensions := AFormat.ArchiveExtensions;
+ if AFilter = '' then
+ AFilter := Format('%0:s (%1:s)|%1:s', [AName, AExtensions])
+ else
+ AFilter := Format('%0:s|%1:s (%2:s)|%2:s', [AFilter, AName, AExtensions]);
+ if AllExtensions = '' then
+ AllExtensions := AExtensions
+ else
+ AllExtensions := Format('%s;%s', [AllExtensions, AExtensions]);
+ end;
+ function AddStandardFilters(const AFilter, AllExtensions: string): string;
+ begin
+ if AFilter = '' then
+ Result := ''
+ else
+ Result := Format('All supported formats|(%0:s)|%1:s', [AllExtensions, AFilter]);
+ end;
+var
+ AFilter, AllExtensions: string;
+ AFormats: TJclCompressionArchiveFormats;
+ Index: Integer;
+begin
+ AFormats := GetArchiveFormats;
+
+ AFilter := '';
+ AllExtensions := '';
+ for Index := 0 to AFormats.CompressFormatCount - 1 do
+ MergeFilters(AFilter, AllExtensions, AFormats.CompressFormats[Index]);
+ SaveDialogArchiveWO.Filter := AFilter;
+
+ AFilter := '';
+ AllExtensions := '';
+ for Index := 0 to AFormats.UpdateFormatCount - 1 do
+ MergeFilters(AFilter, AllExtensions, AFormats.UpdateFormats[Index]);
+ SaveDialogArchiveRW.Filter := AFilter;
+
+ AFilter := '';
+ AllExtensions := '';
+ for Index := 0 to AFormats.DecompressFormatCount - 1 do
+ MergeFilters(AFilter, AllExtensions, AFormats.DecompressFormats[Index]);
+ OpenDialogArchiveRO.Filter := AddStandardFilters(AFilter, AllExtensions);
+
+ AFilter := '';
+ AllExtensions := '';
+ for Index := 0 to AFormats.UpdateFormatCount - 1 do
+ MergeFilters(AFilter, AllExtensions, AFormats.UpdateFormats[Index]);
+ OpenDialogArchiveRW.Filter := AddStandardFilters(AFilter, AllExtensions);
+end;
+
+procedure TFormMain.FormDestroy(Sender: TObject);
+begin
+ CloseArchive;
+end;
+
+procedure TFormMain.ListView1Data(Sender: TObject; Item: TListItem);
+var
+ CompressionItem: TJclCompressionItem;
+begin
+ if not Assigned(FArchive) then
+ begin
+ Item.Caption := '';
+ Item.SubItems.Clear;
+ Exit;
+ end;
+
+ CompressionItem := FArchive.Items[Item.Index];
+
+ Item.Caption := CompressionItem.FileName;
+ Item.SubItems.Clear;
+ if ipPackedName in CompressionItem.ValidProperties then
+ Item.SubItems.Add(CompressionItem.PackedName)
+ else
+ Item.SubItems.Add('');
+ if ipFileSize in CompressionItem.ValidProperties then
+ Item.SubItems.Add(IntToStr(CompressionItem.FileSize))
+ else
+ Item.SubItems.Add('');
+ if ipPackedSize in CompressionItem.ValidProperties then
+ Item.SubItems.Add(IntToStr(CompressionItem.PackedSize))
+ else
+ Item.SubItems.Add('');
+ if ipCreationTime in CompressionItem.ValidProperties then
+ Item.SubItems.Add(FileTimeToString(CompressionItem.CreationTime))
+ else
+ Item.SubItems.Add('');
+ if ipLastAccessTime in CompressionItem.ValidProperties then
+ Item.SubItems.Add(FileTimeToString(CompressionItem.LastAccessTime))
+ else
+ Item.SubItems.Add('');
+ if ipLastWriteTime in CompressionItem.ValidProperties then
+ Item.SubItems.Add(FileTimeToString(CompressionItem.LastWriteTime))
+ else
+ Item.SubItems.Add('');
+ if ipComment in CompressionItem.ValidProperties then
+ Item.SubItems.Add(CompressionItem.Comment)
+ else
+ Item.SubItems.Add('');
+ if ipHostOS in CompressionItem.ValidProperties then
+ Item.SubItems.Add(CompressionItem.HostOS)
+ else
+ Item.SubItems.Add('');
+ if ipHostFS in CompressionItem.ValidProperties then
+ Item.SubItems.Add(CompressionItem.HostFS)
+ else
+ Item.SubItems.Add('');
+ if ipUser in CompressionItem.ValidProperties then
+ Item.SubItems.Add(CompressionItem.User)
+ else
+ Item.SubItems.Add('');
+ if ipGroup in CompressionItem.ValidProperties then
+ Item.SubItems.Add(CompressionItem.Group)
+ else
+ Item.SubItems.Add('');
+ if ipCRC in CompressionItem.ValidProperties then
+ Item.SubItems.Add(IntToHex(CompressionItem.CRC, 8))
+ else
+ Item.SubItems.Add('');
+end;
+
+initialization
+
+ if not Load7Zip then
+ raise EJclCompressionError.Create('Cannot load sevenzip library');
+
+end.
diff --git a/official/1.104/examples/windows/compression/archive/UProperties.dfm b/official/1.104/examples/windows/compression/archive/UProperties.dfm
new file mode 100644
index 0000000..582d1db
--- /dev/null
+++ b/official/1.104/examples/windows/compression/archive/UProperties.dfm
@@ -0,0 +1,243 @@
+object FormArchiveSettings: TFormArchiveSettings
+ Left = 0
+ Top = 0
+ BorderStyle = bsDialog
+ Caption = 'Archive settings'
+ ClientHeight = 311
+ ClientWidth = 493
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poMainFormCenter
+ PixelsPerInch = 96
+ TextHeight = 13
+ object GroupBoxGeneralSettings: TGroupBox
+ Left = 8
+ Top = 8
+ Width = 273
+ Height = 97
+ Caption = 'General settings:'
+ TabOrder = 0
+ object LabelPassword: TLabel
+ Left = 16
+ Top = 27
+ Width = 50
+ Height = 13
+ Caption = '&Password:'
+ FocusControl = EditPassword
+ end
+ object LabelNumberOfThreads: TLabel
+ Left = 16
+ Top = 62
+ Width = 94
+ Height = 13
+ Caption = 'Number of &threads:'
+ FocusControl = EditNumberOfThreads
+ end
+ object EditPassword: TEdit
+ Left = 88
+ Top = 24
+ Width = 169
+ Height = 21
+ TabOrder = 0
+ OnExit = EditPasswordExit
+ end
+ object EditNumberOfThreads: TEdit
+ Left = 128
+ Top = 59
+ Width = 129
+ Height = 21
+ BiDiMode = bdRightToLeft
+ ParentBiDiMode = False
+ TabOrder = 1
+ Text = '1'
+ OnExit = EditNumberOfThreadsExit
+ end
+ end
+ object GroupBoxCompressionProperties: TGroupBox
+ Left = 8
+ Top = 111
+ Width = 273
+ Height = 193
+ Caption = 'Compression properties:'
+ TabOrder = 1
+ object LabelCompressionLevel: TLabel
+ Left = 16
+ Top = 27
+ Width = 176
+ Height = 13
+ Caption = 'Compression &level (from %d to %d):'
+ FocusControl = EditCompressionLevel
+ end
+ object LabelCompressionMethod: TLabel
+ Left = 16
+ Top = 58
+ Width = 104
+ Height = 13
+ Caption = '&Compression method:'
+ FocusControl = ComboBoxCompressionMethod
+ end
+ object LabelEncryptionMethod: TLabel
+ Left = 16
+ Top = 90
+ Width = 94
+ Height = 13
+ Caption = '&Encryption method:'
+ FocusControl = ComboBoxEncryptionMethod
+ end
+ object LabelDictionarySize: TLabel
+ Left = 16
+ Top = 123
+ Width = 73
+ Height = 13
+ Caption = '&Dictionary size:'
+ FocusControl = EditDictionarySize
+ end
+ object LabelNumberOfPasses: TLabel
+ Left = 16
+ Top = 158
+ Width = 90
+ Height = 13
+ Caption = '&Number of passes:'
+ FocusControl = EditNumberOfPasses
+ end
+ object EditCompressionLevel: TEdit
+ Left = 216
+ Top = 24
+ Width = 41
+ Height = 21
+ BiDiMode = bdRightToLeft
+ ParentBiDiMode = False
+ TabOrder = 0
+ Text = '6'
+ OnExit = EditCompressionLevelExit
+ end
+ object ComboBoxCompressionMethod: TComboBox
+ Left = 136
+ Top = 55
+ Width = 121
+ Height = 21
+ Style = csDropDownList
+ ItemHeight = 13
+ TabOrder = 1
+ OnExit = ComboBoxCompressionMethodExit
+ end
+ object ComboBoxEncryptionMethod: TComboBox
+ Left = 136
+ Top = 88
+ Width = 121
+ Height = 21
+ Style = csDropDownList
+ ItemHeight = 13
+ TabOrder = 2
+ OnChange = ComboBoxEncryptionMethodChange
+ end
+ object EditDictionarySize: TEdit
+ Left = 136
+ Top = 122
+ Width = 121
+ Height = 21
+ BiDiMode = bdRightToLeft
+ ParentBiDiMode = False
+ TabOrder = 3
+ Text = '0'
+ OnExit = EditDictionarySizeExit
+ end
+ object EditNumberOfPasses: TEdit
+ Left = 136
+ Top = 156
+ Width = 121
+ Height = 21
+ BiDiMode = bdRightToLeft
+ ParentBiDiMode = False
+ TabOrder = 4
+ Text = '0'
+ OnExit = EditNumberOfPassesExit
+ end
+ end
+ object GroupBox1: TGroupBox
+ Left = 296
+ Top = 8
+ Width = 185
+ Height = 207
+ Caption = 'Content:'
+ TabOrder = 2
+ object CheckBoxRemoveSfxBlock: TCheckBox
+ Left = 16
+ Top = 24
+ Width = 153
+ Height = 17
+ Caption = '&Remove Sfx block'
+ TabOrder = 0
+ OnExit = CheckBoxRemoveSfxBlockExit
+ end
+ object CheckBoxCompressHeader: TCheckBox
+ Left = 16
+ Top = 48
+ Width = 153
+ Height = 17
+ Caption = 'Compress &header'
+ TabOrder = 1
+ OnExit = CheckBoxCompressHeaderExit
+ end
+ object CheckBoxCompressHeaderFull: TCheckBox
+ Left = 32
+ Top = 72
+ Width = 137
+ Height = 17
+ Caption = 'Compress header &full'
+ TabOrder = 2
+ OnExit = CheckBoxCompressHeaderFullExit
+ end
+ object CheckBoxEncryptHeader: TCheckBox
+ Left = 16
+ Top = 96
+ Width = 153
+ Height = 17
+ Caption = 'Encr&ypt header'
+ TabOrder = 3
+ OnExit = CheckBoxEncryptHeaderExit
+ end
+ object CheckBoxSaveCreationDateTime: TCheckBox
+ Left = 16
+ Top = 120
+ Width = 153
+ Height = 17
+ Caption = 'Save cr&eation date-time'
+ TabOrder = 4
+ OnExit = CheckBoxSaveCreationDateTimeExit
+ end
+ object CheckBoxSaveLastAccessDateTime: TCheckBox
+ Left = 16
+ Top = 144
+ Width = 153
+ Height = 17
+ Caption = 'Save last &access date-time'
+ TabOrder = 5
+ OnExit = CheckBoxSaveLastAccessDateTimeExit
+ end
+ object CheckBoxSaveLastSaveDateTime: TCheckBox
+ Left = 16
+ Top = 167
+ Width = 153
+ Height = 17
+ Caption = 'Save last &write date-time'
+ TabOrder = 6
+ OnExit = CheckBoxSaveLastSaveDateTimeExit
+ end
+ end
+ object ButtonClose: TButton
+ Left = 328
+ Top = 243
+ Width = 121
+ Height = 25
+ Caption = 'Close'
+ Default = True
+ ModalResult = 1
+ TabOrder = 3
+ end
+end
diff --git a/official/1.104/examples/windows/compression/archive/UProperties.pas b/official/1.104/examples/windows/compression/archive/UProperties.pas
new file mode 100644
index 0000000..c89bf95
--- /dev/null
+++ b/official/1.104/examples/windows/compression/archive/UProperties.pas
@@ -0,0 +1,262 @@
+unit UProperties;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, JclCompression, ActnList;
+
+type
+ TFormArchiveSettings = class(TForm)
+ GroupBoxGeneralSettings: TGroupBox;
+ EditPassword: TEdit;
+ LabelPassword: TLabel;
+ EditNumberOfThreads: TEdit;
+ LabelNumberOfThreads: TLabel;
+ GroupBoxCompressionProperties: TGroupBox;
+ EditCompressionLevel: TEdit;
+ LabelCompressionLevel: TLabel;
+ ComboBoxCompressionMethod: TComboBox;
+ LabelCompressionMethod: TLabel;
+ ComboBoxEncryptionMethod: TComboBox;
+ LabelEncryptionMethod: TLabel;
+ EditDictionarySize: TEdit;
+ LabelDictionarySize: TLabel;
+ EditNumberOfPasses: TEdit;
+ LabelNumberOfPasses: TLabel;
+ GroupBox1: TGroupBox;
+ CheckBoxRemoveSfxBlock: TCheckBox;
+ CheckBoxCompressHeader: TCheckBox;
+ CheckBoxCompressHeaderFull: TCheckBox;
+ CheckBoxEncryptHeader: TCheckBox;
+ CheckBoxSaveCreationDateTime: TCheckBox;
+ CheckBoxSaveLastAccessDateTime: TCheckBox;
+ CheckBoxSaveLastSaveDateTime: TCheckBox;
+ ButtonClose: TButton;
+ procedure EditPasswordExit(Sender: TObject);
+ procedure EditNumberOfThreadsExit(Sender: TObject);
+ procedure EditCompressionLevelExit(Sender: TObject);
+ procedure ComboBoxCompressionMethodExit(Sender: TObject);
+ procedure ComboBoxEncryptionMethodChange(Sender: TObject);
+ procedure EditDictionarySizeExit(Sender: TObject);
+ procedure EditNumberOfPassesExit(Sender: TObject);
+ procedure CheckBoxRemoveSfxBlockExit(Sender: TObject);
+ procedure CheckBoxCompressHeaderExit(Sender: TObject);
+ procedure CheckBoxCompressHeaderFullExit(Sender: TObject);
+ procedure CheckBoxEncryptHeaderExit(Sender: TObject);
+ procedure CheckBoxSaveCreationDateTimeExit(Sender: TObject);
+ procedure CheckBoxSaveLastAccessDateTimeExit(Sender: TObject);
+ procedure CheckBoxSaveLastSaveDateTimeExit(Sender: TObject);
+ protected
+ FArchive: TJclCompressionArchive;
+ FNumberOfThreads: IJclArchiveNumberOfThreads;
+ FCompressionLevel: IJclArchiveCompressionLevel;
+ FCompressionMethod: IJclArchiveCompressionMethod;
+ FEncryptionMethod: IJclArchiveEncryptionMethod;
+ FDictionarySize: IJclArchiveDictionarySize;
+ FNumberOfPasses: IJclArchiveNumberOfPasses;
+ FRemoveSfxBlock: IJclArchiveRemoveSfxBlock;
+ FCompressHeader: IJclArchiveCompressHeader;
+ FEncryptHeader: IJclArchiveEncryptHeader;
+ FSaveCreationDateTime: IJclArchiveSaveCreationDateTime;
+ FSaveLastAccessDateTime: IJclArchiveSaveLastAccessDateTime;
+ FSaveLastWriteDateTime: IJclArchiveSaveLastWriteDateTime;
+ FAlgoritm: IJclArchiveAlgorithm;
+ public
+ class procedure Execute(Archive: TJclCompressionArchive);
+ procedure RefreshValues;
+ end;
+
+implementation
+
+{$R *.dfm}
+
+uses
+ TypInfo;
+
+procedure TFormArchiveSettings.CheckBoxCompressHeaderExit(Sender: TObject);
+begin
+ FCompressHeader.CompressHeader := CheckBoxCompressHeader.Checked;
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.CheckBoxCompressHeaderFullExit(Sender: TObject);
+begin
+ FCompressHeader.CompressHeaderFull := CheckBoxCompressHeaderFull.Checked;
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.CheckBoxEncryptHeaderExit(Sender: TObject);
+begin
+ FEncryptHeader.EncryptHeader := CheckBoxEncryptHeader.Checked;
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.CheckBoxRemoveSfxBlockExit(Sender: TObject);
+begin
+ FRemoveSfxBlock.RemoveSfxBlock := CheckBoxRemoveSfxBlock.Checked;
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.CheckBoxSaveCreationDateTimeExit(Sender: TObject);
+begin
+ FSaveCreationDateTime.SaveCreationDateTime := CheckBoxSaveCreationDateTime.Checked;
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.CheckBoxSaveLastAccessDateTimeExit(Sender: TObject);
+begin
+ FSaveLastAccessDateTime.SaveLastAccessDateTime := CheckBoxSaveLastAccessDateTime.Checked;
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.CheckBoxSaveLastSaveDateTimeExit(Sender: TObject);
+begin
+ FSaveLastWriteDateTime.SaveLastWriteDateTime := CheckBoxSaveLastSaveDateTime.Checked;
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.ComboBoxCompressionMethodExit(Sender: TObject);
+begin
+ FCompressionMethod.CompressionMethod := TJclCompressionMethod(GetEnumValue(TypeInfo(TJclCompressionMethod),ComboBoxCompressionMethod.Text));
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.ComboBoxEncryptionMethodChange(Sender: TObject);
+begin
+ FEncryptionMethod.EncryptionMethod := TJclEncryptionMethod(GetEnumValue(TypeInfo(TJclEncryptionMethod),ComboBoxEncryptionMethod.Text));
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.EditCompressionLevelExit(Sender: TObject);
+begin
+ FCompressionLevel.CompressionLevel := StrToInt(EditCompressionLevel.Text);
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.EditDictionarySizeExit(Sender: TObject);
+begin
+ FDictionarySize.DictionarySize := StrToInt(EditDictionarySize.Text);
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.EditNumberOfPassesExit(Sender: TObject);
+begin
+ FNumberOfPasses.NumberOfPasses := StrToInt(EditNumberOfPasses.Text);
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.EditNumberOfThreadsExit(Sender: TObject);
+begin
+ FNumberOfThreads.NumberOfThreads := StrToInt(EditNumberOfThreads.Text);
+ RefreshValues;
+end;
+
+procedure TFormArchiveSettings.EditPasswordExit(Sender: TObject);
+begin
+ FArchive.Password := EditPassword.Text;
+ RefreshValues;
+end;
+
+class procedure TFormArchiveSettings.Execute(Archive: TJclCompressionArchive);
+var
+ AFormSettings: TFormArchiveSettings;
+ CompressionMethod: TJclCompressionMethod;
+ EncryptionMethod: TJclEncryptionMethod;
+begin
+ AFormSettings := TFormArchiveSettings.Create(Application);
+ try
+ Supports(IUnknown(Archive),IJclArchiveNumberOfThreads,AFormSettings.FNumberOfThreads);
+ Supports(IUnknown(Archive),IJclArchiveCompressionLevel,AFormSettings.FCompressionLevel);
+ Supports(IUnknown(Archive),IJclArchiveCompressionMethod,AFormSettings.FCompressionMethod);
+ Supports(IUnknown(Archive),IJclArchiveEncryptionMethod,AFormSettings.FEncryptionMethod);
+ Supports(IUnknown(Archive),IJclArchiveDictionarySize,AFormSettings.FDictionarySize);
+ Supports(IUnknown(Archive),IJclArchiveNumberOfPasses,AFormSettings.FNumberOfPasses);
+ Supports(IUnknown(Archive),IJclArchiveRemoveSfxBlock,AFormSettings.FRemoveSfxBlock);
+ Supports(IUnknown(Archive),IJclArchiveCompressHeader,AFormSettings.FCompressHeader);
+ Supports(IUnknown(Archive),IJclArchiveEncryptHeader,AFormSettings.FEncryptHeader);
+ Supports(IUnknown(Archive),IJclArchiveSaveCreationDateTime,AFormSettings.FSaveCreationDateTime);
+ Supports(IUnknown(Archive),IJclArchiveSaveLastAccessDateTime,AFormSettings.FSaveLastAccessDateTime);
+ Supports(IUnknown(Archive),IJclArchiveSaveLastWriteDateTime,AFormSettings.FSaveLastWriteDateTime);
+ AFormSettings.FArchive := Archive;
+
+ if Assigned(AFormSettings.FCompressionLevel) then
+ AFormSettings.LabelCompressionLevel.Caption := Format(AFormSettings.LabelCompressionLevel.Caption,
+ [AFormSettings.FCompressionLevel.CompressionLevelMin,AFormSettings.FCompressionLevel.CompressionLevelMax])
+ else
+ AFormSettings.LabelCompressionLevel.Caption := Format(AFormSettings.LabelCompressionLevel.Caption,[0,0]);
+
+ if Assigned(AFormSettings.FCompressionMethod) then
+ for CompressionMethod := Low(TJclCompressionMethod) to High(TJclCompressionMethod) do
+ if CompressionMethod in AFormSettings.FCompressionMethod.SupportedCompressionMethods then
+ AFormSettings.ComboBoxCompressionMethod.Items.Add(GetEnumName(TypeInfo(TJclCompressionMethod),Integer(CompressionMethod)));
+
+ if Assigned(AFormSettings.FEncryptionMethod) then
+ for EncryptionMethod := Low(TJclEncryptionMethod) to High(TJclEncryptionMethod) do
+ if EncryptionMethod in AFormSettings.FEncryptionMethod.SupportedEncryptionMethods then
+ AFormSettings.ComboBoxEncryptionMethod.Items.Add(GetEnumName(TypeInfo(TJclEncryptionMethod),Integer(EncryptionMethod)));
+
+ AFormSettings.RefreshValues;
+ AFormSettings.ShowModal;
+ finally
+ AFormSettings.Free;
+ end;
+end;
+
+procedure TFormArchiveSettings.RefreshValues;
+begin
+ // password
+ EditPassword.Text := FArchive.Password;
+ // number of threads
+ EditNumberOfThreads.Enabled := Assigned(FNumberOfThreads);
+ if Assigned(FNumberOfThreads) then
+ EditNumberOfThreads.Text := IntToStr(FNumberOfThreads.NumberOfThreads);
+ // compression level
+ EditCompressionLevel.Enabled := Assigned(FCompressionLevel);
+ if Assigned(FCompressionLevel) then
+ EditCompressionLevel.Text := IntToStr(FCompressionLevel.CompressionLevel);
+ // compression method
+ if Assigned(FCompressionMethod) then
+ ComboBoxCompressionMethod.ItemIndex := ComboBoxCompressionMethod.Items.IndexOf(GetEnumName(TypeInfo(TJclCompressionMethod),Integer(FCompressionMethod.CompressionMethod)))
+ else
+ ComboBoxCompressionMethod.Enabled := False;
+ // encryption method
+ if Assigned(FEncryptionMethod) then
+ ComboBoxEncryptionMethod.ItemIndex := ComboBoxEncryptionMethod.Items.IndexOf(GetEnumName(TypeInfo(TJclEncryptionMethod),Integer(FEncryptionMethod.EncryptionMethod)))
+ else
+ ComboBoxEncryptionMethod.Enabled := False;
+ // dictionary size
+ if Assigned(FDictionarySize) then
+ EditDictionarySize.Text := IntToStr(FDictionarySize.DictionarySize)
+ else
+ EditDictionarySize.Enabled := False;
+ // number of passes
+ if Assigned(FNumberOfPasses) then
+ EditNumberOfPasses.Text := IntToStr(FNumberOfPasses.NumberOfPasses)
+ else
+ EditNumberOfPasses.Enabled := False;
+ // remove sfx
+ CheckBoxRemoveSfxBlock.Enabled := Assigned(FRemoveSfxBlock);
+ CheckBoxRemoveSfxBlock.Checked := Assigned(FRemoveSfxBlock) and FRemoveSfxBlock.RemoveSfxBlock;
+ // compress header
+ CheckBoxCompressHeader.Enabled := Assigned(FCompressHeader);
+ CheckBoxCompressHeader.Checked := Assigned(FCompressHeader) and FCompressHeader.CompressHeader;
+ // compress header full
+ CheckBoxCompressHeaderFull.Enabled := Assigned(FCompressHeader);
+ CheckBoxCompressHeaderFull.Checked := Assigned(FCompressHeader) and FCompressHeader.CompressHeaderFull;
+ // encrypt header
+ CheckBoxEncryptHeader.Enabled := Assigned(FEncryptHeader);
+ CheckBoxEncryptHeader.Checked := Assigned(FEncryptHeader) and FEncryptHeader.EncryptHeader;
+ // save creation date time
+ CheckBoxSaveCreationDateTime.Enabled := Assigned(FSaveCreationDateTime);
+ CheckBoxSaveCreationDateTime.Checked := Assigned(FSaveCreationDateTime) and FSaveCreationDateTime.SaveCreationDateTime;
+ // save last access date time
+ CheckBoxSaveLastAccessDateTime.Enabled := Assigned(FSaveLastAccessDateTime);
+ CheckBoxSaveLastAccessDateTime.Checked := Assigned(FSaveLastAccessDateTime) and FSaveLastAccessDateTime.SaveLastAccessDateTime;
+ // save last write date time
+ CheckBoxSaveLastSaveDateTime.Enabled := Assigned(FSaveLastWriteDateTime);
+ CheckBoxSaveLastSaveDateTime.Checked := Assigned(FSaveLastWriteDateTime) and FSaveLastWriteDateTime.SaveLastWriteDateTime;
+end;
+
+end.
+
diff --git a/official/1.104/examples/windows/debug/framestrack/FramesTrackDemoMain.dfm b/official/1.104/examples/windows/debug/framestrack/FramesTrackDemoMain.dfm
new file mode 100644
index 0000000..3215e5b
--- /dev/null
+++ b/official/1.104/examples/windows/debug/framestrack/FramesTrackDemoMain.dfm
@@ -0,0 +1,91 @@
+object Form1: TForm1
+ Left = 192
+ Top = 136
+ ClientWidth = 782
+ ClientHeight = 474
+ 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.104/examples/windows/debug/framestrack/FramesTrackDemoMain.pas b/official/1.104/examples/windows/debug/framestrack/FramesTrackDemoMain.pas
new file mode 100644
index 0000000..f7f4966
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/framestrack/FramesTrackExample.dof b/official/1.104/examples/windows/debug/framestrack/FramesTrackExample.dof
new file mode 100644
index 0000000..e957ac9
--- /dev/null
+++ b/official/1.104/examples/windows/debug/framestrack/FramesTrackExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\..\bin
+
diff --git a/official/1.104/examples/windows/debug/framestrack/FramesTrackExample.dpr b/official/1.104/examples/windows/debug/framestrack/FramesTrackExample.dpr
new file mode 100644
index 0000000..dd6c45c
--- /dev/null
+++ b/official/1.104/examples/windows/debug/framestrack/FramesTrackExample.dpr
@@ -0,0 +1,16 @@
+program FramesTrackExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ FramesTrackDemoMain in 'FramesTrackDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/debug/framestrack/FramesTrackExample.res b/official/1.104/examples/windows/debug/framestrack/FramesTrackExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/debug/framestrack/FramesTrackExample.res differ
diff --git a/official/1.104/examples/windows/debug/reportconverter/ExceptionReportConverter.dpr b/official/1.104/examples/windows/debug/reportconverter/ExceptionReportConverter.dpr
new file mode 100644
index 0000000..97cad84
--- /dev/null
+++ b/official/1.104/examples/windows/debug/reportconverter/ExceptionReportConverter.dpr
@@ -0,0 +1,18 @@
+program ExceptionReportConverter;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ formConverter in 'formConverter.pas' {frmConverter},
+ ExceptDlgMail in '..\..\..\..\EXPERTS\DEBUG\DIALOG\EXCEPTDLGMAIL.pas' {ExceptionDialogMail};
+
+{$R *.res}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'Exception Report Converter';
+ Application.CreateForm(TfrmConverter, frmConverter);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/debug/reportconverter/ExceptionReportConverter.res b/official/1.104/examples/windows/debug/reportconverter/ExceptionReportConverter.res
new file mode 100644
index 0000000..d8a5528
Binary files /dev/null and b/official/1.104/examples/windows/debug/reportconverter/ExceptionReportConverter.res differ
diff --git a/official/1.104/examples/windows/debug/reportconverter/formConverter.dfm b/official/1.104/examples/windows/debug/reportconverter/formConverter.dfm
new file mode 100644
index 0000000..c1895f6
--- /dev/null
+++ b/official/1.104/examples/windows/debug/reportconverter/formConverter.dfm
@@ -0,0 +1,65 @@
+object frmConverter: TfrmConverter
+ Left = 227
+ Top = 119
+ ClientWidth = 454
+ ClientHeight = 80
+ Caption = 'Exception Report Converter'
+ 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 btnConvert: TButton
+ Left = 368
+ Top = 9
+ Width = 75
+ Height = 25
+ Caption = '&Convert'
+ TabOrder = 2
+ OnClick = btnConvertClick
+ end
+ object txtReportFile: TEdit
+ Left = 8
+ Top = 11
+ Width = 313
+ Height = 21
+ TabOrder = 0
+ Text = 'txtReportFile'
+ end
+ object txtMapFile: TEdit
+ Left = 8
+ Top = 51
+ Width = 313
+ Height = 21
+ TabOrder = 1
+ Text = 'txtMapFile'
+ end
+ object btnReportFile: TButton
+ Left = 328
+ Top = 9
+ Width = 22
+ Height = 25
+ Caption = '...'
+ TabOrder = 3
+ OnClick = btnReportFileClick
+ end
+ object btnMapFile: TButton
+ Left = 328
+ Top = 49
+ Width = 22
+ Height = 25
+ Caption = '...'
+ TabOrder = 4
+ OnClick = btnMapFileClick
+ end
+ object dlgOpen: TOpenDialog
+ Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+ Left = 392
+ Top = 51
+ end
+end
diff --git a/official/1.104/examples/windows/debug/reportconverter/formConverter.pas b/official/1.104/examples/windows/debug/reportconverter/formConverter.pas
new file mode 100644
index 0000000..d154500
--- /dev/null
+++ b/official/1.104/examples/windows/debug/reportconverter/formConverter.pas
@@ -0,0 +1,194 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is formConverter.pas. }
+{ }
+{ The Initial Developer of the Original Code is Elahn Ientile }
+{ Portions created by Elahn Ientile are Copyright (C) Elahn Ientile. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Converts a report send by TExceptionDialogMail where no Debug Info or Map file was present into }
+{ a report equivalent to one where Debug Info or Map file was present, i.e. inc. line numbers, etc }
+{ }
+{ Note: to generate a Map file on compile, add "-GD" to [project name].cfg }
+{ the map file used must be the one generated when that copy of the program was compiled }
+{ }
+{ Unit owner: Elahn Ientile }
+{ Last modified: $Date: 2006-09-03 11:36:16 +0200 (dim., 03 sept. 2006) $ }
+{ }
+{**************************************************************************************************}
+
+unit formConverter;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, JclDebug;
+
+type
+ TfrmConverter = class(TForm)
+ btnConvert: TButton;
+ txtReportFile: TEdit;
+ txtMapFile: TEdit;
+ btnReportFile: TButton;
+ btnMapFile: TButton;
+ dlgOpen: TOpenDialog;
+ procedure btnConvertClick(Sender: TObject);
+ procedure btnReportFileClick(Sender: TObject);
+ procedure btnMapFileClick(Sender: TObject);
+ private
+ FScanner: TJclMapScanner;
+ public
+ procedure ConvertFile(AMap, AInput, AOutput: TFileName);
+ function FormatInfo(var Info: TJclLocationInfo;
+ IncludeAddressOffset: Boolean = True;
+ IncludeStartProcLineOffset: Boolean = True): string;
+ function GetVALocationInfo(const VA: DWORD; var Info: TJclLocationInfo): Boolean;
+ end;
+
+var
+ frmConverter: TfrmConverter;
+
+implementation
+
+{$R *.dfm}
+
+procedure TfrmConverter.btnConvertClick(Sender: TObject);
+var
+ lStr, lExt: string;
+begin
+ if not FileExists(txtReportFile.Text) then
+ ShowMessage('Report File does not exist.')
+ else if not FileExists(txtMapFile.Text) then
+ ShowMessage('Map File does not exist.')
+ else
+ begin
+ lStr := txtReportFile.Text;
+ lExt := ExtractFileExt(lStr);
+ Insert('.converted', lStr, Length(lStr) + 1 - Length(lExt));
+ ConvertFile(txtMapFile.Text, txtReportFile.Text, lStr);
+ end;
+end;
+
+procedure TfrmConverter.ConvertFile(AMap, AInput, AOutput: TFileName);
+var
+ ls: TStringList;
+ i: Integer;
+ lInStackList: Boolean;
+ s: string;
+ VA: DWORD;
+ Info: TJclLocationInfo;
+begin
+ FScanner := TJclMapScanner.Create(AMap);
+ ls := TStringList.Create;
+ try
+ ls.LoadFromFile(AInput);
+ if ls.Count = 0 then
+ Exit;
+ lInStackList := False;
+ i := 0;
+ while i < ls.Count do
+ begin
+ if (Copy(ls[i], 1, 3) = '---') then
+ if lInStackList then
+ Break
+ else if Copy(ls[i+1], 1, 10) = 'Stack list' then
+ begin
+ lInStackList := True;
+ Inc(i, 2);
+ end;
+ if lInStackList and (Copy(ls[i], 1, 1) = '(') then
+ begin
+ s := '$' + Copy(ls[i], 2, 8);
+ VA := DWORD(StrToInt64(s));
+ if GetVALocationInfo(VA, Info) then
+ ls[i] := ls[i] + FormatInfo(Info);
+ end;
+ Inc(i);
+ end;
+ ls.SaveToFile(AOutput);
+ ShowMessage('Successfully converted. Output filename:' + #13#10#13#10 + AOutput);
+ finally
+ ls.Free;
+ end;
+end;
+
+function TfrmConverter.FormatInfo(var Info: TJclLocationInfo;
+ IncludeAddressOffset, IncludeStartProcLineOffset: Boolean): string;
+var
+ StartProcInfo: TJclLocationInfo;
+ OffsetStr, StartProcOffsetStr: string;
+begin
+ OffsetStr := '';
+ with Info do
+ begin
+ if LineNumber > 0 then
+ begin
+ if IncludeStartProcLineOffset and GetVALocationInfo(DWORD(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(' %s.%s (Line %u, "%s"%s)%s', [UnitName, ProcedureName, LineNumber,
+ SourceName, StartProcOffsetStr, OffsetStr]);
+ end
+ else
+ begin
+ if IncludeAddressOffset then
+ OffsetStr := Format(' + $%x', [OffsetFromProcName]);
+ if UnitName <> '' then
+ Result := Format(' %s.%s%s', [UnitName, ProcedureName, OffsetStr])
+ else
+ Result := Format(' %s%s', [ProcedureName, OffsetStr]);
+ end;
+ end;
+end;
+
+function TfrmConverter.GetVALocationInfo(const VA: DWORD; var Info: TJclLocationInfo): Boolean;
+begin
+ with FScanner do
+ begin
+ Info.UnitName := ModuleNameFromAddr(VA);
+ Result := (Info.UnitName <> '');
+ if Result then
+ begin
+ Info.Address := Pointer(VA);
+ Info.ProcedureName := ProcNameFromAddr(VA, Info.OffsetFromProcName);
+ Info.LineNumber := LineNumberFromAddr(VA, Info.OffsetFromLineNumber);
+ Info.SourceName := SourceNameFromAddr(VA);
+ Info.DebugInfo := nil;
+ end;
+ end;
+end;
+
+procedure TfrmConverter.btnReportFileClick(Sender: TObject);
+begin
+ if dlgOpen.Execute then
+ txtReportFile.Text := dlgOpen.FileName;
+end;
+
+procedure TfrmConverter.btnMapFileClick(Sender: TObject);
+begin
+ if dlgOpen.Execute then
+ txtMapFile.Text := dlgOpen.FileName;
+end;
+
+end.
diff --git a/official/1.104/examples/windows/debug/sourceloc/SourceLocDemoMain.dfm b/official/1.104/examples/windows/debug/sourceloc/SourceLocDemoMain.dfm
new file mode 100644
index 0000000..30fdc88
--- /dev/null
+++ b/official/1.104/examples/windows/debug/sourceloc/SourceLocDemoMain.dfm
@@ -0,0 +1,134 @@
+object Form1: TForm1
+ Left = 192
+ Top = 107
+ ClientWidth = 638
+ ClientHeight = 485
+ 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.104/examples/windows/debug/sourceloc/SourceLocDemoMain.pas b/official/1.104/examples/windows/debug/sourceloc/SourceLocDemoMain.pas
new file mode 100644
index 0000000..5b5c14b
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/sourceloc/SourceLocExample.dof b/official/1.104/examples/windows/debug/sourceloc/SourceLocExample.dof
new file mode 100644
index 0000000..e957ac9
--- /dev/null
+++ b/official/1.104/examples/windows/debug/sourceloc/SourceLocExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\..\bin
+
diff --git a/official/1.104/examples/windows/debug/sourceloc/SourceLocExample.dpr b/official/1.104/examples/windows/debug/sourceloc/SourceLocExample.dpr
new file mode 100644
index 0000000..d266117
--- /dev/null
+++ b/official/1.104/examples/windows/debug/sourceloc/SourceLocExample.dpr
@@ -0,0 +1,16 @@
+program SourceLocExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ SourceLocDemoMain in 'SourceLocDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/debug/sourceloc/SourceLocExample.res b/official/1.104/examples/windows/debug/sourceloc/SourceLocExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/debug/sourceloc/SourceLocExample.res differ
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.bdsproj b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.bdsproj
new file mode 100644
index 0000000..32e0e8f
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.bdsproj
@@ -0,0 +1,175 @@
+
+
+
+
+ Delphi.Personality
+ VCLApplication
+ 1.0
+ {28EE2091-005E-4A61-8C18-68F6887EC29A}
+
+
+
+
+ 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.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dof b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dof
new file mode 100644
index 0000000..18ab99a
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\..\bin
+Conditionals=HOOK_DLL_EXCEPTIONS
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dpr b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dpr
new file mode 100644
index 0000000..965f9da
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.dpr
@@ -0,0 +1,21 @@
+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.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.res b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.res differ
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.tlb b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.tlb
new file mode 100644
index 0000000..ce1f5db
Binary files /dev/null and b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary.tlb differ
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary_TLB.pas b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComLibrary_TLB.pas
new file mode 100644
index 0000000..d440ef8
--- /dev/null
+++ b/official/1.104/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: 1658 $
+// 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.104/examples/windows/debug/stacktrack/StackTrackDLLsComUnit.pas b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsComUnit.pas
new file mode 100644
index 0000000..d4c37f9
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.dfm b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.dfm
new file mode 100644
index 0000000..bf364b7
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.pas b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDemoMain.pas
new file mode 100644
index 0000000..cde7fe8
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.bdsproj b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.bdsproj
new file mode 100644
index 0000000..dcc7f08
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.bdsproj
@@ -0,0 +1,175 @@
+
+
+
+
+ Delphi.Personality
+ VCLApplication
+ 1.0
+ {B1AF12A9-9CFB-4CCA-A20A-368DF8B9862C}
+
+
+
+
+ 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.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dof b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dof
new file mode 100644
index 0000000..18ab99a
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\..\bin
+Conditionals=HOOK_DLL_EXCEPTIONS
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dpr b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.dpr
new file mode 100644
index 0000000..6470da7
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.res b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicLibrary.res differ
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicUnit.pas b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsDynamicUnit.pas
new file mode 100644
index 0000000..2b92f16
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.bdsproj b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.bdsproj
new file mode 100644
index 0000000..ef3bf94
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.bdsproj
@@ -0,0 +1,175 @@
+
+
+
+
+ Delphi.Personality
+ VCLApplication
+ 1.0
+ {408349D8-6067-4996-8244-C20B50486C5D}
+
+
+
+
+ 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.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.dof b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.dof
new file mode 100644
index 0000000..18ab99a
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\..\bin
+Conditionals=HOOK_DLL_EXCEPTIONS
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.dpr b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.dpr
new file mode 100644
index 0000000..a034fb8
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.dpr
@@ -0,0 +1,17 @@
+program StackTrackDLLsExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ StackTrackDLLsDemoMain in 'StackTrackDLLsDemoMain.pas' {MainForm},
+ ExceptDlg in '..\..\..\..\experts\debug\dialog\ExceptDlg.pas' {ExceptionDialog};
+
+{$R *.res}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.res b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsExample.res differ
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.bdsproj b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.bdsproj
new file mode 100644
index 0000000..cbba2ac
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.bdsproj
@@ -0,0 +1,175 @@
+
+
+
+
+ Delphi.Personality
+ VCLApplication
+ 1.0
+ {23237F7B-FDEE-4A59-8911-0784E4314F34}
+
+
+
+
+ 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.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dof b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dof
new file mode 100644
index 0000000..18ab99a
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\..\bin
+Conditionals=HOOK_DLL_EXCEPTIONS
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dpr b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.dpr
new file mode 100644
index 0000000..2584a09
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.res b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticLibrary.res differ
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticUnit.pas b/official/1.104/examples/windows/debug/stacktrack/StackTrackDLLsStaticUnit.pas
new file mode 100644
index 0000000..3b3922e
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/stacktrack/StackTrackDemoMain.dfm b/official/1.104/examples/windows/debug/stacktrack/StackTrackDemoMain.dfm
new file mode 100644
index 0000000..d1ffa55
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackDemoMain.dfm
@@ -0,0 +1,95 @@
+object MainForm: TMainForm
+ Left = 342
+ Top = 197
+ ClientWidth = 606
+ ClientHeight = 497
+ 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.104/examples/windows/debug/stacktrack/StackTrackDemoMain.pas b/official/1.104/examples/windows/debug/stacktrack/StackTrackDemoMain.pas
new file mode 100644
index 0000000..93cec82
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/stacktrack/StackTrackExample.bdsproj b/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.bdsproj
new file mode 100644
index 0000000..c75588d
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.bdsproj
@@ -0,0 +1,175 @@
+
+
+
+
+ Delphi.Personality
+ VCLApplication
+ 1.0
+ {EB18AE6A-75B1-47E9-BCBF-154C37E9DFA1}
+
+
+
+
+ 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.104/examples/windows/debug/stacktrack/StackTrackExample.dof b/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.dof
new file mode 100644
index 0000000..18ab99a
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\..\bin
+Conditionals=HOOK_DLL_EXCEPTIONS
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.dpr b/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.dpr
new file mode 100644
index 0000000..26cacb4
--- /dev/null
+++ b/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.dpr
@@ -0,0 +1,16 @@
+program StackTrackExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ StackTrackDemoMain in 'StackTrackDemoMain.pas' {MainForm};
+
+{$R *.RES}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.res b/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/debug/stacktrack/StackTrackExample.res differ
diff --git a/official/1.104/examples/windows/debug/threadexcept/ThreadExceptDemoMain.dfm b/official/1.104/examples/windows/debug/threadexcept/ThreadExceptDemoMain.dfm
new file mode 100644
index 0000000..6e7b376
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/threadexcept/ThreadExceptDemoMain.pas b/official/1.104/examples/windows/debug/threadexcept/ThreadExceptDemoMain.pas
new file mode 100644
index 0000000..10b523e
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/debug/threadexcept/ThreadExceptExample.dof b/official/1.104/examples/windows/debug/threadexcept/ThreadExceptExample.dof
new file mode 100644
index 0000000..9acd2cf
--- /dev/null
+++ b/official/1.104/examples/windows/debug/threadexcept/ThreadExceptExample.dof
@@ -0,0 +1,4 @@
+[Directories]
+OutputDir=../../../../bin
+
+
diff --git a/official/1.104/examples/windows/debug/threadexcept/ThreadExceptExample.dpr b/official/1.104/examples/windows/debug/threadexcept/ThreadExceptExample.dpr
new file mode 100644
index 0000000..9efd090
--- /dev/null
+++ b/official/1.104/examples/windows/debug/threadexcept/ThreadExceptExample.dpr
@@ -0,0 +1,18 @@
+program ThreadExceptExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ JclIdeThreadStatus in '..\..\..\..\experts\debug\threadnames\JclIdeThreadStatus.pas',
+ ThreadExpertSharedNames in '..\..\..\..\experts\debug\threadnames\ThreadExpertSharedNames.pas',
+ ThreadExceptDemoMain in 'ThreadExceptDemoMain.pas' {MainForm};
+
+{$R *.res}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/debug/threadexcept/ThreadExceptExample.res b/official/1.104/examples/windows/debug/threadexcept/ThreadExceptExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/debug/threadexcept/ThreadExceptExample.res differ
diff --git a/official/1.104/examples/windows/delphitools/DelphiToolsGroup.bpg b/official/1.104/examples/windows/delphitools/DelphiToolsGroup.bpg
new file mode 100644
index 0000000..7a36fb3
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/Readme.txt b/official/1.104/examples/windows/delphitools/Readme.txt
new file mode 100644
index 0000000..ad67294
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/common/About.dfm b/official/1.104/examples/windows/delphitools/common/About.dfm
new file mode 100644
index 0000000..b4ca5ee
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/common/About.pas b/official/1.104/examples/windows/delphitools/common/About.pas
new file mode 100644
index 0000000..1c21e43
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/common/About.pas
@@ -0,0 +1,180 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/common/D6MdiMsgFix.pas b/official/1.104/examples/windows/delphitools/common/D6MdiMsgFix.pas
new file mode 100644
index 0000000..665734a
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/common/D6MdiMsgFix.pas
@@ -0,0 +1,85 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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}
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/common/FindDlg.dfm b/official/1.104/examples/windows/delphitools/common/FindDlg.dfm
new file mode 100644
index 0000000..ad3da51
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/common/FindDlg.pas b/official/1.104/examples/windows/delphitools/common/FindDlg.pas
new file mode 100644
index 0000000..2d97cb7
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/common/FindDlg.pas
@@ -0,0 +1,202 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/common/SHDocVw_TLB.pas b/official/1.104/examples/windows/delphitools/common/SHDocVw_TLB.pas
new file mode 100644
index 0000000..c214a5f
--- /dev/null
+++ b/official/1.104/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: 1658 $
+// 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.104/examples/windows/delphitools/common/ToolsUtils.pas b/official/1.104/examples/windows/delphitools/common/ToolsUtils.pas
new file mode 100644
index 0000000..4eac6df
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/common/ToolsUtils.pas
@@ -0,0 +1,380 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $ }
+{ }
+{**************************************************************************************************}
+
+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, JclWin32;
+
+resourcestring
+ RsJCLLink = 'JEDI Code Library;http://delphi-jedi.org/Jedi:CODELIBJCL';
+ RsEmailAddress = 'mailto:petr.v@mujmail.cz?subject=[Delphi Tools]';
+
+function StrEmpty(const S: string): 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 CharIsDigit(S[I])) and (S[I] <> '-') then
+ Delete(S, I, 1)
+ else
+ Inc(I);
+ Result := StrToIntDef(S, 0);
+end;
+
+function GetImageBase(const FileName: TFileName): DWORD;
+var
+ NtHeaders32: TImageNtHeaders32;
+ NtHeaders64: TImageNtHeaders64;
+ ImageStream: TMemoryStream;
+ PETarget: TJclPeTarget;
+begin
+ ImageStream := TMemoryStream.Create;
+ try
+ ImageStream.LoadFromFile(FileName);
+ PETarget := PeMapImgTarget(ImageStream.Memory);
+ finally
+ ImageStream.Free;
+ end;
+ if (PETarget = taWin32) and PeGetNtHeaders32(FileName, NtHeaders32) then
+ Result := NtHeaders32.OptionalHeader.ImageBase
+ else
+ if (PETarget = taWin64) and PeGetNtHeaders64(FileName, NtHeaders64) then
+ Result := NtHeaders64.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}
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/dependencyviewer/DependView.dof b/official/1.104/examples/windows/delphitools/dependencyviewer/DependView.dof
new file mode 100644
index 0000000..3b9e1ca
--- /dev/null
+++ b/official/1.104/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\include;..\..\..\..\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.104/examples/windows/delphitools/dependencyviewer/DependView.dpr b/official/1.104/examples/windows/delphitools/dependencyviewer/DependView.dpr
new file mode 100644
index 0000000..a4fe8a4
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/dependencyviewer/DependView.dpr
@@ -0,0 +1,24 @@
+program DependView;
+
+{$I jcl.inc}
+
+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}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'Dependency Viewer';
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/delphitools/dependencyviewer/DependView.res b/official/1.104/examples/windows/delphitools/dependencyviewer/DependView.res
new file mode 100644
index 0000000..e3af773
Binary files /dev/null and b/official/1.104/examples/windows/delphitools/dependencyviewer/DependView.res differ
diff --git a/official/1.104/examples/windows/delphitools/dependencyviewer/DependViewMain.dfm b/official/1.104/examples/windows/delphitools/dependencyviewer/DependViewMain.dfm
new file mode 100644
index 0000000..b7fab92
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/dependencyviewer/DependViewMain.pas b/official/1.104/examples/windows/delphitools/dependencyviewer/DependViewMain.pas
new file mode 100644
index 0000000..69ed70a
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/dependencyviewer/DependViewMain.pas
@@ -0,0 +1,346 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $ }
+{ }
+{**************************************************************************************************}
+
+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 (FileName[1] <> '-') and (FileName[1] <> '/') 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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/dependencyviewer/FileViewer.dfm b/official/1.104/examples/windows/delphitools/dependencyviewer/FileViewer.dfm
new file mode 100644
index 0000000..1b9932a
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/dependencyviewer/FileViewer.pas b/official/1.104/examples/windows/delphitools/dependencyviewer/FileViewer.pas
new file mode 100644
index 0000000..1f46411
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/dependencyviewer/FileViewer.pas
@@ -0,0 +1,667 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2008-08-07 23:54:09 +0200 (jeu., 07 août 2008) $ }
+{ }
+{**************************************************************************************************}
+
+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,
+ JclBase, 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;
+const
+ BracketChars: array [0..1] of Char = ( '[', ']' );
+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, BracketChars);
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeDump.dfm b/official/1.104/examples/windows/delphitools/peviewer/PeDump.dfm
new file mode 100644
index 0000000..54f3017
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/peviewer/PeDump.pas b/official/1.104/examples/windows/delphitools/peviewer/PeDump.pas
new file mode 100644
index 0000000..ad6f776
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/peviewer/PeDump.pas
@@ -0,0 +1,943 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2007-02-04 19:37:27 +0100 (dim., 04 févr. 2007) $ }
+{ }
+{**************************************************************************************************}
+
+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
+ if FPeImage.Target = taWin64 then
+ begin
+ with Item, FPeImage.OptionalHeader64 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
+ else
+ begin
+ with Item, FPeImage.OptionalHeader32 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;
+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
+ if FPeImage.Target = taWin64 then
+ Percent := SizeOfRawData * 100 / OptionalHeader64.SizeOfImage
+ else
+ Percent := SizeOfRawData * 100 / OptionalHeader32.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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeGenDef.dfm b/official/1.104/examples/windows/delphitools/peviewer/PeGenDef.dfm
new file mode 100644
index 0000000..a157874
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/peviewer/PeGenDef.dfm
@@ -0,0 +1,144 @@
+object PeGenDefChild: TPeGenDefChild
+ Left = 278
+ Top = 149
+ ClientWidth = 401
+ ClientHeight = 312
+ 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.104/examples/windows/delphitools/peviewer/PeGenDef.pas b/official/1.104/examples/windows/delphitools/peviewer/PeGenDef.pas
new file mode 100644
index 0000000..eb9ce0e
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/peviewer/PeGenDef.pas
@@ -0,0 +1,365 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+ function CharIsValidLeadingChar(const C: Char): Boolean;
+ begin
+ case C of
+ 'A'..'Z',
+ 'a'..'z':
+ Result := True;
+ else
+ Result := False;
+ end;
+ end;
+ function CharIsStripLeadingChar(const C: Char): Boolean;
+ begin
+ Result := C = '_';
+ end;
+ function CharIsValid(const C: Char): Boolean;
+ begin
+ case C of
+ 'A'..'Z',
+ 'a'..'z',
+ '0'..'9':
+ Result := True;
+ else
+ Result := False;
+ end;
+ end;
+const
+ 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 CharIsValidLeadingChar(C) then
+ Result := Result + C
+ else
+ if not CharIsStripLeadingChar(C) then
+ Break; // probably MS C++ or Borland name decoration
+ end else
+ begin
+ if CharIsValid(C) 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: AnsiChar;
+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] = '?') and (Name[1] = '@');
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeResView.dfm b/official/1.104/examples/windows/delphitools/peviewer/PeResView.dfm
new file mode 100644
index 0000000..edb8b7c
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/peviewer/PeResView.pas b/official/1.104/examples/windows/delphitools/peviewer/PeResView.pas
new file mode 100644
index 0000000..c327618
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/peviewer/PeResView.pas
@@ -0,0 +1,710 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2008-08-11 14:23:08 +0200 (lun., 11 août 2008) $ }
+{ }
+{**************************************************************************************************}
+
+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], CharIsReturn));
+ 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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeResource.pas b/official/1.104/examples/windows/delphitools/peviewer/PeResource.pas
new file mode 100644
index 0000000..d967dd2
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/peviewer/PeResource.pas
@@ -0,0 +1,1541 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $ }
+{ }
+{**************************************************************************************************}
+
+unit PeResource;
+
+{$I JCL.INC}
+
+interface
+
+uses
+ Windows, Messages, Classes, SysUtils, Graphics, ComCtrls, Contnrs,
+ 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
+ {$IFDEF SUPPORTS_UNICODE}
+ SetLength(Result, Len);
+ if Len > 0 then
+ Move(WStr^, Result[1], Len * SizeOf(WideChar));
+ {$ELSE SUPPORTS_UNICODE}
+ 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);
+ {$ENDIF ~SUPPORTS_UNICODE}
+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, CharIsReturn);
+ 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, CharIsReturn);
+ 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);
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeSearch.dfm b/official/1.104/examples/windows/delphitools/peviewer/PeSearch.dfm
new file mode 100644
index 0000000..272339e
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/peviewer/PeSearch.pas b/official/1.104/examples/windows/delphitools/peviewer/PeSearch.pas
new file mode 100644
index 0000000..56cc4d0
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/peviewer/PeSearch.pas
@@ -0,0 +1,226 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeViewer.dof b/official/1.104/examples/windows/delphitools/peviewer/PeViewer.dof
new file mode 100644
index 0000000..cbce52f
--- /dev/null
+++ b/official/1.104/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\ignore;..\..\..\..\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.104/examples/windows/delphitools/peviewer/PeViewer.dpr b/official/1.104/examples/windows/delphitools/peviewer/PeViewer.dpr
new file mode 100644
index 0000000..7a9b5a8
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/peviewer/PeViewer.dpr
@@ -0,0 +1,33 @@
+program PeViewer;
+
+{$I jcl.inc}
+
+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}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'PE Viewer';
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeViewer.res b/official/1.104/examples/windows/delphitools/peviewer/PeViewer.res
new file mode 100644
index 0000000..26d12ee
Binary files /dev/null and b/official/1.104/examples/windows/delphitools/peviewer/PeViewer.res differ
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeViewer.tlb b/official/1.104/examples/windows/delphitools/peviewer/PeViewer.tlb
new file mode 100644
index 0000000..bd17d10
Binary files /dev/null and b/official/1.104/examples/windows/delphitools/peviewer/PeViewer.tlb differ
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeViewerControl.pas b/official/1.104/examples/windows/delphitools/peviewer/PeViewerControl.pas
new file mode 100644
index 0000000..3c252cf
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/peviewer/PeViewerControl.pas
@@ -0,0 +1,83 @@
+{**************************************************************************************************}
+{ }
+{ 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-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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);
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeViewerMain.dfm b/official/1.104/examples/windows/delphitools/peviewer/PeViewerMain.dfm
new file mode 100644
index 0000000..e5aa53f
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/peviewer/PeViewerMain.pas b/official/1.104/examples/windows/delphitools/peviewer/PeViewerMain.pas
new file mode 100644
index 0000000..c67de68
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/peviewer/PeViewerMain.pas
@@ -0,0 +1,631 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $ }
+{ }
+{**************************************************************************************************}
+
+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 (FileName[1] <> '-') and (FileName[1] <> '/') 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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/peviewer/PeViewer_TLB.pas b/official/1.104/examples/windows/delphitools/peviewer/PeViewer_TLB.pas
new file mode 100644
index 0000000..0175573
--- /dev/null
+++ b/official/1.104/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: 1658 $
+// 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.104/examples/windows/delphitools/resfix/ResFix.dof b/official/1.104/examples/windows/delphitools/resfix/ResFix.dof
new file mode 100644
index 0000000..e6fdb31
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/resfix/ResFix.dof
@@ -0,0 +1,137 @@
+[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\include;..\..\..\..\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=
+
diff --git a/official/1.104/examples/windows/delphitools/resfix/ResFix.dpr b/official/1.104/examples/windows/delphitools/resfix/ResFix.dpr
new file mode 100644
index 0000000..c829783
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/resfix/ResFix.dpr
@@ -0,0 +1,20 @@
+program ResFix;
+
+{$I jcl.inc}
+
+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}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'ResFix';
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/delphitools/resfix/ResFix.res b/official/1.104/examples/windows/delphitools/resfix/ResFix.res
new file mode 100644
index 0000000..ef1acfc
Binary files /dev/null and b/official/1.104/examples/windows/delphitools/resfix/ResFix.res differ
diff --git a/official/1.104/examples/windows/delphitools/resfix/ResFixMain.dfm b/official/1.104/examples/windows/delphitools/resfix/ResFixMain.dfm
new file mode 100644
index 0000000..19a14e9
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/resfix/ResFixMain.pas b/official/1.104/examples/windows/delphitools/resfix/ResFixMain.pas
new file mode 100644
index 0000000..d825f2d
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/resfix/ResFixMain.pas
@@ -0,0 +1,263 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/screenjpg/Main.dfm b/official/1.104/examples/windows/delphitools/screenjpg/Main.dfm
new file mode 100644
index 0000000..071988c
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/screenjpg/Main.pas b/official/1.104/examples/windows/delphitools/screenjpg/Main.pas
new file mode 100644
index 0000000..bb8532c
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/screenjpg/Main.pas
@@ -0,0 +1,285 @@
+{**************************************************************************************************}
+{ }
+{ 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-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/screenjpg/ScreenJPG.dof b/official/1.104/examples/windows/delphitools/screenjpg/ScreenJPG.dof
new file mode 100644
index 0000000..8f9e4b1
--- /dev/null
+++ b/official/1.104/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\include;..\..\..\..\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.104/examples/windows/delphitools/screenjpg/ScreenJPG.dpr b/official/1.104/examples/windows/delphitools/screenjpg/ScreenJPG.dpr
new file mode 100644
index 0000000..ef7a5f8
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/screenjpg/ScreenJPG.dpr
@@ -0,0 +1,20 @@
+program ScreenJPG;
+
+{$I jcl.inc}
+
+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}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'ScreenJPG';
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/delphitools/screenjpg/ScreenJPG.res b/official/1.104/examples/windows/delphitools/screenjpg/ScreenJPG.res
new file mode 100644
index 0000000..0a04ff1
Binary files /dev/null and b/official/1.104/examples/windows/delphitools/screenjpg/ScreenJPG.res differ
diff --git a/official/1.104/examples/windows/delphitools/toolhelpview/ChangePriority.dfm b/official/1.104/examples/windows/delphitools/toolhelpview/ChangePriority.dfm
new file mode 100644
index 0000000..dc72ece
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/toolhelpview/ChangePriority.pas b/official/1.104/examples/windows/delphitools/toolhelpview/ChangePriority.pas
new file mode 100644
index 0000000..93c32cb
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/toolhelpview/ChangePriority.pas
@@ -0,0 +1,114 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/toolhelpview/Global.dfm b/official/1.104/examples/windows/delphitools/toolhelpview/Global.dfm
new file mode 100644
index 0000000..7933378
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/toolhelpview/Global.pas b/official/1.104/examples/windows/delphitools/toolhelpview/Global.pas
new file mode 100644
index 0000000..2495496
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/toolhelpview/Global.pas
@@ -0,0 +1,132 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/toolhelpview/HeapDump.dfm b/official/1.104/examples/windows/delphitools/toolhelpview/HeapDump.dfm
new file mode 100644
index 0000000..8707fd7
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/toolhelpview/HeapDump.pas b/official/1.104/examples/windows/delphitools/toolhelpview/HeapDump.pas
new file mode 100644
index 0000000..88f6be3
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/toolhelpview/HeapDump.pas
@@ -0,0 +1,334 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/toolhelpview/Main.dfm b/official/1.104/examples/windows/delphitools/toolhelpview/Main.dfm
new file mode 100644
index 0000000..02526b3
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/toolhelpview/Main.pas b/official/1.104/examples/windows/delphitools/toolhelpview/Main.pas
new file mode 100644
index 0000000..b8cf640
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/toolhelpview/Main.pas
@@ -0,0 +1,936 @@
+{**************************************************************************************************}
+{ }
+{ 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-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/toolhelpview/MemoryDump.dfm b/official/1.104/examples/windows/delphitools/toolhelpview/MemoryDump.dfm
new file mode 100644
index 0000000..5b14849
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/toolhelpview/MemoryDump.pas b/official/1.104/examples/windows/delphitools/toolhelpview/MemoryDump.pas
new file mode 100644
index 0000000..3dafc32
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/toolhelpview/MemoryDump.pas
@@ -0,0 +1,518 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $ }
+{ }
+{**************************************************************************************************}
+
+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);
+ {$IFDEF SUPPORTS_UNICODE}
+ S := WideString(W^);
+ {$ELSE ~SUPPORTS_UNICODE}
+ WideCharToMultiByte(CP_ACP, 0, W, 1, PAnsiChar(S), 1, nil, nil);
+ {$ENDIF ~SUPPORTS_UNICODE}
+ 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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/toolhelpview/ModulesDump.dfm b/official/1.104/examples/windows/delphitools/toolhelpview/ModulesDump.dfm
new file mode 100644
index 0000000..71750ff
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/delphitools/toolhelpview/ModulesDump.pas b/official/1.104/examples/windows/delphitools/toolhelpview/ModulesDump.pas
new file mode 100644
index 0000000..1cda690
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/toolhelpview/ModulesDump.pas
@@ -0,0 +1,245 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dof b/official/1.104/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dof
new file mode 100644
index 0000000..c2f51c3
--- /dev/null
+++ b/official/1.104/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\include;..\..\..\..\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.104/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dpr b/official/1.104/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dpr
new file mode 100644
index 0000000..d220e93
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/toolhelpview/ToolHelpViewer.dpr
@@ -0,0 +1,35 @@
+program ToolHelpViewer;
+
+{$I jcl.inc}
+
+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}
+{$R ..\..\..\..\source\windows\JclCommCtrlAsInvoker.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.104/examples/windows/delphitools/toolhelpview/ToolHelpViewer.res b/official/1.104/examples/windows/delphitools/toolhelpview/ToolHelpViewer.res
new file mode 100644
index 0000000..12a2ffd
Binary files /dev/null and b/official/1.104/examples/windows/delphitools/toolhelpview/ToolHelpViewer.res differ
diff --git a/official/1.104/examples/windows/delphitools/toolhelpview/ViewTemplate.dfm b/official/1.104/examples/windows/delphitools/toolhelpview/ViewTemplate.dfm
new file mode 100644
index 0000000..9496ff8
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/toolhelpview/ViewTemplate.dfm
@@ -0,0 +1,109 @@
+object ViewForm: TViewForm
+ Left = 288
+ Top = 168
+ ClientWidth = 340
+ ClientHeight = 284
+ 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.104/examples/windows/delphitools/toolhelpview/ViewTemplate.pas b/official/1.104/examples/windows/delphitools/toolhelpview/ViewTemplate.pas
new file mode 100644
index 0000000..d9a10df
--- /dev/null
+++ b/official/1.104/examples/windows/delphitools/toolhelpview/ViewTemplate.pas
@@ -0,0 +1,155 @@
+{**************************************************************************************************}
+{ }
+{ 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: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/examples/windows/edisdk/Clean.bat b/official/1.104/examples/windows/edisdk/Clean.bat
new file mode 100644
index 0000000..2bca898
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/edisdk/EDICOMExample.dof b/official/1.104/examples/windows/edisdk/EDICOMExample.dof
new file mode 100644
index 0000000..abe45c2
--- /dev/null
+++ b/official/1.104/examples/windows/edisdk/EDICOMExample.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=..\..\..\bin
diff --git a/official/1.104/examples/windows/edisdk/EDICOMExample.dpr b/official/1.104/examples/windows/edisdk/EDICOMExample.dpr
new file mode 100644
index 0000000..0ba1c24
--- /dev/null
+++ b/official/1.104/examples/windows/edisdk/EDICOMExample.dpr
@@ -0,0 +1,16 @@
+program EDICOMExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ EDICOMExampleMain in 'EDICOMExampleMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/edisdk/EDICOMExample.res b/official/1.104/examples/windows/edisdk/EDICOMExample.res
new file mode 100644
index 0000000..55f8742
Binary files /dev/null and b/official/1.104/examples/windows/edisdk/EDICOMExample.res differ
diff --git a/official/1.104/examples/windows/edisdk/EDICOMExampleMain.dfm b/official/1.104/examples/windows/edisdk/EDICOMExampleMain.dfm
new file mode 100644
index 0000000..ac5e7df
--- /dev/null
+++ b/official/1.104/examples/windows/edisdk/EDICOMExampleMain.dfm
@@ -0,0 +1,50 @@
+object Form1: TForm1
+ Left = 192
+ Top = 107
+ ClientWidth = 688
+ ClientHeight = 454
+ 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.104/examples/windows/edisdk/EDICOMExampleMain.pas b/official/1.104/examples/windows/edisdk/EDICOMExampleMain.pas
new file mode 100644
index 0000000..48cfdec
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/edisdk/EDISDK_TLB.dcr b/official/1.104/examples/windows/edisdk/EDISDK_TLB.dcr
new file mode 100644
index 0000000..4961f7d
Binary files /dev/null and b/official/1.104/examples/windows/edisdk/EDISDK_TLB.dcr differ
diff --git a/official/1.104/examples/windows/edisdk/EDISDK_TLB.pas b/official/1.104/examples/windows/edisdk/EDISDK_TLB.pas
new file mode 100644
index 0000000..b2ea6d5
--- /dev/null
+++ b/official/1.104/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: 1658 $
+// 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.104/examples/windows/edisdk/comserver/Clean.bat b/official/1.104/examples/windows/edisdk/comserver/Clean.bat
new file mode 100644
index 0000000..2bca898
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/edisdk/comserver/EDISDK.dof b/official/1.104/examples/windows/edisdk/comserver/EDISDK.dof
new file mode 100644
index 0000000..4575b9a
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/edisdk/comserver/EDISDK.dpr b/official/1.104/examples/windows/edisdk/comserver/EDISDK.dpr
new file mode 100644
index 0000000..4a71302
--- /dev/null
+++ b/official/1.104/examples/windows/edisdk/comserver/EDISDK.dpr
@@ -0,0 +1,23 @@
+library EDISDK;
+
+{$I jcl.inc}
+
+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.104/examples/windows/edisdk/comserver/EDISDK.res b/official/1.104/examples/windows/edisdk/comserver/EDISDK.res
new file mode 100644
index 0000000..2aff2bd
Binary files /dev/null and b/official/1.104/examples/windows/edisdk/comserver/EDISDK.res differ
diff --git a/official/1.104/examples/windows/edisdk/comserver/EDISDK.tlb b/official/1.104/examples/windows/edisdk/comserver/EDISDK.tlb
new file mode 100644
index 0000000..e3e6659
Binary files /dev/null and b/official/1.104/examples/windows/edisdk/comserver/EDISDK.tlb differ
diff --git a/official/1.104/examples/windows/edisdk/comserver/EDISDK_TLB.pas b/official/1.104/examples/windows/edisdk/comserver/EDISDK_TLB.pas
new file mode 100644
index 0000000..bb04e34
--- /dev/null
+++ b/official/1.104/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: 1658 $
+// 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.104/examples/windows/edisdk/comserver/JclEDICOM_ANSIX12.pas b/official/1.104/examples/windows/edisdk/comserver/JclEDICOM_ANSIX12.pas
new file mode 100644
index 0000000..c490a55
--- /dev/null
+++ b/official/1.104/examples/windows/edisdk/comserver/JclEDICOM_ANSIX12.pas
@@ -0,0 +1,1059 @@
+{**************************************************************************************************}
+{ }
+{ 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);
+
+end.
diff --git a/official/1.104/examples/windows/edisdk/comserver/sample.edi b/official/1.104/examples/windows/edisdk/comserver/sample.edi
new file mode 100644
index 0000000..bb0a617
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/edisdk/sample.edi b/official/1.104/examples/windows/edisdk/sample.edi
new file mode 100644
index 0000000..bb0a617
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/edisdk/vb5/Form1.frm b/official/1.104/examples/windows/edisdk/vb5/Form1.frm
new file mode 100644
index 0000000..90fbdcc
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/edisdk/vb5/Form1.frx b/official/1.104/examples/windows/edisdk/vb5/Form1.frx
new file mode 100644
index 0000000..da8c0d9
--- /dev/null
+++ b/official/1.104/examples/windows/edisdk/vb5/Form1.frx
@@ -0,0 +1 @@
+Text1
\ No newline at end of file
diff --git a/official/1.104/examples/windows/edisdk/vb5/Project1.vbp b/official/1.104/examples/windows/edisdk/vb5/Project1.vbp
new file mode 100644
index 0000000..a94b847
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/edisdk/vb5/Project1.vbw b/official/1.104/examples/windows/edisdk/vb5/Project1.vbw
new file mode 100644
index 0000000..a4c36f7
--- /dev/null
+++ b/official/1.104/examples/windows/edisdk/vb5/Project1.vbw
@@ -0,0 +1 @@
+Form1 = 44, 44, 419, 390, Z, 22, 22, 273, 284,
diff --git a/official/1.104/examples/windows/edisdk/vb5/sample.edi b/official/1.104/examples/windows/edisdk/vb5/sample.edi
new file mode 100644
index 0000000..bb0a617
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/filesummary/FileSummaryDemoMain.dfm b/official/1.104/examples/windows/filesummary/FileSummaryDemoMain.dfm
new file mode 100644
index 0000000..8a57fff
--- /dev/null
+++ b/official/1.104/examples/windows/filesummary/FileSummaryDemoMain.dfm
@@ -0,0 +1,56 @@
+object FormMain: TFormMain
+ Left = 0
+ Top = 0
+ Width = 440
+ Height = 552
+ Caption = ';'
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ PixelsPerInch = 96
+ TextHeight = 13
+ object DriveComboBox1: TDriveComboBox
+ Left = 8
+ Top = 8
+ Width = 193
+ Height = 19
+ Anchors = [akLeft, akTop, akRight]
+ DirList = DirectoryListBox1
+ TabOrder = 0
+ end
+ object Memo1: TMemo
+ Left = 8
+ Top = 248
+ Width = 416
+ Height = 269
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ Lines.Strings = (
+ 'Select a file to have its properties')
+ ScrollBars = ssBoth
+ TabOrder = 1
+ end
+ object FileListBox1: TFileListBox
+ Left = 207
+ Top = 8
+ Width = 217
+ Height = 234
+ Anchors = [akTop, akRight]
+ ItemHeight = 13
+ TabOrder = 2
+ OnChange = FileListBox1Change
+ end
+ object DirectoryListBox1: TDirectoryListBox
+ Left = 8
+ Top = 33
+ Width = 193
+ Height = 209
+ Anchors = [akLeft, akTop, akRight]
+ FileList = FileListBox1
+ ItemHeight = 16
+ TabOrder = 3
+ end
+end
diff --git a/official/1.104/examples/windows/filesummary/FileSummaryDemoMain.pas b/official/1.104/examples/windows/filesummary/FileSummaryDemoMain.pas
new file mode 100644
index 0000000..355b666
--- /dev/null
+++ b/official/1.104/examples/windows/filesummary/FileSummaryDemoMain.pas
@@ -0,0 +1,309 @@
+unit FileSummaryDemoMain;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, FileCtrl, ActiveX, JclNTFS;
+
+type
+ TFormMain = class(TForm)
+ DriveComboBox1: TDriveComboBox;
+ Memo1: TMemo;
+ FileListBox1: TFileListBox;
+ DirectoryListBox1: TDirectoryListBox;
+ procedure FileListBox1Change(Sender: TObject);
+ private
+ FFileSummary: TJclFileSummary;
+ procedure UpdateFileSummary(const FileName: string);
+ public
+ end;
+
+var
+ FormMain: TFormMain;
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclSysUtils;
+
+procedure TFormMain.FileListBox1Change(Sender: TObject);
+begin
+ if FileListBox1.FileName <> '' then
+ UpdateFileSummary(FileListBox1.FileName);
+end;
+
+procedure TFormMain.UpdateFileSummary(const FileName: string);
+ function FileTimeToString(const FileTime: TFileTime): string;
+ var
+ ASystemTime: TSystemTime;
+ begin
+ if FileTimeToSystemTime(FileTime, ASystemTime) then
+ Result := Format('%d/%d/%d %d:%d:%d', [ASystemTime.wYear, ASystemTime.wMonth, ASystemTime.wDay,
+ ASystemTime.wHour, ASystemTime.wMinute, ASystemTime.wSecond])
+ else
+ Result := '';
+ end;
+var
+ AFilePropertySet: TJclFilePropertySet;
+ AFileSummaryInformation: TJclFileSummaryInformation;
+ ADocumentSummaryInformation: TJclDocSummaryInformation;
+ AMediaFileSummaryInformation: TJclMediaFileSummaryInformation;
+ AMSISummaryInformation: TJclMSISummaryInformation;
+ AVideoSummaryInformation: TJclVideoSummaryInformation;
+ AAudioSummaryInformation: TJclAudioSummaryInformation;
+begin
+ Memo1.Lines.Clear;
+ FFileSummary := TJclFileSummary.Create(FileName, fsaRead, fssDenyAll);
+ try
+ FFileSummary.GetPropertySet(TJclFileSummaryInformation, AFileSummaryInformation);
+ if Assigned(AFileSummaryInformation) then
+ try
+ Memo1.Lines.Add('File summary');
+
+ Memo1.Lines.Add(string(' Title ' + AFileSummaryInformation.Title));
+ Memo1.Lines.Add(string(' Subject ' + AFileSummaryInformation.Subject));
+ Memo1.Lines.Add(string(' Author ' + AFileSummaryInformation.Author));
+ Memo1.Lines.Add(string(' Keywords ' + AFileSummaryInformation.KeyWords));
+ Memo1.Lines.Add(string(' Comments ' + AFileSummaryInformation.Comments));
+ Memo1.Lines.Add(string(' Template ' + AFileSummaryInformation.Template));
+ Memo1.Lines.Add(string(' Last author ' + AFileSummaryInformation.LastAuthor));
+ Memo1.Lines.Add(string(' Revision numer ' + AFileSummaryInformation.RevNumber));
+ Memo1.Lines.Add(string(' Edit time ' + FileTimeToString(AFileSummaryInformation.EditTime)));
+ Memo1.Lines.Add(string(' Last printed time ' + FileTimeToString(AFileSummaryInformation.LastPrintedTime)));
+ Memo1.Lines.Add(string(' Creation time ' + FileTimeToString(AFileSummaryInformation.CreationTime)));
+ Memo1.Lines.Add(string(' Last save time ' + FileTimeToString(AFileSummaryInformation.LastSaveTime)));
+ Memo1.Lines.Add(' Page count ' + IntToStr(AFileSummaryInformation.PageCount));
+ Memo1.Lines.Add(' Word count ' + IntToStr(AFileSummaryInformation.WordCount));
+ Memo1.Lines.Add(' Char count ' + IntToStr(AFileSummaryInformation.CharCount));
+ //AFileSummaryInformation.Thumnail
+ Memo1.Lines.Add(string(' App name ' + AFileSummaryInformation.AppName));
+ Memo1.Lines.Add(' Security ' + IntToStr(AFileSummaryInformation.Security));
+ finally
+ AFileSummaryInformation.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclDocSummaryInformation, ADocumentSummaryInformation);
+ if Assigned(ADocumentSummaryInformation) then
+ try
+ Memo1.Lines.Add('Document summary');
+ Memo1.Lines.Add(string(' Category ' + ADocumentSummaryInformation.Category));
+ Memo1.Lines.Add(string(' Pres format ' + ADocumentSummaryInformation.PresFormat));
+ Memo1.Lines.Add(' Byte count ' + IntToStr(ADocumentSummaryInformation.ByteCount));
+ Memo1.Lines.Add(' Line count ' + IntToStr(ADocumentSummaryInformation.LineCount));
+ Memo1.Lines.Add(' Par count ' + IntToStr(ADocumentSummaryInformation.ParCount));
+ Memo1.Lines.Add(' Slide count ' + IntToStr(ADocumentSummaryInformation.SlideCount));
+ Memo1.Lines.Add(' Note count ' + IntToStr(ADocumentSummaryInformation.NoteCount));
+ Memo1.Lines.Add(' Hidden count ' + IntToStr(ADocumentSummaryInformation.HiddenCount));
+ Memo1.Lines.Add(' MM Clip count ' + IntToStr(ADocumentSummaryInformation.MMClipCount));
+ Memo1.Lines.Add(' Scale ' + BooleanToStr(ADocumentSummaryInformation.Scale));
+ //ADocumentSummaryInformation.HeadingPair
+ //ADocumentSummaryInformation.DocParts
+ Memo1.Lines.Add(string(' Manager ' + ADocumentSummaryInformation.Manager));
+ Memo1.Lines.Add(string(' Company ' + ADocumentSummaryInformation.Company));
+ Memo1.Lines.Add(' Links dirty ' + BooleanToStr(ADocumentSummaryInformation.LinksDirty));
+ finally
+ ADocumentSummaryInformation.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclMediaFileSummaryInformation, AMediaFileSummaryInformation);
+ if Assigned(AMediaFileSummaryInformation) then
+ try
+ Memo1.Lines.Add('Media file');
+ Memo1.Lines.Add(' Supplier ' + AMediaFileSummaryInformation.Supplier);
+ Memo1.Lines.Add(' Source ' + AMediaFileSummaryInformation.Source);
+ Memo1.Lines.Add(' Sequence no ' + AMediaFileSummaryInformation.SequenceNo);
+ Memo1.Lines.Add(' Project ' + AMediaFileSummaryInformation.Project);
+ Memo1.Lines.Add(' Status ' + IntToStr(AMediaFileSummaryInformation.Status));
+ Memo1.Lines.Add(' Owner ' + AMediaFileSummaryInformation.Owner);
+ Memo1.Lines.Add(' Rating ' + AMediaFileSummaryInformation.Rating);
+ Memo1.Lines.Add(' Production ' + FileTimeToString(AMediaFileSummaryInformation.Production));
+ Memo1.Lines.Add(' Copyright ' + AMediaFileSummaryInformation.Copyright);
+ finally
+ AMediaFileSummaryInformation.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclMSISummaryInformation, AMSISummaryInformation);
+ if Assigned(AMSISummaryInformation) then
+ try
+ Memo1.Lines.Add('MSI summary');
+ Memo1.Lines.Add(' Version ' + IntToStr(AMSISummaryInformation.Version));
+ Memo1.Lines.Add(' Source ' + IntToStr(AMSISummaryInformation.Source));
+ Memo1.Lines.Add(' Restrict ' + IntToStr(AMSISummaryInformation.Restrict));
+ finally
+ AMSISummaryInformation.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclShellSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Shell summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclStorageSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Storage summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclImageSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Image summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclDisplacedSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Displaced summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclBriefCaseSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Briefcase summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclMiscSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Misc summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclWebViewSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Webview summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclMusicSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Music summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclDRMSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('DRM summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclVideoSummaryInformation, AVideoSummaryInformation);
+ if Assigned(AVideoSummaryInformation) then
+ try
+ Memo1.Lines.Add('Video summary');
+ Memo1.Lines.Add(' Stream name ' + AVideoSummaryInformation.StreamName);
+ Memo1.Lines.Add(' Width ' + IntToStr(AVideoSummaryInformation.Width));
+ Memo1.Lines.Add(' Height ' + IntToStr(AVideoSummaryInformation.Height));
+ Memo1.Lines.Add(' Time length(ms) ' + IntToStr(AVideoSummaryInformation.TimeLength));
+ Memo1.Lines.Add(' Frame count ' + IntToStr(AVideoSummaryInformation.FrameCount));
+ Memo1.Lines.Add(' Frame rate ' + IntToStr(AVideoSummaryInformation.FrameRate));
+ Memo1.Lines.Add(' Data rate ' + IntToStr(AVideoSummaryInformation.DataRate));
+ Memo1.Lines.Add(' Sample size ' + IntToStr(AVideoSummaryInformation.SampleSize));
+ Memo1.Lines.Add(' Compression ' + AVideoSummaryInformation.Compression);
+ Memo1.Lines.Add(' Stream number ' + IntToStr(AVideoSummaryInformation.StreamNumber));
+ finally
+ AVideoSummaryInformation.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclAudioSummaryInformation, AAudioSummaryInformation);
+ if Assigned(AAudioSummaryInformation) then
+ try
+ Memo1.Lines.Add('Audio summary');
+ Memo1.Lines.Add(' Format ' + AAudioSummaryInformation.Format);
+ Memo1.Lines.Add(' Time length ' + IntToStr(AAudioSummaryInformation.TimeLength));
+ Memo1.Lines.Add(' Average data rate ' + IntToStr(AAudioSummaryInformation.AverageDataRate));
+ Memo1.Lines.Add(' Sample rate ' + IntToStr(AAudioSummaryInformation.SampleRate));
+ Memo1.Lines.Add(' Sample size ' + IntToStr(AAudioSummaryInformation.SampleSize));
+ Memo1.Lines.Add(' Channel count ' + IntToStr(AAudioSummaryInformation.ChannelCount));
+ Memo1.Lines.Add(' Stream number ' + IntToStr(AAudioSummaryInformation.StreamNumber));
+ Memo1.Lines.Add(' Stream name ' + AAudioSummaryInformation.StreamName);
+ Memo1.Lines.Add(' Compression ' + AAudioSummaryInformation.Compression);
+ finally
+ AAudioSummaryInformation.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclControlPanelSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Control panel summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclVolumeSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Volume summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclShareSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Share summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclLinkSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Link summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclQuerySummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Query summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclImageInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Image');
+ finally
+ AFilePropertySet.Free;
+ end;
+
+ FFileSummary.GetPropertySet(TJclJpegSummaryInformation, AFilePropertySet);
+ if Assigned(AFilePropertySet) then
+ try
+ Memo1.Lines.Add('Jpeg summary');
+ finally
+ AFilePropertySet.Free;
+ end;
+ finally
+ FreeAndNil(FFileSummary);
+ end;
+
+ if Memo1.Lines.Count = 0 then
+ Memo1.Lines.Add('No properties');
+end;
+
+end.
diff --git a/official/1.104/examples/windows/filesummary/FileSummaryExample.dof b/official/1.104/examples/windows/filesummary/FileSummaryExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/filesummary/FileSummaryExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/filesummary/FileSummaryExample.dpr b/official/1.104/examples/windows/filesummary/FileSummaryExample.dpr
new file mode 100644
index 0000000..9b46644
--- /dev/null
+++ b/official/1.104/examples/windows/filesummary/FileSummaryExample.dpr
@@ -0,0 +1,16 @@
+program FileSummaryExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ FileSummaryDemoMain in 'FileSummaryDemoMain.pas' {FormMain};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TFormMain, FormMain);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/filesummary/FileSummaryExample.res b/official/1.104/examples/windows/filesummary/FileSummaryExample.res
new file mode 100644
index 0000000..119d171
Binary files /dev/null and b/official/1.104/examples/windows/filesummary/FileSummaryExample.res differ
diff --git a/official/1.104/examples/windows/fileversion/VerInfoDemoMain.dfm b/official/1.104/examples/windows/fileversion/VerInfoDemoMain.dfm
new file mode 100644
index 0000000..50b80d1
--- /dev/null
+++ b/official/1.104/examples/windows/fileversion/VerInfoDemoMain.dfm
@@ -0,0 +1,55 @@
+object Form1: TForm1
+ Left = 203
+ Top = 116
+ ClientWidth = 529
+ ClientHeight = 394
+ 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.104/examples/windows/fileversion/VerInfoDemoMain.pas b/official/1.104/examples/windows/fileversion/VerInfoDemoMain.pas
new file mode 100644
index 0000000..8531e40
--- /dev/null
+++ b/official/1.104/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, JclSysUtils;
+
+{ 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.104/examples/windows/fileversion/VerInfoExample.dof b/official/1.104/examples/windows/fileversion/VerInfoExample.dof
new file mode 100644
index 0000000..4c107f6
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/fileversion/VerInfoExample.dpr b/official/1.104/examples/windows/fileversion/VerInfoExample.dpr
new file mode 100644
index 0000000..0b3948b
--- /dev/null
+++ b/official/1.104/examples/windows/fileversion/VerInfoExample.dpr
@@ -0,0 +1,16 @@
+program VerInfoExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ VerInfoDemoMain in 'VerInfoDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/fileversion/VerInfoExample.res b/official/1.104/examples/windows/fileversion/VerInfoExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/fileversion/VerInfoExample.res differ
diff --git a/official/1.104/examples/windows/lanman/LanManDemoMain.dfm b/official/1.104/examples/windows/lanman/LanManDemoMain.dfm
new file mode 100644
index 0000000..cea1ec2
--- /dev/null
+++ b/official/1.104/examples/windows/lanman/LanManDemoMain.dfm
@@ -0,0 +1,271 @@
+object Form1: TForm1
+ Left = 339
+ Top = 230
+ ClientWidth = 716
+ ClientHeight = 390
+ 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.104/examples/windows/lanman/LanManDemoMain.pas b/official/1.104/examples/windows/lanman/LanManDemoMain.pas
new file mode 100644
index 0000000..a7bb8e5
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/lanman/LanManExample.dof b/official/1.104/examples/windows/lanman/LanManExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/lanman/LanManExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/lanman/LanManExample.dpr b/official/1.104/examples/windows/lanman/LanManExample.dpr
new file mode 100644
index 0000000..8fe7153
--- /dev/null
+++ b/official/1.104/examples/windows/lanman/LanManExample.dpr
@@ -0,0 +1,16 @@
+program LanManExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ LanManDemoMain in 'LanManDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAdmin.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/lanman/LanManExample.res b/official/1.104/examples/windows/lanman/LanManExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/lanman/LanManExample.res differ
diff --git a/official/1.104/examples/windows/locales/LocalesDemoMain.dfm b/official/1.104/examples/windows/locales/LocalesDemoMain.dfm
new file mode 100644
index 0000000..44b2cd1
--- /dev/null
+++ b/official/1.104/examples/windows/locales/LocalesDemoMain.dfm
@@ -0,0 +1,306 @@
+object MainForm: TMainForm
+ Left = 199
+ Top = 112
+ ClientWidth = 632
+ ClientHeight = 571
+ 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.104/examples/windows/locales/LocalesDemoMain.pas b/official/1.104/examples/windows/locales/LocalesDemoMain.pas
new file mode 100644
index 0000000..e7cf9d5
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/locales/LocalesExample.dof b/official/1.104/examples/windows/locales/LocalesExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/locales/LocalesExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/locales/LocalesExample.dpr b/official/1.104/examples/windows/locales/LocalesExample.dpr
new file mode 100644
index 0000000..5fcc8ef
--- /dev/null
+++ b/official/1.104/examples/windows/locales/LocalesExample.dpr
@@ -0,0 +1,16 @@
+program LocalesExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ LocalesDemoMain in 'LocalesDemoMain.pas' {MainForm};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/locales/LocalesExample.res b/official/1.104/examples/windows/locales/LocalesExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/locales/LocalesExample.res differ
diff --git a/official/1.104/examples/windows/mapi/MapiDemoMain.dfm b/official/1.104/examples/windows/mapi/MapiDemoMain.dfm
new file mode 100644
index 0000000..aecabe2
--- /dev/null
+++ b/official/1.104/examples/windows/mapi/MapiDemoMain.dfm
@@ -0,0 +1,257 @@
+object MainForm: TMainForm
+ Left = 285
+ Top = 165
+ ClientWidth = 692
+ ClientHeight = 494
+ 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.104/examples/windows/mapi/MapiDemoMain.pas b/official/1.104/examples/windows/mapi/MapiDemoMain.pas
new file mode 100644
index 0000000..7827f93
--- /dev/null
+++ b/official/1.104/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 := string(Profiles[I]);
+ Data := Pointer(Caption = string(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(AnsiString(ToAddressEdit.Text), AnsiString(ToNameEdit.Text));
+ SimpleMapiMail.Subject := AnsiString(SubjectEdit.Text);
+ SimpleMapiMail.Body := AnsiString(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.104/examples/windows/mapi/MapiExample.dof b/official/1.104/examples/windows/mapi/MapiExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/mapi/MapiExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/mapi/MapiExample.dpr b/official/1.104/examples/windows/mapi/MapiExample.dpr
new file mode 100644
index 0000000..e29f81b
--- /dev/null
+++ b/official/1.104/examples/windows/mapi/MapiExample.dpr
@@ -0,0 +1,16 @@
+program MapiExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ MapiDemoMain in 'MapiDemoMain.pas' {MainForm};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/mapi/MapiExample.res b/official/1.104/examples/windows/mapi/MapiExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/mapi/MapiExample.res differ
diff --git a/official/1.104/examples/windows/mapi/ReadMailDemoMain.dfm b/official/1.104/examples/windows/mapi/ReadMailDemoMain.dfm
new file mode 100644
index 0000000..c56ee2a
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/mapi/ReadMailDemoMain.pas b/official/1.104/examples/windows/mapi/ReadMailDemoMain.pas
new file mode 100644
index 0000000..4ecf54c
--- /dev/null
+++ b/official/1.104/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 := AnsiString(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 := string(Email.Recipients.Originator.Name);
+ SubItems.Add(string(Email.Subject));
+ SubItems.Add(DateTimeToStr(Email.ReadMsg.DateReceived));
+ SubItems.Add(string(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.104/examples/windows/mapi/ReadMailExample.dof b/official/1.104/examples/windows/mapi/ReadMailExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/mapi/ReadMailExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/mapi/ReadMailExample.dpr b/official/1.104/examples/windows/mapi/ReadMailExample.dpr
new file mode 100644
index 0000000..c6fd19d
--- /dev/null
+++ b/official/1.104/examples/windows/mapi/ReadMailExample.dpr
@@ -0,0 +1,16 @@
+program ReadMailExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ ReadMailDemoMain in 'ReadMailDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/mapi/ReadMailExample.res b/official/1.104/examples/windows/mapi/ReadMailExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/mapi/ReadMailExample.res differ
diff --git a/official/1.104/examples/windows/multimedia/MultiMediaExample.dof b/official/1.104/examples/windows/multimedia/MultiMediaExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/multimedia/MultiMediaExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/multimedia/MultiMediaExample.dpr b/official/1.104/examples/windows/multimedia/MultiMediaExample.dpr
new file mode 100644
index 0000000..b62ef8c
--- /dev/null
+++ b/official/1.104/examples/windows/multimedia/MultiMediaExample.dpr
@@ -0,0 +1,16 @@
+program MultiMediaExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ MultimediaDemoMain in 'MultimediaDemoMain.pas' {MainForm};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/multimedia/MultiMediaExample.res b/official/1.104/examples/windows/multimedia/MultiMediaExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/multimedia/MultiMediaExample.res differ
diff --git a/official/1.104/examples/windows/multimedia/MultimediaDemoMain.dfm b/official/1.104/examples/windows/multimedia/MultimediaDemoMain.dfm
new file mode 100644
index 0000000..f8b52fb
--- /dev/null
+++ b/official/1.104/examples/windows/multimedia/MultimediaDemoMain.dfm
@@ -0,0 +1,215 @@
+object MainForm: TMainForm
+ Left = 313
+ Top = 238
+ ClientWidth = 669
+ ClientHeight = 541
+ 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.104/examples/windows/multimedia/MultimediaDemoMain.pas b/official/1.104/examples/windows/multimedia/MultimediaDemoMain.pas
new file mode 100644
index 0000000..c6a01f7
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/ntfs/JEDISoftLinks.dof b/official/1.104/examples/windows/ntfs/JEDISoftLinks.dof
new file mode 100644
index 0000000..a357c00
--- /dev/null
+++ b/official/1.104/examples/windows/ntfs/JEDISoftLinks.dof
@@ -0,0 +1,4 @@
+[Directories]
+OutputDir=..\..\..\bin
+[Parameters]
+RunParams=/UNREGSERVER
diff --git a/official/1.104/examples/windows/ntfs/JEDISoftLinks.dpr b/official/1.104/examples/windows/ntfs/JEDISoftLinks.dpr
new file mode 100644
index 0000000..b7b53c3
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/ntfs/JEDISoftLinks.tlb b/official/1.104/examples/windows/ntfs/JEDISoftLinks.tlb
new file mode 100644
index 0000000..f5ea296
Binary files /dev/null and b/official/1.104/examples/windows/ntfs/JEDISoftLinks.tlb differ
diff --git a/official/1.104/examples/windows/ntfs/JEDISoftLinks_TLB.pas b/official/1.104/examples/windows/ntfs/JEDISoftLinks_TLB.pas
new file mode 100644
index 0000000..5600ffc
--- /dev/null
+++ b/official/1.104/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: 1658 $
+// 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.104/examples/windows/ntfs/SoftLinkDragDropHandler.pas b/official/1.104/examples/windows/ntfs/SoftLinkDragDropHandler.pas
new file mode 100644
index 0000000..246e90d
--- /dev/null
+++ b/official/1.104/examples/windows/ntfs/SoftLinkDragDropHandler.pas
@@ -0,0 +1,229 @@
+//
+// 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';
+const
+ SMenuHelp = AnsiString('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, PAnsiChar(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.104/examples/windows/ntservice/NtSvcDemoDependent.dfm b/official/1.104/examples/windows/ntservice/NtSvcDemoDependent.dfm
new file mode 100644
index 0000000..f08daac
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/ntservice/NtSvcDemoDependent.pas b/official/1.104/examples/windows/ntservice/NtSvcDemoDependent.pas
new file mode 100644
index 0000000..adcb3af
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/ntservice/NtSvcDemoGroups.dfm b/official/1.104/examples/windows/ntservice/NtSvcDemoGroups.dfm
new file mode 100644
index 0000000..924eeb0
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/ntservice/NtSvcDemoGroups.pas b/official/1.104/examples/windows/ntservice/NtSvcDemoGroups.pas
new file mode 100644
index 0000000..ead36e0
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/ntservice/NtSvcDemoMain.dfm b/official/1.104/examples/windows/ntservice/NtSvcDemoMain.dfm
new file mode 100644
index 0000000..415cbe1
--- /dev/null
+++ b/official/1.104/examples/windows/ntservice/NtSvcDemoMain.dfm
@@ -0,0 +1,275 @@
+object frmMain: TfrmMain
+ Left = 271
+ Top = 251
+ ClientWidth = 640
+ ClientHeight = 426
+ 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.104/examples/windows/ntservice/NtSvcDemoMain.pas b/official/1.104/examples/windows/ntservice/NtSvcDemoMain.pas
new file mode 100644
index 0000000..b929499
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/ntservice/NtSvcExample.dof b/official/1.104/examples/windows/ntservice/NtSvcExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/ntservice/NtSvcExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/ntservice/NtSvcExample.dpr b/official/1.104/examples/windows/ntservice/NtSvcExample.dpr
new file mode 100644
index 0000000..c60ead6
--- /dev/null
+++ b/official/1.104/examples/windows/ntservice/NtSvcExample.dpr
@@ -0,0 +1,18 @@
+program NtSvcExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ NtSvcDemoMain in 'NtSvcDemoMain.pas' {frmMain},
+ NtSvcDemoDependent in 'NtSvcDemoDependent.pas' {frmDependent},
+ NtSvcDemoGroups in 'NtSvcDemoGroups.pas' {frmServiceGroups};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAdmin.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TfrmMain, frmMain);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/ntservice/NtSvcExample.res b/official/1.104/examples/windows/ntservice/NtSvcExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/ntservice/NtSvcExample.res differ
diff --git a/official/1.104/examples/windows/peimage/ApiHookDemoMain.dfm b/official/1.104/examples/windows/peimage/ApiHookDemoMain.dfm
new file mode 100644
index 0000000..110c171
--- /dev/null
+++ b/official/1.104/examples/windows/peimage/ApiHookDemoMain.dfm
@@ -0,0 +1,53 @@
+object Form1: TForm1
+ Left = 193
+ Top = 103
+ ClientWidth = 450
+ ClientHeight = 330
+ 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.104/examples/windows/peimage/ApiHookDemoMain.pas b/official/1.104/examples/windows/peimage/ApiHookDemoMain.pas
new file mode 100644
index 0000000..47c6c65
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/peimage/ApiHookExample.dof b/official/1.104/examples/windows/peimage/ApiHookExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/peimage/ApiHookExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/peimage/ApiHookExample.dpr b/official/1.104/examples/windows/peimage/ApiHookExample.dpr
new file mode 100644
index 0000000..c706ad2
--- /dev/null
+++ b/official/1.104/examples/windows/peimage/ApiHookExample.dpr
@@ -0,0 +1,16 @@
+program ApiHookExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ ApiHookDemoMain in 'ApiHookDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/peimage/ApiHookExample.res b/official/1.104/examples/windows/peimage/ApiHookExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/peimage/ApiHookExample.res differ
diff --git a/official/1.104/examples/windows/peimage/PeFuncDemoMain.dfm b/official/1.104/examples/windows/peimage/PeFuncDemoMain.dfm
new file mode 100644
index 0000000..7661f6d
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/peimage/PeFuncDemoMain.pas b/official/1.104/examples/windows/peimage/PeFuncDemoMain.pas
new file mode 100644
index 0000000..4f85968
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/peimage/PeFuncExample.dof b/official/1.104/examples/windows/peimage/PeFuncExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/peimage/PeFuncExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/peimage/PeFuncExample.dpr b/official/1.104/examples/windows/peimage/PeFuncExample.dpr
new file mode 100644
index 0000000..61e3952
--- /dev/null
+++ b/official/1.104/examples/windows/peimage/PeFuncExample.dpr
@@ -0,0 +1,16 @@
+program PeFuncExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ PeFuncDemoMain in 'PeFuncDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/peimage/PeFuncExample.res b/official/1.104/examples/windows/peimage/PeFuncExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/peimage/PeFuncExample.res differ
diff --git a/official/1.104/examples/windows/peimage/UnmangleNameDemoMain.dfm b/official/1.104/examples/windows/peimage/UnmangleNameDemoMain.dfm
new file mode 100644
index 0000000..4b36021
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/peimage/UnmangleNameDemoMain.pas b/official/1.104/examples/windows/peimage/UnmangleNameDemoMain.pas
new file mode 100644
index 0000000..df2d274
--- /dev/null
+++ b/official/1.104/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(string(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.104/examples/windows/peimage/UnmangleNameExample.dof b/official/1.104/examples/windows/peimage/UnmangleNameExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/peimage/UnmangleNameExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/peimage/UnmangleNameExample.dpr b/official/1.104/examples/windows/peimage/UnmangleNameExample.dpr
new file mode 100644
index 0000000..81b48b3
--- /dev/null
+++ b/official/1.104/examples/windows/peimage/UnmangleNameExample.dpr
@@ -0,0 +1,16 @@
+program UnmangleNameExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ UnmangleNameDemoMain in 'UnmangleNameDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/peimage/UnmangleNameExample.res b/official/1.104/examples/windows/peimage/UnmangleNameExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/peimage/UnmangleNameExample.res differ
diff --git a/official/1.104/examples/windows/registry/RegistryDemoMain.dfm b/official/1.104/examples/windows/registry/RegistryDemoMain.dfm
new file mode 100644
index 0000000..db79bea
--- /dev/null
+++ b/official/1.104/examples/windows/registry/RegistryDemoMain.dfm
@@ -0,0 +1,53 @@
+object Form1: TForm1
+ Left = 211
+ Top = 136
+ ClientWidth = 641
+ ClientHeight = 448
+ 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.104/examples/windows/registry/RegistryDemoMain.pas b/official/1.104/examples/windows/registry/RegistryDemoMain.pas
new file mode 100644
index 0000000..8f252cf
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/registry/RegistryExample.dof b/official/1.104/examples/windows/registry/RegistryExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/registry/RegistryExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/registry/RegistryExample.dpr b/official/1.104/examples/windows/registry/RegistryExample.dpr
new file mode 100644
index 0000000..4d68ee7
--- /dev/null
+++ b/official/1.104/examples/windows/registry/RegistryExample.dpr
@@ -0,0 +1,16 @@
+program RegistryExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ RegistryDemoMain in 'RegistryDemoMain.pas' {Form1};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/registry/RegistryExample.res b/official/1.104/examples/windows/registry/RegistryExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/registry/RegistryExample.res differ
diff --git a/official/1.104/examples/windows/structstorage/HexDump.pas b/official/1.104/examples/windows/structstorage/HexDump.pas
new file mode 100644
index 0000000..0332e01
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/structstorage/PropsFrm.dfm b/official/1.104/examples/windows/structstorage/PropsFrm.dfm
new file mode 100644
index 0000000..97926fa
--- /dev/null
+++ b/official/1.104/examples/windows/structstorage/PropsFrm.dfm
@@ -0,0 +1,221 @@
+object frmProps: TfrmProps
+ Left = 798
+ Top = 376
+ ClientWidth = 331
+ ClientHeight = 349
+ 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.104/examples/windows/structstorage/PropsFrm.pas b/official/1.104/examples/windows/structstorage/PropsFrm.pas
new file mode 100644
index 0000000..8a21bf1
--- /dev/null
+++ b/official/1.104/examples/windows/structstorage/PropsFrm.pas
@@ -0,0 +1,172 @@
+{-----------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may 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 Thrnqvist [peter3@peter3.com]
+Portions created by Peter Thrnqvist are Copyright (C) 2002 Peter Thrnqvist.
+All Rights Reserved.
+
+Contributor(s):
+
+Last Modified: $Date: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $
+
+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;
+
+end.
+
diff --git a/official/1.104/examples/windows/structstorage/StructStorageExample.dof b/official/1.104/examples/windows/structstorage/StructStorageExample.dof
new file mode 100644
index 0000000..abe45c2
--- /dev/null
+++ b/official/1.104/examples/windows/structstorage/StructStorageExample.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=..\..\..\bin
diff --git a/official/1.104/examples/windows/structstorage/StructStorageExample.dpr b/official/1.104/examples/windows/structstorage/StructStorageExample.dpr
new file mode 100644
index 0000000..60ead59
--- /dev/null
+++ b/official/1.104/examples/windows/structstorage/StructStorageExample.dpr
@@ -0,0 +1,19 @@
+program StructStorageExample;
+
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ StructStorageExampleMain in 'StructStorageExampleMain.pas' {frmMain},
+ PropsFrm in 'PropsFrm.pas' {frmProps};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'Compound Document Editor';
+ Application.CreateForm(TfrmMain, frmMain);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/structstorage/StructStorageExample.res b/official/1.104/examples/windows/structstorage/StructStorageExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/structstorage/StructStorageExample.res differ
diff --git a/official/1.104/examples/windows/structstorage/StructStorageExampleMain.dfm b/official/1.104/examples/windows/structstorage/StructStorageExampleMain.dfm
new file mode 100644
index 0000000..b607ce6
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/structstorage/StructStorageExampleMain.pas b/official/1.104/examples/windows/structstorage/StructStorageExampleMain.pas
new file mode 100644
index 0000000..e6faf9d
--- /dev/null
+++ b/official/1.104/examples/windows/structstorage/StructStorageExampleMain.pas
@@ -0,0 +1,938 @@
+{-----------------------------------------------------------------------------
+The contents of this file are subject to the Mozilla Public License
+Version 1.1 (the "License"); you may 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 Thrnqvist [peter3@peter3.com]
+Portions created by Peter Thrnqvist are Copyright (C) 2002 Peter Thrnqvist.
+All Rights Reserved.
+
+Contributor(s):
+
+Last Modified: $Date: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $
+
+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 := PAnsiChar(AnsiString(SAboutMsg));
+ lpszCaption := PAnsiChar(AnsiString(SAboutCaption));
+ dwStyle := MB_OK or MB_USERICON;
+ lpszIcon := PAnsiChar('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;
+
+end.
+
diff --git a/official/1.104/examples/windows/sysinfo/SysInfoDemoMain.dfm b/official/1.104/examples/windows/sysinfo/SysInfoDemoMain.dfm
new file mode 100644
index 0000000..bb33efe
--- /dev/null
+++ b/official/1.104/examples/windows/sysinfo/SysInfoDemoMain.dfm
@@ -0,0 +1,1010 @@
+object MainForm: TMainForm
+ Left = 382
+ Top = 187
+ ClientWidth = 476
+ ClientHeight = 433
+ 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.104/examples/windows/sysinfo/SysInfoDemoMain.pas b/official/1.104/examples/windows/sysinfo/SysInfoDemoMain.pas
new file mode 100644
index 0000000..cab8ab8
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/sysinfo/SysInfoExample.dof b/official/1.104/examples/windows/sysinfo/SysInfoExample.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/sysinfo/SysInfoExample.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/sysinfo/SysInfoExample.dpr b/official/1.104/examples/windows/sysinfo/SysInfoExample.dpr
new file mode 100644
index 0000000..d9bbb38
--- /dev/null
+++ b/official/1.104/examples/windows/sysinfo/SysInfoExample.dpr
@@ -0,0 +1,16 @@
+program SysInfoExample;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ SysInfoDemoMain in 'SysInfoDemoMain.pas' {MainForm};
+
+{$R *.RES}
+{$R ..\..\..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/sysinfo/SysInfoExample.res b/official/1.104/examples/windows/sysinfo/SysInfoExample.res
new file mode 100644
index 0000000..472f2e4
Binary files /dev/null and b/official/1.104/examples/windows/sysinfo/SysInfoExample.res differ
diff --git a/official/1.104/examples/windows/tasks/TaskDemo.dof b/official/1.104/examples/windows/tasks/TaskDemo.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/examples/windows/tasks/TaskDemo.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/examples/windows/tasks/TaskDemo.dpr b/official/1.104/examples/windows/tasks/TaskDemo.dpr
new file mode 100644
index 0000000..2bfe6c2
--- /dev/null
+++ b/official/1.104/examples/windows/tasks/TaskDemo.dpr
@@ -0,0 +1,18 @@
+program TaskDemo;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ TaskDemoMain in 'TaskDemoMain.pas' {frmMain},
+ TaskDemoDataModule in 'TaskDemoDataModule.pas' {DM: TDataModule};
+
+{$R *.res}
+{$R ..\..\..\source\windows\JclCommCtrlAdmin.res}
+
+begin
+ Application.Initialize;
+ Application.CreateForm(TDM, DM);
+ Application.CreateForm(TfrmMain, frmMain);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/tasks/TaskDemo.res b/official/1.104/examples/windows/tasks/TaskDemo.res
new file mode 100644
index 0000000..0930265
Binary files /dev/null and b/official/1.104/examples/windows/tasks/TaskDemo.res differ
diff --git a/official/1.104/examples/windows/tasks/TaskDemoDataModule.dfm b/official/1.104/examples/windows/tasks/TaskDemoDataModule.dfm
new file mode 100644
index 0000000..de3b739
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/tasks/TaskDemoDataModule.pas b/official/1.104/examples/windows/tasks/TaskDemoDataModule.pas
new file mode 100644
index 0000000..9213af9
--- /dev/null
+++ b/official/1.104/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.104/examples/windows/tasks/TaskDemoMain.dfm b/official/1.104/examples/windows/tasks/TaskDemoMain.dfm
new file mode 100644
index 0000000..fd6e037
--- /dev/null
+++ b/official/1.104/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 = (
+ ''
+ ''
+ ''
+ ''
+ ''
+ ''
+ ''
+ ' Name Value TaskName <#TaskName> AccountName <#AccountName> Comment <#Comment> Creator <#Creator> ErrorRetryCount <#ErrorRetryCount> ErrorRetryInterval <#ErrorRetryInterval> <' +
+ '/TR>'
+ ''
+ ' 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.104/examples/windows/tasks/TaskDemoMain.pas b/official/1.104/examples/windows/tasks/TaskDemoMain.pas
new file mode 100644
index 0000000..5c2bd45
--- /dev/null
+++ b/official/1.104/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 := '';
+ 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.104/examples/windows/widestring/WideStringDemoMain.dfm b/official/1.104/examples/windows/widestring/WideStringDemoMain.dfm
new file mode 100644
index 0000000..bceacc7
--- /dev/null
+++ b/official/1.104/examples/windows/widestring/WideStringDemoMain.dfm
@@ -0,0 +1,154 @@
+object Form1: TForm1
+ Left = 0
+ Top = 0
+ Caption = 'TWideStringList Example (JclUnicode)'
+ ClientHeight = 544
+ ClientWidth = 791
+ Color = clBtnFace
+ Font.Charset = ANSI_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -15
+ Font.Name = 'Segoe UI'
+ Font.Style = []
+ OldCreateOrder = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ PixelsPerInch = 120
+ TextHeight = 20
+ object FileListView: TListView
+ Left = 0
+ Top = 177
+ Width = 791
+ Height = 342
+ Align = alClient
+ Columns = <
+ item
+ Caption = 'Name'
+ Width = 200
+ end
+ item
+ Caption = 'Location'
+ Width = 400
+ end
+ item
+ Caption = 'Encoding'
+ Width = 150
+ end>
+ RowSelect = True
+ PopupMenu = FilePopupMenu
+ TabOrder = 0
+ ViewStyle = vsReport
+ OnColumnClick = FileListViewColumnClick
+ OnDblClick = OpenwithNotepad1Click
+ end
+ object Panel1: TPanel
+ Left = 0
+ Top = 0
+ Width = 791
+ Height = 177
+ Align = alTop
+ TabOrder = 1
+ object Label3: TLabel
+ Left = 216
+ Top = 58
+ Width = 106
+ Height = 20
+ Caption = 'Filter encoding :'
+ end
+ object Label2: TLabel
+ Left = 8
+ Top = 58
+ Width = 68
+ Height = 20
+ Caption = 'File mask :'
+ end
+ object Label1: TLabel
+ Left = 8
+ Top = 4
+ Width = 102
+ Height = 20
+ Caption = 'Root directory :'
+ end
+ object FilterEncodingComboBox: TComboBox
+ Left = 216
+ Top = 79
+ Width = 201
+ Height = 28
+ ItemHeight = 20
+ TabOrder = 0
+ Items.Strings = (
+ ''
+ 'ANSI'
+ 'Unicode'
+ 'Unicode big endian'
+ 'UTF-8')
+ end
+ object IncludeSubDirectoriesCheckBox: TCheckBox
+ Left = 448
+ Top = 84
+ Width = 177
+ Height = 17
+ Caption = 'Include sub directories'
+ Checked = True
+ State = cbChecked
+ TabOrder = 1
+ end
+ object ConvertButton: TButton
+ Left = 216
+ Top = 120
+ Width = 201
+ Height = 41
+ Caption = 'Convert UTF-8 to ANSI'
+ Enabled = False
+ TabOrder = 2
+ OnClick = ConvertButtonClick
+ end
+ object SearchButton: TButton
+ Left = 8
+ Top = 120
+ Width = 202
+ Height = 41
+ Caption = 'Search'
+ TabOrder = 3
+ OnClick = SearchButtonClick
+ end
+ object FileMaskEdit: TEdit
+ Left = 8
+ Top = 79
+ Width = 202
+ Height = 28
+ TabOrder = 4
+ Text = '*.pas;*.dfm;*.xfm;*.dpr;*.dpk*'
+ end
+ object RootDirectoryEdit: TEdit
+ Left = 8
+ Top = 24
+ Width = 769
+ Height = 28
+ TabOrder = 5
+ end
+ end
+ object StatusBar1: TStatusBar
+ Left = 0
+ Top = 519
+ Width = 791
+ Height = 25
+ Font.Charset = ANSI_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -15
+ Font.Name = 'Segoe UI'
+ Font.Style = []
+ Panels = <>
+ SimplePanel = True
+ UseSystemFont = False
+ end
+ object FilePopupMenu: TPopupMenu
+ Left = 712
+ Top = 96
+ object OpenwithNotepad1: TMenuItem
+ Caption = 'Open with Notepad'
+ Default = True
+ OnClick = OpenwithNotepad1Click
+ end
+ end
+end
diff --git a/official/1.104/examples/windows/widestring/WideStringDemoMain.pas b/official/1.104/examples/windows/widestring/WideStringDemoMain.pas
new file mode 100644
index 0000000..dd18d68
--- /dev/null
+++ b/official/1.104/examples/windows/widestring/WideStringDemoMain.pas
@@ -0,0 +1,192 @@
+unit WideStringDemoMain;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, ComCtrls, StdCtrls, ExtCtrls, Menus, ShellAPI,
+ JclFileUtils, JclUnicode, JclSysInfo, JclFont;
+
+type
+ TForm1 = class(TForm)
+ FileListView: TListView;
+ Panel1: TPanel;
+ FilterEncodingComboBox: TComboBox;
+ IncludeSubDirectoriesCheckBox: TCheckBox;
+ ConvertButton: TButton;
+ SearchButton: TButton;
+ Label3: TLabel;
+ FileMaskEdit: TEdit;
+ Label2: TLabel;
+ RootDirectoryEdit: TEdit;
+ Label1: TLabel;
+ StatusBar1: TStatusBar;
+ FilePopupMenu: TPopupMenu;
+ OpenwithNotepad1: TMenuItem;
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure SearchButtonClick(Sender: TObject);
+ procedure AddFile(const Directory: string; const FileInfo: TSearchRec);
+ procedure TaskDone(const ID: TFileSearchTaskID; const Aborted: boolean);
+ procedure FileListViewColumnClick(Sender: TObject; Column: TListColumn);
+ procedure OpenwithNotepad1Click(Sender: TObject);
+ procedure ConvertButtonClick(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form1: TForm1;
+ FileListViewSortAscending: boolean;
+ UTF8FileCount: integer;
+ FFileEnumerator: TJclFileEnumerator;
+ FTaskID: TFileSearchTaskID;
+ FWideStringList: TWideStringList;
+
+const
+ SaveFormatValues: array[TSaveFormat] of string =
+ ('Unicode', 'Unicode big endian', 'UTF-8', 'ANSI');
+
+implementation
+
+{$R *.dfm}
+
+function CustomSortByColumn(Item1, Item2: TListItem; iData: integer): integer;
+ stdcall;
+var
+ Str1, Str2: string;
+begin
+ if (Item1 = nil) or (Item2 = nil) then
+ begin
+ Result := 0;
+ exit;
+ end;
+
+ try
+ if (iData = 0) then
+ begin
+ Str1 := Item1.Caption;
+ Str2 := Item2.Caption;
+ end
+ else
+ begin
+ if (iData >= 1) and (iData <= Item1.SubItems.Count) then
+ Str1 := Item1.SubItems[iData - 1]
+ else
+ Str1 := '';
+ if (iData >= 1) and (iData <= Item2.SubItems.Count) then
+ Str2 := Item2.SubItems[iData - 1]
+ else
+ Str2 := '';
+ end;
+ Result := AnsiCompareStr(Str1, Str2);
+ except
+ Result := 0;
+ end;
+
+ if not FileListViewSortAscending then
+ Result := -Result;
+end;
+
+procedure TForm1.AddFile(const Directory: string; const FileInfo: TSearchRec);
+var
+ ListItem: TListItem;
+begin
+ FWideStringList.LoadFromFile(Directory + FileInfo.Name);
+
+ if (FilterEncodingComboBox.Text = '') or (FilterEncodingComboBox.Text =
+ SaveFormatValues[FWideStringList.SaveFormat]) then
+ begin
+ ListItem := FileListView.Items.Add;
+ with ListItem do
+ begin
+ Caption := FileInfo.Name;
+ SubItems.Add(Directory);
+ SubItems.Add(SaveFormatValues[FWideStringList.SaveFormat]);
+ if (FWideStringList.SaveFormat = sfUTF8) then
+ Inc(UTF8FileCount);
+ end;
+ end;
+end;
+
+procedure TForm1.SearchButtonClick(Sender: TObject);
+begin
+ FFileEnumerator.OnTerminateTask := TaskDone;
+ FFileEnumerator.RootDirectory := RootDirectoryEdit.Text;
+ FFileEnumerator.FileMask := FileMaskEdit.Text;
+ FFileEnumerator.IncludeSubDirectories := IncludeSubDirectoriesCheckBox.Checked;
+
+ FileListView.Items.BeginUpdate;
+ FileListView.Items.Clear;
+ Screen.Cursor := crHourGlass;
+ UTF8FileCount := 0;
+ FTaskID := FFileEnumerator.ForEach(AddFile);
+end;
+
+procedure TForm1.ConvertButtonClick(Sender: TObject);
+var
+ i: integer;
+begin
+ for i := 0 to FileListView.Items.Count - 1 do
+ begin
+ if (FileListView.Items[i].SubItems[1] = 'UTF-8') then
+ begin
+ FWideStringList.LoadFromFile(PChar(FileListView.Items[i].SubItems[0] +
+ FileListView.Items[i].Caption));
+ if (FWideStringList.SaveFormat = sfUTF8) then
+ begin
+ FWideStringList.SaveFormat := sfAnsi;
+ FWideStringList.SaveToFile(PChar(FileListView.Items[i].SubItems[0] +
+ FileListView.Items[i].Caption));
+ FileListView.Items[i].SubItems[1] := SaveFormatValues[FWideStringList.SaveFormat];
+ Dec(UTF8FileCount);
+ end;
+ end;
+ end;
+ ConvertButton.Enabled := (UTF8FileCount > 0);
+end;
+
+procedure TForm1.FileListViewColumnClick(Sender: TObject; Column: TListColumn);
+begin
+ if (Column.Index = TListView(Sender).Tag) then
+ FileListViewSortAscending := not FileListViewSortAscending
+ else
+ TListView(Sender).Tag := Column.Index;
+ TListView(Sender).CustomSort(@CustomSortByColumn, Column.Index);
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+ FFileEnumerator := TJclFileEnumerator.Create;
+ FWideStringList := TWideStringList.Create;
+
+ SetObjectFontToSystemFont(Form1);
+
+ RootDirectoryEdit.Text := ExtractFilePath(Application.ExeName);
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+ FWideStringList.Free;
+ FFileEnumerator.Free;
+end;
+
+procedure TForm1.OpenwithNotepad1Click(Sender: TObject);
+begin
+ if (FileListView.Selected <> nil) then
+ ShellExecute(Handle, 'open', PChar(GetWindowsFolder + '\notepad.exe'),
+ PChar(FileListView.Selected.SubItems[0] + FileListView.Selected.Caption),
+ nil, SW_SHOWNORMAL);
+end;
+
+procedure TForm1.TaskDone(const ID: TFileSearchTaskID; const Aborted: boolean);
+begin
+ FileListView.Items.EndUpdate;
+ Screen.Cursor := crDefault;
+ StatusBar1.SimpleText := Format('%d files', [FileListView.Items.Count]);
+ ConvertButton.Enabled := (UTF8FileCount > 0);
+end;
+
+end.
diff --git a/official/1.104/examples/windows/widestring/WideStringExample.dpr b/official/1.104/examples/windows/widestring/WideStringExample.dpr
new file mode 100644
index 0000000..e5aae47
--- /dev/null
+++ b/official/1.104/examples/windows/widestring/WideStringExample.dpr
@@ -0,0 +1,14 @@
+program WideStringExample;
+
+uses
+ Forms,
+ WideStringDemoMain in 'WideStringDemoMain.pas' {Form1};
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'TWideStringList Example (JclUnicode)';
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
diff --git a/official/1.104/examples/windows/widestring/WideStringExample.res b/official/1.104/examples/windows/widestring/WideStringExample.res
new file mode 100644
index 0000000..2dc0523
Binary files /dev/null and b/official/1.104/examples/windows/widestring/WideStringExample.res differ
diff --git a/official/1.104/experts/common/JclConfigure.ico b/official/1.104/experts/common/JclConfigure.ico
new file mode 100644
index 0000000..294f6aa
Binary files /dev/null and b/official/1.104/experts/common/JclConfigure.ico differ
diff --git a/official/1.104/experts/common/JclImages.rc b/official/1.104/experts/common/JclImages.rc
new file mode 100644
index 0000000..824804b
--- /dev/null
+++ b/official/1.104/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.104/experts/common/JclImages.res b/official/1.104/experts/common/JclImages.res
new file mode 100644
index 0000000..42a014e
Binary files /dev/null and b/official/1.104/experts/common/JclImages.res differ
diff --git a/official/1.104/experts/common/JclOtaActionConfigureSheet.dfm b/official/1.104/experts/common/JclOtaActionConfigureSheet.dfm
new file mode 100644
index 0000000..429f997
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaActionConfigureSheet.dfm
@@ -0,0 +1,68 @@
+object JclOtaActionConfigureFrame: TJclOtaActionConfigureFrame
+ Left = 0
+ Top = 0
+ Width = 369
+ 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 = 337
+ 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
+ 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.104/experts/common/JclOtaActionConfigureSheet.pas b/official/1.104/experts/common/JclOtaActionConfigureSheet.pas
new file mode 100644
index 0000000..7d9aa4e
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaActionConfigureSheet.pas
@@ -0,0 +1,169 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaActionConfigureSheet.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaActionConfigureSheet;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/common/JclOtaActionConfigureSheet.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/common/JclOtaConfigurationForm.dfm b/official/1.104/experts/common/JclOtaConfigurationForm.dfm
new file mode 100644
index 0000000..3374153
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaConfigurationForm.dfm
@@ -0,0 +1,111 @@
+object JclOtaOptionsForm: TJclOtaOptionsForm
+ Left = 0
+ Top = 0
+ ClientWidth = 554
+ ClientHeight = 486
+ 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
+ Width = 3
+ Height = 450
+ Cursor = crHSplit
+ 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]
+ Cancel = True
+ 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.104/experts/common/JclOtaConfigurationForm.pas b/official/1.104/experts/common/JclOtaConfigurationForm.pas
new file mode 100644
index 0000000..249fc86
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaConfigurationForm.pas
@@ -0,0 +1,257 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaActionConfigureSheet.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaConfigurationForm;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls, ComCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/common/JclOtaConfigurationForm.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
\ No newline at end of file
diff --git a/official/1.104/experts/common/JclOtaConsts.pas b/official/1.104/experts/common/JclOtaConsts.pas
new file mode 100644
index 0000000..ae6ce2e
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaConsts.pas
@@ -0,0 +1,169 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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) }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaConsts;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ ToolsApi;
+
+const
+ DelphiRootDirKeyValue = 'RootDir';
+ RegJclKey = 'Jedi\JCL\';
+ RegJclIDEKey = RegJclKey + 'IDE\';
+ DelphiEnvironmentVar = 'DELPHI';
+ {$IFDEF COMPILER6_UP}
+ EnvironmentVarsKey = 'Environment Variables';
+ {$ENDIF COMPLER6_UP}
+
+ //=== Various constants shared by different experts ========================
+ JclLeft = 'Left';
+ JclTop = 'Top';
+ JclWidth = 'Right';
+ JclHeight = 'Height';
+
+ JclDesignerAny = {$IFDEF COMPILER6_UP} dAny {$ELSE COMPILER6_UP} '' {$ENDIF COMPILER6_UP};
+ JclDesignerVcl = {$IFDEF COMPILER6_UP} dVcl {$ELSE COMPILER6_UP} '' {$ENDIF COMPILER6_UP};
+ JclDesignerClx = {$IFDEF COMPILER6_UP} dClx {$ELSE COMPILER6_UP} '' {$ENDIF COMPILER6_UP};
+ JclDelphiPersonality = {$IFDEF BDS} sDelphiPersonality {$ELSE BDS} '' {$ENDIF BDS};
+ JclCBuilderPersonality = {$IFDEF BDS} sCBuilderPersonality {$ELSE BDS} '' {$ENDIF BDS};
+
+
+ //=== Configuration ========================================================
+ JclConfigurationSettings = 'JclExpertConfigurationForm';
+ JclActionSettings = 'Actions';
+
+ //=== Configuration form ===================================================
+ JclPanelTreeWidth = 'PanelTreeWidth';
+ JclConfigureActionName = 'JCLConfigureCommand';
+ JclConfigureMenuName = 'JCLConfigureMenu';
+
+ //=== Debug Expert =========================================================
+ JclDebugExpertRegKey = 'JclDebugExpert';
+ JclDebugEnabledRegValue = 'JclDebugEnabled';
+ JclDebugGenerateJdbgRegValue = 'JclDebugGenerateJdbg';
+ JclDebugInsertJdbgRegValue = 'JclDebugInsertJdbg';
+ JclDebugDeleteMapFileRegValue = 'JclDebugDeleteMapFile';
+ MapFileOptionName = 'MapFile';
+ OutputDirOptionName = 'OutputDir';
+ RuntimeOnlyOptionName = 'RuntimeOnly';
+ PkgDllDirOptionName = 'PkgDllDir';
+ BPLOutputDirOptionName = 'PackageDPLOutput';
+ LIBPREFIXOptionName = 'SOPrefix';
+ LIBSUFFIXOptionName = 'SOSuffix';
+ ColumnRegName = 'Column%d';
+ JclDebugMessagePrefix = 'Jcl Debug Expert';
+ JclDebugExpertActionName = 'JCLDebugExpertCommand';
+ JclDebugExpertMenuName = 'JCLDebugExpertMenu';
+ JclGenerateJdbgActionName = 'JCLGenerateJdbgCommand';
+ JclGenerateJdbgMenuName = 'JCLGenerateJdbgMenu';
+ JclInsertJdbgActionName = 'JCLInsertJdbgCommand';
+ JclInsertJdbgMenuName = 'JCLInsertJdbgMenu';
+ JclDeleteMapFileActionName = 'JCLDeleteMapFileCommand';
+ JclDeleteMapFileMenuName = 'JCLDeleteMapFileMenu';
+ JclDebugGenerateJdbgSetting = 'JCL_DEBUG_EXPERT_GENERATEJDBG';
+ JclDebugInsertJdbgSetting = 'JCL_DEBUG_EXPERT_INSERTJDBG';
+ JclDebugDeleteMapfileSetting = 'JCL_DEBUG_EXPERT_DELETEMAPFILE';
+
+ //=== Favorite Folders Expert ==============================================
+ JclFavoritesExpertName = 'JclFavoriteFoldersExpert';
+ JclFavoritesListSubKey = 'Favorites';
+ PictDialogFolderItemName = 'PictureDialogPath';
+ BorlandImagesPath = 'Borland Shared\Images';
+ FavDialogTemplateName = 'FAVDLGTEMPLATE';
+ OpenPictDialogTemplateName = 'DLGTEMPLATE';
+
+ //=== Threads Expert =======================================================
+ JclThreadsExpertName = 'JclThreadsExpert';
+
+ //=== SIMD Expert ==========================================================
+ JclSIMDExpertName = 'JclSIMDExpert';
+ JclSIMDActionName = 'JCLSIMDCommand';
+ JclSIMDMenuName = 'JCLSIMDMenu';
+
+ //=== Uses Expert ==========================================================
+ JclUsesExpertName = 'JclUsesExpert';
+ SIniIdentifierLists = 'IdentifierLists';
+ SRegDebugLibPath = 'Debug Library';
+ SRegLibPath = 'Library';
+ SRegWizardActive = 'Uses Wizard Active';
+ SRegWizardConfirm = 'Uses Wizard Confirm';
+ SRegWizardIniFile = 'Configuration File';
+ JclRootDirValueName = 'RootDir';
+ JclIniFileLocation = 'experts\useswizard\JediUsesWizard.ini';
+
+ //=== Project analyser =====================================================
+ JclProjectAnalyzerExpertName = 'JclProjectAnalyzerExpert';
+ AnalyzerViewName = 'AnalyzerView';
+ AnalyzerShowPackagesName = 'ShowPackages';
+ JclProjectAnalyzeActionName = 'JCLProjectAnalyseCommand';
+ JclProjectAnalyzeMenuName = 'JCLProjectAnalyseMenu';
+
+ //=== Repository Expert ====================================================
+ JclRepositoryCategoryDelphiFiles = {$IFDEF BDS} sCategoryDelphiNewFiles {$ELSE BDS} '' {$ENDIF BDS};
+ JclRepositoryCategoryCBuilderFiles = {$IFDEF BDS} sCategoryCBuilderNewFiles {$ELSE BDS} '' {$ENDIF BDS};
+
+ //=== Version Control Expert ===============================================
+ JclVersionCtrlMenuName = 'JclVersionCtrlMenu';
+ JclVersionCtrlActOnTopSandboxName = 'ActOnTopSandbox';
+ JclVersionCtrlMenuOrganizationName = 'MenuOrganization';
+ JclVersionCtrlSaveConfirmationName = 'SaveConfirmation';
+ JclVersionCtrlDisableActionsName = 'DisableActions';
+ JclVersionCtrlHideActionsName = 'HideActions';
+ JclVersionCtrlIconTypeName = 'IconType';
+ JclVersionCtrlIconTypeAutoValue = 'auto';
+ JclVersionCtrlIconTypeNoIconValue = 'noicon';
+ JclVersionCtrlIconTypeJclIconValue = 'jclicons';
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/common/JclOtaConsts.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/common/JclOtaExceptionForm.dfm b/official/1.104/experts/common/JclOtaExceptionForm.dfm
new file mode 100644
index 0000000..3f9fedc
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaExceptionForm.dfm
@@ -0,0 +1,63 @@
+object JclExpertExceptionForm: TJclExpertExceptionForm
+ Left = 157
+ Top = 183
+ ClientWidth = 551
+ ClientHeight = 423
+ 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 = 222
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ TabOrder = 1
+ end
+ object ButtonClose: TButton
+ Left = 470
+ Top = 396
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Cancel = True
+ Caption = 'RsReportClose'
+ ModalResult = 1
+ TabOrder = 2
+ end
+end
diff --git a/official/1.104/experts/common/JclOtaExceptionForm.pas b/official/1.104/experts/common/JclOtaExceptionForm.pas
new file mode 100644
index 0000000..6bb7a6b
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaExceptionForm.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 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+unit JclOtaExceptionForm;
+
+interface
+
+{$I jcl.inc}
+{$I crossplatform.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/common/JclOtaExceptionForm.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/common/JclOtaResources.pas b/official/1.104/experts/common/JclOtaResources.pas
new file mode 100644
index 0000000..bb2a770
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaResources.pas
@@ -0,0 +1,387 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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) }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $ }
+{ Revision: $Rev:: 2498 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaResources;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclBase;
+
+//=== JclOtaUtils.pas ========================================================
+resourcestring
+ RsENoOTAServices = 'Unable to get Borland IDE Services';
+ RsENoNTAServices = 'Unable to get Borland NTA Services';
+ RsENoDebuggerServices = 'Unable to get Borland Debugger Services';
+ RsENoNTASplashServices = 'Unable to get Borland Splash Services';
+ RsENoOTAAboutServices = 'Unable to get Borland About Services';
+ RsENoOTAModuleServices = 'Unable to get Borland Module Services';
+ RsENoOTAWizardServices = 'Unable to get Borland Wizard Services';
+ RsENoOTAPackageServices = 'Unable to get Borland Package Services';
+ RsENoOTAPersonalityServices = 'Unable to get Borland Personality Services';
+ RsENoOTAProjectManager = 'Unable to get project manager';
+ RsENoOTAMessageServices = 'Unable to get Borland Message Services';
+ RsENoOTAGalleryCategoryManager = 'Unable to get Borland Gallery Category Manager';
+ 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' + NativeLineBreak +
+ 'The JCL is a member of the JEDI Project http://www.delphi-jedi.org' + NativeLineBreak +
+ 'Covered under the Mozilla Public License v1.1 (MPL 1.1)' + NativeLineBreak +
+ 'License available at http://www.mozilla.org/MPL/MPL-1.1.html';
+ RsAboutLicenceStatus = 'MPL 1.1';
+ RsJCLOptions = 'JCL Options...';
+ RsActionSheet = 'Common\Actions';
+ RsUnitVersioningSheet = 'Common\Unit versioning';
+ RsENoBitmapResources = 'Unable to load bitmap resource';
+ RsENoEnvironmentOptions = 'Environment options are not available';
+ RsELineTooLong = 'Line too long in project file';
+ RsEUnterminatedComment = 'Unterminated comment in project file';
+
+//=== JclExceptionForm.pas ===================================================
+resourcestring
+ RsReportFormCaption = 'Exception in an expert of the JCL';
+ RsExceptionDetails = 'An exception was raised in an expert of the JCL.' + NativeLineBreak +
+ '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.' + NativeLineBreak +
+ 'There are several ways to report bugs in the JCL:' + NativeLineBreak +
+ ' - issue tracker (recommended),' + NativeLineBreak +
+ ' - jedi newsgroups,' + NativeLineBreak +
+ ' - mailing list.' + NativeLineBreak +
+ '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';
+
+//=== JclOtaUnitVersioningSheet.pas ==========================================
+resourcestring
+ RsCopyToClipboard = '&Copy to clipboard';
+ RsSaveAsText = '&Save as...';
+
+//=== JclExpertConfigurationForm.pas =========================================
+resourcestring
+ RsConfigurationCaption = 'JCL Options';
+ RsOk = '&Ok';
+ RsCancel = '&Cancel';
+ RsSelectPage = 'Select a page';
+ RsHomePage = '&JCL Home page';
+
+//=== JclOtaWizardForm.pas ===================================================
+resourcestring
+ RsNext = '&Next';
+ RsPrevious = '&Previous';
+ RsFinish = '&Finish';
+ RsWizardProgression = 'Page %d of %d: %s';
+
+//=== JclOtaExcDlgWizard.pas =================================================
+resourcestring
+ RsExceptionDialogConfigure = 'New exception dialog...';
+
+//=== JclOtaExcDlgFileFrame.pas ==============================================
+resourcestring
+ RsExcDlgFileOptions = 'file options';
+ RsLanguage = '&Language:';
+ RsFileName = '&File name:';
+ RsFormName = 'Form &name:';
+ RsFormAncestor = 'Form &ancestor:';
+ RsFileNameDialog = '&Save new file as...';
+
+//=== JclOtaExcDlgFormFrame.pas ==============================================
+resourcestring
+ RsExcDlgFormOptions = 'form options';
+ RsDialogWithMailButton = '&Button to send stack trace by mail';
+ RsEMail = '&EMail:';
+ RsSubject = '&Subject:';
+ RsModalDialog = '&Modal dialog';
+ RsSizeableDialog = 'S&izeable dialog';
+ RsAutoScrollBars = '&Automatic scroll bars';
+
+//=== JclOtaExcDlgSystemFrame.pas ============================================
+resourcestring
+ RsExcDlgSystemOptions = 'system options';
+ RsDelayedStackTrace = '&Delayed stack traces (faster)';
+ RsLogTrace = '&Add crash data to log file';
+ RsHookDll = '&Hook DLL';
+ RsModuleList = '&Module list';
+ RsUnitVersioning = '&Unit versioning';
+ RsOSInfo = '&Operating system informations';
+ RsActiveControls = '&List of active controls';
+ RsMainThreadOnly = '&Catch only exceptions of main thread';
+
+//=== JclOtaExcDlgTraceFrame.pas =============================================
+resourcestring
+ RsExcDlgTraceOptions = 'trace options';
+ RsStackList = '&Stack list';
+ RsRawData = '&Raw analysis of the stack';
+ RsModuleName = '&Module name';
+ //RsAddressOffset = 'Address offset';
+ RsCodeDetails = '&Code details';
+ RsVirtualAddress = '&Virtual address';
+ RsModuleOffset = 'Module &offset';
+ RsPreview = '&Preview:';
+ RsAllThreads = 'Include traces for registered &threads';
+
+//=== JclOtaExcDlgIgnoreFrame.pas ============================================
+resourcestring
+ RsExcDlgIgnoreOptions = 'ignored exceptions';
+ RsTraceAllExceptions = '&Trace all exceptions';
+ RsTraceEAbort = 'Trace &EAbort and its descendants';
+ RsIgnoredExceptions = '&Ancestor exception classes to ignore (one per line)';
+
+//=== 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';
+
+//=== ProjAnalyserImpl.pas ===================================================
+resourcestring
+ RsAnalyzeActionCaption = 'Analyze project %s';
+ 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, ICode: %d, Data: %d, Bss: %d, Resources: %d';
+ RsCodeData = '(CODE+ICODE+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';
+ RsCantInsertToInstalledPackage = 'JCL Debug IDE Expert: Can not insert debug information to installed package' +
+ NativeLineBreak + '%s' + NativeLineBreak + 'Would you like to disable the insertion of JCL Debug data ?';
+ RsChangeMapFileOption = 'JCL Debug expert: the project "%s" must be configured to generate a detailled MAP file.' +
+ NativeLineBreak + 'Do you want the expert to change this setting?';
+ RsDisabledDebugExpert = 'JCL Debug expert is disabled';
+ RsCompilationAborted = 'JCL Debug data cannot be inserted to installed package' + NativeLineBreak + 'Compilation aborted';
+ RsDebugExpertCaption = 'JCL Debug expert';
+ RsAlwaysDisabled = 'Always &disabled';
+ RsProjectDisabled = 'D&isabled for this project';
+ RsProjectEnabled = 'E&nabled for this project';
+ RsAlwaysEnabled = 'Always &enabled';
+ RsEExecutableNotFound = 'Executable file for project "%s" not found.' +
+ 'JCL debug data can''t be added to the binary.';
+ RsEMapFileNotFound = 'Map file "%s" for project "%s" not found.' +
+ 'No conversions of debug information were made';
+ RsConvertedMapToJdbg = 'Converted MAP file "%s" (%d bytes) to .jdbg (%d bytes)';
+ RsInsertedJdbg = 'Converted MAP file "%s" (%d bytes) and inserted debug information (%d bytes) into the binary';
+ RsDeletedMapFile = 'Deleted %s file "%s"';
+ RsEFailedToDeleteMapFile = 'Failed to delete %s file "%s"';
+ RsEMapConversion = 'Failed to convert MAP file "%s"';
+ 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';
+ RsDebugConfigPageCaption = 'Debug info converter';
+ RsEProjectPropertyFailed = 'Unable to save project properties, project file may be read-only';
+
+//=== JclDebugIdeConfigFrame.pas =============================================
+resourcestring
+ RsDefaultDisabled = 'D&isabled by default (can be enabled per project)';
+ RsDefaultEnabled = 'E&nabled by default (can be disabled per project)';
+ RsDebugGenerateJdbg = 'Generate .jdbg files';
+ RsDebugInsertJdbg = 'Insert JDBG data into the binary';
+ RsDeleteMapFile = 'Delete map files after conversion';
+ RsEInvalidDebugExpertState = '%d is not a valid debug expert state';
+
+//=== JclSIMDView.pas ========================================================
+resourcestring
+ 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!';
+ RsLong = '64-bit Core';
+
+ RsTrademarks =
+ 'MMX is a trademark of Intel Corporation.' + NativeLineBreak +
+ '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';
+
+//=== JclOtaExcDlgRepository.pas =============================================
+resourcestring
+ RsRepositoryExcDlgPage = 'Exception dialog';
+
+ RsRepositoryExcDlgDelphiName = 'Jcl Exception dialog for Delphi';
+ RsRepositoryExcDlgDelphiDescription = 'Create an exception dialog for your Delphi project';
+
+ RsRepositoryExcDlgCBuilderName = 'Jcl Exception dialog for C++Builder';
+ RsRepositoryExcDlgCBuilderDescription = 'Create an exception dialog for your C++Builder';
+
+//=== JclVersionControlImpl.pas ==============================================
+resourcestring
+ RsVersionCtrlMenuCaption = '&Version Control';
+ RsSvnMenuItemNotInserted = 'Can''t insert the ''%s'' menu item';
+ RsENoToolsMenuItem = 'Tools menu item not found';
+ RsVersionControlSheet = 'Version control';
+ RsActionCategory = 'JEDI Code Library';
+ RsVersionCtrlSystemName = 'System';
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/common/JclOtaResources.pas $';
+ Revision: '$Revision: 2498 $';
+ Date: '$Date: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $';
+ LogPath: 'JCL\experts\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/common/JclOtaUnitVersioningSheet.dfm b/official/1.104/experts/common/JclOtaUnitVersioningSheet.dfm
new file mode 100644
index 0000000..87a5d41
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaUnitVersioningSheet.dfm
@@ -0,0 +1,47 @@
+object JclOtaUnitVersioningFrame: TJclOtaUnitVersioningFrame
+ Left = 0
+ Top = 0
+ Width = 369
+ Height = 375
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ TabOrder = 0
+ TabStop = True
+ object MemoUnitVersioning: TMemo
+ Left = 8
+ Top = 8
+ Width = 353
+ Height = 321
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ ParentColor = True
+ ReadOnly = True
+ ScrollBars = ssBoth
+ TabOrder = 0
+ end
+ object ButtonCopyToClipboard: TButton
+ Left = 8
+ Top = 335
+ Width = 137
+ Height = 25
+ Anchors = [akLeft, akBottom]
+ Caption = 'RsCopyClipboard'
+ TabOrder = 1
+ OnClick = ButtonCopyToClipboardClick
+ end
+ object ButtonSaveAsText: TButton
+ Left = 151
+ Top = 335
+ Width = 137
+ Height = 25
+ Anchors = [akLeft, akBottom]
+ Caption = 'RsSaveAsText'
+ TabOrder = 2
+ OnClick = ButtonSaveAsTextClick
+ end
+ object SaveDialogText: TSaveDialog
+ DefaultExt = 'txt'
+ Filter = 'Text files (*.txt)|*.txt|All files (*.*)|*.*'
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing]
+ Left = 120
+ Top = 168
+ end
+end
diff --git a/official/1.104/experts/common/JclOtaUnitVersioningSheet.pas b/official/1.104/experts/common/JclOtaUnitVersioningSheet.pas
new file mode 100644
index 0000000..2ede79e
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaUnitVersioningSheet.pas
@@ -0,0 +1,133 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaUnitVersioningSheet.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 23:08:21 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2494 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaUnitVersioningSheet;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ JclUnitVersioning,
+ Dialogs, ComCtrls, StdCtrls;
+
+type
+ TJclOtaUnitVersioningFrame = class(TFrame)
+ MemoUnitVersioning: TMemo;
+ ButtonCopyToClipboard: TButton;
+ ButtonSaveAsText: TButton;
+ SaveDialogText: TSaveDialog;
+ procedure ButtonCopyToClipboardClick(Sender: TObject);
+ procedure ButtonSaveAsTextClick(Sender: TObject);
+ private
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/common/JclOtaUnitVersioningSheet.pas $';
+ Revision: '$Revision: 2494 $';
+ Date: '$Date: 2008-09-23 23:08:21 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ ActnList, Menus,
+ ToolsApi,
+ JclBase, JclFileUtils, JclUnitVersioningProviders,
+ JclOtaConsts, JclOtaResources, JclOtaUtils;
+
+procedure TJclOtaUnitVersioningFrame.ButtonCopyToClipboardClick(
+ Sender: TObject);
+begin
+ MemoUnitVersioning.SelectAll;
+ MemoUnitVersioning.CopyToClipboard;
+end;
+
+procedure TJclOtaUnitVersioningFrame.ButtonSaveAsTextClick(Sender: TObject);
+begin
+ if SaveDialogText.Execute then
+ MemoUnitVersioning.Lines.SaveToFile(SaveDialogText.FileName);
+end;
+
+constructor TJclOtaUnitVersioningFrame.Create(AOwner: TComponent);
+var
+ UnitVersioning: TUnitVersioning;
+ UnitVersioningModule: TUnitVersioningModule;
+ UnitVersion: TUnitVersion;
+ I, J: Integer;
+ LongFileName: string;
+begin
+ inherited Create(AOwner);
+ ButtonCopyToClipboard.Caption := RsCopyToClipboard;
+ ButtonSaveAsText.Caption := RsSaveAsText;
+
+ UnitVersioning := GetUnitVersioning;
+ UnitVersioning.RegisterProvider(TJclDefaultUnitVersioningProvider);
+ for I := 0 to Pred(UnitVersioning.ModuleCount) do
+ UnitVersioning.LoadModuleUnitVersioningInfo(UnitVersioning.Modules[I].Instance);
+ MemoUnitVersioning.Lines.BeginUpdate;
+ try
+ MemoUnitVersioning.Lines.Clear;
+ MemoUnitVersioning.Lines.Add(Format('JCL %d.%d.%d.%d', [JclVersionMajor, JclVersionMinor, JclVersionRelease, JclVersionBuild]));
+ for I := 0 to Pred(UnitVersioning.ModuleCount) do
+ begin
+ UnitVersioningModule := UnitVersioning.Modules[I];
+ MemoUnitVersioning.Lines.Add(Format('%s [%d units]', [GetModulePath(UnitVersioningModule.Instance), UnitVersioningModule.Count]));
+ for J := 0 to Pred(UnitVersioningModule.Count) do
+ begin
+ UnitVersion := UnitVersioningModule.Items[J];
+ LongFileName := UnitVersion.LogPath;
+ if LongFileName <> '' then
+ LongFileName := PathAddSeparator(LongFileName);
+ LongFileName := LongFileName + UnitVersion.RCSfile;
+ MemoUnitVersioning.Lines.Add(Format('%s %s %s', [LongFileName, UnitVersion.Revision, UnitVersion.Date]));
+ end;
+ end;
+ finally
+ MemoUnitVersioning.Lines.EndUpdate;
+ end;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/common/JclOtaUtils.pas b/official/1.104/experts/common/JclOtaUtils.pas
new file mode 100644
index 0000000..85e4bfa
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaUtils.pas
@@ -0,0 +1,1695 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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) }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $ }
+{ Revision: $Rev:: 2498 $ }
+{ Author: $Author:: outchy $ }
+{ $Date: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $ xpin }
+{**************************************************************************************************}
+unit JclOtaUtils;
+
+interface
+
+{$I jcl.inc}
+{$I crossplatform.inc}
+
+uses
+ SysUtils, Classes, Windows,
+ Controls, ComCtrls, ActnList, Menus,
+ {$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}
+ JclBase,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ {$IFDEF MSWINDOWS}
+ JclDebug,
+ {$ENDIF MSWINDOWS}
+ JclBorlandTools,
+ ToolsAPI;
+
+const
+ MapFileOptionDetailed = 3;
+
+type
+ // class of actions with a drop down menu on tool bars
+ {$IFDEF COMPILER8_UP}
+ TDropDownAction = TControlAction;
+ {$ELSE COMPILER8_UP}
+ TDropDownAction = TPopupAction;
+ {$ENDIF COMPILER8_UP}
+
+// 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;
+ FSettings: TJclOTASettings;
+ function GetModuleHInstance: Cardinal;
+ function GetRootDir: string;
+ procedure ReadEnvVariables;
+ procedure ConfigurationActionUpdate(Sender: TObject);
+ procedure ConfigurationActionExecute(Sender: TObject);
+ function GetActivePersonality: TJclBorPersonality;
+ function GetDesigner: string;
+ public
+ class function GetNTAServices: INTAServices;
+ class function GetOTAServices: IOTAServices;
+ class function GetOTADebuggerServices: IOTADebuggerServices;
+ class function GetOTAModuleServices: IOTAModuleServices;
+ class function GetOTAPackageServices: IOTAPackageServices;
+ {$IFDEF BDS}
+ class function GetOTAPersonalityServices: IOTAPersonalityServices;
+ class function GetOTAGalleryCategoryManager: IOTAGalleryCategoryManager;
+ {$ENDIF BDS}
+ {$IFDEF BDS4_UP}
+ class function GetOTAProjectManager: IOTAProjectManager;
+ {$ENDIF BDS4_UP}
+ class function GetOTAMessageServices: IOTAMessageServices;
+ class function GetOTAWizardServices: IOTAWizardServices;
+ class function GetActiveProject: IOTAProject;
+ class function GetProjectGroup: IOTAProjectGroup;
+ class function IsPersonalityLoaded(const PersonalityName: string): Boolean;
+ 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;
+ procedure AfterConstruction; override;
+ procedure BeforeDestruction; override;
+
+ function FindExecutableName(const MapFileName: TFileName; const OutputDirectory: string;
+ var ExecutableFileName: TFileName): Boolean;
+ function GetDrcFileName(const Project: IOTAProject): TFileName;
+ function GetMapFileName(const Project: IOTAProject): TFileName;
+ 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 Settings: TJclOTASettings read FSettings;
+ property RootDir: string read GetRootDir;
+ property ActivePersonality: TJclBorPersonality read GetActivePersonality;
+ property Designer: string read GetDesigner;
+
+ property ModuleHInstance: Cardinal read GetModuleHInstance;
+ end;
+
+ TJclOTAExpert = class(TJclOTAExpertBase, IOTAWizard, IOTANotifier)
+ protected
+ procedure AfterSave; virtual;
+ procedure BeforeSave; virtual;
+ procedure Destroyed; virtual;
+ procedure Modified; virtual;
+ procedure Execute; virtual;
+ function GetIDString: string; virtual;
+ function GetName: string; virtual;
+ function GetState: TWizardState; virtual;
+ end;
+
+// procedure SaveOptions(const Options: IOTAOptions; const FileName: string);
+function JclExpertShowExceptionDialog(AExceptionObj: TObject): Boolean;
+{$IFDEF BDS}
+function PersonalityTextToId(const PersonalityText: string): TJclBorPersonality;
+{$ENDIF BDS}
+
+{$IFDEF BDS}
+procedure RegisterSplashScreen;
+procedure RegisterAboutBox;
+{$ENDIF BDS}
+
+// properties are stored as "// PropID PropValue" in project file
+// they have to be placed before any identifiers and after comments at the beginning of the file
+function GetProjectProperties(const AProject: IOTAProject; const PropIDs: TDynAnsiStringArray): TDynAnsiStringArray;
+function SetProjectProperties(const AProject: IOTAProject; const PropIDs, PropValues: TDynAnsiStringArray): Integer;
+
+// set to true to temporary disable experts that alter compiled files after they were compiled
+var
+ JclDisablePostCompilationProcess: Boolean = False;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/common/JclOtaUtils.pas $';
+ Revision: '$Revision: 2498 $';
+ Date: '$Date: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $';
+ LogPath: 'JCL\experts\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+ {$IFDEF HAS_UNIT_VARIANTS}
+ Variants,
+ {$ENDIF HAS_UNIT_VARIANTS}
+ Forms, Graphics, Dialogs, ActiveX,
+ {$IFDEF MSWINDOWS}
+ ImageHlp, JclRegistry,
+ {$ENDIF MSWINDOWS}
+ JclFileUtils, JclStrings, JclSysInfo, JclSimpleXml,
+ JclOtaConsts, JclOtaResources, JclOtaExceptionForm, JclOtaConfigurationForm,
+ JclOtaActionConfigureSheet, JclOtaUnitVersioningSheet,
+ JclOtaWizardForm, JclOtaWizardFrame;
+
+{$R 'JclImages.res'}
+
+var
+ GlobalActionList: TList = nil;
+ GlobalActionSettings: TJclOtaSettings = nil;
+ GlobalExpertList: TList = nil;
+ ConfigurationAction: TAction = nil;
+ ConfigurationMenuItem: TMenuItem = nil;
+ ActionConfigureSheet: TJclOtaActionConfigureFrame = nil;
+ UnitVersioningSheet: TJclOtaUnitVersioningFrame = 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;
+
+{$IFDEF BDS}
+function PersonalityTextToId(const PersonalityText: string): TJclBorPersonality;
+begin
+ if SameText(PersonalityText, sDelphiPersonality) then
+ Result := bpDelphi32
+ else if SameText(PersonalityText, sDelphiDotNetPersonality) then
+ Result := bpDelphiNet32
+ else if SameText(PersonalityText, sCBuilderPersonality) then
+ Result := bpBCBuilder32
+ else if SameText(PersonalityText, sCSharpPersonality) then
+ Result := bpCSBuilder32
+ else if SameText(PersonalityText, sVBPersonality) then
+ Result := bpVisualBasic32
+ {$IFDEF COMPILER10_UP}
+ else if SameText(PersonalityText, sDesignPersonality) then
+ Result := bpDesign
+ {$ENDIF COMPILER10_UP}
+ else
+ Result := bpUnknown;
+end;
+{$ENDIF BDS}
+
+// result[] > 0: the property was found, result is the position of the first char of the property value
+// result[] <= 0: the property was not found, -result is the position where the property could be inserted
+function InternalLocateProperties(const AReader: IOTAEditReader; const PropIDs: TDynAnsiStringArray): TDynIntegerArray;
+const
+ BufferSize = 4096;
+var
+ Buffer, Line: AnsiString;
+ BufferStart, BufferCount, BufferPosition, LineStart, Position, PropIndex, PropCount, PropMatches: Integer;
+ InsideLineComment, InsideComment, InsideBrace: Boolean;
+ procedure LoadNextBuffer;
+ begin
+ BufferStart := Position;
+ BufferCount := AReader.GetText(BufferStart, PAnsiChar(Buffer), BufferSize);
+ BufferPosition := Position - BufferStart;
+ end;
+begin
+ BufferStart := 0;
+ BufferCount := 0;
+ LineStart := 0;
+ Position := 0;
+ PropMatches := 0;
+ InsideLineComment := False;
+ InsideComment := False;
+ InsideBrace := False;
+ PropCount := Length(PropIDs);
+ SetLength(Result, PropCount);
+ for PropIndex := 0 to PropCount - 1 do
+ Result[PropIndex] := -1;
+
+ SetLength(Buffer, BufferSize);
+ repeat
+ BufferPosition := Position - BufferStart;
+
+ if BufferPosition >= BufferCount then
+ LoadNextBuffer;
+
+ case Buffer[BufferPosition + 1] of
+ NativeLineFeed,
+ NativeCarriageReturn:
+ begin
+ if InsideLineComment and not (InsideComment or InsideBrace) then
+ begin
+ // process line
+ InsideLineComment := False;
+ if (LineStart - BufferStart) < 0 then
+ raise EJclExpertException.CreateRes(@RsELineTooLong);
+ Line := Copy(Buffer, LineStart - BufferStart + 1, Position - LineStart);
+ for PropIndex := 0 to PropCount - 1 do
+ if Pos(PropIDs[PropIndex], Line) = 4 then
+ begin
+ Result[PropIndex] := LineStart + Length(PropIDs[PropIndex]) + 4;
+ Inc(PropMatches);
+ end;
+ end;
+ LineStart := Position + 1;
+ end;
+ '/':
+ begin
+ if BufferPosition >= BufferCount then
+ LoadNextBuffer;
+ if (BufferPosition + 1) < BufferCount then
+ begin
+ if not (InsideLineComment or InsideComment or InsideBrace) then
+ begin
+ if (Buffer[BufferPosition + 2] = '/') then
+ begin
+ Inc(Position);
+ InsideLineComment := True;
+ end
+ else
+ // end of comments
+ Break;
+ end;
+ end
+ else
+ // end of file
+ Break;
+ end;
+ '(':
+ begin
+ if BufferPosition >= BufferCount then
+ LoadNextBuffer;
+ if (BufferPosition + 1) < BufferCount then
+ begin
+ if not (InsideLineComment or InsideComment or InsideBrace) then
+ begin
+ if (Buffer[BufferPosition + 2] = '*') then
+ begin
+ Inc(Position);
+ InsideComment := True;
+ end
+ else
+ // end of comments
+ Break;
+ end;
+ end
+ else
+ // end of file
+ Break;
+ end;
+ '*':
+ begin
+ if BufferPosition >= BufferCount then
+ LoadNextBuffer;
+ if (BufferPosition + 1) < BufferCount then
+ begin
+ if InsideComment then
+ begin
+ if (Buffer[BufferPosition + 2] = ')') then
+ begin
+ Inc(Position);
+ InsideComment := False;
+ end;
+ end
+ else
+ if not (InsideLineComment or InsideBrace) then
+ // end of comments
+ Break;
+ end
+ else
+ // end of file
+ Break;
+ end;
+ '{':
+ if not (InsideLineComment or InsideComment or InsideBrace) then
+ InsideBrace := True;
+ '}':
+ if InsideBrace then
+ InsideBrace := False
+ else
+ if not (InsideLineComment or InsideComment) then
+ // end of comments
+ Break;
+ else
+ if not CharIsWhiteSpace(Char(Buffer[BufferPosition + 1])) and not InsideLineComment
+ and not InsideComment and not InsideBrace then
+ // end of comments
+ Break;
+ end;
+ Inc(Position);
+ until (BufferCount = 0) or (PropMatches = PropCount);
+ if InsideLineComment or InsideComment or InsideBrace then
+ raise EJclExpertException.CreateRes(@RsEUnterminatedComment);
+ for PropIndex := 0 to PropCount - 1 do
+ if Result[PropIndex] = -1 then
+ Result[PropIndex] := -Position;
+end;
+
+function GetProjectProperties(const AProject: IOTAProject; const PropIDs: TDynAnsiStringArray): TDynAnsiStringArray;
+const
+ BufferSize = 4096;
+var
+ FileIndex, PropCount, PropIndex, BufferIndex: Integer;
+ AEditor: IOTAEditor;
+ FileExtension: string;
+ PropLocations: TDynIntegerArray;
+ AReader: IOTAEditReader;
+begin
+ PropCount := Length(PropIDs);
+ SetLength(Result, PropCount);
+ SetLength(PropLocations, 0);
+ for FileIndex := 0 to AProject.GetModuleFileCount - 1 do
+ begin
+ AEditor := AProject.GetModuleFileEditor(FileIndex);
+ FileExtension := ExtractFileExt(AEditor.FileName);
+ if AnsiSameText(FileExtension, '.dpr') or AnsiSameText(FileExtension, '.dpk')
+ or AnsiSameText(FileExtension, '.bpf') or AnsiSameText(FileExtension, '.cpp') then
+ begin
+ AReader := (AEditor as IOTASourceEditor).CreateReader;
+ try
+ PropLocations := InternalLocateProperties(AReader, PropIDs);
+ for PropIndex := 0 to PropCount - 1 do
+ if PropLocations[PropIndex] > 0 then
+ begin
+ SetLength(Result[PropIndex], BufferSize);
+ SetLength(Result[PropIndex], AReader.GetText(PropLocations[PropIndex], PAnsiChar(Result[PropIndex]), BufferSize));
+ for BufferIndex := 1 to Length(Result[PropIndex]) do
+ if CharIsWhiteSpace(Char(Result[PropIndex][BufferIndex])) then
+ begin
+ SetLength(Result[PropIndex], BufferIndex - 1);
+ Break;
+ end;
+ end;
+ finally
+ AReader := nil;
+ end;
+ Break;
+ end;
+ end;
+end;
+
+function SetProjectProperties(const AProject: IOTAProject; const PropIDs, PropValues: TDynAnsiStringArray): Integer;
+const
+ BufferSize = 4096;
+var
+ FileIndex, PropCount, PropIndex, BufferIndex, PropSize: Integer;
+ AEditor: IOTAEditor;
+ ASourceEditor: IOTASourceEditor;
+ FileExtension: string;
+ Buffer: AnsiString;
+ PropLocations: TDynIntegerArray;
+ AReader: IOTAEditReader;
+ AWriter: IOTAEditWriter;
+ S: AnsiString;
+ ABuffer: IOTAEditBuffer;
+begin
+ PropCount := Length(PropIDs);
+ Result := 0;
+ for FileIndex := 0 to AProject.GetModuleFileCount - 1 do
+ begin
+ AEditor := AProject.GetModuleFileEditor(FileIndex);
+ FileExtension := ExtractFileExt(AEditor.FileName);
+ if AnsiSameText(FileExtension, '.dpr') or AnsiSameText(FileExtension, '.dpk')
+ or AnsiSameText(FileExtension, '.bpf') or AnsiSameText(FileExtension, '.cpp') then
+ begin
+ ASourceEditor := AEditor as IOTASourceEditor;
+ ABuffer := ASourceEditor as IOTAEditBuffer;
+ if not ABuffer.IsReadOnly then
+ begin
+ for PropIndex := 0 to PropCount - 1 do
+ begin
+ SetLength(PropLocations, 0);
+ PropSize := 0;
+ AReader := ASourceEditor.CreateReader;
+ try
+ PropLocations := InternalLocateProperties(AReader, Copy(PropIDs, PropIndex, 1));
+ if PropLocations[0] > 0 then
+ begin
+ SetLength(Buffer, BufferSize);
+ SetLength(Buffer, AReader.GetText(PropLocations[0], PAnsiChar(Buffer), BufferSize));
+ for BufferIndex := 1 to Length(Buffer) do
+ if CharIsWhiteSpace(Char(Buffer[BufferIndex])) then
+ begin
+ PropSize := BufferIndex - 1;
+ Break;
+ end;
+ end;
+ finally
+ // release the reader before allocating the writer
+ AReader := nil;
+ end;
+
+ AWriter := ASourceEditor.CreateUndoableWriter;
+ try
+ if PropLocations[0] > 0 then
+ begin
+ AWriter.CopyTo(PropLocations[0]);
+ AWriter.DeleteTo(PropLocations[0] + PropSize);
+ AWriter.Insert(PAnsiChar(PropValues[PropIndex]));
+ end
+ else
+ begin
+ AWriter.CopyTo(-PropLocations[0]);
+ S := AnsiString(Format('// %s %s%s', [PropIDs[PropIndex], PropValues[PropIndex], NativeLineBreak]));
+ AWriter.Insert(PAnsiChar(S));
+ end;
+ finally
+ // release the writter before allocating the reader
+ AWriter := nil;
+ end;
+ Inc(Result);
+ end;
+ end;
+ Break;
+ end;
+ end;
+end;
+
+//=== { EJclExpertException } ================================================
+
+constructor EJclExpertException.CreateTrace(const Msg: string);
+begin
+ inherited Create(Msg);
+ {$IFDEF MSWINDOWS}
+ FStackInfo := JclCreateStackList(False, 0, nil, False);
+ {$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(RsENoOTAServices);
+
+ FBaseKeyName := StrEnsureSuffix(NativeBackSlash, OTAServices.GetBaseRegistryKey);
+
+ FKeyName := BaseKeyName + RegJclIDEKey + 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;
+
+procedure TJclOTAExpertBase.AfterConstruction;
+begin
+ inherited AfterConstruction;
+
+ RegisterCommands;
+ AddExpert(Self);
+end;
+
+procedure TJclOTAExpertBase.BeforeDestruction;
+begin
+ RemoveExpert(Self);
+ UnregisterCommands;
+
+ inherited BeforeDestruction;
+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;
+ if not Assigned(UnitVersioningSheet) then
+ begin
+ UnitVersioningSheet := TJclOtaUnitVersioningFrame.Create(Application);
+ AddPageFunc(UnitVersioningSheet, RsUnitVersioningSheet, 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
+ if Assigned(AControl) and (AControl = UnitVersioningSheet) then
+ FreeAndNil(UnitVersioningSheet)
+ else
+ AControl.Free;
+ // override to customize
+end;
+
+constructor TJclOTAExpertBase.Create(AName: string);
+begin
+ inherited Create;
+
+ {$IFDEF BDS}
+ RegisterSplashScreen;
+ RegisterAboutBox;
+ {$ENDIF BDS}
+
+ FEnvVariables := TStringList.Create;
+ FSettings := TJclOTASettings.Create(AName);
+end;
+
+destructor TJclOTAExpertBase.Destroy;
+begin
+ FreeAndNil(FSettings);
+ FreeAndNil(FEnvVariables);
+
+ inherited Destroy;
+end;
+
+function TJclOTAExpertBase.FindExecutableName(const MapFileName: TFileName;
+ const OutputDirectory: string; var ExecutableFileName: TFileName): 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}
+ // possible loss of data
+ if MapAndLoad(PAnsiChar(AnsiString(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;
+
+class function TJclOTAExpertBase.GetActiveProject: IOTAProject;
+var
+ ProjectGroup: IOTAProjectGroup;
+ OTAModuleServices: IOTAModuleServices;
+ Index: Integer;
+begin
+ Result := nil;
+ ProjectGroup := GetProjectGroup;
+ OTAModuleServices := GetOTAModuleServices;
+
+ if Assigned(ProjectGroup) then
+ Result := ProjectGroup.ActiveProject
+ else
+ for Index := 0 to OTAModuleServices.ModuleCount - 1 do
+ if Supports(OTAModuleServices.Modules[Index], IOTAProject, Result) then
+ Exit;
+end;
+
+function TJclOTAExpertBase.GetDesigner: string;
+begin
+ {$IFDEF COMPILER6_UP}
+ Result := GetOTAServices.GetActiveDesignerType;
+ {$ELSE COMPILER6_UP}
+ Result := JclDesignerAny;
+ {$ENDIF COMPILER6_UP}
+end;
+
+function TJclOTAExpertBase.GetDrcFileName(const Project: IOTAProject): TFileName;
+begin
+ if not Assigned(Project) then
+ raise EJclExpertException.CreateTrace(RsENoActiveProject);
+
+ Result := ChangeFileExt(Project.FileName, CompilerExtensionDRC);
+end;
+
+function TJclOTAExpertBase.GetMapFileName(const Project: IOTAProject): TFileName;
+var
+ ProjectFileName: TFileName;
+ 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]));
+ if LibPrefix = 'false' then
+ LibPrefix := '';
+ if LibSuffix = 'false' then
+ LibSuffix := '';
+ {$ELSE ~RTL140_UP}
+ LibPrefix := '';
+ LibSuffix := '';
+ {$ENDIF ~RTL140_UP}
+ Result := PathAddSeparator(OutputDirectory) + LibPrefix +
+ PathExtractFileNameNoExt(ProjectFileName) + LibSuffix + CompilerExtensionMAP;
+end;
+
+function TJclOTAExpertBase.GetModuleHInstance: Cardinal;
+begin
+ Result := FindClassHInstance(ClassType);
+ if Result = 0 then
+ raise EJclExpertException.CreateTrace(RsBadModuleHInstance);
+end;
+
+class function TJclOTAExpertBase.GetNTAServices: INTAServices;
+begin
+ Supports(BorlandIDEServices, INTAServices, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateTrace(RsENoNTAServices);
+end;
+
+{$IFDEF BDS}
+class function TJclOTAExpertBase.GetOTAGalleryCategoryManager: IOTAGalleryCategoryManager;
+begin
+ Supports(BorlandIDEServices, IOTAGalleryCategoryManager, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateTrace(RsENoOTAGalleryCategoryManager);
+end;
+{$ENDIF BDS}
+
+class function TJclOTAExpertBase.GetOTADebuggerServices: IOTADebuggerServices;
+begin
+ Supports(BorlandIDEServices, IOTADebuggerServices, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateTrace(RsENoDebuggerServices);
+end;
+
+class function TJclOTAExpertBase.GetOTAMessageServices: IOTAMessageServices;
+begin
+ Supports(BorlandIDEServices, IOTAMessageServices, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateTrace(RsENoOTAMessageServices);
+end;
+
+class function TJclOTAExpertBase.GetOTAModuleServices: IOTAModuleServices;
+begin
+ Supports(BorlandIDEServices, IOTAModuleServices, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateTrace(RsENoOTAModuleServices);
+end;
+
+class function TJclOTAExpertBase.GetOTAPackageServices: IOTAPackageServices;
+begin
+ Supports(BorlandIDEServices, IOTAPackageServices, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateTrace(RsENoOTAPackageServices);
+end;
+
+{$IFDEF BDS}
+class function TJclOTAExpertBase.GetOTAPersonalityServices: IOTAPersonalityServices;
+begin
+ Supports(BorlandIDEServices, IOTAPersonalityServices, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateTrace(RsENoOTAPersonalityServices);
+end;
+{$ENDIF BDS}
+
+{$IFDEF BDS4_UP}
+class function TJclOTAExpertBase.GetOTAProjectManager: IOTAProjectManager;
+begin
+ Supports(BorlandIDEServices, IOTAProjectManager, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateRes(@RsENoOTAProjectManager);
+end;
+{$ENDIF BDS4_UP}
+
+class function TJclOTAExpertBase.GetOTAServices: IOTAServices;
+begin
+ Supports(BorlandIDEServices, IOTAServices, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateTrace(RsENoOTAServices);
+end;
+
+class function TJclOTAExpertBase.GetOTAWizardServices: IOTAWizardServices;
+begin
+ Supports(BorlandIDEServices, IOTAWizardServices, Result);
+ if not Assigned(Result) then
+ raise EJclExpertException.CreateTrace(RsENoOTAWizardServices);
+end;
+
+function TJclOTAExpertBase.GetOutputDirectory(const Project: IOTAProject): string;
+var
+ EnvironmentOptions: IOTAEnvironmentOptions;
+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 = 'false' then
+ Result := '';
+
+ if Result = '' then
+ begin
+ EnvironmentOptions := GetOTAServices.GetEnvironmentOptions;
+ if not Assigned(EnvironmentOptions) then
+ raise EJclExpertException.CreateTrace(RsENoEnvironmentOptions);
+ Result := EnvironmentOptions.Values[BPLOutputDirOptionName];
+ end;
+ end
+ else
+ Result := VarToStr(Project.ProjectOptions.Values[OutputDirOptionName]);
+
+ if Result = 'false' then
+ Result := '';
+
+ Result := SubstitutePath(Trim(Result));
+ if Result = '' then
+ Result := ExtractFilePath(Project.FileName)
+ else if not PathIsAbsolute(Result) then
+ Result := PathGetRelativePath(ExtractFilePath(Project.FileName), Result);
+end;
+
+function TJclOTAExpertBase.GetActivePersonality: TJclBorPersonality;
+{$IFDEF BDS}
+var
+ PersonalityText: string;
+ OTAPersonalityServices: IOTAPersonalityServices;
+ {$IFDEF COMPILER9_UP}
+ ActiveProject: IOTAProject;
+ {$ENDIF COMPILER9_UP}
+begin
+ {$IFDEF COMPILER9_UP}
+ ActiveProject := ActiveProject;
+ if Assigned(ActiveProject) then
+ PersonalityText := ActiveProject.Personality
+ else
+ {$ENDIF COMPILER9_UP}
+ OTAPersonalityServices := GetOTAPersonalityServices;
+ PersonalityText := OTAPersonalityServices.CurrentPersonality;
+ Result := PersonalityTextToId(PersonalityText);
+end;
+{$ELSE BDS}
+begin
+ {$IFDEF DELPHI}
+ Result := bpDelphi32;
+ {$ENDIF DELPHI}
+ {$IFDEF BCB}
+ Result := bpBCBuilder32;
+ {$ENDIF BCB}
+end;
+{$ENDIF BDS}
+
+class function TJclOTAExpertBase.GetProjectGroup: IOTAProjectGroup;
+var
+ OTAModuleServices: IOTAModuleServices;
+ AModule: IOTAModule;
+ I: Integer;
+begin
+ OTAModuleServices := GetOTAModuleServices;
+ for I := 0 to OTAModuleServices.ModuleCount - 1 do
+ begin
+ AModule := OTAModuleServices.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: TFileName;
+ OTAPackageServices: 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), '');
+ OTAPackageServices := GetOTAPackageServices;
+
+ for I := 0 to OTAPackageServices.PackageCount - 1 do
+ begin
+ PackageFileName := ChangeFileExt(OTAPackageServices.PackageNames[I], BinaryExtensionPackage);
+ 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: TFileName;
+ FileExtension: string;
+ Index: Integer;
+ ProjectFile: TJclSimpleXML;
+ PersonalityNode, SourceNode, ProjectExtensions, ProjectTypeNode: TJclSimpleXMLElem;
+ NameProp: TJclSimpleXMLProp;
+begin
+ if not Assigned(Project) then
+ raise EJclExpertException.CreateTrace(RsENoActiveProject);
+
+ FileName := Project.FileName;
+ FileExtension := ExtractFileExt(FileName);
+
+ if AnsiSameText(FileExtension, SourceExtensionDProject) and FileExists(FileName) then
+ begin
+ Result := False;
+ ProjectFile := TJclSimpleXML.Create;
+ try
+ ProjectFile.Options := ProjectFile.Options - [sxoAutoCreate];
+ ProjectFile.LoadFromFile(FileName);
+ ProjectExtensions := ProjectFile.Root.Items.ItemNamed['ProjectExtensions'];
+ if Assigned(ProjectExtensions) then
+ begin
+ ProjectTypeNode := ProjectExtensions.Items.ItemNamed['Borland.ProjectType'];
+ if Assigned(ProjectTypeNode) then
+ Result := AnsiSameText(ProjectTypeNode.Value, 'Package');
+ end;
+ finally
+ ProjectFile.Free;
+ end;
+ end
+ else
+ if AnsiSameText(FileExtension, SourceExtensionBDSProject) and FileExists(FileName) then
+ begin
+ Result := False;
+ ProjectFile := TJclSimpleXML.Create;
+ try
+ ProjectFile.Options := ProjectFile.Options - [sxoAutoCreate];
+ ProjectFile.LoadFromFile(FileName);
+ PersonalityNode := ProjectFile.Root.Items.ItemNamed['Delphi.Personality'];
+ if not Assigned(PersonalityNode) then
+ PersonalityNode := ProjectFile.Root.Items.ItemNamed['CPlusPlusBuilder.Personality'];
+
+ if Assigned(PersonalityNode) then
+ begin
+ SourceNode := PersonalityNode.Items.ItemNamed['Source'];
+ if Assigned(SourceNode) then
+ begin
+ for Index := 0 to SourceNode.Items.Count - 1 do
+ if AnsiSameText(SourceNode.Items.Item[0].Name, 'Source') then
+ begin
+ NameProp := SourceNode.Items.Item[0].Properties.ItemNamed['Name'];
+ if Assigned(NameProp) and AnsiSameText(NameProp.Value, 'MainSource') then
+ begin
+ Result := AnsiSameText(ExtractFileExt(SourceNode.Items.Item[0].Value), SourceExtensionDelphiPackage);
+ Break;
+ end;
+ end;
+ end;
+ end;
+ finally
+ ProjectFile.Free;
+ end;
+ end
+ else
+ Result := AnsiSameText(FileExtension, SourceExtensionDelphiPackage);
+end;
+
+class function TJclOTAExpertBase.IsPersonalityLoaded(
+ const PersonalityName: string): Boolean;
+{$IFDEF BDS}
+var
+ OTAPersonalityServices: IOTAPersonalityServices;
+ Index: Integer;
+begin
+ OTAPersonalityServices := GetOTAPersonalityServices;
+ Result := False;
+
+ for Index := 0 to OTAPersonalityServices.PersonalityCount - 1 do
+ if SameText(OTAPersonalityServices.Personalities[Index], PersonalityName) then
+ begin
+ Result := True;
+ Break;
+ end;
+end;
+{$ELSE BDS}
+begin
+ Result := True;
+end;
+{$ENDIF BDS}
+
+procedure TJclOTAExpertBase.ReadEnvVariables;
+{$IFDEF COMPILER6_UP}
+var
+ I: Integer;
+ EnvNames: TStringList;
+ {$IFDEF MSWINDOWS}
+ EnvVarKeyName: string;
+ {$ENDIF MSWINDOWS}
+ {$IFDEF KYLIX}
+ RADToolsInstallations: TJclBorRADToolInstallations;
+ RADToolInstallation: TJclBorRADToolInstallation;
+ {$ENDIF KYLIX}
+{$ENDIF COMPILER6_UP}
+begin
+ FEnvVariables.Clear;
+
+ // read user and system environment variables
+ GetEnvironmentVars(FEnvVariables, False);
+
+ // read Delphi environment variables
+ {$IFDEF COMPILER6_UP}
+ EnvNames := TStringList.Create;
+ try
+ {$IFDEF MSWINDOWS}
+ EnvVarKeyName := Settings.BaseKeyName + EnvironmentVarsKey;
+ if RegKeyExists(HKEY_CURRENT_USER, EnvVarKeyName) and
+ RegGetValueNames(HKEY_CURRENT_USER, EnvVarKeyName, EnvNames) then
+ for I := 0 to EnvNames.Count - 1 do
+ FEnvVariables.Values[EnvNames[I]] :=
+ RegReadStringDef(HKEY_CURRENT_USER, EnvVarKeyName, EnvNames[I], '');
+ {$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
+ begin
+ for I := 0 to RADToolInstallation.EnvironmentVariables.Count - 1 do
+ EnvNames.Add(RADToolInstallation.EnvironmentVariables.Names[I]);
+ for I := 0 to EnvNames.Count - 1 do
+ FEnvVariables.Values[EnvNames[I]] :=
+ RADToolInstallation.EnvironmentVariables.Values[EnvNames[I]];
+ end;
+ finally
+ RADToolsInstallations.Free;
+ end;
+ {$ENDIF KYLIX}
+ finally
+ EnvNames.Free;
+ end;
+ {$ENDIF COMPILER6_UP}
+
+ // add the Delphi directory
+ FEnvVariables.Values[DelphiEnvironmentVar] := RootDir;
+end;
+
+function TJclOTAExpertBase.SubstitutePath(const Path: string): string;
+var
+ I: Integer;
+ Name: string;
+begin
+ if FEnvVariables.Count = 0 then
+ ReadEnvVariables;
+ Result := Path;
+ while Pos('$(', Result) > 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;
+ While Pos('\\', Result) > 0 do
+ Result := StringReplace(Result, '\\', DirDelimiter, [rfReplaceAll]);
+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);
+var
+ NTAServices: INTAServices;
+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;
+
+ NTAServices := GetNTAServices;
+ // remove action from toolbar to avoid crash when recompile package inside the IDE.
+ CheckToolBarButton(NTAServices.ToolBar[sCustomToolBar], Action);
+ CheckToolBarButton(NTAServices.ToolBar[sStandardToolBar], Action);
+ CheckToolBarButton(NTAServices.ToolBar[sDebugToolBar], Action);
+ CheckToolBarButton(NTAServices.ToolBar[sViewToolBar], Action);
+ CheckToolBarButton(NTAServices.ToolBar[sDesktopToolBar], Action);
+ {$IFDEF COMPILER7_UP}
+ CheckToolBarButton(NTAServices.ToolBar[sInternetToolBar], Action);
+ CheckToolBarButton(NTAServices.ToolBar[sCORBAToolBar], Action);
+ {$ENDIF COMPILER7_UP}
+end;
+
+procedure TJclOTAExpertBase.RegisterCommands;
+var
+ JclIcon: TIcon;
+ Category: string;
+ Index: Integer;
+ IDEMenuItem, ToolsMenuItem: TMenuItem;
+ NTAServices: INTAServices;
+begin
+ NTAServices := GetNTAServices;
+
+ 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.Name := JclConfigureMenuName;
+ 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(RsENoOTAAboutServices);
+ ProductImage := LoadBitmap(FindResourceHInstance(HInstance), 'JCLSPLASH');
+ if ProductImage = 0 then
+ raise EJclExpertException.CreateTrace(RsENoBitmapResources);
+ AboutBoxIndex := AboutBoxServices.AddPluginInfo(RsAboutTitle, RsAboutDescription,
+ ProductImage, False, RsAboutLicenceStatus);
+ end;
+end;
+
+procedure UnregisterAboutBox;
+begin
+ if (AboutBoxIndex <> -1) and Assigned(AboutBoxServices) then
+ begin
+ AboutBoxServices.RemovePluginInfo(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
+
+try
+ {$IFDEF UNITVERSIONING}
+ RegisterUnitVersion(HInstance, UnitVersioning);
+ {$ENDIF UNITVERSIONING}
+ Classes.RegisterClass(TJclWizardForm);
+ Classes.RegisterClass(TJclWizardFrame);
+except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+end;
+
+finalization
+
+try
+ {$IFDEF UNITVERSIONING}
+ UnregisterUnitVersion(HInstance);
+ {$ENDIF UNITVERSIONING}
+ {$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;
+}
+
+end.
diff --git a/official/1.104/experts/common/JclOtaWizardForm.dfm b/official/1.104/experts/common/JclOtaWizardForm.dfm
new file mode 100644
index 0000000..7d32aef
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaWizardForm.dfm
@@ -0,0 +1,123 @@
+object JclWizardForm: TJclWizardForm
+ Left = 0
+ Top = 0
+ BorderStyle = bsDialog
+ ClientHeight = 423
+ ClientWidth = 625
+ 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 Bevel1: TBevel
+ Left = 8
+ Top = 376
+ Width = 607
+ Height = 17
+ Shape = bsTopLine
+ end
+ object LabelProgression: TLabel
+ Left = 8
+ Top = 56
+ Width = 101
+ Height = 13
+ Caption = 'RsWizardProgression'
+ end
+ object ButtonCancel: TButton
+ Left = 540
+ Top = 388
+ Width = 75
+ Height = 25
+ Cancel = True
+ Caption = 'RsCancel'
+ ModalResult = 2
+ TabOrder = 0
+ end
+ object ButtonFinish: TButton
+ Left = 459
+ Top = 388
+ Width = 75
+ Height = 25
+ Action = ActionFinish
+ Default = True
+ TabOrder = 1
+ end
+ object ButtonNext: TButton
+ Left = 378
+ Top = 388
+ Width = 75
+ Height = 25
+ Action = ActionNext
+ TabOrder = 2
+ end
+ object ButtonPrevious: TButton
+ Left = 297
+ Top = 388
+ Width = 75
+ Height = 25
+ Action = ActionPrevious
+ TabOrder = 3
+ end
+ object PanelTitle: TPanel
+ Left = 0
+ Top = 0
+ Width = 625
+ Height = 49
+ Align = alTop
+ BevelOuter = bvNone
+ Color = clBlack
+ TabOrder = 4
+ object ImageJcl: TImage
+ Left = 8
+ Top = 8
+ Width = 33
+ Height = 33
+ end
+ object LabelJcl: TLabel
+ Left = 56
+ Top = 10
+ Width = 156
+ Height = 23
+ Caption = 'RsAboutDialogTitle'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWhite
+ Font.Height = -19
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ParentFont = False
+ end
+ end
+ object PanelPages: TPanel
+ Left = 2
+ Top = 72
+ Width = 623
+ Height = 298
+ BevelOuter = bvNone
+ TabOrder = 5
+ end
+ object ActionListButtons: TActionList
+ Left = 240
+ Top = 384
+ object ActionFinish: TAction
+ Caption = 'RsFinish'
+ OnExecute = ActionFinishExecute
+ OnUpdate = ActionFinishUpdate
+ end
+ object ActionPrevious: TAction
+ Caption = 'RsPrevious'
+ OnExecute = ActionPreviousExecute
+ OnUpdate = ActionPreviousUpdate
+ end
+ object ActionNext: TAction
+ Caption = 'RsNext'
+ OnExecute = ActionNextExecute
+ OnUpdate = ActionNextUpdate
+ end
+ end
+end
diff --git a/official/1.104/experts/common/JclOtaWizardForm.pas b/official/1.104/experts/common/JclOtaWizardForm.pas
new file mode 100644
index 0000000..198084e
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaWizardForm.pas
@@ -0,0 +1,256 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaWizardForm.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+unit JclOtaWizardForm;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls, ActnList,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclOtaWizardFrame;
+
+type
+ TJclWizardForm = class(TForm)
+ ButtonCancel: TButton;
+ ButtonFinish: TButton;
+ ButtonNext: TButton;
+ ButtonPrevious: TButton;
+ Bevel1: TBevel;
+ PanelTitle: TPanel;
+ ImageJcl: TImage;
+ LabelJcl: TLabel;
+ LabelProgression: TLabel;
+ ActionListButtons: TActionList;
+ ActionPrevious: TAction;
+ ActionNext: TAction;
+ ActionFinish: TAction;
+ PanelPages: TPanel;
+ procedure FormCreate(Sender: TObject);
+ procedure ActionPreviousExecute(Sender: TObject);
+ procedure ActionPreviousUpdate(Sender: TObject);
+ procedure ActionNextExecute(Sender: TObject);
+ procedure ActionNextUpdate(Sender: TObject);
+ procedure ActionFinishExecute(Sender: TObject);
+ procedure ActionFinishUpdate(Sender: TObject);
+ private
+ FDescription: string;
+ FPageIndex: Integer;
+ FExecuting: Boolean;
+ function GetPageCount: Integer;
+ function GetPageIndex: Integer;
+ procedure SetPageIndex(const Value: Integer);
+ function GetActivePage: TJclWizardFrame;
+ function GetPage(Index: Integer): TJclWizardFrame;
+ public
+ function AddPage(const WizardFrame: TJclWizardFrame): Integer;
+ function Execute: Boolean;
+
+ property PageCount: Integer read GetPageCount;
+ property PageIndex: Integer read GetPageIndex write SetPageIndex;
+ property Description: string read FDescription write FDescription;
+ property Pages[Index: Integer]: TJclWizardFrame read GetPage;
+ property ActivePage: TJclWizardFrame read GetActivePage;
+ property Executing: Boolean read FExecuting;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/common/JclOtaWizardForm.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclOtaResources;
+
+//=== { TJclWizardForm } =====================================================
+
+procedure TJclWizardForm.ActionFinishExecute(Sender: TObject);
+begin
+ PageIndex := -1;
+ ModalResult := mrOk;
+end;
+
+procedure TJclWizardForm.ActionFinishUpdate(Sender: TObject);
+var
+ CurrentPage: TJclWizardFrame;
+begin
+ CurrentPage := ActivePage;
+ (Sender as TAction).Enabled := Assigned(CurrentPage) and CurrentPage.SupportsFinish;
+end;
+
+procedure TJclWizardForm.ActionNextExecute(Sender: TObject);
+begin
+ PageIndex := PageIndex + 1;
+end;
+
+procedure TJclWizardForm.ActionNextUpdate(Sender: TObject);
+var
+ CurrentPage: TJclWizardFrame;
+begin
+ CurrentPage := ActivePage;
+ (Sender as TAction).Enabled := (PageIndex < (PageCount - 1))
+ and Assigned(CurrentPage) and CurrentPage.SupportsNext;
+end;
+
+procedure TJclWizardForm.ActionPreviousExecute(Sender: TObject);
+begin
+ PageIndex := PageIndex - 1;
+end;
+
+procedure TJclWizardForm.ActionPreviousUpdate(Sender: TObject);
+var
+ CurrentPage: TJclWizardFrame;
+begin
+ CurrentPage := ActivePage;
+ (Sender as TAction).Enabled := (PageIndex > 0)
+ and Assigned(CurrentPage) and CurrentPage.SupportsPrevious;
+end;
+
+function TJclWizardForm.AddPage(const WizardFrame: TJclWizardFrame): Integer;
+begin
+ WizardFrame.Visible := False;
+ WizardFrame.Parent := PanelPages;
+ WizardFrame.Align := alClient;
+ for Result := 0 to PanelPages.ControlCount - 1 do
+ if PanelPages.Controls[Result] = WizardFrame then
+ Exit;
+ Result := -1;
+end;
+
+function TJclWizardForm.Execute: Boolean;
+begin
+ FExecuting := True;
+ try
+ if PageCount > 0 then
+ begin
+ FPageIndex := -1;
+ PageIndex := 0;
+ Result := ShowModal = mrOk;
+ end
+ else
+ Result := False;
+ finally
+ FExecuting := False;
+ end;
+end;
+
+procedure TJclWizardForm.FormCreate(Sender: TObject);
+begin
+ ActionPrevious.Caption := RsPrevious;
+ ActionNext.Caption := RsNext;
+ ActionFinish.Caption := RsFinish;
+ ButtonCancel.Caption := RsCancel;
+ LabelJcl.Caption := RsAboutDialogTitle;
+ try
+ ImageJcl.Picture.Bitmap.TransparentMode := tmAuto;
+ ImageJcl.Picture.Bitmap.Transparent := True;
+ ImageJcl.Picture.Bitmap.LoadFromResourceName(FindResourceHInstance(HInstance), 'JCLSPLASH');
+ except
+
+ end;
+end;
+
+function TJclWizardForm.GetActivePage: TJclWizardFrame;
+begin
+ if Executing then
+ Result := Pages[PageIndex]
+ else
+ Result := nil;
+end;
+
+function TJclWizardForm.GetPage(Index: Integer): TJclWizardFrame;
+begin
+ if (Index >= 0) and (Index < PanelPages.ControlCount) then
+ Result := PanelPages.Controls[Index] as TJclWizardFrame
+ else
+ Result := nil;
+end;
+
+function TJclWizardForm.GetPageCount: Integer;
+begin
+ Result := PanelPages.ControlCount;
+end;
+
+function TJclWizardForm.GetPageIndex: Integer;
+begin
+ if Executing then
+ Result := FPageIndex
+ else
+ Result := -1;
+end;
+
+procedure TJclWizardForm.SetPageIndex(const Value: Integer);
+var
+ Direction: TJclWizardDirection;
+ AFrame: TJclWizardFrame;
+begin
+ if Value > FPageIndex then
+ Direction := wdForward
+ else
+ Direction := wdBackward;
+
+ AFrame := Pages[FPageIndex];
+ if Assigned(AFrame) then
+ begin
+ AFrame.PageDesactivated(Direction);
+ AFrame.Visible := False;
+ end;
+
+ FPageIndex := Value;
+
+ AFrame := Pages[FPageIndex];
+ if Assigned(AFrame) then
+ begin
+ AFrame.PageActivated(Direction);
+ AFrame.Visible := True;
+ LabelProgression.Caption := Format(RsWizardProgression, [PageIndex+1 {one based}, PageCount, AFrame.Caption]);
+ end;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/common/JclOtaWizardFrame.dfm b/official/1.104/experts/common/JclOtaWizardFrame.dfm
new file mode 100644
index 0000000..5bd5638
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaWizardFrame.dfm
@@ -0,0 +1,8 @@
+object JclWizardFrame: TJclWizardFrame
+ Left = 0
+ Top = 0
+ Width = 623
+ Height = 298
+ TabOrder = 0
+ TabStop = True
+end
diff --git a/official/1.104/experts/common/JclOtaWizardFrame.pas b/official/1.104/experts/common/JclOtaWizardFrame.pas
new file mode 100644
index 0000000..5f22c1a
--- /dev/null
+++ b/official/1.104/experts/common/JclOtaWizardFrame.pas
@@ -0,0 +1,112 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaWizardFrame.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaWizardFrame;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ Dialogs;
+
+type
+ TJclWizardDirection = (wdForward, wdBackward);
+ TJclWizardFrame = class(TFrame)
+ protected
+ function GetSupportsFinish: Boolean; virtual;
+ function GetSupportsNext: Boolean; virtual;
+ function GetSupportsPrevious: Boolean; virtual;
+ public
+ procedure PageActivated(Direction: TJclWizardDirection); virtual;
+ procedure PageDesactivated(Direction: TJclWizardDirection); virtual;
+ property SupportsNext: Boolean read GetSupportsNext;
+ property SupportsPrevious: Boolean read GetSupportsPrevious;
+ property SupportsFinish: Boolean read GetSupportsFinish;
+ property Caption;
+ end;
+
+ TJclWizardFrameClass = class of TJclWizardFrame;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/common/JclOtaWizardFrame.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\common'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+//=== { TJclWizardFrame } ====================================================
+
+function TJclWizardFrame.GetSupportsFinish: Boolean;
+begin
+ // override to customize
+ Result := SupportsNext;
+end;
+
+function TJclWizardFrame.GetSupportsNext: Boolean;
+begin
+ // override to customize
+ Result := True;
+end;
+
+function TJclWizardFrame.GetSupportsPrevious: Boolean;
+begin
+ // override to customize
+ Result := True;
+end;
+
+procedure TJclWizardFrame.PageActivated(Direction: TJclWizardDirection);
+begin
+ // override to customize
+end;
+
+procedure TJclWizardFrame.PageDesactivated(Direction: TJclWizardDirection);
+begin
+ // override to customize
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/common/JclSplash.bmp b/official/1.104/experts/common/JclSplash.bmp
new file mode 100644
index 0000000..eb15014
Binary files /dev/null and b/official/1.104/experts/common/JclSplash.bmp differ
diff --git a/official/1.104/experts/debug/Howto.txt b/official/1.104/experts/debug/Howto.txt
new file mode 100644
index 0000000..8088c05
--- /dev/null
+++ b/official/1.104/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.104/experts/debug/JclDebugThread.pas b/official/1.104/experts/debug/JclDebugThread.pas
new file mode 100644
index 0000000..83d3211
--- /dev/null
+++ b/official/1.104/experts/debug/JclDebugThread.pas
@@ -0,0 +1,208 @@
+{**************************************************************************************************}
+{ }
+{ 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: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclDebugThread;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/JclDebugThread.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\debug'
+ );
+{$ENDIF UNITVERSIONING}
+
+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
+ {$IFDEF UNITVERSIONING}
+ RegisterUnitVersion(HInstance, UnitVersioning);
+ {$ENDIF UNITVERSIONING}
+ Init;
+
+finalization
+ FreeAndNil(HookImports);
+ FreeAndNil(SharedThreadNames);
+ FreeAndNil(Notifier);
+ {$IFDEF UNITVERSIONING}
+ UnregisterUnitVersion(HInstance);
+ {$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/converter/JclDebugIdeConfigFrame.dfm b/official/1.104/experts/debug/converter/JclDebugIdeConfigFrame.dfm
new file mode 100644
index 0000000..0359d89
--- /dev/null
+++ b/official/1.104/experts/debug/converter/JclDebugIdeConfigFrame.dfm
@@ -0,0 +1,48 @@
+object JclDebugIdeConfigFrame: TJclDebugIdeConfigFrame
+ Left = 0
+ Top = 0
+ Width = 369
+ Height = 375
+ AutoScroll = True
+ TabOrder = 0
+ TabStop = True
+ object RadioGroupGenerateJdbg: TRadioGroup
+ Left = 3
+ Top = 3
+ Width = 347
+ Height = 129
+ Caption = 'RsDebugGenerateJdbg'
+ Items.Strings = (
+ 'RsAlwaysDisabled'
+ 'RsDefaultDisabled'
+ 'RsDefaultEnabled'
+ 'RsAlwaysEnabled')
+ TabOrder = 0
+ end
+ object RadioGroupInsertJdbg: TRadioGroup
+ Left = 3
+ Top = 138
+ Width = 347
+ Height = 129
+ Caption = 'RsDebugInsertJdbg'
+ Items.Strings = (
+ 'RsAlwaysDisabled'
+ 'RsDefaultDisabled'
+ 'RsDefaultEnabled'
+ 'RsAlwaysEnabled')
+ TabOrder = 1
+ end
+ object RadioGroupDeleteMapFile: TRadioGroup
+ Left = 3
+ Top = 273
+ Width = 347
+ Height = 129
+ Caption = 'RsDeleteMapFile'
+ Items.Strings = (
+ 'RsDataAlwaysDisabled'
+ 'RsDataDefaultDisabled'
+ 'RsDataDefaultEnabled'
+ 'RsDataAlwaysEnabled')
+ TabOrder = 2
+ end
+end
diff --git a/official/1.104/experts/debug/converter/JclDebugIdeConfigFrame.pas b/official/1.104/experts/debug/converter/JclDebugIdeConfigFrame.pas
new file mode 100644
index 0000000..ee3885a
--- /dev/null
+++ b/official/1.104/experts/debug/converter/JclDebugIdeConfigFrame.pas
@@ -0,0 +1,244 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclDebugIdeConfigFrame.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet. }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclDebugIdeConfigFrame;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ Dialogs, StdCtrls, ExtCtrls;
+
+type
+ TDebugExpertState = (deAlwaysDisabled, deProjectDisabled, deProjectEnabled, deAlwaysEnabled);
+
+ TJclDebugIdeConfigFrame = class(TFrame)
+ RadioGroupGenerateJdbg: TRadioGroup;
+ RadioGroupInsertJdbg: TRadioGroup;
+ RadioGroupDeleteMapFile: TRadioGroup;
+ private
+ function GetGenerateJdbgState: TDebugExpertState;
+ function GetInsertJdbgState: TDebugExpertState;
+ function GetDeleteMapFileState: TDebugExpertState;
+ procedure SetGenerateJdbgState(Value: TDebugExpertState);
+ procedure SetInsertJdbgState(Value: TDebugExpertState);
+ procedure SetDeleteMapFileState(Value: TDebugExpertState);
+ public
+ constructor Create(AOwner: TComponent); override;
+
+ property GenerateJdbgState: TDebugExpertState read GetGenerateJdbgState write SetGenerateJdbgState;
+ property InsertJdbgState: TDebugExpertState read GetInsertJdbgState write SetInsertJdbgState;
+ property DeleteMapFileState: TDebugExpertState read GetDeleteMapFileState write SetDeleteMapFileState;
+ end;
+
+function DebugExpertStateToInt(Value: TDebugExpertState): Integer;
+function IntToDebugExpertState(Value: Integer): TDebugExpertState;
+function ToggleDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+function EnableDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+function DisableDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+function ApplyDebugExpertState(GlobalState: TDebugExpertState; LocalEnabled: Boolean): TDebugExpertState;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/converter/JclDebugIdeConfigFrame.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\converter'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclOtaResources;
+
+function DebugExpertStateToInt(Value: TDebugExpertState): Integer;
+begin
+ case Value of
+ deAlwaysDisabled:
+ Result := 0;
+ deProjectDisabled:
+ Result := 1;
+ deProjectEnabled:
+ Result := 2;
+ deAlwaysEnabled:
+ Result := 3;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(Value)]);
+ end;
+end;
+
+function IntToDebugExpertState(Value: Integer): TDebugExpertState;
+begin
+ case Value of
+ 0:
+ Result := deAlwaysDisabled;
+ 1:
+ Result := deProjectDisabled;
+ 2:
+ Result := deProjectEnabled;
+ 3:
+ Result := deAlwaysEnabled;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Value]);
+ end;
+end;
+
+function ToggleDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+begin
+ case Value of
+ deAlwaysDisabled:
+ Result := deAlwaysEnabled;
+ deProjectDisabled:
+ Result := deProjectEnabled;
+ deProjectEnabled:
+ Result := deProjectDisabled;
+ deAlwaysEnabled:
+ Result := deAlwaysDisabled;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(Value)]);
+ end;
+end;
+
+function EnableDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+begin
+ case Value of
+ deAlwaysDisabled:
+ Result := deAlwaysEnabled;
+ deProjectDisabled:
+ Result := deProjectEnabled;
+ deProjectEnabled,
+ deAlwaysEnabled:
+ Result := Value;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(Value)]);
+ end;
+end;
+
+function DisableDebugExpertState(Value: TDebugExpertState): TDebugExpertState;
+begin
+ case Value of
+ deAlwaysDisabled,
+ deProjectDisabled:
+ Result := Value;
+ deProjectEnabled:
+ Result := deProjectDisabled;
+ deAlwaysEnabled:
+ Result := deAlwaysDisabled;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(Value)]);
+ end;
+end;
+
+function ApplyDebugExpertState(GlobalState: TDebugExpertState; LocalEnabled: Boolean): TDebugExpertState;
+begin
+ case GlobalState of
+ deAlwaysDisabled:
+ Result := deAlwaysDisabled;
+ deProjectDisabled,
+ deProjectEnabled:
+ if LocalEnabled then
+ Result := deProjectEnabled
+ else
+ Result := deProjectDisabled;
+ deAlwaysEnabled:
+ Result := deAlwaysEnabled;
+ else
+ raise EConvertError.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(GlobalState)]);
+ end;
+end;
+
+//=== { TJclDebugIdeConfigFrame } ============================================
+
+constructor TJclDebugIdeConfigFrame.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ RadioGroupGenerateJdbg.Caption := RsDebugGenerateJdbg;
+ RadioGroupGenerateJdbg.Items.Strings[0] := RsAlwaysDisabled;
+ RadioGroupGenerateJdbg.Items.Strings[1] := RsDefaultDisabled;
+ RadioGroupGenerateJdbg.Items.Strings[2] := RsDefaultEnabled;
+ RadioGroupGenerateJdbg.Items.Strings[3] := RsAlwaysEnabled;
+
+ RadioGroupInsertJdbg.Caption := RsDebugInsertJdbg;
+ RadioGroupInsertJdbg.Items.Strings[0] := RsAlwaysDisabled;
+ RadioGroupInsertJdbg.Items.Strings[1] := RsDefaultDisabled;
+ RadioGroupInsertJdbg.Items.Strings[2] := RsDefaultEnabled;
+ RadioGroupInsertJdbg.Items.Strings[3] := RsAlwaysEnabled;
+
+ RadioGroupDeleteMapFile.Caption := RsDeleteMapFile;
+ RadioGroupDeleteMapFile.Items.Strings[0] := RsAlwaysDisabled;
+ RadioGroupDeleteMapFile.Items.Strings[1] := RsDefaultDisabled;
+ RadioGroupDeleteMapFile.Items.Strings[2] := RsDefaultEnabled;
+ RadioGroupDeleteMapFile.Items.Strings[3] := RsAlwaysEnabled;
+end;
+
+function TJclDebugIdeConfigFrame.GetGenerateJdbgState: TDebugExpertState;
+begin
+ Result := IntToDebugExpertState(RadioGroupGenerateJdbg.ItemIndex);
+end;
+
+function TJclDebugIdeConfigFrame.GetInsertJdbgState: TDebugExpertState;
+begin
+ Result := IntToDebugExpertState(RadioGroupInsertJdbg.ItemIndex);
+end;
+
+function TJclDebugIdeConfigFrame.GetDeleteMapFileState: TDebugExpertState;
+begin
+ Result := IntToDebugExpertState(RadioGroupDeleteMapFile.ItemIndex);
+end;
+
+procedure TJclDebugIdeConfigFrame.SetGenerateJdbgState(Value: TDebugExpertState);
+begin
+ RadioGroupGenerateJdbg.ItemIndex := DebugExpertStateToInt(Value);
+end;
+
+procedure TJclDebugIdeConfigFrame.SetInsertJdbgState(Value: TDebugExpertState);
+begin
+ RadioGroupInsertJdbg.ItemIndex := DebugExpertStateToInt(Value);
+end;
+
+procedure TJclDebugIdeConfigFrame.SetDeleteMapFileState(Value: TDebugExpertState);
+begin
+ RadioGroupDeleteMapFile.ItemIndex := DebugExpertStateToInt(Value);
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/converter/JclDebugIdeIcon.res b/official/1.104/experts/debug/converter/JclDebugIdeIcon.res
new file mode 100644
index 0000000..08a9c21
Binary files /dev/null and b/official/1.104/experts/debug/converter/JclDebugIdeIcon.res differ
diff --git a/official/1.104/experts/debug/converter/JclDebugIdeImpl.pas b/official/1.104/experts/debug/converter/JclDebugIdeImpl.pas
new file mode 100644
index 0000000..833c751
--- /dev/null
+++ b/official/1.104/experts/debug/converter/JclDebugIdeImpl.pas
@@ -0,0 +1,1720 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $ }
+{ Revision: $Rev:: 2498 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclDebugIdeImpl;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Classes, Menus, ActnList, SysUtils, Graphics, Dialogs, Controls, Forms, ToolsAPI,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclOtaUtils, JclOtaConsts,
+ JclDebugIdeConfigFrame;
+
+type
+ TJclDebugDataInfo = record
+ ProjectName: string;
+ ExecutableFileName: TFileName;
+ MapFileSize, JclDebugDataSize: Integer;
+ LinkerBugUnit: string;
+ LineNumberErrors: Integer;
+ Success: Boolean;
+ end;
+
+ TDebugExpertAction = (deGenerateJdbg, deInsertJdbg, deDeleteMapFile);
+ TDebugExpertActions = set of TDebugExpertAction;
+
+ TJclDebugExtension = class(TJclOTAExpert)
+ private
+ FResultInfo: array of TJclDebugDataInfo;
+ FStoreResults: Boolean;
+ FBuildError: Boolean;
+ FDebugExpertAction: TDropDownAction;
+ FDebugExpertItem: TMenuItem;
+ FGenerateJdbgAction: TDropDownAction;
+ FGenerateJdbgItem: TMenuItem;
+ FInsertJdbgAction: TDropDownAction;
+ FInsertJdbgItem: TMenuItem;
+ FDeleteMapFileAction: TDropDownAction;
+ FDeleteMapFileItem: TMenuItem;
+ FDebugImageIndex: Integer;
+ FNoDebugImageIndex: Integer;
+ FGenerateJdbgImageIndex: Integer;
+ FNoGenerateJdbgImageIndex: Integer;
+ FInsertJdbgImageIndex: Integer;
+ FNoInsertJdbgImageIndex: Integer;
+ FDeleteMapFileImageIndex: Integer;
+ FNoDeleteMapFileImageIndex: Integer;
+ FCurrentProject: IOTAProject;
+ FSaveBuildProjectAction: TCustomAction;
+ FSaveBuildProjectActionExecute: TNotifyEvent;
+ FSaveBuildAllProjectsAction: TCustomAction;
+ FSaveBuildAllProjectsActionExecute: TNotifyEvent;
+ FIDENotifierIndex: Integer;
+ {$IFDEF BDS4_UP}
+ FProjectManagerNotifierIndex: Integer;
+ {$ENDIF BDS4_UP}
+ FConfigFrame: TJclDebugIdeConfigFrame;
+ FGlobalStates: array [TDebugExpertAction] of TDebugExpertState;
+ procedure DebugExpertActionExecute(Sender: TObject);
+ procedure DebugExpertActionUpdate(Sender: TObject);
+ procedure DebugExpertMenuClick(Sender: TObject);
+ procedure DebugExpertMenuDropDown(Sender: TObject);
+ procedure DebugExpertSubMenuClick(Sender: TObject);
+ procedure GenerateJdbgActionExecute(Sender: TObject);
+ procedure GenerateJdbgActionUpdate(Sender: TObject);
+ procedure GenerateJdbgMenuClick(Sender: TObject);
+ procedure GenerateJdbgMenuDropDown(Sender: TObject);
+ procedure GenerateJdbgSubMenuClick(Sender: TObject);
+ procedure InsertJdbgActionExecute(Sender: TObject);
+ procedure InsertJdbgActionUpdate(Sender: TObject);
+ procedure InsertJdbgMenuClick(Sender: TObject);
+ procedure InsertJdbgMenuDropDown(Sender: TObject);
+ procedure InsertJdbgSubMenuClick(Sender: TObject);
+ procedure DeleteMapFileActionExecute(Sender: TObject);
+ procedure DeleteMapFileActionUpdate(Sender: TObject);
+ procedure DeleteMapFileMenuClick(Sender: TObject);
+ procedure DeleteMapFileMenuDropDown(Sender: TObject);
+ procedure DeleteMapFileSubMenuClick(Sender: TObject);
+ procedure LoadExpertValues;
+ procedure SaveExpertValues;
+ procedure BuildAllProjects(Sender: TObject);
+ procedure BuildProject(Sender: TObject);
+ procedure BeginStoreResults;
+ procedure DisplayResults;
+ procedure EndStoreResults;
+ function GetGlobalState(Index: TDebugExpertAction): TDebugExpertState;
+ procedure SetGlobalState(Index: TDebugExpertAction; Value: TDebugExpertState);
+ function GetProjectState(Index: TDebugExpertAction; const AProject: IOTAProject): TDebugExpertState;
+ procedure SetProjectState(Index: TDebugExpertAction; const AProject: IOTAProject; Value: TDebugExpertState);
+ function GetProjectActions(const AProject: IOTAProject): TDebugExpertActions;
+ public
+ constructor Create; reintroduce;
+ procedure AfterCompile(Succeeded: Boolean);
+ procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
+ procedure RegisterCommands; override;
+ procedure UnregisterCommands; override;
+ procedure AddConfigurationPages(AddPageFunc: TJclOTAAddPageFunc); override;
+ procedure ConfigurationClosed(AControl: TControl; SaveChanges: Boolean); override;
+ procedure DisableExpert(const AProject: IOTAProject);
+ property GlobalStates[Index: TDebugExpertAction]: TDebugExpertState read GetGlobalState
+ write SetGlobalState;
+ property ProjectStates[Index: TDebugExpertAction; const AProject: IOTAProject]: TDebugExpertState
+ read GetProjectState write SetProjectState;
+ property ProjectActions[const AProject: IOTAProject]: TDebugExpertActions read GetProjectActions;
+ end;
+
+ TIdeNotifier = class(TNotifierObject, IOTANotifier, IOTAIDENotifier, IOTAIDENotifier50)
+ private
+ FDebugExtension: TJclDebugExtension;
+ protected
+ { IOTAIDENotifier }
+ procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
+ procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
+ procedure AfterCompile(Succeeded: Boolean); overload;
+ { IOTAIDENotifier50 }
+ procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload;
+ procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload;
+ public
+ constructor Create(ADebugExtension: TJclDebugExtension);
+ end;
+
+ {$IFDEF BDS4_UP}
+ TProjectManagerNotifier = class(TNotifierObject, IOTANotifier, INTAProjectMenuCreatorNotifier)
+ private
+ FDebugExtension: TJclDebugExtension;
+ FOTAProjectManager: IOTAProjectManager;
+ FNTAServices: INTAServices;
+ procedure GenerateJdbgSubMenuClick(Sender: TObject);
+ procedure InsertJdbgSubMenuClick(Sender: TObject);
+ procedure DeleteMapFileSubMenuClick(Sender: TObject);
+ protected
+ { INTAProjectMenuCreatorNotifier }
+ function AddMenu(const Ident: string): TMenuItem;
+ function CanHandle(const Ident: string): Boolean;
+ public
+ constructor Create(ADebugExtension: TJclDebugExtension; const ANTAServices: INTAServices;
+ const AOTAProjectManager: IOTAProjectManager);
+ end;
+ {$ENDIF BDS4_UP}
+
+// design package entry point
+procedure Register;
+
+// expert DLL entry point
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var TerminateProc: TWizardTerminateProc): Boolean; stdcall;
+
+const
+ DebugActionNames: array [TDebugExpertAction] of AnsiString =
+ ( JclDebugGenerateJdbgSetting, // deGenerateJdbg
+ JclDebugInsertJdbgSetting, // deInsertJdbg
+ JclDebugDeleteMapfileSetting // deDeleteMapFile);
+ );
+ DebugActionValues: array [False..True] of AnsiString =
+ ( 'OFF', 'ON' );
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/converter/JclDebugIdeImpl.pas $';
+ Revision: '$Revision: 2498 $';
+ Date: '$Date: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\converter'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R JclDebugIdeIcon.res}
+
+uses
+ TypInfo,
+ {$IFDEF HAS_UNIT_VARIANTS}
+ Variants,
+ {$ENDIF HAS_UNIT_VARIANTS}
+ JclBase, JclBorlandTools, JclDebug, JclDebugIdeResult,
+ 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;
+begin
+ try
+ if JCLWizardIndex <> -1 then
+ TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLWizardIndex);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var TerminateProc: TWizardTerminateProc): Boolean stdcall;
+begin
+ try
+ TerminateProc := JclWizardTerminate;
+
+ JCLWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.AddWizard(TJclDebugExtension.Create);
+
+ Result := True;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ Result := False;
+ end;
+ end;
+end;
+
+//=== { TJclDebugExtension } =================================================
+
+procedure TJclDebugExtension.ConfigurationClosed(AControl: TControl;
+ SaveChanges: Boolean);
+begin
+ if Assigned(AControl) and (AControl = FConfigFrame) then
+ begin
+ if SaveChanges then
+ begin
+ GlobalStates[deGenerateJdbg] := FConfigFrame.GenerateJdbgState;
+ GlobalStates[deInsertJdbg] := FConfigFrame.InsertJdbgState;
+ GlobalStates[deDeleteMapFile] := FConfigFrame.DeleteMapFileState;
+ end;
+ FreeAndNil(FConfigFrame);
+ end
+ else
+ inherited ConfigurationClosed(AControl, SaveChanges);
+end;
+
+constructor TJclDebugExtension.Create;
+begin
+ inherited Create(JclDebugExpertRegKey);
+end;
+
+procedure TJclDebugExtension.AddConfigurationPages(
+ AddPageFunc: TJclOTAAddPageFunc);
+begin
+ inherited AddConfigurationPages(AddPageFunc);
+ FConfigFrame := TJclDebugIdeConfigFrame.Create(nil);
+ FConfigFrame.GenerateJdbgState := GlobalStates[deGenerateJdbg];
+ FConfigFrame.InsertJdbgState := GlobalStates[deInsertJdbg];
+ FConfigFrame.DeleteMapFileState := GlobalStates[deDeleteMapFile];
+ AddPageFunc(FConfigFrame, RsDebugConfigPageCaption, Self);
+end;
+
+procedure TJclDebugExtension.AfterCompile(Succeeded: Boolean);
+var
+ ProjectFileName, MapFileName, DrcFileName, ExecutableFileName, JdbgFileName: TFileName;
+ OutputDirectory, LinkerBugUnit: string;
+ Succ: Boolean;
+ MapFileSize, JclDebugDataSize, LineNumberErrors, C: Integer;
+ EnabledActions: TDebugExpertActions;
+ OTAMessageServices: IOTAMessageServices;
+
+ procedure OutputToolMessage(const Msg: string);
+ begin
+ if Assigned(FCurrentProject) then
+ OTAMessageServices.AddToolMessage(FCurrentProject.FileName, Msg,
+ JclDebugMessagePrefix, 1, 1)
+ else
+ OTAMessageServices.AddToolMessage('', Msg, JclDebugMessagePrefix, 1, 1);
+ end;
+
+begin
+ if JclDisablePostCompilationProcess or (FCurrentProject = nil) then
+ Exit;
+
+ OTAMessageServices := GetOTAMessageServices;
+ EnabledActions := GetProjectActions(FCurrentProject);
+ if EnabledActions <> [] then
+ begin
+ ProjectFileName := FCurrentProject.FileName;
+ OutputDirectory := GetOutputDirectory(FCurrentProject);
+ MapFileName := GetMapFileName(FCurrentProject);
+ DrcFileName := GetDrcFileName(FCurrentProject);
+ JdbgFileName := ChangeFileExt(MapFileName, JclDbgFileExtension);
+
+ if Succeeded then
+ begin
+ Screen.Cursor := crHourGlass;
+ try
+ LinkerBugUnit := '';
+ LineNumberErrors := 0;
+
+ Succ := FileExists(MapFileName);
+ if not Succ then
+ OutputToolMessage(Format(RsEMapFileNotFound, [MapFileName, ProjectFileName]));
+
+ // creation of .jdbg
+ if Succ and (deGenerateJdbg in EnabledActions) then
+ begin
+ Succ := ConvertMapFileToJdbgFile(MapFileName, LinkerBugUnit, LineNumberErrors,
+ MapFileSize, JclDebugDataSize);
+ if Succ then
+ OutputToolMessage(Format(RsConvertedMapToJdbg, [MapFileName, MapFileSize, JclDebugDataSize]))
+ else
+ OutputToolMessage(Format(RsEMapConversion, [MapFileName]));
+ end;
+
+ // insertion of JEDI Debug Information into the binary
+ if Succ and (deInsertJdbg in EnabledActions) then
+ begin
+ Succ := FindExecutableName(MapFileName, OutputDirectory, ExecutableFileName);
+ if Succ then
+ begin
+ Succ := InsertDebugDataIntoExecutableFile(ExecutableFileName, MapFileName,
+ LinkerBugUnit, MapFileSize, JclDebugDataSize, LineNumberErrors);
+ if Succ then
+ OutputToolMessage(Format(RsInsertedJdbg, [MapFileName, MapFileSize, JclDebugDataSize]))
+ else
+ OutputToolMessage(Format(RsEMapConversion, [MapFileName]));
+ end
+ else
+ OutputToolMessage(Format(RsEExecutableNotFound, [ProjectFileName]));
+ end;
+
+ // deletion of MAP files
+ if Succ and (deDeleteMapFile in EnabledActions) then
+ begin
+ Succ := DeleteFile(MapFileName);
+ if Succ then
+ OutputToolMessage(Format(RsDeletedMapFile, ['MAP', MapFileName]))
+ else
+ OutputToolMessage(Format(RsEFailedToDeleteMapFile, ['MAP', MapFileName]));
+ if DeleteFile(DrcFileName) then
+ OutputToolMessage(Format(RsDeletedMapFile, ['DRC', DrcFileName]))
+ else
+ OutputToolMessage(Format(RsEFailedToDeleteMapFile, ['DRC', DrcFileName]));
+ end;
+
+ Screen.Cursor := crDefault;
+ except
+ Screen.Cursor := crDefault;
+ raise;
+ end;
+
+ 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;
+ end
+ else
+ FBuildError := True;
+ FCurrentProject := nil;
+ end;
+end;
+
+procedure TJclDebugExtension.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
+var
+ ProjOptions: IOTAProjectOptions;
+ EnabledActions: TDebugExpertActions;
+begin
+ EnabledActions := GetProjectActions(Project);
+ if EnabledActions <> [] then
+ begin
+ if IsInstalledPackage(Project) then
+ begin
+ if MessageDlg(Format(RsCantInsertToInstalledPackage, [Project.FileName]), mtError, [mbYes, mbNo], 0) = mrYes then
+ begin
+ DisableExpert(Project);
+ MessageDlg(RsDisabledDebugExpert, mtInformation, [mbOK], 0);
+ end
+ else
+ begin
+ Cancel := True;
+ MessageDlg(RsCompilationAborted, mtError, [mbOK], 0);
+ end;
+ end
+ else
+ begin
+ FCurrentProject := Project;
+ ProjOptions := Project.ProjectOptions;
+ if not Assigned(ProjOptions) then
+ raise EJclExpertException.CreateTrace(RsENoProjectOptions);
+
+ // keep EVariantConvert away from us
+ if (VarToStr(ProjOptions.Values[MapFileOptionName]) <> IntToStr(MapFileOptionDetailed)) then
+ begin
+ if MessageDlg(Format(RsChangeMapFileOption, [ExtractFileName(Project.FileName)]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
+ begin
+ ProjOptions.Values[MapFileOptionName] := MapFileOptionDetailed;
+ ProjOptions.ModifiedState := True;
+ end
+ else
+ begin
+ DisableExpert(Project);
+ MessageDlg(RsDisabledDebugExpert, mtInformation, [mbOK], 0);
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.BeginStoreResults;
+begin
+ FBuildError := False;
+ FStoreResults := True;
+ FResultInfo := nil;
+end;
+
+procedure TJclDebugExtension.BuildAllProjects(Sender: TObject);
+begin
+ BeginStoreResults;
+ try
+ try
+ FSaveBuildAllProjectsActionExecute(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
+ FSaveBuildProjectActionExecute(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.DisableExpert(const AProject: IOTAProject);
+begin
+ ProjectStates[deGenerateJdbg, AProject] := DisableDebugExpertState(ProjectStates[deGenerateJdbg, AProject]);
+ ProjectStates[deInsertJdbg, AProject] := DisableDebugExpertState(ProjectStates[deInsertJdbg, AProject]);
+ ProjectStates[deDeleteMapFile, AProject] := DisableDebugExpertState(ProjectStates[deDeleteMapFile, AProject]);
+end;
+
+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;
+
+procedure TJclDebugExtension.DebugExpertActionExecute(Sender: TObject);
+var
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ begin
+ if ProjectActions[ActiveProject] <> [] then
+ begin
+ // disable all actions
+ ProjectStates[deGenerateJdbg, ActiveProject] := DisableDebugExpertState(ProjectStates[deGenerateJdbg, ActiveProject]);
+ ProjectStates[deInsertJdbg, ActiveProject] := DisableDebugExpertState(ProjectStates[deInsertJdbg, ActiveProject]);
+ ProjectStates[deDeleteMapFile, ActiveProject] := DisableDebugExpertState(ProjectStates[deDeleteMapFile, ActiveProject]);
+ end
+ else
+ begin
+ // enable all actions
+ ProjectStates[deGenerateJdbg, ActiveProject] := EnableDebugExpertState(ProjectStates[deGenerateJdbg, ActiveProject]);
+ ProjectStates[deInsertJdbg, ActiveProject] := EnableDebugExpertState(ProjectStates[deInsertJdbg, ActiveProject]);
+ ProjectStates[deDeleteMapFile, ActiveProject] := EnableDebugExpertState(ProjectStates[deDeleteMapFile, ActiveProject]);
+ end;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DebugExpertActionUpdate(Sender: TObject);
+var
+ AAction: TCustomAction;
+ AEnabled: Boolean;
+ ActiveProject: IOTAProject;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ ActiveProject := GetActiveProject;
+ AEnabled := ActiveProject <> nil;
+ AAction.Enabled := AEnabled;
+ if AEnabled then
+ begin
+ AAction.Checked := ProjectActions[ActiveProject] <> [];
+ AAction.ImageIndex := FDebugImageIndex;
+ end
+ else
+ AAction.ImageIndex := FNoDebugImageIndex;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DebugExpertMenuClick(Sender: TObject);
+var
+ EnabledActions: TDebugExpertActions;
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ EnabledActions := ProjectActions[ActiveProject]
+ else
+ EnabledActions := [];
+ FGenerateJdbgItem.Checked := deGenerateJdbg in EnabledActions;
+ FInsertJdbgItem.Checked := deInsertJdbg in EnabledActions;
+ FDeleteMapFileItem.Checked := deDeleteMapFile in EnabledActions;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DebugExpertMenuDropDown(Sender: TObject);
+var
+ CheckTag, Index: Integer;
+ APopupMenu: TPopupMenu;
+ AMenuItem: TMenuItem;
+ ActiveProject: IOTAProject;
+ TestState: TDebugExpertState;
+ IndexAction: TDebugExpertAction;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ begin
+ TestState := ProjectStates[Low(TDebugExpertAction), ActiveProject];
+ CheckTag := DebugExpertStateToInt(TestState);
+ for IndexAction := Succ(Low(TDebugExpertAction)) to High(TDebugExpertAction) do
+ if TestState <> ProjectStates[IndexAction, ActiveProject] then
+ begin
+ CheckTag := -1;
+ Break;
+ end;
+ end
+ else
+ begin
+ TestState := GlobalStates[Low(TDebugExpertAction)];
+ CheckTag := DebugExpertStateToInt(TestState);
+ for IndexAction := Succ(Low(TDebugExpertAction)) to High(TDebugExpertAction) do
+ if TestState <> GlobalStates[IndexAction] then
+ begin
+ CheckTag := -1;
+ Break;
+ end;
+ end;
+ APopupMenu := Sender as TPopupMenu;
+ for Index := 0 to APopupMenu.Items.Count - 1 do
+ begin
+ AMenuItem := APopupMenu.Items.Items[Index];
+ AMenuItem.Enabled := (ActiveProject <> nil) or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ AMenuItem.Checked := AMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DebugExpertSubMenuClick(Sender: TObject);
+var
+ AState: TDebugExpertState;
+ ActiveProject: IOTAProject;
+begin
+ try
+ AState := IntToDebugExpertState((Sender as TComponent).Tag);
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ begin
+ ProjectStates[deGenerateJdbg, ActiveProject] := AState;
+ ProjectStates[deInsertJdbg, ActiveProject] := AState;
+ ProjectStates[deDeleteMapFile, ActiveProject] := AState;
+ end
+ else
+ begin
+ GlobalStates[deGenerateJdbg] := AState;
+ GlobalStates[deInsertJdbg] := AState;
+ GlobalStates[deDeleteMapFile] := AState;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileActionExecute(Sender: TObject);
+var
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ ProjectStates[deDeleteMapFile, ActiveProject] := ToggleDebugExpertState(ProjectStates[deDeleteMapFile, ActiveProject])
+ else
+ GlobalStates[deDeleteMapFile] := ToggleDebugExpertState(GlobalStates[deDeleteMapFile]);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileActionUpdate(Sender: TObject);
+var
+ AAction: TCustomAction;
+ AEnabled: Boolean;
+ ActiveProject: IOTAProject;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ ActiveProject := GetActiveProject;
+ AEnabled := ActiveProject <> nil;
+ AAction.Enabled := AEnabled;
+ if AEnabled then
+ begin
+ AAction.Checked := ProjectStates[deDeleteMapFile, ActiveProject] in [deAlwaysEnabled, deProjectEnabled];
+ AAction.ImageIndex := FDeleteMapFileImageIndex;
+ end
+ else
+ begin
+ AAction.Checked := False;
+ AAction.ImageIndex := FNoDeleteMapFileImageIndex;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileMenuClick(Sender: TObject);
+var
+ AMenuItem, BMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deDeleteMapFile, ActiveProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deDeleteMapFile]);
+ AMenuItem := Sender as TMenuItem;
+ for Index := 0 to AMenuItem.Count - 1 do
+ begin
+ BMenuItem := AMenuItem.Items[Index];
+ BMenuItem.Enabled := (ActiveProject <> nil) or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ BMenuItem.Checked := BMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileMenuDropDown(Sender: TObject);
+var
+ AMenu: TPopupMenu;
+ AMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deDeleteMapFile, ActiveProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deDeleteMapFile]);
+ AMenu := Sender as TPopupMenu;
+ for Index := 0 to AMenu.Items.Count - 1 do
+ begin
+ AMenuItem := AMenu.Items.Items[Index];
+ AMenuItem.Enabled := (ActiveProject <> nil) or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ AMenuItem.Checked := AMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.DeleteMapFileSubMenuClick(Sender: TObject);
+var
+ AState: TDebugExpertState;
+ ActiveProject: IOTAProject;
+begin
+ try
+ AState := IntToDebugExpertState((Sender as TComponent).Tag);
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ ProjectStates[deDeleteMapFile, ActiveProject] := AState
+ else
+ GlobalStates[deDeleteMapFile] := AState;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgActionExecute(Sender: TObject);
+var
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ ProjectStates[deGenerateJdbg, ActiveProject] := ToggleDebugExpertState(ProjectStates[deGenerateJdbg, ActiveProject])
+ else
+ GlobalStates[deGenerateJdbg] := ToggleDebugExpertState(GlobalStates[deGenerateJdbg]);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgActionUpdate(Sender: TObject);
+var
+ AAction: TCustomAction;
+ AEnabled: Boolean;
+ ActiveProject: IOTAProject;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ ActiveProject := GetActiveProject;
+ AEnabled := ActiveProject <> nil;
+ AAction.Enabled := AEnabled;
+ if AEnabled then
+ begin
+ AAction.Checked := ProjectStates[deGenerateJdbg, ActiveProject] in [deAlwaysEnabled, deProjectEnabled];
+ AAction.ImageIndex := FGenerateJdbgImageIndex;
+ end
+ else
+ begin
+ AAction.Checked := False;
+ AAction.ImageIndex := FNoGenerateJdbgImageIndex;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgMenuClick(Sender: TObject);
+var
+ AMenuItem, BMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deGenerateJdbg, ActiveProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deGenerateJdbg]);
+ AMenuItem := Sender as TMenuItem;
+ for Index := 0 to AMenuItem.Count - 1 do
+ begin
+ BMenuItem := AMenuItem.Items[Index];
+ BMenuItem.Enabled := (ActiveProject <> nil) or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ BMenuItem.Checked := BMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgMenuDropDown(Sender: TObject);
+var
+ AMenu: TPopupMenu;
+ AMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deGenerateJdbg, ActiveProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deGenerateJdbg]);
+ AMenu := Sender as TPopupMenu;
+ for Index := 0 to AMenu.Items.Count - 1 do
+ begin
+ AMenuItem := AMenu.Items.Items[Index];
+ AMenuItem.Enabled := (ActiveProject <> nil) or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ AMenuItem.Checked := AMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.GenerateJdbgSubMenuClick(Sender: TObject);
+var
+ AState: TDebugExpertState;
+ ActiveProject: IOTAProject;
+begin
+ try
+ AState := IntToDebugExpertState((Sender as TComponent).Tag);
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ ProjectStates[deGenerateJdbg, ActiveProject] := AState
+ else
+ GlobalStates[deGenerateJdbg] := AState;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+function TJclDebugExtension.GetGlobalState(Index: TDebugExpertAction): TDebugExpertState;
+begin
+ Result := FGlobalStates[Index];
+end;
+
+function TJclDebugExtension.GetProjectActions(const AProject: IOTAProject): TDebugExpertActions;
+var
+ PropIDs, PropValues: TDynAnsiStringArray;
+ Index: TDebugExpertAction;
+begin
+ SetLength(PropIDs, Integer(High(TDebugExpertAction)) - Integer(Low(TDebugExpertAction)) + 1);
+ for Index := Low(TDebugExpertAction) to High(TDebugExpertAction) do
+ PropIDs[Integer(Index)] := DebugActionNames[Index];
+ PropValues := GetProjectProperties(AProject, PropIDs);
+ Result := [];
+ for Index := Low(TDebugExpertAction) to High(TDebugExpertAction) do
+ case FGlobalStates[Index] of
+ deAlwaysEnabled:
+ Include(Result, Index);
+ deProjectEnabled:
+ if PropValues[Integer(Index)] <> DebugActionValues[False] then
+ Include(Result, Index);
+ deProjectDisabled:
+ if PropValues[Integer(Index)] = DebugActionValues[True] then
+ Include(Result, Index);
+ end;
+end;
+
+function TJclDebugExtension.GetProjectState(Index: TDebugExpertAction; const AProject: IOTAProject): TDebugExpertState;
+var
+ PropIDs: TDynAnsiStringArray;
+begin
+ case FGlobalStates[Index] of
+ deAlwaysDisabled:
+ Result := deAlwaysDisabled;
+ deProjectDisabled:
+ begin
+ SetLength(PropIDs, 1);
+ PropIDs[0] := DebugActionNames[Index];
+ if GetProjectProperties(AProject, PropIDs)[0] = DebugActionValues[True] then
+ Result := deProjectEnabled
+ else
+ Result := deProjectDisabled;
+ end;
+ deProjectEnabled:
+ begin
+ SetLength(PropIDs, 1);
+ PropIDs[0] := DebugActionNames[Index];
+ if GetProjectProperties(AProject, PropIDs)[0] <> DebugActionValues[False] then
+ Result := deProjectEnabled
+ else
+ Result := deProjectDisabled;
+ end;
+ deAlwaysEnabled:
+ Result := deAlwaysEnabled;
+ else
+ raise EJclExpertException.CreateResFmt(@RsEInvalidDebugExpertState, [Integer(FGlobalStates[Index])]);
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgActionExecute(Sender: TObject);
+var
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ ProjectStates[deInsertJdbg, ActiveProject] := ToggleDebugExpertState(ProjectStates[deInsertJdbg, ActiveProject])
+ else
+ GlobalStates[deInsertJdbg] := ToggleDebugExpertState(GlobalStates[deInsertJdbg]);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgActionUpdate(Sender: TObject);
+var
+ AAction: TCustomAction;
+ AEnabled: Boolean;
+ ActiveProject: IOTAProject;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ ActiveProject := GetActiveProject;
+ AEnabled := ActiveProject <> nil;
+ AAction.Enabled := AEnabled;
+ if AEnabled then
+ begin
+ AAction.Checked := ProjectStates[deInsertJdbg, ActiveProject] in [deAlwaysEnabled, deProjectEnabled];
+ AAction.ImageIndex := FInsertJdbgImageIndex
+ end
+ else
+ begin
+ AAction.Checked := False;
+ AAction.ImageIndex := FNoInsertJdbgImageIndex;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgMenuClick(Sender: TObject);
+var
+ AMenuItem, BMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deInsertJdbg, ActiveProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deInsertJdbg]);
+ AMenuItem := Sender as TMenuItem;
+ for Index := 0 to AMenuItem.Count - 1 do
+ begin
+ BMenuItem := AMenuItem.Items[Index];
+ BMenuItem.Enabled := (ActiveProject <> nil) or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (BMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ BMenuItem.Checked := BMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgMenuDropDown(Sender: TObject);
+var
+ AMenu: TPopupMenu;
+ AMenuItem: TMenuItem;
+ CheckTag, Index: Integer;
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ CheckTag := DebugExpertStateToInt(ProjectStates[deInsertJdbg, ActiveProject])
+ else
+ CheckTag := DebugExpertStateToInt(GlobalStates[deInsertJdbg]);
+ AMenu := Sender as TPopupMenu;
+ for Index := 0 to AMenu.Items.Count - 1 do
+ begin
+ AMenuItem := AMenu.Items.Items[Index];
+ AMenuItem.Enabled := (ActiveProject <> nil) or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysDisabled))
+ or (AMenuItem.Tag = DebugExpertStateToInt(deAlwaysEnabled));
+ AMenuItem.Checked := AMenuItem.Tag = CheckTag;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.InsertJdbgSubMenuClick(Sender: TObject);
+var
+ AState: TDebugExpertState;
+ ActiveProject: IOTAProject;
+begin
+ try
+ AState := IntToDebugExpertState((Sender as TComponent).Tag);
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ ProjectStates[deInsertJdbg, ActiveProject] := AState
+ else
+ GlobalStates[deInsertJdbg] := AState;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+procedure TJclDebugExtension.LoadExpertValues;
+begin
+ GlobalStates[deGenerateJdbg] := IntToDebugExpertState(Settings.LoadInteger(JclDebugGenerateJdbgRegValue, 0));
+ GlobalStates[deInsertJdbg] := IntToDebugExpertState(Settings.LoadInteger(JclDebugInsertJdbgRegValue, 0));
+ GlobalStates[deDeleteMapFile] := IntToDebugExpertState(Settings.LoadInteger(JclDebugDeleteMapFileRegValue, 0));
+end;
+
+procedure TJclDebugExtension.SaveExpertValues;
+begin
+ Settings.SaveInteger(JclDebugGenerateJdbgRegValue, DebugExpertStateToInt(GlobalStates[deGenerateJdbg]));
+ Settings.SaveInteger(JclDebugInsertJdbgRegValue, DebugExpertStateToInt(GlobalStates[deInsertJdbg]));
+ Settings.SaveInteger(JclDebugDeleteMapFileRegValue, DebugExpertStateToInt(GlobalStates[deDeleteMapFile]));
+end;
+
+procedure TJclDebugExtension.SetGlobalState(Index: TDebugExpertAction; Value: TDebugExpertState);
+begin
+ FGlobalStates[Index] := Value;
+end;
+
+procedure TJclDebugExtension.SetProjectState(Index: TDebugExpertAction; const AProject: IOTAProject;
+ Value: TDebugExpertState);
+var
+ PropIDs, PropValues: TDynAnsiStringArray;
+begin
+ case Value of
+ deAlwaysDisabled:
+ FGlobalStates[Index] := deAlwaysDisabled;
+ deProjectDisabled:
+ begin
+ if not (GlobalStates[Index] in [deProjectDisabled, deProjectEnabled]) then
+ FGlobalStates[Index] := deProjectDisabled;
+ SetLength(PropIDs, 1);
+ PropIDs[0] := DebugActionNames[Index];
+ SetLength(PropValues, 1);
+ PropValues[0] := DebugActionValues[False];
+ if SetProjectProperties(AProject, PropIDs, PropValues) <> 1 then
+ MessageDlg(RsEProjectPropertyFailed,mtError,[mbAbort],0);
+ end;
+ deProjectEnabled:
+ begin
+ if not (GlobalStates[Index] in [deProjectDisabled, deProjectEnabled]) then
+ FGlobalStates[Index] := deProjectEnabled;
+ SetLength(PropIDs, 1);
+ PropIDs[0] := DebugActionNames[Index];
+ SetLength(PropValues, 1);
+ PropValues[0] := DebugActionValues[True];
+ if SetProjectProperties(AProject, PropIDs, PropValues) <> 1 then
+ MessageDlg(RsEProjectPropertyFailed,mtError,[mbAbort],0);
+ end;
+ deAlwaysEnabled:
+ FGlobalStates[Index] := deAlwaysEnabled;
+ end;
+end;
+
+procedure TJclDebugExtension.RegisterCommands;
+ procedure FillMenu(AMenuItem: TMenuItem; AEvent: TNotifyEvent);
+ var
+ BMenuItem: TMenuItem;
+ begin
+ BMenuItem := TMenuItem.Create(AMenuItem);
+ BMenuItem.Caption := RsAlwaysEnabled;
+ BMenuItem.RadioItem := True;
+ BMenuItem.Tag := DebugExpertStateToInt(deAlwaysEnabled);
+ BMenuItem.OnClick := AEvent;
+ AMenuItem.Add(BMenuItem);
+
+ BMenuItem := TMenuItem.Create(AMenuItem);
+ BMenuItem.Caption := RsProjectEnabled;
+ BMenuItem.RadioItem := True;
+ BMenuItem.Tag := DebugExpertStateToInt(deProjectEnabled);
+ BMenuItem.OnClick := AEvent;
+ AMenuItem.Add(BMenuItem);
+
+ BMenuItem := TMenuItem.Create(AMenuItem);
+ BMenuItem.Caption := RsProjectDisabled;
+ BMenuItem.RadioItem := True;
+ BMenuItem.Tag := DebugExpertStateToInt(deProjectDisabled);
+ BMenuItem.OnClick := AEvent;
+ AMenuItem.Add(BMenuItem);
+
+ BMenuItem := TMenuItem.Create(AMenuItem);
+ BMenuItem.Caption := RsAlwaysDisabled;
+ BMenuItem.RadioItem := True;
+ BMenuItem.Tag := DebugExpertStateToInt(deAlwaysDisabled);
+ BMenuItem.OnClick := AEvent;
+ AMenuItem.Add(BMenuItem);
+ end;
+var
+ IDEMainMenu: TMainMenu;
+ IDEProjectItem: TMenuItem;
+ IDEActionList: TActionList;
+ I: Integer;
+ ImageBmp: TBitmap;
+ NTAServices: INTAServices;
+ OTAServices: IOTAServices;
+ {$IFDEF BDS4_UP}
+ OTAProjectManager: IOTAProjectManager;
+ {$ENDIF BDS4_UP}
+begin
+ inherited RegisterCommands;
+
+ NTAServices := GetNTAServices;
+ OTAServices := GetOTAServices;
+
+ IDEActionList := TActionList(NTAServices.ActionList);
+ IDEMainMenu := NTAServices.MainMenu;
+ ImageBmp := TBitmap.Create;
+ try
+ // load images
+ ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLDEBUG');
+ FDebugImageIndex := NTAServices.AddMasked(ImageBmp, clPurple);
+ ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLNODEBUG');
+ FNoDebugImageIndex := NTAServices.AddMasked(ImageBmp, clPurple);
+ ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLGENERATEJDBG');
+ FGenerateJdbgImageIndex := NTAServices.AddMasked(ImageBmp, clPurple);
+ ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLNOGENERATEJDBG');
+ FNoGenerateJdbgImageIndex := NTAServices.AddMasked(ImageBmp, clPurple);
+ ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLINSERTJDBG');
+ FInsertJdbgImageIndex := NTAServices.AddMasked(ImageBmp, clPurple);
+ ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLNOINSERTJDBG');
+ FNoInsertJdbgImageIndex := NTAServices.AddMasked(ImageBmp, clPurple);
+ ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLDELETEMAP');
+ FDeleteMapFileImageIndex := NTAServices.AddMasked(ImageBmp, clPurple);
+ ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'JCLNODELETEMAP');
+ FNoDeleteMapFileImageIndex := NTAServices.AddMasked(ImageBmp, clPurple);
+
+ // create actions
+ FDebugExpertAction := TDropDownAction.Create(nil);
+ FDebugExpertAction.Caption := RsDebugExpertCaption;
+ FDebugExpertAction.Visible := True;
+ FDebugExpertAction.ImageIndex := FDebugImageIndex;
+ FDebugExpertAction.OnUpdate := DebugExpertActionUpdate;
+ FDebugExpertAction.OnExecute := DebugExpertActionExecute;
+ FDebugExpertAction.ActionList := IDEActionList;
+ FDebugExpertAction.Name := JclDebugExpertActionName;
+ FDebugExpertAction.DropdownMenu := TPopupMenu.Create(nil);
+ FDebugExpertAction.DropdownMenu.OnPopup := DebugExpertMenuDropDown;
+ FDebugExpertAction.DropdownMenu.AutoPopup := True;
+ FillMenu(FDebugExpertAction.DropDownMenu.Items, DebugExpertSubMenuClick);
+ RegisterAction(FDebugExpertAction);
+
+ FGenerateJdbgAction := TDropDownAction.Create(nil);
+ FGenerateJdbgAction.Caption := RsDebugGenerateJdbg;
+ FGenerateJdbgAction.Visible := True;
+ FGenerateJdbgAction.ImageIndex := FGenerateJdbgImageIndex;
+ FGenerateJdbgAction.OnUpdate := GenerateJdbgActionUpdate;
+ FGenerateJdbgAction.OnExecute := GenerateJdbgActionExecute;
+ FGenerateJdbgAction.ActionList := IDEActionList;
+ FGenerateJdbgAction.Name := JclGenerateJdbgActionName;
+ FGenerateJdbgAction.DropdownMenu := TPopupMenu.Create(nil);
+ FGenerateJdbgAction.DropdownMenu.OnPopup := GenerateJdbgMenuDropDown;
+ FGenerateJdbgAction.DropdownMenu.AutoPopup := True;
+ FillMenu(FGenerateJdbgAction.DropDownMenu.Items, GenerateJdbgSubMenuClick);
+ RegisterAction(FGenerateJdbgAction);
+
+ FInsertJdbgAction := TDropDownAction.Create(nil);
+ FInsertJdbgAction.Caption := RsDebugInsertJdbg;
+ FInsertJdbgAction.Visible := True;
+ FInsertJdbgAction.ImageIndex := FInsertJdbgImageIndex;
+ FInsertJdbgAction.OnUpdate := InsertJdbgActionUpdate;
+ FInsertJdbgAction.OnExecute := InsertJdbgActionExecute;
+ FInsertJdbgAction.ActionList := IDEActionList;
+ FInsertJdbgAction.Name := JclInsertJdbgActionName;
+ FInsertJdbgAction.DropdownMenu := TPopupMenu.Create(nil);
+ FInsertJdbgAction.DropdownMenu.OnPopup := InsertJdbgMenuDropDown;
+ FInsertJdbgAction.DropdownMenu.AutoPopup := True;
+ FillMenu(FInsertJdbgAction.DropDownMenu.Items, InsertJdbgSubMenuClick);
+ RegisterAction(FInsertJdbgAction);
+
+ FDeleteMapFileAction := TDropDownAction.Create(nil);
+ FDeleteMapFileAction.Caption := RsDeleteMapFile;
+ FDeleteMapFileAction.Visible := True;
+ FDeleteMapFileAction.ImageIndex := FDeleteMapFileImageIndex;
+ FDeleteMapFileAction.OnUpdate := DeleteMapFileActionUpdate;
+ FDeleteMapFileAction.OnExecute := DeleteMapFileActionExecute;
+ FDeleteMapFileAction.ActionList := IDEActionList;
+ FDeleteMapFileAction.Name := JclDeleteMapFileActionName;
+ FDeleteMapFileAction.DropdownMenu := TPopupMenu.Create(nil);
+ FDeleteMapFileAction.DropdownMenu.OnPopup := DeleteMapFileMenuDropDown;
+ FDeleteMapFileAction.DropdownMenu.AutoPopup := True;
+ FillMenu(FDeleteMapFileAction.DropDownMenu.Items, DeleteMapFileSubMenuClick);
+ RegisterAction(FDeleteMapFileAction);
+
+ // create menu items
+ FDebugExpertItem := TMenuItem.Create(nil);
+ FDebugExpertItem.Name := JclDebugExpertMenuName;
+ FDebugExpertItem.Caption := RsDebugExpertCaption;
+ FDebugExpertItem.OnClick := DebugExpertMenuClick;
+ FDebugExpertItem.ImageIndex := FDebugImageIndex;
+
+ FGenerateJdbgItem := TMenuItem.Create(nil);
+ FGenerateJdbgItem.Name := JclGenerateJdbgMenuName;
+ FGenerateJdbgItem.Caption := RsDebugGenerateJdbg;
+ FGenerateJdbgItem.OnClick := GenerateJdbgMenuClick;
+ FGenerateJdbgItem.ImageIndex := FGenerateJdbgImageIndex;
+ FillMenu(FGenerateJdbgItem, GenerateJdbgSubMenuClick);
+ FDebugExpertItem.Add(FGenerateJdbgItem);
+
+ FInsertJdbgItem := TMenuItem.Create(nil);
+ FInsertJdbgItem.Name := JclInsertJdbgMenuName;
+ FInsertJdbgItem.Caption := RsDebugInsertJdbg;
+ FInsertJdbgItem.OnClick := InsertJdbgMenuClick;
+ FInsertJdbgItem.ImageIndex := FInsertJdbgImageIndex;
+ FillMenu(FInsertJdbgItem, InsertJdbgSubMenuClick);
+ FDebugExpertItem.Add(FInsertJdbgItem);
+
+ FDeleteMapFileItem := TMenuItem.Create(nil);
+ FDeleteMapFileItem.Name := JclDeleteMapFileMenuName;
+ FDeleteMapFileItem.Caption := RsDeleteMapFile;
+ FDeleteMapFileItem.OnClick := DeleteMapFileMenuClick;
+ FDeleteMapFileItem.ImageIndex := FDeleteMapFileImageIndex;
+ FillMenu(FDeleteMapFileItem, DeleteMapFileSubMenuClick);
+ FDebugExpertItem.Add(FDeleteMapFileItem);
+ finally
+ ImageBmp.Free;
+ end;
+
+ // register notifiers
+ FIDENotifierIndex := OTAServices.AddNotifier(TIdeNotifier.Create(Self));
+ {$IFDEF BDS4_UP}
+ OTAProjectManager := GetOTAProjectManager;
+ FProjectManagerNotifierIndex := OTAProjectManager.AddMenuCreatorNotifier(TProjectManagerNotifier.Create(Self,
+ NTAServices, OTAProjectManager));
+ {$ENDIF BDS4_UP}
+
+ LoadExpertValues;
+
+ // insert menus
+ 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 = 'ProjectOptionsItem' then
+ begin
+ if Assigned(Items[I].Action) then
+ begin
+ FDebugExpertAction.Category := TContainedAction(Items[I].Action).Category;
+ FGenerateJdbgAction.Category := FDebugExpertAction.Category;
+ FInsertJdbgAction.Category := FDebugExpertAction.Category;
+ FDeleteMapFileAction.Category := FDebugExpertAction.Category;
+ end;
+ IDEProjectItem.Insert(I + 1, FDebugExpertItem);
+ System.Break;
+ end;
+ if not Assigned(FDebugExpertItem.Parent) then
+ raise EJclExpertException.CreateTrace(RsEInsertDataMenuItemNotInserted);
+
+ // hook actions
+ FSaveBuildProjectAction := nil;
+ with IDEActionList do
+ for I := 0 to ActionCount - 1 do
+ if Actions[I].Name = 'ProjectBuildCommand' then
+ begin
+ FSaveBuildProjectAction := TCustomAction(Actions[I]);
+ FSaveBuildProjectActionExecute := FSaveBuildProjectAction.OnExecute;
+ FSaveBuildProjectAction.OnExecute := BuildProject;
+ Break;
+ end;
+ if not Assigned(FSaveBuildProjectAction) then
+ raise EJclExpertException.CreateTrace(RsENoBuildAction);
+
+ FSaveBuildAllProjectsAction := nil;
+ with IDEActionList do
+ for I := 0 to ActionCount - 1 do
+ if Actions[I].Name = 'ProjectBuildAllCommand' then
+ begin
+ FSaveBuildAllProjectsAction := TCustomAction(Actions[I]);
+ FSaveBuildAllProjectsActionExecute := FSaveBuildAllProjectsAction.OnExecute;
+ FSaveBuildAllProjectsAction.OnExecute := BuildAllProjects;
+ Break;
+ end;
+ if not Assigned(FSaveBuildAllProjectsAction) then
+ raise EJclExpertException.CreateTrace(RsENoBuildAllAction);
+end;
+
+procedure TJclDebugExtension.UnregisterCommands;
+begin
+ inherited UnregisterCommands;
+ {$IFDEF BDS4_UP}
+ if FProjectManagerNotifierIndex <> -1 then
+ GetOTAProjectManager.RemoveMenuCreatorNotifier(FProjectManagerNotifierIndex);
+ {$ENDIF BDS4_UP}
+ if FIDENotifierIndex <> -1 then
+ GetOTAServices.RemoveNotifier(FIDENotifierIndex);
+ // save settings
+ SaveExpertValues;
+
+ // unhook actions
+ FSaveBuildProjectAction.OnExecute := FSaveBuildProjectActionExecute;
+ FSaveBuildAllProjectsAction.OnExecute := FSaveBuildAllProjectsActionExecute;
+
+ // remove menu items
+ if FDebugExpertAction <> nil then
+ FDebugExpertAction.DropdownMenu.Free;
+ if FGenerateJdbgAction <> nil then
+ FGenerateJdbgAction.DropdownMenu.Free;
+ if FInsertJdbgAction <> nil then
+ FInsertJdbgAction.DropdownMenu.Free;
+ if FDeleteMapFileAction <> nil then
+ FDeleteMapFileAction.DropdownMenu.Free;
+ FGenerateJdbgItem.Free;
+ FInsertJdbgItem.Free;
+ FDeleteMapFileItem.Free;
+ FDebugExpertItem.Free;
+
+ // remove actions
+ UnregisterAction(FDeleteMapFileAction);
+ UnregisterAction(FInsertJdbgAction);
+ UnregisterAction(FGenerateJdbgAction);
+ UnregisterAction(FDebugExpertAction);
+ FDeleteMapFileAction.Free;
+ FInsertJdbgAction.Free;
+ FGenerateJdbgAction.Free;
+ FDebugExpertAction.Free;
+end;
+
+//=== { TIdeNotifier } =======================================================
+
+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; Do not lock out the user from compiling anything
+ 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;
+
+{$IFDEF BDS4_UP}
+
+//=== { TProjectManagerNotifier } ============================================
+
+constructor TProjectManagerNotifier.Create(ADebugExtension: TJclDebugExtension;
+ const ANTAServices: INTAServices; const AOTAProjectManager: IOTAProjectManager);
+begin
+ inherited Create;
+ FDebugExtension := ADebugExtension;
+ FNTAServices := ANTAServices;
+ FOTAProjectManager := AOTAProjectManager;
+end;
+
+function TProjectManagerNotifier.AddMenu(const Ident: string): TMenuItem;
+ procedure FillSubMenu(AMenuItem: TMenuItem; const AOnClickEvent: TNotifyEvent; AState: TDebugExpertState);
+ var
+ SubMenuItem: TMenuItem;
+ begin
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Visible := True;
+ SubMenuItem.Caption := RsAlwaysEnabled;
+ SubMenuItem.RadioItem := True;
+ SubMenuItem.Checked := AState = deAlwaysEnabled;
+ SubMenuItem.Tag := DebugExpertStateToInt(deAlwaysEnabled);
+ SubMenuItem.OnClick := AOnClickEvent;
+ AMenuItem.Add(SubMenuItem);
+
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Visible := True;
+ SubMenuItem.Caption := RsProjectEnabled;
+ SubMenuItem.RadioItem := True;
+ SubMenuItem.Checked := AState = deProjectEnabled;
+ SubMenuItem.Tag := DebugExpertStateToInt(deProjectEnabled);
+ SubMenuItem.OnClick := AOnClickEvent;
+ AMenuItem.Add(SubMenuItem);
+
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Visible := True;
+ SubMenuItem.Caption := RsProjectDisabled;
+ SubMenuItem.RadioItem := True;
+ SubMenuItem.Checked := AState = deProjectDisabled;
+ SubMenuItem.Tag := DebugExpertStateToInt(deProjectDisabled);
+ SubMenuItem.OnClick := AOnClickEvent;
+ AMenuItem.Add(SubMenuItem);
+
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Visible := True;
+ SubMenuItem.Caption := RsAlwaysDisabled;
+ SubMenuItem.RadioItem := True;
+ SubMenuItem.Checked := AState = deAlwaysDisabled;
+ SubMenuItem.Tag := DebugExpertStateToInt(deAlwaysDisabled);
+ SubMenuItem.OnClick := AOnClickEvent;
+ AMenuItem.Add(SubMenuItem);
+ end;
+var
+ SelectedIdent: string;
+ AProject: IOTAProject;
+ ADeleteMapFileState, AGenerateJdbgState, AInsertJdbgState: TDebugExpertState;
+ ActionMenuItem: TMenuItem;
+begin
+ try
+ SelectedIdent := Ident;
+ AProject := FOTAProjectManager.GetCurrentSelection(SelectedIdent);
+ if AProject <> nil then
+ begin
+ ADeleteMapFileState := FDebugExtension.ProjectStates[deDeleteMapFile, AProject];
+ AGenerateJdbgState := FDebugExtension.ProjectStates[deGenerateJdbg, AProject];
+ AInsertJdbgState := FDebugExtension.ProjectStates[deInsertJdbg, AProject];
+
+ // root item
+ Result := TMenuItem.Create(nil);
+ Result.Visible := True;
+ Result.Caption := RsDebugExpertCaption;
+ if (ADeleteMapFileState in [deAlwaysEnabled, deProjectEnabled])
+ or (AGenerateJdbgState in [deAlwaysEnabled, deProjectEnabled])
+ or (AInsertJdbgState in [deAlwaysEnabled, deProjectEnabled]) then
+ begin
+ Result.Checked := True;
+ Result.ImageIndex := FDebugExtension.FDebugImageIndex
+ end
+ else
+ Result.ImageIndex := FDebugExtension.FNoDebugImageIndex;
+ Result.SubMenuImages := FNTAServices.ImageList;
+
+ // actions items
+ ActionMenuItem := TMenuItem.Create(Result);
+ ActionMenuItem.Visible := True;
+ ActionMenuItem.Caption := RsDebugGenerateJdbg;
+ if AGenerateJdbgState in [deAlwaysEnabled, deProjectEnabled] then
+ begin
+ ActionMenuItem.Checked := True;
+ ActionMenuItem.ImageIndex := FDebugExtension.FGenerateJdbgImageIndex;
+ end
+ else
+ ActionMenuItem.ImageIndex := FDebugExtension.FNoGenerateJdbgImageIndex;
+ FillSubMenu(ActionMenuItem, GenerateJdbgSubMenuClick, AGenerateJdbgState);
+ Result.Add(ActionMenuItem);
+
+ ActionMenuItem := TMenuItem.Create(Result);
+ ActionMenuItem.Visible := True;
+ ActionMenuItem.Caption := RsDebugInsertJdbg;
+ if AInsertJdbgState in [deAlwaysEnabled, deProjectEnabled] then
+ begin
+ ActionMenuItem.Checked := True;
+ ActionMenuItem.ImageIndex := FDebugExtension.FInsertJdbgImageIndex;
+ end
+ else
+ ActionMenuItem.ImageIndex := FDebugExtension.FNoInsertJdbgImageIndex;
+ FillSubMenu(ActionMenuItem, InsertJdbgSubMenuClick, AInsertJdbgState);
+ Result.Add(ActionMenuItem);
+
+ ActionMenuItem := TMenuItem.Create(Result);
+ ActionMenuItem.Visible := True;
+ ActionMenuItem.Caption := RsDeleteMapFile;
+ if ADeleteMapFileState in [deAlwaysEnabled, deProjectEnabled] then
+ begin
+ ActionMenuItem.Checked := True;
+ ActionMenuItem.ImageIndex := FDebugExtension.FDeleteMapFileImageIndex;
+ end
+ else
+ ActionMenuItem.ImageIndex := FDebugExtension.FNoDeleteMapFileImageIndex;
+ FillSubMenu(ActionMenuItem, DeleteMapFileSubMenuClick, ADeleteMapFileState);
+ Result.Add(ActionMenuItem);
+ end
+ else
+ raise EJclExpertException.CreateRes(@RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+function TProjectManagerNotifier.CanHandle(const Ident: string): Boolean;
+begin
+ Result := Ident = sProjectContainer;
+end;
+
+procedure TProjectManagerNotifier.DeleteMapFileSubMenuClick(Sender: TObject);
+var
+ AProject: IOTAProject;
+ Ident: string;
+begin
+ try
+ Ident := '';
+ AProject := FOTAProjectManager.GetCurrentSelection(Ident);
+ if AProject <> nil then
+ FDebugExtension.ProjectStates[deDeleteMapFile, AProject] := IntToDebugExpertState((Sender as TMenuItem).Tag)
+ else
+ raise EJclExpertException.CreateRes(@RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TProjectManagerNotifier.GenerateJdbgSubMenuClick(Sender: TObject);
+var
+ AProject: IOTAProject;
+ Ident: string;
+begin
+ try
+ Ident := '';
+ AProject := FOTAProjectManager.GetCurrentSelection(Ident);
+ if AProject <> nil then
+ FDebugExtension.ProjectStates[deGenerateJdbg, AProject] := IntToDebugExpertState((Sender as TMenuItem).Tag)
+ else
+ raise EJclExpertException.CreateRes(@RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TProjectManagerNotifier.InsertJdbgSubMenuClick(Sender: TObject);
+var
+ AProject: IOTAProject;
+ Ident: string;
+begin
+ try
+ Ident := '';
+ AProject := FOTAProjectManager.GetCurrentSelection(Ident);
+ if AProject <> nil then
+ FDebugExtension.ProjectStates[deInsertJdbg, AProject] := IntToDebugExpertState((Sender as TMenuItem).Tag)
+ else
+ raise EJclExpertException.CreateRes(@RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+{$ENDIF BDS4_UP}
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/converter/JclDebugIdeResult.dfm b/official/1.104/experts/debug/converter/JclDebugIdeResult.dfm
new file mode 100644
index 0000000..9cf8719
--- /dev/null
+++ b/official/1.104/experts/debug/converter/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.104/experts/debug/converter/JclDebugIdeResult.pas b/official/1.104/experts/debug/converter/JclDebugIdeResult.pas
new file mode 100644
index 0000000..91c1ae4
--- /dev/null
+++ b/official/1.104/experts/debug/converter/JclDebugIdeResult.pas
@@ -0,0 +1,226 @@
+{**************************************************************************************************}
+{ }
+{ 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:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclDebugIdeResult;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, SysUtils, Classes, Controls, Forms, ComCtrls, StdCtrls, ImgList,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/converter/JclDebugIdeResult.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\converter'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/dialog/ClxExceptDlg.ico b/official/1.104/experts/debug/dialog/ClxExceptDlg.ico
new file mode 100644
index 0000000..2fd6f72
Binary files /dev/null and b/official/1.104/experts/debug/dialog/ClxExceptDlg.ico differ
diff --git a/official/1.104/experts/debug/dialog/ClxExceptDlg.pas b/official/1.104/experts/debug/dialog/ClxExceptDlg.pas
new file mode 100644
index 0000000..12097fa
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/ClxExceptDlg.pas
@@ -0,0 +1,756 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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: 2008-08-07 23:54:09 +0200 (jeu., 07 août 2008) $ }
+{ }
+{**************************************************************************************************}
+
+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;
+ OldProtect, Dummy: 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
+ Result := VirtualProtect(CallAddress, sizeof(CallInstruction), PAGE_EXECUTE_READWRITE, OldProtect);
+ if Result then
+ try
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ PCALLInstruction(CallAddress)^ := CALLInstruction;
+ if Result then
+ FlushInstructionCache(GetCurrentProcess, CallAddress, SizeOf(CALLInstruction));
+ finally
+ VirtualProtect(CallAddress, sizeof(CallInstruction), OldProtect, Dummy);
+ end;
+ 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(NativeCrLf, 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(NativeCrLf);
+ 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(NativeCrLf, TextLabel.Text) + NativeCrLf + 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);
+const
+ DirectionChars: array [0..1] of Char = ( '<', '>' );
+var
+ DetailsCaption: string;
+begin
+ FDetailsVisible := Value;
+ DetailsCaption := Trim(StrRemoveChars(DetailsBtn.Caption, DirectionChars));
+ 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}
+
+end.
diff --git a/official/1.104/experts/debug/dialog/ClxExceptDlg.xfm b/official/1.104/experts/debug/dialog/ClxExceptDlg.xfm
new file mode 100644
index 0000000..8a9aa92
--- /dev/null
+++ b/official/1.104/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.104/experts/debug/dialog/CreateStdDialogs.dpr b/official/1.104/experts/debug/dialog/CreateStdDialogs.dpr
new file mode 100644
index 0000000..2ce76fb
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/CreateStdDialogs.dpr
@@ -0,0 +1,116 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is CreateStdDialogs.dpr. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $ }
+{ Revision: $Rev:: 2461 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+program CreateStdDialogs;
+
+{$APPTYPE CONSOLE}
+
+uses
+ SysUtils,
+ Classes,
+ JclBorlandTools,
+ JclOtaTemplates in '..\..\repository\JclOtaTemplates.pas',
+ JclOtaExcDlgRepository in '..\..\repository\JclOtaExcDlgRepository.pas';
+
+function LoadTemplate(const FileName: TFileName): string;
+var
+ AFileStream: TFileStream;
+ Buffer: AnsiString;
+begin
+ AFileStream := TFileStream.Create(FileName, fmOpenRead, fmShareDenyWrite);
+ try
+ SetLength(Buffer, AFileStream.Size);
+ AFileStream.ReadBuffer(Buffer[1], AFileStream.Size);
+ Result := string(Buffer);
+ finally
+ AFileStream.Free;
+ end;
+end;
+
+procedure SaveFile(const FileName: TFileName; const FileContent: string);
+var
+ AFileStream: TFileStream;
+ Buffer: AnsiString;
+begin
+ AFileStream := TFileStream.Create(FileName, fmOpenWrite, fmShareExclusive);
+ try
+ Buffer := AnsiString(FileContent);
+ AFileStream.Size := 0;
+ AFileStream.Write(Buffer[1], Length(Buffer));
+ finally
+ AFileStream.Free;
+ end;
+end;
+
+var
+ Params: TJclOtaExcDlgParams;
+begin
+ try
+ Params := TJclOtaExcDlgParams.Create;
+ try
+ Params.ActivePersonality := bpDelphi32;
+ Params.FormName := 'ExceptionDialog';
+ Params.FormAncestor := 'TForm';
+ Params.ModalDialog := True;
+ Params.SendEMail := False;
+ Params.SizeableDialog := True;
+ Params.AutoScrollBars := True;
+ Params.DelayedTrace := True;
+ Params.HookDll := True;
+ Params.LogFile := True;
+ Params.LogFileName := '''filename.log''';
+ Params.OSInfo := True;
+ Params.ModuleList := True;
+ Params.ActiveControls := True;
+ Params.MainThreadOnly := False;
+ Params.TraceAllExceptions := False;
+ Params.StackList := True;
+ Params.RawData := True;
+ Params.ModuleName := True;
+ Params.ModuleOffset := True;
+ Params.CodeDetails := True;
+ Params.VirtualAddress := True;
+
+ SaveFile('ExceptDlg.pas', GetFinalSourceContent(ApplyTemplate(LoadTemplate('ExceptDlg.Delphi32.pas'), Params), 'ExceptDlg', 'ExceptionDialog', 'TForm'));
+ SaveFile('ExceptDlg.dfm', GetFinalSourceContent(ApplyTemplate(LoadTemplate('ExceptDlg.Delphi32.dfm'), Params), 'ExceptDlg', 'ExceptionDialog', 'TForm'));
+
+ Params.FormName := 'ExceptionDialogMail';
+ Params.SendEMail := True;
+ Params.EMailAddress := '''name@domain.ext''';
+ Params.EMailSubject := '''email subject''';
+
+ SaveFile('ExceptDlgMail.pas', GetFinalSourceContent(ApplyTemplate(LoadTemplate('ExceptDlg.Delphi32.pas'), Params), 'ExceptDlgMail', 'ExceptionDialogMail', 'TForm'));
+ SaveFile('ExceptDlgMail.dfm', GetFinalSourceContent(ApplyTemplate(LoadTemplate('ExceptDlg.Delphi32.dfm'), Params), 'ExceptDlgMail', 'ExceptionDialogMail', 'TForm'));
+ finally
+ Params.Free;
+ end;
+ except
+ on E:Exception do
+ Writeln(E.Classname, ': ', E.Message);
+ end;
+end.
diff --git a/official/1.104/experts/debug/dialog/ExceptDlg.CBuilder32.cpp b/official/1.104/experts/debug/dialog/ExceptDlg.CBuilder32.cpp
new file mode 100644
index 0000000..30404ce
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/ExceptDlg.CBuilder32.cpp
@@ -0,0 +1 @@
+TODO
\ No newline at end of file
diff --git a/official/1.104/experts/debug/dialog/ExceptDlg.CBuilder32.dfm b/official/1.104/experts/debug/dialog/ExceptDlg.CBuilder32.dfm
new file mode 100644
index 0000000..30404ce
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/ExceptDlg.CBuilder32.dfm
@@ -0,0 +1 @@
+TODO
\ No newline at end of file
diff --git a/official/1.104/experts/debug/dialog/ExceptDlg.CBuilder32.h b/official/1.104/experts/debug/dialog/ExceptDlg.CBuilder32.h
new file mode 100644
index 0000000..30404ce
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/ExceptDlg.CBuilder32.h
@@ -0,0 +1 @@
+TODO
\ No newline at end of file
diff --git a/official/1.104/experts/debug/dialog/ExceptDlg.Delphi32.dfm b/official/1.104/experts/debug/dialog/ExceptDlg.Delphi32.dfm
new file mode 100644
index 0000000..a84a3c5
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/ExceptDlg.Delphi32.dfm
@@ -0,0 +1,106 @@
+object %FORMNAME%: T%FORMNAME%
+ Left = 310
+ Top = 255
+ AutoScroll = False
+ BorderIcons = [biSystemMenu]
+%ifnot SizeableDialog BorderStyle = bsDialog%endif
+ Caption = '%FORMNAME%'
+ ClientHeight = 255
+ ClientWidth = 483
+ 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 BevelDetails: TBevel
+ Left = 3
+ Top = 91
+ Width = 473
+ Height = 9
+ Anchors = [akLeft, akTop, akRight]
+ Shape = bsTopLine
+ end
+%if SendEMail
+ object SendBtn: TButton
+ Left = 403
+ Top = 32
+ Width = 75
+ Height = 25
+ Hint = 'Send bug report using default mail client'
+ Anchors = [akTop, akRight]
+ Caption = '&Send'
+ TabOrder = 0
+ OnClick = SendBtnClick
+ end%endif
+ object TextMemo: TMemo
+ Left = 56
+ Top = 8
+ Width = 332
+ Height = 75
+ Hint = 'Use Ctrl+C to copy the report to the clipboard'
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Ctl3D = True
+ ParentColor = True
+ ParentCtl3D = False
+ ReadOnly = True
+ TabOrder = 1
+ WantReturns = False
+ end
+ object OkBtn: TButton
+ Left = 403
+ Top = 4
+ Width = 75
+ Height = 25
+ Anchors = [akTop, akRight]
+ Caption = '&OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 2
+ end
+ object DetailsBtn: TButton
+ Left = 403
+ 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 = 472
+ 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.104/experts/debug/dialog/ExceptDlg.Delphi32.pas b/official/1.104/experts/debug/dialog/ExceptDlg.Delphi32.pas
new file mode 100644
index 0000000..62d25ce
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/ExceptDlg.Delphi32.pas
@@ -0,0 +1,762 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-24 22:40:10 +0200 (mer., 24 sept. 2008) $ }
+{ Revision: $Rev:: 2496 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit %MODULENAME%;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls, AppEvnts,
+ JclSysUtils,%if SendEMail JclMapi,%endif %if UnitVersioning JclUnitVersioning, JclUnitVersioningProviders,%endif JclDebug;
+
+const
+ UM_CREATEDETAILS = WM_USER + $100;
+
+type
+ T%FORMNAME% = class(%ANCESTORNAME%)
+%if SendEMail SendBtn: TButton;%endif
+ TextMemo: TMemo;
+ OkBtn: TButton;
+ DetailsBtn: TButton;
+ BevelDetails: TBevel;
+ DetailsMemo: TMemo;
+%if SendEMail procedure SendBtnClick(Sender: TObject);%endif
+ 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;
+ FThreadID: DWORD;
+%if ActiveControls FLastActiveControl: TWinControl;%endif
+ FNonDetailsHeight: Integer;
+ FFullHeight: Integer;
+%if LogFile FSimpleLog: TJclSimpleLog;
+ procedure ReportToLog;%endif
+ function GetReportAsText: string;
+ procedure SetDetailsVisible(const Value: Boolean);
+ procedure UMCreateDetails(var Message: TMessage); message UM_CREATEDETAILS;
+ protected
+ procedure AfterCreateDetails; dynamic;
+ procedure BeforeCreateDetails; dynamic;
+ procedure CreateDetails; dynamic;
+ procedure CreateReport;
+ function ReportMaxColumns: Integer; virtual;
+ function ReportNewBlockDelimiterChar: Char; virtual;
+ procedure NextDetailBlock;
+ procedure UpdateTextMemoScrollbars;
+ public
+ procedure CopyReportToClipboard;
+ class procedure ExceptionHandler(Sender: TObject; E: Exception);
+ class procedure ExceptionThreadHandler(Thread: TJclDebugThread);
+ class procedure ShowException(E: TObject; Thread: TJclDebugThread);
+ property DetailsVisible: Boolean read FDetailsVisible
+ write SetDetailsVisible;
+ property ReportAsText: string read GetReportAsText;
+%if LogFile property SimpleLog: TJclSimpleLog read FSimpleLog;%endif
+ end;
+
+ T%FORMNAME%Class = class of T%FORMNAME%;
+
+var
+ %FORMNAME%Class: T%FORMNAME%Class = T%FORMNAME%;
+
+implementation
+
+{$R *.dfm}
+
+uses
+ ClipBrd, Math,
+ JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclWin32;
+
+resourcestring
+ RsAppError = '%s - application error';
+ RsExceptionClass = 'Exception class: %s';
+ RsExceptionMessage = 'Exception message: %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';
+ RsMemory = 'Memory: %d; free %d';
+ RsScreenRes = 'Display : %dx%d pixels, %d bpp';
+ RsActiveControl = 'Active Controls hierarchy:';
+ RsThread = 'Thread: %s';
+ RsMissingVersionInfo = '(no module version info)';
+%if AllThreads RsMainThreadCallStack = 'Call stack for main thread';
+ RsThreadCallStack = 'Call stack for thread %s';%endif
+ RsErrorMessage = 'There was an error during the execution of this program.' + NativeLineBreak +
+ 'The application might become unstable and even useless.' + NativeLineBreak +
+ 'It''s recommended that you save your work and close this application.' + NativeLineBreak + NativeLineBreak;
+ RsDetailsIntro = 'Exception log with detailed tech info. Generated on %s.' + NativeLineBreak +
+ 'You may send it to the application vendor, helping him to understand what had happened.' + NativeLineBreak +
+ ' Application title: %s' + NativeLineBreak +
+ ' Application file: %s';
+%if UnitVersioning RsUnitVersioningIntro = 'Unit versioning information:';%endif
+
+var
+ %FORMNAME%: T%FORMNAME%;
+
+//============================================================================
+// Helper routines
+//============================================================================
+
+// SortModulesListByAddressCompare
+// sorts module by address
+function SortModulesListByAddressCompare(List: TStringList;
+ Index1, Index2: Integer): Integer;
+var
+ Addr1, Addr2: Cardinal;
+begin
+ Addr1 := Cardinal(List.Objects[Index1]);
+ Addr2 := Cardinal(List.Objects[Index2]);
+ if Addr1 > Addr2 then
+ Result := 1
+ else if Addr1 < Addr2 then
+ Result := -1
+ else
+ Result := 0;
+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
+ T%FORMNAME%.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;
+ WrittenBytes: Cardinal;
+
+ 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);
+ if Assigned(TApplicationHandleExceptionAddr) and Assigned(SysUtilsShowExceptionAddr) then
+ begin
+ Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
+ if Result then
+ begin
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
+ end;
+ end
+ else
+ Result := False;
+end;
+
+//============================================================================
+// Exception dialog with Send
+//============================================================================
+
+var
+ ExceptionShowing: Boolean;
+
+//=== { T%FORMNAME% } ===============================================
+
+procedure T%FORMNAME%.AfterCreateDetails;
+begin
+%if SendEMail SendBtn.Enabled := True;%endif
+end;
+
+//----------------------------------------------------------------------------
+
+procedure T%FORMNAME%.BeforeCreateDetails;
+begin
+%if SendEMail SendBtn.Enabled := False;%endif
+end;
+
+//----------------------------------------------------------------------------
+
+function T%FORMNAME%.ReportMaxColumns: Integer;
+begin
+ Result := 78;
+end;
+
+%if SendEMail//----------------------------------------------------------------------------
+
+procedure T%FORMNAME%.SendBtnClick(Sender: TObject);
+begin
+ with TJclEmail.Create do
+ try
+ ParentWnd := Application.Handle;
+ Recipients.Add(%StrValue EMailAddress);
+ Subject := %StrValue EMailSubject;
+ Body := AnsiString(ReportAsText);
+ SaveTaskWindows;
+ try
+ Send(True);
+ finally
+ RestoreTaskWindows;
+ end;
+ finally
+ Free;
+ end;
+end;
+%endif
+//----------------------------------------------------------------------------
+
+procedure T%FORMNAME%.CopyReportToClipboard;
+begin
+ ClipBoard.AsText := ReportAsText;
+end;
+
+//----------------------------------------------------------------------------
+
+procedure T%FORMNAME%.CreateDetails;
+begin
+ Screen.Cursor := crHourGlass;
+ DetailsMemo.Lines.BeginUpdate;
+ try
+ CreateReport;
+%if LogFile ReportToLog;%endif
+ 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 T%FORMNAME%.CreateReport;
+var
+%if ModuleList SL: TStringList;
+ I: Integer;
+ ModuleName: TFileName;
+ NtHeaders32: PImageNtHeaders32;
+ NtHeaders64: PImageNtHeaders64;
+ ModuleBase: Cardinal;
+ ImageBaseStr: string;%endif
+%if ActiveControls C: TWinControl;%endif
+%if OSInfo CpuInfo: TCpuInfo;
+ ProcessorDetails: string;%endif
+%if StackList StackList: TJclStackInfoList;
+%if AllThreads ThreadList: TJclDebugThreadList;
+ AThreadID: DWORD;%endif %endif
+ PETarget: TJclPeTarget;
+%if UnitVersioning UnitVersioning: TUnitVersioning;
+ UnitVersioningModule: TUnitVersioningModule;
+ UnitVersion: TUnitVersion;
+ ModuleIndex, UnitIndex: Integer;%endif
+begin
+ SL := TStringList.Create;
+ try
+%if StackList // Stack list
+ StackList := JclGetExceptStackList(FThreadID);
+ if Assigned(StackList) then
+ begin
+ DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)]));
+ StackList.AddToStrings(DetailsMemo.Lines, %BoolValue ModuleName, %BoolValue ModuleOffset, %BoolValue CodeDetails, %BoolValue VirtualAddress);
+ NextDetailBlock;
+ end;
+%if AllThreads // Main thread
+ if FThreadID <> MainThreadID then
+ begin
+ StackList := JclCreateThreadStackTraceFromID(%BoolValue RawData, MainThreadID);
+ if Assigned(StackList) then
+ begin
+ DetailsMemo.Lines.Add(RsMainThreadCallStack);
+ DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)]));
+ StackList.AddToStrings(DetailsMemo.Lines, %BoolValue ModuleName, %BoolValue ModuleOffset, %BoolValue CodeDetails, %BoolValue VirtualAddress);
+ NextDetailBlock;
+ end;
+ end;
+ // All threads
+ ThreadList := JclDebugThreadList;
+ ThreadList.Lock.Enter; // avoid modifications
+ try
+ for I := 0 to ThreadList.ThreadIDCount - 1 do
+ begin
+ AThreadID := ThreadList.ThreadIDs[I];
+ if (AThreadID <> FThreadID) then
+ begin
+ StackList := JclCreateThreadStackTrace(%BoolValue RawData, ThreadList.ThreadHandles[I]);
+ if Assigned(StackList) then
+ begin
+ DetailsMemo.Lines.Add(Format(RsThreadCallStack, [ThreadList.ThreadInfos[AThreadID]]));
+ DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)]));
+ StackList.AddToStrings(DetailsMemo.Lines, %BoolValue ModuleName, %BoolValue ModuleOffset, %BoolValue CodeDetails, %BoolValue VirtualAddress);
+ NextDetailBlock;
+ end;
+ end;
+ end;
+ finally
+ ThreadList.Lock.Leave;
+ end;
+%endif
+%endif
+
+%if OSInfo // System and OS information
+ DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString,
+ Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
+ GetCpuInfo(CpuInfo);
+ ProcessorDetails := Format(RsProcessor, [CpuInfo.Manufacturer, CpuInfo.CpuName,
+ RoundFrequency(CpuInfo.FrequencyInfo.NormFreq)]);
+ if not CpuInfo.IsFDIVOK then
+ ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
+ if CpuInfo.ExMMX then
+ ProcessorDetails := ProcessorDetails + ' MMXex';
+ if CpuInfo.MMX then
+ ProcessorDetails := ProcessorDetails + ' MMX';
+ if sse in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if sse2 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE2';
+ if sse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE3';
+ if ssse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSSE3';
+ if sse4A in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4A';
+ if sse4B in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4B';
+ if sse5 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if CpuInfo.Ex3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!ex';
+ if CpuInfo._3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!';
+ if CpuInfo.Is64Bits then
+ ProcessorDetails := ProcessorDetails + ' 64 bits';
+ if CpuInfo.DEPCapable then
+ ProcessorDetails := ProcessorDetails + ' DEP';
+ DetailsMemo.Lines.Add(ProcessorDetails);
+ DetailsMemo.Lines.Add(Format(RsMemory, [GetTotalPhysicalMemory div 1024 div 1024,
+ GetFreePhysicalMemory div 1024 div 1024]));
+ DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP]));
+ NextDetailBlock;
+%endif
+
+%if ModuleList // Modules list
+ if LoadedModulesList(SL, GetCurrentProcessId) then
+ begin
+%if UnitVersioning UnitVersioning := GetUnitVersioning;
+ UnitVersioning.RegisterProvider(TJclDefaultUnitVersioningProvider);%endif
+ 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]));
+ PETarget := PeMapImgTarget(Pointer(ModuleBase));
+ NtHeaders32 := nil;
+ NtHeaders64 := nil;
+ if PETarget = taWin32 then
+ NtHeaders32 := PeMapImgNtHeaders32(Pointer(ModuleBase))
+ else
+ if PETarget = taWin64 then
+ NtHeaders64 := PeMapImgNtHeaders64(Pointer(ModuleBase));
+ if (NtHeaders32 <> nil) and (NtHeaders32^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders32^.OptionalHeader.ImageBase])
+ else
+ if (NtHeaders64 <> nil) and (NtHeaders64^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders64^.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);
+%if UnitVersioning for ModuleIndex := 0 to UnitVersioning.ModuleCount - 1 do
+ begin
+ UnitVersioningModule := UnitVersioning.Modules[ModuleIndex];
+ if UnitVersioningModule.Instance = ModuleBase then
+ begin
+ if UnitVersioningModule.Count > 0 then
+ DetailsMemo.Lines.Add(StrRepeat(' ', 11) + RsUnitVersioningIntro);
+ for UnitIndex := 0 to UnitVersioningModule.Count - 1 do
+ begin
+ UnitVersion := UnitVersioningModule.Items[UnitIndex];
+ DetailsMemo.Lines.Add(Format('%s%s %s %s %s', [StrRepeat(' ', 13), UnitVersion.LogPath, UnitVersion.RCSfile, UnitVersion.Revision, UnitVersion.Date]));
+ end;
+ end;
+ end;%endif
+ end;
+ NextDetailBlock;
+ end;
+%endif
+
+%if ActiveControls // Active controls
+ if (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;
+%endif
+ finally
+ SL.Free;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.DetailsBtnClick(Sender: TObject);
+begin
+ DetailsVisible := not DetailsVisible;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+class procedure T%FORMNAME%.ExceptionHandler(Sender: TObject; E: Exception);
+begin
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, nil);
+ finally
+ ExceptionShowing := False;
+ end;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+class procedure T%FORMNAME%.ExceptionThreadHandler(Thread: TJclDebugThread);
+var
+ E: Exception;
+begin
+ E := Exception(Thread.SyncException);
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, Thread);
+ finally
+ ExceptionShowing := False;
+ end;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.FormCreate(Sender: TObject);
+begin
+%if LogFile FSimpleLog := TJclSimpleLog.Create(%StrValue LogFileName);%endif
+ FFullHeight := ClientHeight;
+ DetailsVisible := False;
+ Caption := Format(RsAppError, [Application.Title]);
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.FormDestroy(Sender: TObject);
+begin
+%if LogFile FreeAndNil(FSimpleLog);%endif
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.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 T%FORMNAME%.FormPaint(Sender: TObject);
+begin
+ DrawIcon(Canvas.Handle, TextMemo.Left - GetSystemMetrics(SM_CXICON) - 15,
+ TextMemo.Top, LoadIcon(0, IDI_ERROR));
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.FormResize(Sender: TObject);
+begin
+ UpdateTextMemoScrollbars;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.FormShow(Sender: TObject);
+begin
+ BeforeCreateDetails;
+ MessageBeep(MB_ICONERROR);
+ if (GetCurrentThreadId = MainThreadID) and (GetWindowThreadProcessId(Handle, nil) = MainThreadID) then
+ PostMessage(Handle, UM_CREATEDETAILS, 0, 0)
+ else
+ CreateReport;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+function T%FORMNAME%.GetReportAsText: string;
+begin
+ Result := StrEnsureSuffix(NativeCrLf, TextMemo.Text) + NativeCrLf + DetailsMemo.Text;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.NextDetailBlock;
+begin
+ DetailsMemo.Lines.Add(StrRepeat(ReportNewBlockDelimiterChar, ReportMaxColumns));
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+function T%FORMNAME%.ReportNewBlockDelimiterChar: Char;
+begin
+ Result := '-';
+end;
+
+%if LogFile//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.ReportToLog;
+begin
+ FSimpleLog.WriteStamp(ReportMaxColumns);
+ try
+ FSimpleLog.Write(ReportAsText);
+ finally
+ FSimpleLog.CloseLog;
+ end;
+end;
+%endif
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.SetDetailsVisible(const Value: Boolean);
+const
+ DirectionChars: array [0..1] of Char = ( '<', '>' );
+var
+ DetailsCaption: string;
+begin
+ FDetailsVisible := Value;
+ DetailsCaption := Trim(StrRemoveChars(DetailsBtn.Caption, DirectionChars));
+ 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 := BevelDetails.Top;
+ FNonDetailsHeight := Height;
+ end
+ else
+ Height := FNonDetailsHeight;
+ Constraints.MinHeight := FNonDetailsHeight;
+ Constraints.MaxHeight := FNonDetailsHeight
+ end;
+ DetailsBtn.Caption := DetailsCaption;
+ DetailsMemo.Enabled := Value;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+class procedure T%FORMNAME%.ShowException(E: TObject; Thread: TJclDebugThread);
+begin
+ if %FORMNAME% = nil then
+ %FORMNAME% := %FORMNAME%Class.Create(Application);
+ try
+ with %FORMNAME% do
+ begin
+ if Assigned(Thread) then
+ FThreadID := Thread.ThreadID
+ else
+ FThreadID := MainThreadID;
+%if ActiveControls FLastActiveControl := Screen.ActiveControl;%endif
+ if E is Exception then
+ TextMemo.Text := RsErrorMessage + AdjustLineBreaks(StrEnsureSuffix('.', Exception(E).Message))
+ else
+ TextMemo.Text := RsErrorMessage + AdjustLineBreaks(StrEnsureSuffix('.', E.ClassName));
+ UpdateTextMemoScrollbars;
+ NextDetailBlock;
+ //Arioch: some header for possible saving to txt-file/e-mail/clipboard/NTEvent...
+ DetailsMemo.Lines.Add(Format(RsDetailsIntro, [DateTimeToStr(Now), Application.Title, Application.ExeName]));
+ NextDetailBlock;
+ DetailsMemo.Lines.Add(Format(RsExceptionClass, [E.ClassName]));
+ if E is Exception then
+ DetailsMemo.Lines.Add(Format(RsExceptionMessage, [StrEnsureSuffix('.', Exception(E).Message)]));
+ if Thread = nil then
+ DetailsMemo.Lines.Add(Format(RsExceptionAddr, [ExceptAddr]))
+ else
+ DetailsMemo.Lines.Add(Format(RsThread, [Thread.ThreadInfo]));
+ NextDetailBlock;
+ ShowModal;
+ end;
+ finally
+ FreeAndNil(%FORMNAME%);
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.UMCreateDetails(var Message: TMessage);
+begin
+ Update;
+ CreateDetails;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure T%FORMNAME%.UpdateTextMemoScrollbars;
+begin
+%if AutoScrollBars Canvas.Font := TextMemo.Font;
+ if TextMemo.Lines.Count * Canvas.TextHeight('Wg') > TextMemo.ClientHeight then
+ TextMemo.ScrollBars := ssVertical
+ else
+ TextMemo.ScrollBars := ssNone;%endif
+end;
+
+//==================================================================================================
+// Exception handler initialization code
+//==================================================================================================
+
+var
+ AppEvents: TApplicationEvents = nil;
+
+procedure InitializeHandler;
+begin
+ if AppEvents = nil then
+ begin
+ AppEvents := TApplicationEvents.Create(nil);
+ AppEvents.OnException := T%FORMNAME%.ExceptionHandler;
+%repeatline IgnoredExceptionsCount AddIgnoredException(%IgnoredExceptions);
+%if TraceEAbort RemoveIgnoredException(EAbort);%endif
+%if TraceAllExceptions JclStackTrackingOptions := JclStackTrackingOptions + [stTraceAllExceptions];%endif
+%if RawData JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];%endif
+%if HookDll JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];%endif
+%if DelayedTrace JclStackTrackingOptions := JclStackTrackingOptions + [stDelayedTrace];%endif
+ JclDebugThreadList.OnSyncException := T%FORMNAME%.ExceptionThreadHandler;
+ JclStartExceptionTracking;
+%if HookDll if HookTApplicationHandleException then
+ JclTrackExceptionsFromLibraries;%endif
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure UnInitializeHandler;
+begin
+ if AppEvents <> nil then
+ begin
+ FreeAndNil(AppEvents);
+ JclDebugThreadList.OnSyncException := nil;
+ JclUnhookExceptions;
+ JclStopExceptionTracking;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+initialization
+ InitializeHandler;
+
+finalization
+ UnInitializeHandler;
+
+end.
diff --git a/official/1.104/experts/debug/dialog/ExceptDlg.dfm b/official/1.104/experts/debug/dialog/ExceptDlg.dfm
new file mode 100644
index 0000000..1a89890
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/ExceptDlg.dfm
@@ -0,0 +1,95 @@
+object ExceptionDialog: TExceptionDialog
+ Left = 310
+ Top = 255
+ AutoScroll = False
+ BorderIcons = [biSystemMenu]
+
+ Caption = 'ExceptionDialog'
+ ClientHeight = 255
+ ClientWidth = 483
+ 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 BevelDetails: TBevel
+ Left = 3
+ Top = 91
+ Width = 473
+ Height = 9
+ Anchors = [akLeft, akTop, akRight]
+ Shape = bsTopLine
+ end
+
+ object TextMemo: TMemo
+ Left = 56
+ Top = 8
+ Width = 332
+ Height = 75
+ Hint = 'Use Ctrl+C to copy the report to the clipboard'
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Ctl3D = True
+ ParentColor = True
+ ParentCtl3D = False
+ ReadOnly = True
+ TabOrder = 1
+ WantReturns = False
+ end
+ object OkBtn: TButton
+ Left = 403
+ Top = 4
+ Width = 75
+ Height = 25
+ Anchors = [akTop, akRight]
+ Caption = '&OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 2
+ end
+ object DetailsBtn: TButton
+ Left = 403
+ 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 = 472
+ 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.104/experts/debug/dialog/ExceptDlg.ico b/official/1.104/experts/debug/dialog/ExceptDlg.ico
new file mode 100644
index 0000000..2fd6f72
Binary files /dev/null and b/official/1.104/experts/debug/dialog/ExceptDlg.ico differ
diff --git a/official/1.104/experts/debug/dialog/ExceptDlg.pas b/official/1.104/experts/debug/dialog/ExceptDlg.pas
new file mode 100644
index 0000000..c65d603
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/ExceptDlg.pas
@@ -0,0 +1,706 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-11-01 23:11:22 +0100 (sam., 01 nov. 2008) $ }
+{ Revision: $Rev:: 2548 $ }
+{ Author: $Author:: ahuser $ }
+{ }
+{**************************************************************************************************}
+
+unit ExceptDlg;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls, AppEvnts,
+ JclSysUtils, JclUnitVersioning, JclUnitVersioningProviders, JclDebug;
+
+const
+ UM_CREATEDETAILS = WM_USER + $100;
+
+type
+ TExceptionDialog = class(TForm)
+
+ TextMemo: TMemo;
+ OkBtn: TButton;
+ DetailsBtn: TButton;
+ BevelDetails: TBevel;
+ DetailsMemo: 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
+ private
+ FDetailsVisible: Boolean;
+ FThreadID: DWORD;
+ FLastActiveControl: TWinControl;
+ FNonDetailsHeight: Integer;
+ FFullHeight: Integer;
+ FSimpleLog: TJclSimpleLog;
+ procedure ReportToLog;
+ function GetReportAsText: string;
+ procedure SetDetailsVisible(const Value: Boolean);
+ procedure UMCreateDetails(var Message: TMessage); message UM_CREATEDETAILS;
+ protected
+ procedure AfterCreateDetails; dynamic;
+ procedure BeforeCreateDetails; dynamic;
+ procedure CreateDetails; dynamic;
+ procedure CreateReport;
+ function ReportMaxColumns: Integer; virtual;
+ function ReportNewBlockDelimiterChar: Char; virtual;
+ procedure NextDetailBlock;
+ procedure UpdateTextMemoScrollbars;
+ public
+ procedure CopyReportToClipboard;
+ class procedure ExceptionHandler(Sender: TObject; E: Exception);
+ class procedure ExceptionThreadHandler(Thread: TJclDebugThread);
+ class procedure ShowException(E: TObject; Thread: TJclDebugThread);
+ property DetailsVisible: Boolean read FDetailsVisible
+ write SetDetailsVisible;
+ property ReportAsText: string read GetReportAsText;
+ property SimpleLog: TJclSimpleLog read FSimpleLog;
+ end;
+
+ TExceptionDialogClass = class of TExceptionDialog;
+
+var
+ ExceptionDialogClass: TExceptionDialogClass = TExceptionDialog;
+
+implementation
+
+{$R *.dfm}
+
+uses
+ ClipBrd, Math,
+ JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclWin32;
+
+resourcestring
+ RsAppError = '%s - application error';
+ RsExceptionClass = 'Exception class: %s';
+ RsExceptionMessage = 'Exception message: %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';
+ RsMemory = 'Memory: %d; free %d';
+ RsScreenRes = 'Display : %dx%d pixels, %d bpp';
+ RsActiveControl = 'Active Controls hierarchy:';
+ RsThread = 'Thread: %s';
+ RsMissingVersionInfo = '(no module version info)';
+
+ RsErrorMessage = 'There was an error during the execution of this program.' + NativeLineBreak +
+ 'The application might become unstable and even useless.' + NativeLineBreak +
+ 'It''s recommended that you save your work and close this application.' + NativeLineBreak + NativeLineBreak;
+ RsDetailsIntro = 'Exception log with detailed tech info. Generated on %s.' + NativeLineBreak +
+ 'You may send it to the application vendor, helping him to understand what had happened.' + NativeLineBreak +
+ ' Application title: %s' + NativeLineBreak +
+ ' Application file: %s';
+ RsUnitVersioningIntro = 'Unit versioning information:';
+
+var
+ ExceptionDialog: TExceptionDialog;
+
+//============================================================================
+// Helper routines
+//============================================================================
+
+// SortModulesListByAddressCompare
+// sorts module by address
+function SortModulesListByAddressCompare(List: TStringList;
+ Index1, Index2: Integer): Integer;
+var
+ Addr1, Addr2: Cardinal;
+begin
+ Addr1 := Cardinal(List.Objects[Index1]);
+ Addr2 := Cardinal(List.Objects[Index2]);
+ if Addr1 > Addr2 then
+ Result := 1
+ else if Addr1 < Addr2 then
+ Result := -1
+ else
+ Result := 0;
+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;
+ WrittenBytes: Cardinal;
+
+ 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);
+ if Assigned(TApplicationHandleExceptionAddr) and Assigned(SysUtilsShowExceptionAddr) then
+ begin
+ Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
+ if Result then
+ begin
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
+ end;
+ end
+ else
+ Result := False;
+end;
+
+//============================================================================
+// Exception dialog with Send
+//============================================================================
+
+var
+ ExceptionShowing: Boolean;
+
+//=== { TExceptionDialog } ===============================================
+
+procedure TExceptionDialog.AfterCreateDetails;
+begin
+
+end;
+
+//----------------------------------------------------------------------------
+
+procedure TExceptionDialog.BeforeCreateDetails;
+begin
+
+end;
+
+//----------------------------------------------------------------------------
+
+function TExceptionDialog.ReportMaxColumns: Integer;
+begin
+ Result := 78;
+end;
+
+
+//----------------------------------------------------------------------------
+
+procedure TExceptionDialog.CopyReportToClipboard;
+begin
+ ClipBoard.AsText := ReportAsText;
+end;
+
+//----------------------------------------------------------------------------
+
+procedure TExceptionDialog.CreateDetails;
+begin
+ Screen.Cursor := crHourGlass;
+ DetailsMemo.Lines.BeginUpdate;
+ try
+ CreateReport;
+ 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;
+var
+ SL: TStringList;
+ I: Integer;
+ ModuleName: TFileName;
+ NtHeaders32: PImageNtHeaders32;
+ NtHeaders64: PImageNtHeaders64;
+ ModuleBase: Cardinal;
+ ImageBaseStr: string;
+ C: TWinControl;
+ CpuInfo: TCpuInfo;
+ ProcessorDetails: string;
+ StackList: TJclStackInfoList;
+
+ PETarget: TJclPeTarget;
+ UnitVersioning: TUnitVersioning;
+ UnitVersioningModule: TUnitVersioningModule;
+ UnitVersion: TUnitVersion;
+ ModuleIndex, UnitIndex: Integer;
+begin
+ SL := TStringList.Create;
+ try
+ // Stack list
+ StackList := JclGetExceptStackList(FThreadID);
+ if Assigned(StackList) then
+ begin
+ DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)]));
+ StackList.AddToStrings(DetailsMemo.Lines, True, True, True, True);
+ NextDetailBlock;
+ end;
+
+
+
+ // System and OS information
+ DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString,
+ Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
+ GetCpuInfo(CpuInfo);
+ ProcessorDetails := Format(RsProcessor, [CpuInfo.Manufacturer, CpuInfo.CpuName,
+ RoundFrequency(CpuInfo.FrequencyInfo.NormFreq)]);
+ if not CpuInfo.IsFDIVOK then
+ ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
+ if CpuInfo.ExMMX then
+ ProcessorDetails := ProcessorDetails + ' MMXex';
+ if CpuInfo.MMX then
+ ProcessorDetails := ProcessorDetails + ' MMX';
+ if sse in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if sse2 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE2';
+ if sse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE3';
+ if ssse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSSE3';
+ if sse4A in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4A';
+ if sse4B in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4B';
+ if sse5 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if CpuInfo.Ex3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!ex';
+ if CpuInfo._3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!';
+ if CpuInfo.Is64Bits then
+ ProcessorDetails := ProcessorDetails + ' 64 bits';
+ if CpuInfo.DEPCapable then
+ ProcessorDetails := ProcessorDetails + ' DEP';
+ DetailsMemo.Lines.Add(ProcessorDetails);
+ DetailsMemo.Lines.Add(Format(RsMemory, [GetTotalPhysicalMemory div 1024 div 1024,
+ GetFreePhysicalMemory div 1024 div 1024]));
+ DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP]));
+ NextDetailBlock;
+
+
+ // Modules list
+ if LoadedModulesList(SL, GetCurrentProcessId) then
+ begin
+ UnitVersioning := GetUnitVersioning;
+ UnitVersioning.RegisterProvider(TJclDefaultUnitVersioningProvider);
+ 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]));
+ PETarget := PeMapImgTarget(Pointer(ModuleBase));
+ NtHeaders32 := nil;
+ NtHeaders64 := nil;
+ if PETarget = taWin32 then
+ NtHeaders32 := PeMapImgNtHeaders32(Pointer(ModuleBase))
+ else
+ if PETarget = taWin64 then
+ NtHeaders64 := PeMapImgNtHeaders64(Pointer(ModuleBase));
+ if (NtHeaders32 <> nil) and (NtHeaders32^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders32^.OptionalHeader.ImageBase])
+ else
+ if (NtHeaders64 <> nil) and (NtHeaders64^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders64^.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);
+ for ModuleIndex := 0 to UnitVersioning.ModuleCount - 1 do
+ begin
+ UnitVersioningModule := UnitVersioning.Modules[ModuleIndex];
+ if UnitVersioningModule.Instance = ModuleBase then
+ begin
+ if UnitVersioningModule.Count > 0 then
+ DetailsMemo.Lines.Add(StrRepeat(' ', 11) + RsUnitVersioningIntro);
+ for UnitIndex := 0 to UnitVersioningModule.Count - 1 do
+ begin
+ UnitVersion := UnitVersioningModule.Items[UnitIndex];
+ DetailsMemo.Lines.Add(Format('%s%s %s %s %s', [StrRepeat(' ', 13), UnitVersion.LogPath, UnitVersion.RCSfile, UnitVersion.Revision, UnitVersion.Date]));
+ end;
+ end;
+ end;
+ end;
+ NextDetailBlock;
+ end;
+
+
+ // Active controls
+ if (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 Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, nil);
+ finally
+ ExceptionShowing := False;
+ end;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+class procedure TExceptionDialog.ExceptionThreadHandler(Thread: TJclDebugThread);
+var
+ E: Exception;
+begin
+ E := Exception(Thread.SyncException);
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, Thread);
+ finally
+ ExceptionShowing := False;
+ end;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialog.FormCreate(Sender: TObject);
+begin
+ FSimpleLog := TJclSimpleLog.Create('filename.log');
+ 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, TextMemo.Left - GetSystemMetrics(SM_CXICON) - 15,
+ TextMemo.Top, LoadIcon(0, IDI_ERROR));
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialog.FormResize(Sender: TObject);
+begin
+ UpdateTextMemoScrollbars;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialog.FormShow(Sender: TObject);
+begin
+ BeforeCreateDetails;
+ MessageBeep(MB_ICONERROR);
+ if (GetCurrentThreadId = MainThreadID) and (GetWindowThreadProcessId(Handle, nil) = MainThreadID) then
+ PostMessage(Handle, UM_CREATEDETAILS, 0, 0)
+ else
+ CreateReport;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+function TExceptionDialog.GetReportAsText: string;
+begin
+ Result := StrEnsureSuffix(NativeCrLf, TextMemo.Text) + NativeCrLf + DetailsMemo.Text;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialog.NextDetailBlock;
+begin
+ DetailsMemo.Lines.Add(StrRepeat(ReportNewBlockDelimiterChar, ReportMaxColumns));
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+function TExceptionDialog.ReportNewBlockDelimiterChar: Char;
+begin
+ Result := '-';
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialog.ReportToLog;
+begin
+ FSimpleLog.WriteStamp(ReportMaxColumns);
+ try
+ FSimpleLog.Write(ReportAsText);
+ finally
+ FSimpleLog.CloseLog;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialog.SetDetailsVisible(const Value: Boolean);
+const
+ DirectionChars: array [0..1] of Char = ( '<', '>' );
+var
+ DetailsCaption: string;
+begin
+ FDetailsVisible := Value;
+ DetailsCaption := Trim(StrRemoveChars(DetailsBtn.Caption, DirectionChars));
+ 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 := BevelDetails.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: TObject; Thread: TJclDebugThread);
+begin
+ if ExceptionDialog = nil then
+ ExceptionDialog := ExceptionDialogClass.Create(Application);
+ try
+ with ExceptionDialog do
+ begin
+ if Assigned(Thread) then
+ FThreadID := Thread.ThreadID
+ else
+ FThreadID := MainThreadID;
+ FLastActiveControl := Screen.ActiveControl;
+ if E is Exception then
+ TextMemo.Text := RsErrorMessage + AdjustLineBreaks(StrEnsureSuffix('.', Exception(E).Message))
+ else
+ TextMemo.Text := RsErrorMessage + AdjustLineBreaks(StrEnsureSuffix('.', E.ClassName));
+ UpdateTextMemoScrollbars;
+ NextDetailBlock;
+ //Arioch: some header for possible saving to txt-file/e-mail/clipboard/NTEvent...
+ DetailsMemo.Lines.Add(Format(RsDetailsIntro, [DateTimeToStr(Now), Application.Title, Application.ExeName]));
+ NextDetailBlock;
+ DetailsMemo.Lines.Add(Format(RsExceptionClass, [E.ClassName]));
+ if E is Exception then
+ DetailsMemo.Lines.Add(Format(RsExceptionMessage, [StrEnsureSuffix('.', Exception(E).Message)]));
+ 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.UpdateTextMemoScrollbars;
+begin
+ Canvas.Font := TextMemo.Font;
+ if TextMemo.Lines.Count * Canvas.TextHeight('Wg') > TextMemo.ClientHeight then
+ TextMemo.ScrollBars := ssVertical
+ else
+ TextMemo.ScrollBars := ssNone;
+end;
+
+//==================================================================================================
+// Exception handler initialization code
+//==================================================================================================
+
+var
+ AppEvents: TApplicationEvents = nil;
+
+procedure InitializeHandler;
+begin
+ if AppEvents = nil then
+ begin
+ AppEvents := TApplicationEvents.Create(nil);
+ AppEvents.OnException := TExceptionDialog.ExceptionHandler;
+
+
+
+ JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];
+ JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];
+ JclStackTrackingOptions := JclStackTrackingOptions + [stDelayedTrace];
+ JclDebugThreadList.OnSyncException := TExceptionDialog.ExceptionThreadHandler;
+ JclStartExceptionTracking;
+ if HookTApplicationHandleException then
+ JclTrackExceptionsFromLibraries;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure UnInitializeHandler;
+begin
+ if AppEvents <> nil then
+ begin
+ FreeAndNil(AppEvents);
+ JclDebugThreadList.OnSyncException := nil;
+ JclUnhookExceptions;
+ JclStopExceptionTracking;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+initialization
+ InitializeHandler;
+
+finalization
+ UnInitializeHandler;
+
+end.
diff --git a/official/1.104/experts/debug/dialog/ExceptDlgCpp.ico b/official/1.104/experts/debug/dialog/ExceptDlgCpp.ico
new file mode 100644
index 0000000..151d927
Binary files /dev/null and b/official/1.104/experts/debug/dialog/ExceptDlgCpp.ico differ
diff --git a/official/1.104/experts/debug/dialog/ExceptDlgMail.dfm b/official/1.104/experts/debug/dialog/ExceptDlgMail.dfm
new file mode 100644
index 0000000..555e7e8
--- /dev/null
+++ b/official/1.104/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 = 483
+ 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 BevelDetails: TBevel
+ Left = 3
+ Top = 91
+ Width = 473
+ Height = 9
+ Anchors = [akLeft, akTop, akRight]
+ Shape = bsTopLine
+ end
+
+ object SendBtn: TButton
+ Left = 403
+ 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 TextMemo: TMemo
+ Left = 56
+ Top = 8
+ Width = 332
+ Height = 75
+ Hint = 'Use Ctrl+C to copy the report to the clipboard'
+ Anchors = [akLeft, akTop, akRight]
+ BorderStyle = bsNone
+ Ctl3D = True
+ ParentColor = True
+ ParentCtl3D = False
+ ReadOnly = True
+ TabOrder = 1
+ WantReturns = False
+ end
+ object OkBtn: TButton
+ Left = 403
+ Top = 4
+ Width = 75
+ Height = 25
+ Anchors = [akTop, akRight]
+ Caption = '&OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 2
+ end
+ object DetailsBtn: TButton
+ Left = 403
+ 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 = 472
+ 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.104/experts/debug/dialog/ExceptDlgMail.ico b/official/1.104/experts/debug/dialog/ExceptDlgMail.ico
new file mode 100644
index 0000000..f2ed1d3
Binary files /dev/null and b/official/1.104/experts/debug/dialog/ExceptDlgMail.ico differ
diff --git a/official/1.104/experts/debug/dialog/ExceptDlgMail.pas b/official/1.104/experts/debug/dialog/ExceptDlgMail.pas
new file mode 100644
index 0000000..22c8869
--- /dev/null
+++ b/official/1.104/experts/debug/dialog/ExceptDlgMail.pas
@@ -0,0 +1,726 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-11-01 23:11:22 +0100 (sam., 01 nov. 2008) $ }
+{ Revision: $Rev:: 2548 $ }
+{ Author: $Author:: ahuser $ }
+{ }
+{**************************************************************************************************}
+
+unit ExceptDlgMail;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls, AppEvnts,
+ JclSysUtils, JclMapi, JclUnitVersioning, JclUnitVersioningProviders, JclDebug;
+
+const
+ UM_CREATEDETAILS = WM_USER + $100;
+
+type
+ TExceptionDialogMail = class(TForm)
+ SendBtn: TButton;
+ TextMemo: TMemo;
+ OkBtn: TButton;
+ DetailsBtn: TButton;
+ BevelDetails: 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;
+ FThreadID: DWORD;
+ FLastActiveControl: TWinControl;
+ FNonDetailsHeight: Integer;
+ FFullHeight: Integer;
+ FSimpleLog: TJclSimpleLog;
+ procedure ReportToLog;
+ function GetReportAsText: string;
+ procedure SetDetailsVisible(const Value: Boolean);
+ procedure UMCreateDetails(var Message: TMessage); message UM_CREATEDETAILS;
+ protected
+ procedure AfterCreateDetails; dynamic;
+ procedure BeforeCreateDetails; dynamic;
+ procedure CreateDetails; dynamic;
+ procedure CreateReport;
+ function ReportMaxColumns: Integer; virtual;
+ function ReportNewBlockDelimiterChar: Char; virtual;
+ procedure NextDetailBlock;
+ procedure UpdateTextMemoScrollbars;
+ public
+ procedure CopyReportToClipboard;
+ class procedure ExceptionHandler(Sender: TObject; E: Exception);
+ class procedure ExceptionThreadHandler(Thread: TJclDebugThread);
+ class procedure ShowException(E: TObject; Thread: TJclDebugThread);
+ property DetailsVisible: Boolean read FDetailsVisible
+ write SetDetailsVisible;
+ property ReportAsText: string read GetReportAsText;
+ property SimpleLog: TJclSimpleLog read FSimpleLog;
+ end;
+
+ TExceptionDialogMailClass = class of TExceptionDialogMail;
+
+var
+ ExceptionDialogMailClass: TExceptionDialogMailClass = TExceptionDialogMail;
+
+implementation
+
+{$R *.dfm}
+
+uses
+ ClipBrd, Math,
+ JclBase, JclFileUtils, JclHookExcept, JclPeImage, JclStrings, JclSysInfo, JclWin32;
+
+resourcestring
+ RsAppError = '%s - application error';
+ RsExceptionClass = 'Exception class: %s';
+ RsExceptionMessage = 'Exception message: %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';
+ RsMemory = 'Memory: %d; free %d';
+ RsScreenRes = 'Display : %dx%d pixels, %d bpp';
+ RsActiveControl = 'Active Controls hierarchy:';
+ RsThread = 'Thread: %s';
+ RsMissingVersionInfo = '(no module version info)';
+
+ RsErrorMessage = 'There was an error during the execution of this program.' + NativeLineBreak +
+ 'The application might become unstable and even useless.' + NativeLineBreak +
+ 'It''s recommended that you save your work and close this application.' + NativeLineBreak + NativeLineBreak;
+ RsDetailsIntro = 'Exception log with detailed tech info. Generated on %s.' + NativeLineBreak +
+ 'You may send it to the application vendor, helping him to understand what had happened.' + NativeLineBreak +
+ ' Application title: %s' + NativeLineBreak +
+ ' Application file: %s';
+ RsUnitVersioningIntro = 'Unit versioning information:';
+
+var
+ ExceptionDialogMail: TExceptionDialogMail;
+
+//============================================================================
+// Helper routines
+//============================================================================
+
+// SortModulesListByAddressCompare
+// sorts module by address
+function SortModulesListByAddressCompare(List: TStringList;
+ Index1, Index2: Integer): Integer;
+var
+ Addr1, Addr2: Cardinal;
+begin
+ Addr1 := Cardinal(List.Objects[Index1]);
+ Addr2 := Cardinal(List.Objects[Index2]);
+ if Addr1 > Addr2 then
+ Result := 1
+ else if Addr1 < Addr2 then
+ Result := -1
+ else
+ Result := 0;
+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;
+ WrittenBytes: Cardinal;
+
+ 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);
+ if Assigned(TApplicationHandleExceptionAddr) and Assigned(SysUtilsShowExceptionAddr) then
+ begin
+ Result := CheckAddressForOffset(CallOffset) or CheckAddressForOffset(CallOffsetDebug);
+ if Result then
+ begin
+ CALLInstruction.Address := Integer(@HookShowException) - Integer(CallAddress) - SizeOf(CALLInstruction);
+ Result := WriteProtectedMemory(CallAddress, @CallInstruction, SizeOf(CallInstruction), WrittenBytes);
+ end;
+ end
+ else
+ Result := False;
+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('name@domain.ext');
+ Subject := 'email subject';
+ Body := AnsiString(ReportAsText);
+ SaveTaskWindows;
+ try
+ Send(True);
+ finally
+ RestoreTaskWindows;
+ end;
+ finally
+ Free;
+ end;
+end;
+
+//----------------------------------------------------------------------------
+
+procedure TExceptionDialogMail.CopyReportToClipboard;
+begin
+ ClipBoard.AsText := ReportAsText;
+end;
+
+//----------------------------------------------------------------------------
+
+procedure TExceptionDialogMail.CreateDetails;
+begin
+ Screen.Cursor := crHourGlass;
+ DetailsMemo.Lines.BeginUpdate;
+ try
+ CreateReport;
+ 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;
+var
+ SL: TStringList;
+ I: Integer;
+ ModuleName: TFileName;
+ NtHeaders32: PImageNtHeaders32;
+ NtHeaders64: PImageNtHeaders64;
+ ModuleBase: Cardinal;
+ ImageBaseStr: string;
+ C: TWinControl;
+ CpuInfo: TCpuInfo;
+ ProcessorDetails: string;
+ StackList: TJclStackInfoList;
+
+ PETarget: TJclPeTarget;
+ UnitVersioning: TUnitVersioning;
+ UnitVersioningModule: TUnitVersioningModule;
+ UnitVersion: TUnitVersion;
+ ModuleIndex, UnitIndex: Integer;
+begin
+ SL := TStringList.Create;
+ try
+ // Stack list
+ StackList := JclGetExceptStackList(FThreadID);
+ if Assigned(StackList) then
+ begin
+ DetailsMemo.Lines.Add(Format(RsStackList, [DateTimeToStr(StackList.TimeStamp)]));
+ StackList.AddToStrings(DetailsMemo.Lines, True, True, True, True);
+ NextDetailBlock;
+ end;
+
+
+
+ // System and OS information
+ DetailsMemo.Lines.Add(Format(RsOSVersion, [GetWindowsVersionString, NtProductTypeString,
+ Win32MajorVersion, Win32MinorVersion, Win32BuildNumber, Win32CSDVersion]));
+ GetCpuInfo(CpuInfo);
+ ProcessorDetails := Format(RsProcessor, [CpuInfo.Manufacturer, CpuInfo.CpuName,
+ RoundFrequency(CpuInfo.FrequencyInfo.NormFreq)]);
+ if not CpuInfo.IsFDIVOK then
+ ProcessorDetails := ProcessorDetails + ' [FDIV Bug]';
+ if CpuInfo.ExMMX then
+ ProcessorDetails := ProcessorDetails + ' MMXex';
+ if CpuInfo.MMX then
+ ProcessorDetails := ProcessorDetails + ' MMX';
+ if sse in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if sse2 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE2';
+ if sse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE3';
+ if ssse3 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSSE3';
+ if sse4A in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4A';
+ if sse4B in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE4B';
+ if sse5 in CpuInfo.SSE then
+ ProcessorDetails := ProcessorDetails + ' SSE';
+ if CpuInfo.Ex3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!ex';
+ if CpuInfo._3DNow then
+ ProcessorDetails := ProcessorDetails + ' 3DNow!';
+ if CpuInfo.Is64Bits then
+ ProcessorDetails := ProcessorDetails + ' 64 bits';
+ if CpuInfo.DEPCapable then
+ ProcessorDetails := ProcessorDetails + ' DEP';
+ DetailsMemo.Lines.Add(ProcessorDetails);
+ DetailsMemo.Lines.Add(Format(RsMemory, [GetTotalPhysicalMemory div 1024 div 1024,
+ GetFreePhysicalMemory div 1024 div 1024]));
+ DetailsMemo.Lines.Add(Format(RsScreenRes, [Screen.Width, Screen.Height, GetBPP]));
+ NextDetailBlock;
+
+
+ // Modules list
+ if LoadedModulesList(SL, GetCurrentProcessId) then
+ begin
+ UnitVersioning := GetUnitVersioning;
+ UnitVersioning.RegisterProvider(TJclDefaultUnitVersioningProvider);
+ 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]));
+ PETarget := PeMapImgTarget(Pointer(ModuleBase));
+ NtHeaders32 := nil;
+ NtHeaders64 := nil;
+ if PETarget = taWin32 then
+ NtHeaders32 := PeMapImgNtHeaders32(Pointer(ModuleBase))
+ else
+ if PETarget = taWin64 then
+ NtHeaders64 := PeMapImgNtHeaders64(Pointer(ModuleBase));
+ if (NtHeaders32 <> nil) and (NtHeaders32^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders32^.OptionalHeader.ImageBase])
+ else
+ if (NtHeaders64 <> nil) and (NtHeaders64^.OptionalHeader.ImageBase <> ModuleBase) then
+ ImageBaseStr := Format('<%.8x> ', [NtHeaders64^.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);
+ for ModuleIndex := 0 to UnitVersioning.ModuleCount - 1 do
+ begin
+ UnitVersioningModule := UnitVersioning.Modules[ModuleIndex];
+ if UnitVersioningModule.Instance = ModuleBase then
+ begin
+ if UnitVersioningModule.Count > 0 then
+ DetailsMemo.Lines.Add(StrRepeat(' ', 11) + RsUnitVersioningIntro);
+ for UnitIndex := 0 to UnitVersioningModule.Count - 1 do
+ begin
+ UnitVersion := UnitVersioningModule.Items[UnitIndex];
+ DetailsMemo.Lines.Add(Format('%s%s %s %s %s', [StrRepeat(' ', 13), UnitVersion.LogPath, UnitVersion.RCSfile, UnitVersion.Revision, UnitVersion.Date]));
+ end;
+ end;
+ end;
+ end;
+ NextDetailBlock;
+ end;
+
+
+ // Active controls
+ if (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 Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, nil);
+ finally
+ ExceptionShowing := False;
+ end;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+class procedure TExceptionDialogMail.ExceptionThreadHandler(Thread: TJclDebugThread);
+var
+ E: Exception;
+begin
+ E := Exception(Thread.SyncException);
+ if Assigned(E) then
+ if ExceptionShowing then
+ Application.ShowException(E)
+ else
+ begin
+ ExceptionShowing := True;
+ try
+ if IsIgnoredException(E.ClassType) then
+ Application.ShowException(E)
+ else
+ ShowException(E, Thread);
+ finally
+ ExceptionShowing := False;
+ end;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialogMail.FormCreate(Sender: TObject);
+begin
+ FSimpleLog := TJclSimpleLog.Create('filename.log');
+ 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, TextMemo.Left - GetSystemMetrics(SM_CXICON) - 15,
+ TextMemo.Top, LoadIcon(0, IDI_ERROR));
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialogMail.FormResize(Sender: TObject);
+begin
+ UpdateTextMemoScrollbars;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialogMail.FormShow(Sender: TObject);
+begin
+ BeforeCreateDetails;
+ MessageBeep(MB_ICONERROR);
+ if (GetCurrentThreadId = MainThreadID) and (GetWindowThreadProcessId(Handle, nil) = MainThreadID) then
+ PostMessage(Handle, UM_CREATEDETAILS, 0, 0)
+ else
+ CreateReport;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+function TExceptionDialogMail.GetReportAsText: string;
+begin
+ Result := StrEnsureSuffix(NativeCrLf, TextMemo.Text) + NativeCrLf + 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
+ FSimpleLog.WriteStamp(ReportMaxColumns);
+ try
+ FSimpleLog.Write(ReportAsText);
+ finally
+ FSimpleLog.CloseLog;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure TExceptionDialogMail.SetDetailsVisible(const Value: Boolean);
+const
+ DirectionChars: array [0..1] of Char = ( '<', '>' );
+var
+ DetailsCaption: string;
+begin
+ FDetailsVisible := Value;
+ DetailsCaption := Trim(StrRemoveChars(DetailsBtn.Caption, DirectionChars));
+ 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 := BevelDetails.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: TObject; Thread: TJclDebugThread);
+begin
+ if ExceptionDialogMail = nil then
+ ExceptionDialogMail := ExceptionDialogMailClass.Create(Application);
+ try
+ with ExceptionDialogMail do
+ begin
+ if Assigned(Thread) then
+ FThreadID := Thread.ThreadID
+ else
+ FThreadID := MainThreadID;
+ FLastActiveControl := Screen.ActiveControl;
+ if E is Exception then
+ TextMemo.Text := RsErrorMessage + AdjustLineBreaks(StrEnsureSuffix('.', Exception(E).Message))
+ else
+ TextMemo.Text := RsErrorMessage + AdjustLineBreaks(StrEnsureSuffix('.', E.ClassName));
+ UpdateTextMemoScrollbars;
+ NextDetailBlock;
+ //Arioch: some header for possible saving to txt-file/e-mail/clipboard/NTEvent...
+ DetailsMemo.Lines.Add(Format(RsDetailsIntro, [DateTimeToStr(Now), Application.Title, Application.ExeName]));
+ NextDetailBlock;
+ DetailsMemo.Lines.Add(Format(RsExceptionClass, [E.ClassName]));
+ if E is Exception then
+ DetailsMemo.Lines.Add(Format(RsExceptionMessage, [StrEnsureSuffix('.', Exception(E).Message)]));
+ 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.UpdateTextMemoScrollbars;
+begin
+ Canvas.Font := TextMemo.Font;
+ if TextMemo.Lines.Count * Canvas.TextHeight('Wg') > TextMemo.ClientHeight then
+ TextMemo.ScrollBars := ssVertical
+ else
+ TextMemo.ScrollBars := ssNone;
+end;
+
+//==================================================================================================
+// Exception handler initialization code
+//==================================================================================================
+
+var
+ AppEvents: TApplicationEvents = nil;
+
+procedure InitializeHandler;
+begin
+ if AppEvents = nil then
+ begin
+ AppEvents := TApplicationEvents.Create(nil);
+ AppEvents.OnException := TExceptionDialogMail.ExceptionHandler;
+
+
+
+ JclStackTrackingOptions := JclStackTrackingOptions + [stRawMode];
+ JclStackTrackingOptions := JclStackTrackingOptions + [stStaticModuleList];
+ JclStackTrackingOptions := JclStackTrackingOptions + [stDelayedTrace];
+ JclDebugThreadList.OnSyncException := TExceptionDialogMail.ExceptionThreadHandler;
+ JclStartExceptionTracking;
+ if HookTApplicationHandleException then
+ JclTrackExceptionsFromLibraries;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+procedure UnInitializeHandler;
+begin
+ if AppEvents <> nil then
+ begin
+ FreeAndNil(AppEvents);
+ JclDebugThreadList.OnSyncException := nil;
+ JclUnhookExceptions;
+ JclStopExceptionTracking;
+ end;
+end;
+
+//--------------------------------------------------------------------------------------------------
+
+initialization
+ InitializeHandler;
+
+finalization
+ UnInitializeHandler;
+
+end.
diff --git a/official/1.104/experts/debug/simdview/JclSIMDCpuInfo.dfm b/official/1.104/experts/debug/simdview/JclSIMDCpuInfo.dfm
new file mode 100644
index 0000000..4fe0dd5
--- /dev/null
+++ b/official/1.104/experts/debug/simdview/JclSIMDCpuInfo.dfm
@@ -0,0 +1,198 @@
+object JclFormCpuInfo: TJclFormCpuInfo
+ Left = 468
+ Top = 438
+ BorderStyle = bsDialog
+ Caption = 'Local CPU Informations'
+ ClientHeight = 264
+ 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 = 95
+ Width = 137
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'MMX Extensions'
+ Enabled = False
+ TabOrder = 4
+ end
+ object CheckBox3DNow: TCheckBox
+ Left = 8
+ Top = 118
+ Width = 137
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = '3DNow!'
+ Enabled = False
+ TabOrder = 5
+ end
+ object CheckBoxEx3DNow: TCheckBox
+ Left = 8
+ Top = 141
+ Width = 137
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = '3DNow! Extensions'
+ Enabled = False
+ TabOrder = 6
+ end
+ object CheckBox64Bits: TCheckBox
+ Left = 8
+ Top = 164
+ Width = 137
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = '64 bits'
+ Enabled = False
+ TabOrder = 7
+ end
+ object CheckBoxSSE1: TCheckBox
+ Left = 161
+ Top = 72
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'SSE Version 1'
+ Enabled = False
+ TabOrder = 8
+ end
+ object CheckBoxSSE2: TCheckBox
+ Left = 161
+ Top = 95
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'SSE Version 2'
+ Enabled = False
+ TabOrder = 9
+ end
+ object CheckBoxSSE3: TCheckBox
+ Left = 161
+ Top = 118
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'SSE Version 3'
+ Enabled = False
+ TabOrder = 10
+ end
+ object ButtonClose: TButton
+ Left = 128
+ Top = 233
+ Width = 83
+ Height = 25
+ Caption = 'Close'
+ ModalResult = 2
+ TabOrder = 11
+ end
+ object CheckBoxSSSE3: TCheckBox
+ Left = 161
+ Top = 141
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'Suppl. SSE Version 3'
+ Enabled = False
+ TabOrder = 12
+ end
+ object CheckBoxSSE4A: TCheckBox
+ Left = 161
+ Top = 164
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'SSE Version 4 A'
+ Enabled = False
+ TabOrder = 13
+ end
+ object CheckBoxSSE5: TCheckBox
+ Left = 161
+ Top = 210
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'SSE Version 5'
+ Enabled = False
+ TabOrder = 14
+ end
+ object CheckBoxSSE4B: TCheckBox
+ Left = 161
+ Top = 187
+ Width = 153
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = 'SSE Version 4 B'
+ Enabled = False
+ TabOrder = 15
+ end
+end
diff --git a/official/1.104/experts/debug/simdview/JclSIMDCpuInfo.pas b/official/1.104/experts/debug/simdview/JclSIMDCpuInfo.pas
new file mode 100644
index 0000000..d6836d8
--- /dev/null
+++ b/official/1.104/experts/debug/simdview/JclSIMDCpuInfo.pas
@@ -0,0 +1,130 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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 }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclSIMDCpuInfo;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+ CheckBoxSSSE3: TCheckBox;
+ CheckBoxSSE4A: TCheckBox;
+ CheckBoxSSE5: TCheckBox;
+ CheckBoxSSE4B: TCheckBox;
+ protected
+ procedure CreateParams(var Params: TCreateParams); override;
+ public
+ procedure Execute(const CpuInfo: TCPUInfo);
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/simdview/JclSIMDCpuInfo.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\simdview'
+ );
+{$ENDIF UNITVERSIONING}
+
+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 := string(AnsiString(CpuInfo.CpuName));
+ EditVendor.Text := string(AnsiString(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 := sse in CpuInfo.SSE;
+ CheckBoxSSE2.Checked := sse2 in CpuInfo.SSE;
+ CheckBoxSSE3.Checked := sse3 in CpuInfo.SSE;
+ CheckBoxSSSE3.Checked := ssse3 in CpuInfo.SSE;
+ CheckBoxSSE4A.Checked := sse4A in CpuInfo.SSE;
+ CheckBoxSSE4B.Checked := sse4B in CpuInfo.SSE;
+ CheckBoxSSE5.Checked := sse5 in CpuInfo.SSE;
+ ShowModal;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/simdview/JclSIMDIcon.dcr b/official/1.104/experts/debug/simdview/JclSIMDIcon.dcr
new file mode 100644
index 0000000..e3afa55
Binary files /dev/null and b/official/1.104/experts/debug/simdview/JclSIMDIcon.dcr differ
diff --git a/official/1.104/experts/debug/simdview/JclSIMDModifyForm.dfm b/official/1.104/experts/debug/simdview/JclSIMDModifyForm.dfm
new file mode 100644
index 0000000..ba36d13
--- /dev/null
+++ b/official/1.104/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.104/experts/debug/simdview/JclSIMDModifyForm.pas b/official/1.104/experts/debug/simdview/JclSIMDModifyForm.pas
new file mode 100644
index 0000000..e636a9a
--- /dev/null
+++ b/official/1.104/experts/debug/simdview/JclSIMDModifyForm.pas
@@ -0,0 +1,556 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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 }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclSIMDModifyForm;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls, ToolsApi, Contnrs,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/simdview/JclSIMDModifyForm.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\simdview'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/simdview/JclSIMDTestBCB.cpp b/official/1.104/experts/debug/simdview/JclSIMDTestBCB.cpp
new file mode 100644
index 0000000..779c55c
--- /dev/null
+++ b/official/1.104/experts/debug/simdview/JclSIMDTestBCB.cpp
@@ -0,0 +1,105 @@
+//{**************************************************************************************************}
+//{ }
+//{ Project JEDI Code Library (JCL) }
+//{ }
+//{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+//{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+//{ License at http://www.mozilla.org/MPL/ }
+//{ }
+//{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+//{ 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 }
+//{ }
+//{**************************************************************************************************}
+//{ }
+//{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+//{ Revision: $Rev:: 2175 $ }
+//{ Author: $Author:: outchy $ }
+//{ }
+//{**************************************************************************************************}
+
+#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;
+}
+//---------------------------------------------------------------------------
diff --git a/official/1.104/experts/debug/simdview/JclSIMDTestBCBProject.bpf b/official/1.104/experts/debug/simdview/JclSIMDTestBCBProject.bpf
new file mode 100644
index 0000000..2b51182
--- /dev/null
+++ b/official/1.104/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.104/experts/debug/simdview/JclSIMDTestBCBProject.bpr b/official/1.104/experts/debug/simdview/JclSIMDTestBCBProject.bpr
new file mode 100644
index 0000000..a5a9e0f
--- /dev/null
+++ b/official/1.104/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.104/experts/debug/simdview/JclSIMDTestDelphi.dof b/official/1.104/experts/debug/simdview/JclSIMDTestDelphi.dof
new file mode 100644
index 0000000..c22fe7f
--- /dev/null
+++ b/official/1.104/experts/debug/simdview/JclSIMDTestDelphi.dof
@@ -0,0 +1,2 @@
+[Directories]
+OutputDir=..\..\..\..\bin
diff --git a/official/1.104/experts/debug/simdview/JclSIMDTestDelphi.dpr b/official/1.104/experts/debug/simdview/JclSIMDTestDelphi.dpr
new file mode 100644
index 0000000..3ce26cd
--- /dev/null
+++ b/official/1.104/experts/debug/simdview/JclSIMDTestDelphi.dpr
@@ -0,0 +1,92 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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 }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/experts/debug/simdview/JclSIMDUtils.pas b/official/1.104/experts/debug/simdview/JclSIMDUtils.pas
new file mode 100644
index 0000000..9dc54c0
--- /dev/null
+++ b/official/1.104/experts/debug/simdview/JclSIMDUtils.pas
@@ -0,0 +1,913 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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 }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclSIMDUtils;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows,
+ ToolsAPI,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/simdview/JclSIMDUtils.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\simdview'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+ SysUtils, Math,
+ JclStrings,
+ 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 CharIsDigit(LocalString[Index]) 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 CharIsDigit(LocalString[Index]) 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 CharIsDigit(LocalString[Index]) 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 CharIsDigit(LocalString[Index]) 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}
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/simdview/JclSIMDView.pas b/official/1.104/experts/debug/simdview/JclSIMDView.pas
new file mode 100644
index 0000000..c822ca4
--- /dev/null
+++ b/official/1.104/experts/debug/simdview/JclSIMDView.pas
@@ -0,0 +1,639 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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 }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $ }
+{ Revision: $Rev:: 2498 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclSIMDView;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Classes, Menus, ActnList, ToolsAPI, SysUtils, Graphics, Dialogs,
+ Forms, ComCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclSysInfo,
+ JclOtaUtils, JclSIMDViewForm;
+
+{$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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/simdview/JclSIMDView.pas $';
+ Revision: '$Revision: 2498 $';
+ Date: '$Date: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\simdview'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+ TypInfo,
+ JclOtaConsts, JclOtaResources,
+ JclSIMDUtils;
+
+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;
+begin
+ try
+ if JCLWizardIndex <> -1 then
+ TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLWizardIndex);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var TerminateProc: TWizardTerminateProc): Boolean stdcall;
+begin
+ try
+ TerminateProc := JclWizardTerminate;
+
+ JCLWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.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 = [] 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 <> []) 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;
+ NTAServices: INTAServices;
+begin
+ inherited RegisterCommands;
+
+ NTAServices := GetNTAServices;
+ FDebuggerServices := GetOTADebuggerServices;
+
+ 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 := JclSIMDActionName;
+ FSIMDAction.ImageIndex := NTAServices.ImageList.AddIcon(FIcon);
+ FSIMDAction.ActionList := NTAServices.ActionList;
+ FSIMDAction.ShortCut := Shortcut(Ord('D'), [ssCtrl, ssAlt]);
+
+ FSIMDMenuItem := TMenuItem.Create(nil);
+ FSIMDMenuItem.Name := JCLSIMDMenuName;
+ 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;
+
+var
+ SSESupport: TSSESupport;
+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);
+ for SSESupport := Low(TSSESupport) to High(TSSESupport) do
+ if SSESupport in SSE then
+ Result := Concat(Result, GetEnumName(TypeInfo(TSSESupport), Integer(SSESupport)));
+ 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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/simdview/JclSIMDViewForm.dfm b/official/1.104/experts/debug/simdview/JclSIMDViewForm.dfm
new file mode 100644
index 0000000..dff67d1
--- /dev/null
+++ b/official/1.104/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.104/experts/debug/simdview/JclSIMDViewForm.pas b/official/1.104/experts/debug/simdview/JclSIMDViewForm.pas
new file mode 100644
index 0000000..91e2759
--- /dev/null
+++ b/official/1.104/experts/debug/simdview/JclSIMDViewForm.pas
@@ -0,0 +1,976 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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 }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclSIMDViewForm;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ToolsApi, Grids, ExtCtrls, Menus, ActnList,
+ DockForm,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclOtaUtils, JclSysInfo, JclSIMDUtils, JclSIMDModifyForm;
+
+type
+ TJclSIMDViewFrm = class(TDockableForm)
+ 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;
+ // not for dockable windows
+ //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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/simdview/JclSIMDViewForm.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\simdview'
+ );
+{$ENDIF UNITVERSIONING}
+
+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 = [] 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;
+
+// not for dockable windows
+{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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/threadnames/JclIdeThreadStatus.pas b/official/1.104/experts/debug/threadnames/JclIdeThreadStatus.pas
new file mode 100644
index 0000000..0d93496
--- /dev/null
+++ b/official/1.104/experts/debug/threadnames/JclIdeThreadStatus.pas
@@ -0,0 +1,196 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+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);
+
+end.
diff --git a/official/1.104/experts/debug/threadnames/ThreadExpertSharedNames.pas b/official/1.104/experts/debug/threadnames/ThreadExpertSharedNames.pas
new file mode 100644
index 0000000..d81b3ce
--- /dev/null
+++ b/official/1.104/experts/debug/threadnames/ThreadExpertSharedNames.pas
@@ -0,0 +1,359 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit ThreadExpertSharedNames;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, SysUtils, Classes,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/threadnames/ThreadExpertSharedNames.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\threadnames'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+ // do not reference Ota units there because of the ThreadExceptExample
+ {JclOtaConsts, JclOtaResources,} JclSysUtils;
+
+const
+ MaxThreadCount = 256;
+ IdeEnterMutexTimeout = 5000;
+ MutexName = 'DebugThreadNamesMutex';
+ MutexReadName = 'DebugThreadNamesReadMutex';
+ MappingName = 'DebugThreadNamesMapping';
+ EventName = 'DebugThreadNamesEvent';
+
+resourcestring
+ RsEnterMutexTimeout = 'JCL Thread Name IDE Expert Mutex Timeout';
+
+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 := string(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 := ShortString(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 := string(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, string(Threads[I].ThreadName));
+ finally
+ FReadMutex.Release;
+ end;
+ end;
+ finally
+ FMutex.Release;
+ end;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/threadnames/ThreadExpertUnit.pas b/official/1.104/experts/debug/threadnames/ThreadExpertUnit.pas
new file mode 100644
index 0000000..74749cc
--- /dev/null
+++ b/official/1.104/experts/debug/threadnames/ThreadExpertUnit.pas
@@ -0,0 +1,408 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $ }
+{ Revision: $Rev:: 2498 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+unit ThreadExpertUnit;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Classes, SysUtils, ToolsAPI, ComCtrls, Dialogs,
+ ThreadExpertSharedNames,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/debug/threadnames/ThreadExpertUnit.pas $';
+ Revision: '$Revision: 2498 $';
+ Date: '$Date: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $';
+ LogPath: 'JCL\experts\debug\threadnames'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+begin
+ try
+ if JCLWizardIndex <> -1 then
+ TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLWizardIndex);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var TerminateProc: TWizardTerminateProc): Boolean stdcall;
+begin
+ try
+ TerminateProc := JclWizardTerminate;
+
+ JCLWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/debug/tools/MakeJclDbg.dof b/official/1.104/experts/debug/tools/MakeJclDbg.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/experts/debug/tools/MakeJclDbg.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/experts/debug/tools/MakeJclDbg.dpr b/official/1.104/experts/debug/tools/MakeJclDbg.dpr
new file mode 100644
index 0000000..08e5f61
--- /dev/null
+++ b/official/1.104/experts/debug/tools/MakeJclDbg.dpr
@@ -0,0 +1,136 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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: $Date:: 2008-02-27 09:18:19 +0100 (mer., 27 févr. 2008) $ }
+{ Revision: $Rev:: 2358 $ }
+{ Author: $Author:: obones $ }
+{ }
+{**************************************************************************************************}
+
+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 not AnsiSameText(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 as the MAP files');
+ end
+ else
+ if not MakeDebugData(ParamStr(2)) then
+ Halt(1);
+end.
diff --git a/official/1.104/experts/debug/tools/MapToJdbg.dof b/official/1.104/experts/debug/tools/MapToJdbg.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/experts/debug/tools/MapToJdbg.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/experts/debug/tools/MapToJdbg.dpr b/official/1.104/experts/debug/tools/MapToJdbg.dpr
new file mode 100644
index 0000000..1517bc5
--- /dev/null
+++ b/official/1.104/experts/debug/tools/MapToJdbg.dpr
@@ -0,0 +1,43 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is MapToJdbg.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 converting JCL debug data created from MAP files }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+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.104/experts/debug/tools/MapToJdbg.res b/official/1.104/experts/debug/tools/MapToJdbg.res
new file mode 100644
index 0000000..1fefc8d
Binary files /dev/null and b/official/1.104/experts/debug/tools/MapToJdbg.res differ
diff --git a/official/1.104/experts/debug/tools/MapToJdbgMain.dfm b/official/1.104/experts/debug/tools/MapToJdbgMain.dfm
new file mode 100644
index 0000000..625cf45
--- /dev/null
+++ b/official/1.104/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.104/experts/debug/tools/MapToJdbgMain.pas b/official/1.104/experts/debug/tools/MapToJdbgMain.pas
new file mode 100644
index 0000000..ca7a451
--- /dev/null
+++ b/official/1.104/experts/debug/tools/MapToJdbgMain.pas
@@ -0,0 +1,228 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{ Contributors: }
+{ Michael Chernyshev }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+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, ExeFileName: TFileName;
+ LinkerBugUnit: string;
+ MapFileSize, JclDebugDataSize, LineNumberErrors: Integer;
+begin
+ if ParamCount = 1 then
+ begin
+ MapFileName := ParamStr(1);
+ if MapFileName <> '' then
+ begin
+ if not ConvertMapFileToJdbgFile(MapFileName) then
+ ExitCode := 1;
+ Application.ShowMainForm := False;
+ Application.Terminate;
+ end;
+ end
+ else
+ if ParamCount = 2 then
+ begin
+ MapFileName := ParamStr(1);
+ ExeFileName := ParamStr(2);
+ if (MapFileName <> '') and (ExeFileName <> '') then
+ begin
+ if not InsertDebugDataIntoExecutableFile(ExeFileName, MapFileName, LinkerBugUnit, MapFileSize, JclDebugDataSize, LineNumberErrors) then
+ ExitCode := 1;
+ Application.ShowMainForm := False;
+ Application.Terminate;
+ end;
+ 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;
+
+end.
diff --git a/official/1.104/experts/debug/tools/TlbToMap.dof b/official/1.104/experts/debug/tools/TlbToMap.dof
new file mode 100644
index 0000000..4a388e0
--- /dev/null
+++ b/official/1.104/experts/debug/tools/TlbToMap.dof
@@ -0,0 +1,3 @@
+[Directories]
+OutputDir=..\..\..\bin
+
diff --git a/official/1.104/experts/debug/tools/TlbToMap.dpr b/official/1.104/experts/debug/tools/TlbToMap.dpr
new file mode 100644
index 0000000..492d011
--- /dev/null
+++ b/official/1.104/experts/debug/tools/TlbToMap.dpr
@@ -0,0 +1,43 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is MapToJdbg.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 converting JCL debug data created from TLB files }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+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.104/experts/debug/tools/TlbToMap.res b/official/1.104/experts/debug/tools/TlbToMap.res
new file mode 100644
index 0000000..267e471
Binary files /dev/null and b/official/1.104/experts/debug/tools/TlbToMap.res differ
diff --git a/official/1.104/experts/debug/tools/TlbToMapMain.dfm b/official/1.104/experts/debug/tools/TlbToMapMain.dfm
new file mode 100644
index 0000000..f702f91
--- /dev/null
+++ b/official/1.104/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.104/experts/debug/tools/TlbToMapMain.pas b/official/1.104/experts/debug/tools/TlbToMapMain.pas
new file mode 100644
index 0000000..d57b136
--- /dev/null
+++ b/official/1.104/experts/debug/tools/TlbToMapMain.pas
@@ -0,0 +1,391 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+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;
+
+end.
diff --git a/official/1.104/experts/debug/tools/Tools.bpg b/official/1.104/experts/debug/tools/Tools.bpg
new file mode 100644
index 0000000..99d9643
--- /dev/null
+++ b/official/1.104/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.104/experts/debug/tools/makejcldbg.res b/official/1.104/experts/debug/tools/makejcldbg.res
new file mode 100644
index 0000000..ba101a9
Binary files /dev/null and b/official/1.104/experts/debug/tools/makejcldbg.res differ
diff --git a/official/1.104/experts/favfolders/FavDlg.rc b/official/1.104/experts/favfolders/FavDlg.rc
new file mode 100644
index 0000000..9f54e54
--- /dev/null
+++ b/official/1.104/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.104/experts/favfolders/FavDlg.res b/official/1.104/experts/favfolders/FavDlg.res
new file mode 100644
index 0000000..0659c10
Binary files /dev/null and b/official/1.104/experts/favfolders/FavDlg.res differ
diff --git a/official/1.104/experts/favfolders/IdeOpenDlgFavoriteUnit.pas b/official/1.104/experts/favfolders/IdeOpenDlgFavoriteUnit.pas
new file mode 100644
index 0000000..5b2a3aa
--- /dev/null
+++ b/official/1.104/experts/favfolders/IdeOpenDlgFavoriteUnit.pas
@@ -0,0 +1,166 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $ }
+{ Revision: $Rev:: 2498 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit IdeOpenDlgFavoriteUnit;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ SysUtils,
+ ToolsAPI, OpenDlgFavAdapter,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclOtaUtils;
+
+type
+ TJclOpenDialogsFavoriteExpert = class(TJclOTAExpert)
+ private
+ FFavOpenDialog: TFavOpenDialog;
+ procedure DialogClose(Sender: TObject);
+ procedure DialogShow(Sender: TObject);
+ public
+ constructor Create; reintroduce;
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/favfolders/IdeOpenDlgFavoriteUnit.pas $';
+ Revision: '$Revision: 2498 $';
+ Date: '$Date: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $';
+ LogPath: 'JCL\experts\favfolders'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+begin
+ try
+ if JCLWizardIndex <> -1 then
+ TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLWizardIndex);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var TerminateProc: TWizardTerminateProc): Boolean stdcall;
+begin
+ try
+ TerminateProc := JclWizardTerminate;
+
+ JCLWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.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);
+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;
+
+procedure TJclOpenDialogsFavoriteExpert.RegisterCommands;
+begin
+ inherited RegisterCommands;
+ FFavOpenDialog := InitializeFavOpenDialog;
+ FFavOpenDialog.DisableHelpButton := True;
+ FFavOpenDialog.HookDialogs;
+ FFavOpenDialog.OnClose := DialogClose;
+ FFavOpenDialog.OnShow := DialogShow;
+ FFavOpenDialog.PictureDialogLastFolder := Settings.LoadString(PictDialogFolderItemName,
+ PathAddSeparator(GetCommonFilesFolder) + BorlandImagesPath);
+end;
+
+procedure TJclOpenDialogsFavoriteExpert.UnregisterCommands;
+begin
+ FFavOpenDialog.UnhookDialogs;
+ inherited UnregisterCommands;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/favfolders/OpenDlgFavAdapter.pas b/official/1.104/experts/favfolders/OpenDlgFavAdapter.pas
new file mode 100644
index 0000000..9536ec8
--- /dev/null
+++ b/official/1.104/experts/favfolders/OpenDlgFavAdapter.pas
@@ -0,0 +1,557 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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 }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit OpenDlgFavAdapter;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, Classes, SysUtils, Controls, StdCtrls, ExtCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclPeImage, JclWin32;
+
+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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/favfolders/OpenDlgFavAdapter.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\favfolders'
+ );
+{$ENDIF UNITVERSIONING}
+
+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(SetWindowLongPtr(Wnd, GWLP_WNDPROC, LONG_PTR(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(SetWindowLongPtr(FParentWnd, GWLP_WNDPROC, LONG_PTR(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
+ {$IFDEF UNICODE}
+ FHooks.HookImport(ModuleBase, comdlg32, 'GetOpenFileNameW', @NewGetOpenFileName, @OldGetOpenFileName);
+ FHooks.HookImport(ModuleBase, comdlg32, 'GetSaveFileNameW', @NewGetSaveFileName, @OldGetSaveFileName);
+ {$ELSE}
+ FHooks.HookImport(ModuleBase, comdlg32, 'GetOpenFileNameA', @NewGetOpenFileName, @OldGetOpenFileName);
+ FHooks.HookImport(ModuleBase, comdlg32, 'GetSaveFileNameA', @NewGetSaveFileName, @OldGetSaveFileName);
+ {$ENDIF UNICODE}
+ end;
+ end;
+var
+ Pe: TJclPeImage;
+ I: Integer;
+ HookedModule: LongWord;
+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
+
+try
+ {$IFDEF UNITVERSIONING}
+ RegisterUnitVersion(HInstance, UnitVersioning);
+ {$ENDIF UNITVERSIONING}
+except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+end;
+
+finalization
+
+try
+ {$IFDEF UNITVERSIONING}
+ UnregisterUnitVersion(HInstance);
+ {$ENDIF UNITVERSIONING}
+ FreeAndNil(FavOpenDialog);
+except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+end;
+
+end.
diff --git a/official/1.104/experts/projectanalyzer/ProjAnalyzerFrm.dfm b/official/1.104/experts/projectanalyzer/ProjAnalyzerFrm.dfm
new file mode 100644
index 0000000..1756315
--- /dev/null
+++ b/official/1.104/experts/projectanalyzer/ProjAnalyzerFrm.dfm
@@ -0,0 +1,893 @@
+object ProjectAnalyzerForm: TProjectAnalyzerForm
+ Left = 362
+ Top = 263
+ Width = 544
+ Height = 483
+ BorderIcons = [biSystemMenu]
+ BorderStyle = bsSizeToolWin
+ Caption = 'Project Analyzer'
+ 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 = 42
+ Width = 536
+ Height = 395
+ 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 = 536
+ Height = 42
+ AutoSize = True
+ ButtonHeight = 36
+ ButtonWidth = 84
+ Caption = 'ToolBarMain'
+ EdgeBorders = [ebTop, ebBottom]
+ Images = ExplorerItemImages
+ Indent = 4
+ PopupMenu = PopupMenuToolbar
+ ShowCaptions = True
+ TabOrder = 1
+ object ToolButtonCopy: TToolButton
+ Left = 4
+ Top = 2
+ Action = ActionCopy
+ end
+ object ToolButtonSave: TToolButton
+ Left = 88
+ Top = 2
+ Action = ActionSave
+ end
+ object ToolButtonSeparator1: TToolButton
+ Left = 172
+ Top = 2
+ Width = 8
+ ImageIndex = 3
+ Style = tbsSeparator
+ end
+ object ToolButtonDetails: TToolButton
+ Left = 180
+ Top = 2
+ Action = ActionShowDetails
+ Grouped = True
+ Style = tbsCheck
+ end
+ object ToolButtonSummary: TToolButton
+ Left = 264
+ Top = 2
+ Action = ActionShowSummary
+ Grouped = True
+ Style = tbsCheck
+ end
+ object ToolButtonDfms: TToolButton
+ Left = 348
+ Top = 2
+ Action = ActionShowDfms
+ Grouped = True
+ Style = tbsCheck
+ end
+ object ToolButtonSeparator2: TToolButton
+ Left = 432
+ Top = 2
+ Width = 8
+ Caption = 'ToolButtonSeparator2'
+ ImageIndex = 18
+ Style = tbsSeparator
+ end
+ object ToolButtonShowPackages: TToolButton
+ Left = 440
+ Top = 2
+ Action = ActionShowPackages
+ end
+ end
+ object StatusBarMain: TStatusBar
+ Left = 0
+ Top = 437
+ Width = 536
+ Height = 19
+ Panels = <
+ item
+ Width = 50
+ end>
+ SimplePanel = False
+ end
+ object ExplorerItemImages: TImageList
+ Left = 8
+ Top = 392
+ Bitmap = {
+ 494C010113001400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+ 0000000000003600000028000000400000005000000001002000000000000050
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000000000007F7F7F000000
+ 00007F7F7F007F7F7F0000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 000000000000000000000000000000000000FFFF000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000BFBFBF000000
+ 0000BFBFBF00BFBFBF0000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000FFFF0000FFFFFF00FFFF0000FFFF0000FF0000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000BFBFBF00BFBF
+ BF00BFBFBF00BFBFBF00000000000000000000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000
+ 0000FFFFFF000000FF00FFFFFF00FFFFFF00FFFF0000FFFF0000FFFF00000000
+ FF00FFFF00000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00000000000000
+ 0000FFFFFF000000000000000000FFFFFF00000000000000000000000000FFFF
+ FF000000000000000000FFFFFF0000000000000000000000000000000000FFFF
+ FF00FFFF00000000FF00FFFF0000FFFFFF00FFFF0000FFFF0000FF0000000000
+ FF00FF000000FFFF000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000000000000000FFFF
+ FF00FFFFFF000000FF00FFFFFF00FFFFFF00FFFF0000FFFF0000FFFF00000000
+ FF00FFFF0000FFFF000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00000000000000
+ 0000FFFFFF000000000000000000FFFFFF00FFFFFF0000000000000000000000
+ 00000000000000000000FFFFFF0000000000000000000000000000000000FFFF
+ FF00FFFF00000000FF00FFFF0000FFFFFF00FFFF0000FFFF0000FF0000000000
+ FF00FF000000FFFF000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFF0000FFFF
+ 0000FFFF0000FFFF0000FFFF0000FFFFFF00FFFFFF0000000000FFFFFF000000
+ FF00FFFFFF00FF000000FFFFFF0000000000000000000000000000000000FFFF
+ FF00FFFFFF000000FF00FFFFFF00FFFFFF0080808000FFFF0000FFFF00000000
+ FF00FFFF0000FFFF000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00000000000000
+ 0000FFFFFF000000000000000000BFBFBF0000000000FF000000FF000000FF00
+ 00000000FF00FF000000FF0000000000000000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF000000
+ FF00FFFFFF00FF000000FFFFFF0000000000000000000000000000000000FFFF
+ FF00FFFF00000000FF00808080008080800000000000FFFFFF00800000000000
+ FF00FF000000FFFF000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000
+ FF000000FF000000FF00000000000000000000000000FFFFFF00000000000000
+ 00000000000000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFF
+ FF00FFFFFF00FF000000FFFFFF0000000000000000000000000000000000FFFF
+ FF008080800080808000FFFFFF00000000008080800000000000FFFFFF008000
+ 000080000000FFFF000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00000000000000
+ 00000000000000000000FFFFFF0000000000FFFFFF00000000000000FF000000
+ FF000000FF000000FF000000FF000000000000000000FFFFFF00000000000000
+ 00000000000000000000FFFFFF00FFFFFF00FFFFFF0000000000FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000808080008080
+ 8000FFFFFF00FFFFFF0000000000C0C0C00080808000C0C0C00000000000FFFF
+ FF00FFFFFF008000000080000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000FF000000FF000000
+ FF000000FF000000FF000000FF000000FF0000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF000000000000000000FFFFFF00FFFFFF00FFFF
+ FF000000000000000000C0C0C0000000000000000000C0C0C000C0C0C0000000
+ 000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00000000000000
+ 0000FFFFFF000000000000000000000000000000000000000000000000000000
+ FF000000FF000000FF00000000000000000000000000FF000000FF000000FF00
+ 0000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF00
+ 0000FF000000FF000000FF000000000000000000000000000000000000000000
+ 0000FFFFFF00808080000000000000FFFF0000FFFF0000000000808080008080
+ 8000FFFFFF000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF0000000000FFFFFF00FFFFFF000000000000000000000000000000
+ FF000000FF000000FF00000000000000000000000000BFBFBF00BFBFBF00FF00
+ 0000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF00
+ 0000FF000000BFBFBF00BFBFBF0000000000000000000000000000000000FFFF
+ FF00FFFFFF000000000000FFFF0000FFFF0000FFFF0000FFFF0000000000FFFF
+ FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF0000000000BFBF
+ BF00FFFFFF0000000000FFFFFF000000000000000000000000007F7F7F000000
+ FF000000FF000000FF0000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000FFFFFF00FFFF
+ FF00FFFFFF000000000000FFFF0000FFFF0000FFFF0000FFFF0000000000FFFF
+ FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000000000000000000000000000FFFFFF00FFFFFF00FFFF
+ FF00FFFFFF000000000000000000000000000000FF000000FF000000FF000000
+ FF000000FF000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000FFFFFF00FFFFFF000000000000FFFF0000FFFF0000000000FFFFFF00FFFF
+ FF00FFFFFF000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000000000000000FFFFFF000000000000000000FFFFFF00FFFFFF000000
+ 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
+ 000000000000000000000000FFFFFF00FF00FFFFFC1F0000FF000000F0070000
+ FF000000C0010000FF000000C001000000000000C001000000000000C0010000
+ 00000000C001000000000000C001000000230000C00100000001000080000000
+ 0000000000000000002300008000000000630000C001000000C3000080000000
+ 0107FFFFC001000003FFFFFFF0070000FFFFFFFFFFFFFC00FFFFFFFFFFFFFC00
+ 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
+ object ActionShowPackages: TAction
+ Caption = 'Show packages'
+ Checked = True
+ ImageIndex = 18
+ OnExecute = ActionShowPackagesExecute
+ OnUpdate = ActionShowPackagesUpdate
+ 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.104/experts/projectanalyzer/ProjAnalyzerFrm.pas b/official/1.104/experts/projectanalyzer/ProjAnalyzerFrm.pas
new file mode 100644
index 0000000..77ec1f0
--- /dev/null
+++ b/official/1.104/experts/projectanalyzer/ProjAnalyzerFrm.pas
@@ -0,0 +1,721 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit ProjAnalyzerFrm;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, SysUtils, Classes, Controls, Forms, Dialogs,
+ ComCtrls, ActnList, Menus, ClipBrd, ImgList, ToolWin,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+ ToolButtonSeparator1: 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;
+ ToolButtonSeparator2: TToolButton;
+ ToolButtonShowPackages: TToolButton;
+ ActionShowPackages: TAction;
+ 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);
+ procedure ActionShowPackagesExecute(Sender: TObject);
+ procedure ActionShowPackagesUpdate(Sender: TObject);
+ private
+ FCodeSize: Integer;
+ FICodeSize: Integer;
+ FDataSize: Integer;
+ FBssSize: Integer;
+ FPackageUnits: array of TPackageUnitItem;
+ FUnits: array of TUnitItem;
+ FDfms: array of TUnitItem;
+ FUnitsSum: TStringList;
+ FSettings: TJclOtaSettings;
+ FShowPackages: Boolean;
+ 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;
+ property ShowPackages: Boolean read FShowPackages;
+ end;
+
+var
+ ProjectAnalyzerForm: TProjectAnalyzerForm;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/projectanalyzer/ProjAnalyzerFrm.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\projectanalyser'
+ );
+{$ENDIF UNITVERSIONING}
+
+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
+ for I := 0 to ListView.Columns.Count - 1 do
+ ListView.Columns.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 CharIsNumberChar(S[I]) 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)));
+ FShowPackages := Settings.LoadBool(AnalyzerShowPackagesName, True);
+
+ for Index := 0 to UnitListView.Columns.Count - 1 do
+ UnitListView.Columns.Items[Index].Width := Settings.LoadInteger(Format(ColumnRegName, [Index]),
+ UnitListView.Columns.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));
+ Settings.SaveBool(AnalyzerShowPackagesName, ShowPackages);
+ for Index := 0 to UnitListView.Columns.Count - 1 do
+ Settings.SaveInteger(Format(ColumnRegName, [Index]), UnitListView.Columns.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, FICodeSize, FDataSize, FBssSize, ResourcesSize]);
+ case View of
+ pavDetails:
+ ShowDetails;
+ pavSummary:
+ ShowSummary;
+ else
+ ShowDfms;
+ end;
+end;
+
+procedure TProjectAnalyzerForm.ShowDetails;
+var
+ I: Integer;
+ PackageName: string;
+ AItem: TListItem;
+begin
+ FView := pavDetails;
+ UnitListView.Items.BeginUpdate;
+ try
+ UnitListView.Items.Clear;
+ for I := 0 to Length(FUnits) - 1 do
+ begin
+ PackageName := FindPackageForUnitName(FUnits[I].Name);
+ if ShowPackages or (PackageName = '') then
+ begin
+ AItem := UnitListView.Items.Add;
+ AItem.Caption := FUnits[I].Name;
+ AItem.SubItems.Add(Format('%.0n', [IntToExtended(FUnits[I].Size)]));
+ AItem.SubItems.Add(FUnits[I].Group);
+ AItem.SubItems.Add(PackageName);
+ case FUnits[I].Group[1] of
+ 'D':
+ AItem.ImageIndex := 3;
+ 'B':
+ AItem.ImageIndex := 4;
+ else
+ AItem.ImageIndex := 2;
+ end;
+ end;
+ end;
+ UnitListView.AlphaSort;
+ finally
+ UnitListView.Items.EndUpdate;
+ end;
+end;
+
+procedure TProjectAnalyzerForm.ShowSummary;
+var
+ I: Integer;
+ PackageName: string;
+ AItem: TListItem;
+begin
+ FView := pavSummary;
+ UnitListView.Items.BeginUpdate;
+ try
+ UnitListView.Items.Clear;
+ for I := 0 to FUnitsSum.Count - 1 do
+ begin
+ PackageName := FindPackageForUnitName(FUnitsSum.Strings[I]);
+ if ShowPackages or (PackageName = '') then
+ begin
+ AItem := UnitListView.Items.Add;
+ AItem.Caption := FUnitsSum.Strings[I];
+ AItem.SubItems.Add(Format('%.0n', [IntToExtended(Integer(FUnitsSum.Objects[I]))]));
+ AItem.SubItems.Add(RsCodeData);
+ AItem.SubItems.Add(PackageName);
+ AItem.ImageIndex := 2;
+ end;
+ end;
+ UnitListView.AlphaSort;
+ finally
+ UnitListView.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);
+ 'I':
+ Inc(FICodeSize, 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.ActionShowPackagesExecute(Sender: TObject);
+begin
+ FShowPackages := not FShowPackages;
+ ActionShowPackages.Checked := not ActionShowPackages.Checked;
+ case FView of
+ pavDetails:
+ ShowDetails;
+ pavSummary:
+ ShowSummary;
+ pavDfms:
+ ShowDfms;
+ end;
+end;
+
+procedure TProjectAnalyzerForm.ActionShowPackagesUpdate(Sender: TObject);
+var
+ AAction: TAction;
+begin
+ AAction := Sender as TAction;
+
+ AAction.Enabled := (Length(FUnits) > 0);
+ AAction.Checked := ShowPackages;
+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;
+ FICodeSize := 0;
+ FDataSize := 0;
+ FBssSize := 0;
+ FPackageUnits := nil;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/projectanalyzer/ProjAnalyzerIcon.res b/official/1.104/experts/projectanalyzer/ProjAnalyzerIcon.res
new file mode 100644
index 0000000..bf406de
Binary files /dev/null and b/official/1.104/experts/projectanalyzer/ProjAnalyzerIcon.res differ
diff --git a/official/1.104/experts/projectanalyzer/ProjAnalyzerImpl.pas b/official/1.104/experts/projectanalyzer/ProjAnalyzerImpl.pas
new file mode 100644
index 0000000..d04813b
--- /dev/null
+++ b/official/1.104/experts/projectanalyzer/ProjAnalyzerImpl.pas
@@ -0,0 +1,431 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $ }
+{ Revision: $Rev:: 2498 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit ProjAnalyzerImpl;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Classes, Menus, ActnList, ToolsAPI, SysUtils, Graphics, Dialogs, Forms,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclOtaUtils, ProjAnalyzerFrm;
+
+type
+ TJclProjectAnalyzerExpert = class(TJclOTAExpert)
+ private
+ FBuildMenuItem: TMenuItem;
+ FBuildAction: TAction;
+ {$IFDEF BDS4_UP}
+ FProjectManagerNotifierIndex: Integer;
+ {$ENDIF BDS4_UP}
+ procedure ActionExecute(Sender: TObject);
+ procedure ActionUpdate(Sender: TObject);
+ procedure AnalyzeProject(const AProject: IOTAProject);
+ public
+ constructor Create; reintroduce;
+ destructor Destroy; override;
+ procedure RegisterCommands; override;
+ procedure UnregisterCommands; override;
+ end;
+
+ {$IFDEF BDS4_UP}
+ TProjectManagerNotifier = class(TNotifierObject, IOTANotifier, INTAProjectMenuCreatorNotifier)
+ private
+ FProjectAnalyser: TJclProjectAnalyzerExpert;
+ FOTAProjectManager: IOTAProjectManager;
+ procedure AnalyzeProjectMenuClick(Sender: TObject);
+ protected
+ { INTAProjectMenuCreatorNotifier }
+ function AddMenu(const Ident: string): TMenuItem;
+ function CanHandle(const Ident: string): Boolean;
+ public
+ constructor Create(AProjectAnalyzer: TJclProjectAnalyzerExpert; const AOTAProjectManager: IOTAProjectManager);
+ end;
+ {$ENDIF BDS4_UP}
+
+// design package entry point
+procedure Register;
+
+// expert DLL entry point
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var TerminateProc: TWizardTerminateProc): Boolean; stdcall;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/projectanalyzer/ProjAnalyzerImpl.pas $';
+ Revision: '$Revision: 2498 $';
+ Date: '$Date: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $';
+ LogPath: 'JCL\experts\projectanalyser'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+begin
+ try
+ if JCLWizardIndex <> -1 then
+ TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLWizardIndex);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var TerminateProc: TWizardTerminateProc): Boolean stdcall;
+begin
+ try
+ TerminateProc := JclWizardTerminate;
+
+ JCLWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.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(JclProjectAnalyzerExpertName);
+end;
+
+destructor TJclProjectAnalyzerExpert.Destroy;
+begin
+ FreeAndNil(ProjectAnalyzerForm);
+ inherited Destroy;
+end;
+
+procedure TJclProjectAnalyzerExpert.ActionExecute(Sender: TObject);
+var
+ ActiveProject: IOTAProject;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if ActiveProject <> nil then
+ AnalyzeProject(ActiveProject)
+ else
+ raise EJclExpertException.CreateTrace(RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclProjectAnalyzerExpert.ActionUpdate(Sender: TObject);
+var
+ ActiveProject: IOTAProject;
+ ProjectName: string;
+begin
+ try
+ ActiveProject := GetActiveProject;
+ if Assigned(ActiveProject) then
+ ProjectName := ExtractFileName(ActiveProject.FileName)
+ else
+ ProjectName := '';
+ FBuildAction.Enabled := Assigned(ActiveProject);
+ 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.AnalyzeProject(const AProject: IOTAProject);
+var
+ BuildOK, Succ: Boolean;
+ ProjOptions: IOTAProjectOptions;
+ SaveMapFile: Variant;
+ ProjectName, OutputDirectory: string;
+ ProjectFileName, MapFileName, ExecutableFileName: TFileName;
+begin
+ try
+ JclDisablePostCompilationProcess := True;
+
+ ProjectFileName := AProject.FileName;
+ ProjectName := ExtractFileName(ProjectFileName);
+ Succ := False;
+
+ ProjOptions := AProject.ProjectOptions;
+ if not Assigned(ProjOptions) then
+ raise EJclExpertException.CreateTrace(RsENoProjectOptions);
+
+ OutputDirectory := GetOutputDirectory(AProject);
+ MapFileName := GetMapFileName(AProject);
+
+ if ProjectAnalyzerForm = nil then
+ begin
+ ProjectAnalyzerForm := TProjectAnalyzerForm.Create(Application, Settings);
+ ProjectAnalyzerForm.Show;
+ end;
+ ProjectAnalyzerForm.ClearContent;
+ ProjectAnalyzerForm.StatusBarText := Format(RsBuildingProject, [ProjectName]);
+
+ SaveMapFile := ProjOptions.Values[MapFileOptionName];
+ ProjOptions.Values[MapFileOptionName] := MapFileOptionDetailed;
+ // workaround for MsBuild, the project has to be saved (seems useless with Delphi 2007 update 1)
+ ProjOptions.ModifiedState := True;
+ //TempActiveProject.Save(False, True);
+
+ BuildOK := AProject.ProjectBuilder.BuildProject(cmOTABuild, False);
+
+ ProjOptions.Values[MapFileOptionName] := SaveMapFile;
+ // workaround for MsBuild, the project has to be saved (seems useless with Delphi 2007 update 1)
+ ProjOptions.ModifiedState := True;
+ //TempActiveProject.Save(False, True);
+
+ 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 Integer(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;
+ finally
+ JclDisablePostCompilationProcess := False;
+ end;
+end;
+
+procedure TJclProjectAnalyzerExpert.RegisterCommands;
+var
+ IDEMainMenu: TMainMenu;
+ IDEProjectItem: TMenuItem;
+ IDEActionList: TActionList;
+ I: Integer;
+ ImageBmp: TBitmap;
+ NTAServices: INTAServices;
+ {$IFDEF BDS4_UP}
+ OTAProjectManager: IOTAProjectManager;
+ {$ENDIF BDS4_UP}
+begin
+ inherited RegisterCommands;
+
+ NTAServices := GetNTAServices;
+
+ // create actions
+ FBuildAction := TAction.Create(nil);
+ FBuildAction.Caption := Format(RsAnalyzeActionCaption, [RsProjectNone]);
+ FBuildAction.Visible := True;
+ FBuildAction.OnExecute := ActionExecute;
+ FBuildAction.OnUpdate := ActionUpdate;
+ FBuildAction.Name := JclProjectAnalyzeActionName;
+ ImageBmp := TBitmap.Create;
+ try
+ ImageBmp.LoadFromResourceName(FindResourceHInstance(ModuleHInstance), 'PROJANALYZER');
+ FBuildAction.ImageIndex := NTAServices.AddMasked(ImageBmp, clOlive);
+ finally
+ ImageBmp.Free;
+ end;
+
+ // create project manager notifier
+ {$IFDEF BDS4_UP}
+ OTAProjectManager := GetOTAProjectManager;
+ FProjectManagerNotifierIndex := OTAProjectManager.AddMenuCreatorNotifier(TProjectManagerNotifier.Create(Self,
+ OTAProjectManager));
+ {$ENDIF BDS4_UP}
+
+ // create menu item
+ 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.Name := JclProjectAnalyzeMenuName;
+ 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;
+ // remove notifier
+ {$IFDEF BDS4_UP}
+ if FProjectManagerNotifierIndex <> -1 then
+ GetOTAProjectManager.RemoveMenuCreatorNotifier(FProjectManagerNotifierIndex);
+ {$ENDIF BDS4_UP}
+
+ UnregisterAction(FBuildAction);
+ FreeAndNil(FBuildMenuItem);
+ FreeAndNil(FBuildAction);
+end;
+
+{$IFDEF BDS4_UP}
+
+//=== { TProjectManagerNotifier } ============================================
+
+constructor TProjectManagerNotifier.Create(AProjectAnalyzer: TJclProjectAnalyzerExpert;
+ const AOTAProjectManager: IOTAProjectManager);
+begin
+ inherited Create;
+ FProjectAnalyser := AProjectAnalyzer;
+ FOTAProjectManager := AOTAProjectManager;
+end;
+
+function TProjectManagerNotifier.AddMenu(const Ident: string): TMenuItem;
+var
+ SelectedIdent: string;
+ AProject: IOTAProject;
+begin
+ try
+ SelectedIdent := Ident;
+ AProject := FOTAProjectManager.GetCurrentSelection(SelectedIdent);
+ if AProject <> nil then
+ begin
+ // root item
+ Result := TMenuItem.Create(nil);
+ Result.Visible := True;
+ Result.Caption := Format(RsAnalyzeActionCaption, [ExtractFileName(AProject.FileName)]);
+ Result.OnClick := AnalyzeProjectMenuClick;
+ end
+ else
+ raise EJclExpertException.CreateTrace(RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TProjectManagerNotifier.AnalyzeProjectMenuClick(Sender: TObject);
+var
+ TempProject: IOTAProject;
+ SelectedIdent: string;
+begin
+ try
+ SelectedIdent := '';
+ TempProject := FOTAProjectManager.GetCurrentSelection(SelectedIdent);
+ if TempProject <> nil then
+ FProjectAnalyser.AnalyzeProject(TempProject)
+ else
+ raise EJclExpertException.CreateTrace(RsENoActiveProject);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+function TProjectManagerNotifier.CanHandle(const Ident: string): Boolean;
+begin
+ Result := Ident = sProjectContainer;
+end;
+
+{$ENDIF BDS4_UP}
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaExcDlgFileFrame.dfm b/official/1.104/experts/repository/JclOtaExcDlgFileFrame.dfm
new file mode 100644
index 0000000..4ba70f4
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgFileFrame.dfm
@@ -0,0 +1,79 @@
+inherited JclOtaExcDlgFilePage: TJclOtaExcDlgFilePage
+ object LabelLanguage: TLabel
+ Left = 23
+ Top = 27
+ Width = 59
+ Height = 13
+ Caption = 'RsLanguage'
+ FocusControl = ComboBoxLanguage
+ end
+ object LabelFormName: TLabel
+ Left = 23
+ Top = 182
+ Width = 63
+ Height = 13
+ Caption = 'RsFormName'
+ FocusControl = EditFormName
+ end
+ object LabelFileName: TLabel
+ Left = 23
+ Top = 75
+ Width = 55
+ Height = 13
+ Caption = 'RsFileName'
+ FocusControl = EditFileName
+ end
+ object LabelFormAncestor: TLabel
+ Left = 23
+ Top = 222
+ Width = 79
+ Height = 13
+ Caption = 'RsFormAncestor'
+ FocusControl = EditFormAncestor
+ end
+ object ComboBoxLanguage: TComboBox
+ Left = 136
+ Top = 24
+ Width = 249
+ Height = 21
+ Style = csDropDownList
+ ItemHeight = 13
+ TabOrder = 0
+ OnClick = ComboBoxLanguageClick
+ end
+ object EditFormName: TEdit
+ Left = 136
+ Top = 179
+ Width = 249
+ Height = 21
+ TabOrder = 1
+ end
+ object EditFileName: TEdit
+ Left = 136
+ Top = 72
+ Width = 249
+ Height = 21
+ TabOrder = 2
+ end
+ object ButtonFileBrowse: TButton
+ Left = 391
+ Top = 72
+ Width = 25
+ Height = 21
+ Caption = '...'
+ TabOrder = 3
+ OnClick = ButtonFileBrowseClick
+ end
+ object EditFormAncestor: TEdit
+ Left = 136
+ Top = 219
+ Width = 249
+ Height = 21
+ TabOrder = 4
+ end
+ object SaveDialogFileName: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofNoReadOnlyReturn, ofEnableSizing]
+ Left = 260
+ Top = 96
+ end
+end
diff --git a/official/1.104/experts/repository/JclOtaExcDlgFileFrame.pas b/official/1.104/experts/repository/JclOtaExcDlgFileFrame.pas
new file mode 100644
index 0000000..963e28c
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgFileFrame.pas
@@ -0,0 +1,226 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaExcDlgFileFrame.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaExcDlgFileFrame;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclBorlandTools, JclOtaWizardFrame, JclOtaExcDlgRepository;
+
+type
+ TJclOtaExcDlgFilePage = class(TJclWizardFrame)
+ ComboBoxLanguage: TComboBox;
+ LabelLanguage: TLabel;
+ EditFormName: TEdit;
+ LabelFormName: TLabel;
+ EditFileName: TEdit;
+ LabelFileName: TLabel;
+ ButtonFileBrowse: TButton;
+ EditFormAncestor: TEdit;
+ LabelFormAncestor: TLabel;
+ SaveDialogFileName: TSaveDialog;
+ procedure ButtonFileBrowseClick(Sender: TObject);
+ procedure ComboBoxLanguageClick(Sender: TObject);
+ private
+ FParams: TJclOtaExcDlgParams;
+ procedure AdjustFileExtension;
+ function GetSelectedLanguage: TJclBorPersonality;
+ protected
+ function GetSupportsNext: Boolean; override;
+ property SelectedLanguage: TJclBorPersonality read GetSelectedLanguage;
+ public
+ constructor Create(AOwner: TComponent;
+ AParams: TJclOtaExcDlgParams); reintroduce;
+
+ procedure PageActivated(Direction: TJclWizardDirection); override;
+ procedure PageDesactivated(Direction: TJclWizardDirection); override;
+
+ property Params: TJclOtaExcDlgParams read FParams write FParams;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaExcDlgFileFrame.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclStrings, JclOtaResources;
+
+//=== { TJclOtaExcDlgFilePage } ==============================================
+
+procedure TJclOtaExcDlgFilePage.AdjustFileExtension;
+var
+ AFileName: string;
+begin
+ AFileName := EditFileName.Text;
+ if AFileName <> '' then
+ begin
+ case SelectedLanguage of
+ bpDelphi32:
+ AFileName := ChangeFileExt(AFileName, SourceExtensionPAS);
+ bpBCBuilder32:
+ AFileName := ChangeFileExt(AFileName, SourceExtensionCPP);
+ end;
+ EditFileName.Text := AFileName;
+ end;
+end;
+
+procedure TJclOtaExcDlgFilePage.ButtonFileBrowseClick(Sender: TObject);
+ procedure AddFilter(const NewDescription, NewExtension: string);
+ var
+ AFilter: string;
+ begin
+ AFilter := SaveDialogFileName.Filter;
+ if AFilter <> '' then
+ AFilter := StrEnsureSuffix('|',AFilter);
+ AFilter := Format('%s%s (*%s)|*%s',[AFilter, NewDescription, NewExtension, NewExtension]);
+ SaveDialogFileName.Filter := AFilter;
+ end;
+begin
+ SaveDialogFileName.FileName := EditFileName.Text;
+ SaveDialogFileName.Title := RsFileNameDialog;
+
+ SaveDialogFileName.Filter := '';
+ AddFilter('All files', '.*');
+ if (bpDelphi32 in Params.Languages) or (bpBCBuilder32 in Params.Languages) then
+ AddFilter(SourceDescriptionPAS, SourceExtensionPAS);
+ if bpBCBuilder32 in Params.Languages then
+ AddFilter(SourceDescriptionCPP, SourceExtensionCPP);
+
+ if ComboBoxLanguage.ItemIndex > -1 then
+ case SelectedLanguage of
+ bpDelphi32 :
+ SaveDialogFileName.FilterIndex := 2;
+ bpBCBuilder32 :
+ SaveDialogFileName.FilterIndex := 3;
+ else
+ SaveDialogFileName.FilterIndex := 1;
+ end
+ else
+ SaveDialogFileName.DefaultExt := '';
+
+ if SaveDialogFileName.Execute then
+ EditFileName.Text := SaveDialogFileName.FileName;
+ AdjustFileExtension;
+end;
+
+procedure TJclOtaExcDlgFilePage.ComboBoxLanguageClick(Sender: TObject);
+begin
+ AdjustFileExtension;
+end;
+
+constructor TJclOtaExcDlgFilePage.Create(AOwner: TComponent;
+ AParams: TJclOtaExcDlgParams);
+begin
+ FParams := AParams;
+ inherited Create(AOwner);
+
+ Caption := RsExcDlgFileOptions;
+ LabelLanguage.Caption := RsLanguage;
+ LabelFileName.Caption := RsFileName;
+ LabelFormName.Caption := RsFormName;
+ LabelFormAncestor.Caption := RsFormAncestor;
+end;
+
+function TJclOtaExcDlgFilePage.GetSelectedLanguage: TJclBorPersonality;
+begin
+ if ComboBoxLanguage.ItemIndex > -1 then
+ Result := TJclBorPersonality(ComboBoxLanguage.Items.Objects[ComboBoxLanguage.ItemIndex])
+ else
+ Result := bpUnknown;
+end;
+
+function TJclOtaExcDlgFilePage.GetSupportsNext: Boolean;
+begin
+ Result := (ComboBoxLanguage.ItemIndex > -1) and (EditFormName.Text <> '') and (EditFormAncestor.Text <> '')
+ and (( SelectedLanguage = Params.ActivePersonality)
+ or (EditFileName.Text <> ''));
+end;
+
+procedure TJclOtaExcDlgFilePage.PageActivated(Direction: TJclWizardDirection);
+var
+ Language: TJclBorPersonality;
+ ItemIndex: Integer;
+begin
+ inherited PageActivated(Direction);
+
+ ComboBoxLanguage.Items.Clear;
+
+ for Language := Low(TJclBorPersonality) to High(TJclBorPersonality) do
+ if Language in Params.Languages then
+ begin
+ ItemIndex := ComboBoxLanguage.Items.AddObject(JclBorPersonalityDescription[Language], TObject(Language));
+ if Language = Params.Language then
+ ComboBoxLanguage.ItemIndex := ItemIndex;
+ end;
+
+ EditFileName.Text := Params.FileName;
+ EditFormName.Text := Params.FormName;
+ EditFormAncestor.Text := Params.FormAncestor;
+end;
+
+procedure TJclOtaExcDlgFilePage.PageDesactivated(
+ Direction: TJclWizardDirection);
+begin
+ inherited PageDesactivated(Direction);
+
+ if ComboBoxLanguage.ItemIndex > -1 then
+ Params.Language := SelectedLanguage
+ else
+ Params.Language := bpUnknown;
+ Params.FileName := EditFileName.Text;
+ Params.FormName := EditFormName.Text;
+ Params.FormAncestor := EditFormAncestor.Text;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaExcDlgFormFrame.dfm b/official/1.104/experts/repository/JclOtaExcDlgFormFrame.dfm
new file mode 100644
index 0000000..82a3e57
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgFormFrame.dfm
@@ -0,0 +1,65 @@
+inherited JclOtaExcDlgFormPage: TJclOtaExcDlgFormPage
+ object LabelEMailAddress: TLabel
+ Left = 97
+ Top = 186
+ Width = 36
+ Height = 13
+ Caption = 'RsEmail'
+ FocusControl = EditEMail
+ end
+ object LabelSubject: TLabel
+ Left = 97
+ Top = 226
+ Width = 48
+ Height = 13
+ Caption = 'RsSubject'
+ FocusControl = EditSubject
+ end
+ object CheckBoxMail: TCheckBox
+ Left = 72
+ Top = 144
+ Width = 233
+ Height = 17
+ Caption = 'RsDialogWithMailButton'
+ TabOrder = 0
+ OnClick = CheckBoxMailClick
+ end
+ object EditEMail: TEdit
+ Left = 160
+ Top = 183
+ Width = 193
+ Height = 21
+ TabOrder = 1
+ end
+ object CheckBoxModalDialog: TCheckBox
+ Left = 72
+ Top = 24
+ Width = 233
+ Height = 17
+ Caption = 'RsModalDialog'
+ TabOrder = 2
+ end
+ object CheckBoxSizeable: TCheckBox
+ Left = 72
+ Top = 64
+ Width = 233
+ Height = 17
+ Caption = 'RsSizeable'
+ TabOrder = 3
+ end
+ object EditSubject: TEdit
+ Left = 160
+ Top = 223
+ Width = 193
+ Height = 21
+ TabOrder = 4
+ end
+ object CheckBoxAutoScrollBars: TCheckBox
+ Left = 72
+ Top = 104
+ Width = 233
+ Height = 17
+ Caption = 'RsAutoScrollBars'
+ TabOrder = 5
+ end
+end
diff --git a/official/1.104/experts/repository/JclOtaExcDlgFormFrame.pas b/official/1.104/experts/repository/JclOtaExcDlgFormFrame.pas
new file mode 100644
index 0000000..28a9f06
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgFormFrame.pas
@@ -0,0 +1,165 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaExcDlgFormFrame.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaExcDlgFormFrame;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclOtaExcDlgRepository, JclOtaWizardFrame;
+
+type
+ TJclOtaExcDlgFormPage = class(TJclWizardFrame)
+ CheckBoxMail: TCheckBox;
+ LabelEMailAddress: TLabel;
+ EditEMail: TEdit;
+ CheckBoxModalDialog: TCheckBox;
+ CheckBoxSizeable: TCheckBox;
+ EditSubject: TEdit;
+ LabelSubject: TLabel;
+ CheckBoxAutoScrollBars: TCheckBox;
+ procedure CheckBoxMailClick(Sender: TObject);
+ private
+ FParams: TJclOtaExcDlgParams;
+ procedure UpdateMailEdits;
+ protected
+ function GetSupportsNext: Boolean; override;
+ public
+ constructor Create(AOwner: TComponent; AParams: TJclOtaExcDlgParams); reintroduce;
+
+ procedure PageActivated(Direction: TJclWizardDirection); override;
+ procedure PageDesactivated(Direction: TJclWizardDirection); override;
+
+ property Params: TJclOtaExcDlgParams read FParams write FParams;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaExcDlgFormFrame.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclOtaResources;
+
+//=== { TJclOtaExcDlgFormPage } ==============================================
+
+procedure TJclOtaExcDlgFormPage.CheckBoxMailClick(Sender: TObject);
+begin
+ UpdateMailEdits;
+end;
+
+constructor TJclOtaExcDlgFormPage.Create(AOwner: TComponent;
+ AParams: TJclOtaExcDlgParams);
+begin
+ FParams := AParams;
+ inherited Create(AOwner);
+
+ Caption := RsExcDlgFormOptions;
+ CheckBoxMail.Caption := RsDialogWithMailButton;
+ LabelEMailAddress.Caption := RsEMail;
+ LabelSubject.Caption := RsSubject;
+ CheckBoxModalDialog.Caption := RsModalDialog;
+ CheckBoxSizeable.Caption := RsSizeableDialog;
+ CheckBoxAutoScrollBars.Caption := RsAutoScrollBars;
+end;
+
+function TJclOtaExcDlgFormPage.GetSupportsNext: Boolean;
+begin
+ Result := (not CheckBoxMail.Checked) or ((EditEMail.Text <> '') and (EditSubject.Text <> ''));
+end;
+
+procedure TJclOtaExcDlgFormPage.PageActivated(Direction: TJclWizardDirection);
+begin
+ inherited PageActivated(Direction);
+
+ CheckBoxMail.Checked := Params.SendEMail;
+ EditEMail.Text := Params.EMailAddress;
+ EditSubject.Text := Params.EMailSubject;
+ CheckBoxModalDialog.Checked := Params.ModalDialog;
+ CheckBoxSizeable.Checked := Params.SizeableDialog;
+ CheckBoxAutoScrollBars.Checked := Params.AutoScrollBars;
+
+ UpdateMailEdits;
+end;
+
+procedure TJclOtaExcDlgFormPage.PageDesactivated(
+ Direction: TJclWizardDirection);
+begin
+ inherited PageDesactivated(Direction);
+
+ Params.SendEMail := CheckBoxMail.Checked;
+ Params.EMailAddress := EditEMail.Text;
+ Params.EMailSubject := EditSubject.Text;
+ Params.ModalDialog := CheckBoxModalDialog.Checked;
+ Params.SizeableDialog := CheckBoxSizeable.Checked;
+ Params.AutoScrollBars := CheckBoxAutoScrollBars.Checked;
+end;
+
+procedure TJclOtaExcDlgFormPage.UpdateMailEdits;
+begin
+ if CheckBoxMail.Checked then
+ begin
+ EditEMail.Enabled := True;
+ EditSubject.Enabled := True;
+ EditEMail.Color := clWindow;
+ EditSubject.Color := clWindow;
+ end
+ else
+ begin
+ EditEMail.Enabled := False;
+ EditSubject.Enabled := False;
+ EditEMail.ParentColor := True;
+ EditSubject.ParentColor := True;
+ end;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaExcDlgIcons.RES b/official/1.104/experts/repository/JclOtaExcDlgIcons.RES
new file mode 100644
index 0000000..654f92e
Binary files /dev/null and b/official/1.104/experts/repository/JclOtaExcDlgIcons.RES differ
diff --git a/official/1.104/experts/repository/JclOtaExcDlgIcons.rc b/official/1.104/experts/repository/JclOtaExcDlgIcons.rc
new file mode 100644
index 0000000..3cc8b1b
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgIcons.rc
@@ -0,0 +1,2 @@
+JCLEXCDLG ICON "ExceptDlg.ico"
+JCLEXCDLGCPP ICON "ExceptDlgCpp.ico"
diff --git a/official/1.104/experts/repository/JclOtaExcDlgIgnoreFrame.dfm b/official/1.104/experts/repository/JclOtaExcDlgIgnoreFrame.dfm
new file mode 100644
index 0000000..2405a0e
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgIgnoreFrame.dfm
@@ -0,0 +1,34 @@
+inherited JclOtaExcDlgIgnorePage: TJclOtaExcDlgIgnorePage
+ object LabelIgnoredExceptions: TLabel
+ Left = 120
+ Top = 80
+ Width = 102
+ Height = 13
+ Caption = 'RsIgnoredExceptions'
+ FocusControl = MemoIgnoredExceptions
+ end
+ object CheckBoxTraceAllExceptions: TCheckBox
+ Left = 96
+ Top = 16
+ Width = 393
+ Height = 17
+ Caption = 'RsTraceAllExceptions'
+ TabOrder = 0
+ OnClick = CheckBoxTraceAllExceptionsClick
+ end
+ object CheckBoxTraceEAbort: TCheckBox
+ Left = 120
+ Top = 48
+ Width = 369
+ Height = 17
+ Caption = 'RsTraceEAbort'
+ TabOrder = 1
+ end
+ object MemoIgnoredExceptions: TMemo
+ Left = 120
+ Top = 99
+ Width = 369
+ Height = 177
+ TabOrder = 2
+ end
+end
diff --git a/official/1.104/experts/repository/JclOtaExcDlgIgnoreFrame.pas b/official/1.104/experts/repository/JclOtaExcDlgIgnoreFrame.pas
new file mode 100644
index 0000000..d9a7fcd
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgIgnoreFrame.pas
@@ -0,0 +1,145 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaExcDlgIgnoreFrame.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaExcDlgIgnoreFrame;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclOtaExcDlgRepository, JclOtaWizardFrame;
+
+type
+ TJclOtaExcDlgIgnorePage = class(TJclWizardFrame)
+ CheckBoxTraceAllExceptions: TCheckBox;
+ CheckBoxTraceEAbort: TCheckBox;
+ LabelIgnoredExceptions: TLabel;
+ MemoIgnoredExceptions: TMemo;
+ procedure CheckBoxTraceAllExceptionsClick(Sender: TObject);
+ private
+ FParams: TJclOtaExcDlgParams;
+ procedure UpdateControls;
+ public
+ constructor Create(AOwner: TComponent; AParams: TJclOtaExcDlgParams); reintroduce;
+
+ procedure PageActivated(Direction: TJclWizardDirection); override;
+ procedure PageDesactivated(Direction: TJclWizardDirection); override;
+
+ property Params: TJclOtaExcDlgParams read FParams write FParams;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaExcDlgIgnoreFrame.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclOtaResources;
+
+//=== { TJclOtaExcDlgIgnorePage } ============================================
+
+procedure TJclOtaExcDlgIgnorePage.CheckBoxTraceAllExceptionsClick(
+ Sender: TObject);
+begin
+ UpdateControls;
+end;
+
+constructor TJclOtaExcDlgIgnorePage.Create(AOwner: TComponent;
+ AParams: TJclOtaExcDlgParams);
+begin
+ FParams := AParams;
+ inherited Create(AOwner);
+
+ Caption := RsExcDlgIgnoreOptions;
+ CheckBoxTraceAllExceptions.Caption := RsTraceAllExceptions;
+ CheckBoxTraceEAbort.Caption := RsTraceEAbort;
+ LabelIgnoredExceptions.Caption := RsIgnoredExceptions;
+end;
+
+procedure TJclOtaExcDlgIgnorePage.PageActivated(Direction: TJclWizardDirection);
+begin
+ inherited PageActivated(Direction);
+
+ CheckBoxTraceAllExceptions.Checked := Params.TraceAllExceptions;
+ CheckBoxTraceEAbort.Checked := Params.TraceEAbort;
+ MemoIgnoredExceptions.Lines.Assign(Params.IgnoredExceptions);
+ UpdateControls;
+end;
+
+procedure TJclOtaExcDlgIgnorePage.PageDesactivated(
+ Direction: TJclWizardDirection);
+begin
+ inherited PageDesactivated(Direction);
+
+ Params.TraceAllExceptions := CheckBoxTraceAllExceptions.Checked;
+ Params.TraceEAbort := CheckBoxTraceEAbort.Checked;
+ Params.IgnoredExceptions.Assign(MemoIgnoredExceptions.Lines);
+end;
+
+procedure TJclOtaExcDlgIgnorePage.UpdateControls;
+begin
+ if CheckBoxTraceAllExceptions.Checked then
+ begin
+ CheckBoxTraceEAbort.Enabled := False;
+ MemoIgnoredExceptions.Enabled := False;
+ LabelIgnoredExceptions.Enabled := False;
+ MemoIgnoredExceptions.ParentColor := True;
+ end
+ else
+ begin
+ CheckBoxTraceEAbort.Enabled := True;
+ MemoIgnoredExceptions.Enabled := True;
+ LabelIgnoredExceptions.Enabled := True;
+ MemoIgnoredExceptions.Color := clWindow;
+ end;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaExcDlgRepository.pas b/official/1.104/experts/repository/JclOtaExcDlgRepository.pas
new file mode 100644
index 0000000..c794c2c
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgRepository.pas
@@ -0,0 +1,198 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaExcDlgRepository.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-24 22:40:10 +0200 (mer., 24 sept. 2008) $ }
+{ Revision: $Rev:: 2496 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaExcDlgRepository;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Classes, Forms,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclBorlandTools,
+ JclOtaTemplates;
+
+type
+ TJclOtaExcDlgParams = class(TJclOtaTemplateParams)
+ private
+ FHookDll: Boolean;
+ FFileName: string;
+ FCodeDetails: Boolean;
+ FModuleName: Boolean;
+ FModuleOffset: Boolean;
+ FDelayedTrace: Boolean;
+ FFormName: string;
+ FLogFile: Boolean;
+ FLogFileName: string;
+ FAddressOffset: Boolean;
+ FVirtualAddress: Boolean;
+ FActivePersonality: TJclBorPersonality;
+ FLanguages: TJclBorPersonalities;
+ FRawData: Boolean;
+ FSendEMail: Boolean;
+ FEMailAddress: string;
+ FFormAncestor: string;
+ FModalDialog: Boolean;
+ FSizeableDialog: Boolean;
+ FEMailSubject: string;
+ FDesigner: TJclBorDesigner;
+ FModuleList: Boolean;
+ FUnitVersioning: Boolean;
+ FOSInfo: Boolean;
+ FActiveControls: Boolean;
+ FStackList: Boolean;
+ FAutoScrollBars: Boolean;
+ FMainThreadOnly: Boolean;
+ FAllThreads: Boolean;
+ FTraceEAbort: Boolean;
+ FIgnoredExceptions: TStrings;
+ FTraceAllExceptions: Boolean;
+ function GetIgnoredExceptionsCount: Integer;
+ public
+ constructor Create; reintroduce;
+ destructor Destroy; override;
+ published
+ // file options
+ property Languages: TJclBorPersonalities read FLanguages write FLanguages;
+ property ActivePersonality: TJclBorPersonality read FActivePersonality
+ write FActivePersonality;
+ property FileName: string read FFileName write FFileName;
+ property FormName: string read FFormName write FFormName;
+ property FormAncestor: string read FFormAncestor write FFormAncestor;
+ property Designer: TJclBorDesigner read FDesigner write FDesigner;
+ // form options
+ property ModalDialog: Boolean read FModalDialog write FModalDialog;
+ property SendEMail: Boolean read FSendEMail write FSendEMail;
+ property EMailAddress: string read FEMailAddress write FEMailAddress;
+ property EMailSubject: string read FEMailSubject write FEMailSubject;
+ property SizeableDialog: Boolean read FSizeableDialog write FSizeableDialog;
+ property AutoScrollBars: Boolean read FAutoScrollBars write FAutoScrollBars;
+ // system options
+ property DelayedTrace: Boolean read FDelayedTrace write FDelayedTrace;
+ property HookDll: Boolean read FHookDll write FHookDll;
+ property LogFile: Boolean read FLogFile write FLogFile;
+ property LogFileName: string read FLogFileName write FLogFileName;
+ property OSInfo: Boolean read FOSInfo write FOSInfo;
+ property ModuleList: Boolean read FModuleList write FModuleList;
+ property UnitVersioning: Boolean read FUnitVersioning write FUnitVersioning;
+ property ActiveControls: Boolean read FActiveControls write FActiveControls;
+ property MainThreadOnly: Boolean read FMainThreadOnly write FMainThreadOnly;
+ // ignored exceptions
+ property TraceAllExceptions: Boolean read FTraceAllExceptions
+ write FTraceAllExceptions;
+ property TraceEAbort: Boolean read FTraceEAbort write FTraceEAbort;
+ property IgnoredExceptions: TStrings read FIgnoredExceptions write FIgnoredExceptions;
+ property IgnoredExceptionsCount: Integer read GetIgnoredExceptionsCount;
+ // trace options
+ property StackList: Boolean read FStackList write FStackList;
+ property RawData: Boolean read FRawData write FRawData;
+ property ModuleName: Boolean read FModuleName write FModuleName;
+ property ModuleOffset: Boolean read FModuleOffset write FModuleOffset;
+ property AllThreads: Boolean read FAllThreads write FAllThreads;
+ //property AddressOffset: Boolean read FAddressOffset write FAddressOffset;
+ property CodeDetails: Boolean read FCodeDetails write FCodeDetails;
+ property VirtualAddress: Boolean read FVirtualAddress write FVirtualAddress;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaExcDlgRepository.pas $';
+ Revision: '$Revision: 2496 $';
+ Date: '$Date: 2008-09-24 22:40:10 +0200 (mer., 24 sept. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R JclOtaExcDlgIcons.res}
+
+//=== { TJclOtaExcDlgParams } ================================================
+
+constructor TJclOtaExcDlgParams.Create;
+begin
+ inherited Create;
+
+ FHookDll := True;
+ FLanguage := bpUnknown;
+ FLanguages := [bpUnknown];
+ FFileName := '';
+ FCodeDetails := True;
+ FModuleName := True;
+ FModuleOffset := False;
+ FDelayedTrace := True;
+ FFormName := 'ExceptionDialog';
+ FFormAncestor := TForm.ClassName;
+ FLogFile := False;
+ FLogFileName := '';
+ FAddressOffset := True;
+ FVirtualAddress := False;
+ FActivePersonality := bpUnknown;
+ FRawData := False;
+ FSendEMail := False;
+ FEMailAddress := '';
+ FEMailSubject := '';
+ FModalDialog := True;
+ FSizeableDialog := False;
+ FDesigner := bdVCL;
+ FModuleList := True;
+ FUnitVersioning := True;
+ FOSInfo := True;
+ FActiveControls := True;
+ FStackList := True;
+ FAutoScrollBars := True;
+ FMainThreadOnly := False;
+ FTraceEAbort := False;
+ FTraceAllExceptions := False;
+ FIgnoredExceptions := TStringList.Create;
+end;
+
+destructor TJclOtaExcDlgParams.Destroy;
+begin
+ FIgnoredExceptions.Free;
+ inherited Destroy;
+end;
+
+function TJclOtaExcDlgParams.GetIgnoredExceptionsCount: Integer;
+begin
+ Result := FIgnoredExceptions.Count;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaExcDlgSystemFrame.dfm b/official/1.104/experts/repository/JclOtaExcDlgSystemFrame.dfm
new file mode 100644
index 0000000..027c47e
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgSystemFrame.dfm
@@ -0,0 +1,82 @@
+inherited JclOtaExcDlgSystemPage: TJclOtaExcDlgSystemPage
+ object LabelLogFileName: TLabel
+ Left = 170
+ Top = 139
+ Width = 55
+ Height = 13
+ Caption = 'RsFileName'
+ end
+ object CheckBoxDelayed: TCheckBox
+ Left = 120
+ Top = 18
+ Width = 265
+ Height = 17
+ Caption = 'RsDelayedStackTrace'
+ TabOrder = 0
+ end
+ object CheckBoxHookDll: TCheckBox
+ Left = 120
+ Top = 49
+ Width = 265
+ Height = 17
+ Caption = 'RsHookDll'
+ TabOrder = 1
+ end
+ object CheckBoxLogFile: TCheckBox
+ Left = 120
+ Top = 113
+ Width = 265
+ Height = 17
+ Caption = 'RsLogFile'
+ TabOrder = 2
+ OnClick = CheckBoxLogFileClick
+ end
+ object EditLogFileName: TEdit
+ Left = 240
+ Top = 136
+ Width = 145
+ Height = 21
+ TabOrder = 3
+ end
+ object CheckBoxModuleList: TCheckBox
+ Left = 120
+ Top = 176
+ Width = 265
+ Height = 17
+ Caption = 'RsModuleList'
+ TabOrder = 4
+ OnClick = CheckBoxModuleListClick
+ end
+ object CheckBoxOSInfo: TCheckBox
+ Left = 120
+ Top = 232
+ Width = 265
+ Height = 17
+ Caption = 'RsOSInfo'
+ TabOrder = 5
+ end
+ object CheckBoxActiveControls: TCheckBox
+ Left = 120
+ Top = 264
+ Width = 265
+ Height = 17
+ Caption = 'RsActiveControls'
+ TabOrder = 6
+ end
+ object CheckBoxMainThreadOnly: TCheckBox
+ Left = 120
+ Top = 81
+ Width = 265
+ Height = 17
+ Caption = 'RsMainThreadOnly'
+ TabOrder = 7
+ end
+ object CheckBoxUnitVersioning: TCheckBox
+ Left = 152
+ Top = 199
+ Width = 233
+ Height = 17
+ Caption = 'RsUnitVersioning'
+ TabOrder = 8
+ end
+end
diff --git a/official/1.104/experts/repository/JclOtaExcDlgSystemFrame.pas b/official/1.104/experts/repository/JclOtaExcDlgSystemFrame.pas
new file mode 100644
index 0000000..bfe2a78
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgSystemFrame.pas
@@ -0,0 +1,178 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaExcDlgSystemFrame.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-24 22:40:10 +0200 (mer., 24 sept. 2008) $ }
+{ Revision: $Rev:: 2496 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaExcDlgSystemFrame;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclOtaExcDlgRepository, JclOtaWizardFrame;
+
+type
+ TJclOtaExcDlgSystemPage = class(TJclWizardFrame)
+ CheckBoxDelayed: TCheckBox;
+ CheckBoxHookDll: TCheckBox;
+ CheckBoxLogFile: TCheckBox;
+ LabelLogFileName: TLabel;
+ EditLogFileName: TEdit;
+ CheckBoxModuleList: TCheckBox;
+ CheckBoxOSInfo: TCheckBox;
+ CheckBoxActiveControls: TCheckBox;
+ CheckBoxMainThreadOnly: TCheckBox;
+ CheckBoxUnitVersioning: TCheckBox;
+ procedure CheckBoxLogFileClick(Sender: TObject);
+ procedure CheckBoxModuleListClick(Sender: TObject);
+ private
+ FParams: TJclOtaExcDlgParams;
+ procedure UpdateLogEdits;
+ protected
+ function GetSupportsNext: Boolean; override;
+ public
+ constructor Create(AOwner: TComponent; AParams: TJclOtaExcDlgParams); reintroduce;
+
+ procedure PageActivated(Direction: TJclWizardDirection); override;
+ procedure PageDesactivated(Direction: TJclWizardDirection); override;
+
+ property Params: TJclOtaExcDlgParams read FParams write FParams;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaExcDlgSystemFrame.pas $';
+ Revision: '$Revision: 2496 $';
+ Date: '$Date: 2008-09-24 22:40:10 +0200 (mer., 24 sept. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclOtaResources;
+
+//=== { TJclOtaExcDlgSystemPage } ============================================
+
+procedure TJclOtaExcDlgSystemPage.CheckBoxLogFileClick(Sender: TObject);
+begin
+ UpdateLogEdits;
+end;
+
+procedure TJclOtaExcDlgSystemPage.CheckBoxModuleListClick(Sender: TObject);
+begin
+ CheckBoxUnitVersioning.Enabled := CheckBoxModuleList.Checked;
+end;
+
+constructor TJclOtaExcDlgSystemPage.Create(AOwner: TComponent;
+ AParams: TJclOtaExcDlgParams);
+begin
+ FParams := AParams;
+ inherited Create(AOwner);
+
+ Caption := RsExcDlgSystemOptions;
+ CheckBoxDelayed.Caption := RsDelayedStackTrace;
+ CheckBoxHookDll.Caption := RsHookDll;
+ CheckBoxLogFile.Caption := RsLogTrace;
+ LabelLogFileName.Caption := RsFileName;
+ CheckBoxModuleList.Caption := RsModuleList;
+ CheckBoxUnitVersioning.Caption := RsUnitVersioning;
+ CheckBoxOSInfo.Caption := RsOSInfo;
+ CheckBoxActiveControls.Caption := RsActiveControls;
+ CheckBoxMainThreadOnly.Caption := RsMainThreadOnly;
+end;
+
+function TJclOtaExcDlgSystemPage.GetSupportsNext: Boolean;
+begin
+ Result := (not CheckBoxLogFile.Checked) or (EditLogFileName.Text <> '');
+end;
+
+procedure TJclOtaExcDlgSystemPage.PageActivated(Direction: TJclWizardDirection);
+begin
+ inherited PageActivated(Direction);
+
+ CheckBoxDelayed.Checked := Params.DelayedTrace;
+ CheckBoxHookDll.Checked := Params.HookDll;
+ CheckBoxLogFile.Checked := Params.LogFile;
+ EditLogFileName.Text := Params.LogFileName;
+ CheckBoxModuleList.Checked := Params.ModuleList;
+ CheckBoxUnitVersioning.Checked := Params.UnitVersioning;
+ CheckBoxOSInfo.Checked := Params.OSInfo;
+ CheckBoxActiveControls.Checked := Params.ActiveControls;
+ CheckBoxMainThreadOnly.Checked := Params.MainThreadOnly;
+
+ UpdateLogEdits;
+end;
+
+procedure TJclOtaExcDlgSystemPage.PageDesactivated(
+ Direction: TJclWizardDirection);
+begin
+ inherited PageDesactivated(Direction);
+
+ Params.DelayedTrace := CheckBoxDelayed.Checked;
+ Params.HookDll := CheckBoxHookDll.Checked;
+ Params.LogFile := CheckBoxLogFile.Checked;
+ Params.LogFileName := EditLogFileName.Text;
+ Params.ModuleList := CheckBoxModuleList.Checked;
+ Params.UnitVersioning := CheckBoxUnitVersioning.Checked;
+ Params.OSInfo := CheckBoxOSInfo.Checked;
+ Params.ActiveControls := CheckBoxActiveControls.Checked;
+ Params.MainThreadOnly := CheckBoxMainThreadOnly.Checked;
+end;
+
+procedure TJclOtaExcDlgSystemPage.UpdateLogEdits;
+begin
+ if CheckBoxLogFile.Checked then
+ begin
+ EditLogFileName.Enabled := True;
+ EditLogFileName.Color := clWindow;
+ end
+ else
+ begin
+ EditLogFileName.Enabled := False;
+ EditLogFileName.ParentColor := True;
+ end;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaExcDlgTraceFrame.dfm b/official/1.104/experts/repository/JclOtaExcDlgTraceFrame.dfm
new file mode 100644
index 0000000..a2f2331
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgTraceFrame.dfm
@@ -0,0 +1,83 @@
+inherited JclOtaExcDlgTracePage: TJclOtaExcDlgTracePage
+ object LabelPreview: TLabel
+ Left = 303
+ Top = 7
+ Width = 51
+ Height = 13
+ Caption = 'RsPreview'
+ end
+ object CheckBoxRawData: TCheckBox
+ Left = 56
+ Top = 57
+ Width = 233
+ Height = 17
+ Caption = 'RsRawData'
+ TabOrder = 0
+ OnClick = CheckBoxClick
+ end
+ object CheckBoxModuleName: TCheckBox
+ Left = 56
+ Top = 95
+ Width = 233
+ Height = 17
+ Caption = 'RsModuleName'
+ TabOrder = 1
+ OnClick = CheckBoxClick
+ end
+ object CheckBoxCodeDetails: TCheckBox
+ Left = 56
+ Top = 175
+ Width = 233
+ Height = 17
+ Caption = 'RsCodeDetails'
+ TabOrder = 2
+ OnClick = CheckBoxClick
+ end
+ object CheckBoxVirtualAddress: TCheckBox
+ Left = 56
+ Top = 214
+ Width = 233
+ Height = 17
+ Caption = 'RsVirtualAddress'
+ TabOrder = 3
+ OnClick = CheckBoxClick
+ end
+ object CheckBoxModuleOffset: TCheckBox
+ Left = 56
+ Top = 136
+ Width = 233
+ Height = 17
+ Caption = 'RsModuleOffset'
+ TabOrder = 4
+ OnClick = CheckBoxClick
+ end
+ object MemoStack: TMemo
+ Left = 303
+ Top = 26
+ Width = 313
+ Height = 263
+ ParentColor = True
+ ReadOnly = True
+ ScrollBars = ssBoth
+ TabOrder = 6
+ WordWrap = False
+ end
+ object CheckBoxStackList: TCheckBox
+ Left = 32
+ Top = 26
+ Width = 257
+ Height = 17
+ Caption = 'RsStackList'
+ TabOrder = 5
+ OnClick = CheckBoxStackListClick
+ end
+ object CheckBoxAllThreads: TCheckBox
+ Left = 56
+ Top = 248
+ Width = 233
+ Height = 17
+ Caption = 'RsAllThreads'
+ TabOrder = 7
+ OnClick = CheckBoxClick
+ end
+end
diff --git a/official/1.104/experts/repository/JclOtaExcDlgTraceFrame.pas b/official/1.104/experts/repository/JclOtaExcDlgTraceFrame.pas
new file mode 100644
index 0000000..39da50c
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgTraceFrame.pas
@@ -0,0 +1,241 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaExcDlgTraceFrame.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaExcDlgTraceFrame;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, JclDebug,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclOtaExcDlgRepository, JclOtaWizardFrame;
+
+type
+ TJclOtaExcDlgTracePage = class(TJclWizardFrame)
+ CheckBoxRawData: TCheckBox;
+ CheckBoxModuleName: TCheckBox;
+ CheckBoxCodeDetails: TCheckBox;
+ CheckBoxVirtualAddress: TCheckBox;
+ CheckBoxModuleOffset: TCheckBox;
+ MemoStack: TMemo;
+ LabelPreview: TLabel;
+ CheckBoxStackList: TCheckBox;
+ CheckBoxAllThreads: TCheckBox;
+ procedure CheckBoxClick(Sender: TObject);
+ procedure CheckBoxStackListClick(Sender: TObject);
+ private
+ FParams: TJclOtaExcDlgParams;
+ FTestThread: TJclDebugThread;
+ procedure UpdatePreview;
+ procedure UpdateCheckBoxes;
+ public
+ constructor Create(AOwner: TComponent; AParams: TJclOtaExcDlgParams); reintroduce;
+ destructor Destroy; override;
+
+ procedure PageActivated(Direction: TJclWizardDirection); override;
+ procedure PageDesactivated(Direction: TJclWizardDirection); override;
+
+ property Params: TJclOtaExcDlgParams read FParams write FParams;
+ end;
+
+ // in interface to be exported and have basic debug informations based on exports
+ TTestThread = class(TJclDebugThread)
+ private
+ procedure ExecuteTask;
+ procedure ExecuteSubTask;
+ protected
+ procedure Execute; override;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaExcDlgTraceFrame.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclOtaResources;
+
+//=== { TTestThread } ========================================================
+
+{$W+}
+
+procedure TTestThread.Execute;
+begin
+ ExecuteTask;
+end;
+
+{$IFNDEF STACKFRAMES_ON}
+{$W-}
+{$ENDIF ~STACKFRAMES_ON}
+
+procedure TTestThread.ExecuteTask;
+begin
+ ExecuteSubTask;
+end;
+
+procedure TTestThread.ExecuteSubTask;
+begin
+ while not Terminated do
+ Sleep(100);
+end;
+
+//=== { TJclOtaExcDlgTracePage } =============================================
+
+procedure TJclOtaExcDlgTracePage.CheckBoxClick(Sender: TObject);
+begin
+ UpdatePreview;
+end;
+
+procedure TJclOtaExcDlgTracePage.CheckBoxStackListClick(Sender: TObject);
+begin
+ UpdateCheckBoxes;
+end;
+
+constructor TJclOtaExcDlgTracePage.Create(AOwner: TComponent;
+ AParams: TJclOtaExcDlgParams);
+begin
+ FParams := AParams;
+ inherited Create(AOwner);
+ FTestThread := TTestThread.Create(False, 'MyTaskThread');
+
+ Caption := RsExcDlgTraceOptions;
+ CheckBoxStackList.Caption := RsStackList;
+ CheckBoxRawData.Caption := RsRawData;
+ CheckBoxModuleName.Caption := RsModuleName;
+// CheckBoxAddressOffset.Caption := RsAddressOffset;
+ CheckBoxCodeDetails.Caption := RsCodeDetails;
+ CheckBoxVirtualAddress.Caption := RsVirtualAddress;
+ CheckBoxModuleOffset.Caption := RsModuleOffset;
+ LabelPreview.Caption := RsPreview;
+ CheckBoxAllThreads.Caption := RsAllThreads;
+end;
+
+destructor TJclOtaExcDlgTracePage.Destroy;
+begin
+ FTestThread.Free;
+ inherited Destroy;
+end;
+
+procedure TJclOtaExcDlgTracePage.PageActivated(Direction: TJclWizardDirection);
+begin
+ inherited PageActivated(Direction);
+
+ CheckBoxStackList.Checked := Params.StackList;
+ CheckBoxRawData.Checked := Params.RawData;
+ CheckBoxModuleName.Checked := Params.ModuleName;
+// CheckBoxAddressOffset.Checked := Params.AddressOffset;
+ CheckBoxCodeDetails.Checked := Params.CodeDetails;
+ CheckBoxVirtualAddress.Checked := Params.VirtualAddress;
+ CheckBoxModuleOffset.Checked := Params.ModuleOffset;
+ CheckBoxAllThreads.Checked := Params.AllThreads;
+
+ UpdateCheckBoxes;
+end;
+
+procedure TJclOtaExcDlgTracePage.PageDesactivated(
+ Direction: TJclWizardDirection);
+begin
+ inherited PageDesactivated(Direction);
+
+ Params.StackList := CheckBoxStackList.Checked;
+ Params.RawData := CheckBoxRawData.Checked;
+ Params.ModuleName := CheckBoxModuleName.Checked;
+// Params.AddressOffset := CheckBoxAddressOffset.Checked;
+ Params.CodeDetails := CheckBoxCodeDetails.Checked;
+ Params.VirtualAddress := CheckBoxVirtualAddress.Checked;
+ Params.ModuleOffset := CheckBoxModuleOffset.Checked;
+ Params.AllThreads := CheckBoxAllThreads.Checked;
+end;
+
+procedure TJclOtaExcDlgTracePage.UpdateCheckBoxes;
+var
+ AEnabled: Boolean;
+begin
+ AEnabled := CheckBoxStackList.Enabled;
+
+ CheckBoxRawData.Enabled := AEnabled;
+ CheckBoxModuleName.Enabled := AEnabled;
+ CheckBoxCodeDetails.Enabled := AEnabled;
+ CheckBoxVirtualAddress.Enabled := AEnabled;
+ CheckBoxModuleOffset.Enabled := AEnabled;
+end;
+
+procedure TJclOtaExcDlgTracePage.UpdatePreview;
+var
+ AStack: TJclStackInfoList;
+begin
+ MemoStack.Lines.Clear;
+
+ if CheckBoxAllThreads.Checked then
+ MemoStack.Lines.Add('Main thread stack trace');
+
+ AStack := TJclStackInfoList.Create(CheckBoxRawData.Checked, 0, nil, False);
+ try
+ AStack.AddToStrings(MemoStack.Lines, CheckBoxModuleName.Checked,
+ CheckBoxModuleOffset.Checked, CheckBoxCodeDetails.Checked, CheckBoxVirtualAddress.Checked);
+ finally
+ AStack.Free;
+ end;
+
+ if CheckBoxAllThreads.Checked then
+ begin
+ MemoStack.Lines.Add('');
+ MemoStack.Lines.Add(Format('Stack trace for thread: "%s" (%s)', [FTestThread.ThreadName, FTestThread.ClassName]));
+ AStack := JclCreateThreadStackTrace(CheckBoxRawData.Checked, FTestThread.Handle);
+ try
+ AStack.AddToStrings(MemoStack.Lines, CheckBoxModuleName.Checked,
+ CheckBoxModuleOffset.Checked, CheckBoxCodeDetails.Checked, CheckBoxVirtualAddress.Checked);
+ finally
+ AStack.Free;
+ end;
+ end;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaExcDlgWizard.dfm b/official/1.104/experts/repository/JclOtaExcDlgWizard.dfm
new file mode 100644
index 0000000..8a4b337
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgWizard.dfm
@@ -0,0 +1,5 @@
+inherited JclOtaExcDlgForm: TJclOtaExcDlgForm
+ Caption = 'JclOtaExcDlgForm'
+ PixelsPerInch = 96
+ TextHeight = 13
+end
diff --git a/official/1.104/experts/repository/JclOtaExcDlgWizard.pas b/official/1.104/experts/repository/JclOtaExcDlgWizard.pas
new file mode 100644
index 0000000..7d7bae5
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaExcDlgWizard.pas
@@ -0,0 +1,130 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaExcDlgWizard.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaExcDlgWizard;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ Dialogs, ActnList, ExtCtrls, StdCtrls,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclBorlandTools, JclOtaExcDlgRepository, JclOtaWizardForm;
+
+type
+ TJclOtaExcDlgForm = class(TJclWizardForm)
+ procedure FormCreate(Sender: TObject);
+ private
+ FParams: TJclOtaExcDlgParams;
+ public
+ constructor Create(AOwner: TComponent;
+ AParams: TJclOtaExcDlgParams); reintroduce;
+ property Params: TJclOtaExcDlgParams read FParams;
+ end;
+
+function ExcDlgWizard(var AParams: TJclOtaExcDlgParams): Boolean;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaExcDlgWizard.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ JclOtaResources,
+ JclOtaExcDlgFileFrame, JclOtaExcDlgFormFrame,
+ JclOtaExcDlgSystemFrame, JclOtaExcDlgTraceFrame, JclOtaExcDlgIgnoreFrame;
+
+function ExcDlgWizard(var AParams: TJclOtaExcDlgParams): Boolean;
+var
+ OwnsParams: Boolean;
+ AForm: TJclOtaExcDlgForm;
+begin
+ Result := False;
+ OwnsParams := False;
+
+ if not Assigned(AParams) then
+ begin
+ OwnsParams := True;
+ AParams := TJclOtaExcDlgParams.Create;
+ end;
+ try
+ AForm := TJclOtaExcDlgForm.Create(Application, AParams);
+ try
+ Result := AForm.Execute;
+ finally
+ AForm.Free;
+ end;
+ finally
+ if OwnsParams and not Result then
+ FreeAndNil(AParams);
+ end;
+end;
+
+//=== { TJclOtaExcDlgForm.pas } ==============================================
+
+constructor TJclOtaExcDlgForm.Create(AOwner: TComponent;
+ AParams: TJclOtaExcDlgParams);
+begin
+ FParams := AParams;
+ inherited Create(AOwner);
+end;
+
+procedure TJclOtaExcDlgForm.FormCreate(Sender: TObject);
+begin
+ inherited FormCreate(Sender);
+ Caption := RsExceptionDialogConfigure;
+
+ AddPage(TJclOtaExcDlgFilePage.Create(Self, Params));
+ AddPage(TJclOtaExcDlgFormPage.Create(Self, Params));
+ AddPage(TJclOtaExcDlgSystemPage.Create(Self, Params));
+ AddPage(TJclOtaExcDlgIgnorePage.Create(Self, Params));
+ AddPage(TJclOtaExcDlgTracePage.Create(Self, Params));
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaRepositoryReg.pas b/official/1.104/experts/repository/JclOtaRepositoryReg.pas
new file mode 100644
index 0000000..f5d4ab3
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaRepositoryReg.pas
@@ -0,0 +1,361 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaRepositoryReg.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-10-10 15:36:26 +0200 (ven., 10 oct. 2008) $ }
+{ Revision: $Rev:: 2539 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaRepositoryReg;
+
+interface
+
+{$I jcl.inc}
+
+{$IFDEF DELPHI}
+{$DEFINE DELPHIEXCDLG}
+{$ENDIF DELPHI}
+
+{$IFDEF BCB}
+{$DEFINE CBUILDEREXCDLG}
+{$ENDIF BCB}
+
+{$IFDEF COMPILER10_UP}
+{$DEFINE CBUILDEREXCDLG}
+{$ENDIF COMPILER10_UP}
+
+uses
+ SysUtils, Classes,
+ ToolsAPI,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclBorlandTools,
+ JclOtaUtils, JclOtaRepositoryUtils, JclOtaExcDlgRepository;
+
+type
+ TJclExcDlgExpert = class(TJclOtaRepositoryExpert)
+ public
+ procedure CreateExceptionDialog(const Params: TJclOtaExcDlgParams);
+ end;
+
+ TJclExcDlgDelphiExpert = class(TJclExcDlgExpert)
+ public
+ constructor Create; reintroduce;
+ destructor Destroy; override;
+
+ procedure DoExecute(const Personality: TJclBorPersonality); override;
+ function IsVisible(const Personality: TJclBorPersonality): Boolean; override;
+ end;
+
+ TJclExcDlgCBuilderExpert = class(TJclExcDlgExpert)
+ public
+ constructor Create; reintroduce;
+ destructor Destroy; override;
+
+ procedure DoExecute(const Personality: TJclBorPersonality); override;
+ function IsVisible(const Personality: TJclBorPersonality): Boolean; override;
+ end;
+
+// design package entry point
+procedure Register;
+
+// expert DLL entry point
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var TerminateProc: TWizardTerminateProc): Boolean; stdcall;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaRepositoryReg.pas $';
+ Revision: '$Revision: 2539 $';
+ Date: '$Date: 2008-10-10 15:36:26 +0200 (ven., 10 oct. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+ Windows,
+ JclStrings, JclFileUtils, JclRegistry,
+ JclOtaResources, JclOtaConsts, JclOtaTemplates, JclOtaExcDlgWizard;
+
+procedure Register;
+begin
+ try
+ {$IFDEF DELPHI}
+ if TJclOTAExpertBase.IsPersonalityLoaded(JclDelphiPersonality) then
+ RegisterPackageWizard(TJclExcDlgDelphiExpert.Create);
+ {$ENDIF DELPHI}
+ {$IFDEF BCB}
+ if TJclOTAExpertBase.IsPersonalityLoaded(JclCBuilderPersonality) then
+ RegisterPackageWizard(TJclExcDlgCBuilderExpert.Create);
+ {$ENDIF BCB}
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+var
+ {$IFDEF DELPHI}
+ JCLDelphiWizardIndex: Integer = -1;
+ {$ENDIF DELPHI}
+ {$IFDEF BCB}
+ JclCBuilderWizardIndex: Integer = -1;
+ {$ENDIF BCB}
+
+procedure JclWizardTerminate;
+var
+ OTAWizardServices: IOTAWizardServices;
+begin
+ try
+ OTAWizardServices := TJclOTAExpertBase.GetOTAWizardServices;
+
+ {$IFDEF DELPHI}
+ if JCLDelphiWizardIndex <> -1 then
+ OTAWizardServices.RemoveWizard(JCLDelphiWizardIndex);
+ {$ENDIF DELPHI}
+
+ {$IFDEF BCB}
+ if JclCBuilderWizardIndex <> -1 then
+ OTAWizardServices.RemoveWizard(JclCBuilderWizardIndex);
+ {$ENDIF BCB}
+ 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;
+
+ OTAWizardServices := TJclOTAExpertBase.GetOTAWizardServices;
+
+ {$IFDEF DELPHI}
+ //if IsPersonalityLoaded(BorlandIDEServices, JclDelphiPersonality) then
+ // JCLDelphiWizardIndex := OTAWizardServices.AddWizard(TJclExcDlgDelphiExpert.Create);
+ {$ENDIF DELPHI}
+ {$IFDEF BCB}
+ //if IsPersonalityLoaded(BorlandIDEServices, JclCBuilderPersonality) then
+ // JclCBuilderWizardIndex := OTAWizardServices.AddWizard(TJclExcDlgCBuilderExpert.Create);
+ {$ENDIF BCB}
+ Result := True;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ Result := False;
+ end;
+ end;
+end;
+
+//=== { TJclExcDlgExpert } ===================================================
+
+procedure TJclExcDlgExpert.CreateExceptionDialog(
+ const Params: TJclOtaExcDlgParams);
+ function LoadTemplate(const FileName: string): string;
+ var
+ AFileStream: TFileStream;
+ StreamLength: Int64;
+ AnsiResult: AnsiString;
+ begin
+ AnsiResult := '';
+ if FileName <> '' then
+ begin
+ AFileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ StreamLength := AFileStream.Size;
+ SetLength(AnsiResult, StreamLength);
+ AFileStream.ReadBuffer(AnsiResult[1], StreamLength);
+ finally
+ AFileStream.Free;
+ end;
+ end;
+ Result := string(AnsiResult);
+ end;
+const
+ TemplateSubDir = 'experts\debug\dialog\';
+ DelphiTemplate = 'ExceptDlg.Delphi32';
+ BCBTemplate = 'ExceptDlg.CBuilder32';
+var
+ JclSettingsKeyName, TemplatePath,
+ FormExtension, FormTemplate, FormContent, FormFileName,
+ HeaderExtension, HeaderTemplate, HeaderContent, HeaderFileName,
+ SourceExtension, SourceTemplate, SourceContent, SourceFileName: string;
+ OTAServices: IOTAServices;
+begin
+ OTAServices := GetOTAServices;
+ JclSettingsKeyName := StrEnsureSuffix('\', OTAServices.GetBaseRegistryKey) + RegJclKey;
+ TemplatePath := PathAddSeparator(RegReadString(HKCU, JclSettingsKeyName, 'RootDir')) + TemplateSubDir;
+
+ case Params.Language of
+ bpDelphi32:
+ begin
+ FormExtension := JclBorDesignerFormExtension[Params.Designer];
+ FormTemplate := TemplatePath + DelphiTemplate + FormExtension;
+ HeaderExtension := '';
+ HeaderTemplate := '';
+ SourceExtension := SourceExtensionPAS;
+ SourceTemplate := TemplatePath + DelphiTemplate + SourceExtension;
+ end;
+ bpBCBuilder32:
+ begin
+ FormExtension := JclBorDesignerFormExtension[Params.Designer];
+ FormTemplate := TemplatePath + BCBTemplate + FormExtension;
+ HeaderExtension := SourceExtensionH;
+ HeaderTemplate := TemplatePath + BCBTemplate + HeaderExtension;
+ SourceExtension := SourceExtensionCPP;
+ SourceTemplate := TemplatePath + BCBTemplate + SourceExtension;
+ end;
+ else
+ begin
+ FormExtension := '';
+ FormTemplate := '';
+ HeaderExtension := '';
+ HeaderTemplate := '';
+ SourceExtension := '';
+ SourceTemplate := '';
+ end;
+ end;
+
+ FormTemplate := LoadTemplate(FormTemplate);
+ HeaderTemplate := LoadTemplate(HeaderTemplate);
+ SourceTemplate := LoadTemplate(SourceTemplate);
+
+ FormContent := ApplyTemplate(FormTemplate, Params);
+ HeaderContent := ApplyTemplate(HeaderTemplate, Params);
+ SourceContent := ApplyTemplate(SourceTemplate, Params);
+
+ if Params.FileName <> '' then
+ begin
+ FormFileName := ChangeFileExt(Params.FileName, FormExtension);
+ HeaderFileName := ChangeFileExt(Params.FileName, HeaderExtension);
+ SourceFileName := ChangeFileExt(Params.FileName, SourceExtension);
+ end
+ else
+ begin
+ FormFileName := '';
+ HeaderFileName := '';
+ SourceFileName := '';
+ end;
+
+ CreateForm(Params.FormAncestor, Params.FormName, FormFileName, FormContent, SourceFileName,
+ SourceContent, HeaderFileName, HeaderContent);
+end;
+
+//=== { TJclRepositoryExpert } ===============================================
+
+constructor TJclExcDlgDelphiExpert.Create;
+begin
+ inherited Create(RsRepositoryExcDlgDelphiName, RsRepositoryExcDlgDelphiDescription,
+ RsAboutDialogTitle, RsRepositoryExcDlgPage, JclRepositoryCategoryDelphiFiles,
+ JclDesignerVcl, JclDelphiPersonality, LoadIcon(FindResourceHInstance(HInstance), 'JclExcDlg'), ritForm);
+end;
+
+destructor TJclExcDlgDelphiExpert.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TJclExcDlgDelphiExpert.DoExecute(const Personality: TJclBorPersonality);
+var
+ AParams: TJclOtaExcDlgParams;
+begin
+ AParams := TJclOtaExcDlgParams.Create;
+ try
+ AParams.Languages := [bpDelphi32];
+ AParams.Language := bpDelphi32;
+ AParams.ActivePersonality := bpDelphi32;
+ if ExcDlgWizard(AParams) and (AParams.Language <> bpUnknown) then
+ CreateExceptionDialog(AParams);
+ finally
+ AParams.Free;
+ end;
+end;
+
+function TJclExcDlgDelphiExpert.IsVisible(
+ const Personality: TJclBorPersonality): Boolean;
+begin
+ Result := Personality = bpDelphi32;
+end;
+
+//=== { TJclExcDlgCBuilderExpert } ===========================================
+
+constructor TJclExcDlgCBuilderExpert.Create;
+begin
+ inherited Create(RsRepositoryExcDlgCBuilderName, RsRepositoryExcDlgCBuilderDescription,
+ RsAboutDialogTitle, RsRepositoryExcDlgPage, JclRepositoryCategoryCBuilderFiles,
+ JclDesignerVcl, JclCBuilderPersonality, LoadIcon(FindResourceHInstance(HInstance), 'JclExcDlgCPP'), ritForm);
+end;
+
+destructor TJclExcDlgCBuilderExpert.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TJclExcDlgCBuilderExpert.DoExecute(
+ const Personality: TJclBorPersonality);
+var
+ AParams: TJclOtaExcDlgParams;
+begin
+ AParams := TJclOtaExcDlgParams.Create;
+ try
+ AParams.Languages := [bpDelphi32];
+ AParams.Language := bpDelphi32;
+ AParams.ActivePersonality := bpBCBuilder32;
+ if ExcDlgWizard(AParams) and (AParams.Language <> bpUnknown) then
+ CreateExceptionDialog(AParams);
+ finally
+ AParams.Free;
+ end;
+end;
+
+function TJclExcDlgCBuilderExpert.IsVisible(
+ const Personality: TJclBorPersonality): Boolean;
+begin
+ Result := Personality = bpBCBuilder32;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaRepositoryUtils.pas b/official/1.104/experts/repository/JclOtaRepositoryUtils.pas
new file mode 100644
index 0000000..948f792
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaRepositoryUtils.pas
@@ -0,0 +1,590 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaRepositoryUtils.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $ }
+{ Revision: $Rev:: 2498 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaRepositoryUtils;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Windows,
+ SysUtils,
+ ToolsAPI,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclBorlandTools,
+ JclOtaUtils;
+
+type
+ TJclRepositoryItemType = (ritForm, ritProject);
+
+ // abstraction layer for all versions of Delphi from 5 to 2006
+ TJclOTARepositoryExpert = class(TJclOTAExpert,
+ {$IFDEF COMPILER6_UP} IInterface, {$ELSE COMPILER6_UP} IUnknown, {$ENDIF COMPILER6_UP}
+ {$IFDEF COMPILER6_UP} IOTARepositoryWizard60, {$ENDIF COMPILER6_UP}
+ {$IFDEF COMPILER8_UP} IOTARepositoryWizard80, {$ENDIF COMPILER8_UP}
+ IOTARepositoryWizard,
+ {$IFDEF COMPILER10_UP} IOTAProjectWizard100, {$ENDIF COMPILER10_UP}
+ IOTAProjectWizard,
+ {$IFDEF COMPILER10_UP} IOTAFormWizard100, {$ENDIF COMPILER10_UP}
+ IOTAFormWizard)
+ private
+ FName: string;
+ FDescription: string;
+ FAuthor: string;
+ FPage: string;
+ FGalleryCategory: string;
+ FGlyph: Cardinal;
+ FItemType: TJclRepositoryItemType;
+ FDesigner: string;
+ FPersonality: string;
+ protected
+ procedure Execute; override;
+ function GetName: string; override;
+ function GetState: TWizardState; override;
+ function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
+ public
+ constructor Create(AName, ADescription, AAuthor, APage, AGalleryCategory,
+ ADesigner, APersonality: string; AGlyph: Cardinal;
+ AItemType: TJclRepositoryItemType); reintroduce;
+ destructor Destroy; override;
+
+ // override to customize
+ procedure DoExecute(const Personality: TJclBorPersonality); virtual;
+ function IsVisible(const Personality: TJclBorPersonality): Boolean; virtual;
+ public
+ // IOTARepositoryWizard
+ function GetAuthor: string;
+ function GetComment: string;
+ function GetPage: string;
+ function GetGlyph: {$IFDEF COMPILER6_UP} Cardinal {$ELSE COMPILER6_UP} HICON {$ENDIF COMPILER6_UP};
+
+ {$IFDEF COMPILER6_UP}
+ // IOTARepositoryWizard60
+ function GetDesigner: string;
+ {$ENDIF COMPILER6_UP}
+
+ {$IFDEF COMPILER8_UP}
+ // IOTARepositoryWizard80
+ function GetGalleryCategory: IOTAGalleryCategory;
+ function GetPersonality: string;
+ {$ENDIF COMPILER8_UP}
+
+ // IOTAProjectWizard
+
+ {$IFDEF COMPILER10_UP}
+ // IOTAProjectWizard100
+ function IsProjectWizardVisible(Project: IOTAProject): Boolean;
+ function IOTAProjectWizard100.IsVisible = IsProjectWizardVisible;
+ {$ENDIF COMPILER10_UP}
+
+ // IOTAFormWizard
+
+ {$IFDEF COMPILER10_UP}
+ // IOTAFormWizard100
+ function IsFormWizardVisible(Project: IOTAProject): Boolean;
+ function IOTAFormWizard100.IsVisible = IsFormWizardVisible;
+ {$ENDIF COMPILER10_UP}
+
+ property Name: string read FName;
+ public
+ function CreateForm(const FormAncestor, FormName: string;
+ const FormFileName: TFileName; const FormContent: string;
+ const SourceFileName: TFileName; const SourceContent: string;
+ const HeaderFileName: TFileName; const HeaderContent: string): IOTAModule;
+ end;
+
+ TJclOtaFormCreator = class(TInterfacedObject, IOTACreator, IOTAModuleCreator)
+ private
+ FFormFileName: TFileName;
+ FFormContent: string;
+ FSourceFileName: TFileName;
+ FSourceContent: string;
+ FHeaderFileName: TFileName;
+ FHeaderContent: string;
+ FFormAncestor: string;
+ FFormName: string;
+ FProjectModule: IOTAProject;
+ procedure SaveFile(const FileName: TFileName; const FileContent: string);
+ public
+ constructor Create(const ProjectModule: IOTAProject;
+ const FormAncestor, FormName: string;
+ const FormFileName: TFileName; const FormContent: string;
+ const SourceFileName: TFileName; const SourceContent: string;
+ const HeaderFileName: TFileName; const HeaderContent: string); reintroduce;
+ destructor Destroy; override;
+ // IOTACreator
+ function GetCreatorType: string;
+ function GetExisting: Boolean;
+ function GetFileSystem: string;
+ function GetOwner: IOTAModule;
+ function GetUnnamed: Boolean;
+
+ // IOTAModuleCreator
+ function GetAncestorName: string;
+ function GetImplFileName: string;
+ function GetIntfFileName: string;
+ function GetFormName: string;
+ function GetMainForm: Boolean;
+ function GetShowForm: Boolean;
+ function GetShowSource: Boolean;
+ function NewFormFile(const FormIdent, AncestorIdent: string): IOTAFile;
+ function NewImplSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
+ function NewIntfSource(const ModuleIdent, FormIdent, AncestorIdent: string): IOTAFile;
+ procedure FormCreated(const FormEditor: IOTAFormEditor);
+ end;
+
+ TJclOtaFile = class(TInterfacedObject, IOTAFile)
+ private
+ FFileName: string;
+ FContent: string;
+ public
+ constructor Create(const AFileName, AContent: string); reintroduce;
+ function GetSource: string;
+ function GetAge: TDateTime;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaRepositoryUtils.pas $';
+ Revision: '$Revision: 2498 $';
+ Date: '$Date: 2008-09-27 12:26:07 +0200 (sam., 27 sept. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+ Classes, ActiveX,
+ JclDateTime, JclFileUtils, JclOtaResources, JclOtaTemplates;
+
+//=== { TJclOTARepositoryExpert } ============================================
+
+constructor TJclOTARepositoryExpert.Create(AName, ADescription, AAuthor, APage,
+ AGalleryCategory, ADesigner, APersonality: string; AGlyph: Cardinal;
+ AItemType: TJclRepositoryItemType);
+begin
+ inherited Create(AName);
+ FName := AName;
+ FDescription := ADescription;
+ FAuthor := AAuthor;
+ FPage := APage;
+ FGalleryCategory := AGalleryCategory;
+ FGlyph := AGlyph;
+ FItemType := AItemType;
+ FDesigner := ADesigner;
+ FPersonality := APersonality;
+end;
+
+function TJclOTARepositoryExpert.CreateForm(const FormAncestor, FormName: string;
+ const FormFileName: TFileName; const FormContent: string;
+ const SourceFileName: TFileName; const SourceContent: string;
+ const HeaderFileName: TFileName; const HeaderContent: string): IOTAModule;
+var
+ AModuleCreator: IOTAModuleCreator;
+begin
+ AModuleCreator := TJclOtaFormCreator.Create(GetActiveProject, FormAncestor,
+ FormName, FormFileName, FormContent, SourceFileName, SourceContent,
+ HeaderFileName, HeaderContent);
+ try
+ Result := GetOTAModuleServices.CreateModule(AModuleCreator);
+ finally
+ AModuleCreator := nil;
+ end;
+end;
+
+destructor TJclOTARepositoryExpert.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TJclOTARepositoryExpert.DoExecute(
+ const Personality: TJclBorPersonality);
+begin
+ // inherit to customize
+end;
+
+procedure TJclOTARepositoryExpert.Execute;
+var
+ Personality: TJclBorPersonality;
+begin
+ try
+ Personality := ActivePersonality;
+ if Personality <> bpUnknown then
+ DoExecute(Personality);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+//IOTARepositoryWizard.GetAuthor
+function TJclOTARepositoryExpert.GetAuthor: string;
+begin
+ Result := FAuthor;
+end;
+
+//IOTARepositoryWizard.GetComment
+function TJclOTARepositoryExpert.GetComment: string;
+begin
+ Result := FDescription;
+end;
+
+{$IFDEF COMPILER6_UP}
+//IOTARepositoryWizard60.GetDesigner
+function TJclOTARepositoryExpert.GetDesigner: string;
+begin
+ Result := FDesigner;
+end;
+{$ENDIF COMPILER6_UP}
+
+{$IFDEF COMPILER8_UP}
+// IOTARepositoryWizard80.GetGalleryCategory
+function TJclOTARepositoryExpert.GetGalleryCategory: IOTAGalleryCategory;
+begin
+ try
+ Result := GetOTAGalleryCategoryManager.FindCategory(FGalleryCategory);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+{$ENDIF COMPILER8_UP}
+
+//IOTARepositoryWizard.GetGlyph
+function TJclOTARepositoryExpert.GetGlyph: {$IFDEF COMPILER6_UP} Cardinal {$ELSE COMPILER6_UP} HICON {$ENDIF COMPILER6_UP};
+begin
+ Result := FGlyph;
+end;
+
+function TJclOTARepositoryExpert.GetName: string;
+begin
+ Result := FName;
+end;
+
+//IOTARepositoryWizard.GetPage
+function TJclOTARepositoryExpert.GetPage: string;
+begin
+ Result := FPage;
+end;
+
+function TJclOTARepositoryExpert.GetState: TWizardState;
+begin
+ try
+ if IsVisible(ActivePersonality) then
+ Result := [wsEnabled]
+ else
+ Result := [];
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+{$IFDEF COMPILER8_UP}
+//IOTARepositoryWizard80.GetPage
+function TJclOTARepositoryExpert.GetPersonality: string;
+begin
+ Result := FPersonality;
+end;
+{$ENDIF COMPILER8_UP}
+
+{$IFDEF COMPILER10_UP}
+//IOTAFormWizard100.IsVisible
+function TJclOTARepositoryExpert.IsFormWizardVisible(
+ Project: IOTAProject): Boolean;
+begin
+ try
+ Result := (FItemType = ritForm) and Assigned(Project)
+ and IsVisible(PersonalityTextToId(Project.Personality));
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+{$ENDIF COMPILER10_UP}
+
+{$IFDEF COMPILER10_UP}
+//IOTAProjectWizard100.IsVisible
+function TJclOTARepositoryExpert.IsProjectWizardVisible(
+ Project: IOTAProject): Boolean;
+begin
+ try
+ Result := (FItemType = ritProject) and Assigned(Project)
+ and IsVisible(PersonalityTextToId(Project.Personality));
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+{$ENDIF COMPILER10_UP}
+
+function TJclOTARepositoryExpert.IsVisible(
+ const Personality: TJclBorPersonality): Boolean;
+begin
+ // override to customize
+ Result := Personality <> bpUnknown;
+end;
+
+function TJclOTARepositoryExpert.QueryInterface(const IID: TGUID;
+ out Obj): HResult; stdcall;
+begin
+ if (IsEqualGUID(IID, IOTAFormWizard) and (FItemType <> ritForm))
+ {$IFDEF COMPILER10_UP}
+ or (IsEqualGUID(IID, IOTAFormWizard100) and (FItemType <> ritForm))
+ or (IsEqualGUID(IID, IOTAProjectWizard100) and (FItemType <> ritProject))
+ {$ENDIF COMPILER10_UP}
+ or (IsEqualGUID(IID, IOTAProjectWizard) and (FItemType <> ritProject)) then
+ begin
+ Result := E_NOINTERFACE;
+ Pointer(Obj) := nil;
+ end
+ else
+ Result := inherited QueryInterface(IID, Obj);
+end;
+
+//=== { TJclOtaModuleCreator } ===============================================
+
+constructor TJclOtaFormCreator.Create(const ProjectModule: IOTAProject;
+ const FormAncestor, FormName: string;
+ const FormFileName: TFileName; const FormContent: string;
+ const SourceFileName: TFileName; const SourceContent: string;
+ const HeaderFileName: TFileName; const HeaderContent: string);
+begin
+ inherited Create;
+ FProjectModule := ProjectModule;
+ FFormAncestor := FormAncestor;
+ FFormName := FormName;
+ FFormFileName := FormFileName;
+ FFormContent := FormContent;
+ FSourceFileName := SourceFileName;
+ FSourceContent := SourceContent;
+ FHeaderFileName := HeaderFileName;
+ FHeaderContent := HeaderContent;
+end;
+
+destructor TJclOtaFormCreator.Destroy;
+begin
+ FProjectModule := nil;
+ inherited Destroy;
+end;
+
+procedure TJclOtaFormCreator.FormCreated(const FormEditor: IOTAFormEditor);
+begin
+ // nothing
+end;
+
+function TJclOtaFormCreator.GetAncestorName: string;
+begin
+ Result := FFormAncestor;
+end;
+
+function TJclOtaFormCreator.GetCreatorType: string;
+begin
+ // form module
+ Result := sForm;
+end;
+
+function TJclOtaFormCreator.GetExisting: Boolean;
+begin
+ // new module
+ Result := (FSourceFileName <> '') and (FFormFileName <> '') and (FHeaderFileName <> '');
+end;
+
+function TJclOtaFormCreator.GetFileSystem: string;
+begin
+ // no file system
+ Result := '';
+end;
+
+function TJclOtaFormCreator.GetFormName: string;
+begin
+ Result := FFormName;
+end;
+
+function TJclOtaFormCreator.GetImplFileName: string;
+begin
+ if (FFormContent <> '') and (FFormFileName <> '') then
+ SaveFile(FFormFileName, GetFinalFormContent(FFormContent, FFormName, FFormAncestor));
+
+ if (FSourceContent <> '') and (FSourceFileName <> '') then
+ SaveFile(FSourceFileName, GetFinalSourceContent(FSourceContent, PathExtractFileNameNoExt(FSourceFileName), FFormName, FFormAncestor));
+
+ Result := FSourceFileName;
+end;
+
+function TJclOtaFormCreator.GetIntfFileName: string;
+begin
+ if (FHeaderContent <> '') and (FHeaderFileName <> '') then
+ SaveFile(FHeaderFileName, GetFinalHeaderContent(FHeaderContent, PathExtractFileNameNoExt(FSourceFileName), FFormName, FFormAncestor));
+
+ Result := FHeaderFileName;
+end;
+
+function TJclOtaFormCreator.GetMainForm: Boolean;
+begin
+ // it is not the main form
+ Result := False;
+end;
+
+function TJclOtaFormCreator.GetOwner: IOTAModule;
+begin
+ // the owner is the project
+ Result := FProjectModule;
+end;
+
+function TJclOtaFormCreator.GetShowForm: Boolean;
+begin
+ // shows the form once created
+ Result := False;
+end;
+
+function TJclOtaFormCreator.GetShowSource: Boolean;
+begin
+ // shows the source once created
+ Result := True;
+end;
+
+function TJclOtaFormCreator.GetUnnamed: Boolean;
+begin
+ // the save-as dialog will be displayed
+ Result := ((FFormFileName = '') and (FFormContent <> ''))
+ or ((FSourceFileName = '') and (FSourceContent <> ''))
+ or ((FHeaderFileName = '') and (FHeaderContent <> ''));
+end;
+
+function TJclOtaFormCreator.NewFormFile(const FormIdent,
+ AncestorIdent: string): IOTAFile;
+begin
+ if FFormContent <> '' then
+ Result := TJclOtaFile.Create(FFormFileName, GetFinalFormContent(FFormContent, FormIdent, AncestorIdent))
+ else
+ Result := nil;
+end;
+
+function TJclOtaFormCreator.NewImplSource(const ModuleIdent, FormIdent,
+ AncestorIdent: string): IOTAFile;
+begin
+ if FSourceContent <> '' then
+ Result := TJclOtaFile.Create(FSourceFileName, GetFinalSourceContent(FSourceContent, ModuleIdent, FormIdent, AncestorIdent))
+ else
+ Result := nil;
+end;
+
+function TJclOtaFormCreator.NewIntfSource(const ModuleIdent, FormIdent,
+ AncestorIdent: string): IOTAFile;
+begin
+ if FHeaderContent <> '' then
+ Result := TJclOtaFile.Create(FHeaderFileName, GetFinalHeaderContent(FHeaderContent, ModuleIdent, FormIdent, AncestorIdent))
+ else
+ Result := nil;
+end;
+
+procedure TJclOtaFormCreator.SaveFile(const FileName: TFileName; const FileContent: string);
+var
+ AFileStream: TFileStream;
+ Buffer: AnsiString;
+begin
+ AFileStream := TFileStream.Create(FileName, fmCreate);
+ try
+ Buffer := AnsiString(FileContent);
+ AFileStream.WriteBuffer(Buffer[1], Length(Buffer));
+ finally
+ AFileStream.Free;
+ end;
+end;
+
+//=== { TJclOtaFile } ========================================================
+
+constructor TJclOtaFile.Create(const AFileName, AContent: string);
+begin
+ inherited Create;
+ FContent := AContent;
+ FFileName := AFileName;
+end;
+
+function TJclOtaFile.GetAge: TDateTime;
+var
+ AFileTime: TFileTime;
+ AFileStream: TFileStream;
+begin
+ // new file
+ if FFileName <> '' then
+ begin
+ try
+ AFileStream := TFileStream.Create(FFileName, fmOpenRead);
+ try
+ if GetFileTime(AFileStream.Handle, nil, nil, @AFileTime) then
+ Result := FileTimeToDateTime(AFileTime)
+ else
+ Result := -1;
+ finally
+ AFileStream.Free;
+ end;
+ except
+ Result := -1;
+ end;
+ end
+ else
+ Result := -1;
+end;
+
+function TJclOtaFile.GetSource: string;
+begin
+ // return the file content
+ Result := FContent;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/JclOtaTemplates.pas b/official/1.104/experts/repository/JclOtaTemplates.pas
new file mode 100644
index 0000000..4ecc86e
--- /dev/null
+++ b/official/1.104/experts/repository/JclOtaTemplates.pas
@@ -0,0 +1,343 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclOtaTemplates.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All rights reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclOtaTemplates;
+
+interface
+
+{$I jcl.inc}
+
+uses
+ Classes,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclBorlandTools;
+
+type
+ TJclOtaTemplateParams = class(TPersistent)
+ protected
+ FLanguage: TJclBorPersonality;
+ public
+ function GetBoolValue(const Name: string): Boolean; virtual;
+ function IsDefined(const Name: string): Boolean; virtual;
+ function GetStrValue(const Name: string): string; virtual;
+ function GetIntValue(const Name: string): Integer; virtual;
+ function GetStringsValue(const Name: string): TStrings; virtual;
+
+ property Language: TJclBorPersonality read FLanguage write FLanguage;
+ end;
+
+const
+ ModulePattern = '%MODULENAME%';
+ FormPattern = '%FORMNAME%';
+ AncestorPattern = '%ANCESTORNAME%';
+
+function GetFinalFormContent(const Content, FormIdent,
+ AncestorIdent: string): string;
+function GetFinalHeaderContent(const Content, ModuleIdent, FormIdent,
+ AncestorIdent: string): string;
+function GetFinalSourceContent(const Content, ModuleIdent, FormIdent,
+ AncestorIdent: string): string;
+
+function ApplyTemplate(const Template: string;
+ const Params: TJclOtaTemplateParams): string;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/repository/JclOtaTemplates.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\repository'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+ SysUtils,
+ {$IFDEF HAS_UNIT_VARIANTS}
+// Variants,
+ {$ENDIF HAS_UNIT_VARIANTS}
+ TypInfo,
+ JclStrings, JclSysUtils;
+
+function GetFinalFormContent(const Content, FormIdent,
+ AncestorIdent: string): string;
+begin
+ Result := StringReplace(Content, FormPattern, FormIdent, [rfReplaceAll, rfIgnoreCase]);
+ Result := StringReplace(Result, AncestorPattern, AncestorIdent, [rfReplaceAll, rfIgnoreCase]);
+end;
+
+function GetFinalHeaderContent(const Content, ModuleIdent, FormIdent,
+ AncestorIdent: string): string;
+begin
+ Result := StringReplace(Content, FormPattern, FormIdent, [rfReplaceAll, rfIgnoreCase]);
+ Result := StringReplace(Result, AncestorPattern, AncestorIdent, [rfReplaceAll, rfIgnoreCase]);
+ Result := StringReplace(Result, ModulePattern, ModuleIdent, [rfReplaceAll, rfIgnoreCase]);
+end;
+
+function GetFinalSourceContent(const Content, ModuleIdent, FormIdent, AncestorIdent: string): string;
+begin
+ Result := StringReplace(Content, FormPattern, FormIdent, [rfReplaceAll, rfIgnoreCase]);
+ Result := StringReplace(Result, AncestorPattern, AncestorIdent, [rfReplaceAll, rfIgnoreCase]);
+ Result := StringReplace(Result, ModulePattern, ModuleIdent, [rfReplaceAll, rfIgnoreCase]);
+end;
+
+function ApplyTemplate(const Template: string;
+ const Params: TJclOtaTemplateParams): string;
+ procedure CopyStr(var Dest: string; var IndexDest: Integer;
+ var DestCharCount: Integer; const Src: string; IndexSrc: Integer;
+ CharCount: Integer);
+ begin
+ if (Length(Src) - IndexSrc + 1) < CharCount then
+ CharCount := Length(Src) - IndexSrc + 1;
+ while (DestCharCount - IndexDest + 1) < CharCount do
+ begin
+ DestCharCount := 2 * DestCharCount;
+ SetLength(Dest, DestCharCount);
+ end;
+
+ if CharCount > 0 then
+ begin
+ Move(Src[IndexSrc], Dest[IndexDest], CharCount*SizeOf(Char));
+ Inc(IndexDest, CharCount);
+ end;
+ end;
+ function SkipBlanks(const Str: string; const Index: Integer;
+ Count: Integer): Integer;
+ begin
+ Result := Index;
+ while (Result <= Count) and CharIsWhiteSpace(Str[Result]) do
+ Inc(Result);
+ end;
+ function GetIdentifier(const Str: string; var Index: Integer;
+ Count: Integer): string;
+ var
+ IndexStart: Integer;
+ begin
+ IndexStart := Index;
+ while (Index <= Count) and CharIsValidIdentifierLetter(Str[Index]) or (Str[Index] = '%') do
+ Inc(Index);
+ Result := Copy(Str, IndexStart, Index - IndexStart);
+ end;
+var
+ IndexInput, IndexOutput, TokenPos, CharCountIn, CharCountOut,
+ IfCount, StrIndex, RepeatCount: Integer;
+ Identifier, Command, Symbol, StrValue, RepeatPattern, RepeatValue: string;
+ StrList: TStrings;
+begin
+ CharCountIn := Length(Template);
+ CharCountOut := 2*CharCountIn;
+ SetLength(Result, CharCountOut);
+ IndexInput := 1;
+ IndexOutput := 1;
+ IfCount := 0;
+ while IndexInput < CharCountIn do
+ begin
+ TokenPos := CharPos(Template, '%', IndexInput);
+
+ if TokenPos = 0 then
+ begin
+ CopyStr(Result, IndexOutput, CharCountOut, Template, IndexInput, CharCountIn - IndexInput + 1);
+ SetLength(Result, IndexOutput - 1);
+ Exit;
+ end
+ else
+ begin
+ if IfCount = 0 then
+ CopyStr(Result, IndexOutput, CharCountOut, Template, IndexInput, TokenPos - IndexInput);
+
+ Identifier := GetIdentifier(Template, TokenPos, CharCountIn);
+ Command := StrUpper(Identifier);
+
+ if Command = '%IF' then
+ begin
+ TokenPos := SkipBlanks(Template, TokenPos, CharCountIn);
+ Symbol := GetIdentifier(Template, TokenPos, CharCountIn);
+ if (IfCount > 0) or not Params.IsDefined(Symbol) then
+ begin
+ Inc(IfCount);
+ end;
+ end
+ else if Command = '%IFNOT' then
+ begin
+ TokenPos := SkipBlanks(Template, TokenPos, CharCountIn);
+ Symbol := GetIdentifier(Template, TokenPos, CharCountIn);
+ if (IfCount > 0) or Params.IsDefined(Symbol) then
+ Inc(IfCount);
+ end
+ else if Command = '%ELSE' then
+ begin
+ if IfCount = 1 then
+ IfCount := 0
+ else if IfCount = 0 then
+ IfCount := 1;
+ end
+ else if Command = '%ENDIF' then
+ begin
+ if IfCount > 0 then
+ Dec(IfCount);
+ end
+ else if Command = '%STRVALUE' then
+ begin
+ TokenPos := SkipBlanks(Template, TokenPos, CharCountIn);
+ Symbol := GetIdentifier(Template, TokenPos, CharCountIn);
+ if IfCount = 0 then
+ begin
+ StrValue := Params.GetStrValue(Symbol);
+ case Params.Language of
+ bpDelphi32:
+ begin
+ StrValue := StringReplace(StrValue, NativeSingleQuote, NativeSingleQuote + NativeSingleQuote, [rfReplaceAll]);
+ StrValue := NativeSingleQuote + StrValue + NativeSingleQuote;
+ end;
+ bpBCBuilder32:
+ begin
+ StrValue := StringReplace(StrValue, NativeDoubleQuote, NativeBackslash + NativeDoubleQuote, [rfReplaceAll]);
+ StrValue := NativeDoubleQuote + StrValue + NativeDoubleQuote;
+ end;
+ end;
+ CopyStr(Result, IndexOutput, CharCountOut, StrValue, 1, Length(StrValue));
+ end;
+ end
+ else if Command = '%INTVALUE' then
+ begin
+ TokenPos := SkipBlanks(Template, TokenPos, CharCountIn);
+ Symbol := GetIdentifier(Template, TokenPos, CharCountIn);
+ if IfCount = 0 then
+ begin
+ StrValue := IntToStr(Params.GetIntValue(Symbol));
+ CopyStr(Result, IndexOutput, CharCountOut, StrValue, 1, Length(StrValue));
+ end;
+ end
+ else if Command = '%BOOLVALUE' then
+ begin
+ TokenPos := SkipBlanks(Template, TokenPos, CharCountIn);
+ Symbol := GetIdentifier(Template, TokenPos, CharCountIn);
+ if IfCount = 0 then
+ begin
+ StrValue := BooleanToStr(Params.GetBoolValue(Symbol));
+ CopyStr(Result, IndexOutput, CharCountOut, StrValue, 1, Length(StrValue));
+ end;
+ end
+ else if Command = '%REPEATLINE' then
+ begin
+ TokenPos := SkipBlanks(Template, TokenPos, CharCountIn);
+ Symbol := GetIdentifier(Template, TokenPos, CharCountIn);
+ if IfCount = 0 then
+ begin
+ RepeatCount := Params.GetIntValue(Symbol);
+ StrIndex := TokenPos;
+ while (StrIndex <= CharCountIn) and not CharIsReturn(Template[StrIndex]) do
+ Inc(StrIndex);
+ RepeatPattern := Copy(Template, TokenPos, StrIndex - TokenPos);
+ TokenPos := StrIndex;
+
+ while RepeatCount > 0 do
+ begin
+ StrValue := RepeatPattern;
+ StrIndex := Pos('%', StrValue);
+ while StrIndex > 0 do
+ begin
+ Inc(StrIndex);
+ Symbol := GetIdentifier(StrValue, StrIndex, Length(StrValue));
+ StrList := Params.GetStringsValue(Symbol);
+ if Assigned(StrList) then
+ RepeatValue := StrList.Strings[RepeatCount - 1]
+ else
+ RepeatValue := '';
+ StrReplace(StrValue, '%' + Symbol, RepeatValue, [rfReplaceAll, rfIgnoreCase]);
+ StrIndex := Pos('%', StrValue);
+ end;
+ CopyStr(Result, IndexOutput, CharCountOut, StrValue, 1, Length(StrValue));
+ CopyStr(Result, IndexOutput, CharCountOut, NativeLineBreak, 1, Length(NativeLineBreak));
+ Dec(RepeatCount);
+ end;
+ end;
+ end
+ else if IfCount = 0 then
+ CopyStr(Result, IndexOutput, CharCountOut, Identifier, 1, Length(Identifier));
+
+ IndexInput := TokenPos;
+ end;
+ end;
+end;
+
+//=== { TJclOtaTemplateParams } ==============================================
+
+function TJclOtaTemplateParams.GetBoolValue(const Name: string): Boolean;
+var
+ VariantValue: Variant;
+begin
+ VariantValue := GetPropValue(Self, Name);
+ Result := Boolean(VariantValue);
+end;
+
+function TJclOtaTemplateParams.GetIntValue(const Name: string): Integer;
+var
+ VariantValue: Variant;
+begin
+ VariantValue := GetPropValue(Self, Name);
+ Result := Integer(VariantValue);
+end;
+
+function TJclOtaTemplateParams.GetStringsValue(const Name: string): TStrings;
+var
+ Instance: TObject;
+begin
+ Instance := TObject(GetOrdProp(Self, Name));
+ if Instance is TStrings then
+ Result := TStrings(Instance)
+ else
+ Result := nil;
+end;
+
+function TJclOtaTemplateParams.GetStrValue(const Name: string): string;
+var
+ VariantValue: Variant;
+begin
+ VariantValue := GetPropValue(Self, Name, True);
+ Result := string(VariantValue);
+end;
+
+function TJclOtaTemplateParams.IsDefined(const Name: string): Boolean;
+begin
+ Result := GetBoolValue(Name);
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/repository/dirinfo.txt b/official/1.104/experts/repository/dirinfo.txt
new file mode 100644
index 0000000..2c9b281
--- /dev/null
+++ b/official/1.104/experts/repository/dirinfo.txt
@@ -0,0 +1 @@
+This is the directory where shared units for object repository reside.
\ No newline at end of file
diff --git a/official/1.104/experts/useswizard/Hardlinks.txt b/official/1.104/experts/useswizard/Hardlinks.txt
new file mode 100644
index 0000000..662d0ed
--- /dev/null
+++ b/official/1.104/experts/useswizard/Hardlinks.txt
@@ -0,0 +1,6 @@
+TFNCreateHardLinkA
+TFNCreateHardLinkW
+bRtdlFunctionsLoaded
+CreateHardLinkA
+CreateHardLinkW
+hNtDll
diff --git a/official/1.104/experts/useswizard/History.txt b/official/1.104/experts/useswizard/History.txt
new file mode 100644
index 0000000..13c4919
--- /dev/null
+++ b/official/1.104/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.104/experts/useswizard/IdentifierList.dpr b/official/1.104/experts/useswizard/IdentifierList.dpr
new file mode 100644
index 0000000..0abd7eb
--- /dev/null
+++ b/official/1.104/experts/useswizard/IdentifierList.dpr
@@ -0,0 +1,156 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is IdentifierList.dpr. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $ }
+{ Revision: $Rev:: 2461 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+// note: this program converts the xml output of Doc-o-matic =,,...
+
+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;
+
+procedure TJCLUsesWizard.LoadSettings;
+var
+ DefaultIniFile, DefaultRegKey: string;
+ OTAServices: IOTAServices;
+begin
+ OTAServices := GetOTAServices;
+ DefaultRegKey := StrEnsureSuffix(NativeBackslash, OTAServices.GetBaseRegistryKey) + RegJclKey;
+ DefaultIniFile := RegReadStringDef(HKCU, DefaultRegKey, JclRootDirValueName, '');
+ if DefaultIniFile <> '' then
+ DefaultIniFile := PathAddSeparator(DefaultIniFile) + JclIniFileLocation;
+
+ ConfirmChanges := Settings.LoadBool(SRegWizardConfirm, True);
+ IniFile := Settings.LoadString(SRegWizardIniFile, DefaultIniFile);
+ Active := Settings.LoadBool(SRegWizardActive, False);
+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;
+ ActiveProject: 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
+ ActiveProject := GetActiveProject;
+ if Assigned(ActiveProject) and Assigned(ActiveProject.ProjectBuilder) then
+ ActiveProject.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
+ ActiveProject := GetActiveProject;
+ if Assigned(ActiveProject) and Assigned(ActiveProject.ProjectBuilder) then
+ ActiveProject.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
+ ActiveProject := GetActiveProject;
+ if Assigned(ActiveProject) and Assigned(ActiveProject.ProjectBuilder) then
+ ActiveProject.ProjectBuilder.BuildProject(cmOTAMake, True, True);
+ end;
+ finally
+ ChangeList.Free;
+ end;
+ end;
+ finally
+ Goal.Free;
+ end;
+end;
+
+procedure TJCLUsesWizard.RegisterCommands;
+begin
+ LoadSettings;
+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.SaveSettings;
+begin
+ Settings.SaveBool(SRegWizardConfirm, ConfirmChanges);
+ Settings.SaveString(SRegWizardIniFile, IniFile);
+ Settings.SaveBool(SRegWizardActive, Active);
+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.UnregisterCommands;
+begin
+ SaveSettings;
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/useswizard/Jcl8087.txt b/official/1.104/experts/useswizard/Jcl8087.txt
new file mode 100644
index 0000000..2e2aa64
--- /dev/null
+++ b/official/1.104/experts/useswizard/Jcl8087.txt
@@ -0,0 +1,20 @@
+Get8087ControlWord
+Get8087Infinity
+Get8087Precision
+Get8087Rounding
+GetPending8087Exceptions
+Mask8087Exceptions
+Set8087ControlWord
+Set8087Infinity
+Set8087Precision
+Set8087Rounding
+SetMasked8087Exceptions
+Unmask8087Exceptions
+T8087Exception
+All8087Exceptions
+ClearPending8087Exceptions
+GetMasked8087Exceptions
+T8087Precision
+T8087Rounding
+T8087Infinity
+Get8087StatusWord
diff --git a/official/1.104/experts/useswizard/JclAbstractContainers.txt b/official/1.104/experts/useswizard/JclAbstractContainers.txt
new file mode 100644
index 0000000..3e03ac0
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclAbstractContainers.txt
@@ -0,0 +1,2 @@
+TJclStrCollection
+TJclAbstractContainer
diff --git a/official/1.104/experts/useswizard/JclAlgorithms.txt b/official/1.104/experts/useswizard/JclAlgorithms.txt
new file mode 100644
index 0000000..95d71f2
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclAlgorithms.txt
@@ -0,0 +1,43 @@
+Apply
+Apply
+Apply
+Copy
+Copy
+Copy
+CountObject
+CountObject
+CountObject
+Fill
+Fill
+Fill
+Find
+Find
+Find
+Generate
+Generate
+Generate
+IntegerCompare
+IntfSimpleCompare
+QuickSort
+QuickSort
+QuickSort
+Reverse
+Reverse
+Reverse
+SimpleCompare
+Sort
+Sort
+Sort
+StrSimpleCompare
+TApplyFunction
+TCompare
+TIntfApplyFunction
+TIntfCompare
+TIntfSortProc
+TSortProc
+TStrApplyFunction
+TStrCompare
+TStrSortProc
+IntfSortProc
+SortProc
+StrSortProc
diff --git a/official/1.104/experts/useswizard/JclAnsiStrings.txt b/official/1.104/experts/useswizard/JclAnsiStrings.txt
new file mode 100644
index 0000000..605a5cf
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclAnsiStrings.txt
@@ -0,0 +1,167 @@
+AddStringToStrings
+AllocateMultiSz
+AllocateWideMultiSz
+ArrayOf
+CharLastPos
+FreeWideMultiSz
+MultiSzDup
+MultiSzLength
+StrFillChar
+StrIToStrings
+StrResetLength
+StrToFloatSafe
+StrToIntSafe
+StrWord
+WideMultiSzDup
+WideMultiSzLength
+WideMultiSzToWideStrings
+WideStringsToWideMultiSz
+EJclStringError
+PCharVector
+PMultiSz
+PWideMultiSz
+AnsiDecDigits
+AnsiHexDigits
+AnsiLetters
+AnsiLowercaseLetters
+AnsiNull
+AnsiOctDigits
+AnsiSigns
+AnsiUppercaseLetters
+AnsiValidIdentifierLetters
+AnsiWhiteSpace
+C1_ALPHA
+C1_BLANK
+C1_CNTRL
+C1_DIGIT
+C1_LOWER
+C1_PUNCT
+C1_SPACE
+C1_UPPER
+C1_XDIGIT
+CharIPos
+CharPos
+CharReplace
+CharEqualNoCase
+CharIsAlpha
+CharIsAlphaNum
+CharIsBlank
+CharIsControl
+CharIsDelete
+CharIsDigit
+CharIsLower
+CharIsNumberChar
+CharIsPrintable
+CharIsPunctuation
+CharIsReturn
+CharIsSpace
+CharIsUpper
+CharIsWhiteSpace
+CharType
+CharHex
+CharLower
+CharToggleCase
+CharUpper
+FileToString
+StringToFile
+StrToken
+StrTokens
+StrTokenToStrings
+BooleanToStr
+StrNormIndex
+StringsToMultiSz
+MultiSzToStrings
+FreeMultiSz
+StringsToPCharVector
+PCharVectorCount
+PCharVectorToStrings
+FreePCharVector
+StrAfter
+StrBefore
+StrBetween
+StrChopRight
+StrLeft
+StrMid
+StrRestOf
+StrRight
+StrAddRef
+StrAllocSize
+StrDecRef
+StrLen
+StrLength
+StrRefCount
+StrCharCount
+StrCompareRange
+StrFillChar
+StrFind
+StrHasPrefix
+StrILastPos
+StrIndex
+StrIPos
+StrIsOneOf
+StrKeepChars
+StrLastPos
+StrMatch
+StrNIPos
+StrNPos
+StrPrefixIndex
+StrReplace
+StrReplaceButChars
+StrReplaceChar
+StrReplaceChars
+StrSearch
+StrStrCount
+StrCompare
+StrConsistsOfNumberChars
+StrContainsChars
+StrIsAlpha
+StrIsAlphaNum
+StrIsAlphaNumUnderscore
+StrIsDigit
+StrIsSubset
+StrMatches
+StrSame
+StrAnsiToOem
+StrCenter
+StrCharsCount
+StrDoubleQuote
+StrEnsureNoPrefix
+StrEnsureNoSuffix
+StrEnsurePrefix
+StrEnsureSuffix
+StrEscapedToString
+StrLower
+StrLowerBuff
+StrLowerInPlace
+StrMove
+StrOemToAnsi
+StrPadLeft
+StrPadRight
+StrProper
+StrProperBuff
+StrQuote
+StrRemoveChars
+StrRepeat
+StrReverse
+StrReverseInPlace
+StrSingleQuote
+StrSmartCase
+StrStringToEscaped
+StrStripNonNumberChars
+StrToHex
+StrTrimCharLeft
+StrTrimCharRight
+StrTrimCharsLeft
+StrTrimCharsRight
+StrTrimQuotes
+StrUpper
+StrUpperBuff
+StrUpperInPlace
+StrRepeatLength
+StrCharPosLower
+StrCharPosUpper
+StringsToStr
+StrToStrings
+TrimStrings
+TrimStringsRight
+TrimStringsLeft
diff --git a/official/1.104/experts/useswizard/JclAppInst.txt b/official/1.104/experts/useswizard/JclAppInst.txt
new file mode 100644
index 0000000..f72a5a7
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclAppInst.txt
@@ -0,0 +1,12 @@
+TJclAppInstances
+JclAppInstances
+ReadMessageCheck
+ReadMessageData
+ReadMessageStrings
+TJclAppInstDataKind
+AI_INSTANCECREATED
+AI_INSTANCEDESTROYED
+AI_USERMSG
+AppInstCmdLineDataKind
+AppInstDataKindNoData
+ReadMessageString
diff --git a/official/1.104/experts/useswizard/JclArrayLists.txt b/official/1.104/experts/useswizard/JclArrayLists.txt
new file mode 100644
index 0000000..506bf17
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclArrayLists.txt
@@ -0,0 +1,3 @@
+TJclIntfArrayList
+TJclStrArrayList
+TJclArrayList
diff --git a/official/1.104/experts/useswizard/JclArraySets.txt b/official/1.104/experts/useswizard/JclArraySets.txt
new file mode 100644
index 0000000..137fde4
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclArraySets.txt
@@ -0,0 +1,3 @@
+TJclArraySet
+TJclIntfArraySet
+TJclStrArraySet
diff --git a/official/1.104/experts/useswizard/JclBase.txt b/official/1.104/experts/useswizard/JclBase.txt
new file mode 100644
index 0000000..eeafdca
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclBase.txt
@@ -0,0 +1,53 @@
+ByteArrayStringLen
+ByteArrayToString
+GetBytesEx
+MoveArray
+MoveArray
+MoveArray
+MoveArray
+MoveChar
+SetBytesEx
+SetIntegerSet
+StringToByteArray
+TULargeInteger
+Int16
+Int32
+Int8
+Largeint
+PCardinal
+PJclByteArray
+PLargeInteger
+PULargeInteger
+TDynByteArray
+TDynCardinalArray
+TDynDoubleArray
+TDynExtendedArray
+TDynFloatArray
+TDynIInterfaceArray
+TDynInt64Array
+TDynIntegerArray
+TDynLongIntArray
+TDynObjectArray
+TDynPointerArray
+TDynShortIntArray
+TDynSingleArray
+TDynSmallIntArray
+TDynStringArray
+TDynWordArray
+TIntegerSet
+TJclByteArray
+TJclBytes
+TLargeInteger
+UInt16
+UInt32
+UInt64
+UInt8
+JclVersion
+Float
+RaiseLastOSError
+IInterface
+EJclError
+EJclInternalError
+EJclWin32Error
+CardinalsToI64
+I64ToCardinals
diff --git a/official/1.104/experts/useswizard/JclBinaryTrees.txt b/official/1.104/experts/useswizard/JclBinaryTrees.txt
new file mode 100644
index 0000000..34fc82d
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclBinaryTrees.txt
@@ -0,0 +1,10 @@
+TJclBinaryNode
+TJclBinaryTree
+TJclIntfBinaryNode
+TJclIntfBinaryTree
+TJclStrBinaryNode
+TJclStrBinaryTree
+TJclTreeColor
+PJclBinaryNode
+PJclIntfBinaryNode
+PJclStrBinaryNode
diff --git a/official/1.104/experts/useswizard/JclBorlandTools.txt b/official/1.104/experts/useswizard/JclBorlandTools.txt
new file mode 100644
index 0000000..46bf4a0
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclBorlandTools.txt
@@ -0,0 +1,118 @@
+EJclBorRADException
+EJclCommandLineToolError
+TJclBCBInstallation
+TJclBCC32
+TJclBDSInstallation
+TJclBorlandCommandLineTool
+TJclBorlandMake
+TJclBorlandOpenHelp
+TJclBorRADToolIdePackages
+TJclBorRADToolIdeTool
+TJclBorRADToolInstallation
+TJclBorRADToolInstallationObject
+TJclBorRADToolInstallations
+TJclBorRADToolPalette
+TJclBorRADToolRepository
+TJclBpr2Mak
+TJclCommandLineTool
+TJclDCC32
+TJclDCCIL
+TJclDelphiInstallation
+TJclHelp2Manager
+IJclCommandLineTool
+BinaryFileName
+BPLFileName
+GetBPKFileInfo
+GetBPRFileInfo
+GetDPKFileInfo
+GetDPRFileInfo
+IsBCBPackage
+IsBCBProject
+IsDelphiPackage
+IsDelphiProject
+TCommandLineTool
+TJclBorDesigner
+TJclBorPersonality
+TJclBorPlatform
+TJclBorRADToolEdition
+TJclBorRADToolKind
+TJclHelp2Object
+TCommandLineTools
+TJclBorDesigners
+TJclBorPersonalities
+TJclBorRADToolInstallationClass
+TJclBorRADToolPath
+TJclDCC
+TJclHelp2Objects
+TTraverseMethod
+BinaryExtensionExecutable
+BinaryExtensionLibrary
+BinaryExtensionPackage
+BorRADToolEditionIDs
+BorRADToolRepositoryDataModulesPage
+BorRADToolRepositoryDesignerDfm
+BorRADToolRepositoryDesignerXfm
+BorRADToolRepositoryDialogsPage
+BorRADToolRepositoryFormsPage
+BorRADToolRepositoryFormTemplate
+BorRADToolRepositoryObjectAncestor
+BorRADToolRepositoryObjectAuthor
+BorRADToolRepositoryObjectDescr
+BorRADToolRepositoryObjectDesigner
+BorRADToolRepositoryObjectIcon
+BorRADToolRepositoryObjectMainForm
+BorRADToolRepositoryObjectName
+BorRADToolRepositoryObjectNewForm
+BorRADToolRepositoryObjectPage
+BorRADToolRepositoryObjectType
+BorRADToolRepositoryPagesSection
+BorRADToolRepositoryProjectsPage
+BorRADToolRepositoryProjectTemplate
+CompilerExtensionBPI
+CompilerExtensionDCP
+CompilerExtensionDEF
+CompilerExtensionDRC
+CompilerExtensionLIB
+CompilerExtensionMAP
+CompilerExtensionTDS
+DesignerCLX
+DesignerVCL
+DOFCompilerSection
+DOFConditionals
+DOFDirectoriesSection
+DOFLinkerSection
+DOFPackageNoLinkKey
+DOFPackagesKey
+DOFSearchPathName
+DOFUnitOutputDirKey
+JclBorDesignerDescription
+JclBorDesignerFormExtension
+JclBorPersonalityDescription
+Personality32Bit
+Personality64Bit
+PersonalityBCB
+PersonalityBDS
+PersonalityCSB
+PersonalityDelphi
+PersonalityDelphiDotNet
+PersonalityDesign
+PersonalityUnknown
+PersonalityVB
+ProjectTypeLibrary
+ProjectTypePackage
+ProjectTypeProgram
+SourceDescriptionCPP
+SourceDescriptionPAS
+SourceExtensionBCBPackage
+SourceExtensionBCBProject
+SourceExtensionBDSProject
+SourceExtensionCPP
+SourceExtensionDelphiPackage
+SourceExtensionDelphiProject
+SourceExtensionDFM
+SourceExtensionH
+SourceExtensionPAS
+SourceExtensionXFM
+SupportedBCBVersions
+SupportedBDSVersions
+SupportedDelphiVersions
diff --git a/official/1.104/experts/useswizard/JclCIL.txt b/official/1.104/experts/useswizard/JclCIL.txt
new file mode 100644
index 0000000..1e757a6
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclCIL.txt
@@ -0,0 +1,11 @@
+EJclCliInstructionError
+EJclCliInstructionStreamInvalid
+TJclBinaryInstruction
+TJclClrILGenerator
+TJclInstruction
+TJclUnaryInstruction
+TJclInstructionDumpILOption
+TJclInstructionParamType
+TJclOpCode
+TJclInstructionDumpILOptions
+InstructionDumpILAllOption
diff --git a/official/1.104/experts/useswizard/JclCLR.txt b/official/1.104/experts/useswizard/JclCLR.txt
new file mode 100644
index 0000000..2c4f9f5
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclCLR.txt
@@ -0,0 +1,38 @@
+TJclClrBlobRecord
+TJclClrBlobStream
+TJclClrGuidStream
+TJclClrHeaderEx
+TJclClrResourceRecord
+TJclClrStream
+TJclClrStringsStream
+TJclClrTable
+TJclClrTableRow
+TJclClrTableStream
+TJclClrUserStringStream
+TJclClrVTableFixupRecord
+TJclPeMetadata
+ITableCanDumpIL
+_IMAGE_COR_VTABLEFIXUP
+TClrMetadataHeader
+TClrStreamHeader
+TClrTableStreamHeader
+TJclClrComboIndex
+TJclClrHeapKind
+TJclClrImageFlag
+TJclClrTableKind
+TJclClrVTableKind
+IMAGE_COR_VTABLEFIXUP
+PClrMetadataHeader
+PClrStreamHeader
+PClrTableStreamHeader
+PImageCorVTableFixup
+PImageCorVTableFixupArray
+PJclClrToken
+TImageCorVTableFixup
+TImageCorVTableFixupArray
+TJclClrImageFlags
+TJclClrStreamClass
+TJclClrTableClass
+TJclClrTableRowClass
+TJclClrToken
+TJclClrVTableKinds
diff --git a/official/1.104/experts/useswizard/JclCOM.txt b/official/1.104/experts/useswizard/JclCOM.txt
new file mode 100644
index 0000000..c4d92c2
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclCOM.txt
@@ -0,0 +1,24 @@
+EInvalidParam
+CreateComponentCategory
+MarshalInterMachineInterfaceInStream
+MarshalInterMachineInterfaceInVarArray
+MarshalInterProcessInterfaceInStream
+MarshalInterProcessInterfaceInVarArray
+MarshalInterThreadInterfaceInVarArray
+RegisterCLSIDInCategory
+ResetIStreamToStart
+SizeOfIStreamContents
+StreamToVariantArray
+StreamToVariantArray
+UnRegisterCLSIDInCategory
+VariantArrayToStream
+VariantArrayToStream
+TArrayCatID
+CATID_SafeForInitializing
+CATID_SafeForScripting
+CLSID_StdComponentCategoriesMgr
+icMAX_CATEGORY_DESC_LEN
+IsDCOMInstalled
+IsDCOMEnabled
+GetDCOMVersion
+GetMDACVersion
diff --git a/official/1.104/experts/useswizard/JclComplex.txt b/official/1.104/experts/useswizard/JclComplex.txt
new file mode 100644
index 0000000..1e1015c
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclComplex.txt
@@ -0,0 +1,8 @@
+TCoords
+TRectCoord
+ComplexPrecision
+EpsilonSqr
+MaxTerm
+TComplex_VERSION
+TComplexKind
+TJclComplex
diff --git a/official/1.104/experts/useswizard/JclCompression.txt b/official/1.104/experts/useswizard/JclCompression.txt
new file mode 100644
index 0000000..d74d9d7
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclCompression.txt
@@ -0,0 +1,13 @@
+EJclCompressionError
+TJclCompressionStream
+TJclCompressStream
+TJclDecompressStream
+TJclGZIPCompressionStream
+TJclGZIPDecompressionStream
+TJclRARCompressionStream
+TJclRARDecompressionStream
+TJclTARCompressionStream
+TJclTARDecompressionStream
+TJclZLibCompressStream
+TJclZLibDecompressStream
+TJclCompressionLevel
diff --git a/official/1.104/experts/useswizard/JclConsole.txt b/official/1.104/experts/useswizard/JclConsole.txt
new file mode 100644
index 0000000..628f46d
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclConsole.txt
@@ -0,0 +1,25 @@
+TJclConsole
+TJclInputBuffer
+TJclScreenBuffer
+TJclScreenCharacter
+TJclScreenCursor
+TJclScreenCustomTextAttribute
+TJclScreenFont
+TJclScreenTextAttribute
+TJclScreenWindow
+IJclScreenTextAttribute
+TJclConsoleInputMode
+TJclConsoleOutputMode
+TJclInputCtrlEvent
+TJclScreenBackColor
+TJclScreenBufferTextHorizontalAlign
+TJclScreenBufferTextVerticalAlign
+TJclScreenFontColor
+TJclScreenFontStyle
+TJclConsoleInputModes
+TJclConsoleOutputModes
+TJclInputRecordArray
+TJclScreenBufferAfterResizeEvent
+TJclScreenBufferBeforeResizeEvent
+TJclScreenCursorSize
+TJclScreenFontStyles
diff --git a/official/1.104/experts/useswizard/JclContainerIntf.txt b/official/1.104/experts/useswizard/JclContainerIntf.txt
new file mode 100644
index 0000000..099a8ba
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclContainerIntf.txt
@@ -0,0 +1,44 @@
+EJclConcurrentModificationError
+EJclIllegalArgumentError
+EJclIllegalStateError
+EJclNoSuchElementError
+EJclOperationNotSupportedError
+EJclOutOfBoundsError
+DefaultContainerCapacity
+IJclCloneable
+IJclIntfCloneable
+IJclIntfIterator
+IJclStrIterator
+IJclIterator
+IJclIntfCollection
+IJclStrCollection
+IJclCollection
+IJclIntfList
+IJclStrList
+IJclList
+IJclIntfArray
+IJclStrArray
+IJclArray
+IJclIntfSet
+IJclStrSet
+IJclSet
+IJclIntfTree
+IJclStrTree
+IJclTree
+IJclIntfIntfMap
+IJclMultiIntfIntfMap
+IJclStrIntfMap
+IJclStrStrMap
+IJclStrMap
+IJclMap
+IJclIntfQueue
+IJclStrQueue
+IJclQueue
+IJclStrStrSortedMap
+IJclSortedMap
+IJclIntfSortedSet
+IJclSortedSet
+IJclIntfStack
+IJclStrStack
+IJclStack
+TJclTraverseOrder
diff --git a/official/1.104/experts/useswizard/JclCounter.txt b/official/1.104/experts/useswizard/JclCounter.txt
new file mode 100644
index 0000000..2094c49
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclCounter.txt
@@ -0,0 +1,5 @@
+EJclCounterError
+ContinueCount
+StartCount
+StopCount
+TJclCounter
diff --git a/official/1.104/experts/useswizard/JclDateTime.txt b/official/1.104/experts/useswizard/JclDateTime.txt
new file mode 100644
index 0000000..a479b72
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclDateTime.txt
@@ -0,0 +1,71 @@
+EJclDateTimeError
+DateTimeToSystemTime
+DayOfTheYear
+DecodeDate
+DecodeDate
+DosDateTimeToFileTime
+FATDatesEqual
+FileTimeToDosDateTime
+FileTimeToLocalDateTime
+FileTimeToSystemTime
+GetISOYearNumberOfDays
+IsISOLongYear
+IsISOLongYear
+IsLeapYear
+ISODayOfWeek
+ISOWeekNumber
+ISOWeekNumber
+SystemTimeToFileTime
+TDosDateTime
+UnixTimeStart
+DayOfTheYear
+DecodeDate
+FATDatesEqual
+IsLeapYear
+ISOWeekNumber
+ISOWeekToDateTime
+DayOfTheYearToDateTime
+EasterSunday
+CenturyOfDate
+CenturyBaseYear
+YearOfDate
+MonthOfDate
+DayOfDate
+HourOfTime
+MinuteOfTime
+SecondOfTime
+DaysInMonth
+Make4DigitYear
+MakeYear4Digit
+EncodeDate
+CreationDateTimeOfFile
+LastAccessDateTimeOfFile
+LastWriteDateTimeOfFile
+FormatDateTime
+DateTimeToSystemTime
+DosDateTimeToFileTime
+FileTimeToDosDateTime
+FileTimeToSystemTime
+SystemTimeToFileTime
+FileTimeToDateTime
+DosDateTimeToSystemTime
+SystemTimeToDosDateTime
+SystemTimeToStr
+DosDateTimeToDateTime
+DateTimeToDosDateTime
+DateTimeToFileTime
+LocalDateTimeToDateTime
+LocalDateTimeToFileTime
+DateTimeToLocalDateTime
+FileTimeToStr
+DosDateTimeToStr
+TimeOfDateTimeToSeconds
+TimeOfDateTimeToMSecs
+HoursToMSecs
+MinutesToMSecs
+SecondsToMSecs
+DateTimeToUnixTime
+UnixTimeToDateTime
+UnixTimeToFileTime
+FileTimeToUnixTime
+TJclUnixTime32
diff --git a/official/1.104/experts/useswizard/JclDebug.txt b/official/1.104/experts/useswizard/JclDebug.txt
new file mode 100644
index 0000000..5e30a9c
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclDebug.txt
@@ -0,0 +1,123 @@
+TJclDebugInfoSymbols
+TJclDebugInfoTD32
+TJclDebugThread
+TJclDebugThreadList
+TJclModuleInfoList
+__FILE__
+__FILE_OF_ADDR__
+AssertKindOf
+ConvertMapFileToJdbgFile
+ConvertMapFileToJdbgFile
+GetLocationInfo
+InsertDebugDataIntoExecutableFile
+InsertDebugDataIntoExecutableFile
+InsertDebugDataIntoExecutableFile
+InsertDebugDataIntoExecutableFile
+JclDebugThreadList
+JclExceptionTrackingActive
+JclLastExceptStackListToStrings
+JclStartExceptionTracking
+JclStopExceptionTracking
+JclTrackExceptionsFromLibraries
+JclValidateModuleAddress
+TraceMsg
+TJclBinDbgNameCache
+TJclDbgHeader
+TJclMapLineNumber
+TJclMapProcName
+TJclMapSegment
+TJclStackTrackingOption
+TJmpTable
+PDWORDArray
+PJclDbgHeader
+PJclLocationInfo
+PJclMapAddress
+PJclMapLineNumber
+PJclMapProcName
+PJclMapSegment
+PJmpTable
+PStackInfo
+TDWORDArray
+TJclDebugInfoSourceClass
+TJclDebugThreadNotifyEvent
+TJclMapClassTableEvent
+TJclMapLineNumbersEvent
+TJclMapLineNumberUnitEvent
+TJclMapPublicsEvent
+TJclMapSegmentEvent
+TJclStackTrackingOptions
+TJclThreadIDNotifyEvent
+JclStackTrackingOptions
+DrcFileExtension
+EnvironmentVarAlternateNtSymbolPath
+EnvironmentVarNtSymbolPath
+JclDbgHeaderVersion
+MapFileExtension
+MaxStackTraceItems
+AssertKindOf
+Trace
+TraceFmt
+TraceLoc
+TraceLocFmt
+TJmpInstruction
+TExcDescEntry
+TExcDesc
+TExcFrame
+TExceptFrameKind
+TJclExceptFrame
+TJclExceptFrameList
+JclCreateExceptFrameList
+JclLastExceptFrameList
+InsertDebugDataIntoExecutableFile
+IsHandleValid
+IsDebuggerAttached
+EnableCrashOnCtrlScroll
+GetLocationInfo
+TJclLocationInfo
+TJclDebugInfoSource
+TJclDebugInfoList
+DebugInfoAvailable
+TJclDebugInfoMap
+TJclDebugInfoBinary
+TJclDebugInfoExports
+Caller
+GetLocationInfoStr
+ClearLocationData
+__MODULE__
+__PROC__
+__LINE__
+__MAP__
+__MODULE_OF_ADDR__
+__PROC_OF_ADDR__
+__LINE_OF_ADDR__
+__MAP_OF_ADDR__
+FileByLevel
+ModuleByLevel
+ProcByLevel
+LineByLevel
+MapByLevel
+FileOfAddr
+ModuleOfAddr
+ProcOfAddr
+LineOfAddr
+MapOfAddr
+ExtractClassName
+ExtractMethodName
+ConvertMapFileToJdbgFile
+JclDbgDataSignature
+JclDbgDataResName
+JclDbgFileExtension
+TJclBinDebugGenerator
+TJclBinDebugScanner
+TJclMapAddress
+PJclMapString
+TJclAbstractMapParser
+TJclMapParser
+TJclMapScanner
+TStackFrame
+TStackInfo
+TJclStackInfoItem
+TJclStackInfoList
+JclCreateStackList
+JclLastExceptStackList
+TJclStackBaseList
diff --git a/official/1.104/experts/useswizard/JclDotNet.txt b/official/1.104/experts/useswizard/JclDotNet.txt
new file mode 100644
index 0000000..a0013db
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclDotNet.txt
@@ -0,0 +1,57 @@
+EJclClrException
+TJclClrAppDomain
+TJclClrAppDomainSetup
+TJclClrAssembly
+TJclClrField
+TJclClrHost
+TJclClrMethod
+TJclClrObject
+TJclClrProperty
+CallFunctionShim
+ClrCreateManagedInstance
+CompareCLRVersions
+CorBindToCurrentRuntime
+CorBindToRuntime
+CorBindToRuntimeByCfg
+CorBindToRuntimeEx
+CorBindToRuntimeHost
+CorExitProcess
+CorMarkThreadInThreadPool
+GetCORRequiredVersion
+GetCORSystemDirectory
+GetCORVersion
+GetFileVersion
+GetRealProcAddress
+GetRequestedRuntimeInfo
+GetRequestedRuntimeVersion
+GetRequestedRuntimeVersionForCLSID
+LoadLibraryShim
+RunDll32ShimW
+TJclClrHostFlavor
+TJclClrHostLoaderFlag
+CLSID_RESOLUTION_FLAGS
+HDOMAINENUM
+IJclClrAppDomain
+IJclClrAssembly
+IJclClrEvidence
+IJclClrMethod
+TJclClrAssemblyArguments
+TJclClrBase
+TJclClrHostLoaderFlags
+CLSID_RESOLUTION_DEFAULT
+CLSID_RESOLUTION_REGISTERED
+mscoree_dll
+RUNTIME_INFO_DONT_RETURN_DIRECTORY
+RUNTIME_INFO_DONT_RETURN_VERSION
+RUNTIME_INFO_DONT_SHOW_ERROR_DIALOG
+RUNTIME_INFO_REQUEST_AMD64
+RUNTIME_INFO_REQUEST_IA64
+RUNTIME_INFO_REQUEST_X86
+RUNTIME_INFO_UPGRADE_VERSION
+STARTUP_CONCURRENT_GC
+STARTUP_LOADER_OPTIMIZATION_MASK
+STARTUP_LOADER_OPTIMIZATION_MULTI_DOMAIN
+STARTUP_LOADER_OPTIMIZATION_MULTI_DOMAIN_HOST
+STARTUP_LOADER_OPTIMIZATION_SINGLE_DOMAIN
+STARTUP_LOADER_SAFEMODE
+STARTUP_LOADER_SETPREFERENCE
diff --git a/official/1.104/experts/useswizard/JclEDI.txt b/official/1.104/experts/useswizard/JclEDI.txt
new file mode 100644
index 0000000..5f48c3d
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclEDI.txt
@@ -0,0 +1,39 @@
+TEDIDataObject
+TEDIDataObjectGroup
+TEDIDataObjectList
+TEDIDataObjectListItem
+TEDIDelimiters
+TEDILoopStack
+TEDIObject
+TEDIObjectList
+TEDIObjectListItem
+StringRemove
+StringReplace
+TEDIDataObjectDataState
+TEDIDataObjectType
+TEDILoopStackFlags
+TEDILoopStackRecord
+EJclEDIError
+TCustomData
+TEDIDataObjectArray
+TEDIDataObjectGroupArray
+TEDIDataObjectListOptions
+TEDILoopStackArray
+TEDILoopStackFlagSet
+TEDILoopStackOnAddLoopEvent
+TEDIObjectArray
+Debug_EDIDataObjectListCreated
+Debug_EDIDataObjectListDestroyed
+Debug_EDIDataObjectListItemsCreated
+Debug_EDIDataObjectListItemsDestroyed
+Debug_EDIDataObjectsCreated
+Debug_EDIDataObjectsDestroyed
+EDIDataType_Binary
+EDIDataType_Date
+EDIDataType_Decimal
+EDIDataType_Identifier
+EDIDataType_Numeric
+EDIDataType_String
+EDIDataType_Time
+ElementSpecId_Reserved
+NA_LoopId
diff --git a/official/1.104/experts/useswizard/JclEDISEF.txt b/official/1.104/experts/useswizard/JclEDISEF.txt
new file mode 100644
index 0000000..ed50c8c
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclEDISEF.txt
@@ -0,0 +1,136 @@
+TEDISEFCompositeElement
+TEDISEFDataObject
+TEDISEFDataObjectGroup
+TEDISEFDataObjectList
+TEDISEFDataObjectListItem
+TEDISEFElement
+TEDISEFFile
+TEDISEFLoop
+TEDISEFObject
+TEDISEFRepeatingPattern
+TEDISEFSegment
+TEDISEFSet
+TEDISEFSubElement
+TEDISEFTable
+TEDISEFText
+TEDISEFTextSet
+TEDISEFTextSets
+AddCompositeElementTo
+AddElementTo
+AddLoopTo
+AddRepeatingPatternTo
+AddSegmentTo
+AddSubElementTo
+AddTableTo
+AppendCompositeElementTo
+AppendElementTo
+AppendLoopTo
+AppendRepeatingPatternTo
+AppendSegmentTo
+AppendSubElementTo
+AppendTableTo
+CombineCOMSDataOfCOMSDefinition
+CombineCOMSDataOfSEGSDefinition
+CombineELMSDataOfCOMSorSEGSDefinition
+CombineELMSDataOfELMSDefinition
+CombineSEGSDataOfSEGSDefinition
+CombineSEGSDataOfSETSDefinition
+DeleteCompositeElementFrom
+DeleteElementFrom
+DeleteLoopFrom
+DeleteRepeatingPatternFrom
+DeleteSegmentFrom
+DeleteSubElementFrom
+DeleteTableFrom
+ExtractCompositeElementFrom
+ExtractElementFrom
+ExtractFromDataObjectGroup
+ExtractFromDataObjectGroup
+ExtractLoopFrom
+ExtractRepeatingPatternFrom
+ExtractSegmentFrom
+ExtractSubElementFrom
+ExtractTableFrom
+GetEDISEFUserAttributeDescription
+GetEDISEFUserAttributeDescription
+InsertCompositeElementInto
+InsertCompositeElementInto
+InsertElementInto
+InsertElementInto
+InsertLoopInto
+InsertLoopInto
+InsertRepeatingPatternInto
+InsertRepeatingPatternInto
+InsertSegmentInto
+InsertSegmentInto
+InsertSubElementInto
+InsertSubElementInto
+InsertTableInto
+InsertTableInto
+ParseCOMSDataOfCOMSDefinition
+ParseCOMSDataOfSEGSDefinition
+ParseELMSDataOfCOMSDefinition
+ParseELMSDataOfELMSDefinition
+ParseELMSDataOfSEGSDefinition
+ParseLoopDataOfSETSDefinition
+ParseSEGSDataOfSEGSDefinition
+ParseSEGSDataOfSETSDefinition
+ParseSetsDataOfSETSDefinition
+ParseTableDataOfSETSDefinition
+TEDISEFComsUserAttributes
+TEDISEFObjectParentType
+TEDISEFWhereType
+TEDISEFDataObjectClass
+EDISEFUserAttributeAmpersand
+EDISEFUserAttributeAmpersandDesc
+EDISEFUserAttributeDollarSign
+EDISEFUserAttributeDollarSignDesc
+EDISEFUserAttributeExclamationPoint
+EDISEFUserAttributeExclamationPointDesc
+EDISEFUserAttributeHyphen
+EDISEFUserAttributeHyphenDesc
+EDISEFUserAttributePeriod
+EDISEFUserAttributePeriodDesc
+EDISEFUserAttributeSet
+SectionTag_
+SectionTag_CODES
+SectionTag_COMS
+SectionTag_ELMS
+SectionTag_INI
+SectionTag_JCL_COMSEXT
+SectionTag_JCL_ELMSEXT
+SectionTag_JCL_SEGSEXT
+SectionTag_JCL_SETSEXT
+SectionTag_OBJVARS
+SectionTag_PRIVATE
+SectionTag_PUBLIC
+SectionTag_SEGS
+SectionTag_SEMREFS
+SectionTag_SETS
+SectionTag_STD
+SectionTag_TEXT
+SectionTag_TEXTSETS
+SectionTag_VALLISTS
+SectionTag_VER
+SEFTextCR
+SEFTextCRLF
+SEFTextLF
+SEFTextSetsCode_Elm0
+SEFTextSetsCode_Elm1
+SEFTextSetsCode_Elm2
+SEFTextSetsCode_Elm4
+SEFTextSetsCode_Seg0
+SEFTextSetsCode_Seg1
+SEFTextSetsCode_Seg2
+SEFTextSetsCode_Seg3
+SEFTextSetsCode_Seg4
+SEFTextSetsCode_Seg5
+SEFTextSetsCode_Seg6
+SEFTextSetsCode_Seg7
+SEFTextSetsCode_Set0
+SEFTextSetsCode_Set1
+SEFTextSetsCode_Set2
+SEFTextSetsCode_Set3
+SEFTextSetsCode_Set4
+SEFTextSetsCode_Set5
+Value_UndefinedMaximum
diff --git a/official/1.104/experts/useswizard/JclEDITranslators.txt b/official/1.104/experts/useswizard/JclEDITranslators.txt
new file mode 100644
index 0000000..e4af641
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclEDITranslators.txt
@@ -0,0 +1,2 @@
+TEDISEFToSpecTranslator
+TEDISpecToSEFTranslator
diff --git a/official/1.104/experts/useswizard/JclEDIXML.txt b/official/1.104/experts/useswizard/JclEDIXML.txt
new file mode 100644
index 0000000..0a60105
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclEDIXML.txt
@@ -0,0 +1,46 @@
+TEDIXMLANSIX12FormatTranslator
+TEDIXMLAttributes
+TEDIXMLDataObject
+TEDIXMLDataObjectGroup
+TEDIXMLDelimiters
+TEDIXMLElement
+TEDIXMLFile
+TEDIXMLFileHeader
+TEDIXMLFunctionalGroup
+TEDIXMLFunctionalGroupSegment
+TEDIXMLInterchangeControl
+TEDIXMLInterchangeControlSegment
+TEDIXMLObject
+TEDIXMLSegment
+TEDIXMLTransactionSet
+TEDIXMLTransactionSetLoop
+TEDIXMLTransactionSetSegment
+TEDIXMLNameSpaceOption
+TEDIXMLDataObjectArray
+TEDIXMLElementArray
+TEDIXMLObjectArray
+TEDIXMLSegmentArray
+XMLAttribute_Description
+XMLAttribute_Id
+XMLAttribute_MaximumLength
+XMLAttribute_MaximumUsage
+XMLAttribute_MinimumLength
+XMLAttribute_OwnerLoopId
+XMLAttribute_ParentLoopId
+XMLAttribute_Position
+XMLAttribute_RequirementDesignator
+XMLAttribute_Section
+XMLAttribute_Type
+XMLTag_EDIFile
+XMLTag_Element
+XMLTag_FGHSegmentId
+XMLTag_FGTSegmentId
+XMLTag_FunctionalGroup
+XMLTag_ICHSegmentId
+XMLTag_ICTSegmentId
+XMLTag_InterchangeControl
+XMLTag_Segment
+XMLTag_TransactionSet
+XMLTag_TransactionSetLoop
+XMLTag_TSHSegmentId
+XMLTag_TSTSegmentId
diff --git a/official/1.104/experts/useswizard/JclEDI_ANSIX12.txt b/official/1.104/experts/useswizard/JclEDI_ANSIX12.txt
new file mode 100644
index 0000000..44718d7
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclEDI_ANSIX12.txt
@@ -0,0 +1,48 @@
+TEDIElementSpec
+TEDIFileSpec
+TEDIFunctionalGroupSegmentGSSpec
+TEDIFunctionalGroupSegmentSpec
+TEDIFunctionalGroupSpec
+TEDIInterchangeControlSegmentISASpec
+TEDIInterchangeControlSegmentSpec
+TEDIInterchangeControlSpec
+TEDISegmentSpec
+TEDITransactionSet
+TEDITransactionSetDocument
+TEDITransactionSetLoop
+TEDITransactionSetSegment
+TEDITransactionSetSegmentSpec
+TEDITransactionSetSegmentSTSpec
+TEDITransactionSetSpec
+TEDITransactionSetArray
+TEDITransactionSetDocumentArray
+TEDITransactionSetDocumentOptions
+FGHSegmentId
+FGTSegmentId
+ICHSegmentId
+ICTSegmentId
+RDFN_AgencyCodeId
+RDFN_Description
+RDFN_FGDescription
+RDFN_FunctionalGroupId
+RDFN_ICDescription
+RDFN_Id
+RDFN_MaximumLength
+RDFN_MaximumLoopRepeat
+RDFN_MaximumUsage
+RDFN_MinimumLength
+RDFN_Notes
+RDFN_OwnerLoopId
+RDFN_ParentLoopId
+RDFN_Position
+RDFN_RequirementDesignator
+RDFN_Section
+RDFN_StandardId
+RDFN_TransSetDesc
+RDFN_TransSetId
+RDFN_Type
+RDFN_VersionId
+RDFN_VersionReleaseId
+TA1SegmentId
+TSHSegmentId
+TSTSegmentId
diff --git a/official/1.104/experts/useswizard/JclEDI_ANSIX12_Ext.txt b/official/1.104/experts/useswizard/JclEDI_ANSIX12_Ext.txt
new file mode 100644
index 0000000..7b60e87
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclEDI_ANSIX12_Ext.txt
@@ -0,0 +1 @@
+TEDI_ANSIX12_Document
diff --git a/official/1.104/experts/useswizard/JclEDI_UNEDIFACT.txt b/official/1.104/experts/useswizard/JclEDI_UNEDIFACT.txt
new file mode 100644
index 0000000..eff0f94
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclEDI_UNEDIFACT.txt
@@ -0,0 +1,26 @@
+TEDICompositeElement
+TEDIElement
+TEDIFile
+TEDIFunctionalGroup
+TEDIFunctionalGroupSegment
+TEDIInterchangeControl
+TEDIInterchangeControlSegment
+TEDIMessage
+TEDIMessageLoop
+TEDIMessageSegment
+TEDISegment
+TEDICompositeElementArray
+TEDIElementArray
+TEDIFileArray
+TEDIFileOptions
+TEDIFunctionalGroupArray
+TEDIInterchangeControlArray
+TEDIMessageArray
+TEDISegmentArray
+UNASegmentId
+UNBSegmentId
+UNESegmentId
+UNGSegmentId
+UNHSegmentId
+UNTSegmentId
+UNZSegmentId
diff --git a/official/1.104/experts/useswizard/JclEDI_UNEDIFACT_Ext.txt b/official/1.104/experts/useswizard/JclEDI_UNEDIFACT_Ext.txt
new file mode 100644
index 0000000..696603e
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclEDI_UNEDIFACT_Ext.txt
@@ -0,0 +1,2 @@
+TEDI_UNEDIFACT_Document
+TEDIMessageDocumentOptions
diff --git a/official/1.104/experts/useswizard/JclExprEval.txt b/official/1.104/experts/useswizard/JclExprEval.txt
new file mode 100644
index 0000000..695e1c6
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclExprEval.txt
@@ -0,0 +1,54 @@
+cExprEvalHashSize
+EJclExprEvalError
+ExprWhiteSpace
+TFloat
+TFloat32
+TFloat64
+TFloat80
+TFloatFunc
+TUnaryFunc
+TBinaryFunc
+TTernaryFunc
+TExprContext
+TExprHashContext
+TExprSetContext
+TExprSym
+TExprToken
+TExprLexer
+TExprNode
+TExprNodeFactory
+TExprCompileParser
+TExprEvalParser
+TExprSimpleLexer
+TExprVirtMachOp
+TExprVirtMach
+TExprVirtMachNodeFactory
+TExprConstSym
+TExprConst32Sym
+TExprConst64Sym
+TExprConst80Sym
+TExprVar32Sym
+TExprVar64Sym
+TExprVar80Sym
+TExprAbstractFuncSym
+TExprFuncSym
+TExprFloat32FuncSym
+TExprFloat64FuncSym
+TExprFloat80FuncSym
+TExprUnaryFuncSym
+TExprUnary32FuncSym
+TExprUnary64FuncSym
+TExprUnary80FuncSym
+TExprBinaryFuncSym
+TExprBinary32FuncSym
+TExprBinary64FuncSym
+TExprBinary80FuncSym
+TExprTernaryFuncSym
+TExprTernary32FuncSym
+TExprTernary64FuncSym
+TExprTernary80FuncSym
+TEasyEvaluator
+TEvaluator
+TCompiledEvaluator
+TCompiledExpression
+TExpressionCompiler
diff --git a/official/1.104/experts/useswizard/JclFileUtils.txt b/official/1.104/experts/useswizard/JclFileUtils.txt
new file mode 100644
index 0000000..989f317
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclFileUtils.txt
@@ -0,0 +1,181 @@
+EJclFileMappingError
+EJclFileMappingViewError
+EJclFileUtilsError
+EJclFileVersionInfoError
+EJclPathError
+EJclTempFileStreamError
+TJclFileMappingStream
+TJclFileMaskComparator
+TJclMappedTextReader
+FormatVersionString
+FormatVersionString
+FormatVersionString
+fstat64
+GetBackupFileName
+GetFileCreation
+GetFileInformation
+GetFileLastAccess
+GetFileLastAccess
+GetFileLastAccess
+GetFileLastAccess
+GetFileLastAttrChange
+GetFileLastAttrChange
+GetFileLastAttrChange
+GetFileLastWrite
+GetFileLastWrite
+GetFileLastWrite
+GetFileLastWrite
+GetFileStatus
+GetSizeOfFile
+GetSizeOfFile
+IsRootDirectory
+lstat64
+PathCanonicalize
+PathExtractPathDepth
+PathGetDepth
+PathListAddItems
+PathListDelItem
+PathListDelItems
+PathListGetItem
+PathListIncludeItems
+PathListItemCount
+PathListItemIndex
+PathListSetItem
+SamePath
+stat64
+VersionExtractFileInfo
+VersionExtractProductInfo
+VersionFixedFileInfoString
+TCompactPath
+TFileEnumeratorSyncMode
+TFileFlag
+TFileListOption
+TFileSearchOption
+TFileVersionFormat
+TJclAttributeMatch
+TJclFileMappingRoundOffset
+TJclMappedTextReaderIndex
+TLangIdRec
+PLangIdRec
+PPCharArray
+TFileHandler
+TFileHandlerEx
+TFileMatchFunc
+TFileSearchTaskID
+TFileSearchTerminationEvent
+TFileTime
+TPCharArray
+DirDelimiter
+DirSeparator
+ERROR_NO_MORE_FILES
+faCompressed
+faEncrypted
+faNormalFile
+faNotContentIndexed
+faOffline
+faRejectedByDefault
+faReparsePoint
+faSparseFile
+faSymLink
+faTemporary
+faUnixSpecific
+faWindowsSpecific
+GetFileCreation
+GetFileInformation
+GetFileLastAccess
+GetFileLastWrite
+GetSizeOfFile
+FileGetTypeName
+FindUnusedFileName
+ForceDirectories
+FileGetDisplayName
+FileGetOwnerName
+FileGetGroupName
+GetModulePath
+FileGetTempName
+FileCreateTemp
+FileBackup
+FileCopy
+FileDelete
+FileExists
+FileMove
+FileRestore
+ShredFile
+FileGetSize
+GetFileAttributeListEx
+GetFileAttributeList
+GetDirectorySize
+GetDriveTypeStr
+SetFileLastWrite
+SetFileLastAccess
+SetFileCreation
+SetDirLastWrite
+SetDirLastAccess
+SetDirCreation
+IsDirectory
+LockVolume
+OpenVolume
+CloseVolume
+CreateEmptyFile
+GetStandardFileInfo
+GetFileAgeCoherence
+BuildFileList
+AdvBuildFileList
+TFileListOptions
+TDelTreeProgress
+DelTree
+DelTreeEx
+DirectoryExists
+DiskInDrive
+DeleteDirectory
+UnlockVolume
+CreateSymbolicLink
+SymbolicLinkTarget
+FileAttributesStr
+TFileSearchOptions
+TAttributeInterest
+VerifyFileAttributeMask
+IsFileAttributeMatch
+IsFileNameMatch
+EnumFiles
+EnumDirectories
+TJclCustomFileAttrMask
+TJclFileAttributeMask
+TJclFileEnumerator
+IJclFileEnumerator
+FileSearch
+TFileFlags
+VersionResourceAvailable
+OSIdentToString
+TJclFileVersionInfo
+VersionFixedFileInfo
+OSFileTypeToString
+DriveLetters
+PathDevicePrefix
+PathSeparator
+PathUncPrefix
+PathGetLongName
+PathGetLongName2
+PathGetShortName
+PathGetRelativePath
+PathGetTempPath
+PathIsChild
+PathIsAbsolute
+PathIsDiskDevice
+PathIsUNC
+PathExtractElements
+PathAddSeparator
+PathAddExtension
+PathAppend
+PathBuildRoot
+PathCommonPrefix
+PathCompactPath
+PathExtractFileDirFixed
+PathExtractFileNameNoExt
+PathRemoveExtension
+PathRemoveSeparator
+TJclTempFileStream
+TJclFileMappingView
+TJclCustomFileMapping
+TJclFileMapping
+TJclSwapFileMapping
diff --git a/official/1.104/experts/useswizard/JclGraphUtils.txt b/official/1.104/experts/useswizard/JclGraphUtils.txt
new file mode 100644
index 0000000..5cdb8db
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclGraphUtils.txt
@@ -0,0 +1,4 @@
+DottedLineTo
+SetBitmapColors
+PPointArray
+TPointArray
diff --git a/official/1.104/experts/useswizard/JclGraphics.txt b/official/1.104/experts/useswizard/JclGraphics.txt
new file mode 100644
index 0000000..8722b7c
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclGraphics.txt
@@ -0,0 +1,29 @@
+TJclByteMap
+CreateRegionFromBitmap
+GetAntialiasedBitmap
+GetIconFromBitmap
+MapWindowRect
+ScreenShot
+ScreenShot
+WriteIcon
+TJclThreadPersistent
+TJclCustomMap
+TJclBitmap32
+AlphaToGrayscale
+ApplyLUT
+BlockTransfer
+ColorToGrayscale
+IntensityToAlpha
+Invert
+InvertRGB
+SetBorderTransparent
+SetGamma
+StretchTransfer
+Transform
+BitmapToJPeg
+JPegToBitmap
+TJclDesktopCanvas
+WriteIcon
+SaveIconToFile
+TJclRegion
+TJclRegionInfo
diff --git a/official/1.104/experts/useswizard/JclHashMaps.txt b/official/1.104/experts/useswizard/JclHashMaps.txt
new file mode 100644
index 0000000..ae34b87
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclHashMaps.txt
@@ -0,0 +1,31 @@
+TJclBucket
+TJclIntfIntfBucket
+TJclStrBucket
+TJclStrIntfBucket
+TJclStrStrBucket
+TJclEntry
+TJclIntfIntfEntry
+TJclStrEntry
+TJclStrIntfEntry
+TJclStrStrEntry
+PJclBucket
+PJclIntfIntfBucket
+PJclStrBucket
+PJclStrIntfBucket
+PJclStrStrBucket
+TJclBucketArray
+TJclEntryArray
+TJclHashFunction
+TJclIntfIntfBucketArray
+TJclIntfIntfEntryArray
+TJclStrBucketArray
+TJclStrEntryArray
+TJclStrIntfBucketArray
+TJclStrIntfEntryArray
+TJclStrStrBucketArray
+TJclStrStrEntryArray
+TJclHashMap
+TJclIntfIntfHashMap
+TJclStrIntfHashMap
+TJclStrHashMap
+TJclStrStrHashMap
diff --git a/official/1.104/experts/useswizard/JclHashSets.txt b/official/1.104/experts/useswizard/JclHashSets.txt
new file mode 100644
index 0000000..d4e00d9
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclHashSets.txt
@@ -0,0 +1,3 @@
+TJclIntfHashSet
+TJclHashSet
+TJclStrHashSet
diff --git a/official/1.104/experts/useswizard/JclHookExcept.txt b/official/1.104/experts/useswizard/JclHookExcept.txt
new file mode 100644
index 0000000..a79c543
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclHookExcept.txt
@@ -0,0 +1,17 @@
+JclAddExceptNotifier
+JclAddExceptNotifier
+JclBelongsHookedCode
+JclHookedExceptModulesList
+JclHookExceptionsInModule
+JclInitializeLibrariesHookExcept
+JclRemoveExceptNotifier
+JclRemoveExceptNotifier
+JclReplaceExceptObj
+JclUnkookExceptionsInModule
+TJclExceptNotifyPriority
+TJclModuleArray
+TJclExceptNotifyProc
+TJclExceptNotifyMethod
+JclHookExceptions
+JclUnhookExceptions
+JclExceptionsHooked
diff --git a/official/1.104/experts/useswizard/JclIniFiles.txt b/official/1.104/experts/useswizard/JclIniFiles.txt
new file mode 100644
index 0000000..b818f5c
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclIniFiles.txt
@@ -0,0 +1,8 @@
+IniReadStrings
+IniWriteStrings
+IniWriteBool
+IniWriteInteger
+IniWriteString
+IniReadBool
+IniReadInteger
+IniReadString
diff --git a/official/1.104/experts/useswizard/JclLANMan.txt b/official/1.104/experts/useswizard/JclLANMan.txt
new file mode 100644
index 0000000..a087443
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclLANMan.txt
@@ -0,0 +1,23 @@
+TNetUserAuthFlag
+TNetUserFlag
+TNetUserInfoFlag
+TNetUserPriv
+TNetUserAuthFlags
+TNetUserFlags
+TNetUserInfoFlags
+ParseAccountName
+IsLocalAccount
+CreateLocalGroup
+CreateGlobalGroup
+DeleteLocalGroup
+GetLocalGroups
+GetGlobalGroups
+LocalGroupExists
+GlobalGroupExists
+AddAccountToLocalGroup
+LookupGroupName
+TNetWellKnownRID
+CreateAccount
+CreateLocalAccount
+DeleteAccount
+DeleteLocalAccount
diff --git a/official/1.104/experts/useswizard/JclLinkedLists.txt b/official/1.104/experts/useswizard/JclLinkedLists.txt
new file mode 100644
index 0000000..da730ef
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclLinkedLists.txt
@@ -0,0 +1,9 @@
+TJclIntfLinkedListItem
+TJclLinkedListItem
+TJclStrLinkedListItem
+PJclIntfLinkedListItem
+PJclLinkedListItem
+PJclStrLinkedListItem
+TJclLinkedList
+TJclIntfLinkedList
+TJclStrLinkedList
diff --git a/official/1.104/experts/useswizard/JclLocales.txt b/official/1.104/experts/useswizard/JclLocales.txt
new file mode 100644
index 0000000..896d7c2
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclLocales.txt
@@ -0,0 +1,11 @@
+JclLocalesInfoList
+TJclLocaleDateFormats
+TJclLocalesDays
+TJclLocalesMonths
+TJclKeyboardLayoutList
+TJclKeyboardLayout
+TJclKeybLayoutFlag
+TJclAvailableKeybLayout
+TJclLocaleInfo
+TJclLocalesKind
+TJclLocalesList
diff --git a/official/1.104/experts/useswizard/JclLogic.txt b/official/1.104/experts/useswizard/JclLogic.txt
new file mode 100644
index 0000000..840d65b
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclLogic.txt
@@ -0,0 +1,185 @@
+BitsHighest
+BitsHighest
+BitsHighest
+BitsHighest
+BitsHighest
+BitsHighest
+BitsLowest
+BitsLowest
+BitsLowest
+BitsLowest
+BitsLowest
+BitsLowest
+BitsNeeded
+BitsNeeded
+BitsNeeded
+BitsToBooleans
+BitsToBooleans
+BitsToBooleans
+BooleansToBits
+BooleansToBits
+BooleansToBits
+ClearBit
+ClearBit
+ClearBit
+ClearBit
+ClearBit
+ClearBit
+ClearBitBuffer
+CountBitsCleared
+CountBitsCleared
+CountBitsCleared
+CountBitsCleared
+CountBitsCleared
+CountBitsCleared
+CountBitsCleared
+CountBitsSet
+CountBitsSet
+CountBitsSet
+CountBitsSet
+CountBitsSet
+CountBitsSet
+CountBitsSet
+DecLimit
+DecLimit
+DecLimit
+DecLimit
+DecLimit
+DecLimit
+DecLimitClamp
+DecLimitClamp
+DecLimitClamp
+DecLimitClamp
+DecLimitClamp
+DecLimitClamp
+IncLimit
+IncLimit
+IncLimit
+IncLimit
+IncLimit
+IncLimit
+IncLimitClamp
+IncLimitClamp
+IncLimitClamp
+IncLimitClamp
+IncLimitClamp
+IncLimitClamp
+LRot
+LRot
+Max
+Max
+Max
+Max
+Max
+Max
+Min
+Min
+Min
+Min
+Min
+Min
+OrdToBinary
+OrdToBinary
+OrdToBinary
+OrdToBinary
+OrdToBinary
+OrdToBinary
+ReverseBits
+ReverseBits
+ReverseBits
+ReverseBits
+ReverseBits
+ReverseBits
+ReverseBits
+ReverseBytes
+ReverseBytes
+ReverseBytes
+ReverseBytes
+ReverseBytes
+RRot
+RRot
+Sar
+Sar
+SetBit
+SetBit
+SetBit
+SetBit
+SetBit
+SetBit
+SetBitBuffer
+SwapOrd
+SwapOrd
+SwapOrd
+SwapOrd
+SwapOrd
+TestBit
+TestBit
+TestBit
+TestBit
+TestBit
+TestBit
+TestBitBuffer
+TestBits
+TestBits
+TestBits
+TestBits
+TestBits
+TestBits
+ToggleBit
+ToggleBit
+ToggleBit
+ToggleBit
+ToggleBit
+ToggleBit
+ToggleBitBuffer
+TBitRange
+TBooleanArray
+BitsPerByte
+BitsPerCardinal
+BitsPerInt64
+BitsPerInteger
+BitsPerNibble
+BitsPerShortint
+BitsPerSmallint
+BitsPerWord
+ByteMask
+CardinalMask
+Int64Mask
+IntegerMask
+NibbleMask
+NibblesPerByte
+NibblesPerCardinal
+NibblesPerInt64
+NibblesPerInteger
+NibblesPerShortint
+NibblesPerSmallint
+NibblesPerWord
+ShortintMask
+SmallintMask
+WordMask
+DecLimit
+DecLimitClamp
+IncLimit
+IncLimitClamp
+Max
+Min
+SwapOrd
+BitsHighest
+BitsLowest
+BitsNeeded
+BitsToBooleans
+BooleansToBits
+ClearBit
+CountBitsCleared
+CountBitsSet
+LRot
+ReverseBits
+ReverseBytes
+RRot
+Sar
+SetBit
+TestBit
+TestBits
+ToggleBit
+Digits
+OrdToBinary
diff --git a/official/1.104/experts/useswizard/JclMIDI.txt b/official/1.104/experts/useswizard/JclMIDI.txt
new file mode 100644
index 0000000..22f2c3d
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclMIDI.txt
@@ -0,0 +1,119 @@
+EJclMIDIError
+TJclMIDIOut
+MIDINoteToStr
+MIDIOut
+MIDISingleNoteTuningData
+TSingleNoteTuningData
+TMIDIChannel
+TMIDIDataByte
+TMIDIDataWord
+TMIDIKey
+TMIDINote
+TMIDINotes
+TMIDIStatusByte
+TMIDIVelocity
+BitsPerMIDIDataByte
+BitsPerMIDIDataWord
+MIDICCAllNotesOff
+MIDICCAllSoundOff
+MIDICCBalance
+MIDICCBalanceLSB
+MIDICCBankSelect
+MIDICCBankSelectLSB
+MIDICCBreathControl
+MIDICCBreathControlLSB
+MIDICCCelesteDepth
+MIDICCChannelVolume
+MIDICCChannelVolumeLSB
+MIDICCChorusSendLevel
+MIDICCDataEntry
+MIDICCDataEntryDec
+MIDICCDataEntryInc
+MIDICCDataEntryLSB
+MIDICCEffectControl
+MIDICCEffectControl2
+MIDICCEffectControl2LSB
+MIDICCEffectControlLSB
+MIDICCEffects2Depth
+MIDICCEffects4Depth
+MIDICCEffects5Depth
+MIDICCExpression
+MIDICCExpressionLSB
+MIDICCFootController
+MIDICCFootControllerLSB
+MIDICCGeneralPurpose1
+MIDICCGeneralPurpose1LSB
+MIDICCGeneralPurpose2
+MIDICCGeneralPurpose2LSB
+MIDICCGeneralPurpose3
+MIDICCGeneralPurpose3LSB
+MIDICCGeneralPurpose4
+MIDICCGeneralPurpose4LSB
+MIDICCGeneralPurpose5
+MIDICCGeneralPurpose6
+MIDICCGeneralPurpose7
+MIDICCGeneralPurpose8
+MIDICCHold2
+MIDICCLegato
+MIDICCLocalControl
+MIDICCMainVolume
+MIDICCMainVolumeLSB
+MIDICCModulationWheel
+MIDICCModulationWheelLSB
+MIDICCMonoModeOn
+MIDICCNonRegParamNumLSB
+MIDICCNonRegParamNumMSB
+MIDICCOmniModeOff
+MIDICCOmniModeOn
+MIDICCPan
+MIDICCPanLSB
+MIDICCPhaserDepth
+MIDICCPolyModeOn
+MIDICCPortamento
+MIDICCPortamentoControl
+MIDICCPortamentoTime
+MIDICCPortamentoTimeLSB
+MIDICCRegParamNumLSB
+MIDICCRegParamNumMSB
+MIDICCResetAllControllers
+MIDICCReverbSendLevel
+MIDICCSoftPedal
+MIDICCSound1
+MIDICCSound10
+MIDICCSound2
+MIDICCSound3
+MIDICCSound4
+MIDICCSound5
+MIDICCSound6
+MIDICCSound7
+MIDICCSound8
+MIDICCSound9
+MIDICCSustain
+MIDICCSustenuto
+MIDICCTremoloDepth
+MIDIChannelMsgMask
+MIDIDataMask
+MIDIDataWordMask
+MIDIInvalidStatus
+MIDIMsgActiveSensing
+MIDIMsgAftertouch
+MIDIMsgChannelKeyPressure
+MIDIMsgContinueSequence
+MIDIMsgControlChange
+MIDIMsgEOX
+MIDIMsgMTCQtrFrame
+MIDIMsgNoteOff
+MIDIMsgNoteOn
+MIDIMsgPitchWheelChange
+MIDIMsgPolyKeyPressure
+MIDIMsgProgramChange
+MIDIMsgSongPositionPtr
+MIDIMsgSongSelect
+MIDIMsgStartSequence
+MIDIMsgStopSequence
+MIDIMsgSysEx
+MIDIMsgSystemReset
+MIDIMsgTimingClock
+MIDIMsgTuneRequest
+MIDIPitchWheelCenter
+IJclMIDIOut
diff --git a/official/1.104/experts/useswizard/JclMapi.txt b/official/1.104/experts/useswizard/JclMapi.txt
new file mode 100644
index 0000000..a872295
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclMapi.txt
@@ -0,0 +1,21 @@
+JclSimpleSendFax
+TJclTaskWindowsList
+MapiAddressTypeFAX
+MapiAddressTypeSMTP
+MapiAddressTypeTLX
+TJclMapiClient
+TJclMapiClientConnect
+TJclEmailRecipKind
+TJclEmailFindOption
+TJclEmailLogonOption
+TJclEmailReadOption
+TJclEmailReadMsg
+JclSimpleSendMail
+JclSimpleBringUpSendMailDialog
+MapiCheck
+MapiErrorMessage
+EJclMapiError
+TJclEmail
+TJclEmailRecip
+TJclEmailRecips
+TJclSimpleMapi
diff --git a/official/1.104/experts/useswizard/JclMath.txt b/official/1.104/experts/useswizard/JclMath.txt
new file mode 100644
index 0000000..24a1326
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclMath.txt
@@ -0,0 +1,213 @@
+EJclMathError
+EJclNaNSignal
+TJclASet
+TJclFlatSet
+TJclRational
+TJclSparseFlatSet
+TRectComplex
+AbsSqr
+AbsSqr
+Ackermann
+Conjugate
+Conjugate
+Cos
+CosH
+Cot
+CotH
+Csc
+CscH
+DegToGrad
+DegToGrad
+DegToRad
+DegToRad
+Diff
+DomainCheck
+DoubleToHex
+EnsureRange
+EnsureRange
+EnsureRange
+Equal
+Equal
+Exp
+Exsecans
+FastDegToGrad
+FastDegToRad
+FastGradToDeg
+FastGradToRad
+FastRadToDeg
+FastRadToGrad
+Fibonacci
+FloatingPointClass
+FloatingPointClass
+GetNaNTag
+GetNaNTag
+GetParity
+GetParity
+GradToDeg
+GradToDeg
+GradToRad
+GradToRad
+HexToDouble
+Inv
+Inv
+IsInfinite
+IsInfinite
+IsInfinite
+IsInfinite
+IsNaN
+IsNaN
+IsZero
+IsZero
+Ln
+MakeQuietNaN
+MakeQuietNaN
+MakeSignalingNaN
+MakeSignalingNaN
+MinedDoubleArray
+MinedSingleArray
+Neg
+Neg
+Norm
+Norm
+PolarComplex
+PolarComplex
+Power
+Power
+PowerInt
+Product
+Product
+Quotient
+RadToDeg
+RadToDeg
+RadToGrad
+RadToGrad
+RectComplex
+RectComplex
+Root
+Sec
+SecH
+Sin
+SinH
+Sum
+Sum
+SwapOrd
+Tan
+TanH
+TruncPower
+TPolarComplex
+TPrimalityTestMethod
+PDelphiSet
+PPointerArray
+TDelphiSet
+TPointerArray
+Bernstein
+Catalan
+CompleteDelphiSet
+EmptyDelphiSet
+EulerMascheroni
+GoldenMean
+Infinity
+NaN
+NegInfinity
+PiExt
+RatioDegToGrad
+RatioDegToRad
+RatioGradToDeg
+RatioGradToRad
+RatioRadToDeg
+RatioRadToGrad
+DegMinSecToFloat
+FloatToDegMinSec
+CheckCrc32
+Crc32
+InitCrc32
+CheckCrc16
+Crc16
+InitCrc16
+Exp
+Power
+PowerInt
+TenToY
+TwoToY
+FloatingPointClass
+GetNaNTag
+IsInfinite
+IsNaN
+MakeQuietNaN
+MakeSignalingNaN
+ModFloat
+RemainderFloat
+FloatsEqual
+SwapFloats
+MinFloat
+MaxFloat
+TFloatingPointClass
+TNaNTag
+MineSingleBuffer
+MineDoubleBuffer
+CalcMachineEps
+CalcMachineEpsSingle
+CalcMachineEpsDouble
+CalcMachineEpsExtended
+IsFloatZero
+IsSpecialValue
+SetPrecisionTolerance
+SetPrecisionToleranceToEpsilon
+Epsilon
+PrecisionTolerance
+CosH
+CotH
+CscH
+SecH
+SinH
+TanH
+ArcCosH
+ArcCotH
+ArcCscH
+ArcSecH
+ArcSinH
+ArcTanH
+LogBaseN
+LogBase2
+LogBase10
+ISqrt
+Pythagoras
+NormalizeAngle
+IsRelativePrime
+LCM
+GCD
+Ceiling
+CommercialRound
+Floor
+Factorial
+Sgn
+Signe
+IsPrimeFactor
+IsPrimeRM
+IsPrimeTD
+PrimeFactors
+SetPrimalityTest
+IsPrime
+Cos
+Cot
+Csc
+Sec
+Sin
+Tan
+ArcCos
+ArcCot
+ArcCsc
+ArcSec
+ArcSin
+ArcTan
+ArcTan2
+Haversine
+Coversine
+Versine
+SinCos
+DegToGrad
+DegToRad
+GradToDeg
+GradToRad
+RadToDeg
+RadToGrad
diff --git a/official/1.104/experts/useswizard/JclMetadata.txt b/official/1.104/experts/useswizard/JclMetadata.txt
new file mode 100644
index 0000000..0dac6e0
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclMetadata.txt
@@ -0,0 +1,163 @@
+EJclMetadataError
+TJclClrArraySign
+TJclClrCustomModifierSign
+TJclClrExceptionHandler
+TJclClrLocalVar
+TJclClrLocalVarSign
+TJclClrMethodBody
+TJclClrMethodParam
+TJclClrMethodRetType
+TJclClrMethodSign
+TJclClrSignature
+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
+TJclClrTableEventMap
+TJclClrTableEventMapRow
+TJclClrTableEventPtr
+TJclClrTableEventPtrRow
+TJclClrTableExportedType
+TJclClrTableExportedTypeRow
+TJclClrTableFieldDef
+TJclClrTableFieldDefRow
+TJclClrTableFieldLayout
+TJclClrTableFieldLayoutRow
+TJclClrTableFieldMarshal
+TJclClrTableFieldMarshalRow
+TJclClrTableFieldPtr
+TJclClrTableFieldPtrRow
+TJclClrTableFieldRVA
+TJclClrTableFieldRVARow
+TJclClrTableFile
+TJclClrTableFileRow
+TJclClrTableImplMap
+TJclClrTableImplMapRow
+TJclClrTableInterfaceImpl
+TJclClrTableInterfaceImplRow
+TJclClrTableManifestResource
+TJclClrTableManifestResourceRow
+TJclClrTableMemberRef
+TJclClrTableMemberRefRow
+TJclClrTableMethodDef
+TJclClrTableMethodDefRow
+TJclClrTableMethodImpl
+TJclClrTableMethodImplRow
+TJclClrTableMethodPtr
+TJclClrTableMethodPtrRow
+TJclClrTableMethodSemantics
+TJclClrTableMethodSemanticsRow
+TJclClrTableMethodSpec
+TJclClrTableMethodSpecRow
+TJclClrTableModule
+TJclClrTableModuleRef
+TJclClrTableModuleRefRow
+TJclClrTableModuleRow
+TJclClrTableNestedClass
+TJclClrTableNestedClassRow
+TJclClrTableParamDef
+TJclClrTableParamDefRow
+TJclClrTableParamPtr
+TJclClrTableParamPtrRow
+TJclClrTablePropertyDef
+TJclClrTablePropertyDefRow
+TJclClrTablePropertyMap
+TJclClrTablePropertyMapRow
+TJclClrTablePropertyPtr
+TJclClrTablePropertyPtrRow
+TJclClrTableStandAloneSig
+TJclClrTableStandAloneSigRow
+TJclClrTableTypeDef
+TJclClrTableTypeDefRow
+TJclClrTableTypeRef
+TJclClrTableTypeRefRow
+TJclClrTableTypeSpec
+TJclClrTableTypeSpecRow
+IMAGE_COR_ILMETHOD_FAT
+IMAGE_COR_ILMETHOD_SECT_EH
+IMAGE_COR_ILMETHOD_SECT_EH_CLAUSE_FAT
+IMAGE_COR_ILMETHOD_SECT_EH_CLAUSE_SMALL
+IMAGE_COR_ILMETHOD_SECT_EH_FAT
+IMAGE_COR_ILMETHOD_SECT_EH_SMALL
+IMAGE_COR_ILMETHOD_SECT_FAT
+IMAGE_COR_ILMETHOD_SECT_SMALL
+IMAGE_COR_ILMETHOD_TINY
+TImageCorILMethodHeader
+TImageCorILMethodSectHeader
+TJclClrArrayData
+TJclClrAssemblyFlag
+TJclClrClassLayout
+TJclClrClassSemantics
+TJclClrCodeBlock
+TJclClrElementType
+TJclClrExceptionClauseFlag
+TJclClrLocalVarFlag
+TJclClrMemberAccess
+TJclClrMethodCodeType
+TJclClrMethodFlag
+TJclClrMethodImplFlag
+TJclClrMethodSignFlag
+TJclClrParamKind
+TJclClrStringFormatting
+TJclClrTableEventFlag
+TJclClrTableFieldDefFlag
+TJclClrTableFieldDefVisibility
+TJclClrTableManifestResourceVisibility
+TJclClrTablePropertyFlag
+TJclClrTypeAttribute
+TJclClrTypeVisibility
+PImageCorILMethodFat
+PImageCorILMethodHeader
+PImageCorILMethodSectEH
+PImageCorILMethodSectEHClauseFat
+PImageCorILMethodSectEHClauseSmall
+PImageCorILMethodSectEHFat
+PImageCorILMethodSectEHSmall
+PImageCorILMethodSectFat
+PImageCorILMethodSectHeader
+PImageCorILMethodSectSmall
+PImageCorILMethodTiny
+TImageCorILMethodFat
+TImageCorILMethodSectEH
+TImageCorILMethodSectEHClauseFat
+TImageCorILMethodSectEHClauseSmall
+TImageCorILMethodSectEHFat
+TImageCorILMethodSectEHSmall
+TImageCorILMethodSectFat
+TImageCorILMethodSectSmall
+TImageCorILMethodTiny
+TJclClrArraySignBound
+TJclClrArraySignBounds
+TJclClrAssemblyFlags
+TJclClrExceptionClauseFlags
+TJclClrLocalVarFlags
+TJclClrMethodFlags
+TJclClrMethodImplFlags
+TJclClrMethodSignFlags
+TJclClrParamKinds
+TJclClrTableEventFlags
+TJclClrTableFieldDefFlags
+TJclClrTablePropertyFlags
+TJclClrTypeAttributes
diff --git a/official/1.104/experts/useswizard/JclMime.txt b/official/1.104/experts/useswizard/JclMime.txt
new file mode 100644
index 0000000..c901429
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclMime.txt
@@ -0,0 +1,34 @@
+DecodeHttpBasicAuthentication
+MimeDecode
+MimeDecode
+MimeDecodeFile
+MimeDecodePartial
+MimeDecodePartial
+MimeDecodePartialEnd
+MimeDecodePartialEnd
+MimeEncode
+MimeEncode
+MimeEncodedSizeNoCRLF
+MimeEncodeFile
+MimeEncodeFileNoCRLF
+MimeEncodeFullLines
+MimeEncodeFullLines
+MimeEncodeFullLines
+MimeEncodeNoCRLF
+MimeEncodeNoCRLF
+MimeEncodeNoCRLF
+MimeEncodeStreamNoCRLF
+MimeEncodeStringNoCRLF
+MIME_BUFFER_SIZE
+MIME_DECODED_LINE_BREAK
+MIME_ENCODED_LINE_BREAK
+MimeDecode
+MimeDecodePartial
+MimeDecodePartialEnd
+MimeEncode
+MimeEncodeString
+MimeDecodeString
+MimeEncodeStream
+MimeDecodeStream
+MimeEncodedSize
+MimeDecodedSize
diff --git a/official/1.104/experts/useswizard/JclMiscel.txt b/official/1.104/experts/useswizard/JclMiscel.txt
new file mode 100644
index 0000000..40c813a
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclMiscel.txt
@@ -0,0 +1,23 @@
+AbortShutDown
+AbortShutDown
+CreateDOSProcessRedirected
+GetAllowedPowerOperations
+HibernateOS
+ShutDownDialog
+ShutDownDialog
+SuspendOS
+WinExec32
+WinExec32AndRedirectOutput
+WinExec32AndWait
+TJclAllowedPowerOperation
+TJclKillLevel
+TJclAllowedPowerOperations
+SetDisplayResolution
+CreateProcAsUserEx
+CreateProcAsUser
+EJclCreateProcessError
+LogOffOS
+ExitWindows
+ShutDownOS
+PowerOffOS
+RebootOS
diff --git a/official/1.104/experts/useswizard/JclMsdosSys.txt b/official/1.104/experts/useswizard/JclMsdosSys.txt
new file mode 100644
index 0000000..b3b3b85
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclMsdosSys.txt
@@ -0,0 +1,2 @@
+IJclMsdosSys
+GetMsdosSys
diff --git a/official/1.104/experts/useswizard/JclMultimedia.txt b/official/1.104/experts/useswizard/JclMultimedia.txt
new file mode 100644
index 0000000..8e745e3
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclMultimedia.txt
@@ -0,0 +1,31 @@
+EJclMciError
+EJclMixerError
+EJclMmTimerError
+TJclMixer
+TJclMixerDestination
+TJclMixerDevice
+TJclMixerLine
+TJclMixerLineControl
+TJclMixerSource
+CloseCdMciDevice
+GetCDAudioTrackList
+GetCDAudioTrackList
+GetCdInfo
+IsMediaPresentInDrive
+MixerLeftRightToArray
+MMCheck
+OpenCdMciDevice
+TJclCdMediaInfo
+TJclCdTrackInfo
+TJclCdTrackType
+TJclCdTrackInfoArray
+TMCI_Open_Parms
+TMixerCaps
+TMixerControl
+TMixerLine
+TTimeCaps
+TJclMultimediaTimer
+TMmTimerKind
+TMmNotificationKind
+GetMciErrorMessage
+OpenCloseCdDrive
diff --git a/official/1.104/experts/useswizard/JclNTFS.txt b/official/1.104/experts/useswizard/JclNTFS.txt
new file mode 100644
index 0000000..4b74bd1
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclNTFS.txt
@@ -0,0 +1,48 @@
+EJclNtfsError
+NtfsCreateHardLink
+NtfsCreateHardLinkA
+NtfsCreateHardLinkW
+NtfsDeleteHardLinks
+NtfsFindHardLinks
+NtfsGetCompression
+NtfsGetHardLinkInfo
+NtfsOpLockAckClosePending
+NtfsOpLockBreakAckNo2
+NtfsOpLockBreakAcknowledge
+NtfsOpLockBreakNotify
+NtfsRequestOpLock
+TInternalFindStreamData
+TNtfsHardLinkInfo
+TOpLock
+NtfsGetCompression
+TStreamId
+TFindStreamData
+NtfsFindFirstStream
+NtfsFindNextStream
+NtfsFindStreamClose
+NtfsCreateJunctionPoint
+NtfsDeleteJunctionPoint
+NtfsGetJunctionPointDestination
+NtfsZeroDataByName
+NtfsZeroDataByHandle
+NtfsSparseStreamsSupported
+TNtfsAllocRanges
+NtfsGetAllocRangeEntry
+NtfsQueryAllocRanges
+NtfsGetSparse
+NtfsSetSparse
+NtfsDeleteReparsePoint
+NtfsSetReparsePoint
+NtfsGetReparsePoint
+NtfsGetReparseTag
+NtfsReparsePointsSupported
+NtfsFileHasReparsePoint
+NtfsIsFolderMountPoint
+NtfsMountDeviceAsDrive
+NtfsMountVolume
+NtfsSetCompression
+NtfsSetFileCompression
+NtfsSetDirectoryTreeCompression
+NtfsSetPathCompression
+NtfsSetDefaultFileCompression
+TFileCompressionState
diff --git a/official/1.104/experts/useswizard/JclPCRE.txt b/official/1.104/experts/useswizard/JclPCRE.txt
new file mode 100644
index 0000000..1c5abdb
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclPCRE.txt
@@ -0,0 +1,10 @@
+EPCREError
+TJclAnsiRegEx
+InitializeLocaleSupport
+TerminateLocaleSupport
+TJclAnsiCaptureOffset
+TJclAnsiRegExOption
+PPCREIntArray
+TJclAnsiRegExOptions
+TPCREIntArray
+JCL_PCRE_ERROR_STUDYFAILED
diff --git a/official/1.104/experts/useswizard/JclParseUses.pas b/official/1.104/experts/useswizard/JclParseUses.pas
new file mode 100644
index 0000000..f284f08
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclParseUses.pas
@@ -0,0 +1,907 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is JclParseUses.pas. }
+{ }
+{ The Initial Developer of the Original Code is TOndrej (tondrej att t-online dott de). }
+{ Portions created by TOndrej are Copyright (C) of TOndrej. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclParseUses;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Classes, SysUtils,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/useswizard/JclParseUses.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\useswizard'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/useswizard/JclPeImage.txt b/official/1.104/experts/useswizard/JclPeImage.txt
new file mode 100644
index 0000000..2ab1687
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclPeImage.txt
@@ -0,0 +1,94 @@
+TJclPeBorForm
+TJclPeBorImagesCache
+TJclPeCertificate
+TJclPeCertificateList
+TJclPeCLRHeader
+PeBorDependedPackages
+PeBorFormNames
+PeBorUnmangleName
+PeBorUnmangleName
+PeBorUnmangleName
+PeClearCheckSum
+PeCreateRequiredImportList
+PeExportedNames
+PeExportedVariables
+PeFindMissingImports
+PeFindMissingImports
+PeInsertSection
+PeMapFindResource
+PeMapImgExportedVariables
+PeMapImgResolvePackageThunk
+PeReadLinkerTimeStamp
+PeResourceKindNames
+PeUpdateLinkerTimeStamp
+TJclBorUmSymbolModifiers
+TJclPeImageClass
+TJclSmartCompOptions
+EJclPeImageError
+TJclRebaseImageInfo
+TJclPeMapImgHookItem
+TJclPeMapImgHooks
+TJclPeBorImage
+TJclPePackageInfo
+TJclPeDebugList
+TJclPeExportSort
+TJclPeExportFuncItem
+TJclPeExportFuncList
+PeDbgImgNtHeaders
+PeDbgImgLibraryName
+TJclPeImportSort
+TJclPeImportLibSort
+TJclPeImportKind
+TJclPeResolveCheck
+TJclPeLinkerProducer
+TJclPeImportFuncItem
+TJclPeImportLibItem
+TJclPeImportList
+PeMapImgNtHeaders
+PeMapImgLibraryName
+PeMapImgSections
+PeMapImgFindSection
+TJclPeSectionStream
+IsValidPeFile
+PeCreateNameHintTable
+PeRebaseImage
+PeUpdateCheckSum
+PeBorUnmangleName
+TJclBorUmDescription
+TJclBorUmSymbolKind
+TJclBorUmSymbolModifier
+TJclBorUmResult
+TJclPeUmResult
+PeIsNameMangled
+PeUnmangleName
+TJclPeRelocation
+TJclPeRelocEntry
+TJclPeRelocList
+TJclPeResourceKind
+TJclPeResourceItem
+TJclPeResourceList
+TJclPeResourceRawStream
+TJclPeRootResourceList
+PeDoesExportFunction
+PeIsExportFunctionForwardedEx
+PeIsExportFunctionForwarded
+PeDoesImportFunction
+PeDoesImportLibrary
+PeImportedLibraries
+PeImportedFunctions
+PeExportedFunctions
+PeGetNtHeaders
+PeVerifyCheckSum
+PeStripFunctionAW
+PeSmartFunctionNameSame
+TJclPeNameSearchOption
+TJclPeNameSearchNotifyEvent
+TJclPeNameSearchFoundEvent
+TJclPeNameSearch
+TJclPeHeader
+TJclLoadConfig
+TJclPeFileProperties
+TJclPeImageStatus
+TJclPeImage
+TJclPeImageBaseList
+TJclPeImagesCache
diff --git a/official/1.104/experts/useswizard/JclPrint.txt b/official/1.104/experts/useswizard/JclPrint.txt
new file mode 100644
index 0000000..2b9dc3a
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclPrint.txt
@@ -0,0 +1,16 @@
+EJclPrinterError
+TJclPrintSet
+CharFitsWithinDots
+DirectPrint
+DPGetDefaultPrinter
+DPSetDefaultPrinter
+GetDefaultPrinterName
+GetPrinterResolution
+PrintMemo
+SetPrinterPixelsPerInch
+PWordArray
+TWordArray
+CBinMax
+CCHBinName
+CCHPaperName
+CPaperNames
diff --git a/official/1.104/experts/useswizard/JclQGraphUtils.txt b/official/1.104/experts/useswizard/JclQGraphUtils.txt
new file mode 100644
index 0000000..924f9c1
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclQGraphUtils.txt
@@ -0,0 +1,129 @@
+EColorConversionError
+AlphaComponent
+BlueComponent
+CIELABToBGR
+CIELABToBGR
+ClipCodes
+ClipCodes
+ClipLine
+CMYKToBGR
+CMYKToBGR
+Color32
+Color32
+Color32
+ColorToHTML
+DialogUnitsToPixelsX
+DialogUnitsToPixelsY
+EMMS
+Gray32
+GreenComponent
+HLSToRGB
+HLSToRGB
+HLSToRGB
+HSLToRGB
+HSLToRGB
+Intensity
+Intensity
+OpenGLColorToWinColor
+PixelsToDialogUnitsX
+PixelsToDialogUnitsY
+RectFitToScreen
+RedComponent
+RGBAToBGRA
+RGBToBGR
+RGBToBGR
+RGBToHLS
+RGBToHLS
+RGBToHLS
+RGBToHSL
+RGBToHSL
+SetAlpha
+ShortenString
+WinColor
+WinColorToOpenGLColor
+TClipCode
+TColorRec
+TColorVector
+THLSVector
+PClipCodes
+PColor32
+PColor32Array
+PPalette32
+TArrayOfColor32
+TBlendLine
+TBlendLineEx
+TBlendMem
+TBlendMemEx
+TBlendReg
+TBlendRegEx
+TClipCodes
+TCombineMem
+TCombineReg
+THLSValue
+BlendLine
+BlendLineEx
+BlendMem
+BlendMemEx
+BlendReg
+BlendRegEx
+CombineMem
+CombineReg
+clTeal32
+clTrBlack32
+clTrBlue32
+clTrGreen32
+clTrRed32
+clTrWhite32
+clWhite32
+clYellow32
+ClipLine
+DrawPolyLine
+BrightColorChannel
+DarkColorChannel
+DarkColor
+BrightColor
+GetRGBValue
+SetRGBValue
+SetColorRed
+SetColorGreen
+SetColorBlue
+SetColorFlag
+GetColorRed
+GetColorBlue
+GetColorGreen
+GetColorFlag
+CIED65ToCIED50
+PointAssign
+PointCopy
+PointEqual
+PointMove
+NullPoint
+PointIsNull
+RectIsEmpty
+RectNormalize
+RectUnion
+RectIsSquare
+RectCenter
+RectEqual
+RectIsNull
+NullRect
+RectIsValid
+RectsAreValid
+RectIntersectRect
+RectIntersection
+RectIncludesPoint
+RectIncludesRect
+RectBounds
+RectAssign
+RectAssignPoints
+RectCopy
+RectMove
+RectMoveTo
+RectGrow
+RectGrowX
+RectGrowY
+RectHeight
+RectWidth
+TColor32
+TColor32Array
+TPalette32
diff --git a/official/1.104/experts/useswizard/JclQGraphics.txt b/official/1.104/experts/useswizard/JclQGraphics.txt
new file mode 100644
index 0000000..80a48e4
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclQGraphics.txt
@@ -0,0 +1,31 @@
+EJclGraphicsError
+TColorChannel
+TJclRegionBitmapMode
+TJclRegionCombineOperator
+TJclRegionKind
+FillGradient
+IdentityMatrix
+DrawBitmap
+Stretch
+TResamplingFilter
+TDrawMode
+TMatrix3d
+TStretchFilter
+TConversionKind
+TJclTransformation
+TJclLinearTransformation
+BitmapToIcon
+IconToBitmap
+ExtractIconCount
+TGradientDirection
+TPolyFillMode
+TPointF
+TDynPointArrayF
+TDynDynPointArrayArrayF
+TDynPointArray
+TDynDynPointArrayArray
+TDynDynIntegerArrayArray
+TGamma
+TLUT8
+TScanLine
+TScanLines
diff --git a/official/1.104/experts/useswizard/JclQueues.txt b/official/1.104/experts/useswizard/JclQueues.txt
new file mode 100644
index 0000000..440e206
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclQueues.txt
@@ -0,0 +1,3 @@
+TJclQueue
+TJclIntfQueue
+TJclStrQueue
diff --git a/official/1.104/experts/useswizard/JclRTF.txt b/official/1.104/experts/useswizard/JclRTF.txt
new file mode 100644
index 0000000..942aeec
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclRTF.txt
@@ -0,0 +1,2 @@
+TJclRTFProducer
+JclRTFToPlainText
diff --git a/official/1.104/experts/useswizard/JclRTTI.txt b/official/1.104/experts/useswizard/JclRTTI.txt
new file mode 100644
index 0000000..4f24659
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclRTTI.txt
@@ -0,0 +1,39 @@
+EJclRTTIError
+TJclInfoStringsWriter
+TJclInfoWriter
+MaxPrefixCut
+PREFIX_CUT_EQUAL
+PREFIX_CUT_LOWERCASE
+JclIsClass
+JclIsClassByName
+JclSetToList
+JclSetToStr
+JclStrToSet
+JclIntToSet
+JclSetToInt
+JclEnumValueToIdent
+JclStrToTypedInt
+JclTypedIntToStr
+JclGenerateSetType
+JclGenerateEnumType
+JclGenerateEnumTypeBasedOn
+JclGenerateSubRange
+RemoveTypeInfo
+JclTypeInfo
+IJclInfoWriter
+IJclBaseInfo
+TJclPropSpecKind
+IJclClassTypeInfo
+IJclPropInfo
+IJclDynArrayTypeInfo
+IJclEnumerationTypeInfo
+IJclEventTypeInfo
+IJclEventParamInfo
+IJclFloatTypeInfo
+IJclInt64TypeInfo
+IJclInterfaceTypeInfo
+IJclOrdinalRangeTypeInfo
+IJclOrdinalTypeInfo
+IJclSetTypeInfo
+IJclStringTypeInfo
+IJclTypeInfo
diff --git a/official/1.104/experts/useswizard/JclRegistry.txt b/official/1.104/experts/useswizard/JclRegistry.txt
new file mode 100644
index 0000000..999b260
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclRegistry.txt
@@ -0,0 +1,102 @@
+RegCreateKey
+RegReadAnsiStringEx
+RegReadBinaryEx
+RegReadCardinalEx
+RegReadDouble
+RegReadDoubleDef
+RegReadDoubleEx
+RegReadDWORDEx
+RegReadExtended
+RegReadExtendedDef
+RegReadExtendedEx
+RegReadInt64Ex
+RegReadIntegerEx
+RegReadMultiSz
+RegReadMultiSz
+RegReadMultiSzDef
+RegReadMultiSzDef
+RegReadMultiSzEx
+RegReadMultiSzEx
+RegReadSingle
+RegReadSingleDef
+RegReadSingleEx
+RegReadStringEx
+RegReadUInt64Ex
+RegReadWideMultiSz
+RegReadWideMultiSz
+RegReadWideMultiSzDef
+RegReadWideMultiSzDef
+RegReadWideMultiSzEx
+RegReadWideMultiSzEx
+RegReadWideStringEx
+RegValueExists
+RegWriteAnsiString
+RegWriteBool
+RegWriteCardinal
+RegWriteDouble
+RegWriteDouble
+RegWriteDWORD
+RegWriteExtended
+RegWriteExtended
+RegWriteInt64
+RegWriteInteger
+RegWriteMultiSz
+RegWriteMultiSz
+RegWriteMultiSz
+RegWriteMultiSz
+RegWriteSingle
+RegWriteSingle
+RegWriteString
+RegWriteUInt64
+RegWriteWideMultiSz
+RegWriteWideMultiSz
+RegWriteWideMultiSz
+RegWriteWideMultiSz
+RegWriteWideString
+DelphiHKEY
+HKCC
+HKCR
+HKCU
+HKDD
+HKLM
+HKPD
+HKUS
+RegKeyDelimiter
+RegCreateKey
+RegWriteBool
+RegWriteCardinal
+RegWriteDWORD
+RegWriteInt64
+RegWriteInteger
+RegWriteString
+RegWriteUInt64
+RegDeleteKeyTree
+RegReadBoolDef
+RegReadIntegerDef
+RegReadStringDef
+RegDeleteEntry
+RegWriteBinary
+RegReadBool
+RegReadInteger
+RegReadString
+RegReadBinary
+UnregisterAutoExec
+RegisterAutoExec
+TExecKind
+RegGetValueNames
+RegGetKeyNames
+RegHasSubKeys
+RegSaveList
+RegLoadList
+RegDelList
+RegKeyExists
+EJclRegistryError
+RegGetDataSize
+RegGetDataType
+RegReadCardinal
+RegReadInt64
+RegReadUInt64
+RegReadAnsiString
+RegReadWideString
+RegReadDWORD
+AllowRegKeyForEveryone
diff --git a/official/1.104/experts/useswizard/JclResources.txt b/official/1.104/experts/useswizard/JclResources.txt
new file mode 100644
index 0000000..5a638a4
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclResources.txt
@@ -0,0 +1,1441 @@
+EDIXMLError001
+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
+RsArgumentIsNull
+RsArgumentOutOfRange
+RsAssertUnpairedEndUpdate
+RsAttrAnyFile
+RsAttrArchive
+RsAttrCompressed
+RsAttrDirectory
+RsAttrEncrypted
+RsAttrHidden
+RsAttrNormal
+RsAttrOffline
+RsAttrReadOnly
+RsAttrReparsePoint
+RsAttrSparseFile
+RsAttrSystemFile
+RsAttrTemporary
+RsAttrVolumeID
+RsBCBName
+RsBDSName
+RsBitmapExtension
+RsBitsPerSampleNotSupported
+RsBlankSearchString
+RsBorlandStudioProjects
+RsCannotCreateDir
+RsCannotRaiseSignal
+RsCannotWriteRefStream
+RsCasedUnicodeChar
+RsCDRomDrive
+RsCILCmdadd
+RsCILCmdaddovf
+RsCILCmdaddovfun
+RsCILCmdand
+RsCILCmdarglist
+RsCILCmdbeq
+RsCILCmdbeqs
+RsCILCmdbge
+RsCILCmdbges
+RsCILCmdbgeun
+RsCILCmdbgeuns
+RsCILCmdbgt
+RsCILCmdbgts
+RsCILCmdbgtun
+RsCILCmdbgtuns
+RsCILCmdble
+RsCILCmdbles
+RsCILCmdbleun
+RsCILCmdbleuns
+RsCILCmdblt
+RsCILCmdblts
+RsCILCmdbltun
+RsCILCmdbltuns
+RsCILCmdbneun
+RsCILCmdbneuns
+RsCILCmdbox
+RsCILCmdbr
+RsCILCmdbreak
+RsCILCmdbrfalse
+RsCILCmdbrfalses
+RsCILCmdbrs
+RsCILCmdbrtrue
+RsCILCmdbrtrues
+RsCILCmdcall
+RsCILCmdcalli
+RsCILCmdcallvirt
+RsCILCmdcastclass
+RsCILCmdceq
+RsCILCmdcgt
+RsCILCmdcgtun
+RsCILCmdckfinite
+RsCILCmdclt
+RsCILCmdcltun
+RsCILCmdconvi
+RsCILCmdconvi1
+RsCILCmdconvi2
+RsCILCmdconvi4
+RsCILCmdconvi8
+RsCILCmdconvovfi
+RsCILCmdconvovfi1
+RsCILCmdconvovfi1un
+RsCILCmdconvovfi2
+RsCILCmdconvovfi2un
+RsCILCmdconvovfi4
+RsCILCmdconvovfi4un
+RsCILCmdconvovfi8
+RsCILCmdconvovfi8un
+RsCILCmdconvovfiun
+RsCILCmdconvovfu
+RsCILCmdconvovfu1
+RsCILCmdconvovfu1un
+RsCILCmdconvovfu2
+RsCILCmdconvovfu2un
+RsCILCmdconvovfu4
+RsCILCmdconvovfu4un
+RsCILCmdconvovfu8
+RsCILCmdconvovfu8un
+RsCILCmdconvovfuun
+RsCILCmdconvr4
+RsCILCmdconvr8
+RsCILCmdconvrun
+RsCILCmdconvu
+RsCILCmdconvu1
+RsCILCmdconvu2
+RsCILCmdconvu4
+RsCILCmdconvu8
+RsCILCmdcpblk
+RsCILCmdcpobj
+RsCILCmddiv
+RsCILCmddivun
+RsCILCmddup
+RsCILCmdendfilter
+RsCILCmdendfinally
+RsCILCmdinitblk
+RsCILCmdinitobj
+RsCILCmdisinst
+RsCILCmdjmp
+RsCILCmdldarg
+RsCILCmdldarg0
+RsCILCmdldarg1
+RsCILCmdldarg2
+RsCILCmdldarg3
+RsCILCmdldarga
+RsCILCmdldargas
+RsCILCmdldargs
+RsCILCmdldci4
+RsCILCmdldci40
+RsCILCmdldci41
+RsCILCmdldci42
+RsCILCmdldci43
+RsCILCmdldci44
+RsCILCmdldci45
+RsCILCmdldci46
+RsCILCmdldci47
+RsCILCmdldci48
+RsCILCmdldci4m1
+RsCILCmdldci4s
+RsCILCmdldci8
+RsCILCmdldcr4
+RsCILCmdldcr8
+RsCILCmdldelema
+RsCILCmdldelemi
+RsCILCmdldelemi1
+RsCILCmdldelemi2
+RsCILCmdldelemi4
+RsCILCmdldelemi8
+RsCILCmdldelemr4
+RsCILCmdldelemr8
+RsCILCmdldelemref
+RsCILCmdldelemu1
+RsCILCmdldelemu2
+RsCILCmdldelemu4
+RsCILCmdldfld
+RsCILCmdldflda
+RsCILCmdldftn
+RsCILCmdldindi
+RsCILCmdldindi1
+RsCILCmdldindi2
+RsCILCmdldindi4
+RsCILCmdldindi8
+RsCILCmdldindr4
+RsCILCmdldindr8
+RsCILCmdldindref
+RsCILCmdldindu1
+RsCILCmdldindu2
+RsCILCmdldindu4
+RsCILCmdldlen
+RsCILCmdldloc
+RsCILCmdldloc0
+RsCILCmdldloc1
+RsCILCmdldloc2
+RsCILCmdldloc3
+RsCILCmdldloca
+RsCILCmdldlocas
+RsCILCmdldlocs
+RsCILCmdldnull
+RsCILCmdldobj
+RsCILCmdldsfld
+RsCILCmdldsflda
+RsCILCmdldstr
+RsCILCmdldtoken
+RsCILCmdldvirtftn
+RsCILCmdleave
+RsCILCmdleaves
+RsCILCmdlocalloc
+RsCILCmdmkrefany
+RsCILCmdmul
+RsCILCmdmulovf
+RsCILCmdmulovfun
+RsCILCmdneg
+RsCILCmdnewarr
+RsCILCmdnewobj
+RsCILCmdnop
+RsCILCmdnot
+RsCILCmdor
+RsCILCmdpop
+RsCILCmdprefix1
+RsCILCmdprefix2
+RsCILCmdprefix3
+RsCILCmdprefix4
+RsCILCmdprefix5
+RsCILCmdprefix6
+RsCILCmdprefix7
+RsCILCmdprefixref
+RsCILCmdrefanytype
+RsCILCmdrefanyval
+RsCILCmdrem
+RsCILCmdremun
+RsCILCmdret
+RsCILCmdrethrow
+RsCILCmdshl
+RsCILCmdshr
+RsCILCmdshrun
+RsCILCmdsizeof
+RsCILCmdstarg
+RsCILCmdstargs
+RsCILCmdstelemi
+RsCILCmdstelemi1
+RsCILCmdstelemi2
+RsCILCmdstelemi4
+RsCILCmdstelemi8
+RsCILCmdstelemr4
+RsCILCmdstelemr8
+RsCILCmdstelemref
+RsCILCmdstfld
+RsCILCmdstindi
+RsCILCmdstindi1
+RsCILCmdstindi2
+RsCILCmdstindi4
+RsCILCmdstindi8
+RsCILCmdstindr4
+RsCILCmdstindr8
+RsCILCmdstindref
+RsCILCmdstloc
+RsCILCmdstloc0
+RsCILCmdstloc1
+RsCILCmdstloc2
+RsCILCmdstloc3
+RsCILCmdstlocs
+RsCILCmdstobj
+RsCILCmdstsfld
+RsCILCmdsub
+RsCILCmdsubovf
+RsCILCmdsubovfun
+RsCILCmdswitch
+RsCILCmdtail
+RsCILCmdthrow
+RsCILCmdunaligned
+RsCILCmdunbox
+RsCILCmdunused1
+RsCILCmdunused10
+RsCILCmdunused11
+RsCILCmdunused12
+RsCILCmdunused13
+RsCILCmdunused14
+RsCILCmdunused15
+RsCILCmdunused16
+RsCILCmdunused17
+RsCILCmdunused18
+RsCILCmdunused19
+RsCILCmdunused2
+RsCILCmdunused20
+RsCILCmdunused21
+RsCILCmdunused22
+RsCILCmdunused23
+RsCILCmdunused24
+RsCILCmdunused25
+RsCILCmdunused26
+RsCILCmdunused27
+RsCILCmdunused28
+RsCILCmdunused29
+RsCILCmdunused3
+RsCILCmdunused30
+RsCILCmdunused31
+RsCILCmdunused32
+RsCILCmdunused33
+RsCILCmdunused34
+RsCILCmdunused35
+RsCILCmdunused36
+RsCILCmdunused37
+RsCILCmdunused38
+RsCILCmdunused39
+RsCILCmdunused4
+RsCILCmdunused40
+RsCILCmdunused41
+RsCILCmdunused42
+RsCILCmdunused43
+RsCILCmdunused44
+RsCILCmdunused45
+RsCILCmdunused46
+RsCILCmdunused47
+RsCILCmdunused48
+RsCILCmdunused49
+RsCILCmdunused5
+RsCILCmdunused50
+RsCILCmdunused51
+RsCILCmdunused52
+RsCILCmdunused53
+RsCILCmdunused54
+RsCILCmdunused55
+RsCILCmdunused56
+RsCILCmdunused57
+RsCILCmdunused58
+RsCILCmdunused59
+RsCILCmdunused6
+RsCILCmdunused60
+RsCILCmdunused61
+RsCILCmdunused62
+RsCILCmdunused63
+RsCILCmdunused64
+RsCILCmdunused65
+RsCILCmdunused66
+RsCILCmdunused67
+RsCILCmdunused68
+RsCILCmdunused69
+RsCILCmdunused7
+RsCILCmdunused70
+RsCILCmdunused8
+RsCILCmdunused9
+RsCILCmdvolatile
+RsCILCmdxor
+RsCILDescradd
+RsCILDescraddovf
+RsCILDescraddovfun
+RsCILDescrand
+RsCILDescrarglist
+RsCILDescrbeq
+RsCILDescrbeqs
+RsCILDescrbge
+RsCILDescrbges
+RsCILDescrbgeun
+RsCILDescrbgeuns
+RsCILDescrbgt
+RsCILDescrbgts
+RsCILDescrbgtun
+RsCILDescrbgtuns
+RsCILDescrble
+RsCILDescrbles
+RsCILDescrbleun
+RsCILDescrbleuns
+RsCILDescrblt
+RsCILDescrblts
+RsCILDescrbltun
+RsCILDescrbltuns
+RsCILDescrbneun
+RsCILDescrbneuns
+RsCILDescrbox
+RsCILDescrbr
+RsCILDescrbreak
+RsCILDescrbrfalse
+RsCILDescrbrfalses
+RsCILDescrbrs
+RsCILDescrbrtrue
+RsCILDescrbrtrues
+RsCILDescrcall
+RsCILDescrcalli
+RsCILDescrcallvirt
+RsCILDescrcastclass
+RsCILDescrceq
+RsCILDescrcgt
+RsCILDescrcgtun
+RsCILDescrckfinite
+RsCILDescrclt
+RsCILDescrcltun
+RsCILDescrconvi
+RsCILDescrconvi1
+RsCILDescrconvi2
+RsCILDescrconvi4
+RsCILDescrconvi8
+RsCILDescrconvovfi
+RsCILDescrconvovfi1
+RsCILDescrconvovfi1un
+RsCILDescrconvovfi2
+RsCILDescrconvovfi2un
+RsCILDescrconvovfi4
+RsCILDescrconvovfi4un
+RsCILDescrconvovfi8
+RsCILDescrconvovfi8un
+RsCILDescrconvovfiun
+RsCILDescrconvovfu
+RsCILDescrconvovfu1
+RsCILDescrconvovfu1un
+RsCILDescrconvovfu2
+RsCILDescrconvovfu2un
+RsCILDescrconvovfu4
+RsCILDescrconvovfu4un
+RsCILDescrconvovfu8
+RsCILDescrconvovfu8un
+RsCILDescrconvovfuun
+RsCILDescrconvr4
+RsCILDescrconvr8
+RsCILDescrconvrun
+RsCILDescrconvu
+RsCILDescrconvu1
+RsCILDescrconvu2
+RsCILDescrconvu4
+RsCILDescrconvu8
+RsCILDescrcpblk
+RsCILDescrcpobj
+RsCILDescrdiv
+RsCILDescrdivun
+RsCILDescrdup
+RsCILDescrendfilter
+RsCILDescrendfinally
+RsCILDescrinitblk
+RsCILDescrinitobj
+RsCILDescrisinst
+RsCILDescrjmp
+RsCILDescrldarg
+RsCILDescrldarg0
+RsCILDescrldarg1
+RsCILDescrldarg2
+RsCILDescrldarg3
+RsCILDescrldarga
+RsCILDescrldargas
+RsCILDescrldargs
+RsCILDescrldci4
+RsCILDescrldci40
+RsCILDescrldci41
+RsCILDescrldci42
+RsCILDescrldci43
+RsCILDescrldci44
+RsCILDescrldci45
+RsCILDescrldci46
+RsCILDescrldci47
+RsCILDescrldci48
+RsCILDescrldci4m1
+RsCILDescrldci4s
+RsCILDescrldci8
+RsCILDescrldcr4
+RsCILDescrldcr8
+RsCILDescrldelema
+RsCILDescrldelemi
+RsCILDescrldelemi1
+RsCILDescrldelemi2
+RsCILDescrldelemi4
+RsCILDescrldelemi8
+RsCILDescrldelemr4
+RsCILDescrldelemr8
+RsCILDescrldelemref
+RsCILDescrldelemu1
+RsCILDescrldelemu2
+RsCILDescrldelemu4
+RsCILDescrldfld
+RsCILDescrldflda
+RsCILDescrldftn
+RsCILDescrldindi
+RsCILDescrldindi1
+RsCILDescrldindi2
+RsCILDescrldindi4
+RsCILDescrldindi8
+RsCILDescrldindr4
+RsCILDescrldindr8
+RsCILDescrldindref
+RsCILDescrldindu1
+RsCILDescrldindu2
+RsCILDescrldindu4
+RsCILDescrldlen
+RsCILDescrldloc
+RsCILDescrldloc0
+RsCILDescrldloc1
+RsCILDescrldloc2
+RsCILDescrldloc3
+RsCILDescrldloca
+RsCILDescrldlocas
+RsCILDescrldlocs
+RsCILDescrldnull
+RsCILDescrldobj
+RsCILDescrldsfld
+RsCILDescrldsflda
+RsCILDescrldstr
+RsCILDescrldtoken
+RsCILDescrldvirtftn
+RsCILDescrleave
+RsCILDescrleaves
+RsCILDescrlocalloc
+RsCILDescrmkrefany
+RsCILDescrmul
+RsCILDescrmulovf
+RsCILDescrmulovfun
+RsCILDescrneg
+RsCILDescrnewarr
+RsCILDescrnewobj
+RsCILDescrnop
+RsCILDescrnot
+RsCILDescror
+RsCILDescrpop
+RsCILDescrprefix1
+RsCILDescrprefix2
+RsCILDescrprefix3
+RsCILDescrprefix4
+RsCILDescrprefix5
+RsCILDescrprefix6
+RsCILDescrprefix7
+RsCILDescrprefixref
+RsCILDescrrefanytype
+RsCILDescrrefanyval
+RsCILDescrrem
+RsCILDescrremun
+RsCILDescrret
+RsCILDescrrethrow
+RsCILDescrshl
+RsCILDescrshr
+RsCILDescrshrun
+RsCILDescrsizeof
+RsCILDescrstarg
+RsCILDescrstargs
+RsCILDescrstelemi
+RsCILDescrstelemi1
+RsCILDescrstelemi2
+RsCILDescrstelemi4
+RsCILDescrstelemi8
+RsCILDescrstelemr4
+RsCILDescrstelemr8
+RsCILDescrstelemref
+RsCILDescrstfld
+RsCILDescrstindi
+RsCILDescrstindi1
+RsCILDescrstindi2
+RsCILDescrstindi4
+RsCILDescrstindi8
+RsCILDescrstindr4
+RsCILDescrstindr8
+RsCILDescrstindref
+RsCILDescrstloc
+RsCILDescrstloc0
+RsCILDescrstloc1
+RsCILDescrstloc2
+RsCILDescrstloc3
+RsCILDescrstlocs
+RsCILDescrstobj
+RsCILDescrstsfld
+RsCILDescrsub
+RsCILDescrsubovf
+RsCILDescrsubovfun
+RsCILDescrswitch
+RsCILDescrtail
+RsCILDescrthrow
+RsCILDescrunaligned
+RsCILDescrunbox
+RsCILDescrunused1
+RsCILDescrunused10
+RsCILDescrunused11
+RsCILDescrunused12
+RsCILDescrunused13
+RsCILDescrunused14
+RsCILDescrunused15
+RsCILDescrunused16
+RsCILDescrunused17
+RsCILDescrunused18
+RsCILDescrunused19
+RsCILDescrunused2
+RsCILDescrunused20
+RsCILDescrunused21
+RsCILDescrunused22
+RsCILDescrunused23
+RsCILDescrunused24
+RsCILDescrunused25
+RsCILDescrunused26
+RsCILDescrunused27
+RsCILDescrunused28
+RsCILDescrunused29
+RsCILDescrunused3
+RsCILDescrunused30
+RsCILDescrunused31
+RsCILDescrunused32
+RsCILDescrunused33
+RsCILDescrunused34
+RsCILDescrunused35
+RsCILDescrunused36
+RsCILDescrunused37
+RsCILDescrunused38
+RsCILDescrunused39
+RsCILDescrunused4
+RsCILDescrunused40
+RsCILDescrunused41
+RsCILDescrunused42
+RsCILDescrunused43
+RsCILDescrunused44
+RsCILDescrunused45
+RsCILDescrunused46
+RsCILDescrunused47
+RsCILDescrunused48
+RsCILDescrunused49
+RsCILDescrunused5
+RsCILDescrunused50
+RsCILDescrunused51
+RsCILDescrunused52
+RsCILDescrunused53
+RsCILDescrunused54
+RsCILDescrunused55
+RsCILDescrunused56
+RsCILDescrunused57
+RsCILDescrunused58
+RsCILDescrunused59
+RsCILDescrunused6
+RsCILDescrunused60
+RsCILDescrunused61
+RsCILDescrunused62
+RsCILDescrunused63
+RsCILDescrunused64
+RsCILDescrunused65
+RsCILDescrunused66
+RsCILDescrunused67
+RsCILDescrunused68
+RsCILDescrunused69
+RsCILDescrunused7
+RsCILDescrunused70
+RsCILDescrunused8
+RsCILDescrunused9
+RsCILDescrvolatile
+RsCILDescrxor
+RsCleaningFailed
+RsCleaningOk
+RsCleaningPackageCache
+RsClientServer
+RsClrCopyright
+RsCombiningClassUnicodeChar
+RsComFailedStreamRead
+RsComFailedStreamWrite
+RsComInvalidParam
+RsCommandLineToolMissing
+RsCompilationFailed
+RsCompilationOk
+RsCompilingPackage
+RsCompilingProject
+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
+RsCreatingJdbg
+RsCSharpName
+RsDateConversion
+RsDebugAssertValidPointer
+RsDebugAssertValidString
+RsDebugMapFileExtension
+RsDebugNoProcessInfo
+RsDebugSnapshot
+RsDeclarationFormat
+RsDecomposedUnicodeChar
+RsDefaultFileTypeName
+RsDeletingFile
+RsDelphiName
+RsDelphiNetName
+RsDelTreePathIsEmpty
+RsDestinationBitmapEmpty
+RsDeviceMode
+RsDibHandleAllocation
+RsDivByZero
+RsDotNetFormatArgumentNotSupported
+RsDotNetFormatNullFormat
+RsDynArrayError
+RsECannotInstallRunOnly
+RsECmdLineToolOutputInvalid
+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
+RsEDualPackageNotSupported
+RsEFunctionNotFound
+RsEGetBytesExFmt
+RsEIllegalQueueCapacity
+RsEIndexOufOfRange
+RsELibraryNotFound
+RsEmptyArray
+RsENoCollection
+RsENoOpenHelp
+RsENoSupportedPersonality
+RsENotABcbPackage
+RsENotABcbProject
+RsENotADelphiPackage
+RsENotADelphiProject
+RsENotFound
+RsEnterprise
+RsEOpenGLInfo
+RsEOperationNotSupported
+RsEOutOfBounds
+RsErrBadCount
+RsErrBadMagic
+RsErrBadOption
+RsErrBadPartial
+RsErrBadUTF8
+RsErrBadUTF8Offset
+RsErrCallout
+RsErrDfaRecurse
+RsErrDfaUCond
+RsErrDfaUItem
+RsErrDfaUMLimit
+RsErrDfaWSSize
+RsErrInternal
+RsErrLibNotLoaded
+RsErrMatchLimit
+RsErrMemFuncNotSet
+RsErrNoMatch
+RsErrNoMemory
+RsErrNoSubString
+RsErrNull
+RsErrPartial
+RsErrRecursionLimit
+RsErrStudyFailed
+RsErrUnknownNode
+RsESetBytesExFmt
+RsEUnknownCLRVersion
+RsEUnknownIdePackageExtension
+RsEUnknownPackageExtension
+RsEUnknownProjectExtension
+RsEValueNotFound
+RsEx64PlatformNotValid
+RsExpertInstallationFinished
+RsExpertInstallationStarted
+RsExpertUninstallationFinished
+RsExpertUninstallationStarted
+RsExprEvalEndArgs
+RsExprEvalExprNotFound
+RsExprEvalExprPtrNotFound
+RsExprEvalExprRefCountAssertion
+RsExprEvalFactorExpected
+RsExprEvalFirstArg
+RsExprEvalNextArg
+RsExprEvalRParenExpected
+RsExprEvalUnknownSymbol
+RsFailedToObtainSize
+RsFileDeletionFailed
+RsFileDeletionOk
+RsFileIndexOutOfRange
+RsFileMappingInvalidHandle
+RsFileMappingOpenFile
+RsFileSearchAttrInconsistency
+RsFileStreamCreate
+RsFileUtilsAttrUnavailable
+RsFileUtilsLanguageIndex
+RsFileUtilsNoVersionInfo
+RsFormatBadArgumentType
+RsFormatBadArgumentTypeEx
+RsFormatException
+RsFormatNoArgument
+RsFormatNoArgumentEx
+RsFormatSyntaxError
+RsHardDisk
+RsHasNotTD32Info
+RsHKCCLong
+RsHKCCShort
+RsHKCRLong
+RsHKCRShort
+RsHKCULong
+RsHKCUShort
+RsHKDDLong
+RsHKDDShort
+RsHKLMLong
+RsHKLMShort
+RsHKPDLong
+RsHKPDShort
+RsHKUSLong
+RsHKUSShort
+RsIdePackageInstallationFinished
+RsIdePackageInstallationStarted
+RsIdePackageUninstallationFinished
+RsIdePackageUninstallationStarted
+RsInconsistentPath
+RsIndexOutOfRange
+RsIndexOutOfRangePaper
+RsInsertingJdbg
+RsInstructionStreamInvalid
+RsIntelCacheDescr00
+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
+RsIntelCacheDescr78
+RsIntelCacheDescr79
+RsIntelCacheDescr7A
+RsIntelCacheDescr7B
+RsIntelCacheDescr7C
+RsIntelCacheDescr7D
+RsIntelCacheDescr7F
+RsIntelCacheDescr82
+RsIntelCacheDescr83
+RsIntelCacheDescr84
+RsIntelCacheDescr85
+RsIntelCacheDescr86
+RsIntelCacheDescr87
+RsIntelCacheDescrB0
+RsIntelCacheDescrB3
+RsIntelCacheDescrF0
+RsIntelCacheDescrF1
+RsIntelUnknownCache
+RsInvalidArgument
+RsInvalidDigit
+RsInvalidDigitValue
+RsInvalidEmptyStringItem
+RsInvalidGUIDString
+RsInvalidHandleForRegion
+RsInvalidMMFEmpty
+RsInvalidMMFName
+RsInvalidPrinter
+RsInvalidProcessID
+RsInvalidRational
+RsInvalidRegion
+RsInvalidRegionInfo
+RsInvalidSampleSize
+RsInvalidSignatureData
+RsIStreamNil
+RsJdbgInfo
+RsJdbgInfoFailed
+RsJdbgInfoOk
+RsJpegExtension
+RsKylixName
+RsKylixVersionName
+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
+RsMidiNotImplemented
+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
+RsOpenEdition
+RsOpenGLInfoError
+RsOSVersionWin2000
+RsOSVersionWin2003
+RsOSVersionWin2003R2
+RsOSVersionWin95
+RsOSVersionWin95OSR2
+RsOSVersionWin98
+RsOSVersionWin98SE
+RsOSVersionWinLonghorn
+RsOSVersionWinME
+RsOSVersionWinNT3
+RsOSVersionWinNT4
+RsOSVersionWinVista
+RsOSVersionWinXP
+RsOSVersionWinXP64
+RsPackageInstallationFinished
+RsPackageInstallationStarted
+RsPackageUninstallationFinished
+RsPackageUninstallationStarted
+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
+RsProductTypeEnterprise
+RsProductTypePersonal
+RsProductTypeProfessional
+RsProductTypeServer
+RsProductTypeWebEdition
+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
+RsReadKeyError
+RsRegionCouldNotCreated
+RsRegionDataOutOfBound
+RsRegisteringExpert
+RsRegisteringIdePackage
+RsRegisteringPackage
+RsRegistrationFailed
+RsRegistrationOk
+RsRemoteDrive
+RsRemovableDrive
+RsRetrievingPaperSource
+RsRetrievingSource
+RsRTTIArrayOf
+RsRTTIBasedOn
+RsRTTIBits
+RsRTTIClassName
+RsRTTIConst
+RsRTTIDefault
+RsRTTIElNeedCleanup
+RsRTTIElSize
+RsRTTIElType
+RsRTTIFalse
+RsRTTIField
+RsRTTIFlags
+RsRTTIFloatType
+RsRTTIGUID
+RsRTTIIndex
+RsRTTIInvalidBaseType
+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
+RsServerDeveloper
+RsSourceBitmapEmpty
+RsSourceBitmapInvalid
+RsSPInfo
+RsSpoolerDocName
+RsStandard
+RsStreamsCreateError
+RsStreamsOpenError
+RsStreamsSetSizeError
+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
+RsUnknownProjectType
+RsUnknownStringFormatting
+RsUnknownTable
+RsUnknownTableFmt
+RsUnregisteringExpert
+RsUnregisteringIdePackage
+RsUnregisteringPackage
+RsUnregistrationFailed
+RsUnregistrationOk
+RsUpdatePackName
+RsUpdatingPrinter
+RsUREBaseString
+RsURECharacterClassOpen
+RsUREErrorFmt
+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
+sLineBreak
diff --git a/official/1.104/experts/useswizard/JclSchedule.txt b/official/1.104/experts/useswizard/JclSchedule.txt
new file mode 100644
index 0000000..510d7cc
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclSchedule.txt
@@ -0,0 +1,21 @@
+TScheduleWeekDays
+sivFirst
+sivFourth
+sivLast
+sivSecond
+sivThird
+CreateSchedule
+TScheduleRecurringKind
+TScheduleEndKind
+TScheduleIndexKind
+ESchedule
+IJclSchedule
+IJclScheduleDayFrequency
+IJclDailySchedule
+IJclWeeklySchedule
+IJclMonthlySchedule
+IJclYearlySchedule
+NullStamp
+CompareTimeStamps
+EqualTimeStamps
+IsNullTimeStamp
diff --git a/official/1.104/experts/useswizard/JclSecurity.txt b/official/1.104/experts/useswizard/JclSecurity.txt
new file mode 100644
index 0000000..a337b5b
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclSecurity.txt
@@ -0,0 +1,13 @@
+FreeTokenInformation
+CreateNullDacl
+CreateInheritable
+LookupAccountBySid
+QueryTokenInformation
+GetInteractiveUserName
+IsPrivilegeEnabled
+EnableProcessPrivilege
+EnableThreadPrivilege
+IsAdministrator
+GetPrivilegeDisplayName
+GetUserObjectName
+SetUserObjectFullAccess
diff --git a/official/1.104/experts/useswizard/JclShell.txt b/official/1.104/experts/useswizard/JclShell.txt
new file mode 100644
index 0000000..9f3501c
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclShell.txt
@@ -0,0 +1,72 @@
+DisplayPropDialog
+GetFileNameIcon
+GetSpecialFolderLocation
+SHCopy
+ShellExecEx
+ShellLinkIcon
+ShellLinkIcon
+ShellLinkResolve
+SHEnumSpecialFolderFirst
+SHMove
+TSHCopyOption
+TSHMoveOption
+INSTALLSTATE
+TAnsiPath
+TSHCopyOptions
+TSHMoveOptions
+TUnicodePath
+RtdlMsiGetComponentPath
+RtdlMsiGetShortcutTarget
+RtdlMsiLibHandle
+MSILIB
+DisplayPropDialog
+OpenFolder
+OpenSpecialFolder
+SHDeleteFolder
+SHDeleteFiles
+SHRenameFile
+TSHRenameOption
+TSHDeleteOption
+TEnumFolderRec
+TEnumFolderFlag
+SHEnumFolderFirst
+SHEnumFolderClose
+SHEnumFolderNext
+DisplayContextMenuPidl
+DisplayContextMenu
+SHReallocMem
+SHGetMem
+SHAllocMem
+SHFreeMem
+OverlayIcon
+OverlayIconShortCut
+OverlayIconShared
+GetSystemIcon
+SHDllGetVersion
+ShellExec
+ShellExecAndWait
+ShellOpenAs
+ShellRasDial
+ShellRunControlPanel
+TJclFileExeType
+GetFileExeType
+ShellFindExecutable
+SHGetItemInfoTip
+StrRetFreeMem
+StrRetToString
+PidlToPath
+PathToPidl
+PathToPidlBind
+DriveToPidlBind
+PidlBindToParent
+PidlCompare
+PidlCopy
+PidlFree
+PidlGetDepth
+PidlGetLength
+PidlGetNext
+ShellLinkResolve
+TShellLink
+ShellLinkFree
+ShellLinkCreate
+ShellLinkCreateSystem
diff --git a/official/1.104/experts/useswizard/JclStacks.txt b/official/1.104/experts/useswizard/JclStacks.txt
new file mode 100644
index 0000000..f0d1522
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclStacks.txt
@@ -0,0 +1,3 @@
+TJclStack
+TJclIntfStack
+TJclStrStack
diff --git a/official/1.104/experts/useswizard/JclStatistics.txt b/official/1.104/experts/useswizard/JclStatistics.txt
new file mode 100644
index 0000000..804be11
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclStatistics.txt
@@ -0,0 +1,26 @@
+EJclStatisticsError
+Combinations
+HeronianMean
+StdError
+StdError
+SumOfSquares
+ArithmeticMean
+BinomialCoeff
+GeometricMean
+HarmonicMean
+IsPositiveFloatArray
+MaxFloatArray
+MaxFloatArrayIndex
+Median
+MedianUnsorted
+MinFloatArray
+MinFloatArrayIndex
+Permutation
+PopulationVariance
+PopulationVarianceAndMean
+SampleVariance
+SampleVarianceAndMean
+SumFloatArray
+SumSquareDiffFloatArray
+SumSquareFloatArray
+SumPairProductFloatArray
diff --git a/official/1.104/experts/useswizard/JclStrHashMap.txt b/official/1.104/experts/useswizard/JclStrHashMap.txt
new file mode 100644
index 0000000..9591c10
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclStrHashMap.txt
@@ -0,0 +1,21 @@
+PData
+PUserData
+TNodeIterateFunc
+EJclStringHashMapError
+THashValue
+TStringHashMapTraits
+CaseSensitiveTraits
+CaseInsensitiveTraits
+TIterateFunc
+TIterateMethod
+THashNode
+THashArray
+TStringHashMap
+StrHash
+TextHash
+DataHash
+Iterate_FreeObjects
+Iterate_Dispose
+Iterate_FreeMem
+TCaseSensitiveTraits
+TCaseInsensitiveTraits
diff --git a/official/1.104/experts/useswizard/JclStreams.txt b/official/1.104/experts/useswizard/JclStreams.txt
new file mode 100644
index 0000000..55d459a
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclStreams.txt
@@ -0,0 +1,14 @@
+EJclStreamError
+TJclBufferedStream
+TJclEasyStream
+TJclEmptyStream
+TJclEventStream
+TJclFileStream
+TJclHandleStream
+TJclMultiplexStream
+TJclNullStream
+TJclRandomStream
+TJclStream
+TJclStreamDecorator
+TSeekOrigin
+TStreamNotifyEvent
diff --git a/official/1.104/experts/useswizard/JclStrings.txt b/official/1.104/experts/useswizard/JclStrings.txt
new file mode 100644
index 0000000..7f9e6c9
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclStrings.txt
@@ -0,0 +1,138 @@
+ArgumentException
+ArgumentNullException
+ArgumentOutOfRangeException
+FormatException
+TStringBuilder
+IToString
+CharEqualNoCase
+CharHex
+CharIPos
+CharIsAlpha
+CharIsAlphaNum
+CharIsBlank
+CharIsControl
+CharIsDelete
+CharIsDigit
+CharIsLower
+CharIsNumberChar
+CharIsPrintable
+CharIsPunctuation
+CharIsReturn
+CharIsSpace
+CharIsUpper
+CharIsWhiteSpace
+CharLastPos
+CharLower
+CharPos
+CharReplace
+CharToggleCase
+CharType
+CharUpper
+DotNetFormat
+DotNetFormat
+DotNetFormat
+DotNetFormat
+FileToString
+StrAddRef
+StrAfter
+StrAllocSize
+StrAnsiToOem
+StrBefore
+StrBetween
+StrCenter
+StrCharCount
+StrCharPosLower
+StrCharPosUpper
+StrCharsCount
+StrChopRight
+StrCompare
+StrCompareRange
+StrConsistsOfNumberChars
+StrContainsChars
+StrDecRef
+StrDoubleQuote
+StrEnsureNoPrefix
+StrEnsureNoSuffix
+StrEnsurePrefix
+StrEnsureSuffix
+StrEscapedToString
+StrFind
+StrHasPrefix
+StrILastPos
+StrIndex
+StringsToStr
+StringToFile
+StrIPos
+StrIsAlpha
+StrIsAlphaNum
+StrIsAlphaNumUnderscore
+StrIsDigit
+StrIsOneOf
+StrIsSubset
+StrIToStrings
+StrKeepChars
+StrLastPos
+StrLeft
+StrLen
+StrLength
+StrLower
+StrLowerBuff
+StrLowerInPlace
+StrMatch
+StrMatches
+StrMid
+StrMove
+StrNIPos
+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
+TryStrToCurr
+TryStrToFloat
+TryStrToFloat
+TryStrToFloat
+TryStrToInt
+TryStrToInt64
+TCharDynArray
+StrWord
+StrResetLength
diff --git a/official/1.104/experts/useswizard/JclStructStorage.txt b/official/1.104/experts/useswizard/JclStructStorage.txt
new file mode 100644
index 0000000..5aed610
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclStructStorage.txt
@@ -0,0 +1,6 @@
+EJclStructStorageError
+TJclStructStorageFolder
+TJclStructStorageStream
+CoMallocFree
+TJclStructStorageAccessMode
+TJclStructStorageAccessModes
diff --git a/official/1.104/experts/useswizard/JclSvcCtrl.txt b/official/1.104/experts/useswizard/JclSvcCtrl.txt
new file mode 100644
index 0000000..9f63456
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclSvcCtrl.txt
@@ -0,0 +1,33 @@
+GetServiceStatusByName
+StartServiceByName
+StopServiceByName
+SERVICE_DESCRIPTIONA
+LPSERVICE_DESCRIPTIONA
+PServiceDescriptionA
+TJclServiceStates
+TJclServiceTypes
+TQueryServiceConfig2A
+TServiceDescriptionA
+AdministratorsSCMDesiredAccess
+DefaultSCMDesiredAccess
+DefaultSvcDesiredAccess
+EveryoneSCMDesiredAccess
+LocalSystemSCMDesiredAccess
+SERVICE_CONFIG_DESCRIPTION
+SERVICE_CONFIG_FAILURE_ACTIONS
+ssPendingStates
+stAllTypeService
+stDriverService
+stWin32Service
+TJclServiceType
+TJclServiceState
+TJclServiceStartType
+TJclNtService
+TJclServiceGroup
+TJclSCManager
+GetServiceStatus
+GetServiceStatusWaitingIfPending
+TJclServiceSortOrderType
+TJclServiceErrorControlType
+TJclServiceControlAccepted
+TJclServiceControlAccepteds
diff --git a/official/1.104/experts/useswizard/JclSynch.txt b/official/1.104/experts/useswizard/JclSynch.txt
new file mode 100644
index 0000000..2d14746
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclSynch.txt
@@ -0,0 +1,50 @@
+EJclCriticalSectionError
+EJclDispatcherObjectError
+EJclEventError
+EJclMeteredSectionError
+EJclMutexError
+EJclSemaphoreError
+EJclWaitableTimerError
+EJclWin32HandleObjectError
+LockedCompareExchange
+WaitAlertableForMultipleObjects
+WaitForMultipleObjects
+TEventInfo
+TMeteredSection
+TMetSectSharedInfo
+TMrewPreferred
+TMrewThreadInfo
+TMutexInfo
+TOptexSharedInfo
+TSemaphoreCounts
+TTimerInfo
+PMeteredSection
+PMetSectSharedInfo
+POptexSharedInfo
+TMrewThreadInfoArray
+QueryCriticalSection
+QueryEvent
+QueryTimer
+QuerySemaphore
+QueryMutex
+LockedCompareExchange
+LockedExchangeAdd
+LockedAdd
+LockedExchangeSub
+LockedSub
+LockedExchange
+LockedExchangeInc
+LockedInc
+LockedExchangeDec
+LockedDec
+TJclCriticalSection
+TJclCriticalSectionEx
+TJclDispatcherObject
+TJclWaitResult
+TJclEvent
+TJclMeteredSection
+TJclMultiReadExclusiveWrite
+TJclMutex
+TJclOptex
+TJclSemaphore
+TJclWaitableTimer
diff --git a/official/1.104/experts/useswizard/JclSysInfo.txt b/official/1.104/experts/useswizard/JclSysInfo.txt
new file mode 100644
index 0000000..c75ef2f
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclSysInfo.txt
@@ -0,0 +1,647 @@
+DestroyEnvironmentBlock
+GetAPMBatteryFlags
+GetBPP
+GetCPUSpeed
+GetEnvironmentVar
+GetEnvironmentVars
+GetFreeSystemResources
+GetFreeSystemResources
+GetIpAddresses
+GetMainAppWndFromPid
+GetNativeSystemInfo
+GetProcessorArchitecture
+GetProfileFolder
+GetVolumeFileSystemFlags
+GetWindowCaption
+GetWindowsServicePackVersionString
+IsAccessInstalled
+IsExcelInstalled
+IsFrontPageInstalled
+IsInternetExplorerInstalled
+IsMainAppWindow
+IsMSProjectInstalled
+IsOpenOfficeInstalled
+IsOutlookInstalled
+IsPowerPointInstalled
+IsSystemResourcesMeterPresent
+IsWindows64
+IsWordInstalled
+ProgIDExists
+RoundToAllocGranularity64
+SetGlobalEnvironmentVariable
+TCacheFamily
+TCacheInformation
+TFileSystemFlag
+TFreeSysResKind
+TFreeSystemResources
+TJclTerminateAppResult
+TNtProductType
+TProcessorArchitecture
+TTLBInformation
+TTransmetaSpecific
+TVIASpecific
+DWORD
+TAPMBatteryFlags
+TFileSystemFlags
+IsWin2003R2
+IsWinLonghorn
+IsWinVista
+IsWinXP64
+ACPI_FLAG
+AMD_APIC
+AMD_ASSOC_DIRECT
+AMD_ASSOC_FULLY
+AMD_ASSOC_RESERVED
+AMD_CLFLSH
+AMD_CMOV
+AMD_CX8
+AMD_DE
+AMD_FPU
+AMD_FX
+AMD_L2_ASSOC_16WAY
+AMD_L2_ASSOC_2WAY
+AMD_L2_ASSOC_4WAY
+AMD_L2_ASSOC_8WAY
+AMD_L2_ASSOC_DIRECT
+AMD_L2_ASSOC_DISABLED
+AMD_L2_ASSOC_FULLY
+AMD_MCA
+AMD_MCE
+AMD_MMX
+AMD_MSR
+AMD_MTRR
+AMD_PAE
+AMD_PAT
+AMD_PGE
+AMD_PSE
+AMD_PSE2
+AMD_SEP_BIT
+AMD_SSE
+AMD_SSE2
+AMD_TSC
+AMD_VME
+APIC_FLAG
+BIT_0
+BIT_1
+BIT_10_FLAG
+BIT_11
+BIT_12
+BIT_13
+BIT_14
+BIT_15
+BIT_16
+BIT_17
+BIT_2
+BIT_20_FLAG
+BIT_23
+BIT_24
+BIT_3
+BIT_30_FLAG
+BIT_4
+BIT_5
+BIT_6
+BIT_7
+BIT_8
+BIT_9
+CLFLSH_FLAG
+CMOV_FLAG
+CPU_TYPE_AMD
+CPU_TYPE_CYRIX
+CPU_TYPE_INTEL
+CPU_TYPE_TRANSMETA
+CPU_TYPE_VIA
+CX8_FLAG
+CYRIX_APIC
+CYRIX_BIT_10
+CYRIX_BIT_11
+CYRIX_BIT_16
+CYRIX_BIT_17
+CYRIX_BIT_18
+CYRIX_BIT_19
+CYRIX_BIT_20
+CYRIX_BIT_21
+CYRIX_BIT_22
+CYRIX_BIT_24
+CYRIX_BIT_25
+CYRIX_BIT_26
+CYRIX_BIT_27
+CYRIX_BIT_28
+CYRIX_BIT_29
+CYRIX_BIT_30
+CYRIX_BIT_31
+CYRIX_CMOV
+CYRIX_CX8
+CYRIX_DE
+CYRIX_FPU
+CYRIX_MCA
+CYRIX_MCE
+CYRIX_MMX
+CYRIX_MSR
+CYRIX_MTRR
+CYRIX_PAE
+CYRIX_PGE
+CYRIX_PSE
+CYRIX_TSC
+CYRIX_VME
+DE_FLAG
+DS_FLAG
+EAMD_3DNOW
+EAMD_APIC
+EAMD_BIT_10
+EAMD_BIT_18
+EAMD_BIT_19
+EAMD_BIT_21
+EAMD_BIT_26
+EAMD_BIT_27
+EAMD_BIT_28
+EAMD_CMOV
+EAMD_CX8
+EAMD_DE
+EAMD_EX3DNOW
+EAMD_EXMMX
+EAMD_FFX
+EAMD_FPU
+EAMD_FX
+EAMD_LONG
+EAMD_MCA
+EAMD_MCE
+EAMD_MMX
+EAMD_MSR
+EAMD_MTRR
+EAMD_NEPP
+EAMD_PAE
+EAMD_PAT
+EAMD_PGE
+EAMD_PSE
+EAMD_PSE2
+EAMD_SEP
+EAMD_TSC
+EAMD_VME
+ECYRIX_APIC
+ECYRIX_BIT_11
+ECYRIX_BIT_17
+ECYRIX_BIT_18
+ECYRIX_BIT_19
+ECYRIX_BIT_20
+ECYRIX_BIT_21
+ECYRIX_BIT_22
+ECYRIX_BIT_25
+ECYRIX_BIT_26
+ECYRIX_BIT_27
+ECYRIX_BIT_28
+ECYRIX_BIT_29
+ECYRIX_BIT_30
+ECYRIX_BIT_31
+ECYRIX_CX8
+ECYRIX_DE
+ECYRIX_EMMX
+ECYRIX_FCMOV
+ECYRIX_FPU
+ECYRIX_ICMOV
+ECYRIX_MCA
+ECYRIX_MCE
+ECYRIX_MMX
+ECYRIX_MSR
+ECYRIX_MTRR
+ECYRIX_PAE
+ECYRIX_PGE
+ECYRIX_PSE
+ECYRIX_SEP
+ECYRIX_TSC
+ECYRIX_VME
+EINTEL_BIT_1
+EINTEL_BIT_11
+EINTEL_BIT_12
+EINTEL_BIT_13
+EINTEL_BIT_15
+EINTEL_BIT_16
+EINTEL_BIT_17
+EINTEL_BIT_18
+EINTEL_BIT_19
+EINTEL_BIT_2
+EINTEL_BIT_20
+EINTEL_BIT_21
+EINTEL_BIT_22
+EINTEL_BIT_23
+EINTEL_BIT_24
+EINTEL_BIT_25
+EINTEL_BIT_26
+EINTEL_BIT_27
+EINTEL_BIT_28
+EINTEL_BIT_29
+EINTEL_BIT_30
+EINTEL_BIT_31
+EINTEL_BIT_5
+EINTEL_BIT_6
+EINTEL_BIT_9
+EINTEL_CNXTID
+EINTEL_DSCPL
+EINTEL_EST
+EINTEL_MONITOR
+EINTEL_SSE3
+EINTEL_TM2
+EINTEL_XTPR
+EINTEL64_BIT_0
+EINTEL64_BIT_1
+EINTEL64_BIT_10
+EINTEL64_BIT_12
+EINTEL64_BIT_13
+EINTEL64_BIT_14
+EINTEL64_BIT_15
+EINTEL64_BIT_16
+EINTEL64_BIT_17
+EINTEL64_BIT_18
+EINTEL64_BIT_19
+EINTEL64_BIT_2
+EINTEL64_BIT_20
+EINTEL64_BIT_21
+EINTEL64_BIT_22
+EINTEL64_BIT_23
+EINTEL64_BIT_24
+EINTEL64_BIT_25
+EINTEL64_BIT_26
+EINTEL64_BIT_27
+EINTEL64_BIT_28
+EINTEL64_BIT_3
+EINTEL64_BIT_30
+EINTEL64_BIT_31
+EINTEL64_BIT_4
+EINTEL64_BIT_5
+EINTEL64_BIT_6
+EINTEL64_BIT_7
+EINTEL64_BIT_8
+EINTEL64_BIT_9
+EINTEL64_EM64T
+EINTEL64_SYS
+ETRANSMETA_BIT_10
+ETRANSMETA_BIT_11
+ETRANSMETA_BIT_12
+ETRANSMETA_BIT_13
+ETRANSMETA_BIT_14
+ETRANSMETA_BIT_17
+ETRANSMETA_BIT_18
+ETRANSMETA_BIT_19
+ETRANSMETA_BIT_20
+ETRANSMETA_BIT_21
+ETRANSMETA_BIT_22
+ETRANSMETA_BIT_24
+ETRANSMETA_BIT_25
+ETRANSMETA_BIT_26
+ETRANSMETA_BIT_27
+ETRANSMETA_BIT_28
+ETRANSMETA_BIT_29
+ETRANSMETA_BIT_30
+ETRANSMETA_BIT_31
+ETRANSMETA_BIT_6
+ETRANSMETA_BIT_7
+ETRANSMETA_BIT_9
+ETRANSMETA_CMOV
+ETRANSMETA_CX8
+ETRANSMETA_DE
+ETRANSMETA_FCMOV
+ETRANSMETA_FPU
+ETRANSMETA_MMX
+ETRANSMETA_MSR
+ETRANSMETA_PSE
+ETRANSMETA_TSC
+ETRANSMETA_VME
+EVIA_ACEE
+EVIA_AIS
+EVIA_AISE
+EVIA_BIT_10
+EVIA_BIT_11
+EVIA_BIT_12
+EVIA_BIT_13
+EVIA_BIT_14
+EVIA_BIT_15
+EVIA_BIT_16
+EVIA_BIT_17
+EVIA_BIT_18
+EVIA_BIT_19
+EVIA_BIT_20
+EVIA_BIT_21
+EVIA_BIT_22
+EVIA_BIT_23
+EVIA_BIT_24
+EVIA_BIT_25
+EVIA_BIT_26
+EVIA_BIT_27
+EVIA_BIT_28
+EVIA_BIT_29
+EVIA_BIT_30
+EVIA_BIT_31
+EVIA_BIT_8
+EVIA_BIT_9
+EVIA_FEMMS
+EVIA_MSR
+EVIA_NO_ACE
+EVIA_NO_RNG
+EVIA_RNGE
+FPU_FLAG
+FXSR_FLAG
+HTT_FLAG
+INTEL_ACPI
+INTEL_APIC
+INTEL_BIT_10
+INTEL_BIT_20
+INTEL_BIT_30
+INTEL_CLFLSH
+INTEL_CMOV
+INTEL_CX8
+INTEL_DE
+INTEL_DS
+INTEL_FPU
+INTEL_FXSR
+INTEL_HTT
+INTEL_MCA
+INTEL_MCE
+INTEL_MMX
+INTEL_MSR
+INTEL_MTRR
+INTEL_PAE
+INTEL_PAT
+INTEL_PBE
+INTEL_PGE
+INTEL_PSE
+INTEL_PSE36
+INTEL_PSN
+INTEL_SEP
+INTEL_SS
+INTEL_SSE
+INTEL_SSE2
+INTEL_TM
+INTEL_TSC
+INTEL_VME
+IntelCacheDescription
+MCA_FLAG
+MCE_FLAG
+MMX_FLAG
+MSR_FLAG
+MTRR_FLAG
+MXCSR_DAZ
+MXCSR_DE
+MXCSR_DM
+MXCSR_FZ
+MXCSR_IE
+MXCSR_IM
+MXCSR_OE
+MXCSR_OM
+MXCSR_PE
+MXCSR_PM
+MXCSR_RC
+MXCSR_RC1
+MXCSR_RC2
+MXCSR_UE
+MXCSR_UM
+MXCSR_ZE
+MXCSR_ZM
+PAE_FLAG
+PAMD_FREQUENCYID
+PAMD_SOFTTHERMCONTROL
+PAMD_TEMPSENSOR
+PAMD_THERMALMONITOR
+PAMD_THERMALTRIP
+PAMD_VOLTAGEID
+PAT_FLAG
+PBE_FLAG
+PGE_FLAG
+PROCESSOR_ARCHITECTURE_AMD64
+PROCESSOR_ARCHITECTURE_IA32_ON_WIN64
+PROCESSOR_ARCHITECTURE_IA64
+PROCESSOR_ARCHITECTURE_INTEL
+PSE_FLAG
+PSE36_FLAG
+PSN_FLAG
+SEP_FLAG
+SS_FLAG
+SSE_FLAG
+SSE2_FLAG
+STRANSMETA_BIT_10
+STRANSMETA_BIT_11
+STRANSMETA_BIT_12
+STRANSMETA_BIT_13
+STRANSMETA_BIT_14
+STRANSMETA_BIT_15
+STRANSMETA_BIT_16
+STRANSMETA_BIT_17
+STRANSMETA_BIT_18
+STRANSMETA_BIT_19
+STRANSMETA_BIT_2
+STRANSMETA_BIT_20
+STRANSMETA_BIT_21
+STRANSMETA_BIT_22
+STRANSMETA_BIT_23
+STRANSMETA_BIT_24
+STRANSMETA_BIT_25
+STRANSMETA_BIT_26
+STRANSMETA_BIT_27
+STRANSMETA_BIT_28
+STRANSMETA_BIT_29
+STRANSMETA_BIT_30
+STRANSMETA_BIT_31
+STRANSMETA_BIT_4
+STRANSMETA_BIT_5
+STRANSMETA_BIT_6
+STRANSMETA_BIT_9
+STRANSMETA_LONGRUN
+STRANSMETA_LRTI
+STRANSMETA_PTTI1
+STRANSMETA_PTTI2
+STRANSMETA_RECOVERY
+TM_FLAG
+TRANSMETA_BIT_10
+TRANSMETA_BIT_12
+TRANSMETA_BIT_13
+TRANSMETA_BIT_14
+TRANSMETA_BIT_16
+TRANSMETA_BIT_17
+TRANSMETA_BIT_19
+TRANSMETA_BIT_20
+TRANSMETA_BIT_21
+TRANSMETA_BIT_22
+TRANSMETA_BIT_24
+TRANSMETA_BIT_25
+TRANSMETA_BIT_26
+TRANSMETA_BIT_27
+TRANSMETA_BIT_28
+TRANSMETA_BIT_29
+TRANSMETA_BIT_30
+TRANSMETA_BIT_31
+TRANSMETA_BIT_6
+TRANSMETA_BIT_7
+TRANSMETA_BIT_9
+TRANSMETA_CMOV
+TRANSMETA_CX8
+TRANSMETA_DE
+TRANSMETA_FPU
+TRANSMETA_MMX
+TRANSMETA_MSR
+TRANSMETA_PSE
+TRANSMETA_PSN
+TRANSMETA_SEP
+TRANSMETA_TSC
+TRANSMETA_VME
+TSC_FLAG
+VendorIDAMD
+VendorIDCyrix
+VendorIDIntel
+VendorIDTransmeta
+VendorIDVIA
+VIA_3DNOW
+VIA_APIC
+VIA_BIT_10
+VIA_BIT_19
+VIA_BIT_20
+VIA_BIT_21
+VIA_BIT_22
+VIA_BIT_26
+VIA_BIT_27
+VIA_BIT_28
+VIA_BIT_29
+VIA_BIT_30
+VIA_CMOVE
+VIA_CX8
+VIA_DE
+VIA_FPU
+VIA_FX
+VIA_MCA
+VIA_MCE
+VIA_MMX
+VIA_MSR
+VIA_MTRR
+VIA_PAE
+VIA_PAT
+VIA_PSE
+VIA_PSE2
+VIA_PTE
+VIA_SEP
+VIA_SNUM
+VIA_SSE
+VIA_TSC
+VIA_VME
+VME_FLAG
+ModuleFromAddr
+IsSystemModule
+RoundToAllocGranularityPtr
+GetCommonAppdataFolder
+GetCurrentFolder
+GetCommonFilesFolder
+GetProgramFilesFolder
+GetWindowsFolder
+GetWindowsSystemFolder
+GetWindowsTempFolder
+GetDesktopFolder
+GetProgramsFolder
+GetPersonalFolder
+GetFavoritesFolder
+GetStartupFolder
+GetRecentFolder
+GetSendToFolder
+GetStartmenuFolder
+GetDesktopDirectoryFolder
+GetNethoodFolder
+GetFontsFolder
+GetCommonStartmenuFolder
+GetCommonProgramsFolder
+GetCommonStartupFolder
+GetCommonDesktopdirectoryFolder
+GetAppdataFolder
+GetPrinthoodFolder
+GetCommonFavoritesFolder
+GetTemplatesFolder
+GetInternetCacheFolder
+GetCookiesFolder
+GetHistoryFolder
+GetEnvironmentVar
+GetEnvironmentVars
+DelEnvironmentVar
+ExpandEnvironmentVar
+SetEnvironmentVar
+CreateEnvironmentBlock
+TEnvironmentOption
+ProcessorCount
+TestFDIVInstruction
+CPUID
+RoundFrequency
+GetMacAddresses
+ReadTimeStampCounter
+TIntelSpecific
+TCyrixSpecific
+TAMDSpecific
+TCacheInfo
+TFreqInfo
+TCpuInfo
+GetCpuInfo
+GetIntelCacheDescription
+GetVolumeSerialNumber
+GetVolumeFileSystem
+GetVolumeName
+GetIPAddress
+GetLocalComputerName
+GetLocalUserName
+GetRegisteredCompany
+GetRegisteredOwner
+GetBIOSDate
+GetBIOSName
+GetBIOSCopyright
+GetBIOSExtendedInfo
+GetUserDomainName
+GetDomainName
+GetKeyState
+GetNumLockKeyState
+GetScrollLockKeyState
+GetCapsLockKeyState
+AllocGranularity
+PageSize
+GetMaxAppAddress
+GetMinAppAddress
+GetMemoryLoad
+GetSwapFileSize
+GetSwapFileUsage
+GetTotalPhysicalMemory
+GetFreePhysicalMemory
+GetTotalPageFileMemory
+GetFreePageFileMemory
+GetTotalVirtualMemory
+GetFreeVirtualMemory
+GetAPMLineStatus
+TAPMLineStatus
+TAPMBatteryFlag
+GetAPMBatteryFlag
+GetAPMBatteryLifePercent
+GetAPMBatteryLifeTime
+GetAPMBatteryFullLifeTime
+RunningProcessesList
+LoadedModulesList
+GetTasksList
+IsWindowResponding
+GetWindowIcon
+TerminateTask
+TerminateApp
+GetProcessNameFromWnd
+GetProcessNameFromPid
+GetShellProcessName
+GetShellProcessHandle
+GetPidFromProcessName
+TWindowsVersion
+GetWindowsVersion
+GetOSVersionString
+GetWindowsVersionString
+GetWindowsServicePackVersion
+IsWinXP
+IsWin95
+IsWin95OSR2
+IsWin98
+IsWin98SE
+IsWinME
+IsWinNT
+IsWinNT3
+IsWinNT31
+IsWinNT35
+IsWinNT351
+IsWinNT4
+IsWin2K
+IsWin2003
+NtProductType
+NtProductTypeString
+GetOpenGLVersion
diff --git a/official/1.104/experts/useswizard/JclSysUtils.txt b/official/1.104/experts/useswizard/JclSysUtils.txt
new file mode 100644
index 0000000..0981dfd
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclSysUtils.txt
@@ -0,0 +1,122 @@
+EJclConversionError
+EJclVMTError
+ESharedMemError
+TJclIntfCriticalSection
+TJclReferenceMemoryStream
+TJclSimpleLog
+IAutoPtr
+BoolToInt
+CreateAutoPtr
+DynArrayCompareAnsiString
+DynArrayCompareAnsiText
+DynArrayCompareByte
+DynArrayCompareCardinal
+DynArrayCompareDouble
+DynArrayCompareExtended
+DynArrayCompareFloat
+DynArrayCompareInt64
+DynArrayCompareInteger
+DynArrayCompareShortInt
+DynArrayCompareSingle
+DynArrayCompareSmallInt
+DynArrayCompareString
+DynArrayCompareText
+DynArrayCompareWord
+Execute
+Execute
+GetImplementorOfInterface
+Guard
+Guard
+Guard
+Iff
+Iff
+Iff
+Iff
+Iff
+Iff
+Iff
+Iff
+Iff
+IntToBool
+IsCompiledWithPackages
+ListAddItems
+ListDelItem
+ListGetItem
+ListIncludeItems
+ListItemCount
+ListItemIndex
+ListRemoveItems
+ListSetItem
+PAnsiCharOrNil
+ReadKey
+SearchDynArray
+SearchSortedList
+SearchSortedUntyped
+SharedAllocMem
+SharedCloseMem
+SharedFreeMem
+SharedGetMem
+SharedOpenMem
+SharedOpenMem
+SortDynArray
+StrToBoolean
+SystemTObjectInstance
+WriteProtectedMemory
+PBoolean
+TDigitCount
+TDigitValue
+TDynArraySortCompare
+TNumericSystemBase
+TTextHandler
+TUntypedSearchCompare
+ABORT_EXIT_CODE
+ListSeparator
+Iff
+TModuleHandle
+INVALID_MODULEHANDLE_VALUE
+LoadModule
+LoadModuleEx
+UnloadModule
+GetModuleSymbol
+GetModuleSymbolEx
+ReadModuleData
+WriteModuleData
+IntToStrZeroPad
+TJclNumericFormat
+PWideCharOrNil
+PCharOrNil
+GetDynamicMethodCount
+GetDynamicIndexList
+TDynamicIndexList
+GetDynamicAddressList
+TDynamicAddressList
+HasDynamicMethod
+GetDynamicMethod
+GetInitTable
+GetFieldTable
+TFieldTable
+TFieldClassTable
+TFieldEntry
+GetMethodTable
+TMethodTable
+GetMethodEntry
+TMethodEntry
+SetClassParent
+GetClassParent
+IsClass
+IsObject
+GetVirtualMethodCount
+GetVirtualMethod
+SetVirtualMethod
+Guard
+GuardGetMem
+GuardAllocMem
+IMultiSafeGuard
+ISafeGuard
+ClearObjectList
+FreeObjectList
+SizeOfMem
+FreeMemAndNil
+GetAndFillMem
+JclGUIDToString
+JclStringToGUID
diff --git a/official/1.104/experts/useswizard/JclTD32.txt b/official/1.104/experts/useswizard/JclTD32.txt
new file mode 100644
index 0000000..c66128c
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclTD32.txt
@@ -0,0 +1,96 @@
+TJclConstantSymbolInfo
+TJclDataSymbolInfo
+TJclGDataSymbolInfo
+TJclGlobalProcSymbolInfo
+TJclLabelSymbolInfo
+TJclLDataSymbolInfo
+TJclLineInfo
+TJclLocalProcSymbolInfo
+TJclModuleInfo
+TJclObjNameSymbolInfo
+TJclPeBorTD32Image
+TJclProcSymbolInfo
+TJclPublicSymbolInfo
+TJclSourceModuleInfo
+TJclSymbolInfo
+TJclTD32InfoParser
+TJclTD32InfoScanner
+TJclUdtSymbolInfo
+TJclVftPathSymbolInfo
+TJclWithSymbolInfo
+TDirectoryEntry
+TDirectoryHeader
+TGlobalTypeInfo
+TJclTD32FileSignature
+TLineMappingEntry
+TOffsetPair
+TSegmentInfo
+TSourceFileEntry
+TSourceModuleInfo
+TSymbolConstantInfo
+TSymbolDataInfo
+TSymbolInfo
+TSymbolInfos
+TSymbolLabelInfo
+TSymbolObjNameInfo
+TSymbolProcInfo
+TSymbolUdtInfo
+TSymbolVftPathInfo
+TSymbolWithInfo
+PDirectoryEntry
+PDirectoryHeader
+PGlobalTypeInfo
+PJclTD32FileSignature
+PLineMappingEntry
+POffsetPairArray
+PSegmentInfo
+PSegmentInfoArray
+PSourceFileEntry
+PSourceModuleInfo
+PSymbolInfo
+PSymbolInfos
+TOffsetPairArray
+TSegmentInfoArray
+Borland32BitSymbolFileSignatureForBCB
+Borland32BitSymbolFileSignatureForDelphi
+SUBSECTION_TYPE_ALIGN_SYMBOLS
+SUBSECTION_TYPE_GLOBAL_SYMBOLS
+SUBSECTION_TYPE_GLOBAL_TYPES
+SUBSECTION_TYPE_MODULE
+SUBSECTION_TYPE_NAMES
+SUBSECTION_TYPE_SOURCE_MODULE
+SUBSECTION_TYPE_SYMBOLS
+SUBSECTION_TYPE_TYPES
+SYMBOL_TYPE_BLOCK16
+SYMBOL_TYPE_BLOCK32
+SYMBOL_TYPE_BPREL16
+SYMBOL_TYPE_BPREL32
+SYMBOL_TYPE_CEXMODEL16
+SYMBOL_TYPE_CEXMODEL32
+SYMBOL_TYPE_COMPILE
+SYMBOL_TYPE_CONST
+SYMBOL_TYPE_CVRESERVE
+SYMBOL_TYPE_END
+SYMBOL_TYPE_GDATA16
+SYMBOL_TYPE_GDATA32
+SYMBOL_TYPE_GPROC16
+SYMBOL_TYPE_GPROC32
+SYMBOL_TYPE_LABEL16
+SYMBOL_TYPE_LABEL32
+SYMBOL_TYPE_LDATA16
+SYMBOL_TYPE_LDATA32
+SYMBOL_TYPE_LPROC16
+SYMBOL_TYPE_LPROC32
+SYMBOL_TYPE_OBJNAME
+SYMBOL_TYPE_PUB16
+SYMBOL_TYPE_PUB32
+SYMBOL_TYPE_REGISTER
+SYMBOL_TYPE_SKIP
+SYMBOL_TYPE_SSEARCH
+SYMBOL_TYPE_THUNK16
+SYMBOL_TYPE_THUNK32
+SYMBOL_TYPE_UDT
+SYMBOL_TYPE_VFTPATH16
+SYMBOL_TYPE_VFTPATH32
+SYMBOL_TYPE_WITH16
+SYMBOL_TYPE_WITH32
diff --git a/official/1.104/experts/useswizard/JclTask.txt b/official/1.104/experts/useswizard/JclTask.txt
new file mode 100644
index 0000000..a1b9862
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclTask.txt
@@ -0,0 +1,14 @@
+TJclScheduledTask
+TJclScheduledWorkItem
+TJclTaskSchedule
+TJclTaskTrigger
+TJclTaskTriggers
+TJclScheduledTaskFlag
+TJclScheduledTaskStatus
+TJclScheduleTaskPropertyPage
+TDateTimeArray
+TJclScheduledTaskFlags
+TJclScheduleTaskPropertyPages
+InfiniteTime
+JclScheduleTaskAllPages
+LocalSystemAccount
diff --git a/official/1.104/experts/useswizard/JclUnicode.txt b/official/1.104/experts/useswizard/JclUnicode.txt
new file mode 100644
index 0000000..0fffc60
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclUnicode.txt
@@ -0,0 +1,211 @@
+EJclUnicodeError
+CodeBlockName
+CodeBlockRange
+GetCharSetFromLocale
+StrDisposeAndNilW
+StrNewW
+StrPCopyWW
+StrPLCopyWW
+StrScanW
+UnicodeCaseFold
+WideCaseFolding
+WideCaseFolding
+WideLowerCase
+WideTitleCase
+WideTitleCase
+WideUpperCase
+TDFA
+TDFAState
+TDFAStates
+TSaveFormat
+TUcCClass
+TUcElement
+TUcEquivalent
+TUcEquivalentList
+TUcExpressionList
+TUcRange
+TUcState
+TUcStateList
+TUcStateTable
+TUcSymbol
+TUcSymbolTable
+TUcSymbolTableEntry
+TUcTransition
+TUcTransitions
+TUnicodeBlockRange
+TUREBuffer
+TUTBMChar
+TUTBMSkip
+TWideStringItem
+PDFAState
+PUcRange
+PUcState
+PUcStateList
+PUcSymbolTableEntry
+PUREBuffer
+PUTBMChar
+PUTBMSkip
+TCompareFunc
+TConfirmConversionEvent
+TDynWideCharArray
+TFontCharSet
+TUCS2Array
+TUCS4Array
+TWideStringItemList
+UCS2
+WideCompareText
+BOM_LSB_FIRST
+BOM_MSB_FIRST
+BOM_UTF16_LSB
+BOM_UTF16_MSB
+BOM_UTF32_LSB
+BOM_UTF32_MSB
+BOM_UTF8
+MaximumUCS2
+MaximumUCS4
+MaximumUTF16
+ReplacementCharacter
+sfUnicodeLSB
+sfUnicodeMSB
+SurrogateHighEnd
+SurrogateHighStart
+SurrogateLowEnd
+SurrogateLowStart
+WideCarriageReturn
+WideCR
+WideCRLF
+WideFormFeed
+WideLF
+WideLineFeed
+WideLineSeparator
+WideNull
+WideParagraphSeparator
+WideSpace
+WideTabulator
+WideVerticalTab
+TCharacterCategory
+UTF7
+UTF8
+UTF16
+UTF32
+UCS4
+PUCS2
+TUcNumber
+TNormalizationForm
+TUnicodeBlock
+UnicodeIsAlpha
+UnicodeIsDigit
+UnicodeIsAlphaNum
+UnicodeIsControl
+UnicodeIsSpace
+UnicodeIsWhiteSpace
+UnicodeIsBlank
+UnicodeIsPunctuation
+UnicodeIsGraph
+UnicodeIsPrintable
+UnicodeIsUpper
+UnicodeIsLower
+UnicodeIsTitle
+UnicodeIsHexDigit
+UnicodeIsIsoControl
+UnicodeIsFormatControl
+UnicodeIsSymbol
+UnicodeIsNumber
+UnicodeIsNonSpacing
+UnicodeIsOpenPunctuation
+UnicodeIsClosePunctuation
+UnicodeIsInitialPunctuation
+UnicodeIsFinalPunctuation
+UnicodeIsCased
+UnicodeIsComposed
+UnicodeIsQuotationMark
+UnicodeIsSymmetric
+UnicodeIsMirroring
+UnicodeIsNonBreaking
+UnicodeIsMark
+UnicodeIsModifier
+UnicodeIsLetterNumber
+UnicodeIsConnectionPunctuation
+UnicodeIsMath
+UnicodeIsDash
+UnicodeIsCurrency
+UnicodeIsModifierSymbol
+UnicodeIsNonSpacingMark
+UnicodeIsSpacingMark
+UnicodeIsEnclosing
+UnicodeIsPrivate
+UnicodeIsSurrogate
+UnicodeIsLineSeparator
+UnicodeIsParagraphSeparator
+UnicodeIsIdentifierStart
+UnicodeIsIdentifierPart
+UnicodeIsDefined
+UnicodeIsUndefined
+UnicodeIsHan
+UnicodeIsHangul
+UnicodeIsRightToLeft
+UnicodeIsLeftToRight
+UnicodeIsStrong
+UnicodeIsWeak
+UnicodeIsNeutral
+UnicodeIsSeparator
+UnicodeNumberLookup
+UnicodeToUpper
+UnicodeToLower
+UnicodeToTitle
+UnicodeComposePair
+StrICompW
+StrNewW
+StrScanW
+StrRNScanW
+StrNScanW
+StrSwapByteOrder
+StrDisposeW
+StrAllocW
+StrBufSizeW
+StrPosW
+StrRScanW
+StrLICompW
+StrLCompW
+StrCompW
+StrLCatW
+StrCatW
+StrPLCopyW
+StrPCopyW
+StrLCopyW
+StrECopyW
+StrCopyW
+StrMoveW
+StrEndW
+StrLenW
+TSearchFlag
+TSearchEngine
+TURESearch
+TUTBMSearch
+TWideStringList
+TWideStrings
+CharSetFromLocale
+CodePageFromLocale
+CodeBlockFromChar
+KeyboardCodePage
+KeyUnicode
+StringToWideStringEx
+TranslateString
+WideStringToStringEx
+WideStringToUTF8
+UTF8ToWideString
+WideLowerCase
+WideSameText
+WideUpperCase
+WideStringOfChar
+WideQuotedStr
+WideExtractQuotedStr
+WideTrim
+WideTrimRight
+WideTrimLeft
+WideDecompose
+WideCompose
+WideCharPos
+WideAdjustLineBreaks
+WideNormalize
+ExpandANSIString
diff --git a/official/1.104/experts/useswizard/JclUnitConv.txt b/official/1.104/experts/useswizard/JclUnitConv.txt
new file mode 100644
index 0000000..12a1e64
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclUnitConv.txt
@@ -0,0 +1,135 @@
+ETemperatureConversionError
+EUnitConversionError
+CelsiusTo
+CelsiusToRankine
+CelsiusToReaumur
+ConvertTemperature
+DegToGrad
+DegToRad
+FahrenheitTo
+FahrenheitToRankine
+FahrenheitToReaumur
+GradToDeg
+GradToRad
+KelvinTo
+KelvinToRankine
+KelvinToReaumur
+RadToDeg
+RadToGrad
+RankineTo
+RankineToCelsius
+RankineToFahrenheit
+RankineToKelvin
+RankineToReaumur
+ReaumurTo
+ReaumurToCelsius
+ReaumurToFahrenheit
+ReaumurToKelvin
+ReaumurToRankine
+TTemperatureType
+ArcMinutesPerDeg
+ArcSecondsPerArcMinute
+ArcSecondsPerDeg
+CelsiusAbsoluteZero
+CelsiusBoilingPoint
+CelsiusFreezingPoint
+CyclePerDeg
+CyclePerGrad
+CyclePerRad
+DegPerArcMinute
+DegPerArcSecond
+DegPerCycle
+DegPerGrad
+DegPerRad
+FahrenheitAbsoluteZero
+FahrenheitBoilingPoint
+FahrenheitFreezingPoint
+GradPerCycle
+GradPerDeg
+GradPerRad
+KelvinAbsoluteZero
+KelvinBoilingPoint
+KelvinFreezingPoint
+RadPerCycle
+RadPerDeg
+RadPerGrad
+RankineAbsoluteZero
+RankineAtFahrenheitZero
+RankineBoilingPoint
+RankineFreezingPoint
+ReaumurAbsoluteZero
+ReaumurBoilingPoint
+ReaumurFreezingPoint
+CycleToDeg
+CycleToGrad
+CycleToRad
+DegToCycle
+GradToCycle
+RadToCycle
+DmsToDeg
+DmsToRad
+DegToDms
+DegToDmsStr
+CartesianToPolar
+PolarToCartesian
+CartesianToCylinder
+CartesianToSpheric
+CylinderToCartesian
+SphericToCartesian
+CmToInch
+InchToCm
+FeetToMetre
+MetreToFeet
+YardToMetre
+MetreToYard
+NmToKm
+KmToNm
+KmToSm
+SmToKm
+KgToLb
+KgToKarat
+LbToKg
+KgToOz
+OzToKg
+QrUsToKg
+QrUkToKg
+KaratToKg
+CwtUsToKg
+CwtUkToKg
+StonToKg
+LtonToKg
+KgToCwtUs
+KgToCwtUk
+KgToQrUs
+KgToQrUk
+KgToSton
+KgToLton
+HpElectricToWatt
+HpMetricToWatt
+WattToHpElectric
+WattToHpMetric
+PascalToBar
+PascalToAt
+PascalToTorr
+BarToPascal
+AtToPascal
+TorrToPascal
+CelsiusToKelvin
+CelsiusToFahrenheit
+KelvinToCelsius
+KelvinToFahrenheit
+FahrenheitToCelsius
+FahrenheitToKelvin
+KnotToMs
+MsToKnot
+LitreToGalUs
+GalUsToLitre
+GalUsToGalCan
+GalCanToGalUs
+GalUsToGalUk
+GalUkToGalUs
+LitreToGalCan
+GalCanToLitre
+LitreToGalUk
+GalUkToLitre
+MakePercentage
diff --git a/official/1.104/experts/useswizard/JclUnitVersioning.txt b/official/1.104/experts/useswizard/JclUnitVersioning.txt
new file mode 100644
index 0000000..3d2fa2b
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclUnitVersioning.txt
@@ -0,0 +1,10 @@
+TCustomUnitVersioningProvider
+TUnitVersion
+TUnitVersioning
+TUnitVersioningModule
+GetUnitVersioning
+RegisterUnitVersion
+UnregisterUnitVersion
+TUnitVersionInfo
+PUnitVersionInfo
+TUnitVersioningProviderClass
diff --git a/official/1.104/experts/useswizard/JclUnitVersioningProviders.txt b/official/1.104/experts/useswizard/JclUnitVersioningProviders.txt
new file mode 100644
index 0000000..f3acebb
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclUnitVersioningProviders.txt
@@ -0,0 +1,4 @@
+TJclDefaultUnitVersioningProvider
+TJclUnitVersioningList
+TJclUnitVersioningProviderModule
+InsertUnitVersioningSection
diff --git a/official/1.104/experts/useswizard/JclUsesDialog.dfm b/official/1.104/experts/useswizard/JclUsesDialog.dfm
new file mode 100644
index 0000000..fcc2bab
--- /dev/null
+++ b/official/1.104/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.104/experts/useswizard/JclUsesDialog.pas b/official/1.104/experts/useswizard/JclUsesDialog.pas
new file mode 100644
index 0000000..fc6a50b
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclUsesDialog.pas
@@ -0,0 +1,217 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $ }
+{ Revision: $Rev:: 2490 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclUsesDialog;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ 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;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/useswizard/JclUsesDialog.pas $';
+ Revision: '$Revision: 2490 $';
+ Date: '$Date: 2008-09-23 01:01:34 +0200 (mar., 23 sept. 2008) $';
+ LogPath: 'JCL\experts\useswizard'
+ );
+{$ENDIF UNITVERSIONING}
+
+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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/useswizard/JclValidation.txt b/official/1.104/experts/useswizard/JclValidation.txt
new file mode 100644
index 0000000..257531d
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclValidation.txt
@@ -0,0 +1 @@
+IsValidISBN
diff --git a/official/1.104/experts/useswizard/JclVectors.txt b/official/1.104/experts/useswizard/JclVectors.txt
new file mode 100644
index 0000000..8e3a4da
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclVectors.txt
@@ -0,0 +1,3 @@
+TJclVector
+TJclStrVector
+TJclIntfVector
diff --git a/official/1.104/experts/useswizard/JclWideFormat.txt b/official/1.104/experts/useswizard/JclWideFormat.txt
new file mode 100644
index 0000000..382a661
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclWideFormat.txt
@@ -0,0 +1 @@
+WideFormat
diff --git a/official/1.104/experts/useswizard/JclWideStrings.txt b/official/1.104/experts/useswizard/JclWideStrings.txt
new file mode 100644
index 0000000..9f6bc01
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclWideStrings.txt
@@ -0,0 +1,20 @@
+TWStringList
+TWStrings
+CharToWideChar
+MoveWideChar
+StrICompW
+StrLICompW2
+TrimLeftLengthW
+TrimLeftW
+TrimRightLengthW
+TrimRightW
+TrimW
+WideCharToChar
+WideCompareStr
+WideCompareText
+WidePos
+TWideFileOptionsType
+TWStringItem
+PWStringItem
+TWideFileOptions
+TWStringListSortCompare
diff --git a/official/1.104/experts/useswizard/JclWin32.txt b/official/1.104/experts/useswizard/JclWin32.txt
new file mode 100644
index 0000000..5f3bd85
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclWin32.txt
@@ -0,0 +1,1598 @@
+AdjustTokenPrivileges
+BackupSeek
+CheckSumMappedFile
+CreateMutex
+DeleteVolumeMountPoint
+EnumCalendarInfoExA
+GetCalendarInfoA
+GetCalendarInfoW
+GetFileSecurity
+GetFileSecurityA
+GetFileSecurityW
+GetImageUnusedHeaderBytes
+GetVersionEx
+GetVersionEx
+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
+IsPwrHibernateAllowed
+IsPwrShutdownAllowed
+IsPwrSuspendAllowed
+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
+SetFileSecurity
+SetFileSecurityA
+SetFileSecurityW
+SetNamedSecurityInfoW
+SetSuspendState
+SetVolumeMountPoint
+SetWaitableTimer
+SORTIDFROMLCID
+SORTVERSIONFROMLCID
+SUBLANGID
+TouchFileTimes
+UnDecorateSymbolName
+UnMapAndLoad
+_ACTION_HEADER
+_ADAPTER_STATUS
+_FIND_NAME_BUFFER
+_FIND_NAME_HEADER
+_FPO_DATA
+_GET_FILEEX_INFO_LEVELS
+_GROUP_INFO_0
+_GROUP_INFO_1
+_IMAGE_ARCHIVE_MEMBER_HEADER
+_IMAGE_COFF_SYMBOLS_HEADER
+_IMAGE_DATA_DIRECTORY
+_IMAGE_DEBUG_MISC
+_IMAGE_FILE_HEADER
+_IMAGE_FUNCTION_ENTRY
+_IMAGE_FUNCTION_ENTRY64
+_IMAGE_LINENUMBER
+_IMAGE_NT_HEADERS
+_IMAGE_NT_HEADERS64
+_IMAGE_OPTIONAL_HEADER
+_IMAGE_OPTIONAL_HEADER64
+_IMAGE_RESOURCE_DIRECTORY_STRING
+_IMAGE_ROM_HEADERS
+_IMAGE_ROM_OPTIONAL_HEADER
+_IMAGE_SECTION_HEADER
+_IMAGE_SEPARATE_DEBUG_HEADER
+_IMAGE_THUNK_DATA32
+_IMAGE_THUNK_DATA64
+_IMAGE_TLS_DIRECTORY32
+_IMAGE_TLS_DIRECTORY64
+_ImageArchitectureEntry
+_ImageArchitectureHeader
+_IMAGEHLP_LINE
+_LANA_ENUM
+_LOADED_IMAGE
+_LOCALGROUP_INFO_0
+_LOCALGROUP_INFO_1
+_LOCALGROUP_INFO_1002
+_LOCALGROUP_MEMBERS_INFO_0
+_LOCALGROUP_MEMBERS_INFO_1
+_LOCALGROUP_MEMBERS_INFO_2
+_LOCALGROUP_MEMBERS_INFO_3
+_NAME_BUFFER
+_NCB
+_NON_PAGED_DEBUG_INFO
+_OSVERSIONINFOEXA
+_OSVERSIONINFOEXW
+_SESSION_BUFFER
+_SESSION_HEADER
+_SID
+_SID_AND_ATTRIBUTES
+_TOKEN_USER
+_USER_INFO_0
+_USER_INFO_1
+_USER_INFO_2
+IMAGE_LOAD_CONFIG_DIRECTORY32
+IMAGE_LOAD_CONFIG_DIRECTORY64
+IMPORT_OBJECT_HEADER
+IMPORT_OBJECT_NAME_TYPE
+IMPORT_OBJECT_TYPE
+tagRASDIALDLG
+TGenericReparseBuffer
+TIIDUnion
+TImgLineNoType
+TImgSecHdrMisc
+_SID_NAME_USE
+ACTION_HEADER
+ADAPTER_STATUS
+CALINFO_ENUMPROCEXA
+DEVICE_TYPE
+DWORD_PTR
+FILE_ALLOCATED_RANGE_BUFFER
+FILE_ZERO_DATA_INFORMATION
+FIND_NAME_BUFFER
+FIND_NAME_HEADER
+FPO_DATA
+GET_FILEEX_INFO_LEVELS
+GROUP_INFO_0
+GROUP_INFO_1
+IMAGE_ARCHITECTURE_ENTRY
+IMAGE_ARCHITECTURE_HEADER
+IMAGE_ARCHIVE_MEMBER_HEADER
+IMAGE_COFF_SYMBOLS_HEADER
+IMAGE_DATA_DIRECTORY
+IMAGE_DEBUG_MISC
+IMAGE_FILE_HEADER
+IMAGE_FUNCTION_ENTRY
+IMAGE_FUNCTION_ENTRY64
+IMAGE_LINENUMBER
+IMAGE_NT_HEADERS
+IMAGE_NT_HEADERS32
+IMAGE_NT_HEADERS64
+IMAGE_OPTIONAL_HEADER32
+IMAGE_OPTIONAL_HEADER64
+IMAGE_RESOURCE_DIRECTORY_STRING
+IMAGE_ROM_HEADERS
+IMAGE_ROM_OPTIONAL_HEADER
+IMAGE_SECTION_HEADER
+IMAGE_SEPARATE_DEBUG_HEADER
+IMAGE_THUNK_DATA32
+IMAGE_THUNK_DATA64
+IMAGE_TLS_DIRECTORY32
+IMAGE_TLS_DIRECTORY64
+IMAGEHLP_LINE
+LANA_ENUM
+LMCSTR
+LMSTR
+LOADED_IMAGE
+LOCALGROUP_INFO_0
+LOCALGROUP_INFO_1
+LOCALGROUP_INFO_1002
+LOCALGROUP_MEMBERS_INFO_0
+LOCALGROUP_MEMBERS_INFO_1
+LOCALGROUP_MEMBERS_INFO_2
+LOCALGROUP_MEMBERS_INFO_3
+LPCSTR
+LPCTSTR
+LPCWSTR
+LPGROUP_INFO_0
+LPGROUP_INFO_1
+LPLOCALGROUP_INFO_0
+LPLOCALGROUP_INFO_1
+LPLOCALGROUP_INFO_1002
+LPLOCALGROUP_MEMBERS_INFO_0
+LPLOCALGROUP_MEMBERS_INFO_1
+LPLOCALGROUP_MEMBERS_INFO_2
+LPLOCALGROUP_MEMBERS_INFO_3
+LPOSVERSIONINFOEX
+LPOSVERSIONINFOEXA
+LPOSVERSIONINFOEXW
+LPSTR
+LPUSER_INFO_0
+LPUSER_INFO_1
+LPUSER_INFO_2
+LPWSTR
+MAKEINTRESOURCE
+MAKEINTRESOURCEA
+MAKEINTRESOURCEW
+NAME_BUFFER
+NCB
+NET_API_STATUS
+NON_PAGED_DEBUG_INFO
+OSVERSIONINFOEX
+OSVERSIONINFOEXA
+OSVERSIONINFOEXW
+PACTION_HEADER
+PActionHeader
+PADAPTER_STATUS
+PAnonObjectHeader
+PByte
+PDllVersionInfo
+PDWORD_PTR
+PFILE_ALLOCATED_RANGE_BUFFER
+PFILE_ZERO_DATA_INFORMATION
+PFIND_NAME_BUFFER
+PFIND_NAME_HEADER
+PFindNameBuffer
+PFindNameHeader
+PFPO_DATA
+PFpoData
+PGROUP_INFO_0
+PGROUP_INFO_1
+PGroupInfo0
+PGroupInfo1
+PIMAGE_ARCHITECTURE_ENTRY
+PIMAGE_ARCHITECTURE_HEADER
+PIMAGE_ARCHIVE_MEMBER_HEADER
+PIMAGE_BASE_RELOCATION
+PIMAGE_BOUND_FORWARDER_REF
+PIMAGE_BOUND_IMPORT_DESCRIPTOR
+PIMAGE_COFF_SYMBOLS_HEADER
+PIMAGE_COR20_HEADER
+PIMAGE_DATA_DIRECTORY
+PIMAGE_DEBUG_MISC
+PIMAGE_EXPORT_DIRECTORY
+PIMAGE_FILE_HEADER
+PIMAGE_FUNCTION_ENTRY
+PIMAGE_FUNCTION_ENTRY64
+PIMAGE_IMPORT_BY_NAME
+PIMAGE_IMPORT_DESCRIPTOR
+PIMAGE_LINENUMBER
+PIMAGE_LOAD_CONFIG_DIRECTORY
+PIMAGE_LOAD_CONFIG_DIRECTORY32
+PIMAGE_LOAD_CONFIG_DIRECTORY64
+PIMAGE_NT_HEADERS
+PIMAGE_NT_HEADERS32
+PIMAGE_NT_HEADERS64
+PIMAGE_OPTIONAL_HEADER32
+PIMAGE_OPTIONAL_HEADER64
+PIMAGE_RESOURCE_DATA_ENTRY
+PIMAGE_RESOURCE_DIR_STRING_U
+PIMAGE_RESOURCE_DIRECTORY
+PIMAGE_RESOURCE_DIRECTORY_ENTRY
+PIMAGE_RESOURCE_DIRECTORY_STRING
+PIMAGE_ROM_HEADERS
+PIMAGE_ROM_OPTIONAL_HEADER
+PIMAGE_SECTION_HEADER
+PIMAGE_SEPARATE_DEBUG_HEADER
+PIMAGE_THUNK_DATA
+PIMAGE_THUNK_DATA32
+PIMAGE_THUNK_DATA64
+PIMAGE_TLS_CALLBACK
+PIMAGE_TLS_DIRECTORY
+PIMAGE_TLS_DIRECTORY32
+PIMAGE_TLS_DIRECTORY64
+PImageArchitectureEntry
+PImageArchitectureHeader
+PImageArchiveMemberHeader
+PImageCoffSymbolsHeader
+PImageDataDirectory
+PImageDebugMisc
+PImageFileHeader
+PImageFunctionEntry
+PImageFunctionEntry64
+PIMAGEHLP_LINE
+PImageHlpLine
+PImageLineNumber
+PImageLoadConfigDirectory32
+PImageLoadConfigDirectory64
+PImageNtHeaders
+PImageNtHeaders32
+PImageNtHeaders64
+PImageOptionalHeader32
+PImageOptionalHeader64
+PImageResourceDirectoryString
+PImageRomHeaders
+PImageRomOptionalHeader
+PImageSectionHeader
+PImageSeparateDebugHeader
+PImageThunkData32
+PImageThunkData64
+PImageTlsDirectory32
+PImageTlsDirectory64
+PImportObjectHeader
+PKeyboardState
+PLANA_ENUM
+PLMSTR
+PLOADED_IMAGE
+PLoadedImage
+PLOCALGROUP_INFO_0
+PLOCALGROUP_INFO_1
+PLOCALGROUP_INFO_1002
+PLOCALGROUP_MEMBERS_INFO_0
+PLOCALGROUP_MEMBERS_INFO_1
+PLOCALGROUP_MEMBERS_INFO_2
+PLOCALGROUP_MEMBERS_INFO_3
+PLocalGroupInfo0
+PLocalGroupInfo1
+PLocalGroupInfo1002
+PLocalGroupMembersInfo0
+PLocalGroupMembersInfo1
+PLocalGroupMembersInfo2
+PLocalGroupMembersInfo3
+PLONGLONG
+PLongWord
+PNAME_BUFFER
+PNON_PAGED_DEBUG_INFO
+POSVERSIONINFOEX
+POSVERSIONINFOEXA
+POSVERSIONINFOEXW
+PRasDialDlg
+PREPARSE_DATA_BUFFER
+PREPARSE_GUID_DATA_BUFFER
+PREPARSE_POINT_INFORMATION
+PRTL_OSVERSIONINFOEXW
+PSESSION_BUFFER
+PSESSION_HEADER
+PSessionBuffer
+PSessionHeader
+PSID_AND_ATTRIBUTES
+PSID_AND_ATTRIBUTES_ARRAY
+PSID_NAME_USE
+PSidAndAttributes
+PSidAndAttributesArray
+PSidNameUSe
+PTOKEN_USER
+PTokenUser
+PULONGLONG
+PUSER_INFO_0
+PUSER_INFO_1
+PUSER_INFO_2
+PUserInfo0
+PUserInfo1
+PUserInfo2
+RASDIALDLG
+REPARSE_DATA_BUFFER
+REPARSE_GUID_DATA_BUFFER
+REPARSE_POINT_INFORMATION
+ReplacesCorHdrNumericDefines
+RTL_OSVERSIONINFOEXW
+SESSION_BUFFER
+SESSION_HEADER
+SID
+SID_AND_ATTRIBUTES
+SID_AND_ATTRIBUTES_ARRAY
+TActionHeader
+TAnonObjectHeader
+TCalInfoEnumProcExA
+TFindNameBuffer
+TFindNameHeader
+TFpoData
+TGetFileExInfoLevels
+TGroupInfo0
+TGroupInfo1
+TImageArchitectureEntry
+TImageArchitectureHeader
+TImageArchiveMemberHeader
+TImageCoffSymbolsHeader
+TImageDataDirectory
+TImageDebugMisc
+TImageFileHeader
+TImageFunctionEntry
+TImageFunctionEntry64
+TImageHlpLine
+TImageLineNumber
+TImageLoadConfigDirectory32
+TImageLoadConfigDirectory64
+TImageNtHeaders32
+TImageNtHeaders64
+TImageOptionalHeader32
+TImageOptionalHeader64
+TImageResourceDirectoryString
+TImageRomHeaders
+TImageRomOptionalHeader
+TImageSectionHeader
+TImageSeparateDebugHeader
+TImageThunkData32
+TImageThunkData64
+TImageTlsCallback
+TImageTlsDirectory32
+TImageTlsDirectory64
+TImportObjectHeader
+TImportObjectNameType
+TImportObjectType
+TKeyboardState
+TLocalGroupInfo0
+TLocalGroupInfo1
+TLocalGroupInfo1002
+TLocalGroupMembersInfo0
+TLocalGroupMembersInfo1
+TLocalGroupMembersInfo2
+TLocalGroupMembersInfo3
+TNcb
+TNcbPost
+TNetApiStatus
+TOKEN_USER
+TOSVersionInfoExA
+TOSVersionInfoExW
+TRasDialDlg
+TSessionBuffer
+TSessionHeader
+TSid
+TSidAndAttributes
+TSidAndAttributesArray
+TSidNameUse
+TTokenUser
+TUserInfo0
+TUserInfo1
+TUserInfo2
+ULONG_PTR
+ULONGLONG
+USER_INFO_0
+USER_INFO_1
+USER_INFO_2
+USHORT
+ALERTSZ
+ALL_TRANSPORTS
+ANYSIZE_ARRAY
+ASYNCH
+BACKUP_MSG_FILENAME
+CAL_ITWODIGITYEARMAX
+CAL_NOUSEROVERRIDE
+CAL_RETURN_NUMBER
+CAL_SYEARMONTH
+CAL_USE_CP_ACP
+CALL_PENDING
+CLTYPE_LEN
+CNLEN
+COMPRESSION_ENGINE_HIBER
+COMPRESSION_ENGINE_MAXIMUM
+COMPRESSION_ENGINE_STANDARD
+COR_DELETED_NAME_LENGTH
+COR_ILMETHOD_SECT_SMALL_MAX_DATASIZE
+COR_VERSION_MAJOR
+COR_VERSION_MAJOR_V2
+COR_VERSION_MINOR
+COR_VTABLE_32BIT
+COR_VTABLE_64BIT
+COR_VTABLE_CALL_MOST_DERIVED
+COR_VTABLE_FROM_UNMANAGED
+COR_VTABLEGAP_NAME_LENGTH
+CP_ACP
+CP_MACCP
+CP_OEMCP
+CP_SYMBOL
+CP_THREAD_ACP
+CP_UTF7
+CP_UTF8
+CREATEPROCESS_MANIFEST_RESOURCE_ID
+CRYPT_KEY_LEN
+CRYPT_TXT_LEN
+CSIDL_ADMINTOOLS
+CSIDL_CDBURN_AREA
+CSIDL_COMMON_ADMINTOOLS
+CSIDL_COMMON_APPDATA
+CSIDL_COMMON_DOCUMENTS
+CSIDL_COMMON_MUSIC
+CSIDL_COMMON_OEM_LINKS
+CSIDL_COMMON_PICTURES
+CSIDL_COMMON_TEMPLATES
+CSIDL_COMMON_VIDEO
+CSIDL_COMPUTERSNEARME
+CSIDL_CONNECTIONS
+CSIDL_MYPICTURES
+CSIDL_PROFILE
+CSIDL_PROGRAM_FILES
+CSIDL_PROGRAM_FILES_COMMON
+CSIDL_RESOURCES
+CSIDL_RESOURCES_LOCALIZED
+CSIDL_SYSTEM
+CSIDL_WINDOWS
+DATE_LTRREADING
+DATE_RTLREADING
+DEREGISTERED
+DEVLEN
+DIFFERENCE
+DLLVER_PLATFORM_NT
+DLLVER_PLATFORM_WINDOWS
+DNLEN
+DOMAIN_ALIAS_RID_AUTHORIZATIONACCESS
+DOMAIN_ALIAS_RID_INCOMING_FOREST_TRUST_BUILDERS
+DOMAIN_ALIAS_RID_LOGGING_USERS
+DOMAIN_ALIAS_RID_MONITORING_USERS
+DOMAIN_ALIAS_RID_NETWORK_CONFIGURATION_OPS
+DOMAIN_ALIAS_RID_REMOTE_DESKTOP_USERS
+DOMAIN_ALIAS_RID_TS_LICENSE_SERVERS
+DOMAIN_USER_RID_MAX
+DROPEFFECT_COPY
+DROPEFFECT_LINK
+DROPEFFECT_MOVE
+DROPEFFECT_NONE
+DROPEFFECT_SCROLL
+DUPLICATE
+DUPLICATE_CLOSE_SOURCE
+DUPLICATE_DEREG
+DUPLICATE_SAME_ACCESS
+ENCRYPTED_PWLEN
+EVLEN
+FILE_ACTION_ADDED
+FILE_ACTION_MODIFIED
+FILE_ACTION_REMOVED
+FILE_ACTION_RENAMED_NEW_NAME
+FILE_ACTION_RENAMED_OLD_NAME
+FILE_ADD_FILE
+FILE_ADD_SUBDIRECTORY
+FILE_ALL_ACCESS
+FILE_APPEND_DATA
+FILE_ATTRIBUTE_ARCHIVE
+FILE_ATTRIBUTE_COMPRESSED
+FILE_ATTRIBUTE_DIRECTORY
+FILE_ATTRIBUTE_HIDDEN
+FILE_ATTRIBUTE_NORMAL
+FILE_ATTRIBUTE_OFFLINE
+FILE_ATTRIBUTE_READONLY
+FILE_ATTRIBUTE_SYSTEM
+FILE_ATTRIBUTE_TEMPORARY
+FILE_CASE_PRESERVED_NAMES
+FILE_CASE_SENSITIVE_SEARCH
+FILE_CREATE_PIPE_INSTANCE
+FILE_DELETE_CHILD
+FILE_DEVICE_8042_PORT
+FILE_DEVICE_ACPI
+FILE_DEVICE_BATTERY
+FILE_DEVICE_BEEP
+FILE_DEVICE_BUS_EXTENDER
+FILE_DEVICE_CD_ROM
+FILE_DEVICE_CD_ROM_FILE_SYSTEM
+FILE_DEVICE_CHANGER
+FILE_DEVICE_CONTROLLER
+FILE_DEVICE_DATALINK
+FILE_DEVICE_DFS
+FILE_DEVICE_DFS_FILE_SYSTEM
+FILE_DEVICE_DFS_VOLUME
+FILE_DEVICE_DISK
+FILE_DEVICE_DISK_FILE_SYSTEM
+FILE_DEVICE_DVD
+FILE_DEVICE_FIPS
+FILE_DEVICE_FULLSCREEN_VIDEO
+FILE_DEVICE_INFINIBAND
+FILE_DEVICE_INPORT_PORT
+FILE_DEVICE_KEYBOARD
+FILE_DEVICE_KS
+FILE_DEVICE_KSEC
+FILE_DEVICE_MAILSLOT
+FILE_DEVICE_MASS_STORAGE
+FILE_DEVICE_MIDI_IN
+FILE_DEVICE_MIDI_OUT
+FILE_DEVICE_MODEM
+FILE_DEVICE_MOUSE
+FILE_DEVICE_MULTI_UNC_PROVIDER
+FILE_DEVICE_NAMED_PIPE
+FILE_DEVICE_NETWORK
+FILE_DEVICE_NETWORK_BROWSER
+FILE_DEVICE_NETWORK_FILE_SYSTEM
+FILE_DEVICE_NETWORK_REDIRECTOR
+FILE_DEVICE_NULL
+FILE_DEVICE_PARALLEL_PORT
+FILE_DEVICE_PHYSICAL_NETCARD
+FILE_DEVICE_PRINTER
+FILE_DEVICE_SCANNER
+FILE_DEVICE_SCREEN
+FILE_DEVICE_SERENUM
+FILE_DEVICE_SERIAL_MOUSE_PORT
+FILE_DEVICE_SERIAL_PORT
+FILE_DEVICE_SMARTCARD
+FILE_DEVICE_SMB
+FILE_DEVICE_SOUND
+FILE_DEVICE_STREAMS
+FILE_DEVICE_TAPE
+FILE_DEVICE_TAPE_FILE_SYSTEM
+FILE_DEVICE_TERMSRV
+FILE_DEVICE_TRANSPORT
+FILE_DEVICE_UNKNOWN
+FILE_DEVICE_VDM
+FILE_DEVICE_VIDEO
+FILE_DEVICE_VIRTUAL_DISK
+FILE_DEVICE_WAVE_IN
+FILE_DEVICE_WAVE_OUT
+FILE_EXECUTE
+FILE_FILE_COMPRESSION
+FILE_FLAG_BACKUP_SEMANTICS
+FILE_FLAG_DELETE_ON_CLOSE
+FILE_FLAG_FIRST_PIPE_INSTANCE
+FILE_FLAG_NO_BUFFERING
+FILE_FLAG_OPEN_NO_RECALL
+FILE_FLAG_OVERLAPPED
+FILE_FLAG_POSIX_SEMANTICS
+FILE_FLAG_RANDOM_ACCESS
+FILE_FLAG_SEQUENTIAL_SCAN
+FILE_FLAG_WRITE_THROUGH
+FILE_GENERIC_EXECUTE
+FILE_GENERIC_READ
+FILE_GENERIC_WRITE
+FILE_LIST_DIRECTORY
+FILE_NAMED_STREAMS
+FILE_NOTIFY_CHANGE_ATTRIBUTES
+FILE_NOTIFY_CHANGE_CREATION
+FILE_NOTIFY_CHANGE_DIR_NAME
+FILE_NOTIFY_CHANGE_FILE_NAME
+FILE_NOTIFY_CHANGE_LAST_ACCESS
+FILE_NOTIFY_CHANGE_LAST_WRITE
+FILE_NOTIFY_CHANGE_SECURITY
+FILE_NOTIFY_CHANGE_SIZE
+FILE_PERSISTENT_ACLS
+FILE_READ_ATTRIBUTES
+FILE_READ_EA
+FILE_READ_ONLY_VOLUME
+FILE_SHARE_DELETE
+FILE_SHARE_READ
+FILE_SHARE_WRITE
+FILE_SUPPORTS_ENCRYPTION
+FILE_SUPPORTS_OBJECT_IDS
+FILE_SUPPORTS_REMOTE_STORAGE
+FILE_TRAVERSE
+FILE_UNICODE_ON_DISK
+FILE_VOLUME_IS_COMPRESSED
+FILE_VOLUME_QUOTAS
+FILE_WRITE_ATTRIBUTES
+FILE_WRITE_EA
+FOREST_USER_RID_MAX
+FPOFLAGS_FRAME
+FPOFLAGS_HAS_SEH
+FPOFLAGS_PROLOG
+FPOFLAGS_REGS
+FPOFLAGS_RESERVED
+FPOFLAGS_USE_BP
+FRAME_FPO
+FRAME_NONFPO
+FRAME_TRAP
+FRAME_TSS
+FSCTL_ALLOW_EXTENDED_DASD_IO
+FSCTL_CREATE_OR_GET_OBJECT_ID
+FSCTL_CREATE_USN_JOURNAL
+FSCTL_DELETE_OBJECT_ID
+FSCTL_DELETE_USN_JOURNAL
+FSCTL_DISMOUNT_VOLUME
+FSCTL_ENCRYPTION_FSCTL_IO
+FSCTL_ENUM_USN_DATA
+FSCTL_EXTEND_VOLUME
+FSCTL_FILE_PREFETCH
+FSCTL_FILESYSTEM_GET_STATISTICS
+FSCTL_FIND_FILES_BY_SID
+FSCTL_GET_NTFS_FILE_RECORD
+FSCTL_GET_NTFS_VOLUME_DATA
+FSCTL_GET_OBJECT_ID
+FSCTL_GET_RETRIEVAL_POINTERS
+FSCTL_GET_VOLUME_BITMAP
+FSCTL_HSM_DATA
+FSCTL_HSM_MSG
+FSCTL_INVALIDATE_VOLUMES
+FSCTL_IS_PATHNAME_VALID
+FSCTL_IS_VOLUME_DIRTY
+FSCTL_IS_VOLUME_MOUNTED
+FSCTL_MARK_AS_SYSTEM_HIVE
+FSCTL_MARK_HANDLE
+FSCTL_MARK_VOLUME_DIRTY
+FSCTL_MOVE_FILE
+FSCTL_QUERY_FAT_BPB
+FSCTL_QUERY_RETRIEVAL_POINTERS
+FSCTL_QUERY_USN_JOURNAL
+FSCTL_READ_FILE_USN_DATA
+FSCTL_READ_FROM_PLEX
+FSCTL_READ_RAW_ENCRYPTED
+FSCTL_READ_USN_JOURNAL
+FSCTL_RECALL_FILE
+FSCTL_SECURITY_ID_CHECK
+FSCTL_SET_ENCRYPTION
+FSCTL_SET_OBJECT_ID
+FSCTL_SET_OBJECT_ID_EXTENDED
+FSCTL_SIS_COPYFILE
+FSCTL_SIS_LINK_FILES
+FSCTL_WRITE_RAW_ENCRYPTED
+FSCTL_WRITE_USN_CLOSE_RECORD
+GNLEN
+GROUP_NAME
+HANGUP_COMPLETE
+HANGUP_PENDING
+HELP_MSG_FILENAME
+HKEY_CLASSES_ROOT
+HKEY_CURRENT_CONFIG
+HKEY_CURRENT_USER
+HKEY_DYN_DATA
+HKEY_LOCAL_MACHINE
+HKEY_PERFORMANCE_DATA
+HKEY_USERS
+IAHFLAGS_NAMETYPE
+IAHFLAGS_RESERVED
+IAHMASK_MBZ16
+IAHMASK_MBZ7
+IAHMASK_SHIFT
+IAHMASK_VALUE
+IMAGE_ARCHIVE_END
+IMAGE_ARCHIVE_LINKER_MEMBER
+IMAGE_ARCHIVE_LONGNAMES_MEMBER
+IMAGE_ARCHIVE_PAD
+IMAGE_ARCHIVE_START
+IMAGE_ARCHIVE_START_SIZE
+IMAGE_COR_EATJ_THUNK_SIZE
+IMAGE_COR_MIH_BASICBLOCK
+IMAGE_COR_MIH_EHRVA
+IMAGE_COR_MIH_METHODRVA
+IMAGE_DEBUG_MISC_EXENAME
+IMAGE_DIRECTORY_ENTRY_ARCHITECTURE
+IMAGE_DIRECTORY_ENTRY_BASERELOC
+IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT
+IMAGE_DIRECTORY_ENTRY_DEBUG
+IMAGE_DIRECTORY_ENTRY_EXCEPTION
+IMAGE_DIRECTORY_ENTRY_EXPORT
+IMAGE_DIRECTORY_ENTRY_GLOBALPTR
+IMAGE_DIRECTORY_ENTRY_IAT
+IMAGE_DIRECTORY_ENTRY_IMPORT
+IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG
+IMAGE_DIRECTORY_ENTRY_RESOURCE
+IMAGE_DIRECTORY_ENTRY_SECURITY
+IMAGE_DIRECTORY_ENTRY_TLS
+IMAGE_DLLCHARACTERISTICS_NO_BIND
+IMAGE_DLLCHARACTERISTICS_NO_ISOLATION
+IMAGE_DLLCHARACTERISTICS_NO_SEH
+IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE
+IMAGE_DLLCHARACTERISTICS_WDM_DRIVER
+IMAGE_FILE_32BIT_MACHINE
+IMAGE_FILE_AGGRESIVE_WS_TRIM
+IMAGE_FILE_BYTES_REVERSED_HI
+IMAGE_FILE_BYTES_REVERSED_LO
+IMAGE_FILE_DEBUG_STRIPPED
+IMAGE_FILE_DLL
+IMAGE_FILE_EXECUTABLE_IMAGE
+IMAGE_FILE_LARGE_ADDRESS_AWARE
+IMAGE_FILE_LINE_NUMS_STRIPPED
+IMAGE_FILE_LOCAL_SYMS_STRIPPED
+IMAGE_FILE_MACHINE_ALPHA
+IMAGE_FILE_MACHINE_ALPHA64
+IMAGE_FILE_MACHINE_AM33
+IMAGE_FILE_MACHINE_AMD64
+IMAGE_FILE_MACHINE_ARM
+IMAGE_FILE_MACHINE_AXP64
+IMAGE_FILE_MACHINE_CEE
+IMAGE_FILE_MACHINE_CEF
+IMAGE_FILE_MACHINE_EBC
+IMAGE_FILE_MACHINE_I386
+IMAGE_FILE_MACHINE_IA64
+IMAGE_FILE_MACHINE_M32R
+IMAGE_FILE_MACHINE_MIPS16
+IMAGE_FILE_MACHINE_MIPSFPU
+IMAGE_FILE_MACHINE_MIPSFPU16
+IMAGE_FILE_MACHINE_POWERPC
+IMAGE_FILE_MACHINE_POWERPCFP
+IMAGE_FILE_MACHINE_R10000
+IMAGE_FILE_MACHINE_R3000
+IMAGE_FILE_MACHINE_R4000
+IMAGE_FILE_MACHINE_SH3
+IMAGE_FILE_MACHINE_SH3DSP
+IMAGE_FILE_MACHINE_SH3E
+IMAGE_FILE_MACHINE_SH4
+IMAGE_FILE_MACHINE_SH5
+IMAGE_FILE_MACHINE_THUMB
+IMAGE_FILE_MACHINE_TRICORE
+IMAGE_FILE_MACHINE_UNKNOWN
+IMAGE_FILE_MACHINE_WCEMIPSV2
+IMAGE_FILE_NET_RUN_FROM_SWAP
+IMAGE_FILE_RELOCS_STRIPPED
+IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP
+IMAGE_FILE_SYSTEM
+IMAGE_FILE_UP_SYSTEM_ONLY
+IMAGE_NT_OPTIONAL_HDR_MAGIC
+IMAGE_NT_OPTIONAL_HDR32_MAGIC
+IMAGE_NT_OPTIONAL_HDR64_MAGIC
+IMAGE_NUMBEROF_DIRECTORY_ENTRIES
+IMAGE_ORDINAL_FLAG32
+IMAGE_ORDINAL_FLAG64
+IMAGE_ROM_OPTIONAL_HDR_MAGIC
+IMAGE_SCN_ALIGN_1024BYTES
+IMAGE_SCN_ALIGN_128BYTES
+IMAGE_SCN_ALIGN_16BYTES
+IMAGE_SCN_ALIGN_1BYTES
+IMAGE_SCN_ALIGN_2048BYTES
+IMAGE_SCN_ALIGN_256BYTES
+IMAGE_SCN_ALIGN_2BYTES
+IMAGE_SCN_ALIGN_32BYTES
+IMAGE_SCN_ALIGN_4096BYTES
+IMAGE_SCN_ALIGN_4BYTES
+IMAGE_SCN_ALIGN_512BYTES
+IMAGE_SCN_ALIGN_64BYTES
+IMAGE_SCN_ALIGN_8192BYTES
+IMAGE_SCN_ALIGN_8BYTES
+IMAGE_SCN_ALIGN_MASK
+IMAGE_SCN_CNT_CODE
+IMAGE_SCN_CNT_INITIALIZED_DATA
+IMAGE_SCN_CNT_UNINITIALIZED_DATA
+IMAGE_SCN_GPREL
+IMAGE_SCN_LNK_COMDAT
+IMAGE_SCN_LNK_INFO
+IMAGE_SCN_LNK_NRELOC_OVFL
+IMAGE_SCN_LNK_OTHER
+IMAGE_SCN_LNK_REMOVE
+IMAGE_SCN_MEM_16BIT
+IMAGE_SCN_MEM_DISCARDABLE
+IMAGE_SCN_MEM_EXECUTE
+IMAGE_SCN_MEM_FARDATA
+IMAGE_SCN_MEM_LOCKED
+IMAGE_SCN_MEM_NOT_CACHED
+IMAGE_SCN_MEM_NOT_PAGED
+IMAGE_SCN_MEM_PRELOAD
+IMAGE_SCN_MEM_PURGEABLE
+IMAGE_SCN_MEM_READ
+IMAGE_SCN_MEM_SHARED
+IMAGE_SCN_MEM_WRITE
+IMAGE_SCN_NO_DEFER_SPEC_EXC
+IMAGE_SCN_TYPE_NO_PAD
+IMAGE_SEPARATE_DEBUG_FLAGS_MASK
+IMAGE_SEPARATE_DEBUG_MISMATCH
+IMAGE_SEPARATE_DEBUG_SIGNATURE
+IMAGE_SEPARATION
+IMAGE_SIZEOF_ARCHIVE_MEMBER_HDR
+IMAGE_SIZEOF_FILE_HEADER
+IMAGE_SIZEOF_LINENUMBER
+IMAGE_SIZEOF_NT_OPTIONAL_HEADER
+IMAGE_SIZEOF_NT_OPTIONAL32_HEADER
+IMAGE_SIZEOF_NT_OPTIONAL64_HEADER
+IMAGE_SIZEOF_ROM_OPTIONAL_HEADER
+IMAGE_SIZEOF_SECTION_HEADER
+IMAGE_SIZEOF_SHORT_NAME
+IMAGE_SIZEOF_STD_OPTIONAL_HEADER
+IMAGE_SUBSYSTEM_EFI_APPLICATION
+IMAGE_SUBSYSTEM_EFI_BOOT_SERVICE_DRIVER
+IMAGE_SUBSYSTEM_EFI_ROM
+IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER
+IMAGE_SUBSYSTEM_NATIVE
+IMAGE_SUBSYSTEM_NATIVE_WINDOWS
+IMAGE_SUBSYSTEM_OS2_CUI
+IMAGE_SUBSYSTEM_POSIX_CUI
+IMAGE_SUBSYSTEM_UNKNOWN
+IMAGE_SUBSYSTEM_WINDOWS_CE_GUI
+IMAGE_SUBSYSTEM_WINDOWS_CUI
+IMAGE_SUBSYSTEM_WINDOWS_GUI
+IMAGE_SUBSYSTEM_XBOX
+IMPORT_OBJECT_HDR_SIG2
+IO_COMPLETION_ALL_ACCESS
+IO_COMPLETION_MODIFY_STATE
+IO_REPARSE_TAG_DFS
+IO_REPARSE_TAG_FILTER_MANAGER
+IOHFLAGS_TYPE
+ISOLATIONAWARE_MANIFEST_RESOURCE_ID
+ISOLATIONAWARE_NOSTATICIMPORT_MANIFEST_RESOURCE_ID
+KLF_RESET
+KLF_SHIFTLOCK
+LISTEN_OUTSTANDING
+LM20_CNLEN
+LM20_DEVLEN
+LM20_DNLEN
+LM20_GNLEN
+LM20_MAXCOMMENTSZ
+LM20_NNLEN
+LM20_PATHLEN
+LM20_PWLEN
+LM20_QNLEN
+LM20_RMLEN
+LM20_SNLEN
+LM20_STXTLEN
+LM20_UNCLEN
+LM20_UNLEN
+LOCALE_IDEFAULTEBCDICCODEPAGE
+LOCALE_IDIGITSUBSTITUTION
+LOCALE_IPAPERSIZE
+LOCALE_NOUSEROVERRIDE
+LOCALE_RETURN_NUMBER
+LOCALE_SENGCURRNAME
+LOCALE_SNATIVECURRNAME
+LOCALE_SSORTNAME
+LOCALE_SYEARMONTH
+LOCALE_USE_CP_ACP
+MAILSLOT_NO_MESSAGE
+MAILSLOT_WAIT_FOREVER
+MAX_CLASS_NAME
+MAX_LANMAN_MESSAGE_ID
+MAX_NATURAL_ALIGNMENT
+MAX_NERR
+MAX_PACKAGE_NAME
+MAX_PREFERRED_LENGTH
+MAXCOMMENTSZ
+MAXDEVENTRIES
+MAXIMUM_RESERVED_MANIFEST_RESOURCE_ID
+MAXLONGLONG
+MESSAGE_FILENAME
+METHOD_DIRECT_FROM_HARDWARE
+METHOD_DIRECT_TO_HARDWARE
+MIN_LANMAN_MESSAGE_ID
+MINIMUM_RESERVED_MANIFEST_RESOURCE_ID
+MS_NBF
+NAME_FLAGS_MASK
+NATIVE_TYPE_MAX_CB
+NCBACTION
+NCBADDGRNAME
+NCBADDNAME
+NCBCALL
+NCBCANCEL
+NCBCHAINSEND
+NCBCHAINSENDNA
+NCBDELNAME
+NCBDGRECV
+NCBDGRECVBC
+NCBDGSEND
+NCBDGSENDBC
+NCBFINDNAME
+NCBHANGUP
+NCBLANSTALERT
+NCBLISTEN
+NCBRECV
+NCBRECVANY
+NCBSEND
+NCBSENDNA
+NCBSSTAT
+NCBTRACE
+NCBUNLINK
+NERR_AccountExpired
+NERR_AccountLockedOut
+NERR_AccountUndefined
+NERR_AcctLimitExceeded
+NERR_ACFFileIOFail
+NERR_ACFNoParent
+NERR_ACFNoRoom
+NERR_ACFNotFound
+NERR_ACFNotLoaded
+NERR_ACFTooManyLists
+NERR_ActiveConns
+NERR_AddForwarded
+NERR_AlertExists
+NERR_AlreadyExists
+NERR_AlreadyForwarded
+NERR_AlreadyLoggedOn
+NERR_BadAsgType
+NERR_BadComponent
+NERR_BadControlRecv
+NERR_BadDest
+NERR_BadDev
+NERR_BadDevString
+NERR_BadDosFunction
+NERR_BadDosRetCode
+NERR_BadEventName
+NERR_BadFileCheckSum
+NERR_BadPassword
+NERR_BadPasswordCore
+NERR_BadQueueDevString
+NERR_BadQueuePriority
+NERR_BadReceive
+NERR_BadRecipient
+NERR_BadServiceName
+NERR_BadServiceProgName
+NERR_BadSource
+NERR_BadTransactConfig
+NERR_BadUasConfig
+NERR_BadUsername
+NERR_BASE
+NERR_BrowserConfiguredToNotRun
+NERR_BrowserNotStarted
+NERR_BrowserTableIncomplete
+NERR_BufTooSmall
+NERR_CallingRplSrvr
+NERR_CanNotGrowSegment
+NERR_CanNotGrowUASFile
+NERR_CantConnectRplSrvr
+NERR_CantOpenImageFile
+NERR_CantType
+NERR_CfgCompNotFound
+NERR_CfgParamNotFound
+NERR_ClientNameNotFound
+NERR_CommDevInUse
+NERR_ComputerAccountNotFound
+NERR_DatabaseUpToDate
+NERR_DataTypeInvalid
+NERR_DCNotFound
+NERR_DefaultJoinRequired
+NERR_DelComputerName
+NERR_DeleteLater
+NERR_DestExists
+NERR_DestIdle
+NERR_DestInvalidOp
+NERR_DestInvalidState
+NERR_DestNoRoom
+NERR_DestNotFound
+NERR_DeviceIsShared
+NERR_DeviceNotShared
+NERR_DeviceShareConflict
+NERR_DevInUse
+NERR_DevInvalidOpCode
+NERR_DevNotFound
+NERR_DevNotOpen
+NERR_DevNotRedirected
+NERR_DfsAlreadyShared
+NERR_DfsBadRenamePath
+NERR_DfsCantCreateJunctionPoint
+NERR_DfsCantRemoveDfsRoot
+NERR_DfsCantRemoveLastServerShare
+NERR_DfsChildOrParentInDfs
+NERR_DfsCyclicalName
+NERR_DfsDataIsIdentical
+NERR_DfsDuplicateService
+NERR_DfsInconsistent
+NERR_DfsInternalCorruption
+NERR_DfsInternalError
+NERR_DfsLeafVolume
+NERR_DfsNoSuchServer
+NERR_DfsNoSuchShare
+NERR_DfsNoSuchVolume
+NERR_DfsNotALeafVolume
+NERR_DfsNotSupportedInServerDfs
+NERR_DfsServerNotDfsAware
+NERR_DfsServerUpgraded
+NERR_DfsVolumeAlreadyExists
+NERR_DfsVolumeDataCorrupt
+NERR_DfsVolumeHasMultipleServers
+NERR_DfsVolumeIsInterDfs
+NERR_DfsVolumeIsOffline
+NERR_DifferentServers
+NERR_DriverNotFound
+NERR_DuplicateName
+NERR_DuplicateShare
+NERR_DupNameReboot
+NERR_ErrCommRunSrv
+NERR_ErrorExecingGhost
+NERR_ExecFailure
+NERR_FileIdNotFound
+NERR_GroupExists
+NERR_GroupNotFound
+NERR_GrpMsgProcessor
+NERR_ImageParamErr
+NERR_IncompleteDel
+NERR_InternalError
+NERR_InUseBySpooler
+NERR_InvalidAPI
+NERR_InvalidComputer
+NERR_InvalidDatabase
+NERR_InvalidDevice
+NERR_InvalidLana
+NERR_InvalidLogonHours
+NERR_InvalidLogSeek
+NERR_InvalidMaxUsers
+NERR_InvalidUASOp
+NERR_InvalidWorkgroupName
+NERR_InvalidWorkstation
+NERR_IsDfsShare
+NERR_ItemNotFound
+NERR_JobInvalidState
+NERR_JobNoRoom
+NERR_JobNotFound
+NERR_LanmanIniError
+NERR_LastAdmin
+NERR_LineTooLong
+NERR_LocalDrive
+NERR_LocalForward
+NERR_LogFileChanged
+NERR_LogFileCorrupt
+NERR_LogonDomainExists
+NERR_LogonNoUserPath
+NERR_LogonScriptError
+NERR_LogonServerConflict
+NERR_LogonServerNotFound
+NERR_LogonsPaused
+NERR_LogonTrackingError
+NERR_LogOverflow
+NERR_MaxLenExceeded
+NERR_MsgAlreadyStarted
+NERR_MsgInitFailed
+NERR_MsgNotStarted
+NERR_MultipleNets
+NERR_NameInUse
+NERR_NameNotForwarded
+NERR_NameNotFound
+NERR_NameUsesIncompatibleCodePage
+NERR_NetlogonNotStarted
+NERR_NetNameNotFound
+NERR_NetNotStarted
+NERR_NetworkError
+NERR_NoAlternateServers
+NERR_NoCommDevs
+NERR_NoComputerName
+NERR_NoForwardName
+NERR_NonDosFloppyUsed
+NERR_NoNetworkResource
+NERR_NonValidatedLogon
+NERR_NoRoom
+NERR_NoRplBootSystem
+NERR_NoSuchAlert
+NERR_NoSuchConnection
+NERR_NoSuchServer
+NERR_NoSuchSession
+NERR_NotInCache
+NERR_NotInDispatchTbl
+NERR_NotLocalDomain
+NERR_NotLocalName
+NERR_NotLoggedOn
+NERR_NotPrimary
+NERR_OpenFiles
+NERR_PasswordCantChange
+NERR_PasswordExpired
+NERR_PasswordFilterError
+NERR_PasswordHistConflict
+NERR_PasswordMismatch
+NERR_PasswordMustChange
+NERR_PasswordNotComplexEnough
+NERR_PasswordTooLong
+NERR_PasswordTooRecent
+NERR_PasswordTooShort
+NERR_PausedRemote
+NERR_PersonalSku
+NERR_ProcNoRespond
+NERR_ProcNotFound
+NERR_ProfileCleanup
+NERR_ProfileFileTooBig
+NERR_ProfileLoadErr
+NERR_ProfileOffset
+NERR_ProfileSaveErr
+NERR_ProfileUnknownCmd
+NERR_ProgNeedsExtraMem
+NERR_QExists
+NERR_QInvalidState
+NERR_QNoRoom
+NERR_QNotFound
+NERR_QueueNotFound
+NERR_RedirectedPath
+NERR_RemoteBootFailed
+NERR_RemoteErr
+NERR_RemoteFull
+NERR_RemoteOnly
+NERR_ResourceExists
+NERR_ResourceNotFound
+NERR_RPL_CONNECTED
+NERR_RplAdapterInfoCorrupted
+NERR_RplAdapterNameUnavailable
+NERR_RplAdapterNotFound
+NERR_RplBackupDatabase
+NERR_RplBadDatabase
+NERR_RplBadRegistry
+NERR_RplBootInfoCorrupted
+NERR_RplBootInUse
+NERR_RplBootNameUnavailable
+NERR_RplBootNotFound
+NERR_RplBootRestart
+NERR_RplBootServiceTerm
+NERR_RplBootStartFailed
+NERR_RplCannotEnum
+NERR_RplConfigInfoCorrupted
+NERR_RplConfigNameUnavailable
+NERR_RplConfigNotEmpty
+NERR_RplConfigNotFound
+NERR_RplIncompatibleProfile
+NERR_RplInternal
+NERR_RplLoadrDiskErr
+NERR_RplLoadrNetBiosErr
+NERR_RplNeedsRPLUSERAcct
+NERR_RplNoAdaptersStarted
+NERR_RplNotRplServer
+NERR_RplProfileInfoCorrupted
+NERR_RplProfileNameUnavailable
+NERR_RplProfileNotEmpty
+NERR_RplProfileNotFound
+NERR_RplRplfilesShare
+NERR_RplSrvrCallFailed
+NERR_RplVendorInfoCorrupted
+NERR_RplVendorNameUnavailable
+NERR_RplVendorNotFound
+NERR_RplWkstaInfoCorrupted
+NERR_RplWkstaNameUnavailable
+NERR_RplWkstaNeedsUserAcct
+NERR_RplWkstaNotFound
+NERR_RunSrvPaused
+NERR_ServerNotStarted
+NERR_ServiceCtlBusy
+NERR_ServiceCtlNotValid
+NERR_ServiceCtlTimeout
+NERR_ServiceEntryLocked
+NERR_ServiceInstalled
+NERR_ServiceKillProc
+NERR_ServiceNotCtrl
+NERR_ServiceNotInstalled
+NERR_ServiceNotStarting
+NERR_ServiceTableFull
+NERR_ServiceTableLocked
+NERR_SetupAlreadyJoined
+NERR_SetupDomainController
+NERR_SetupNotJoined
+NERR_ShareMem
+NERR_ShareNotFound
+NERR_SourceIsDir
+NERR_SpeGroupOp
+NERR_SpoolerNotLoaded
+NERR_SpoolNoMemory
+NERR_StandaloneLogon
+NERR_StartingRplBoot
+NERR_Success
+NERR_SyncRequired
+NERR_TimeDiffAtDC
+NERR_TmpFile
+NERR_TooManyAlerts
+NERR_TooManyConnections
+NERR_TooManyEntries
+NERR_TooManyFiles
+NERR_TooManyImageParams
+NERR_TooManyItems
+NERR_TooManyNames
+NERR_TooManyServers
+NERR_TooManySessions
+NERR_TooMuchData
+NERR_TruncatedBroadcast
+NERR_TryDownLevel
+NERR_UnableToAddName_F
+NERR_UnableToAddName_W
+NERR_UnableToDelName_F
+NERR_UnableToDelName_W
+NERR_UnknownDevDir
+NERR_UnknownServer
+NERR_UPSDriverNotStarted
+NERR_UPSInvalidCommPort
+NERR_UPSInvalidConfig
+NERR_UPSShutdownFailed
+NERR_UPSSignalAsserted
+NERR_UseNotFound
+NERR_UserExists
+NERR_UserInGroup
+NERR_UserLogon
+NERR_UserNotFound
+NERR_UserNotInGroup
+NERR_WkstaInconsistentState
+NERR_WkstaNotStarted
+NERR_WriteFault
+NetApi32
+NETBIOS_NAME_LEN
+NLS_VALID_LOCALE_MASK
+NNLEN
+NON_PAGED_DEBUG_SIGNATURE
+NRC_ACTSES
+NRC_BADDR
+NRC_BRIDGE
+NRC_BUFLEN
+NRC_CANCEL
+NRC_CANOCCR
+NRC_CMDCAN
+NRC_CMDTMO
+NRC_DUPENV
+NRC_DUPNAME
+NRC_ENVNOTDEF
+NRC_IFBUSY
+NRC_ILLCMD
+NRC_ILLNN
+NRC_INCOMP
+NRC_INUSE
+NRC_INVADDRESS
+NRC_INVDDID
+NRC_LOCKFAIL
+NRC_LOCTFUL
+NRC_MAXAPPS
+NRC_NAMCONF
+NRC_NAMERR
+NRC_NAMTFUL
+NRC_NOCALL
+NRC_NORES
+NRC_NORESOURCES
+NRC_NOSAPS
+NRC_NOWILD
+NRC_OPENERR
+NRC_OSRESNOTAV
+NRC_PENDING
+NRC_REMTFUL
+NRC_SABORT
+NRC_SCLOSED
+NRC_SNUMOUT
+NRC_SYSTEM
+NRC_TOOMANY
+NULL_USERSETINFO_PASSWD
+OS2MSG_FILENAME
+PARM_ERROR_NONE
+PARM_ERROR_UNKNOWN
+PARMNUM_ALL
+PARMNUM_BASE_INFOLEVEL
+PATHLEN
+PCLEANUI
+PDIRTYUI
+PLATFORM_ID_DOS
+PLATFORM_ID_NT
+PLATFORM_ID_OS2
+PLATFORM_ID_OSF
+PLATFORM_ID_VMS
+PWLEN
+QNLEN
+REG_BINARY
+REG_DWORD
+REG_DWORD_BIG_ENDIAN
+REG_DWORD_LITTLE_ENDIAN
+REG_EXPAND_SZ
+REG_FULL_RESOURCE_DESCRIPTOR
+REG_LINK
+REG_MULTI_SZ
+REG_NONE
+REG_QWORD
+REG_QWORD_LITTLE_ENDIAN
+REG_RESOURCE_LIST
+REG_RESOURCE_REQUIREMENTS_LIST
+REG_SZ
+REGISTERED
+REGISTERING
+RMLEN
+RT_ACCELERATOR
+RT_ANICURSOR
+RT_ANIICON
+RT_BITMAP
+RT_CURSOR
+RT_DIALOG
+RT_DLGINCLUDE
+RT_FONT
+RT_FONTDIR
+RT_GROUP_CURSOR
+RT_GROUP_ICON
+RT_ICON
+RT_MENU
+RT_MESSAGETABLE
+RT_PLUGPLAY
+RT_RCDATA
+RT_STRING
+RT_VERSION
+RT_VXD
+RtdlDeleteVolumeMountPoint
+RtdlEnumCalendarInfoExA
+RtdlGetCalendarInfoA
+RtdlGetCalendarInfoW
+RtdlGetVolumeNameForVolumeMountPoint
+RtdlNetApiBufferFree
+RtdlNetBios
+RtdlNetGroupAdd
+RtdlNetGroupDel
+RtdlNetGroupEnum
+RtdlNetLocalGroupAdd
+RtdlNetLocalGroupAddMembers
+RtdlNetLocalGroupDel
+RtdlNetLocalGroupEnum
+RtdlNetUserAdd
+RtdlNetUserDel
+RtdlSetNamedSecurityInfoW
+RtdlSetVolumeMountPoint
+RtdlSetWaitableTimer
+SCHED_E_ACCOUNT_DBASE_CORRUPT
+SCHED_E_ACCOUNT_INFORMATION_NOT_SET
+SCHED_E_ACCOUNT_NAME_NOT_FOUND
+SCHED_E_CANNOT_OPEN_TASK
+SCHED_E_INVALID_TASK
+SCHED_E_NO_SECURITY_SERVICES
+SCHED_E_SERVICE_NOT_INSTALLED
+SCHED_E_SERVICE_NOT_RUNNING
+SCHED_E_TASK_NOT_READY
+SCHED_E_TASK_NOT_RUNNING
+SCHED_E_TRIGGER_NOT_FOUND
+SCHED_E_UNKNOWN_OBJECT_VERSION
+SCHED_E_UNSUPPORTED_ACCOUNT_OPTION
+SCHED_S_EVENT_TRIGGER
+SCHED_S_TASK_DISABLED
+SCHED_S_TASK_HAS_NOT_RUN
+SCHED_S_TASK_NO_MORE_RUNS
+SCHED_S_TASK_NO_VALID_TRIGGERS
+SCHED_S_TASK_NOT_SCHEDULED
+SCHED_S_TASK_READY
+SCHED_S_TASK_RUNNING
+SCHED_S_TASK_TERMINATED
+SE_CREATE_GLOBAL_NAME
+SE_IMPERSONATE_NAME
+SE_MANAGE_VOLUME_NAME
+SECURITY_LOCAL_SERVICE_RID
+SECURITY_MAX_ALWAYS_FILTERED
+SECURITY_MAX_SID_SIZE
+SECURITY_MIN_NEVER_FILTERED
+SECURITY_NETWORK_SERVICE_RID
+SECURITY_NT_NON_UNIQUE_SUB_AUTH_COUNT
+SECURITY_OTHER_ORGANIZATION_RID
+SECURITY_PACKAGE_BASE_RID
+SECURITY_PACKAGE_DIGEST_RID
+SECURITY_PACKAGE_NTLM_RID
+SECURITY_PACKAGE_RID_COUNT
+SECURITY_PACKAGE_SCHANNEL_RID
+SECURITY_REMOTE_LOGON_RID
+SECURITY_RESOURCE_MANAGER_AUTHORITY
+SECURITY_THIS_ORGANIZATION_RID
+SESSION_ABORTED
+SESSION_CRYPT_KLEN
+SESSION_ESTABLISHED
+SESSION_PWLEN
+SHPWLEN
+SHTDN_REASON_FLAG_CLEAN_UI
+SHTDN_REASON_FLAG_COMMENT_REQUIRED
+SHTDN_REASON_FLAG_DIRTY_PROBLEM_ID_REQUIRED
+SHTDN_REASON_FLAG_DIRTY_UI
+SHTDN_REASON_FLAG_PLANNED
+SHTDN_REASON_FLAG_USER_DEFINED
+SHTDN_REASON_LEGACY_API
+SHTDN_REASON_MAJOR_APPLICATION
+SHTDN_REASON_MAJOR_HARDWARE
+SHTDN_REASON_MAJOR_LEGACY_API
+SHTDN_REASON_MAJOR_NONE
+SHTDN_REASON_MAJOR_OPERATINGSYSTEM
+SHTDN_REASON_MAJOR_OTHER
+SHTDN_REASON_MAJOR_POWER
+SHTDN_REASON_MAJOR_SOFTWARE
+SHTDN_REASON_MAJOR_SYSTEM
+SHTDN_REASON_MINOR_BLUESCREEN
+SHTDN_REASON_MINOR_CORDUNPLUGGED
+SHTDN_REASON_MINOR_DC_DEMOTION
+SHTDN_REASON_MINOR_DC_PROMOTION
+SHTDN_REASON_MINOR_DISK
+SHTDN_REASON_MINOR_ENVIRONMENT
+SHTDN_REASON_MINOR_HARDWARE_DRIVER
+SHTDN_REASON_MINOR_HOTFIX
+SHTDN_REASON_MINOR_HOTFIX_UNINSTALL
+SHTDN_REASON_MINOR_HUNG
+SHTDN_REASON_MINOR_INSTALLATION
+SHTDN_REASON_MINOR_MAINTENANCE
+SHTDN_REASON_MINOR_MMC
+SHTDN_REASON_MINOR_NETWORK_CONNECTIVITY
+SHTDN_REASON_MINOR_NETWORKCARD
+SHTDN_REASON_MINOR_NONE
+SHTDN_REASON_MINOR_OTHER
+SHTDN_REASON_MINOR_OTHERDRIVER
+SHTDN_REASON_MINOR_POWER_SUPPLY
+SHTDN_REASON_MINOR_PROCESSOR
+SHTDN_REASON_MINOR_RECONFIG
+SHTDN_REASON_MINOR_SECURITY
+SHTDN_REASON_MINOR_SECURITYFIX
+SHTDN_REASON_MINOR_SECURITYFIX_UNINSTALL
+SHTDN_REASON_MINOR_SERVICEPACK
+SHTDN_REASON_MINOR_SERVICEPACK_UNINSTALL
+SHTDN_REASON_MINOR_TERMSRV
+SHTDN_REASON_MINOR_UNSTABLE
+SHTDN_REASON_MINOR_UPGRADE
+SHTDN_REASON_MINOR_WMI
+SHTDN_REASON_UNKNOWN
+SHTDN_REASON_VALID_BIT_MASK
+SID_MAX_SUB_AUTHORITIES
+SID_RECOMMENDED_SUB_AUTHORITIES
+SID_REVISION
+SidTypeAlias
+SidTypeComputer
+SidTypeDeletedAccount
+SidTypeDomain
+SidTypeGroup
+SidTypeInvalid
+SidTypeUnknown
+SidTypeUser
+SidTypeWellKnownGroup
+SIZEOF_RFPO_DATA
+SNLEN
+STXTLEN
+SYMOPT_ALLOW_ABSOLUTE_SYMBOLS
+SYMOPT_AUTO_PUBLICS
+SYMOPT_DEBUG
+SYMOPT_EXACT_SYMBOLS
+SYMOPT_FAIL_CRITICAL_ERRORS
+SYMOPT_IGNORE_CVREC
+SYMOPT_IGNORE_NT_SYMPATH
+SYMOPT_INCLUDE_32BIT_MODULES
+SYMOPT_LOAD_ANYTHING
+SYMOPT_LOAD_LINES
+SYMOPT_NO_IMAGE_SEARCH
+SYMOPT_NO_PROMPTS
+SYMOPT_NO_PUBLICS
+SYMOPT_NO_UNQUALIFIED_LOADS
+SYMOPT_OMAP_FIND_NEAREST
+SYMOPT_PUBLICS_ONLY
+SYMOPT_SECURE
+TIMEQ_FOREVER
+UCLEANUI
+UDIRTYUI
+UF_ACCOUNT_TYPE_MASK
+UF_ACCOUNTDISABLE
+UF_DONT_EXPIRE_PASSWD
+UF_DONT_REQUIRE_PREAUTH
+UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED
+UF_HOMEDIR_REQUIRED
+UF_INTERDOMAIN_TRUST_ACCOUNT
+UF_LOCKOUT
+UF_MACHINE_ACCOUNT_MASK
+UF_MNS_LOGON_ACCOUNT
+UF_NORMAL_ACCOUNT
+UF_NOT_DELEGATED
+UF_PASSWD_CANT_CHANGE
+UF_PASSWD_NOTREQD
+UF_PASSWORD_EXPIRED
+UF_SCRIPT
+UF_SERVER_TRUST_ACCOUNT
+UF_SETTABLE_BITS
+UF_SMARTCARD_REQUIRED
+UF_TEMP_DUPLICATE_ACCOUNT
+UF_TRUSTED_FOR_DELEGATION
+UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION
+UF_USE_DES_KEY_ONLY
+UF_WORKSTATION_TRUST_ACCOUNT
+UNCLEN
+UNDNAME_32_BIT_DECODE
+UNDNAME_COMPLETE
+UNDNAME_NAME_ONLY
+UNDNAME_NO_ACCESS_SPECIFIERS
+UNDNAME_NO_ALLOCATION_LANGUAGE
+UNDNAME_NO_ALLOCATION_MODEL
+UNDNAME_NO_ARGUMENTS
+UNDNAME_NO_CV_THISTYPE
+UNDNAME_NO_FUNCTION_RETURNS
+UNDNAME_NO_LEADING_UNDERSCORES
+UNDNAME_NO_MEMBER_TYPE
+UNDNAME_NO_MS_KEYWORDS
+UNDNAME_NO_MS_THISTYPE
+UNDNAME_NO_RETURN_UDT_MODEL
+UNDNAME_NO_SPECIAL_SYMS
+UNDNAME_NO_THISTYPE
+UNDNAME_NO_THROW_SIGNATURES
+UNIQUE_NAME
+UNITS_PER_DAY
+UNITS_PER_WEEK
+UNLEN
+USER_MAXSTORAGE_UNLIMITED
+USER_NO_LOGOFF
+USER_PRIV_ADMIN
+USER_PRIV_GUEST
+USER_PRIV_MASK
+USER_PRIV_USER
+VER_AND
+VER_BUILDNUMBER
+VER_CONDITION_MASK
+VER_EQUAL
+VER_GREATER
+VER_GREATER_EQUAL
+VER_LESS
+VER_LESS_EQUAL
+VER_MAJORVERSION
+VER_MINORVERSION
+VER_NUM_BITS_PER_CONDITION_MASK
+VER_OR
+VER_PLATFORM_WIN32_NT
+VER_PLATFORM_WIN32_WINDOWS
+VER_PLATFORM_WIN32s
+VER_PLATFORMID
+VER_PRODUCT_TYPE
+VER_SERVER_NT
+VER_SERVICEPACKMAJOR
+VER_SERVICEPACKMINOR
+VER_SUITE_BLADE
+VER_SUITE_COMPUTE_SERVER
+VER_SUITE_EMBEDDED_RESTRICTED
+VER_SUITE_SECURITY_APPLIANCE
+VER_SUITE_STORAGE_SERVER
+VER_SUITENAME
+VER_WORKSTATION_NT
+VFT2_DRV_COMM
+VFT2_DRV_DISPLAY
+VFT2_DRV_INSTALLABLE
+VFT2_DRV_KEYBOARD
+VFT2_DRV_LANGUAGE
+VFT2_DRV_MOUSE
+VFT2_DRV_NETWORK
+VFT2_DRV_PRINTER
+VFT2_DRV_SOUND
+VFT2_DRV_SYSTEM
+VFT2_UNKNOWN
+VOS__BASE
+VOS__PM16
+VOS__PM32
+VOS__WINDOWS16
+VOS__WINDOWS32
+_REPARSE_GUID_DATA_BUFFER
+_FILE_ALLOCATED_RANGE_BUFFER
+_DLLVERSIONINFO
diff --git a/official/1.104/experts/useswizard/JclWin32Ex.txt b/official/1.104/experts/useswizard/JclWin32Ex.txt
new file mode 100644
index 0000000..59a2ba3
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclWin32Ex.txt
@@ -0,0 +1,19 @@
+JclCancelWaitableTimer
+JclCheckAndInitializeOpenGL
+JclCreateWaitableTimer
+JclGetFileAttributesEx
+JclglGetError
+JclglGetString
+JclgluErrorString
+JclInitializeCriticalSectionAndSpinCount
+JclOpenWaitableTimer
+JclSetCriticalSectionSpinCount
+JclSignalObjectAndWait
+JclTryEnterCriticalSection
+JclwglCreateContext
+JclwglDeleteContext
+JclwglMakeCurrent
+JclWin32ExFunctions
+TJclWin32ExFunction
+TJclWin32ExFunctions
+UnitVersioning
diff --git a/official/1.104/experts/useswizard/JclWinMIDI.txt b/official/1.104/experts/useswizard/JclWinMIDI.txt
new file mode 100644
index 0000000..6b1512f
--- /dev/null
+++ b/official/1.104/experts/useswizard/JclWinMIDI.txt
@@ -0,0 +1,6 @@
+IJclWinMidiOut
+GetMidiOutputs
+MidiInCheck
+MidiOut
+MidiOutCheck
+TStereoChannel
diff --git a/official/1.104/experts/useswizard/JediUsesWizard.ini b/official/1.104/experts/useswizard/JediUsesWizard.ini
new file mode 100644
index 0000000..b27261d
--- /dev/null
+++ b/official/1.104/experts/useswizard/JediUsesWizard.ini
@@ -0,0 +1,89 @@
+[IdentifierLists]
+Hardlinks=Hardlinks.txt
+Jcl8087=Jcl8087.txt
+JclAbstractContainers=JclAbstractContainers.txt
+JclAlgorithms=JclAlgorithms.txt
+JclAnsiStrings=JclAnsiStrings.txt
+JclAppInst=JclAppInst.txt
+JclArrayLists=JclArrayLists.txt
+JclArraySets=JclArraySets.txt
+JclBase=JclBase.txt
+JclBinaryTrees=JclBinaryTrees.txt
+JclBorlandTools=JclBorlandTools.txt
+JclCIL=JclCIL.txt
+JclCLR=JclCLR.txt
+JclCOM=JclCOM.txt
+JclComplex=JclComplex.txt
+JclCompression=JclCompression.txt
+JclConsole=JclConsole.txt
+JclContainerIntf=JclContainerIntf.txt
+JclCounter=JclCounter.txt
+JclDateTime=JclDateTime.txt
+JclDebug=JclDebug.txt
+JclDotNet=JclDotNet.txt
+JclEDI=JclEDI.txt
+JclEDI_ANSIX12=JclEDI_ANSIX12.txt
+JclEDI_ANSIX12_Ext=JclEDI_ANSIX12_Ext.txt
+JclEDI_UNEDIFACT=JclEDI_UNEDIFACT.txt
+JclEDI_UNEDIFACT_Ext=JclEDI_UNEDIFACT_Ext.txt
+JclEDISEF=JclEDISEF.txt
+JclEDITranslators=JclEDITranslators.txt
+JclEDIXML=JclEDIXML.txt
+JclExprEval=JclExprEval.txt
+JclFileUtils=JclFileUtils.txt
+JclGraphics=JclGraphics.txt
+JclGraphUtils=JclGraphUtils.txt
+JclHashMaps=JclHashMaps.txt
+JclHashSets=JclHashSets.txt
+JclHookExcept=JclHookExcept.txt
+JclIniFiles=JclIniFiles.txt
+JclLANMan=JclLANMan.txt
+JclLinkedLists=JclLinkedLists.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
+JclMsdosSys=JclMsdosSys.txt
+JclMultimedia=JclMultimedia.txt
+JclNTFS=JclNTFS.txt
+JclPCRE=JclPCRE.txt
+JclPeImage=JclPeImage.txt
+JclPrint=JclPrint.txt
+JclQGraphics=JclQGraphics.txt
+JclQGraphUtils=JclQGraphUtils.txt
+JclQueues=JclQueues.txt
+JclRegistry=JclRegistry.txt
+JclResources=JclResources.txt
+JclRTF=JclRTF.txt
+JclRTTI=JclRTTI.txt
+JclSchedule=JclSchedule.txt
+JclSecurity=JclSecurity.txt
+JclShell=JclShell.txt
+JclStacks=JclStacks.txt
+JclStatistics=JclStatistics.txt
+JclStreams=JclStreams.txt
+JclStrHashMap=JclStrHashMap.txt
+JclStrings=JclStrings.txt
+JclStructStorage=JclStructStorage.txt
+JclSvcCtrl=JclSvcCtrl.txt
+JclSynch=JclSynch.txt
+JclSysInfo=JclSysInfo.txt
+JclSysUtils=JclSysUtils.txt
+JclTask=JclTask.txt
+JclTD32=JclTD32.txt
+JclUnicode=JclUnicode.txt
+JclUnitConv=JclUnitConv.txt
+JclUnitVersioning=JclUnitVersioning.txt
+JclUnitVersioningProviders=JclUnitVersioningProviders.txt
+JclValidation=JclValidation.txt
+JclVectors=JclVectors.txt
+JclWideFormat=JclWideFormat.txt
+JclWideStrings=JclWideStrings.txt
+JclWin32=JclWin32.txt
+JclWin32Ex=JclWin32Ex.txt
+JclWinMIDI=JclWinMIDI.txt
+pcre=pcre.txt
diff --git a/official/1.104/experts/useswizard/ReadMe.txt b/official/1.104/experts/useswizard/ReadMe.txt
new file mode 100644
index 0000000..dfe7c6d
--- /dev/null
+++ b/official/1.104/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.104/experts/useswizard/pcre.txt b/official/1.104/experts/useswizard/pcre.txt
new file mode 100644
index 0000000..221604a
--- /dev/null
+++ b/official/1.104/experts/useswizard/pcre.txt
@@ -0,0 +1,167 @@
+GetPCRECalloutCallback
+GetPCREFreeCallback
+GetPCREMallocCallback
+GetPCREStackFreeCallback
+GetPCREStackMallocCallback
+IsPCRELoaded
+LoadPCRE
+pcre_compile
+pcre_compile2
+pcre_config
+pcre_copy_named_substring
+pcre_copy_substring
+pcre_dfa_exec
+pcre_exec
+pcre_free_substring
+pcre_free_substring_list
+pcre_fullinfo
+pcre_get_named_substring
+pcre_get_stringnumber
+pcre_get_stringtable_entries
+pcre_get_substring
+pcre_get_substring_list
+pcre_info
+pcre_maketables
+pcre_refcount
+pcre_study
+pcre_version
+SetPCRECalloutCallback
+SetPCREFreeCallback
+SetPCREMallocCallback
+SetPCREStackFreeCallback
+SetPCREStackMallocCallback
+UnloadPCRE
+pcre_callout_block
+real_pcre
+real_pcre_extra
+pcre_callout_callback
+pcre_compile_func
+pcre_compile2_func
+pcre_config_func
+pcre_copy_named_substring_func
+pcre_copy_substring_func
+pcre_dfa_exec_func
+pcre_exec_func
+pcre_free_callback
+pcre_free_substring_func
+pcre_free_substring_list_func
+pcre_fullinfo_func
+pcre_get_named_substring_func
+pcre_get_stringnumber_func
+pcre_get_stringtable_entries_func
+pcre_get_substring_func
+pcre_get_substring_list_func
+pcre_info_func
+pcre_maketables_func
+pcre_malloc_callback
+pcre_refcount_func
+pcre_stack_free_callback
+pcre_stack_malloc_callback
+pcre_study_func
+pcre_version_func
+PInteger
+PPChar
+PPCRE
+PPCREExtra
+PPointer
+PPPChar
+TPCRE
+TPCREExtra
+TPCRELibNotLoadedHandler
+LibNotLoadedHandler
+pcre_callout
+pcre_compile
+pcre_compile2
+pcre_config
+pcre_copy_named_substring
+pcre_copy_substring
+pcre_dfa_exec
+pcre_exec
+pcre_free
+pcre_free_substring
+pcre_free_substring_list
+pcre_fullinfo
+pcre_get_named_substring
+pcre_get_stringnumber
+pcre_get_stringtable_entries
+pcre_get_substring
+pcre_get_substring_list
+pcre_info
+pcre_malloc
+pcre_refcount
+pcre_stack_free
+pcre_stack_malloc
+pcre_study
+MAX_CAPTURE_COUNT
+MAX_NESTING_DEPTH
+MAX_PATTERN_LENGTH
+MAX_QUANTIFY_REPEAT
+PCRE_ANCHORED
+PCRE_AUTO_CALLOUT
+PCRE_CASELESS
+PCRE_CONFIG_LINK_SIZE
+PCRE_CONFIG_MATCH_LIMIT
+PCRE_CONFIG_MATCH_LIMIT_RECURSION
+PCRE_CONFIG_NEWLINE
+PCRE_CONFIG_POSIX_MALLOC_THRESHOLD
+PCRE_CONFIG_STACKRECURSE
+PCRE_CONFIG_UNICODE_PROPERTIES
+PCRE_CONFIG_UTF8
+PCRE_DFA_RESTART
+PCRE_DFA_SHORTEST
+PCRE_DOLLAR_ENDONLY
+PCRE_DOTALL
+PCRE_DUPNAMES
+PCRE_ERROR_BADCOUNT
+PCRE_ERROR_BADMAGIC
+PCRE_ERROR_BADOPTION
+PCRE_ERROR_BADPARTIAL
+PCRE_ERROR_BADUTF8
+PCRE_ERROR_BADUTF8_OFFSET
+PCRE_ERROR_CALLOUT
+PCRE_ERROR_DFA_RECURSE
+PCRE_ERROR_DFA_UCOND
+PCRE_ERROR_DFA_UITEM
+PCRE_ERROR_DFA_UMLIMIT
+PCRE_ERROR_DFA_WSSIZE
+PCRE_ERROR_INTERNAL
+PCRE_ERROR_MATCHLIMIT
+PCRE_ERROR_NOMATCH
+PCRE_ERROR_NOMEMORY
+PCRE_ERROR_NOSUBSTRING
+PCRE_ERROR_NULL
+PCRE_ERROR_PARTIAL
+PCRE_ERROR_RECURSIONLIMIT
+PCRE_ERROR_UNKNOWN_NODE
+PCRE_EXTENDED
+PCRE_EXTRA
+PCRE_EXTRA_CALLOUT_DATA
+PCRE_EXTRA_MATCH_LIMIT
+PCRE_EXTRA_MATCH_LIMIT_RECURSION
+PCRE_EXTRA_STUDY_DATA
+PCRE_EXTRA_TABLES
+PCRE_FIRSTLINE
+PCRE_INFO_BACKREFMAX
+PCRE_INFO_CAPTURECOUNT
+PCRE_INFO_DEFAULT_TABLES
+PCRE_INFO_FIRSTCHAR
+PCRE_INFO_FIRSTTABLE
+PCRE_INFO_LASTLITERAL
+PCRE_INFO_NAMECOUNT
+PCRE_INFO_NAMEENTRYSIZE
+PCRE_INFO_NAMETABLE
+PCRE_INFO_OPTIONS
+PCRE_INFO_SIZE
+PCRE_INFO_STUDYSIZE
+PCRE_MULTILINE
+PCRE_NEWLINE_CR
+PCRE_NEWLINE_CRLF
+PCRE_NEWLINE_LF
+PCRE_NO_AUTO_CAPTURE
+PCRE_NO_UTF8_CHECK
+PCRE_NOTBOL
+PCRE_NOTEMPTY
+PCRE_NOTEOL
+PCRE_PARTIAL
+PCRE_UNGREEDY
+PCRE_UTF8
diff --git a/official/1.104/experts/versioncontrol/JclVersionControlImpl.pas b/official/1.104/experts/versioncontrol/JclVersionControlImpl.pas
new file mode 100644
index 0000000..3d3a11c
--- /dev/null
+++ b/official/1.104/experts/versioncontrol/JclVersionControlImpl.pas
@@ -0,0 +1,1212 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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) }
+{ Sandeep Chandra }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-11-04 16:09:48 +0100 (mar., 04 nov. 2008) $ }
+{ Revision: $Rev:: 2552 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclVersionControlImpl;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ SysUtils, Classes, Graphics, Controls, Menus, ActnList, Dialogs,
+ ToolsAPI,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ JclVersionControl,
+ JclOtaUtils, JclVersionCtrlCommonOptions;
+
+type
+ TJclVersionControlStandardAction = class(TCustomAction)
+ private
+ FControlAction: TJclVersionControlActionType;
+ public
+ property ControlAction: TJclVersionControlActionType read FControlAction write FControlAction;
+ end;
+
+ TJclVersionControlDropDownAction = class(TDropDownAction)
+ private
+ FControlAction: TJclVersionControlActionType;
+ public
+ property ControlAction: TJclVersionControlActionType read FControlAction write FControlAction;
+ end;
+
+ TJclVersionControlExpert = class (TJclOTAExpert)
+ private
+ FVersionCtrlMenu: TMenuItem;
+ FActions: array [TJclVersionControlActionType] of TCustomAction;
+ FIconIndexes: array [TJclVersionControlActionType] of Integer;
+ FHideActions: Boolean;
+ FIconType: TIconType;
+ FActOnTopSandbox: Boolean;
+ FSaveConfirmation: Boolean;
+ FDisableActions: Boolean;
+ FOptionsFrame: TJclVersionCtrlOptionsFrame;
+ FMenuOrganization: TStringList;
+ procedure SetIconType(const Value: TIconType);
+
+ 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;
+ 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 SaveModules(const FileName: string;
+ const IncludeSubDirectories: Boolean): Boolean;
+
+ 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: TIconType read FIconType write SetIconType;
+ property CurrentCache: TJclVersionControlCache read GetCurrentCache;
+ property CurrentPlugin: TJclVersionControlPlugin read GetCurrentPlugin;
+ property CurrentFileName: string read GetCurrentFileName;
+ end;
+
+// 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;
+
+function CharIsAmpersand(const C: Char): Boolean;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/versioncontrol/JclVersionControlImpl.pas $';
+ Revision: '$Revision: 2552 $';
+ Date: '$Date: 2008-11-04 16:09:48 +0100 (mar., 04 nov. 2008) $';
+ LogPath: 'JCL\experts\versioncontrol'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+uses
+ Windows, Forms, TypInfo, ImgList,
+ JclDebug, JclFileUtils, JclRegistry, JclShell, JclStrings,
+ JclOtaConsts, JclOtaResources,
+ JclVersionCtrlSVNImpl,
+ JclVersionCtrlCVSImpl;
+
+{$R JclVersionCtrlIcons.RES}
+
+const
+ IconNames: array [TJclVersionControlActionType] of PChar =
+ ( 'FILEADD', // vcaAdd
+ 'SANDBOXADD', // vcaAddSandbox
+ 'FILEBLAME', // vcaBlame
+ 'FILEBRANCH', // vcaBranch
+ 'SANDBOXBRANCH', // vcaBranchSandbox
+ 'SANDBOXCHECKOUT', // vcaCheckOutSandbox
+ 'FILECOMMIT', // vcaCommit
+ 'SANDBOXCOMMIT', // vcaCommitSandbox
+ 'CONTEXTMENU', // vcaContextMenu
+ 'FILEDIFF', // vcaDiff
+ 'EXPLORE', // vcaExplore
+ 'EXPLORE', // vcaExploreSandbox
+ 'FILEGRAPH', // vcaGraph
+ 'FILELOG', // vcaLog
+ 'SANDBOXLOG', // vcaLogSandbox
+ 'FILELOCK', // vcaLock
+ 'SANDBOXLOCK', // vcaLockSandbox
+ 'FILEMERGE', // vcaMerge
+ 'SANDBOXMERGE', // vcaMergeSandbox
+ 'PROPERTIES', // vcaProperties
+ 'PROPERTIES', // vcaPropertiesSandbox
+ 'FILERENAME', // vcaRename
+ 'SANDBOXRENAME', // vcaRenameSandbox
+ 'REPOBROWSER', // vcaRepoBrowser
+ 'FILEREVERT', // vcaRevert
+ 'SANDBOXREVERT', // vcaRevertSandbox
+ 'STATUS', // vcaStatus
+ 'STATUS', // vcaStatusSandbox
+ 'FILETAG', // vcaTag
+ 'SANDBOXTAG', // vcaTagSandBox
+ 'FILEUPDATE', // vcaUpdate
+ 'SANDBOXUPDATE', // vcaUpdateSandbox
+ 'FILEUPDATE', // vcaUpdateTo
+ 'SANDBOXUPDATE', // vcaUpdateSandboxTo
+ 'FILEUNLOCK', // vcaUnlock
+ 'SANDBOXUNLOCK'); // vcaUnlockSandbox
+
+
+function CharIsAmpersand(const C: Char): Boolean;
+begin
+ Result := C = '&';
+end;
+
+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;
+begin
+ try
+ if JCLWizardIndex <> -1 then
+ TJclOTAExpertBase.GetOTAWizardServices.RemoveWizard(JCLWizardIndex);
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ end;
+ end;
+end;
+
+function JCLWizardInit(const BorlandIDEServices: IBorlandIDEServices;
+ RegisterProc: TWizardRegisterProc;
+ var TerminateProc: TWizardTerminateProc): Boolean stdcall;
+begin
+ try
+ TerminateProc := JclWizardTerminate;
+
+ JCLWizardIndex := TJclOTAExpertBase.GetOTAWizardServices.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 CharIsDigit(Item[Index]) 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 CharIsDigit(Item[Index]) 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 CharIsDigit(Item[Index1]) then
+ begin
+ if Index1 = 1 then
+ Abort;
+ Break;
+ end;
+
+ for Index2 := Length(Item) downto 1 do
+ if not CharIsDigit(Item[Index2]) 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;
+
+function ActionToControlAction(AAction: TCustomAction): TJclVersionControlActionType;
+begin
+ if AAction is TJclVersionControlDropDownAction then
+ Result := TJclVersionControlDropDownAction(AAction).ControlAction
+ else
+ if AAction is TJclVersionControlStandardAction then
+ Result := TJclVersionControlStandardAction(AAction).ControlAction
+ else
+ raise EJclExpertException.CreateTrace('Internal error: invalid action');
+end;
+
+//=== { TJclVersionControlExpert } ===================================================
+
+procedure TJclVersionControlExpert.ActionExecute(Sender: TObject);
+var
+ Index: Integer;
+ AAction: TCustomAction;
+ ControlAction: TJclVersionControlActionType;
+ ControlActionInfo: TJclVersionControlActionInfo;
+ APlugin: TJclVersionControlPlugin;
+ AFileName: string;
+ AFileCache: TJclVersionControlCache;
+ PluginList: TJclVersionControlPluginList;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ ControlAction := ActionToControlAction(AAction);
+ ControlActionInfo := VersionControlActionInfo(ControlAction);
+
+ if ControlActionInfo.Sandbox then
+ begin
+ AFileCache := CurrentCache;
+ if not Assigned(AFileCache) or ControlActionInfo.AllPlugins then
+ Exit;
+ if ActOnTopSandbox then
+ begin
+ for Index := AFileCache.SandboxCount - 1 downto 0 do
+ if ControlAction in AFileCache.SandboxActions[Index] then
+ begin
+ if ControlActionInfo.SaveFile then
+ SaveModules(AFileCache.SandBoxes[Index], True);
+ AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], ControlAction);
+ Exit;
+ end;
+ end
+ else
+ begin
+ for Index := 0 to AFileCache.SandboxCount - 1 do
+ if ControlAction in AFileCache.SandboxActions[Index] then
+ begin
+ if ControlActionInfo.SaveFile then
+ SaveModules(AFileCache.SandBoxes[Index], True);
+ AFileCache.Plugin.ExecuteAction(AFileCache.SandBoxes[Index], ControlAction);
+ Exit;
+ end;
+ end;
+ end
+ else
+ begin
+ AFileName := CurrentFileName;
+ if ControlActionInfo.SaveFile then
+ SaveModules(AFileName, False);
+
+ if ControlActionInfo.AllPlugins then
+ begin
+ PluginList := VersionControlPluginList;
+ for Index := 0 to PluginList.Count - 1 do
+ begin
+ AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[Index]);
+
+ if ControlAction in AFileCache.Actions then
+ begin
+ AFileCache.Plugin.ExecuteAction(AFileName, ControlAction);
+ Exit;
+ end;
+ end;
+ end
+ else
+ begin
+ APlugin := CurrentPlugin;
+ if Assigned(APlugin) then
+ APlugin.ExecuteAction(AFileName, ControlAction);
+ end;
+ end;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclVersionControlExpert.ActionUpdate(Sender: TObject);
+var
+ IndexSandbox, IndexPlugin: Integer;
+ AAction: TCustomAction;
+ ControlAction: TJclVersionControlActionType;
+ ControlActionInfo: TJclVersionControlActionInfo;
+ AFileCache: TJclVersionControlCache;
+ AFileName: string;
+ PluginList: TJclVersionControlPluginList;
+begin
+ try
+ AAction := Sender as TCustomAction;
+ ControlAction := ActionToControlAction(AAction);
+ ControlActionInfo := VersionControlActionInfo(ControlAction);
+ AFileCache := CurrentCache;
+
+ if HideActions and not ControlActionInfo.AllPlugins then
+ AAction.Visible := Assigned(AFileCache) and Assigned(AFileCache.Plugin)
+ and (ControlAction in AFileCache.Plugin.SupportedActionTypes)
+ else
+ AAction.Visible := True;
+
+ if DisableActions then
+ begin
+ if ControlActionInfo.Sandbox then
+ begin
+ if ControlActionInfo.AllPlugins then
+ begin
+ PluginList := VersionControlPluginList;
+ AFileName := CurrentFileName;
+ for IndexPlugin := 0 to PluginList.Count - 1 do
+ begin
+ AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
+ for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
+ if ControlAction 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 ControlAction 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 ControlActionInfo.AllPlugins then
+ begin
+ PluginList := VersionControlPluginList;
+ AFileName := CurrentFileName;
+ for IndexPlugin := 0 to PluginList.Count - 1 do
+ begin
+ AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
+ if ControlAction 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 (ControlAction in AFileCache.Actions);
+ end;
+ end;
+ end
+ else
+ AAction.Enabled := True;
+ except
+ on ExceptionObj: TObject do
+ begin
+ JclExpertShowExceptionDialog(ExceptionObj);
+ raise;
+ end;
+ end;
+end;
+
+procedure TJclVersionControlExpert.AddConfigurationPages(
+ AddPageFunc: TJclOTAAddPageFunc);
+begin
+ inherited AddConfigurationPages(AddPageFunc);
+ FOptionsFrame := TJclVersionCtrlOptionsFrame.Create(nil);
+ FOptionsFrame.DisableActions := DisableActions;
+ FOptionsFrame.HideActions := HideActions;
+ FOptionsFrame.SaveConfirmation := SaveConfirmation;
+ FOptionsFrame.ActOnTopSandbox := ActOnTopSandbox;
+ FOptionsFrame.SetActions(FActions);
+ // after SetActions
+ FOptionsFrame.MenuTree := FMenuOrganization;
+ FOptionsFrame.IconType := IconType;
+ AddPageFunc(FOptionsFrame, RsVersionControlSheet, Self);
+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;
+begin
+ FMenuOrganization := TStringList.Create;
+
+ inherited Create('JclVersionControlExpert');
+end;
+
+destructor TJclVersionControlExpert.Destroy;
+begin
+ inherited Destroy;
+ FMenuOrganization.Free;
+end;
+
+procedure TJclVersionControlExpert.DropDownMenuPopup(Sender: TObject);
+var
+ APopupMenu: TPopupMenu;
+ AMenuItem: TMenuItem;
+ ControlAction: TJclVersionControlActionType;
+ ControlActionInfo: TJclVersionControlActionInfo;
+ AFileCache: TJclVersionControlCache;
+ IndexPlugin, IndexSandbox: Integer;
+ AFileName: string;
+ PluginList: TJclVersionControlPluginList;
+begin
+ try
+ APopupMenu := Sender as TPopupMenu;
+ ControlAction := TJclVersionControlActionType(APopupMenu.Tag);
+ ControlActionInfo := VersionControlActionInfo(ControlAction);
+
+ APopupMenu.Items.Clear;
+
+ if ControlActionInfo.AllPlugins then
+ begin
+ PluginList := VersionControlPluginList;
+ AFileName := CurrentFileName;
+ for IndexPlugin := 0 to PluginList.Count - 1 do
+ begin
+ AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
+ for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
+ if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
+ begin
+ AMenuItem := TMenuItem.Create(APopupMenu.Items);
+ AMenuItem.Caption := Format('%s | %s', [AFileCache.Plugin.Name, AFileCache.SandBoxes[IndexSandbox]]);
+ AMenuItem.Tag := APopupMenu.Tag;
+ AMenuItem.OnClick := SubItemClick;
+ case IconType of
+ itNone:
+ AMenuItem.ImageIndex := -1;
+ itJCL:
+ AMenuItem.ImageIndex := FIconIndexes[ControlAction];
+ end;
+ APopupMenu.Items.Add(AMenuItem);
+ end;
+ end;
+ end
+ else
+ begin
+ AFileCache := CurrentCache;
+ if Assigned(AFileCache) then
+ for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
+ if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
+ begin
+ AMenuItem := TMenuItem.Create(APopupMenu.Items);
+ AMenuItem.Caption := AFileCache.SandBoxes[IndexSandbox];
+ AMenuItem.Tag := APopupMenu.Tag;
+ AMenuItem.OnClick := SubItemClick;
+ case IconType of
+ itNone:
+ AMenuItem.ImageIndex := -1;
+ itJCL:
+ AMenuItem.ImageIndex := FIconIndexes[ControlAction];
+ end;
+ 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;
+ PluginList: TJclVersionControlPluginList;
+begin
+ PluginList := VersionControlPluginList;
+ AFileName := CurrentFileName;
+ for Index := 0 to PluginList.Count - 1 do
+ begin
+ Result := PluginList.GetFileCache(AFileName, PluginList.Plugins[Index]);
+ if Result.Supported then
+ Exit;
+ end;
+ Result := nil;
+end;
+
+function TJclVersionControlExpert.GetCurrentFileName: string;
+var
+ AOTAModule: IOTAModule;
+begin
+ AOTAModule := GetOTAModuleServices.CurrentModule;
+ {$IFDEF COMPILER6_UP}
+ //SC 20/03/2007
+ if Assigned(AOTAModule) and Assigned(AOTAModule.CurrentEditor) then
+ begin
+ Result := AOTAModule.CurrentEditor.FileName;
+ Exit;
+ end
+ //SC 20/03/2007
+ else
+ {$ENDIF COMPILER6_UP}
+ if Assigned(AOTAModule) and (AOTAModule.FileSystem = '') then
+ Result := AOTAModule.FileName
+ else
+ Result := '';
+end;
+
+function TJclVersionControlExpert.GetCurrentPlugin: TJclVersionControlPlugin;
+var
+ Index: Integer;
+ AFileCacheInfo: TJclVersionControlCache;
+ AFileName: string;
+ PluginList: TJclVersionControlPluginList;
+begin
+ PluginList := VersionControlPluginList;
+ AFileName := CurrentFileName;
+ for Index := 0 to PluginList.Count - 1 do
+ begin
+ Result := TJclVersionControlPlugin(PluginList.Plugins[Index]);
+ AFileCacheInfo := PluginList.GetFileCache(AFileName, Result);
+ if AFileCacheInfo.Supported then
+ Exit;
+ end;
+ Result := nil;
+end;
+
+procedure TJclVersionControlExpert.IDEActionMenuClick(Sender: TObject);
+var
+ AMenuItem, SubMenuItem: TMenuItem;
+ ControlAction: TJclVersionControlActionType;
+ ControlActionInfo: TJclVersionControlActionInfo;
+ IndexSandbox, IndexPlugin, IndexItem: Integer;
+ AFileCache: TJclVersionControlCache;
+ AFileName: string;
+ PluginList: TJclVersionControlPluginList;
+begin
+ try
+ AMenuItem := Sender as TMenuItem;
+ // do not delete the dummy subitem
+ for IndexItem := AMenuItem.Count - 1 downto 1 do
+ AMenuItem.Items[IndexItem].Free;
+ ControlAction := TJclVersionControlActionType(AMenuItem.Tag);
+ ControlActionInfo := VersionControlActionInfo(ControlAction);
+
+ if ControlActionInfo.AllPlugins then
+ begin
+ PluginList := VersionControlPluginList;
+ for IndexPlugin := 0 to PluginList.Count - 1 do
+ begin
+ AFileName := CurrentFileName;
+ AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
+ for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
+ if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
+ begin
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Caption := Format('%s | %s', [AFileCache.Plugin.Name, AFileCache.SandBoxes[IndexSandbox]]);
+ SubMenuItem.Tag := Integer(ControlAction);
+ SubMenuItem.OnClick := SubItemClick;
+ case IconType of
+ itNone:
+ SubMenuItem.ImageIndex := -1;
+ itJCL:
+ SubMenuItem.ImageIndex := FIconIndexes[ControlAction];
+ end;
+ AMenuItem.Add(SubMenuItem);
+ end;
+ end;
+ end
+ else
+ begin
+ AFileCache := CurrentCache;
+
+ if Assigned(AFileCache) then
+ for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
+ if ControlAction in AFileCache.SandBoxActions[IndexSandbox] then
+ begin
+ SubMenuItem := TMenuItem.Create(AMenuItem);
+ SubMenuItem.Caption := AFileCache.SandBoxes[IndexSandbox];
+ SubMenuItem.Tag := Integer(ControlAction);
+ SubMenuItem.OnClick := SubItemClick;
+ case IconType of
+ itNone:
+ SubMenuItem.ImageIndex := -1;
+ itJCL:
+ SubMenuItem.ImageIndex := FIconIndexes[ControlAction];
+ end;
+ 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;
+ ControlAction: TJclVersionControlActionType;
+ ControlActionInfo: TJclVersionControlActionInfo;
+ AFileCache: TJclVersionControlCache;
+ AEnabled: Boolean;
+ IndexPlugin: Integer;
+ AFileName: string;
+ PluginList: TJclVersionControlPluginList;
+ 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
+ ControlAction := TJclVersionControlActionType(BMenuItem.Tag);
+ ControlActionInfo := VersionControlActionInfo(ControlAction);
+ if ControlActionInfo.Sandbox then
+ begin
+ AFileCache := CurrentCache;
+
+ case IconType of
+ itNone:
+ BMenuItem.ImageIndex := -1;
+ itJCL:
+ BMenuItem.ImageIndex := FIconIndexes[ControlAction];
+ end;
+
+ if HideActions and not ControlActionInfo.AllPlugins then
+ BMenuItem.Visible := Assigned(AFileCache) and Assigned(AFileCache.Plugin)
+ and (ControlAction in AFileCache.Plugin.SupportedActionTypes)
+ else
+ BMenuItem.Visible := True;
+
+ if DisableActions then
+ begin
+ AEnabled := False;
+ if ControlActionInfo.AllPlugins then
+ begin
+ PluginList := VersionControlPluginList;
+ AFileName := CurrentFileName;
+ for IndexPlugin := 0 to PluginList.Count - 1 do
+ begin
+ AFileCache := PluginList.GetFileCache(AFileName, PluginList.Plugins[IndexPlugin]);
+ for IndexSandbox := 0 to AFileCache.SandBoxCount - 1 do
+ if ControlAction 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 ControlAction 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.RefreshIcons;
+var
+ ControlAction: TJclVersionControlActionType;
+begin
+ for ControlAction := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
+ if Assigned(FActions[ControlAction]) then
+ begin
+ case IconType of
+ // No icon
+ itNone :
+ FActions[ControlAction].ImageIndex := -1;
+ // JCL icons
+ itJCL :
+ FActions[ControlAction].ImageIndex := FIconIndexes[ControlAction];
+ end;
+ end;
+end;
+
+procedure TJclVersionControlExpert.RefreshMenu;
+ procedure LoadDefaultMenu;
+ var
+ Action: TJclVersionControlActionType;
+ begin
+ FMenuOrganization.Clear;
+ for Action := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
+ FMenuOrganization.Add(Format('%d%s', [Integer(Action), GetEnumName(TypeInfo(TJclVersionControlActionType), Integer(Action))]));
+ end;
+var
+ Index, IndexA, IndexB, ActionIndex: Integer;
+ SubMenuItem, ActionMenuItem, DummyMenuItem: TMenuItem;
+ Item, ItemName: string;
+ AAction: TCustomAction;
+begin
+ FVersionCtrlMenu.Clear;
+
+ 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(TJclVersionControlActionType), ItemName);
+
+ if IndexB = -1 then
+ begin
+ if FVersionCtrlMenu.Count <> IndexA then
+ Abort;
+
+ if (ActionIndex = -1) or (ItemName = '-') then
+ begin
+ SubMenuItem := TMenuItem.Create(FVersionCtrlMenu);
+ SubMenuItem.Caption := ItemName;
+ SubMenuItem.Tag := -1;
+ FVersionCtrlMenu.Add(SubMenuItem);
+ end
+ else
+ begin
+ ActionMenuItem := TMenuItem.Create(FVersionCtrlMenu);
+ AAction := FActions[TJclVersionControlActionType(ActionIndex)];
+ if VersionControlActionInfo(TJclVersionControlActionType(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(ActionMenuItem);
+ 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(FVersionCtrlMenu);
+ ActionMenuItem.Caption := ItemName;
+ end
+ else
+ begin
+ ActionMenuItem := TMenuItem.Create(FVersionCtrlMenu);
+ AAction := FActions[TJclVersionControlActionType(ActionIndex)];
+ if VersionControlActionInfo(TJclVersionControlActionType(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(ActionMenuItem);
+ 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;
+ IDEImageList: TCustomImageList;
+ IDEActionList: TCustomActionList;
+ I: Integer;
+ AStandardAction: TJclVersionControlStandardAction;
+ ADropDownAction: TJclVersionControlDropDownAction;
+ AAction: TCustomAction;
+ IconTypeStr: string;
+ ControlAction: TJclVersionControlActionType;
+ ControlActionInfo: TJclVersionControlActionInfo;
+ NTAServices: INTAServices;
+ AIcon: TIcon;
+begin
+ inherited RegisterCommands;
+ NTAServices := GetNTAServices;
+
+ 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 := itJCL;
+ if IconTypeStr = JclVersionCtrlIconTypeNoIconValue then
+ FIconType := itNone
+ else
+ if IconTypeStr = JclVersionCtrlIconTypeJclIconValue then
+ FIconType := itJCL;
+
+ IDEImageList := NTAServices.ImageList;
+ AIcon := TIcon.Create;
+ try
+ for ControlAction := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
+ begin
+ AIcon.Handle := LoadIcon(HInstance, IconNames[ControlAction]);
+ FIconIndexes[ControlAction] := IDEImageList.AddIcon(AIcon);
+ end;
+ finally
+ AIcon.Free;
+ end;
+
+ 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(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
+ begin
+ ControlActionInfo := VersionControlActionInfo(ControlAction);
+
+ if ControlActionInfo.Sandbox then
+ begin
+ ADropDownAction := TJclVersionControlDropDownAction.Create(nil);
+ ADropDownAction.ControlAction := ControlAction;
+ 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
+ begin
+ AStandardAction := TJclVersionControlStandardAction.Create(nil);
+ AStandardAction.ControlAction := ControlAction;
+ AAction := AStandardAction;
+ end;
+
+ AAction.Caption := ControlActionInfo.Caption;
+ AAction.Name := ControlActionInfo.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;
+ OTAModuleServices: IOTAModuleServices;
+begin
+ Result := True;
+ OTAModuleServices := GetOTAModuleServices;
+
+ for Index := 0 to OTAModuleServices.ModuleCount - 1 do
+ begin
+ Module := OTAModuleServices.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: TIconType);
+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: TJclVersionControlActionType;
+ ControlActionInfo: TJclVersionControlActionInfo;
+ PluginList: TJclVersionControlPluginList;
+begin
+ try
+ APlugin := CurrentPlugin;
+ if Sender is TCustomAction then
+ begin
+ AAction := TCustomAction(Sender);
+ ControlAction := TJclVersionControlActionType(AAction.Tag);
+ Directory := AAction.Caption;
+ end
+ else
+ if Sender is TMenuItem then
+ begin
+ AMenuItem := TMenuItem(Sender);
+ ControlAction := TJclVersionControlActionType(AMenuItem.Tag);
+ Directory := AMenuItem.Caption;
+ end
+ else
+ Exit;
+
+ ControlActionInfo := VersionControlActionInfo(ControlAction);
+ Directory := StrRemoveChars(Directory, CharIsAmpersand);
+
+ if ControlActionInfo.AllPlugins then
+ begin
+ PluginList := VersionControlPluginList;
+ PosSeparator := Pos('|', Directory);
+ PluginName := StrLeft(Directory, PosSeparator - 2);
+ Directory := StrRight(Directory, Length(Directory) - PosSeparator - 1);
+ for IndexPlugin := 0 to PluginList.Count - 1 do
+ begin
+ APlugin := TJclVersionControlPlugin(PluginList.Plugins[IndexPlugin]);
+ if SameText(APlugin.Name, PluginName) then
+ Break;
+ APlugin := nil;
+ end;
+
+ if not Assigned(APlugin) then
+ Exit;
+ end;
+
+ if ControlActionInfo.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: TJclVersionControlActionType;
+ 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
+ itNone:
+ Settings.SaveString(JclVersionCtrlIconTypeName, JclVersionCtrlIconTypeNoIconValue);
+ itJCL:
+ Settings.SaveString(JclVersionCtrlIconTypeName, JclVersionCtrlIconTypeJclIconValue);
+ end;
+
+ for ControlAction := Low(TJclVersionControlActionType) to High(TJclVersionControlActionType) do
+ begin
+ UnregisterAction(FActions[ControlAction]);
+ if FActions[ControlAction] is TDropDownAction then
+ begin
+ ADropDownAction := TDropDownAction(FActions[ControlAction]);
+ if Assigned(ADropDownAction.DropDownMenu) then
+ begin
+ ADropDownAction.DropDownMenu.Items.Clear;
+ ADropDownAction.DropDownMenu.Free;
+ ADropDownAction.DropDownMenu := nil;
+ end;
+ end;
+ FreeAndNil(FActions[ControlAction]);
+ end;
+ FVersionCtrlMenu.Clear;
+ FreeAndNil(FVersionCtrlMenu);
+end;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/versioncontrol/JclVersionCtrlCommonOptions.dfm b/official/1.104/experts/versioncontrol/JclVersionCtrlCommonOptions.dfm
new file mode 100644
index 0000000..c676612
--- /dev/null
+++ b/official/1.104/experts/versioncontrol/JclVersionCtrlCommonOptions.dfm
@@ -0,0 +1,190 @@
+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')
+ 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.104/experts/versioncontrol/JclVersionCtrlCommonOptions.pas b/official/1.104/experts/versioncontrol/JclVersionCtrlCommonOptions.pas
new file mode 100644
index 0000000..fd42454
--- /dev/null
+++ b/official/1.104/experts/versioncontrol/JclVersionCtrlCommonOptions.pas
@@ -0,0 +1,593 @@
+{**************************************************************************************************}
+{ }
+{ Project JEDI Code Library (JCL) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ 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. }
+{ }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-11-04 16:09:48 +0100 (mar., 04 nov. 2008) $ }
+{ Revision: $Rev:: 2552 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JclVersionCtrlCommonOptions;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
+ {$IFDEF UNITVERSIONING}
+ JclUnitVersioning,
+ {$ENDIF UNITVERSIONING}
+ Dialogs, StdCtrls, ComCtrls, ActnList, Menus;
+
+type
+ TIconType = (itNone, itJCL);
+
+ 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: TIconType;
+ function GetMenuTree: TStrings;
+ procedure SetDisableActions(const Value: Boolean);
+ procedure SetHideActions(const Value: Boolean);
+ procedure SetIconType(const Value: TIconType);
+ procedure SetMenuTree(const Value: TStrings);
+ procedure MenuItemNewActionClick(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ 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: TIconType read GetIconType write SetIconType;
+ property MenuTree: TStrings read GetMenuTree write SetMenuTree;
+ property SaveConfirmation: Boolean read GetSaveConfirmation write SetSaveConfirmation;
+ end;
+
+{$IFDEF UNITVERSIONING}
+const
+ UnitVersioning: TUnitVersionInfo = (
+ RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-1.104-Build3248/jcl/experts/versioncontrol/JclVersionCtrlCommonOptions.pas $';
+ Revision: '$Revision: 2552 $';
+ Date: '$Date: 2008-11-04 16:09:48 +0100 (mar., 04 nov. 2008) $';
+ LogPath: 'JCL\experts\versioncontrol'
+ );
+{$ENDIF UNITVERSIONING}
+
+implementation
+
+{$R *.dfm}
+
+uses
+ TypInfo, ToolsAPI,
+ JclStrings, JclVersionControl,
+ JclOtaUtils, JclOtaResources, JclVersionControlImpl;
+
+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';
+
+//=== 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;
+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: TIconType;
+begin
+ if ComboBoxIcons.ItemIndex = 1 then
+ Result := itJCL
+ else
+ Result := itNone;
+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(TJclVersionControlActionType), 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(TJclVersionControlActionType), 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: TIconType);
+begin
+ case Value of
+ itNone:
+ ComboBoxIcons.ItemIndex := 0;
+ itJCL:
+ ComboBoxIcons.ItemIndex := 1;
+ end;
+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(TJclVersionControlActionType), 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, CharIsAmpersand));
+ 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, CharIsAmpersand));
+ 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;
+
+function CharIsInvalid(const C: Char): Boolean;
+begin
+ case C of
+ '\', '_', '0'..'9':
+ Result := True;
+ else
+ Result := False;
+ end;
+end;
+
+procedure TJclVersionCtrlOptionsFrame.TreeViewMenuEdited(Sender: TObject;
+ Node: TTreeNode; var S: string);
+begin
+ if StrContainsChars(S, CharIsInvalid, 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;
+
+{$IFDEF UNITVERSIONING}
+initialization
+ RegisterUnitVersion(HInstance, UnitVersioning);
+
+finalization
+ UnregisterUnitVersion(HInstance);
+{$ENDIF UNITVERSIONING}
+
+end.
diff --git a/official/1.104/experts/versioncontrol/JclVersionCtrlIcons.RES b/official/1.104/experts/versioncontrol/JclVersionCtrlIcons.RES
new file mode 100644
index 0000000..b8f03c8
Binary files /dev/null and b/official/1.104/experts/versioncontrol/JclVersionCtrlIcons.RES differ
diff --git a/official/1.104/experts/versioncontrol/JclVersionCtrlIcons.rc b/official/1.104/experts/versioncontrol/JclVersionCtrlIcons.rc
new file mode 100644
index 0000000..dbe000a
--- /dev/null
+++ b/official/1.104/experts/versioncontrol/JclVersionCtrlIcons.rc
@@ -0,0 +1,37 @@
+/****************************************************************************************************
+
+ Icons for version control actions
+
+****************************************************************************************************/
+
+CONTEXTMENU ICON "icons\ContextMenu.ico"
+EXPLORE ICON "icons\Explore.ico"
+FILEADD ICON "icons\FileAdd.ico"
+FILEBLAME ICON "icons\FileBlame.ico"
+FILEBRANCH ICON "icons\FileBranch.ico"
+FILECOMMIT ICON "icons\FileCommit.ico"
+FILEDIFF ICON "icons\FileDiff.ico"
+FILEGRAPH ICON "icons\FileGraph.ico"
+FILELOCK ICON "icons\FileLock.ico"
+FILELOG ICON "icons\FileLog.ico"
+FILEMERGE ICON "icons\FileMerge.ico"
+FILERENAME ICON "icons\FileRename.ico"
+FILEREVERT ICON "icons\FileRevert.ico"
+FILETAG ICON "icons\FileTag.ico"
+FILEUNLOCK ICON "icons\FileUnlock.ico"
+FILEUPDATE ICON "icons\FileUpdate.ico"
+PROPERTIES ICON "icons\Properties.ico"
+REPOBROWSER ICON "icons\RepoBrowser.ico"
+SANDBOXADD ICON "icons\SandboxAdd.ico"
+SANDBOXBRANCH ICON "icons\SandboxBranch.ico"
+SANDBOXCHECKOUT ICON "icons\SandboxCheckout.ico"
+SANDBOXCOMMIT ICON "icons\SandboxCommit.ico"
+SANDBOXLOCK ICON "icons\SandboxLock.ico"
+SANDBOXLOG ICON "icons\SandboxLog.ico"
+SANDBOXMERGE ICON "icons\SandboxMerge.ico"
+SANDBOXRENAME ICON "icons\SandboxRename.ico"
+SANDBOXREVERT ICON "icons\SandboxRevert.ico"
+SANDBOXTAG ICON "icons\SandboxTag.ico"
+SANDBOXUNLOCK ICON "icons\SandboxUnlock.ico"
+SANDBOXUPDATE ICON "icons\SandboxUpdate.ico"
+STATUS ICON "icons\Status.ico"
\ No newline at end of file
diff --git a/official/1.104/experts/versioncontrol/icons/ContextMenu.ico b/official/1.104/experts/versioncontrol/icons/ContextMenu.ico
new file mode 100644
index 0000000..556df26
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/ContextMenu.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/Explore.ico b/official/1.104/experts/versioncontrol/icons/Explore.ico
new file mode 100644
index 0000000..63b9006
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/Explore.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileAdd.ico b/official/1.104/experts/versioncontrol/icons/FileAdd.ico
new file mode 100644
index 0000000..a0b65df
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileAdd.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileBlame.ico b/official/1.104/experts/versioncontrol/icons/FileBlame.ico
new file mode 100644
index 0000000..2452527
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileBlame.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileBranch.ico b/official/1.104/experts/versioncontrol/icons/FileBranch.ico
new file mode 100644
index 0000000..d2111b0
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileBranch.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileCommit.ico b/official/1.104/experts/versioncontrol/icons/FileCommit.ico
new file mode 100644
index 0000000..82e3c15
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileCommit.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileDiff.ico b/official/1.104/experts/versioncontrol/icons/FileDiff.ico
new file mode 100644
index 0000000..b11102e
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileDiff.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileGraph.ico b/official/1.104/experts/versioncontrol/icons/FileGraph.ico
new file mode 100644
index 0000000..537e136
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileGraph.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileLock.ico b/official/1.104/experts/versioncontrol/icons/FileLock.ico
new file mode 100644
index 0000000..33ce36b
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileLock.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileLog.ico b/official/1.104/experts/versioncontrol/icons/FileLog.ico
new file mode 100644
index 0000000..537e136
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileLog.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileMerge.ico b/official/1.104/experts/versioncontrol/icons/FileMerge.ico
new file mode 100644
index 0000000..b07257c
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileMerge.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileRename.ico b/official/1.104/experts/versioncontrol/icons/FileRename.ico
new file mode 100644
index 0000000..622653f
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileRename.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileRevert.ico b/official/1.104/experts/versioncontrol/icons/FileRevert.ico
new file mode 100644
index 0000000..9ac89f3
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileRevert.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileTag.ico b/official/1.104/experts/versioncontrol/icons/FileTag.ico
new file mode 100644
index 0000000..d2111b0
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileTag.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileUnlock.ico b/official/1.104/experts/versioncontrol/icons/FileUnlock.ico
new file mode 100644
index 0000000..51ae2f6
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileUnlock.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/FileUpdate.ico b/official/1.104/experts/versioncontrol/icons/FileUpdate.ico
new file mode 100644
index 0000000..2ff1987
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/FileUpdate.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/Properties.ico b/official/1.104/experts/versioncontrol/icons/Properties.ico
new file mode 100644
index 0000000..cfd7284
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/Properties.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/RepoBrowser.ico b/official/1.104/experts/versioncontrol/icons/RepoBrowser.ico
new file mode 100644
index 0000000..1e56fa3
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/RepoBrowser.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxAdd.ico b/official/1.104/experts/versioncontrol/icons/SandboxAdd.ico
new file mode 100644
index 0000000..bb66837
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxAdd.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxBranch.ico b/official/1.104/experts/versioncontrol/icons/SandboxBranch.ico
new file mode 100644
index 0000000..798cdcf
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxBranch.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxCheckout.ico b/official/1.104/experts/versioncontrol/icons/SandboxCheckout.ico
new file mode 100644
index 0000000..33eb6eb
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxCheckout.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxCommit.ico b/official/1.104/experts/versioncontrol/icons/SandboxCommit.ico
new file mode 100644
index 0000000..db82aec
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxCommit.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxLock.ico b/official/1.104/experts/versioncontrol/icons/SandboxLock.ico
new file mode 100644
index 0000000..34e6abd
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxLock.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxLog.ico b/official/1.104/experts/versioncontrol/icons/SandboxLog.ico
new file mode 100644
index 0000000..d820033
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxLog.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxMerge.ico b/official/1.104/experts/versioncontrol/icons/SandboxMerge.ico
new file mode 100644
index 0000000..2b283c4
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxMerge.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxRename.ico b/official/1.104/experts/versioncontrol/icons/SandboxRename.ico
new file mode 100644
index 0000000..193dc50
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxRename.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxRevert.ico b/official/1.104/experts/versioncontrol/icons/SandboxRevert.ico
new file mode 100644
index 0000000..b3d035c
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxRevert.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxTag.ico b/official/1.104/experts/versioncontrol/icons/SandboxTag.ico
new file mode 100644
index 0000000..798cdcf
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxTag.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxUnlock.ico b/official/1.104/experts/versioncontrol/icons/SandboxUnlock.ico
new file mode 100644
index 0000000..944f965
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxUnlock.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/SandboxUpdate.ico b/official/1.104/experts/versioncontrol/icons/SandboxUpdate.ico
new file mode 100644
index 0000000..082dfe0
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/SandboxUpdate.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/Status.ico b/official/1.104/experts/versioncontrol/icons/Status.ico
new file mode 100644
index 0000000..c7a54b5
Binary files /dev/null and b/official/1.104/experts/versioncontrol/icons/Status.ico differ
diff --git a/official/1.104/experts/versioncontrol/icons/copyright.txt b/official/1.104/experts/versioncontrol/icons/copyright.txt
new file mode 100644
index 0000000..ab9caf4
--- /dev/null
+++ b/official/1.104/experts/versioncontrol/icons/copyright.txt
@@ -0,0 +1,36 @@
+These icons are copyrighted by DryIcons (http://dryicons.com/) and distributed subjecting to the agreements of the DryIcons Free License (http://dryicons.com/terms/#free-license)
+
+DryIcons Free License Agreement
+
+Read Full Legal Code
+
+DryIcons is a service provided by our team of enthusiastic graphic and web designers and programmers. The purpose of this service is to provide only high-quality, free icons and free icon sets, as well as free vector graphics to the general public, with a specific target to designers, software and web developers.
+All DryIcons' Works (meaning "icons, icon sets and graphics") are free of charge, but please read further under what Terms and Conditions.
+All DryIcons Works are licensed under a DryIcons Free License. This means that you can use our icons, icon sets and graphics in any publicly accessible web site, web application or any form of presentation publicly accessible through the World Wide Web only according to the DryIcons Free License Terms and Conditions:
+
+ * You must put a back link with credits to http://dryicons.com on every page where DryIcons' Works are used (example: Icons by DryIcons);
+ * You must include the correct back link to DryIcons website, which is: http://dryicons.com;
+ * You must place the link on an easy-to-see, recognizable place, so there is no confusion about the Original Author of the Works (DryIcons);
+ * When copying, or paraphrasing description text (or title) on one of the Works, you must make sure there are no spelling mistakes;
+ * Do not try to take credit or imply in any way that you and not DryIcons is the Original Author of the Licensed Material (icons, icon sets and graphics).
+
+What you CAN DO:
+
+ 1. All DryIcons' Works are being provided to You under the Terms of this agreement, which allows for use of our Works but does not transfer ownership. All DryIcons' Works remain property of DryIcons;
+ 2. You may use DryIcons' Works in any personal or commercial project unlimited number of times according to the DryIcons Free License Terms and Conditions;
+ 3. You may use DryIcons' Works in any Open Source project and application according to the DryIcons Free License Terms and Conditions;
+ 4. Your rights to DryIcons' Works are worldwide and for the duration of DryIcons' rights in the Works;
+ 5. Any uses other than the ones mentioned above must be approved by DryIcons in writing;
+ 6. Unauthorized use will result in immediate termination of this License, and with it, your rights to use DryIcons' Works.
+
+What you CAN NOT DO:
+
+ 1. You may not alter, crop, modify, manipulate and create derivative works of DryIcons' Works. All Works must be used "AS IS";
+ 2. You may not redistribute, license, sell, lease, assign, convey or transfer DryIcons' Works, or offer free downloads in their present form or in a modified form to any third party;
+ 3. You may not distribute the DryIcons' Works (icons, icon sets and graphics) online in a downloadable format or enable them to be distributed via mobile devices. You may link to http://dryicons.com instead;
+ 4. You may not incorporate DryIcons' Works into a logo, trademark or service mark;
+ 5. You may not use DryIcons' Works directly from dryicons.com or any other location hosted on the dryicons.com domain or any other domain owned by DryIcons.
+
+Copyright
+
+ 1. DryIcons.com reserves the copyrights and ownership rights of all DryIcons' Works downloaded from this website. We reserve the right to change parts of this License without notice and at our sole discretion.
diff --git a/official/1.104/experts/versioncontrol/icons/dirinfo.txt b/official/1.104/experts/versioncontrol/icons/dirinfo.txt
new file mode 100644
index 0000000..cc0b098
--- /dev/null
+++ b/official/1.104/experts/versioncontrol/icons/dirinfo.txt
@@ -0,0 +1 @@
+This is the place where version control icons reside.
\ No newline at end of file
diff --git a/official/1.104/include/zconf.h b/official/1.104/include/zconf.h
new file mode 100644
index 0000000..a77d061
--- /dev/null
+++ b/official/1.104/include/zconf.h
@@ -0,0 +1,332 @@
+/* zconf.h -- configuration of the zlib compression library
+ * Copyright (C) 1995-2005 Jean-loup Gailly.
+ * For conditions of distribution and use, see copyright notice in zlib.h
+ */
+
+/* @(#) $Id: zconf.h 1725 2006-08-11 14:57:53Z outchy $ */
+
+#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 deflateParams z_deflateParams
+# define deflateBound z_deflateBound
+# define deflatePrime z_deflatePrime
+# 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 inflateBack z_inflateBack
+# define inflateBackEnd z_inflateBackEnd
+# 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 zError z_zError
+
+# define alloc_func z_alloc_func
+# define free_func z_free_func
+# define in_func z_in_func
+# define out_func z_out_func
+# 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_WCE) || defined(__WIN32__)
+# ifndef WIN32
+# define WIN32
+# endif
+#endif
+#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32)
+# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__)
+# ifndef SYS16BIT
+# define SYS16BIT
+# endif
+# endif
+#endif
+
+/*
+ * Compile with -DMAXSEG_64K if the alloc function cannot allocate more
+ * than 64k bytes at a time (needed on systems with 16-bit int).
+ */
+#ifdef SYS16BIT
+# define MAXSEG_64K
+#endif
+#ifdef MSDOS
+# define UNALIGNED_OK
+#endif
+
+#ifdef __STDC_VERSION__
+# ifndef STDC
+# define STDC
+# endif
+# if __STDC_VERSION__ >= 199901L
+# ifndef STDC99
+# define STDC99
+# endif
+# endif
+#endif
+#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32))
+# define STDC
+#endif
+#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__))
+# define STDC
+#endif
+
+#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */
+# define STDC
+#endif
+
+#ifndef STDC
+# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */
+# define const /* note: need a more gentle solution here */
+# endif
+#endif
+
+/* Some Mac compilers merge all .h files incorrectly: */
+#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__)
+# define NO_DUMMY_DECL
+#endif
+
+/* Maximum value for memLevel in deflateInit2 */
+#ifndef MAX_MEM_LEVEL
+# ifdef MAXSEG_64K
+# define MAX_MEM_LEVEL 8
+# else
+# define MAX_MEM_LEVEL 9
+# endif
+#endif
+
+/* Maximum value for windowBits in deflateInit2 and inflateInit2.
+ * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files
+ * created by gzip. (Files created by minigzip can still be extracted by
+ * gzip.)
+ */
+#ifndef MAX_WBITS
+# define MAX_WBITS 15 /* 32K LZ77 window */
+#endif
+
+/* The memory requirements for deflate are (in bytes):
+ (1 << (windowBits+2)) + (1 << (memLevel+9))
+ that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values)
+ plus a few kilobytes for small objects. For example, if you want to reduce
+ the default memory requirements from 256K to 128K, compile with
+ make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7"
+ Of course this will generally degrade compression (there's no free lunch).
+
+ The memory requirements for inflate are (in bytes) 1 << windowBits
+ that is, 32K for windowBits=15 (default value) plus a few kilobytes
+ for small objects.
+*/
+
+ /* Type declarations */
+
+#ifndef OF /* function prototypes */
+# ifdef STDC
+# define OF(args) args
+# else
+# define OF(args) ()
+# endif
+#endif
+
+/* The following definitions for FAR are needed only for MSDOS mixed
+ * model programming (small or medium model with some far allocations).
+ * This was tested only with MSC; for other MSDOS compilers you may have
+ * to define NO_MEMCPY in zutil.h. If you don't need the mixed model,
+ * just define FAR to be empty.
+ */
+#ifdef SYS16BIT
+# if defined(M_I86SM) || defined(M_I86MM)
+ /* MSC small or medium model */
+# define SMALL_MEDIUM
+# ifdef _MSC_VER
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+# if (defined(__SMALL__) || defined(__MEDIUM__))
+ /* Turbo C small or medium model */
+# define SMALL_MEDIUM
+# ifdef __BORLANDC__
+# define FAR _far
+# else
+# define FAR far
+# endif
+# endif
+#endif
+
+#if defined(WINDOWS) || defined(WIN32)
+ /* If building or using zlib as a DLL, define ZLIB_DLL.
+ * This is not mandatory, but it offers a little performance increase.
+ */
+# ifdef ZLIB_DLL
+# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500))
+# ifdef ZLIB_INTERNAL
+# define ZEXTERN extern __declspec(dllexport)
+# else
+# define ZEXTERN extern __declspec(dllimport)
+# endif
+# endif
+# endif /* ZLIB_DLL */
+ /* If building or using zlib with the WINAPI/WINAPIV calling convention,
+ * define ZLIB_WINAPI.
+ * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI.
+ */
+# ifdef ZLIB_WINAPI
+# ifdef FAR
+# undef FAR
+# endif
+# include
+ /* No need for _export, use ZLIB.DEF instead. */
+ /* For complete Windows compatibility, use WINAPI, not __stdcall. */
+# define ZEXPORT WINAPI
+# ifdef WIN32
+# define ZEXPORTVA WINAPIV
+# else
+# define ZEXPORTVA FAR CDECL
+# endif
+# endif
+#endif
+
+#if defined (__BEOS__)
+# ifdef ZLIB_DLL
+# ifdef ZLIB_INTERNAL
+# define ZEXPORT __declspec(dllexport)
+# define ZEXPORTVA __declspec(dllexport)
+# else
+# define ZEXPORT __declspec(dllimport)
+# define ZEXPORTVA __declspec(dllimport)
+# endif
+# endif
+#endif
+
+#ifndef ZEXTERN
+# define ZEXTERN extern
+#endif
+#ifndef ZEXPORT
+# define ZEXPORT
+#endif
+#ifndef ZEXPORTVA
+# define ZEXPORTVA
+#endif
+
+#ifndef FAR
+# define FAR
+#endif
+
+#if !defined(__MACTYPES__)
+typedef unsigned char Byte; /* 8 bits */
+#endif
+typedef unsigned int uInt; /* 16 bits or more */
+typedef unsigned long uLong; /* 32 bits or more */
+
+#ifdef SMALL_MEDIUM
+ /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */
+# define Bytef Byte FAR
+#else
+ typedef Byte FAR Bytef;
+#endif
+typedef char FAR charf;
+typedef int FAR intf;
+typedef uInt FAR uIntf;
+typedef uLong FAR uLongf;
+
+#ifdef STDC
+ typedef void const *voidpc;
+ typedef void FAR *voidpf;
+ typedef void *voidp;
+#else
+ typedef Byte const *voidpc;
+ typedef Byte FAR *voidpf;
+ typedef Byte *voidp;
+#endif
+
+#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.104/include/zlib.h b/official/1.104/include/zlib.h
new file mode 100644
index 0000000..62d0e46
--- /dev/null
+++ b/official/1.104/include/zlib.h
@@ -0,0 +1,1357 @@
+/* zlib.h -- interface of the 'zlib' general purpose compression library
+ version 1.2.3, July 18th, 2005
+
+ Copyright (C) 1995-2005 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.3"
+#define ZLIB_VERNUM 0x1230
+
+/*
+ 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 default by the in-memory functions is
+ the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped
+ around a deflate stream, which is itself documented in RFC 1951.
+
+ The library also supports reading and writing files in gzip (.gz) format
+ with an interface similar to that of stdio using the functions that start
+ with "gz". The gzip format is different from the zlib format. gzip is a
+ gzip wrapper, documented in RFC 1952, wrapped around a deflate stream.
+
+ This library can optionally read and write gzip streams in memory as well.
+
+ The zlib format was designed to be compact and fast for use in memory
+ and on communications channels. The gzip format was designed for single-
+ file compression on file systems, has a larger header than zlib to maintain
+ directory information, and uses a different, slower check method than zlib.
+
+ The library does not install any signal handler. The decoder checks
+ the consistency of the compressed data, so the library should never
+ crash even in case of corrupted input.
+*/
+
+typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size));
+typedef void (*free_func) OF((voidpf opaque, voidpf address));
+
+struct internal_state;
+
+typedef struct z_stream_s {
+ Bytef *next_in; /* next input byte */
+ uInt avail_in; /* number of bytes available at next_in */
+ uLong total_in; /* total nb of input bytes read so far */
+
+ Bytef *next_out; /* next output byte should be put there */
+ uInt avail_out; /* remaining free space at next_out */
+ uLong total_out; /* total nb of bytes output so far */
+
+ char *msg; /* last error message, NULL if no error */
+ struct internal_state FAR *state; /* not visible by applications */
+
+ alloc_func zalloc; /* used to allocate the internal state */
+ free_func zfree; /* used to free the internal state */
+ voidpf opaque; /* private data object passed to zalloc and zfree */
+
+ int data_type; /* best guess about the data type: binary or text */
+ uLong adler; /* adler32 value of the uncompressed data */
+ uLong reserved; /* reserved for future use */
+} z_stream;
+
+typedef z_stream FAR *z_streamp;
+
+/*
+ gzip header information passed to and from zlib routines. See RFC 1952
+ for more details on the meanings of these fields.
+*/
+typedef struct gz_header_s {
+ int text; /* true if compressed data believed to be text */
+ uLong time; /* modification time */
+ int xflags; /* extra flags (not used when writing a gzip file) */
+ int os; /* operating system */
+ Bytef *extra; /* pointer to extra field or Z_NULL if none */
+ uInt extra_len; /* extra field length (valid if extra != Z_NULL) */
+ uInt extra_max; /* space at extra (only when reading header) */
+ Bytef *name; /* pointer to zero-terminated file name or Z_NULL */
+ uInt name_max; /* space at name (only when reading header) */
+ Bytef *comment; /* pointer to zero-terminated comment or Z_NULL */
+ uInt comm_max; /* space at comment (only when reading header) */
+ int hcrc; /* true if there was or will be a header crc */
+ int done; /* true when done reading gzip header (not used
+ when writing a gzip file) */
+} gz_header;
+
+typedef gz_header FAR *gz_headerp;
+
+/*
+ The application must update next_in and avail_in when avail_in has
+ dropped to zero. It must update next_out and avail_out when avail_out
+ has dropped to zero. The application must initialize zalloc, zfree and
+ opaque before calling the init function. All other fields are set by the
+ compression library and must not be updated by the application.
+
+ The opaque value provided by the application will be passed as the first
+ parameter for calls of zalloc and zfree. This can be useful for custom
+ memory management. The compression library attaches no meaning to the
+ opaque value.
+
+ zalloc must return Z_NULL if there is not enough memory for the object.
+ If zlib is used in a multi-threaded application, zalloc and zfree must be
+ thread safe.
+
+ On 16-bit systems, the functions zalloc and zfree must be able to allocate
+ exactly 65536 bytes, but will not be required to allocate more than this
+ if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS,
+ pointers returned by zalloc for objects of exactly 65536 bytes *must*
+ have their offset normalized to zero. The default allocation function
+ provided by this library ensures this (see zutil.c). To reduce memory
+ requirements and avoid any allocation of 64K objects, at the expense of
+ compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h).
+
+ The fields total_in and total_out can be used for statistics or
+ progress reports. After compression, total_in holds the total size of
+ the uncompressed data and may be saved for use in the decompressor
+ (particularly if the decompressor wants to decompress everything in
+ a single step).
+*/
+
+ /* constants */
+
+#define Z_NO_FLUSH 0
+#define Z_PARTIAL_FLUSH 1 /* 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_FIXED 4
+#define Z_DEFAULT_STRATEGY 0
+/* compression strategy; see deflateInit2() below for details */
+
+#define Z_BINARY 0
+#define Z_TEXT 1
+#define Z_ASCII Z_TEXT /* for compatibility with 1.2.2 and earlier */
+#define Z_UNKNOWN 2
+/* Possible values of the data_type field (though see inflate()) */
+
+#define Z_DEFLATED 8
+/* The deflate compression method (the only one supported in this version) */
+
+#define Z_NULL 0 /* for initializing zalloc, zfree, opaque */
+
+#define zlib_version zlibVersion()
+/* for compatibility with versions < 1.0.2 */
+
+ /* basic functions */
+
+ZEXTERN const char * ZEXPORT zlibVersion OF((void));
+/* The application can compare zlibVersion and ZLIB_VERSION for consistency.
+ If the first character differs, the library code actually used is
+ not compatible with the zlib.h header file used by the application.
+ This check is automatically made by deflateInit and inflateInit.
+ */
+
+/*
+ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level));
+
+ Initializes the internal stream state for compression. The fields
+ zalloc, zfree and opaque must be initialized before by the caller.
+ If zalloc and zfree are set to Z_NULL, deflateInit updates them to
+ use default allocation functions.
+
+ The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9:
+ 1 gives best speed, 9 gives best compression, 0 gives no compression at
+ all (the input data is simply copied a block at a time).
+ Z_DEFAULT_COMPRESSION requests a default compromise between speed and
+ compression (currently equivalent to level 6).
+
+ deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not
+ enough memory, Z_STREAM_ERROR if level is not a valid compression level,
+ Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible
+ with the version assumed by the caller (ZLIB_VERSION).
+ msg is set to null if there is no error message. deflateInit does not
+ perform any compression: this will be done by deflate().
+*/
+
+
+ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush));
+/*
+ deflate compresses as much data as possible, and stops when the input
+ buffer becomes empty or the output buffer becomes full. It may introduce some
+ output latency (reading input without producing any output) except when
+ forced to flush.
+
+ The detailed semantics are as follows. deflate performs one or both of the
+ following actions:
+
+ - Compress more input starting at next_in and update next_in and avail_in
+ accordingly. If not all input can be processed (because there is not
+ enough room in the output buffer), next_in and avail_in are updated and
+ processing will resume at this point for the next call of deflate().
+
+ - Provide more output starting at next_out and update next_out and avail_out
+ accordingly. This action is forced if the parameter flush is non zero.
+ Forcing flush frequently degrades the compression ratio, so this parameter
+ should be set only when necessary (in interactive applications).
+ Some output may be provided even if flush is not set.
+
+ Before the call of deflate(), the application should ensure that at least
+ one of the actions is possible, by providing more input and/or consuming
+ more output, and updating avail_in or avail_out accordingly; avail_out
+ should never be zero before the call. The application can consume the
+ compressed output when it wants, for example when the output buffer is full
+ (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK
+ and with zero avail_out, it must be called again after making room in the
+ output buffer because there might be more output pending.
+
+ Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to
+ decide how much data to accumualte before producing output, in order to
+ maximize compression.
+
+ If the parameter flush is set to Z_SYNC_FLUSH, all pending output is
+ flushed to the output buffer and the output is aligned on a byte boundary, so
+ that the decompressor can get all input data available so far. (In particular
+ avail_in is zero after the call if enough output space has been provided
+ before the call.) Flushing may degrade compression for some compression
+ algorithms and so it should be used only when necessary.
+
+ If flush is set to Z_FULL_FLUSH, all output is flushed as with
+ Z_SYNC_FLUSH, and the compression state is reset so that decompression can
+ restart from this point if previous compressed data has been damaged or if
+ random access is desired. Using Z_FULL_FLUSH too often can seriously degrade
+ compression.
+
+ If deflate returns with avail_out == 0, this function must be called again
+ with the same value of the flush parameter and more output space (updated
+ avail_out), until the flush is complete (deflate returns with non-zero
+ avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that
+ avail_out is greater than six to avoid repeated flush markers due to
+ avail_out == 0 on return.
+
+ If the parameter flush is set to Z_FINISH, pending input is processed,
+ pending output is flushed and deflate returns with Z_STREAM_END if there
+ was enough output space; if deflate returns with Z_OK, this function must be
+ called again with Z_FINISH and more output space (updated avail_out) but no
+ more input data, until it returns with Z_STREAM_END or an error. After
+ deflate has returned Z_STREAM_END, the only possible operations on the
+ stream are deflateReset or deflateEnd.
+
+ Z_FINISH can be used immediately after deflateInit if all the compression
+ is to be done in a single step. In this case, avail_out must be at least
+ the value returned by deflateBound (see below). If deflate does not return
+ Z_STREAM_END, then it must be called again as described above.
+
+ deflate() sets strm->adler to the adler32 checksum of all input read
+ so far (that is, total_in bytes).
+
+ deflate() may update strm->data_type if it can make a good guess about
+ the input data type (Z_BINARY or Z_TEXT). In doubt, the data is considered
+ binary. This field is only for information purposes and does not affect
+ the compression algorithm in any manner.
+
+ deflate() returns Z_OK if some progress has been made (more input
+ processed or more output produced), Z_STREAM_END if all input has been
+ consumed and all output has been produced (only when flush is set to
+ Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example
+ if next_in or next_out was 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 gets to the next deflate block boundary. When decoding the
+ zlib or gzip format, this will cause inflate() to return immediately after
+ the header and before the first block. When doing a raw inflate, inflate()
+ will go ahead and process the first block, and will return when it gets to
+ the end of that block, or when it runs out of data.
+
+ The Z_BLOCK option assists in appending to or combining deflate streams.
+ Also to assist in this, on return inflate() will set strm->data_type to the
+ number of unused bits in the last byte taken from strm->next_in, plus 64
+ if inflate() is currently decoding the last block in the deflate stream,
+ plus 128 if inflate() returned immediately after decoding an end-of-block
+ code or decoding the complete header up to just before the first byte of the
+ deflate stream. The end-of-block will not be indicated until all of the
+ uncompressed data from that block has been written to strm->next_out. The
+ number of unused bits may in general be greater than seven, except when
+ bit 7 of data_type is set, in which case the number of unused bits will be
+ less than eight.
+
+ 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). If a
+ gzip stream is being written, strm->adler is a crc32 instead of an adler32.
+
+ The memLevel parameter specifies how much memory should be allocated
+ for the internal compression state. memLevel=1 uses minimum memory but
+ is slow and reduces compression ratio; memLevel=9 uses maximum memory
+ for optimal speed. The default value is 8. See zconf.h for total memory
+ usage as a function of windowBits and memLevel.
+
+ The strategy parameter is used to tune the compression algorithm. Use the
+ value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a
+ filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no
+ string match), or Z_RLE to limit match distances to one (run-length
+ encoding). Filtered data consists mostly of small values with a somewhat
+ random distribution. In this case, the compression algorithm is tuned to
+ compress them better. The effect of Z_FILTERED is to force more Huffman
+ coding and less string matching; it is somewhat intermediate between
+ Z_DEFAULT and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as fast as
+ Z_HUFFMAN_ONLY, but give better compression for PNG image data. The strategy
+ parameter only affects the compression ratio but not the correctness of the
+ compressed output even if it is not set appropriately. Z_FIXED prevents the
+ use of dynamic Huffman codes, allowing for a simpler decoder for special
+ applications.
+
+ deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_STREAM_ERROR if 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. In addition, the
+ current implementation of deflate will use at most the window size minus
+ 262 bytes of the provided dictionary.
+
+ Upon return of this function, strm->adler is set to the adler32 value
+ of the dictionary; the decompressor may later use this value to determine
+ which dictionary has been used by the compressor. (The adler32 value
+ applies to the whole dictionary even if only a subset of the dictionary is
+ actually used by the compressor.) If a raw deflate was requested, then the
+ adler32 value is not computed and strm->adler is not set.
+
+ deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a
+ parameter is invalid (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 int ZEXPORT deflateTune OF((z_streamp strm,
+ int good_length,
+ int max_lazy,
+ int nice_length,
+ int max_chain));
+/*
+ Fine tune deflate's internal compression parameters. This should only be
+ used by someone who understands the algorithm used by zlib's deflate for
+ searching for the best matching string, and even then only by the most
+ fanatic optimizer trying to squeeze out the last compressed bit for their
+ specific input data. Read the deflate.c source code for the meaning of the
+ max_lazy, good_length, nice_length, and max_chain parameters.
+
+ deflateTune() can be called after deflateInit() or deflateInit2(), and
+ returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream.
+ */
+
+ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm,
+ uLong sourceLen));
+/*
+ deflateBound() returns an upper bound on the compressed size after
+ deflation of sourceLen bytes. It must be called after deflateInit()
+ or deflateInit2(). This would be used to allocate an output buffer
+ for deflation in a single pass, and so would be called before deflate().
+*/
+
+ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm,
+ int bits,
+ int value));
+/*
+ deflatePrime() inserts bits in the deflate output stream. The intent
+ is that this function is used to start off the deflate output with the
+ bits leftover from a previous deflate stream when appending to it. As such,
+ this function can only be used for raw deflate, and must be used before the
+ first deflate() call after a deflateInit2() or deflateReset(). bits must be
+ less than or equal to 16, and that many of the least significant bits of
+ value will be inserted in the output.
+
+ deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm,
+ gz_headerp head));
+/*
+ deflateSetHeader() provides gzip header information for when a gzip
+ stream is requested by deflateInit2(). deflateSetHeader() may be called
+ after deflateInit2() or deflateReset() and before the first call of
+ deflate(). The text, time, os, extra field, name, and comment information
+ in the provided gz_header structure are written to the gzip header (xflag is
+ ignored -- the extra flags are set according to the compression level). The
+ caller must assure that, if not Z_NULL, name and comment are terminated with
+ a zero byte, and that if extra is not Z_NULL, that extra_len bytes are
+ available there. If hcrc is true, a gzip header crc is included. Note that
+ the current versions of the command-line version of gzip (up through version
+ 1.3.x) do not support header crc's, and will report that it is a "multi-part
+ gzip file" and give up.
+
+ If deflateSetHeader is not used, the default gzip header has text false,
+ the time set to zero, and os set to 255, with no extra, name, or comment
+ fields. The gzip header is returned to the default state by deflateReset().
+
+ deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+/*
+ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm,
+ int windowBits));
+
+ This is another version of inflateInit with an extra parameter. The
+ fields next_in, avail_in, zalloc, zfree and opaque must be initialized
+ before by the caller.
+
+ The windowBits parameter is the base two logarithm of the maximum window
+ size (the size of the history buffer). It should be in the range 8..15 for
+ this version of the library. The default value is 15 if inflateInit is used
+ instead. windowBits must be greater than or equal to the windowBits value
+ provided to deflateInit2() while compressing, or it must be equal to 15 if
+ deflateInit2() was not used. If a compressed stream with a larger window
+ size is given as input, inflate() will return with the error code
+ Z_DATA_ERROR instead of trying to allocate a larger window.
+
+ windowBits can also be -8..-15 for raw inflate. In this case, -windowBits
+ determines the window size. inflate() will then process raw deflate data,
+ not looking for a zlib or gzip header, not generating a check value, and not
+ looking for any check values for comparison at the end of the stream. This
+ is for use with other formats that use the deflate compressed data format
+ such as zip. Those formats provide their own check values. If a custom
+ format is developed using the raw deflate format for compressed data, it is
+ recommended that a check value such as an adler32 or a crc32 be applied to
+ the uncompressed data as is done in the zlib, gzip, and zip formats. For
+ most applications, the zlib format should be used as is. Note that comments
+ above on the use in deflateInit2() applies to the magnitude of windowBits.
+
+ windowBits can also be greater than 15 for optional gzip decoding. Add
+ 32 to windowBits to enable zlib and gzip decoding with automatic header
+ detection, or add 16 to decode only the gzip format (the zlib format will
+ return a Z_DATA_ERROR). If a gzip stream is being decoded, strm->adler is
+ a crc32 instead of an adler32.
+
+ inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
+ memory, Z_STREAM_ERROR if a parameter is invalid (such as a null strm). 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 that call returned Z_NEED_DICT. The dictionary chosen by the compressor
+ can be determined from the adler32 value returned by that call of inflate.
+ The compressor and decompressor must use exactly the same dictionary (see
+ deflateSetDictionary). For raw inflate, this function can be called
+ immediately after inflateInit2() or inflateReset() and before any call of
+ inflate() to set the dictionary. The application must insure that the
+ dictionary that was used for compression is provided.
+
+ inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a
+ parameter is invalid (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 inflatePrime OF((z_streamp strm,
+ int bits,
+ int value));
+/*
+ This function inserts bits in the inflate input stream. The intent is
+ that this function is used to start inflating at a bit position in the
+ middle of a byte. The provided bits will be used before any bytes are used
+ from next_in. This function should only be used with raw inflate, and
+ should be used before the first inflate() call after inflateInit2() or
+ inflateReset(). bits must be less than or equal to 16, and that many of the
+ least significant bits of value will be inserted in the input.
+
+ inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm,
+ gz_headerp head));
+/*
+ inflateGetHeader() requests that gzip header information be stored in the
+ provided gz_header structure. inflateGetHeader() may be called after
+ inflateInit2() or inflateReset(), and before the first call of inflate().
+ As inflate() processes the gzip stream, head->done is zero until the header
+ is completed, at which time head->done is set to one. If a zlib stream is
+ being decoded, then head->done is set to -1 to indicate that there will be
+ no gzip header information forthcoming. Note that Z_BLOCK can be used to
+ force inflate() to return immediately after header processing is complete
+ and before any actual data is decompressed.
+
+ The text, time, xflags, and os fields are filled in with the gzip header
+ contents. hcrc is set to true if there is a header CRC. (The header CRC
+ was valid if done is set to one.) If extra is not Z_NULL, then extra_max
+ contains the maximum number of bytes to write to extra. Once done is true,
+ extra_len contains the actual extra field length, and extra contains the
+ extra field, or that field truncated if extra_max is less than extra_len.
+ If name is not Z_NULL, then up to name_max characters are written there,
+ terminated with a zero unless the length is greater than name_max. If
+ comment is not Z_NULL, then up to comm_max characters are written there,
+ terminated with a zero unless the length is greater than comm_max. When
+ any of extra, name, or comment are not Z_NULL and the respective field is
+ not present in the header, then that field is set to Z_NULL to signal its
+ absence. This allows the use of deflateSetHeader() with the returned
+ structure to duplicate the header. However if those fields are set to
+ allocated memory, then the application will need to save those pointers
+ elsewhere so that they can be eventually freed.
+
+ If inflateGetHeader is not used, then the header information is simply
+ discarded. The header is always checked for validity, including the header
+ CRC if present. inflateReset() will reset the process to discard the header
+ information. The application would need to call inflateGetHeader() again to
+ retrieve the header from the next gzip stream.
+
+ inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source
+ stream state was inconsistent.
+*/
+
+/*
+ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits,
+ unsigned char FAR *window));
+
+ Initialize the internal stream state for decompression using inflateBack()
+ calls. The fields zalloc, zfree and opaque in strm must be initialized
+ before the call. If zalloc and zfree are Z_NULL, then the default library-
+ derived memory allocation routines are used. windowBits is the base two
+ logarithm of the window size, in the range 8..15. window is a caller
+ supplied buffer of that size. Except for special applications where it is
+ assured that deflate was used with small window sizes, windowBits must be 15
+ and a 32K byte window must be supplied to be able to decompress general
+ deflate streams.
+
+ See inflateBack() for the usage of these routines.
+
+ inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of
+ the paramaters are invalid, Z_MEM_ERROR if the internal state could not
+ be allocated, or Z_VERSION_ERROR if the version of the library does not
+ match the version of the header file.
+*/
+
+typedef unsigned (*in_func) OF((void FAR *, unsigned char FAR * FAR *));
+typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned));
+
+ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm,
+ in_func in, void FAR *in_desc,
+ out_func out, void FAR *out_desc));
+/*
+ inflateBack() does a raw inflate with a single call using a call-back
+ interface for input and output. This is more efficient than inflate() for
+ file i/o applications in that it avoids copying between the output and the
+ sliding window by simply making the window itself the output buffer. This
+ function trusts the application to not change the output buffer passed by
+ the output function, at least until inflateBack() returns.
+
+ inflateBackInit() must be called first to allocate the internal state
+ and to initialize the state with the user-provided window buffer.
+ inflateBack() may then be used multiple times to inflate a complete, raw
+ deflate stream with each call. inflateBackEnd() is then called to free
+ the allocated state.
+
+ A raw deflate stream is one with no zlib or gzip header or trailer.
+ This routine would normally be used in a utility that reads zip or gzip
+ files and writes out uncompressed files. The utility would decode the
+ header and process the trailer on its own, hence this routine expects
+ only the raw deflate stream to decompress. This is different from the
+ normal behavior of inflate(), which expects either a zlib or gzip header and
+ trailer around the deflate stream.
+
+ inflateBack() uses two subroutines supplied by the caller that are then
+ called by inflateBack() for input and output. inflateBack() calls those
+ routines until it reads a complete deflate stream and writes out all of the
+ uncompressed data, or until it encounters an error. The function's
+ parameters and return types are defined above in the in_func and out_func
+ typedefs. inflateBack() will call in(in_desc, &buf) which should return the
+ number of bytes of provided input, and a pointer to that input in buf. If
+ there is no input available, in() must return zero--buf is ignored in that
+ case--and inflateBack() will return a buffer error. inflateBack() will call
+ out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out()
+ should return zero on success, or non-zero on failure. If out() returns
+ non-zero, inflateBack() will return with an error. Neither in() nor out()
+ are permitted to change the contents of the window provided to
+ inflateBackInit(), which is also the buffer that out() uses to write from.
+ The length written by out() will be at most the window size. Any non-zero
+ amount of input may be provided by in().
+
+ For convenience, inflateBack() can be provided input on the first call by
+ setting strm->next_in and strm->avail_in. If that input is exhausted, then
+ in() will be called. Therefore strm->next_in must be initialized before
+ calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called
+ immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in
+ must also be initialized, and then if strm->avail_in is not zero, input will
+ initially be taken from strm->next_in[0 .. strm->avail_in - 1].
+
+ The in_desc and out_desc parameters of inflateBack() is passed as the
+ first parameter of in() and out() respectively when they are called. These
+ descriptors can be optionally used to pass any information that the caller-
+ supplied in() and out() functions need to do their job.
+
+ On return, inflateBack() will set strm->next_in and strm->avail_in to
+ pass back any unused input that was provided by the last in() call. The
+ return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR
+ if in() or out() returned an error, Z_DATA_ERROR if there was a format
+ error in the deflate stream (in which case strm->msg is set to indicate the
+ nature of the error), or Z_STREAM_ERROR if the stream was not properly
+ initialized. In the case of Z_BUF_ERROR, an input or output error can be
+ distinguished using strm->next_in which will be Z_NULL only if in() returned
+ an error. If strm->next is not Z_NULL, then the Z_BUF_ERROR was due to
+ out() returning non-zero. (in() will always be called before out(), so
+ strm->next_in is assured to be defined if out() returns non-zero.) Note
+ that inflateBack() cannot return Z_OK.
+*/
+
+ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm));
+/*
+ All memory allocated by inflateBackInit() is freed.
+
+ inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream
+ state was inconsistent.
+*/
+
+ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void));
+/* Return flags indicating compile-time options.
+
+ Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other:
+ 1.0: size of uInt
+ 3.2: size of uLong
+ 5.4: size of voidpf (pointer)
+ 7.6: size of z_off_t
+
+ Compiler, assembler, and debug options:
+ 8: DEBUG
+ 9: ASMV or ASMINF -- use ASM code
+ 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention
+ 11: 0 (reserved)
+
+ One-time table building (smaller code, but not thread-safe if true):
+ 12: BUILDFIXED -- build static block decoding tables when needed
+ 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed
+ 14,15: 0 (reserved)
+
+ Library content (indicates missing functionality):
+ 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking
+ deflate code when not needed)
+ 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect
+ and decode gzip streams (to avoid linking crc code)
+ 18-19: 0 (reserved)
+
+ Operation variations (changes in library functionality):
+ 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate
+ 21: FASTEST -- deflate algorithm with only one, lowest compression level
+ 22,23: 0 (reserved)
+
+ The sprintf variant used by gzprintf (zero is best):
+ 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format
+ 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure!
+ 26: 0 = returns value, 1 = void -- 1 means inferred string length returned
+
+ Remainder:
+ 27-31: 0 (reserved)
+ */
+
+
+ /* utility functions */
+
+/*
+ The following utility functions are implemented on top of the
+ basic stream-oriented functions. To simplify the interface, some
+ default options are assumed (compression level and memory usage,
+ standard memory allocation functions). The source code of these
+ utility functions can 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 gzdirect OF((gzFile file));
+/*
+ Returns 1 if file is being read directly without decompression, 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 adler32_combine OF((uLong adler1, uLong adler2,
+ z_off_t len2));
+/*
+ Combine two Adler-32 checksums into one. For two sequences of bytes, seq1
+ and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for
+ each, adler1 and adler2. adler32_combine() returns the Adler-32 checksum of
+ seq1 and seq2 concatenated, requiring only adler1, adler2, and len2.
+*/
+
+ZEXTERN uLong ZEXPORT crc32 OF((uLong crc, const Bytef *buf, uInt len));
+/*
+ Update a running CRC-32 with the bytes buf[0..len-1] and return the
+ updated CRC-32. If buf is NULL, this function returns the required initial
+ value for the for the crc. Pre- and post-conditioning (one's complement) is
+ performed within this function so it shouldn't be done by the application.
+ Usage example:
+
+ uLong crc = crc32(0L, Z_NULL, 0);
+
+ while (read_buffer(buffer, length) != EOF) {
+ crc = crc32(crc, buffer, length);
+ }
+ if (crc != original_crc) error();
+*/
+
+ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2));
+
+/*
+ Combine two CRC-32 check values into one. For two sequences of bytes,
+ seq1 and seq2 with lengths len1 and len2, CRC-32 check values were
+ calculated for each, crc1 and crc2. crc32_combine() returns the CRC-32
+ check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and
+ len2.
+*/
+
+
+ /* various hacks, don't look :) */
+
+/* deflateInit and inflateInit are macros to allow checking the zlib version
+ * and the compiler's view of z_stream:
+ */
+ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level,
+ const char *version, int stream_size));
+ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm,
+ const char *version, int stream_size));
+ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int level, int method,
+ int windowBits, int memLevel,
+ int strategy, const char *version,
+ int stream_size));
+ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int windowBits,
+ const char *version, int stream_size));
+ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits,
+ unsigned char FAR *window,
+ const char *version,
+ int stream_size));
+#define deflateInit(strm, level) \
+ deflateInit_((strm), (level), ZLIB_VERSION, sizeof(z_stream))
+#define inflateInit(strm) \
+ inflateInit_((strm), ZLIB_VERSION, sizeof(z_stream))
+#define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \
+ deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\
+ (strategy), ZLIB_VERSION, sizeof(z_stream))
+#define inflateInit2(strm, windowBits) \
+ inflateInit2_((strm), (windowBits), ZLIB_VERSION, sizeof(z_stream))
+#define inflateBackInit(strm, windowBits, window) \
+ inflateBackInit_((strm), (windowBits), (window), \
+ ZLIB_VERSION, sizeof(z_stream))
+
+
+#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));
+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.104/include/zutil.h b/official/1.104/include/zutil.h
new file mode 100644
index 0000000..76842af
--- /dev/null
+++ b/official/1.104/include/zutil.h
@@ -0,0 +1,269 @@
+/* zutil.h -- internal interface and configuration of the compression library
+ * Copyright (C) 1995-2005 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 1725 2006-08-11 14:57:53Z outchy $ */
+
+#ifndef ZUTIL_H
+#define ZUTIL_H
+
+#define ZLIB_INTERNAL
+#include "zlib.h"
+
+#ifdef STDC
+# ifndef _WIN32_WCE
+# include
+# endif
+# include
+# include
+#endif
+#ifdef NO_ERRNO_H
+# ifdef _WIN32_WCE
+ /* The Microsoft C Run-Time Library for Windows CE doesn't have
+ * errno. We define it as a global variable to simplify porting.
+ * Its value is always 0 and should not be used. We rename it to
+ * avoid conflict with other libraries that use the same workaround.
+ */
+# define errno z_errno
+# endif
+ extern int errno;
+#else
+# ifndef _WIN32_WCE
+# include
+# endif
+#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
+# ifdef M_I86
+ #include
+# endif
+#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 VMS
+# define NO_vsnprintf
+#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.104/install.sh b/official/1.104/install.sh
new file mode 100644
index 0000000..63859c2
--- /dev/null
+++ b/official/1.104/install.sh
@@ -0,0 +1,17 @@
+#!/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
+ ./prototypes.sh
+fi
+$DCC QJediInstaller.dpr # build...
+../bin/QJediInstaller # ...and run installer
+rm *.dcu # clean up source directories
diff --git a/official/1.104/install/BCB5-dcc32.cfg.mak b/official/1.104/install/BCB5-dcc32.cfg.mak
new file mode 100644
index 0000000..2b13b3a
--- /dev/null
+++ b/official/1.104/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.104/install/ClxGui/QJediGUIInstall.xfm b/official/1.104/install/ClxGui/QJediGUIInstall.xfm
new file mode 100644
index 0000000..cd1c21f
--- /dev/null
+++ b/official/1.104/install/ClxGui/QJediGUIInstall.xfm
@@ -0,0 +1,98 @@
+object InstallFrame: TInstallFrame
+ 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 ProgressBar: TProgressBar
+ Left = 104
+ Top = 6
+ Width = 270
+ Height = 14
+ Anchors = [akLeft, akTop, akRight]
+ end
+ 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
+ end
+ end
+end
diff --git a/official/1.104/install/ClxGui/QJediGUIMain.xfm b/official/1.104/install/ClxGui/QJediGUIMain.xfm
new file mode 100644
index 0000000..63946bd
--- /dev/null
+++ b/official/1.104/install/ClxGui/QJediGUIMain.xfm
@@ -0,0 +1,588 @@
+object MainForm: TMainForm
+ Left = 280
+ Top = 163
+ Width = 838
+ Height = 608
+ VertScrollBar.Range = 49
+ ActiveControl = InstallBtn
+ AutoScroll = False
+ Caption = 'JEDI Installer'
+ Color = clButton
+ Font.Color = clText
+ Font.Height = 12
+ Font.Name = 'helvetica'
+ Font.Pitch = fpVariable
+ Font.Style = []
+ Font.Weight = 40
+ ParentFont = False
+ Position = poScreenCenter
+ ShowHint = True
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnShow = FormShow
+ PixelsPerInch = 96
+ TextHeight = 15
+ TextWidth = 6
+ 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 = 838
+ Height = 49
+ Align = alTop
+ BevelWidth = 2
+ BorderStyle = bsSingle
+ Color = 9981440
+ 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
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ MultiLine = True
+ TabOrder = 3
+ 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 = {
+ 494D474C01000100100000001000000007000000424D361B0000000000003600
+ 00002800000030000000300000000100180000000000001B0000120B0000120B
+ 00000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFF000000000000000000000000000000FFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000BFBFBFBFBFBF7F
+ 7F7F7F7F7F7F7F7F000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ 000000BFBFBFBFBFBF7F7F7F0000000000000000007F7F7F7F7F7F7F7F7F0000
+ 00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFF000000BFBFBFBFBFBF000000FFFFFF00FF00FF
+ FFFF00FF00FFFFFF0000007F7F7F7F7F7F000000FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000
+ BFBFBF000000FFFFFF000000000000000000000000000000FFFFFF0000007F7F
+ 7F000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000BFBFBF7F7F7FFFFFFF00000000000000FF0000
+ 8000008000000000000000FFFFFF7F7F7F7F7F7F000000FFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000BFBFBF
+ 00000000FF0000000000FF0000800000FF0000800000800000000000FF000000
+ 007F7F7F000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000FFFFFF000000FFFFFF00000000FF0000FF0000
+ FF0000FF00008000000000FFFFFF0000007F7F7F000000FFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFF
+ 00000000FF00000000FFFFFF00FF0000FF0000800000FF0000000000FF000000
+ 00BFBFBF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFF000000FFFFFF7F7F7FFFFFFF000000000000FFFFFFFF
+ FFFF00FF00000000000000FFFFFF7F7F7FBFBFBF000000FFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000
+ BFBFBF000000FFFFFF000000000000000000000000000000FFFFFF000000BFBF
+ BF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFF000000FFFFFFBFBFBF000000FFFFFF00FF00FF
+ FFFF00FF00FFFFFF000000BFBFBFBFBFBF000000FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ 000000FFFFFFBFBFBF7F7F7F0000000000000000007F7F7FBFBFBFBFBFBF0000
+ 00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFFFFFFFFFFFF
+ FFFFBFBFBFBFBFBF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFF000000000000000000000000000000FFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFF808080808080808080808080FFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000
+ 0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFF000000000000000000000000000000FFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080FFFFFFFF
+ FFFFFFFFFFFFFFFF808080808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF000000000000C0C0C0C0C0C0808080808080808080000000000000FFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000BFBFBFBFBFBF7F
+ 7F7F7F7F7F7F7F7F000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8080
+ 80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000C0C0C0C0C0C080808000000000
+ 0000000000808080808080808080000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ 000000BFBFBFBFBFBF7F7F7F0000000000000000007F7F7F7F7F7F7F7F7F0000
+ 00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF00
+ 0000000000FFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFF000000
+ C0C0C0C0C0C0000000FFFFFFC0C0C0FFFFFFC0C0C0FFFFFF0000008080808080
+ 80000000FFFFFFFFFFFFFFFFFF000000BFBFBFBFBFBF000000FFFFFF0000FFFF
+ FFFF0000FFFFFFFF0000007F7F7F7F7F7F000000FFFFFFFFFFFFFFFFFFFFFFFF
+ 808080FFFFFFFFFFFF000000000000000000000000000000000000FFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFF000000C0C0C0000000FFFFFF00000000000000
+ 0000000000000000FFFFFF000000808080000000FFFFFFFFFFFFFFFFFF000000
+ BFBFBF000000FFFFFF000000000000000000000000000000FFFFFF0000007F7F
+ 7F000000FFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFF00000000000000
+ 0000000000000000000000FFFFFFFFFFFFFFFFFF808080FFFFFF000000C0C0C0
+ 808080FFFFFF000000000000C0C0C0808080808080000000000000FFFFFF8080
+ 80808080000000FFFFFF000000BFBFBF7F7F7FFFFFFF0000000000000000FF00
+ 0080000080000000000000FFFFFF7F7F7F7F7F7F000000FFFFFFFFFFFF808080
+ FFFFFFFFFFFF000000000000000000000000000000000000000000000000FFFF
+ FFFFFFFF808080FFFFFF000000C0C0C0000000C0C0C0000000C0C0C0808080C0
+ C0C0808080808080000000C0C0C0000000808080000000FFFFFF000000BFBFBF
+ 0000000000FF0000000000FF0000800000FF0000800000800000000000FF0000
+ 007F7F7F000000FFFFFFFFFFFF808080FFFFFFFFFFFF00000000000000000000
+ 0000000000000000000000000000FFFFFFFFFFFF808080FFFFFF000000FFFFFF
+ 000000FFFFFF000000C0C0C0C0C0C0C0C0C0C0C0C0808080000000FFFFFF0000
+ 00808080000000FFFFFF000000FFFFFF000000FFFFFF0000000000FF0000FF00
+ 00FF0000FF000080000000FFFFFF0000007F7F7F000000FFFFFFFFFFFF808080
+ FFFFFFFFFFFFFFFFFF000000000000000000000000000000000000FFFFFFFFFF
+ FFFFFFFF808080FFFFFF000000FFFFFF000000C0C0C0000000FFFFFFC0C0C0C0
+ C0C0808080C0C0C0000000C0C0C0000000C0C0C0000000FFFFFF000000FFFFFF
+ 0000000000FF000000FFFFFF0000FF0000FF0000800000FF0000000000FF0000
+ 00BFBFBF000000FFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFF00000000000000
+ 0000000000000000000000FFFFFFFFFFFF808080FFFFFFFFFFFF000000FFFFFF
+ 808080FFFFFF000000000000FFFFFFFFFFFFC0C0C0000000000000FFFFFF8080
+ 80C0C0C0000000FFFFFF000000FFFFFF7F7F7FFFFFFF000000000000FFFFFFFF
+ FFFF0000FF000000000000FFFFFF7F7F7FBFBFBF000000FFFFFFFFFFFFFFFFFF
+ 808080FFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFF00000000000000000000000000000000000000
+ 0000000000000000000000000000000000000000FFFFFFFFFFFFFFFFFF000000
+ BFBFBF000000FFFFFF000000000000000000000000000000FFFFFF000000BFBF
+ BF000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF000000
+ 0000000000000000000000000000000000000000000000000000000000000000
+ 00000000FFFFFFFFFFFFFFFFFF000000FFFFFFBFBFBF000000FFFFFF0000FFFF
+ FFFF0000FFFFFFFF000000BFBFBFBFBFBF000000FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFF808080808080FFFFFFFFFFFFFFFFFFFFFFFF808080808080FFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000000000000000000000
+ 0000000000000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ 000000FFFFFFBFBFBF7F7F7F0000000000000000007F7F7FBFBFBFBFBFBF0000
+ 00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF80808080
+ 8080808080808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF000000000000000000000000000000000000000000000000000000FFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFFFFFFFFFFFF
+ FFFFBFBFBFBFBFBF000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00000000000000
+ 0000000000000000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFF000000000000000000000000000000FFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFF808080808080808080808080FFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080808080FFFFFFFF
+ FFFFFFFFFFFFFFFF808080808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF8080808080808080808080808080808080808080808080808080808080
+ 80808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF80808080808080808080808080
+ 8080808080808080808080808080808080808080FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF8080
+ 80FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFF00
+ 0000FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF
+ 808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFF000000000000000000FFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFF00000000000000
+ 0000000000000000FFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFF808080
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFF000000000000FFFFFF000000000000000000FFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFF000000FFFFFFFF
+ FFFFFFFFFF000000000000000000FFFFFF808080FFFFFFFFFFFFFFFFFF808080
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF000000000000FFFF
+ FF808080FFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFF000000FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF
+ 808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFF808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFF8080808080808080808080808080808080808080808080808080808080
+ 80808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF80808080808080808080808080
+ 8080808080808080808080808080808080808080FFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFF808080808080FFFFFFFFFFFFFFFFFFFFFFFF808080808080FFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF80808080
+ 8080808080808080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ FFFFFFFFFFFFFFFFFFFF424DBE010000000000003E0000002800000030000000
+ 30000000010001000000000080010000120B0000120B00000200000002000000
+ FFFFFF00000000000000DB9999B9FFFF07C0BFFFFFFFFFFF1FF07BFFF6EBFFFF
+ 3FF8EFFEFFEFFFFF7ABCFFFFFFFFFFFF77DC7B377777FFFFEFEEFFEFFFFFFFFF
+ FFFE7FFFFFFFFFFFAFEECDDCDDDDFFFFBBFEFFFFFFFEFFFFACEEFFFFFFFFFFFF
+ 77DC77773577FFFF5ABCEFFFFFFFFFFF2FF8FFFEFFFFFFFF18F0FDDDFDDFFFFF
+ 07C0BE7EDFF7FFFF000000000000FFFF03C007C007C0FFFF0C301FF01FF0FFFF
+ 10083FF83FF8FFFF21847ABC7ABCFFFF27E477DC77DCFFFF47E2EFEEEFEEFFFF
+ 4FF2FFFEFFFEFFFF4FF2AFEEAFEEFFFF47E2BBFEBBFEFFFF27E4ACEEACEEFFFF
+ 21847FFC77DCFFFF10087FFC5ABCFFFF0C303FF82FF8FFFF03C01FF018F0FFFF
+ 000007C007C0FFFF000000000000FFFF0000000003C0FFFF000000000C30FFFF
+ 1FFC1FFC1008FFFF100410042004FFFF100411042004FFFF100413844002FFFF
+ 100417C44002FFFF100416E44002FFFF100414744002FFFF100410342004FFFF
+ 100410142004FFFF100410041008FFFF1FFC1FFC0C30FFFF0000000003C0FFFF
+ 000000000000FFFF}
+ end
+end
diff --git a/official/1.104/install/ClxGui/QJediGUIReadme.xfm b/official/1.104/install/ClxGui/QJediGUIReadme.xfm
new file mode 100644
index 0000000..2d904bd
--- /dev/null
+++ b/official/1.104/install/ClxGui/QJediGUIReadme.xfm
@@ -0,0 +1,16 @@
+object ReadmeFrame: TReadmeFrame
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 240
+ TabOrder = 0
+ TabStop = True
+ object ReadmePane: TTextViewer
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 240
+ Align = alClient
+ TabOrder = 0
+ end
+end
diff --git a/official/1.104/install/HeaderTest/jcl_a2z.cpp b/official/1.104/install/HeaderTest/jcl_a2z.cpp
new file mode 100644
index 0000000..63dd8b8
--- /dev/null
+++ b/official/1.104/install/HeaderTest/jcl_a2z.cpp
@@ -0,0 +1,314 @@
+//---------------------------------------------------------------------------
+
+//#pragma hdrstop
+
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+//#ifdef TEST_WINDOWS
+//#include mscorlib_TLB is known to fail
+//#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_VCL
+#include
+#endif TEST_VCL
+#ifdef TEST_VCL
+#include
+#endif TEST_VCL
+#ifdef TEST_VCL
+#include
+#endif TEST_VCL
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+//#ifdef TEST_WINDOWS
+//#include no declaration for IPropertyStorage
+//#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_VCL
+#include
+#endif TEST_VCL
+#ifdef TEST_VISCLX
+#include
+#endif TEST_VISCLX
+#ifdef TEST_VISCLX
+#include
+#endif TEST_VISCLX
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+//#ifdef TEST_WINDOWS
+//#include known to fail
+//#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_UNIX
+#include
+#endif TEST_UNIX
+
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int main(int argc, char* argv[])
+{
+ return 0;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/official/1.104/install/HeaderTest/jcl_z2a.cpp b/official/1.104/install/HeaderTest/jcl_z2a.cpp
new file mode 100644
index 0000000..985eacc
--- /dev/null
+++ b/official/1.104/install/HeaderTest/jcl_z2a.cpp
@@ -0,0 +1,314 @@
+//---------------------------------------------------------------------------
+
+//#pragma hdrstop
+
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_UNIX
+#include
+#endif TEST_UNIX
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+//#ifdef TEST_WINDOWS
+//#include known to fail
+//#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_VISCLX
+#include
+#endif TEST_VISCLX
+#ifdef TEST_VISCLX
+#include
+#endif TEST_VISCLX
+#ifdef TEST_VCL
+#include
+#endif TEST_VCL
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+//#ifdef TEST_WINDOWS
+//#include no declaration for IPropertyStorage
+//#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_VCL
+#include
+#endif TEST_VCL
+#ifdef TEST_VCL
+#include
+#endif TEST_VCL
+#ifdef TEST_VCL
+#include
+#endif TEST_VCL
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+//#ifdef TEST_WINDOWS
+//#include mscorlib_TLB.hpp is known to fail
+//#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+#ifdef TEST_WINDOWS
+#include
+#endif TEST_WINDOWS
+#ifdef TEST_COMMON
+#include
+#endif TEST_COMMON
+
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int main(int argc, char* argv[])
+{
+ return 0;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/official/1.104/install/JclInstall.pas b/official/1.104/install/JclInstall.pas
new file mode 100644
index 0000000..51fa482
--- /dev/null
+++ b/official/1.104/install/JclInstall.pas
@@ -0,0 +1,3960 @@
+{**************************************************************************************************}
+{ }
+{ 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 }
+{ - Florent Ouchet (outchy) - New installer core for .net compilation }
+{ }
+{ Last modified: $Date: 2008-11-29 23:31:01 +0100 (sam., 29 nov. 2008) $ }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-11-29 23:31:01 +0100 (sam., 29 nov. 2008) $ }
+{ Revision: $Rev:: 2564 $ }
+{ Author: $Author:: ahuser $ }
+{ }
+{**************************************************************************************************}
+
+unit JclInstall;
+
+interface
+
+{$I jcl.inc}
+{$I crossplatform.inc}
+
+uses
+ SysUtils, Classes, Contnrs,
+ JclSysUtils, JclBorlandTools, JediInstall;
+
+type
+ TInstallerOption = (
+ joJediCodeLibrary,
+ joJCLDef,
+ joJCLDefMath,
+ joJCLDefDebug,
+ joJCLDefEDI,
+ joJCLDefPCRE,
+ joJCLDefBZip2,
+ joJCLDefZLib,
+ joJCLDefUnicode,
+ joJCLDefContainer,
+ joJCLDef7z,
+ joJCLDefThreadSafe,
+ joJCLDefDropObsoleteCode,
+ joJCLDefUnitVersioning,
+ joJCLDefMathPrecSingle,
+ joJCLDefMathPrecDouble,
+ joJCLDefMathPrecExtended,
+ joJCLDefMathExtremeValues,
+ joJCLDefHookDllExceptions,
+ joJCLDefDebugNoBinary,
+ joJCLDefDebugNoTD32,
+ joJCLDefDebugNoMap,
+ joJCLDefDebugNoExports,
+ joJCLDefDebugNoSymbols,
+ joJCLDefEDIWeakPackageUnits,
+ joJCLDefPCREStaticLink,
+ joJCLDefPCRELinkDLL,
+ joJCLDefPCRELinkOnRequest,
+ joJCLDefBZip2StaticLink,
+ joJCLDefBZip2LinkDLL,
+ joJCLDefBZip2LinkOnRequest,
+ joJCLDefZLibStaticLink,
+ joJCLDefZLibLinkDLL,
+ joJCLDefZLibLinkOnRequest,
+ joJCLDefUnicodeSilentFailure,
+ joJCLDefUnicodeRawData,
+ joJCLDefUnicodeZLibData,
+ joJCLDefUnicodeBZip2Data,
+ joJCLDefContainerAnsiStr,
+ joJCLDefContainerWideStr,
+ joJCLDefContainerUnicodeStr,
+ joJCLDefContainerNoStr,
+ //joJCLDef7zStaticLink,
+ joJCLDef7zLinkDLL,
+ joJCLDef7zLinkOnRequest,
+ joJCLEnvironment,
+ joJCLEnvLibPath,
+ joJCLEnvBrowsingPath,
+ joJCLEnvDebugDCUPath,
+ joJCLMake,
+ joJCLMakeRelease,
+ joJCLMakeReleaseVClx,
+ joJCLMakeReleaseVCL,
+ joJCLMakeDebug,
+ joJCLMakeDebugVClx,
+ joJCLMakeDebugVCL,
+ joJCLCopyHppFiles,
+ joJCLCheckHppFiles,
+ joJCLPackages,
+ joJCLVclPackage,
+ joJCLClxPackage,
+ joJCLDualPackages,
+ joJCLCopyPackagesHppFiles,
+ joJCLPdbCreate,
+ joJCLMapCreate,
+ joJCLJdbgCreate,
+ joJCLJdbgInsert,
+ joJCLMapDelete,
+ joJCLExperts,
+ joJCLExpertsDsgnPackages,
+ joJCLExpertsDLL,
+ joJCLExpertDebug,
+ joJCLExpertAnalyzer,
+ joJCLExpertFavorite,
+ joJCLExpertRepository,
+ joJCLExpertThreadNames,
+ joJCLExpertUses,
+ joJCLExpertSimdView,
+ joJCLExpertVersionControl,
+ joJCLExceptDlg,
+ joJCLExceptDlgVCL,
+ joJCLExceptDlgVCLSnd,
+ joJCLExceptDlgCLX,
+ joJCLHelp,
+ joJCLHelpHlp,
+ joJCLHelpChm,
+ joJCLHelpHxS,
+ joJCLHelpHxSPlugin,
+ joJCLMakeDemos);
+
+ TJclDistribution = class;
+
+ TJclInstallation = class
+ private
+ // identification
+ FDistribution: TJclDistribution;
+ FTarget: TJclBorRADToolInstallation;
+ FCLRVersion: string;
+ FTargetName: string;
+ FTargetPlatform: TJclBorPlatform;
+ FGUIPage: IJediInstallPage;
+ FGUI: IJediInstallGUI;
+ FGUIBPLPathIndex: Integer;
+ FGUIDCPPathIndex: Integer;
+ FLibDebugDir: string;
+ FLibReleaseDir: string;
+ FJclDcpPath: string;
+ FDemoList: TStringList;
+ FLogLines: TJclSimpleLog;
+ FDemoSectionName: string;
+ FLogFileName: string;
+ FSilent: Boolean;
+ FRuntimeInstallation: Boolean;
+ FProfilesTargets: TObjectList;
+ procedure AddDemo(const Directory: string; const FileInfo: TSearchRec);
+ procedure AddDemos(const Directory: string);
+ function GetDemoList: TStringList;
+ function MakePath(const FormatStr: string): string;
+ procedure WriteLog(const Msg: string);
+ function GetEnabled: Boolean;
+ function GetIsProfileEnabled(Index: Integer): Boolean;
+ function GetProfilesTarget(Index: Integer): TJclBorRADToolInstallation;
+ protected
+ // if CLRVersion = '' then it is a native installation
+ constructor Create(JclDistribution: TJclDistribution;
+ InstallTarget: TJclBorRADToolInstallation; const ACLRVersion: string = '';
+ ATargetPlatform: TJclBorPlatform = bp32bit; AGUIPage: IJediInstallPage = nil);
+ function CompileLibraryUnits(const SubDir: string; Debug: Boolean): Boolean;
+ {$IFDEF MSWINDOWS}
+ function CompileCLRPackage(const Name: string): Boolean;
+ {$ENDIF MSWINDOWS}
+ function CompilePackage(const Name: string): Boolean;
+ function CompileApplication(FileName: string): Boolean;
+ function DeletePackage(const Name: string): Boolean;
+ procedure ConfigureBpr2Mak(const PackageFileName: string);
+ {$IFDEF MSWINDOWS}
+ function CompileExpert(const Name: string): Boolean;
+ {$ENDIF MSWINDOWS}
+
+ function GetBplPath: string;
+ function GetDcpPath: string;
+ function GetOptionChecked(Option: TInstallerOption): Boolean; overload;
+ function GetOptionCheckedById(Id: Integer): Boolean; overload;
+ procedure MarkOptionBegin(Id: Integer); overload;
+ procedure MarkOptionBegin(Option: TInstallerOption); overload;
+ procedure MarkOptionEnd(Id: Integer; Success: Boolean); overload;
+ procedure MarkOptionEnd(Option: TInstallerOption; Success: Boolean); overload;
+ public
+ destructor Destroy; override;
+ procedure Close;
+ procedure Init;
+ function RemoveSettings: Boolean;
+ function Install: Boolean;
+ function Uninstall(AUninstallHelp: Boolean): Boolean;
+
+ property Distribution: TJclDistribution read FDistribution;
+ property Target: TJclBorRADToolInstallation read FTarget;
+ property CLRVersion: string read FCLRVersion;
+ property TargetName: string read FTargetName;
+ property GUIPage: IJediInstallPage read FGUIPage;
+ property GUI: IJediInstallGUI read FGUI;
+ property TargetPlatform: TJclBorPlatform read FTargetPlatform;
+ property Enabled: Boolean read GetEnabled;
+ property OptionCheckedById[Id: Integer]: Boolean read GetOptionCheckedById;
+ property OptionChecked[Option: TInstallerOption]: Boolean read GetOptionChecked;
+ property LogFileName: string read FLogFileName;
+ property Silent: Boolean read FSilent write FSilent;
+ property RuntimeInstallation: Boolean read FRuntimeInstallation; // false for C#Builder 1, Delphi 8 and .net targets
+
+ property IsProfileEnabled[Index: Integer]: Boolean read GetIsProfileEnabled;
+ property ProfileTargets[Index: Integer]: TJclBorRADToolInstallation read GetProfilesTarget;
+ end;
+
+ TJclDistribution = class (TInterfacedObject, IJediProduct)
+ private
+ FJclPath: string;
+ FJclBinDir: string;
+ FLibReleaseDirMask: string;
+ FLibDebugDirMask: string;
+ FJclSourceDir: string;
+ FJclIncludeDir: string;
+ FJclSourcePath: string;
+ FJclExamplesDir: string;
+ FClxDialogFileName: string;
+ FClxDialogIconFileName: string;
+ FVclDialogFileName: string;
+ FVclDialogSendFileName: string;
+ FVclDialogIconFileName: string;
+ FVclDialogSendIconFileName: string;
+ FJclChmHelpFileName: string;
+ FJclHlpHelpFileName: string;
+ FJclHxSHelpFileName: string;
+ FJclReadmeFileName: string;
+ FGUI: IJediInstallGUI;
+ FNbEnabled: Integer;
+ FNbInstalled: Integer;
+ {$IFDEF MSWINDOWS}
+ FCLRVersions: TStrings;
+ FRegHelpCommands: TStrings;
+ {$ENDIF MSWINDOWS}
+ FRadToolInstallations: TJclBorRADToolInstallations;
+ FTargetInstalls: TObjectList;
+ FProfilesPage: IJediProfilesPage;
+ function GetVersion: string;
+ property Version: string read GetVersion;
+ function CreateInstall(Target: TJclBorRADToolInstallation): Boolean;
+ function GetTargetInstall(Index: Integer): TJclInstallation;
+ function GetTargetInstallCount: Integer;
+ {$IFDEF MSWINDOWS}
+ procedure RegHelpInternalAdd(Command: Integer; Arguments: string; DoNotRepeatCommand: Boolean);
+ function RegHelpExecuteCommands(DisplayErrors: Boolean): Boolean;
+ procedure RegHelpClearCommands;
+ {$ENDIF MSWINDOWS}
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {$IFDEF MSWINDOWS}
+ procedure RegHelpCreateTransaction;
+ procedure RegHelpCommitTransaction;
+ procedure RegHelpRegisterNameSpace(const Name, Collection, Description: WideString);
+ procedure RegHelpUnregisterNameSpace(const Name: WideString);
+ procedure RegHelpRegisterHelpFile(const NameSpace, Identifier: WideString;
+ const LangId: Integer; const HxSFile, HxIFile: WideString);
+ procedure RegHelpUnregisterHelpFile(const NameSpace, Identifier: WideString;
+ const LangId: Integer);
+ procedure RegHelpPlugNameSpaceIn(const SourceNameSpace, TargetNameSpace: WideString);
+ procedure RegHelpUnPlugNameSpace(const SourceNameSpace, TargetNameSpace: WideString);
+ {$ENDIF MSWINDOWS}
+
+ // IJediProduct
+ procedure Init;
+ function Install: Boolean;
+ function Uninstall: Boolean;
+ procedure Close;
+
+ property JclPath: string read FJclPath;
+ property JclBinDir: string read FJclBinDir;
+ property LibReleaseDirMask: string read FLibReleaseDirMask;
+ property LibDebugDirMask: string read FLibDebugDirMask;
+ property JclSourceDir: string read FJclSourceDir;
+ property JclIncludeDir: string read FJclIncludeDir;
+ property JclSourcePath: string read FJclSourcePath;
+ property JclExamplesDir: string read FJclExamplesDir;
+ property ClxDialogFileName: string read FClxDialogFileName;
+ property ClxDialogIconFileName: string read FClxDialogIconFileName;
+ property VclDialogFileName: string read FVclDialogFileName;
+ property VclDialogSendFileName: string read FVclDialogSendFileName;
+ property VclDialogIconFileName: string read FVclDialogIconFileName;
+ property VclDialogSendIconFileName: string read FVclDialogSendIconFileName;
+ property JclChmHelpFileName: string read FJclChmHelpFileName;
+ property JclHlpHelpFileName: string read FJclHlpHelpFileName;
+ property JclHxSHelpFileName: string read FJclHxSHelpFileName;
+ property JclReadmeFileName: string read FJclReadmeFileName;
+ {$IFDEF MSWINDOWS}
+ property CLRVersions: TStrings read FCLRVersions;
+ {$ENDIF MSWINDOWS}
+ property RadToolInstallations: TJclBorRADToolInstallations read FRadToolInstallations;
+ property TargetInstalls[Index: Integer]: TJclInstallation read GetTargetInstall;
+ property TargetInstallCount: Integer read GetTargetInstallCount;
+
+ property GUI: IJediInstallGUI read FGUI;
+ property NbEnabled: Integer read FNbEnabled;
+ property NbInstalled: Integer read FNbInstalled;
+
+ property ProfilesPage: IJediProfilesPage read FProfilesPage;
+ end;
+
+implementation
+
+uses
+ TypInfo,
+ JclBase, JclResources, JclSysInfo,
+ {$IFDEF MSWINDOWS}
+ Windows,
+ JclPeImage,
+ JclRegistry,
+ JclDebug,
+ JclDotNet,
+ JclSecurity,
+ JediRegInfo,
+ JclShell,
+ {$ENDIF MSWINDOWS}
+ JclFileUtils, JclStrings;
+
+resourcestring
+// Names
+ RsNameBPLPath = 'BPL-Path';
+ RsNameDCPPath = 'DCP-Path';
+ RsNameBPIPath = 'BPI-Path';
+
+// Captions
+ RsCaptionOutputPath = '&Output path:';
+ RsCaptionBPLPath = '&BPL path:';
+ RsCaptionDCPPath = '&DCP path:';
+ RsCaptionBPIPath = 'BP&I path:';
+
+ // Products
+ RsCaptionLibrary = 'JEDI Code Library';
+
+ // Conditional features
+ RsCaptionDef = 'Conditional defines';
+ RsCaptionDefThreadSafe = 'Enable thread safe code';
+ RsCaptionDefDropObsoleteCode = 'Drop obsolete code';
+ RsCaptionDefUnitVersioning = 'Include Unit Versioning';
+ // math options
+ RsCaptionDefMath = 'Math options';
+ RsCaptionDefMathPrecSingle = 'Single float precision';
+ RsCaptionDefMathPrecDouble = 'Double float precision';
+ RsCaptionDefMathPrecExtended = 'Extended float precision';
+ RsCaptionDefMathExtremeValues = 'Support for infinite and NaN';
+ // debug options
+ RsCaptionDefDebug = 'Debug and exception hooking options';
+ RsCaptionDefHookDllExceptions = 'Hook exceptions in DLL';
+ RsCaptionDefDebugNoBinary = 'No debug source from JEDI debug informations';
+ RsCaptionDefDebugNoTD32 = 'No debug source from TD32 debug symbols';
+ RsCaptionDefDebugNoMap = 'No debug source from Map files';
+ RsCaptionDefDebugNoExports = 'No debug source from function export table for libraries';
+ RsCaptionDefDebugNoSymbols = 'No debug source from Microsoft debug symbols';
+ // EDI options
+ RsCaptionDefEDI = 'EDI options';
+ RsCaptionDefEDIWeakPackageUnits = 'EDI weak package units';
+ // PCRE options
+ RsCaptionDefPCRE = 'PCRE options';
+ RsCaptionDefPCREStaticLink = 'Static link to PCRE code';
+ RsCaptionDefPCRELinkDLL = 'Static bind to pcre.dll';
+ RsCaptionDefPCRELinkOnRequest = 'Late bind to pcre.dll';
+ // BZip2 options
+ RsCaptionDefBZip2 = 'BZip2 options';
+ RsCaptionDefBZip2StaticLink = 'Static link to BZip2 code';
+ RsCaptionDefBZip2LinkDLL = 'Static bind to bzip2.dll';
+ RsCaptionDefBZip2LinkOnRequest = 'Late bind to bzip2.dll';
+ // ZLib options
+ RsCaptionDefZLib = 'ZLib options';
+ RsCaptionDefZLibStaticLink = 'Static link to ZLib code';
+ RsCaptionDefZLibLinkDLL = 'Static bind to zlib1.dll';
+ RsCaptionDefZLibLinkOnRequest = 'Late bind to zlib1.dll';
+ // Unicode options
+ RsCaptionDefUnicode = 'Unicode options';
+ RsCaptionDefUnicodeSilentFailure = 'Silent failure';
+ RsCaptionDefUnicodeRawData = 'Uncompressed Unicode data';
+ RsCaptionDefUnicodeZLibData = 'Compressed data using zlib';
+ RsCaptionDefUnicodeBZip2Data = 'Compressed data using bzip2';
+ // Container options
+ RsCaptionDefContainer = 'Container options';
+ RsCaptionDefContainerAnsiStr = 'Alias AnsiString containers to String containers';
+ RsCaptionDefContainerWideStr = 'Alias WideString containers to String containers';
+ RsCaptionDefContainerUnicodeStr = 'Alias UnicodeString containers to String containers (Delphi 2008 only)';
+ RsCaptionDefContainerNoStr = 'Do not alias anything';
+ // 7Z options
+ RsCaptionDef7z = 'Sevenzip options';
+ //RsCaptionDef7zStaticLink = 'Static link to Sevenzip code (not supported yet)';
+ RsCaptionDef7zLinkDLL = 'Static bind to 7z.dll';
+ RsCaptionDef7zLinkOnRequest = 'Late bind to 7z.dll';
+
+ // post compilation
+ RsCaptionPdbCreate = 'Create PDB debug information';
+ RsCaptionMapCreate = 'Create MAP files';
+ RsCaptionJdbgCreate = 'Create JEDI Debug Informations';
+ RsCaptionJdbgInsert = 'Insert JEDI Debug Informations in the libraries';
+ RsCaptionMapDelete = 'Do not keep MAP files';
+
+ // environment
+ RsCaptionEnvironment = 'Environment';
+ RsCaptionEnvLibPath = 'Add JCL to IDE Library Path';
+ RsCaptionEnvBrowsingPath = 'Add JCL to IDE Browsing Path';
+ RsCaptionEnvDebugDCUPath = 'Add JCL to Debug DCU Path';
+
+ // make units
+ RsCaptionMake = 'Make library units';
+ RsCaptionMakeRelease = 'Release';
+ RsCaptionMakeDebug = 'Debug';
+ RsCaptionMakeVClx = 'Visual CLX';
+ RsCaptionMakeVCL = 'Visual Component Library';
+ RsCaptionCopyHppFiles = 'Copy HPP files to %s';
+ RsCaptionCheckHppFiles = 'Check HPP files';
+
+ // packages
+ RsCaptionPackages = 'Packages';
+ RsCaptionVclPackage = 'VCL Package';
+ RsCaptionClxPackage = 'CLX package';
+ RsCaptionDualPackages = 'Dual packages';
+ RsCaptionCopyPackagesHppFiles = 'Output HPP files to %s';
+
+ // exception dialogs
+ RsCaptionExceptDlg = 'Sample Exception Dialogs in the Object Repository';
+ RsCaptionExceptDlgVCL = 'VCL Exception Dialog';
+ RsCaptionExceptDlgVCLSnd = 'VCL Exception Dialog with Send button';
+ RsCaptionExceptDlgCLX = 'CLX Exception Dialog';
+
+ // experts
+ RsCaptionExperts = 'IDE experts';
+ RsCaptionExpertsDsgnPackages = 'Design packages';
+ RsCaptionExpertsDLL = 'DLL experts';
+ RsCaptionExpertDebug = 'Debug Extension';
+ RsCaptionExpertAnalyzer = 'Project Analyzer';
+ RsCaptionExpertFavorite = 'Favorite combobox in Open/Save dialogs';
+ RsCaptionExpertRepository = 'Exception dialog expert';
+ RsCaptionExpertThreadNames = 'Displaying thread names in Thread Status window';
+ RsCaptionExpertUses = 'Uses Wizard';
+ RsCaptionExpertSimdView = 'Debug window for XMM registers';
+ RsCaptionExpertVersionControl = 'Version control';
+
+ // help
+ RsCaptionHelp = 'Help files';
+ RsCaptionHelpHlp = 'Add help file to IDE help system';
+ RsCaptionHelpChm = 'Add HTML help to the Tools menu';
+ RsCaptionHelpHxS = 'Register help 2.0 files';
+ RsCaptionHelpHxSPlugin = 'Plug help 2.0 files in the Borland help system';
+
+ // demos
+ RsCaptionMakeDemos = 'Make demos';
+
+// Hints
+ // products
+ RsHintLibrary = 'Select to install JCL for this target.';
+
+ // conditional defines
+ RsHintDef = 'Enable or disable specific features to be compiled';
+ RsHintDefThreadSafe = 'Conditionally some pieces of code to be thread safe, the ThreadSafe.txt file contains more informations about this feature';
+ RsHintDefDropObsoleteCode = 'Do not compile deprecated code';
+ RsHintDefUnitVersioning = 'Includes JCL Unit Versioning informations into each JCL unit (see also JclUnitVersioning.pas)';
+ // math options
+ RsHintDefMath = 'Math specific options (JclMath.pas)';
+ RsHintDefMathPrecSingle = 'type Float = Single';
+ RsHintDefMathPrecDouble = 'type Float = Double';
+ RsHintDefMathPrecExtended = 'type Float = Extended';
+ RsHintDefMathExtremeValues = 'Exp en Power functions accept and return infinite and NaN';
+ // Debug options
+ RsHintDefDebug = 'Debug and exception hooking specific options (JclDebug.pas and JclHookExcept.pas)';
+ RsHintDefHookDllExceptions = 'Hook exceptions raised in DLL compiled with the JCL';
+ RsHintDefDebugNoBinary = 'Disable support for JDBG files';
+ RsHintDefDebugNoMap = 'Disable support for MAP files';
+ RsHintDefDebugNoTD32 = 'Disable support for TD32 informations';
+ RsHintDefDebugNoExports = 'Disable support for export names of libraries';
+ RsHintDefDebugNoSymbols = 'Disable support for Microsoft debug symbols (PDB and DBG files)';
+ // EDI options
+ RsHintDefEDI = 'EDI specific options (JclEDI*.pas)';
+ RsHintDefEDIWeakPackageUnits = 'Mark EDI units as weak package units (check if you use the original EDI package)';
+ // PCRE options
+ RsHintDefPCRE = 'PCRE specific options (pcre.pas and JclPCRE.pas)';
+ RsHintDefPCREStaticLink = 'Code from PCRE is linked into JCL binaries';
+ RsHintDefPCRELinkDLL = 'JCL binaries require pcre.dll to be present';
+ RsHintDefPCRELinkOnRequest = 'JCL binaries require pcre.dll when calling PCRE functions';
+ // BZip2 options
+ RsHintDefBZip2 = 'BZip2 specific options (bzip2.pas)';
+ RsHintDefBZip2StaticLink = 'Code from BZip2 is linked into JCL binaries';
+ RsHintDefBZip2LinkDLL = 'JCL binaries require bzip2.dll to be present';
+ RsHintDefBZip2LinkOnRequest = 'JCL binaries require bzip2.dll when calling BZip2 functions';
+ // ZLib options
+ RsHintDefZLib = 'ZLib specific options (zlibh.pas)';
+ RsHintDefZLibStaticLink = 'Code from ZLib is linked into JCL binaries';
+ RsHintDefZLibLinkDLL = 'JCL binaries require zlib1.dll to be present';
+ RsHintDefZLibLinkOnRequest = 'JCL binaries require zlib1.dll when calling ZLib functions';
+ // Unicode options
+ RsHintDefUnicode = 'Unicode specific option (JclUnicode.pas)';
+ RsHintDefUnicodeSilentFailure = 'Insert a replacement character if sequence is corrupted rather than raising an exception';
+ RsHintDefUnicodeRawData = 'Link resource containing uncompressed Unicode data (bigger executable size)';
+ RsHintDefUnicodeZLibData = 'Link resource containing Unicode data compressed with ZLib';
+ RsHintDefUnicodeBZip2Data = 'Link resource containing Unicode data compressed with BZip2';
+ // Container options
+ RsHintDefContainer = 'Container specific options';
+ RsHintDefContainerAnsiStr = 'Define TJclStr* containers as alias of TJclAnsiStr* containers';
+ RsHintDefContainerWideStr = 'Define TJclStr* containers as alias of TJclWideStr* containers';
+ RsHintDefContainerUnicodeStr = 'Define TJClStr* containers as alias of TJclUnicodeStr* containers';
+ RsHintDefContainerNoStr = 'Do not define TJclStr* containers';
+ // 7Z options
+ RsHintDef7z = 'Sevenzip specific options (sevenzip.pas)';
+ //RsHintDef7zStaticLink = 'Code from Sevenzip is linked into JCL binaries';
+ RsHintDef7zLinkDLL = 'JCL binaries require 7z.dll to be present';
+ RsHintDef7zLinkOnRequest = 'JCL binaries require 7z.dll when calling Sevenzip functions';
+
+ // post compilation
+ RsHintPdbCreate = 'Create detailed debug information for libraries';
+ RsHintMapCreate = 'Create detailed MAP files for each libraries';
+ RsHintJdbgCreate = 'Create JEDI Debug Informations from the MAP files';
+ RsHintJdbgInsert = 'Insert JEDI Debug Informations into the libraries (only the BPL has to be redistributed)';
+ RsHintMapDelete = 'The original MAP file is not kept once JEDI Debug Informations are generated';
+
+ // environment
+ RsHintEnvironment = 'Set selected environment items';
+ RsHintEnvLibPath = 'Add JCL precompiled unit directories to library path';
+ RsHintEnvBrowsingPath = 'Add JCL source directories to browsing path';
+ RsHintEnvDebugDCUPath = 'This is a prerequisite for using the precompiled JCL debug units by means of the respective' + NativeLineBreak +
+ 'Project Options|Compiler switch. See "Make library units/Debug" option below.';
+
+ // make units
+ RsHintMake = 'Generate .dcu and .dpu (Kylix only) files.' + NativeLineBreak + 'Recommended.';
+ RsHintMakeRelease = 'Make precompiled units for release, i.e. optimized, w/o debug information.';
+ RsHintMakeReleaseVcl = 'Make precompiled VCL units for release';
+ RsHintMakeReleaseVClx = 'Make precompiled Visual CLX units for release';
+ RsHintMakeDebug = 'Make precompiled units for debugging, i.e.optimization off, debug information included.' + NativeLineBreak +
+ 'When installed, available through Project Options|Compiler|Use Debug DCUs.';
+ RsHintMakeDebugVcl = 'Make precompiled VCL units for debugging';
+ RsHintMakeDebugVClx = 'Make precompiled Visual CLX units for debugging';
+ RsHintCopyHppFiles = 'Copy .hpp files into C++Builder''s include path.';
+ RsHintCheckHppFiles = 'Compile some C++ source files to verify JCL headers';
+
+ // packages
+ RsHintPackages = 'Build and eventually install JCL runtime packages and optional IDE experts.';
+ RsHintVclPackage = 'Build JCL runtime package containing VCL extensions';
+ RsHintClxPackage = 'Build JCL runtime package containing Visual CLX extensions';
+ RsHintDualPackages = 'The same package introduce code for Delphi Win32 and C++Builder Win32';
+ RsHintCopyPackagesHppFiles = 'Output .hpp files into C++Builder''s include path instead of ' +
+ 'the source paths.';
+
+ // exception dialogs
+ RsHintExceptDlg = 'Add selected Exception dialogs to the Object Repository.';
+ RsHintExceptDlgVCL = 'Add VCL exception dialog to the Object Repository.';
+ RsHintExceptDlgVCLSnd = 'Add VCL exception dialog with "Send Button" to the Object Repository.';
+ RsHintExceptDlgCLX = 'Add CLX exception dialog (Windows only) to the Object Repository.';
+
+ // experts
+ RsHintExperts = 'Build and install selected IDE experts.';
+ RsHintExpertsDsgnPackages = 'Design packages containing JCL experts';
+ RsHintExpertsDLL = 'DLLs containing JCL experts';
+ RsHintExpertDebug = 'Install IDE expert which assists to insert JCL Debug information into executable files.';
+ RsHintExpertAnalyzer = 'Install IDE Project Analyzer.';
+ RsHintExpertFavorite = 'Install "Favorites" combobox in IDE Open/Save dialogs.';
+ RsHintExpertRepository = 'Repository expert to easily create exception dialogs';
+ RsHintExpertThreadNames = 'Display thread names in Thread Status window IDE extension.';
+ RsHintExpertUses = 'Install IDE Uses Wizard.';
+ RsHintExpertSimdView = 'Install a debug window of XMM registers (used by SSE instructions)';
+ RsHintExpertVersionControl = 'Integration of TortoiseCVS and TortoiseSVN in the IDE';
+
+ // help
+ RsHintHelp = 'Install JCL help files.';
+ RsHintHelpHlp = 'Customize Borland Open Help to include JCL help files.';
+ RsHintHelpChm = 'Compiled help files won''t be merged with the IDE help';
+ RsHintHelpHxS = 'Register Help 2.0 files';
+ RsHintHelpHxSPlugin = 'Register Help 2.0 files as a plugin for the Borland.BDS* namespace';
+
+ // demos
+ RsHintMakeDemos = 'Make JCL demo applications';
+
+// warning messages
+ RsWarningPackageNodeNotSelected = 'The "Packages" or "VCL package" nodes are not selected.' + sLineBreak +
+ 'Various libraries (including the JVCL) require JCL packages to be compiled' + sLineBreak +
+ 'Do you want to continue without compiling JCL packages?';
+ RsWarningCreatePath = 'The path where %s files will be created doesn''t exists.' + sLineBreak +
+ 'Do you want the JCL installer to create it?';
+ RsErrorCantCreatePath = 'The path %s cannot be created';
+ RsWarningAddPathToEnvironment = 'The path where BPL are created must be present in the PATH' + sLineBreak +
+ 'environment variable, otherwise JCL packages won''t be found by the IDE.' + sLineBreak +
+ 'Do you want the JCL installer to add it?' + sLineBreak +
+ 'You will have to reboot your computer and/or to close your session to validate this change';
+ RsHtmlHelp2Credentials = 'Registering HTML Help 2.0 files requires administrator privilege to be performed' + sLineBreak +
+ 'The RegHelper.exe utility will make this operation';
+
+type
+ TOptionRec = record
+ Id: Integer;
+ Caption: string;
+ Hint: string;
+ end;
+
+var
+ OptionData: array[TInstallerOption] of TOptionRec =
+ (
+ (Id: -1; Caption: RsCaptionLibrary; Hint: RsHintLibrary), // joLibrary
+ (Id: -1; Caption: RsCaptionDef; Hint: RsHintDef), // joDef
+ (Id: -1; Caption: RsCaptionDefMath; Hint: RsHintDefMath), // joDefMath
+ (Id: -1; Caption: RsCaptionDefDebug; Hint: RsHintDefDebug), // joDefDebug
+ (Id: -1; Caption: RsCaptionDefEDI; Hint: RsHintDefEDI), // joDefEDI
+ (Id: -1; Caption: RsCaptionDefPCRE; Hint: RsHintDefPCRE), // joDefPCRE
+ (Id: -1; Caption: RsCaptionDefBZip2; Hint: RsHintDefBZip2), // joDefBZip2
+ (Id: -1; Caption: RsCaptionDefZLib; Hint: RsHintDefZLib), // joDefZLib
+ (Id: -1; Caption: RsCaptionDefUnicode; Hint: RsHintDefUnicode), // joDefUnicode
+ (Id: -1; Caption: RsCaptionDefContainer; Hint: RsHintDefContainer), // joDefContainer
+ (Id: -1; Caption: RsCaptionDef7z; Hint: RsHintDef7z), // joDef7z
+ (Id: -1; Caption: RsCaptionDefThreadSafe; Hint: RsHintDefThreadSafe), // joDefThreadSafe
+ (Id: -1; Caption: RsCaptionDefDropObsoleteCode; Hint: RsHintDefDropObsoleteCode), // joDefDropObsoleteCode
+ (Id: -1; Caption: RsCaptionDefUnitVersioning; Hint: RsHintDefUnitVersioning), // joDefUnitVersioning
+ (Id: -1; Caption: RsCaptionDefMathPrecSingle; Hint: RsHintDefMathPrecSingle), // ioDefMathPrecSingle
+ (Id: -1; Caption: RsCaptionDefMathPrecDouble; Hint: RsHintDefMathPrecDouble), // joDefMathPrecDouble
+ (Id: -1; Caption: RsCaptionDefMathPrecExtended; Hint: RsHintDefMathPrecExtended), // joDefMathPrecExtended
+ (Id: -1; Caption: RsCaptionDefMathExtremeValues; Hint: RsHintDefMathExtremeValues), // joDefMathExtremeValues
+ (Id: -1; Caption: RsCaptionDefHookDllExceptions; Hint: RsHintDefHookDllExceptions), // joDefHookDllExceptions
+ (Id: -1; Caption: RsCaptionDefDebugNoBinary; Hint: RsHintDefDebugNoBinary), // joDefDebugNoBinary
+ (Id: -1; Caption: RsCaptionDefDebugNoTD32; Hint: RsHintDefDebugNoTD32), // joDefDebugNoTD32
+ (Id: -1; Caption: RsCaptionDefDebugNoMap; Hint: RsHintDefDebugNoMap), // joDefDebugNoMap
+ (Id: -1; Caption: RsCaptionDefDebugNoExports; Hint: RsHintDefDebugNoExports), // joDefDebugNoExports
+ (Id: -1; Caption: RsCaptionDefDebugNoSymbols; Hint: RsHintDefDebugNoSymbols), // joDefDebugNoSymbols
+ (Id: -1; Caption: RsCaptionDefEDIWeakPackageUnits; Hint: RsHintDefEDIWeakPackageUnits), // joDefEDIWeakPackageUnits
+ (Id: -1; Caption: RsCaptionDefPCREStaticLink; Hint: RsHintDefPCREStaticLink), // joDefPCREStaticLink
+ (Id: -1; Caption: RsCaptionDefPCRELinkDLL; Hint: RsHintDefPCRELinkDLL), // joDefPCRELinkDLL
+ (Id: -1; Caption: RsCaptionDefPCRELinkOnRequest; Hint: RsHintDefPCRELinkOnRequest), // joDefPCRELinkOnRequest
+ (Id: -1; Caption: RsCaptionDefBZip2StaticLink; Hint: RsHintDefBZip2StaticLink), // joDefBZip2StaticLink
+ (Id: -1; Caption: RsCaptionDefBZip2LinkDLL; Hint: RsHintDefBZip2LinkDLL), // joDefBZip2LinkDLL
+ (Id: -1; Caption: RsCaptionDefBZip2LinkOnRequest; Hint: RsHintDefBZip2LinkOnRequest), // joDefBZip2LinkOnRequest
+ (Id: -1; Caption: RsCaptionDefZLibStaticLink; Hint: RsHintDefZLibStaticLink), // joDefZLibStaticLink
+ (Id: -1; Caption: RsCaptionDefZLibLinkDLL; Hint: RsHintDefZLibLinkDLL), // joDefZLibLinkDLL
+ (Id: -1; Caption: RsCaptionDefZLibLinkOnRequest; Hint: RsHintDefZLibLinkOnRequest), // joDefZLibLinkOnRequest
+ (Id: -1; Caption: RsCaptionDefUnicodeSilentFailure; Hint: RsHintDefUnicodeSilentFailure), // joDefUnicodeSilentFailure
+ (Id: -1; Caption: RsCaptionDefUnicodeRawData; Hint: RsHintDefUnicodeRawData), // joDefUnicodeRawData
+ (Id: -1; Caption: RsCaptionDefUnicodeZLibData; Hint: RsHintDefUnicodeZLibData), // joDefUnicodeZLibData
+ (Id: -1; Caption: RsCaptionDefUnicodeBZip2Data; Hint: RsHintDefUnicodeBZip2Data), // joDefUnicodeBZip2Data
+ (Id: -1; Caption: RsCaptionDefContainerAnsiStr; Hint: RsHintDefContainerAnsiStr), // joDefContainerAnsiStr
+ (Id: -1; Caption: RsCaptionDefContainerWideStr; Hint: RsHintDefContainerWideStr), // joDefContainerWideStr
+ (Id: -1; Caption: RsCaptionDefContainerUnicodeStr; Hint: RsHintDefContainerUnicodeStr), // joDefContainerUnicodeStr
+ (Id: -1; Caption: RsCaptionDefContainerNoStr; Hint: RsHintDefContainerNoStr), // joDefContainerNoStr
+ //(Id: -1; Caption: RsCaptionDef7zStaticLink; Hint: RsHintDef7zStaticLink), // joDef7zStaticLink
+ (Id: -1; Caption: RsCaptionDef7zLinkDLL; Hint: RsHintDef7zLinkDLL), // joDef7zLinkDLL
+ (Id: -1; Caption: RsCaptionDef7zLinkOnRequest; Hint: RsHintDef7zLinkOnRequest), // joDef7zLinkOnRequest
+ (Id: -1; Caption: RsCaptionEnvironment; Hint: RsHintEnvironment), // joEnvironment
+ (Id: -1; Caption: RsCaptionEnvLibPath; Hint: RsHintEnvLibPath), // joEnvLibPath
+ (Id: -1; Caption: RsCaptionEnvBrowsingPath; Hint: RsHintEnvBrowsingPath), // joEnvBrowsingPath
+ (Id: -1; Caption: RsCaptionEnvDebugDCUPath; Hint: RsHintEnvDebugDCUPath), // joEnvDebugDCUPath
+ (Id: -1; Caption: RsCaptionMake; Hint: RsHintMake), // joMake
+ (Id: -1; Caption: RsCaptionMakeRelease; Hint: RsHintMakeRelease), // joMakeRelease
+ (Id: -1; Caption: RsCaptionMakeVClx; Hint: RsHintMakeReleaseVClx), // joMakeReleaseVClx
+ (Id: -1; Caption: RsCaptionMakeVCL; Hint: RsHintMakeReleaseVCL), // joMakeReleaseVCL
+ (Id: -1; Caption: RsCaptionMakeDebug; Hint: RsHintMakeDebug), // joMakeDebug
+ (Id: -1; Caption: RsCaptionMakeVClx; Hint: RsHintMakeDebugVClx), // joMakeDebugVClx
+ (Id: -1; Caption: RsCaptionMakeVCL; Hint: RsHintMakeDebugVCL), // joMakeDebugVCL
+ (Id: -1; Caption: RsCaptionCopyHppFiles; Hint: RsHintCopyHppFiles), // joCopyHppFiles
+ (Id: -1; Caption: RsCaptionCheckHppFiles; Hint: RsHintCheckHppFiles), // joCheckHppFiles
+ (Id: -1; Caption: RsCaptionPackages; Hint: RsHintPackages), // joPackages
+ (Id: -1; Caption: RsCaptionVclPackage; Hint: RsHintVclPackage), // joVclPackage
+ (Id: -1; Caption: RsCaptionClxPackage; Hint: RsHintClxPackage), // joClxPackage
+ (Id: -1; Caption: RsCaptionDualPackages; Hint: RsHintDualPackages), // joDualPackages
+ (Id: -1; Caption: RsCaptionCopyPackagesHppFiles; Hint: RsHintCopyPackagesHppFiles), // joCopyPackagesHppFiles
+ (Id: -1; Caption: RsCaptionPdbCreate; Hint: RsHintPdbCreate), // joPdbCreate
+ (Id: -1; Caption: RsCaptionMapCreate; Hint: RsHintMapCreate), // joMapCreate
+ (Id: -1; Caption: RsCaptionJdbgCreate; Hint: RsHintJdbgCreate), // joJdbgCreate
+ (Id: -1; Caption: RsCaptionJdbgInsert; Hint: RsHintJdbgInsert), // joJdbgInsert
+ (Id: -1; Caption: RsCaptionMapDelete; Hint: RsHintMapDelete), // joMapDelete
+ (Id: -1; Caption: RsCaptionExperts; Hint: RsHintExperts), // joExperts
+ (Id: -1; Caption: RsCaptionExpertsDsgnPackages; Hint: RsHintExpertsDsgnPackages), // joExpertsDsgnPackages
+ (Id: -1; Caption: RsCaptionExpertsDLL; Hint: RsHintExpertsDLL), // joExpertsDLL
+ (Id: -1; Caption: RsCaptionExpertDebug; Hint: RsHintExpertDebug), // joExpertDebug
+ (Id: -1; Caption: RsCaptionExpertAnalyzer; Hint: RsHintExpertAnalyzer), // joExpertAnalyzer
+ (Id: -1; Caption: RsCaptionExpertFavorite; Hint: RsHintExpertFavorite), // joExpertFavorite
+ (Id: -1; Caption: RsCaptionExpertRepository; Hint: RsHintExpertRepository), // joExpertRepository
+ (Id: -1; Caption: RsCaptionExpertThreadNames; Hint: RsHintExpertThreadNames), // joExpertThreadNames
+ (Id: -1; Caption: RsCaptionExpertUses; Hint: RsHintExpertUses), // joExpertUses
+ (Id: -1; Caption: RsCaptionExpertSimdView; Hint: RsHintExpertSimdView), // joExpertSimdView
+ (Id: -1; Caption: RsCaptionExpertVersionControl; Hint: RsHintExpertVersionControl), // joExpertVersionControl
+ (Id: -1; Caption: RsCaptionExceptDlg; Hint: RsHintExceptDlg), // joExceptDlg
+ (Id: -1; Caption: RsCaptionExceptDlgVCL; Hint: RsHintExceptDlgVCL), // joExceptDlgVCL
+ (Id: -1; Caption: RsCaptionExceptDlgVCLSnd; Hint: RsHintExceptDlgVCLSnd), // joExceptDlgVCLSnd
+ (Id: -1; Caption: RsCaptionExceptDlgCLX; Hint: RsHintExceptDlgCLX), // joExceptDlgCLX
+ (Id: -1; Caption: RsCaptionHelp; Hint: RsHintHelp), // joHelp
+ (Id: -1; Caption: RsCaptionHelpHlp; Hint: RsHintHelpHlp), // joHelpHlp
+ (Id: -1; Caption: RsCaptionHelpChm; Hint: RsHintHelpChm), // joHelpChm
+ (Id: -1; Caption: RsCaptionHelpHxS; Hint: RsHintHelpHxS), // joHelpHxS
+ (Id: -1; Caption: RsCaptionHelpHxSPlugin; Hint: RsHintHelpHxSPlugin), // joHelpHxSPlugin
+ (Id: -1; Caption: RsCaptionMakeDemos; Hint: RsHintMakeDemos) // joMakeDemos
+ );
+
+const
+ {$IFDEF KYLIX}
+ VersionDir = '/k%d';
+ VersionDirExp = '/k%%d';
+ {$ELSE}
+ VersionDir = '\%s';
+ VersionDirExp = '\%%s';
+ {$ENDIF}
+
+ // native packages
+ JclDpk = 'Jcl';
+ JclContainersDpk = 'JclContainers';
+ JclVclDpk = 'JclVcl';
+ JclVClxDpk = 'JclVClx';
+
+ // .net packages
+ JediJclDpk = 'Jedi.Jcl';
+ JediJclContainersDpk = 'Jedi.JclContainers';
+
+ JclExpertBase = 'JclBaseExpert';
+ JclExpertDebug = 'JclDebugExpert';
+ JclExpertAnalyzer = 'JclProjectAnalysisExpert';
+ JclExpertFavorite = 'JclFavoriteFoldersExpert';
+ JclExpertRepository = 'JclRepositoryExpert';
+ JclExpertThrNames = 'JclThreadNameExpert';
+ JclExpertUses = 'JclUsesExpert';
+ JclExpertSimdView = 'JclSIMDViewExpert';
+ JclExpertVersionControl = 'JclVersionControlExpert';
+
+ SupportedExperts: array [joJCLExperts..joJCLExpertVersionControl] of string =
+ (
+ JclExpertBase, '', '', JclExpertDebug, JclExpertAnalyzer,
+ JclExpertFavorite, JclExpertRepository, JclExpertThrNames,
+ JclExpertUses, JclExpertSimdView, JclExpertVersionControl
+ );
+
+ OldExperts: array [0..6] of string =
+ ( 'JclDebugIde', 'ProjectAnalyzer', 'IdeOpenDlgFavorite', 'ThreadNameExpert', 'JediUses', 'JclSIMDView', 'JclVersionControl' );
+
+ JclSrcDirWindows = 'windows';
+ JclSrcDirUnix = 'unix';
+ JclSrcDirVcl = 'vcl';
+ JclSrcDirCommon = 'common';
+ JclSrcDirVisClx = 'visclx';
+
+ BCBIncludePath = '%s' + DirSeparator + '%s' + DirSeparator + '$(BCB)' + DirDelimiter + 'include;$(BCB)' + DirDelimiter + 'include' + DirDelimiter + 'vcl';
+ {$IFDEF MSWINDOWS}
+ BCBObjectPath = '%s;%s;$(BCB)\Lib\Obj';
+ JclSourceDirs: array[0..3] of string = (JclSrcDirCommon, JclSrcDirWindows, JclSrcDirVcl, JclSrcDirVisClx);
+ {$ENDIF MSWINDOWS}
+ {$IFDEF UNIX}
+ BCBObjectPath = BCBIncludePath;
+ JclSourceDirs: array[0..2] of string = (JclSrcDirCommon, JclSrcDirUnix, JclSrcDirVisClx);
+ {$ENDIF UNIX}
+
+ ExceptDlgPath = 'experts' + DirDelimiter + 'debug' + DirDelimiter + 'dialog' + DirDelimiter;
+ ExceptDlgClxFileName = 'ClxExceptDlg.pas';
+ ExceptDlgVclFileName = 'ExceptDlg.pas';
+ ExceptDlgVclSndFileName = 'ExceptDlgMail.pas';
+
+ ExceptDlgClxName = 'CLX Exception Dialog';
+ ExceptDlgVclName = 'Exception Dialog';
+ ExceptDlgVclSndName = 'Exception Dialog with Send';
+
+ ExceptDlgDescription = 'JCL Application exception dialog';
+ ExceptDlgAuthor = 'Project JEDI';
+ ExceptDlgPage = 'Dialogs';
+
+ JclChmHelpFile = 'help' + DirDelimiter + 'JCLHelp.chm';
+ JclHlpHelpFile = 'help' + DirDelimiter + 'JCLHelp.hlp';
+ JclHxSHelpFile = 'help' + DirDelimiter + 'JCLHelp.HxS';
+
+ Help2NameSpace = 'Jedi.Jcl';
+ Help2Collection = 'JCLHelp_COL_MASTER.HxC';
+ Help2Description = 'JEDI Code Library';
+ Help2Identifier = 'JCLHelp';
+ Help2LangId = 1033; // en/english
+ Help2HxSFile = 'JCLHelp.HxS';
+ Help2HxIFile = 'JCLHelp.HxI';
+
+ JclHelpTitle = 'JCL %d.%d Help';
+ JclHelpIndexName = 'JEDI Code Library Reference';
+ HHFileName = 'HH.EXE';
+
+ {$IFDEF VisualCLX}
+ ReadmeFileName = 'Readme.html';
+ {$ELSE}
+ ReadmeFileName = 'Readme.txt';
+ {$ENDIF}
+
+ DailyRevisionFileName = 'jcl-revision.txt';
+ EntriesFileName1 = '.svn' + DirDelimiter + 'entries';
+ EntriesFileName2 = '_svn' + DirDelimiter + 'entries';
+
+ RsJclVersionMask = 'JCL %d.%d %s %s %d';
+ RsJclVersionBuild = 'Build';
+ RsJclVersionRevision = 'Revision';
+ RsJclVersionTesting = 'Testing';
+ RsJclVersionRelease = 'Release';
+
+ {$IFDEF MSWINDOWS}
+ Bcb2MakTemplate = 'packages\BCB.bmk';
+ {$ENDIF MSWINDOWS}
+ {$IFDEF KYLIX}
+ Bcb2MakTemplate = 'packages/bcb.gmk';
+ {$ENDIF KYLIX}
+
+ PathEnvironmentVar = 'PATH';
+ RegHKCUEnvironmentVar = 'Environment';
+ RegHKLMEnvironmentVar = 'SYSTEM\CurrentControlSet\Control\Session Manager\Environment';
+
+ ProfilesSectionName = 'Profiles';
+
+resourcestring
+ RsInstallMessage = '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 = 'Invalid BPL path "%s"';
+ RsInvalidDcpPath = 'Invalid DCP path "%s"';
+ RsLibDescriptor = '%s library %sunits for %s';
+
+function FullPackageFileName(Target: TJclBorRADToolInstallation; const BaseName: string): string;
+const
+ S = 'packages' + VersionDir + DirDelimiter + '%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;
+
+function FullLibraryFileName(Target: TJclBorRADToolInstallation; const BaseName: string): string;
+const
+ S = 'packages' + VersionDir + DirDelimiter + '%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;
+
+//=== { TJclInstallation } ===================================================
+
+constructor TJclInstallation.Create(JclDistribution: TJclDistribution;
+ InstallTarget: TJclBorRADToolInstallation; const ACLRVersion: string;
+ ATargetPlatform: TJclBorPlatform; AGUIPage: IJediInstallPage);
+begin
+ inherited Create;
+
+ FTarget := InstallTarget;
+ if not Target.Valid then
+ Abort;
+
+ FDistribution := JclDistribution;
+ FCLRVersion := ACLRVersion;
+ FTargetPlatform := ATargetPlatform;
+ FTargetName := Target.Name;
+ if CLRVersion <> '' then
+ FTargetName := Format('%s CLR %s', [FTargetName, CLRVersion]);
+
+ // exclude C#Builder 1, Delphi 8 and .net targets
+ FRunTimeInstallation := (CLRVersion <> '') or (Target.RadToolKind <> brBorlandDevStudio)
+ or ((Target.VersionNumber >= 3) and (bpDelphi32 in Target.Personalities));
+
+ case TargetPlatform of
+ //bp32bit:
+ // begin
+ // FTargetName := Format('%s %s', [FTargetName, Personality32Bit]);
+ // LibDirMask := LibDirMask + '.x86';
+ // end;
+ bp64bit:
+ begin
+ FTargetName := Format('%s %s', [FTargetName, Personality64Bit]);
+ end;
+ end;
+
+ FLibReleaseDir := MakePath(Distribution.LibReleaseDirMask);
+ FLibDebugDir := MakePath(Distribution.LibDebugDirMask);
+ FJclDcpPath := PathAddSeparator(MakePath(Distribution.LibReleaseDirMask)); // packages are release
+
+ FDemoSectionName := Target.Name + ' demos';
+ FLogFileName := Format('%sbin%s%s.log', [Distribution.JclPath, DirDelimiter, TargetName]);
+ FLogLines := TJclSimpleLog.Create(FLogFileName);
+
+ FProfilesTargets := TObjectList.Create;
+ FProfilesTargets.Count := InstallCore.ProfilesManager.ProfileCount;
+ FProfilesTargets.OwnsObjects := False;
+end;
+
+destructor TJclInstallation.Destroy;
+var
+ Index: Integer;
+begin
+ if Assigned(FProfilesTargets) then
+ for Index := 0 to FProfilesTargets.Count - 1 do
+ if FProfilesTargets.Items[Index] <> Target then
+ FProfilesTargets.Items[Index].Free;
+ FProfilesTargets.Free;
+ FDemoList.Free;
+ FLogLines.Free;
+ FGUI := nil;
+ FGUIPage := nil;
+
+ inherited Destroy;
+end;
+
+function TJclInstallation.GetEnabled: Boolean;
+begin
+ Result := OptionCheckedById[OptionData[joJediCodeLibrary].Id];
+end;
+
+function TJclInstallation.GetIsProfileEnabled(Index: Integer): Boolean;
+var
+ AProfilesPage: IJediProfilesPage;
+ ASettings: IJediConfiguration;
+begin
+ AProfilesPage := FDistribution.ProfilesPage;
+ ASettings := InstallCore.Configuration;
+ if AProfilesPage <> nil then
+ Result := AProfilesPage.IsProfileEnabled[Index]
+ else
+ if ASettings <> nil then
+ Result := ASettings.OptionAsBoolByName[ProfilesSectionName, InstallCore.ProfilesManager.ProfileNames[Index]]
+ else
+ Result := True;
+end;
+
+function TJclInstallation.GetOptionChecked(Option: TInstallerOption): Boolean;
+begin
+ Result := OptionCheckedById[OptionData[Option].Id];
+end;
+
+function TJclInstallation.GetOptionCheckedById(Id: Integer): Boolean;
+var
+ AConfiguration: IJediConfiguration;
+begin
+ if Assigned(GUIPage) then
+ Result := GUIPage.OptionChecked[Id]
+ else
+ begin
+ AConfiguration := InstallCore.Configuration;
+ if Assigned(AConfiguration) then
+ Result := AConfiguration.OptionAsBool[TargetName, Id]
+ else
+ Result := False;
+ end;
+end;
+
+function TJclInstallation.GetProfilesTarget(Index: Integer): TJclBorRADToolInstallation;
+{$IFDEF MSWINDOWS}
+var
+ RootKey: LongWord;
+begin
+ if FProfilesTargets.Items[Index] = nil then
+ begin
+ RootKey := InstallCore.ProfilesManager.GetProfileKey(Index);
+ if RootKey <> HKCU then
+ begin
+ FProfilesTargets.Items[Index] := TJclBorRADToolInstallationClass(Target.ClassType).Create(Target.ConfigDataLocation, RootKey);
+ TJclBorRADToolInstallation(FProfilesTargets.Items[Index]).OutputCallback := Target.OutputCallback;
+ end
+ else
+ FProfilesTargets.Items[Index] := Target;
+ end;
+ Result := FProfilesTargets.Items[Index] as TJclBorRADToolInstallation;
+end;
+{$ENDIF MSWINDOWS}
+{$IFDEF LINUX}
+begin
+ Result := nil;
+end;
+{$ENDIF LINUX}
+
+procedure TJclInstallation.MarkOptionBegin(Id: Integer);
+begin
+ if Assigned(GUIPage) then
+ GUIPage.MarkOptionBegin(Id);
+ if Assigned(GUI) then
+ GUI.Status := InstallCore.InstallOptionName[Id];
+end;
+
+procedure TJclInstallation.MarkOptionBegin(Option: TInstallerOption);
+begin
+ if Assigned(GUIPage) then
+ GUIPage.MarkOptionBegin(OptionData[Option].Id);
+ if Assigned(GUI) then
+ GUI.Status := OptionData[Option].Hint;
+end;
+
+procedure TJclInstallation.MarkOptionEnd(Id: Integer; Success: Boolean);
+begin
+ if Assigned(GUIPage) then
+ begin
+ GUIPage.MarkOptionEnd(Id, not Success);
+ if Assigned(GUI) then
+ GUI.Progress := Round(100 * (Distribution.NbInstalled + GUIPage.Progress / 100) / Distribution.NbEnabled);
+ end;
+end;
+
+procedure TJclInstallation.MarkOptionEnd(Option: TInstallerOption; Success: Boolean);
+begin
+ if Assigned(GUIPage) then
+ begin
+ GUIPage.MarkOptionEnd(OptionData[Option].Id, not Success);
+ if Assigned(GUI) then
+ GUI.Progress := Round(100 * (Distribution.NbInstalled + GUIPage.Progress / 100) / Distribution.NbEnabled);
+ end;
+end;
+
+procedure TJclInstallation.Init;
+ procedure AddOption(Option: TInstallerOption; GUIOptions: TJediInstallGUIOptions;
+ Parent: Integer; const Caption, Hint: string); overload;
+ begin
+ GUIPage.AddInstallOption(OptionData[Option].Id, GUIOptions, Caption, Hint, Parent);
+ end;
+
+ procedure AddOption(Option: TInstallerOption; GUIOptions: TJediInstallGUIOptions;
+ Parent: Integer); overload;
+ begin
+ AddOption(Option, GUIOptions, Parent, OptionData[Option].Caption, OptionData[Option].Hint);
+ end;
+
+ procedure AddOption(Option: TInstallerOption; GUIOptions: TJediInstallGUIOptions;
+ Parent: TInstallerOption); overload;
+ begin
+ AddOption(Option, GUIOptions, OptionData[Parent].Id, OptionData[Option].Caption, OptionData[Option].Hint);
+ end;
+
+ procedure AddDefOptions(Parent: TInstallerOption);
+ begin
+ AddOption(joJCLDefThreadSafe, [goChecked], Parent);
+ AddOption(joJCLDefDropObsoleteCode, [goChecked], Parent);
+ if CLRVersion = '' then
+ AddOption(joJCLDefUnitVersioning, [goChecked], Parent);
+
+ AddOption(joJCLDefMath, [goChecked], Parent);
+ AddOption(joJCLDefMathPrecSingle, [goRadioButton], joJCLDefMath);
+ AddOption(joJCLDefMathPrecDouble, [goRadioButton], joJCLDefMath);
+ AddOption(joJCLDefMathPrecExtended, [goRadioButton, goChecked], joJCLDefMath);
+ AddOption(joJCLDefMathExtremeValues, [goChecked], joJCLDefMath);
+
+ AddOption(joJCLDefContainer, [goChecked], Parent);
+ if (Target.RadToolKind = brBorlandDevStudio) and (Target.IDEVersionNumber >= 6) then
+ begin
+ AddOption(joJCLDefContainerAnsiStr, [goRadioButton], joJCLDefContainer);
+ AddOption(joJCLDefContainerWideStr, [goRadioButton], joJCLDefContainer);
+ AddOption(joJCLDefContainerUnicodeStr, [goRadioButton, goChecked], joJCLDefContainer);
+ end
+ else
+ if CLRVersion = '' then
+ begin
+ AddOption(joJCLDefContainerAnsiStr, [goRadioButton, goChecked], joJCLDefContainer);
+ AddOption(joJCLDefContainerWideStr, [goRadioButton], joJCLDefContainer);
+ AddOption(joJCLDefContainerUnicodeStr, [goRadioButton], joJCLDefContainer);
+ end
+ else
+ begin
+ AddOption(joJCLDefContainerAnsiStr, [goRadioButton], joJCLDefContainer);
+ AddOption(joJCLDefContainerWideStr, [goRadioButton, goChecked], joJCLDefContainer);
+ AddOption(joJCLDefContainerUnicodeStr, [goRadioButton], joJCLDefContainer);
+ end;
+ AddOption(joJCLDefContainerNoStr, [goRadioButton], joJCLDefContainer);
+
+ if CLRVersion = '' then // these units are not CLR compliant
+ begin
+ {$IFDEF MSWINDOWS}
+ // debug options
+ AddOption(joJCLDefDebug, [goNoAutoCheck], Parent);
+ AddOption(joJCLDefHookDllExceptions, [goNoAutoCheck], joJCLDefDebug);
+ AddOption(joJCLDefDebugNoBinary, [goNoAutoCheck], joJCLDefDebug);
+ AddOption(joJCLDefDebugNoTD32, [goNoAutoCheck], joJCLDefDebug);
+ AddOption(joJCLDefDebugNoMap, [goNoAutoCheck], joJCLDefDebug);
+ AddOption(joJCLDefDebugNoExports, [goNoAutoCheck], joJCLDefDebug);
+ AddOption(joJCLDefDebugNoSymbols, [goNoAutoCheck], joJCLDefDebug);
+ {$ENDIF MSWINDOWS}
+ // EDI options
+ AddOption(joJCLDefEDI, [goNoAutoCheck], Parent);
+ AddOption(joJCLDefEDIWeakPackageUnits, [goNoAutoCheck], joJCLDefEDI);
+ // PCRE options
+ AddOption(joJCLDefPCRE, [goChecked], Parent);
+ if Target.RadToolKind = brBorlandDevStudio then
+ begin
+ AddOption(joJCLDefPCREStaticLink, [goRadioButton, goChecked], joJCLDefPCRE);
+ AddOption(joJCLDefPCRELinkOnRequest, [goRadioButton], joJCLDefPCRE);
+ end
+ else
+ AddOption(joJCLDefPCRELinkOnRequest, [goRadioButton, goChecked], joJCLDefPCRE);
+ AddOption(joJCLDefPCRELinkDLL, [goRadioButton], joJCLDefPCRE);
+ // BZip2 options
+ AddOption(joJCLDefBZip2, [goChecked], Parent);
+ AddOption(joJCLDefBZip2StaticLink, [goRadioButton, goChecked], joJCLDefBZip2);
+ AddOption(joJCLDefBZip2LinkOnRequest, [goRadioButton], joJCLDefBZip2);
+ AddOption(joJCLDefBZip2LinkDLL, [goRadioButton], joJCLDefBZip2);
+ // ZLib options
+ AddOption(joJCLDefZLib, [goChecked], Parent);
+ AddOption(joJCLDefZLibStaticLink, [goRadioButton, goChecked], joJCLDefZLib);
+ AddOption(joJCLDefZLibLinkOnRequest, [goRadioButton], joJCLDefZLib);
+ AddOption(joJCLDefZLibLinkDLL, [goRadioButton], joJCLDefZLib);
+ // Unicode options
+ AddOption(joJCLDefUnicode, [goChecked], Parent);
+ AddOption(joJCLDefUnicodeSilentFailure, [goChecked], joJCLDefUnicode);
+ AddOption(joJCLDefUnicodeRawData, [goRadioButton, goChecked], joJCLDefUnicode);
+ AddOption(joJCLDefUnicodeZLibData, [goRadioButton], joJCLDefUnicode);
+ AddOption(joJCLDefUnicodeBZip2Data, [goRadioButton], joJCLDefUnicode);
+ {$IFDEF MSWINDOWS}
+ // Sevenzip options
+ AddOption(joJCLDef7z, [goChecked], Parent);
+ //AddOption(joJCLDef7zStaticLink, [goRadioButton], joDef7z);
+ AddOption(joJCLDef7zLinkOnRequest, [goRadioButton, goChecked], joJCLDef7z);
+ AddOption(joJCLDef7zLinkDLL, [goRadioButton], joJCLDef7z);
+ {$ENDIF MSWINDOWS}
+ end;
+ end;
+
+ procedure AddEnvOptions(Parent: TInstallerOption);
+ begin
+ AddOption(joJCLEnvLibPath, [goChecked], Parent);
+ AddOption(joJCLEnvBrowsingPath, [goChecked], Parent);
+ if not Target.IsTurboExplorer then
+ AddOption(joJCLEnvDebugDCUPath, [goChecked], Parent);
+ end;
+
+ procedure AddMakeOptions(Parent: TInstallerOption);
+ begin
+ AddOption(joJCLMakeRelease, [goStandAloneParent, goExpandable, goChecked], Parent);
+ AddOption(joJCLMakeDebug, [goStandAloneParent, goExpandable, goChecked], Parent);
+
+ if CLRVersion = '' then
+ begin
+ if Target.SupportsVisualCLX then
+ begin
+ AddOption(joJCLMakeReleaseVClx, [goChecked], joJCLMakeRelease);
+ AddOption(joJCLMakeDebugVClx, [goChecked], joJCLMakeDebug);
+ end;
+
+ if Target.SupportsVCL then
+ begin
+ AddOption(joJCLMakeReleaseVCL, [goChecked], joJCLMakeRelease);
+ AddOption(joJCLMakeDebugVCL, [goChecked], joJCLMakeDebug);
+ end;
+
+ if bpBCBuilder32 in Target.Personalities then
+ begin
+ AddOption(joJCLCopyHppFiles, [goChecked], OptionData[joJCLMake].Id,
+ Format(OptionData[joJCLCopyHppFiles].Caption, [Target.VclIncludeDir]),
+ OptionData[joJCLCopyHppFiles].Hint);
+ AddOption(joJCLCheckHppFiles, [goChecked], joJCLMake);
+ end;
+ end;
+ end;
+
+ procedure AddHelpOptions(Parent: TInstallerOption);
+ begin
+ {$IFDEF MSWINDOWS}
+ if Target.RadToolKind = brBorlandDevStudio then
+ begin
+ // TODO: expert help
+ if (Target.VersionNumber >= 3) and (Distribution.JclHxSHelpFileName <> '') then
+ begin
+ AddOption(joJCLHelp, [goChecked], Parent);
+ AddOption(joJCLhelpHxS, [goStandaloneParent,goChecked], joJCLHelp);
+ AddOption(joJCLHelpHxSPlugin, [goNoAutoCheck], joJCLHelpHxS);
+ end;
+ end
+ else
+ begin
+ if (Distribution.JclHlpHelpFileName <> '') or (Distribution.JclChmHelpFileName <> '') then
+ begin
+ AddOption(joJCLHelp, [goChecked], Parent);
+ if Distribution.JclHlpHelpFileName <> '' then
+ AddOption(joJCLHelpHlp, [goChecked], joJCLHelp);
+ if Distribution.JclChmHelpFileName <> '' then
+ AddOption(joJCLHelpChm, [goChecked], joJCLHelp);
+ end;
+ end;
+ {$ENDIF MSWINDOWS}
+ end;
+
+ procedure AddRepositoryOptions(Parent: TInstallerOption);
+ begin
+ // BDS has an expert for objects in the repository
+ if Target.RadToolKind <> brBorlandDevStudio then
+ begin
+ AddOption(joJCLExceptDlg, [], Parent);
+ if Target.SupportsVCL then
+ begin
+ AddOption(joJCLExceptDlgVCL, [], joJCLExceptDlg);
+ {$IFDEF MSWINDOWS}
+ AddOption(joJCLExceptDlgVCLSnd, [], joJCLExceptDlg);
+ {$ENDIF MSWINDOWS}
+ end;
+ if Target.SupportsVisualCLX then
+ AddOption(joJCLExceptDlgCLX, [], joJCLExceptDlg);
+ end;
+ end;
+
+ procedure AddPackageOptions(Parent: TInstallerOption);
+ begin
+ if (CLRVersion = '') and RuntimeInstallation and Target.SupportsVCL then
+ AddOption(joJCLVclPackage, [goChecked], Parent);
+ if (CLRVersion = '') and RuntimeInstallation and Target.SupportsVisualCLX then
+ AddOption(joJCLClxPackage, [goChecked], Parent);
+ if (bpBCBuilder32 in Target.Personalities) and RunTimeInstallation and (CLRVersion = '') then
+ begin
+ if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 4) then
+ begin
+ AddOption(joJCLDualPackages, [goStandAloneParent, goChecked], Parent);
+ AddOption(joJCLCopyPackagesHppFiles, [goChecked], OptionData[joJCLDualPackages].Id,
+ Format(OptionData[joJCLCopyPackagesHppFiles].Caption, [Target.VclIncludeDir]),
+ OptionData[joJCLCopyPackagesHppFiles].Hint);
+ end
+ else
+ AddOption(joJCLCopyPackagesHppFiles, [goChecked], OptionData[Parent].Id,
+ Format(OptionData[joJCLCopyPackagesHppFiles].Caption, [Target.VclIncludeDir]),
+ OptionData[joJCLCopyPackagesHppFiles].Hint);
+ end;
+
+ if CLRVersion = '' then
+ begin
+ AddOption(joJCLMapCreate, [goExpandable, goStandaloneParent, goNoAutoCheck], Parent);
+
+ {$IFDEF MSWINDOWS}
+ AddOption(joJCLJdbgCreate, [goExpandable, goStandaloneParent], joJCLMapCreate);
+ AddOption(joJCLJdbgInsert, [goNoAutoCheck], joJCLMapCreate);
+ AddOption(joJCLMapDelete, [goNoAutoCheck], joJCLMapCreate);
+
+ {if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber = 3)
+ and (Target.Edition = deStd) then
+ CopyFakeXmlRtlPackage;
+ TODO: CopyFakeXmlRtlPackage
+ }
+ {$ENDIF MSWINDOWS}
+ end
+ else // CLRVersion <> ''
+ AddOption(joJCLPdbCreate, [goNoAutoCheck], Parent);
+ end;
+
+ procedure AddExpertOptions(Parent: TInstallerOption);
+ {$IFDEF MSWINDOWS}
+ var
+ ExpertOptions: TJediInstallGUIOptions;
+ {$ENDIF MSWINDOWS}
+ begin
+ // 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.
+ {$IFDEF MSWINDOWS}
+ if IsWinNT then
+ ExpertOptions := [goChecked]
+ else
+ ExpertOptions := [];
+
+ AddOption(joJCLExperts, [goExpandable, goChecked], Parent);
+
+ if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber <= 2) then
+ // design packages are not loaded by C#Builder 1 and Delphi 8
+ AddOption(joJCLExpertsDLL, [goRadioButton, goChecked], joJCLExperts)
+ 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 loaded yet)
+ AddOption(joJCLExpertsDsgnPackages, [goRadioButton, goChecked], joJCLExperts)
+ else
+ begin
+ AddOption(joJCLExpertsDLL, [goRadioButton], joJCLExperts);
+ AddOption(joJCLExpertsDsgnPackages, [goRadioButton, goChecked], joJCLExperts);
+ end;
+
+ if RunTimeInstallation then
+ begin
+ AddOption(joJCLExpertDebug, ExpertOptions, joJCLExperts);
+ AddOption(joJCLExpertAnalyzer, ExpertOptions, joJCLExperts);
+ if Target.RadToolKind <> brBorlandDevStudio then
+ AddOption(joJCLExpertUses, ExpertOptions, joJCLExperts);
+ AddOption(joJCLExpertSimdView, ExpertOptions, joJCLExperts);
+ AddOption(joJCLExpertRepository, ExpertOptions, joJCLExperts);
+ end;
+ AddOption(joJCLExpertFavorite, ExpertOptions, joJCLExperts);
+ AddOption(joJCLExpertVersionControl, [goNoAutoCheck], joJCLExperts);
+ if (Target.RadToolKind <> brBorlandDevStudio) and (Target.VersionNumber <= 6) then
+ AddOption(joJCLExpertThreadNames, ExpertOptions, joJCLExperts);
+ {$ENDIF MSWINDOWS}
+ end;
+
+ procedure AddDemoNodes;
+ var
+ I: Integer;
+ ADemoList: TStrings;
+ DemoOption: Integer;
+ FileName: string;
+ begin
+ AddOption(joJCLMakeDemos, [goNoAutoCheck], joJediCodeLibrary);
+ ADemoList := GetDemoList;
+ for I := 0 to ADemoList.Count - 1 do
+ begin
+ FileName := ExtractRelativePath(Distribution.JclExamplesDir, ADemoList.Strings[I]);
+ DemoOption := InstallCore.AddInstallOption(FileName);
+ ADemoList.Objects[I] := TObject(DemoOption);
+ GUIPage.AddInstallOption(DemoOption, [], ExtractFileName(FileName), FileName, OptionData[joJCLMakeDemos].Id);
+ end;
+ end;
+
+ procedure LoadValues;
+ var
+ AConfiguration: IJediConfiguration;
+ Option: TInstallerOption;
+ Id, Index: Integer;
+ StoredValue: string;
+ ADemoList: TStrings;
+ ResetDefaultValue: Boolean;
+ begin
+ AConfiguration := InstallCore.Configuration;
+ if not Assigned(AConfiguration) then
+ Exit;
+ if AConfiguration.SectionExists(TargetName) then
+ begin
+ ResetDefaultValue := not AConfiguration.OptionAsBool[TargetName, OptionData[joJediCodeLibrary].Id];
+ for Option := Low(TInstallerOption) to High(TInstallerOption) do
+ begin
+ Id := OptionData[Option].Id;
+ if AConfiguration.ValueExists(TargetName, Id) then
+ GUIPage.OptionChecked[Id] := AConfiguration.OptionAsBool[TargetName, Id]
+ else
+ if ResetDefaultValue then
+ GUIPage.OptionChecked[Id] := False;
+ end;
+ end
+ else
+ GUIPage.OptionChecked[OptionData[joJediCodeLibrary].Id] := True;
+
+ if not Target.IsTurboExplorer then
+ begin
+ if FRunTimeInstallation and (CLRVersion = '') then
+ begin
+ ADemoList := GetDemoList;
+ if AConfiguration.SectionExists(FDemoSectionName) then
+ for Index := 0 to ADemoList.Count - 1 do
+ begin
+ Id := Integer(ADemoList.Objects[Index]);
+ GUIPage.OptionChecked[Id] := AConfiguration.OptionAsBool[FDemoSectionName, Id];
+ end;
+ end;
+
+ StoredValue := AConfiguration.OptionAsStringByName[TargetName, RsNameBPLPath];
+ if StoredValue = '' then
+ StoredValue := Target.BPLOutputPath;
+ GUIPage.Directories[FGUIBPLPathIndex] := StoredValue;
+ if Target.RadToolKind = brCppBuilder then
+ StoredValue := AConfiguration.OptionAsStringByName[TargetName, RsNameBPIPath]
+ else
+ StoredValue := AConfiguration.OptionAsStringByName[TargetName, RsNameDCPPath];
+ if StoredValue = '' then
+ StoredValue := FJclDcpPath;
+ GUIPage.Directories[FGUIDCPPathIndex] := StoredValue;
+ end;
+ end;
+
+begin
+ FGUI := InstallCore.InstallGUI;
+ if not Assigned(GUI) then
+ Exit;
+
+ FGUIPage := GUI.CreateInstallPage;
+ GUIPage.Caption := TargetName;
+ GUIPage.SetIcon(Target.IdeExeFileName);
+
+ AddOption(joJediCodeLibrary, [goExpandable, goChecked], JediTargetOption);
+
+ if RunTimeInstallation then
+ begin
+ // conditional defines
+ AddOption(joJCLDef, [goExpandable, goChecked], OptionData[joJediCodeLibrary].Id);
+ AddDefOptions(joJCLDef);
+
+ if CLRVersion = '' then
+ begin
+ AddOption(joJCLEnvironment, [goExpandable, goChecked], OptionData[joJediCodeLibrary].Id);
+ AddEnvOptions(joJCLEnvironment);
+ end;
+
+ if not Target.IsTurboExplorer then
+ begin
+ AddOption(joJCLMake, [goExpandable, goChecked], OptionData[joJediCodeLibrary].Id);
+ AddMakeOptions(joJCLMake);
+ end;
+
+ if CLRVersion = '' then
+ begin
+ AddHelpOptions(joJediCodeLibrary);
+ AddRepositoryOptions(joJediCodeLibrary);
+ end;
+ end;
+
+ if not Target.IsTurboExplorer then
+ begin
+ AddOption(joJCLPackages, [goStandAloneParent, goExpandable, goChecked], joJediCodeLibrary);
+ AddPackageOptions(joJCLPackages);
+
+ if CLRVersion = '' then
+ begin
+ {$IFDEF MSWINDOWS}
+ AddExpertOptions(joJCLPackages);
+ {$ENDIF MSWINDOWS}
+ if RunTimeInstallation then
+ AddDemoNodes;
+ end;
+ end;
+
+ GUIPage.InitDisplay;
+
+ if not Target.IsTurboExplorer then
+ begin
+ if (CLRVersion = '') then
+ begin
+ FGUIBPLPathIndex := GUIPage.AddDirectory(RsCaptionBPLPath);
+ if Target.RadToolKind = brCppBuilder then
+ FGUIDCPPathIndex := GUIPage.AddDirectory(RsCaptionBPIPath)
+ else
+ FGUIDCPPathIndex := GUIPage.AddDirectory(RsCaptionDCPPath);
+ end
+ else
+ FGUIBPLPathIndex := GUIPage.AddDirectory(RsCaptionOutputPath);
+ end;
+
+ LoadValues;
+end;
+
+function TJclInstallation.Install: Boolean;
+var
+ AProfilesManager: IJediProfilesManager;
+
+ procedure WriteIntroduction;
+ var
+ Personality: TJclBorPersonality;
+ Index: Integer;
+ begin
+ WriteLog(StrRepeat('=', 80));
+ WriteLog(Distribution.Version);
+ WriteLog('');
+ WriteLog(StrPadRight(StrRepeat('=', 10) + TargetName, 80, '='));
+ WriteLog('');
+ WriteLog('Installed personalities :');
+ for Personality := Low(TJclBorPersonality) to High(TJclBorPersonality) do
+ if Personality in Target.Personalities then
+ begin
+ WriteLog(JclBorPersonalityDescription[Personality]);
+ end;
+ WriteLog('');
+ WriteLog(StrRepeat('=', 80));
+ WriteLog('');
+ if AProfilesManager.MultipleProfileMode then
+ begin
+ for Index := 0 to AProfilesManager.ProfileCount - 1 do
+ if IsProfileEnabled[Index] then
+ WriteLog(AProfilesManager.ProfileNames[Index]);
+ end
+ else
+ WriteLog('Single profile installation');
+ WriteLog('');
+ WriteLog(StrRepeat('=', 80));
+ WriteLog('');
+ end;
+
+ function CheckDirectories: Boolean;
+ begin
+ Result := True;
+
+ {$IFDEF MSWINDOWS}
+ if (not OptionChecked[joJCLPackages] or (Target.SupportsVCL and not OptionChecked[joJCLVCLPackage])) and
+ Assigned(GUI) and (CLRVersion = '') and not Target.IsTurboExplorer then
+ Result := GUI.Dialog(RsWarningPackageNodeNotSelected, dtConfirmation, [drYes, drNo]) = drYes;
+ {$ENDIF MSWINDOWS}
+
+ if Result and OptionChecked[joJCLPackages] then
+ begin
+ Result := True;
+ if not DirectoryExists(GetBplPath) then
+ begin
+ Result := False;
+ if not Assigned(GUI) then
+ WriteLog(Format(RsInvalidBplPath, [GetBplPath]))
+ else if GUI.Dialog(Format(RsWarningCreatePath, ['BPL']), dtWarning, [drYes, drNo]) = drYes then
+ begin
+ Result := ForceDirectories(GetBplPath);
+ if not Result then
+ GUI.Dialog(Format(RsErrorCantCreatePath, [GetBplPath]), dtError, [drCancel]);
+ end;
+ end;
+ if (CLRVersion = '') and not DirectoryExists(GetDcpPath) then
+ begin
+ Result := False;
+ if not Assigned(GUI) then
+ WriteLog(Format(RsInvalidDcpPath, [GetDcpPath]))
+ else if GUI.Dialog(Format(RsWarningCreatePath, ['DCP']), dtWarning, [drYes, drNo]) = drYes then
+ begin
+ Result := ForceDirectories(GetDcpPath);
+ if not Result then
+ GUI.Dialog(Format(RsErrorCantCreatePath, [GetDcpPath]), dtError, [drCancel]);
+ end;
+ end;
+ end;
+ end;
+
+ function SetStaticOptions: Boolean;
+
+ function SaveDefines(Defines: TStrings): Boolean;
+ var
+ TemplateFileName, IncludeFileName, IncludeLine, Symbol, CLRSuffix: string;
+ IncludeFile: TStrings;
+ IndexLine, DefinePos, SymbolEnd: Integer;
+ Defined, NotDefined: Boolean;
+ const
+ DefineText = '$DEFINE';
+ NotDefineText = '.' + DefineText;
+ begin
+ WriteLog('Saving conditional defines...');
+ Result := True;
+ if CLRVersion = '' then
+ CLRSuffix := ''
+ else
+ CLRSuffix := '.net';
+ TemplateFileName := PathAddSeparator(Distribution.JclIncludeDir) + 'jcl.template.inc';
+ IncludeFileName := Format('%sjcl%s%s.inc', [PathAddSeparator(Distribution.JclIncludeDir), Target.IDEVersionNumberStr, CLRSuffix]);
+ try
+ IncludeFile := TStringList.Create;
+ try
+ IncludeFile.LoadFromFile(TemplateFileName);
+ WriteLog(Format('Loaded template for include file %s', [TemplateFileName]));
+
+ for IndexLine := 0 to IncludeFile.Count - 1 do
+ begin
+ IncludeLine := IncludeFile.Strings[IndexLine];
+ DefinePos := AnsiPos(DefineText, UpperCase(IncludeLine));
+ if DefinePos > 1 then
+ begin
+ Defined := IncludeLine[DefinePos - 1] = '{';
+ NotDefined := IncludeLine[DefinePos - 1] = '.';
+ if Defined or NotDefined then
+ begin
+ Inc(DefinePos, Length(DefineText));
+ while CharIsWhiteSpace(IncludeLine[DefinePos]) do
+ Inc(DefinePos);
+ SymbolEnd := DefinePos;
+ while CharIsValidIdentifierLetter(IncludeLine[SymbolEnd]) do
+ Inc(SymbolEnd);
+ Symbol := Copy(IncludeLine, DefinePos, SymbolEnd - DefinePos);
+ DefinePos := Defines.IndexOf(Symbol);
+
+ if (DefinePos >= 0) and NotDefined then
+ IncludeLine := StringReplace(IncludeLine, NotDefineText, DefineText, [rfIgnoreCase]);
+ if (DefinePos < 0) and Defined then
+ IncludeLine := StringReplace(IncludeLine, DefineText, NotDefineText, [rfIgnoreCase]);
+
+ IncludeFile.Strings[IndexLine] := IncludeLine;
+ end;
+ end;
+ end;
+ IncludeFile.SaveToFile(IncludeFileName);
+ WriteLog(Format('Saved include file %s', [IncludeFileName]));
+ finally
+ IncludeFile.Free;
+ end;
+ except
+ Result := False;
+ end;
+ end;
+
+ const
+ DefineNames: array [joJCLDefThreadSafe..joJCLDef7zLinkOnRequest] of string =
+ ( 'THREADSAFE', 'DROP_OBSOLETE_CODE', 'UNITVERSIONING',
+ 'MATH_SINGLE_PRECISION', 'MATH_DOUBLE_PRECISION', 'MATH_EXTENDED_PRECISION',
+ 'MATH_EXT_EXTREMEVALUES', 'HOOK_DLL_EXCEPTIONS',
+ 'DEBUG_NO_BINARY', 'DEBUG_NO_TD32', 'DEBUG_NO_MAP', 'DEBUG_NO_EXPORTS',
+ 'DEBUG_NO_SYMBOLS', 'EDI_WEAK_PACKAGE_UNITS', 'PCRE_STATICLINK',
+ 'PCRE_LINKDLL', 'PCRE_LINKONREQUEST', 'BZIP2_STATICLINK',
+ 'BZIP2_LINKDLL', 'BZIP2_LINKONREQUEST', 'ZLIB_STATICLINK',
+ 'ZLIB_LINKDLL', 'ZLIB_LINKONREQUEST', 'UNICODE_SILENT_FAILURE',
+ 'UNICODE_RAW_DATA', 'UNICODE_ZLIB_DATA', 'UNICODE_BZIP2_DATA',
+ 'CONTAINER_ANSISTR', 'CONTAINER_WIDESTR', 'CONTAINER_UNICODESTR',
+ 'CONTAINER_NOSTR', {'7ZIP_STATICLINK',} '7ZIP_LINKDLL',
+ '7ZIP_LINKONREQUEST' );
+ var
+ Option: TInstallerOption;
+ Defines: TStrings;
+ begin
+ Defines := TStringList.Create;
+ try
+ if OptionChecked[joJCLDef] then
+ begin
+ MarkOptionBegin(joJCLDef);
+ for Option := Low(DefineNames) to High(DefineNames) do
+ if OptionChecked[Option] then
+ begin
+ MarkOptionBegin(Option);
+ Defines.Add(DefineNames[Option]);
+ MarkOptionEnd(Option, True);
+ end;
+ MarkOptionEnd(joJCLDef, True);
+ end;
+ if OptionChecked[joJCLMapCreate] then
+ begin
+ MarkOptionBegin(joJCLMapCreate);
+ Target.MapCreate := True;
+ MarkOptionEnd(joJCLMapCreate, True);
+ end
+ else
+ Target.MapCreate := False;
+ {$IFDEF MSWINDOWS}
+ if OptionChecked[joJCLJdbgCreate] then
+ begin
+ MarkOptionBegin(joJCLJdbgCreate);
+ Target.JdbgCreate := True;
+ MarkOptionEnd(joJCLJdbgCreate, True);
+ end
+ else
+ Target.JdbgCreate := False;
+ if OptionChecked[joJCLJdbgInsert] then
+ begin
+ MarkOptionBegin(joJCLJdbgInsert);
+ Target.JdbgInsert := True;
+ MarkOptionEnd(joJCLJdbgInsert, True);
+ end
+ else
+ Target.JdbgInsert := False;
+ if OptionChecked[joJCLMapDelete] then
+ begin
+ MarkOptionBegin(joJCLMapDelete);
+ Target.MapDelete := True;
+ MarkOptionEnd(joJCLMapDelete, True);
+ end
+ else
+ Target.MapDelete := False;
+ if Target is TJclBDSInstallation then
+ begin
+ if OptionChecked[joJCLDualPackages] then
+ begin
+ MarkOptionBegin(joJCLDualPackages);
+ TJclBDSInstallation(Target).DualPackageInstallation := True;
+ if OptionChecked[joJCLCopyPackagesHppFiles] then
+ begin
+ MarkOptionBegin(joJCLCopyPackagesHppFiles);
+ MarkOptionEnd(joJCLCopyPackagesHppFiles, True);
+ end;
+ MarkOptionEnd(joJCLDualPackages, True);
+ end
+ else
+ TJclBDSInstallation(Target).DualPackageInstallation := False;
+ if OptionChecked[joJCLPdbCreate] then
+ begin
+ MarkOptionBegin(joJCLPdbCreate);
+ TJclBDSInstallation(Target).PdbCreate := True;
+ MarkOptionEnd(joJCLPdbCreate, True);
+ end
+ else
+ TJclBDSInstallation(Target).PdbCreate := False;
+ end;
+ {$ENDIF MSWINDOWS}
+
+ // no conditional defines for C#Builder 1 and Delphi 8
+ Result := ((Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber <= 2)) or SaveDefines(Defines);
+ finally
+ Defines.Free;
+ end;
+ end;
+
+ function SetEnvironment(ATarget: TJclBorRADToolInstallation): Boolean;
+ begin
+ Result := True;
+ if OptionChecked[joJCLEnvironment] then
+ begin
+ MarkOptionBegin(joJCLEnvironment);
+
+ if OptionChecked[joJCLEnvLibPath] then
+ begin
+ MarkOptionBegin(joJCLEnvLibPath);
+ Result := ATarget.AddToLibrarySearchPath(FLibReleaseDir) and ATarget.AddToLibrarySearchPath(Distribution.JclIncludeDir);
+ if Result then
+ begin
+ WriteLog(Format('Added "%s;%s" to library search path.', [FLibReleaseDir, Distribution.JclIncludeDir]));
+ {$IFDEF MSWINDOWS}
+ if (ATarget.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in ATarget.Personalities)
+ and OptionChecked[joJCLDualPackages] then
+ with TJclBDSInstallation(ATarget) do
+ begin
+ Result := AddToCppSearchPath(FLibReleaseDir) and AddToCppSearchPath(Distribution.JclIncludeDir) and
+ ((IDEVersionNumber < 5) or AddToCppLibraryPath(FLibReleaseDir));
+ if Result then
+ WriteLog(Format('Added "%s;%s" to cpp search path.', [FLibReleaseDir, Distribution.JclIncludeDir]))
+ else
+ WriteLog('Failed to add cpp search paths.');
+ end;
+ {$ENDIF MSWINDOWS}
+ if ATarget.IsTurboExplorer then
+ begin
+ Result := ATarget.AddToLibrarySearchPath(Distribution.JclSourcePath);
+ if Result then
+ WriteLog(Format('Added "%s" to library search path.', [Distribution.JclSourcePath]))
+ else
+ WriteLog('Failed to add library search paths.');
+ end;
+ end
+ else
+ WriteLog('Failed to add library search paths.');
+ MarkOptionEnd(joJCLEnvLibPath, Result);
+ end;
+
+ if Result and OptionChecked[joJCLEnvBrowsingPath] then
+ begin
+ MarkOptionBegin(joJCLEnvBrowsingPath);
+ if Result then
+ begin
+ Result := ATarget.AddToLibraryBrowsingPath(Distribution.JclSourcePath);
+ if Result then
+ begin
+ WriteLog(Format('Added "%s" to library browsing path.', [Distribution.JclSourcePath]));
+ {$IFDEF MSWINDOWS}
+ if (ATarget.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in ATarget.Personalities)
+ and OptionChecked[joJCLDualPackages] then
+ with TJclBDSInstallation(ATarget) do
+ begin
+ Result := AddToCppBrowsingPath(Distribution.JclSourcePath);
+ if Result then
+ WriteLog(Format('Added "%s" to cpp browsing path.', [Distribution.JclSourcePath]))
+ else
+ WriteLog('Failed to add cpp browsing paths.');
+ end;
+ {$ENDIF MSWINDOWS}
+ end
+ else
+ WriteLog('Failed to add library browsing path');
+ end
+ else
+ WriteLog('Failed to add library browsing path.');
+ MarkOptionEnd(joJCLEnvBrowsingPath, Result);
+ end;
+
+ if Result and OptionChecked[joJCLEnvDebugDCUPath] then
+ begin
+ MarkOptionBegin(joJCLEnvDebugDCUPath);
+ Result := ATarget.AddToDebugDCUPath(FLibDebugDir);
+ if Result then
+ WriteLog(Format('Added "%s" to Debug DCU Path.', [FLibDebugDir]))
+ else
+ WriteLog('Failed to add debug DCU path');
+ MarkOptionEnd(joJCLEnvDebugDCUPath, Result);
+ end;
+
+ MarkOptionEnd(joJCLEnvironment, Result);
+ end;
+ end;
+
+ function MakeUnits: Boolean;
+ function CheckHppFiles: Boolean;
+ var
+ SaveDir, Options: string;
+ begin
+ SaveDir := GetCurrentDir;
+ SetCurrentDir(Format('%sinstall%sHeaderTest', [Distribution.JclPath, DirDelimiter]));
+ try
+ Target.BCC32.Options.Clear;
+ Target.BCC32.Options.Add('-c'); // compile only
+ Target.BCC32.Options.Add('-Ve'); // compatibility
+ Target.BCC32.Options.Add('-X'); // no autodependencies
+ Target.BCC32.Options.Add('-a8'); // data alignment
+ Target.BCC32.Options.Add('-b'); // enum to be at least 4 bytes
+ Target.BCC32.Options.Add('-k-'); // no standard stack frame
+ {$IFDEF MSWINDOWS}
+ Target.BCC32.Options.Add('-tWM'); // code format
+ {$ELSE ~ MSWINDOWS}
+ Target.BCC32.Options.Add('-tC'); // code format
+ {$ENDIF ~MSWINDOWS}
+ Target.BCC32.Options.Add('-w-par'); // warning
+ Target.BCC32.Options.Add('-w-aus'); // warning
+ Target.BCC32.AddPathOption('I', Format('%sinclude%s%s%s%s%sinclude%s%s', [Distribution.JclPath, DirSeparator, Distribution.JclSourcePath, DirSeparator, Target.RootDir, DirDelimiter, DirSeparator, Target.VclIncludeDir]));
+ Target.BCC32.Options.Add('-DTEST_COMMON');
+ {$IFDEF MSWINDOWS}
+ Target.BCC32.Options.Add('-DTEST_WINDOWS');
+ {$ENDIF MSWINDOWS}
+ {$IFDEF UNIX}
+ Target.BCC32.Options.Add('-DTEST_UNIX');
+ {$ENDIF UNIX}
+ if OptionChecked[joJCLMakeReleaseVCL] or OptionChecked[joJCLMakeDebugVCL] then
+ Target.BCC32.Options.Add('-DTEST_VCL');
+ if OptionChecked[joJCLMakeReleaseVClx] or OptionChecked[joJCLMakeDebugVClx] then
+ Target.BCC32.Options.Add('-DTEST_VISCLX');
+ Options := StringsToStr(Target.BCC32.Options, NativeSpace);
+ Result := Target.BCC32.Execute(Options + ' "jcl_a2z.cpp"')
+ and Target.BCC32.Execute(Options + ' "jcl_z2a.cpp"');
+ finally
+ SetCurrentDir(SaveDir);
+ end;
+ end;
+ var
+ I: Integer;
+ begin
+ Result := True;
+ if OptionChecked[joJCLMake] then
+ begin
+ MarkOptionBegin(joJCLMake);
+
+ if OptionChecked[joJCLMakeRelease] then
+ begin
+ MarkOptionBegin(joJCLMakeRelease);
+
+ for I := Low(JclSourceDirs) to High(JclSourceDirs) do
+ begin
+ if (JclSourceDirs[I] = JclSrcDirVisClx) then
+ begin
+ if OptionChecked[joJCLMakeReleaseVClx] then
+ MarkOptionBegin(joJCLMakeReleaseVClx)
+ else
+ Continue;
+ end;
+ if (JclSourceDirs[I] = JclSrcDirVcl) then
+ begin
+ if OptionChecked[joJCLMakeReleaseVCL] or
+ ((Target.VersionNumber <= 5) and (Target.RadToolKind <> brBorlandDevStudio)) then
+ MarkOptionBegin(joJCLMakeReleaseVCL)
+ else
+ Continue;
+ end;
+ Result := Result and CompileLibraryUnits(JclSourceDirs[I], False);
+ if (JclSourceDirs[I] = JclSrcDirVisClx) then
+ MarkOptionEnd(joJCLMakeReleaseVClx, Result);
+ if (JclSourceDirs[I] = JclSrcDirVcl) then
+ MarkOptionEnd(joJCLMakeReleaseVCL, Result);
+ end;
+ MarkOptionEnd(joJCLMakeRelease, Result);
+ end;
+
+ if Result and OptionChecked[joJCLMakeDebug] then
+ begin
+ MarkOptionBegin(joJCLMakeDebug);
+ for I := Low(JclSourceDirs) to High(JclSourceDirs) do
+ begin
+ if (JclSourceDirs[I] = JclSrcDirVisClx) then
+ begin
+ if OptionChecked[joJCLMakeDebugVClx] then
+ MarkOptionBegin(joJCLMakeDebugVClx)
+ else
+ Continue;
+ end;
+ if (JclSourceDirs[I] = JclSrcDirVcl) then
+ begin
+ if OptionChecked[joJCLMakeDebugVCL] or
+ ((Target.VersionNumber <= 5) and (Target.RadToolKind <> brBorlandDevStudio)) then
+ MarkOptionBegin(joJCLMakeDebugVCL)
+ else
+ Continue;
+ end;
+ Result := Result and CompileLibraryUnits(JclSourceDirs[I], True);
+ if (JclSourceDirs[I] = JclSrcDirVisClx) then
+ MarkOptionEnd(joJCLMakeDebugVClx, Result);
+ if (JclSourceDirs[I] = JclSrcDirVcl) then
+ MarkOptionEnd(joJCLMakeDebugVCL, Result);
+ end;
+ MarkOptionEnd(joJCLMakeDebug, Result);
+ end;
+
+ if Result and OptionChecked[joJCLCheckHppFiles] then
+ begin
+ MarkOptionBegin(joJCLCheckHppFiles);
+ WriteLog('Checking .hpp files');
+ Result := Result and CheckHppFiles;
+ MarkOptionEnd(joJCLCheckHppFiles, Result);
+ end;
+
+ MarkOptionEnd(joJCLMake, Result);
+ end;
+ end;
+
+ function CompilePackages: Boolean;
+ begin
+ Result := True;
+ if OptionChecked[joJCLPackages] then
+ begin
+ MarkOptionBegin(joJCLPackages);
+ if CLRVersion = '' then
+ begin
+ Result := CompilePackage(FullPackageFileName(Target, JclDpk))
+ and CompilePackage(FullPackageFileName(Target, JclContainersDpk));
+
+ if Result and OptionChecked[joJCLVclPackage] then
+ begin
+ MarkOptionBegin(joJCLVclPackage);
+ Result := Result and CompilePackage(FullPackageFileName(Target, JclVclDpk));
+ MarkOptionEnd(joJCLVclPackage, Result);
+ end;
+
+ if Result and OptionChecked[joJCLClxPackage] then
+ begin
+ MarkOptionBegin(joJCLClxPackage);
+ Result := Result and CompilePackage(FullPackageFileName(Target, JclVClxDpk));
+ MarkOptionEnd(joJCLClxPackage, Result);
+ end;
+
+ MarkOptionEnd(joJCLPackages, Result);
+ end
+ {$IFDEF MSWINDOWS}
+ else
+ // CLR installation
+ Result := CompileCLRPackage(JediJclDpk) and CompileCLRPackage(JediJclContainersDpk);
+ {$ENDIF MSWINDOWS}
+ end;
+ end;
+
+ function RegisterPackages(ATarget: TJclBorRADToolInstallation): Boolean;
+ {$IFDEF MSWINDOWS}
+ var
+ PathEnvVar: string;
+ {$ENDIF MSWINDOWS}
+ begin
+ {$IFDEF MSWINDOWS}
+ if CLRVersion = '' then
+ begin
+ InstallJediRegInformation(ATarget.ConfigDataLocation, 'JCL',
+ Format('%d.%d.%d.%d', [JclVersionMajor, JclVersionMinor, JclVersionRelease, JclVersionBuild]),
+ GetDcpPath, GetBplPath, Distribution.FJclPath, ATarget.RootKey);
+
+ PathEnvVar := RegReadStringDef(ATarget.RootKey, RegHKCUEnvironmentVar, PathEnvironmentVar, '');
+ PathListIncludeItems(PathEnvVar, RegReadStringDef(HKLM, RegHKLMEnvironmentVar, PathEnvironmentVar, ''));
+ ExpandEnvironmentVar(PathEnvVar);
+ if (PathListItemIndex(PathEnvVar, GetBplPath) = -1) and (PathListItemIndex(PathEnvVar, PathAddSeparator(GetBplPath)) = -1)
+ and Assigned(GUI) and (GUI.Dialog(RsWarningAddPathToEnvironment, dtWarning, [drYes, drNo]) = drYes) then
+ begin
+ PathEnvVar := RegReadStringDef(ATarget.RootKey, RegHKCUEnvironmentVar, PathEnvironmentVar, '');
+ PathListIncludeItems(PathEnvVar, GetBplPath);
+ RegWriteString(ATarget.RootKey, RegHKCUEnvironmentVar, PathEnvironmentVar, PathEnvVar);
+ end;
+ end;
+ {$ENDIF MSWINDOWS}
+ Result := True;
+ end;
+
+ {$IFDEF MSWINDOWS}
+ function CompileExperts: Boolean;
+ var
+ Option: TInstallerOption;
+ DLLExperts: Boolean;
+ begin
+ Result := True;
+ if OptionChecked[joJCLExperts] then
+ begin
+ MarkOptionBegin(joJCLExperts);
+ DLLExperts := False;
+ // dual packages useless for experts
+ if Target.RadToolKind = brBorlandDevStudio then
+ TJclBDSInstallation(Target).DualPackageInstallation := False;
+ for Option := Low(SupportedExperts) to High(SupportedExperts) do
+ if OptionChecked[Option] then
+ begin
+ MarkOptionBegin(Option);
+ if Option = joJCLExpertsDsgnPackages then
+ // nothing, default value
+ else if Option = joJCLExpertsDLL then
+ DLLExperts := OptionChecked[Option]
+ else if DLLExperts then
+ Result := CompileExpert(FullLibraryFileName(Target, SupportedExperts[Option]))
+ else
+ Result := CompilePackage(FullPackageFileName(Target, SupportedExperts[Option]));
+ MarkOptionEnd(Option, Result);
+ if not Result then
+ Break;
+ end;
+ MarkOptionEnd(joJCLExperts, Result);
+ end;
+ end;
+
+ function RegisterExperts(ATarget: TJclBorRADToolInstallation): Boolean;
+ var
+ Option: TInstallerOption;
+ DLLExperts: Boolean;
+ ProjectFileName: string;
+ begin
+ Result := True;
+ if OptionChecked[joJCLExperts] then
+ begin
+ MarkOptionBegin(joJCLExperts);
+ DLLExperts := False;
+ // dual packages useless for experts
+ if ATarget.RadToolKind = brBorlandDevStudio then
+ TJclBDSInstallation(ATarget).DualPackageInstallation := False;
+ for Option := Low(SupportedExperts) to High(SupportedExperts) do
+ if OptionChecked[Option] then
+ begin
+ MarkOptionBegin(Option);
+ if Option = joJCLExpertsDsgnPackages then
+ // nothing, default value
+ else if Option = joJCLExpertsDLL then
+ DLLExperts := OptionChecked[Option]
+ else if DLLExperts then
+ begin
+ ProjectFileName := Distribution.JclPath + FullLibraryFileName(ATarget, SupportedExperts[Option]);
+ Result := ATarget.RegisterExpert(ProjectFileName, GetBplPath, PathExtractFileNameNoExt(ProjectFileName));
+ end
+ else
+ begin
+ ProjectFileName := Distribution.JclPath + FullPackageFileName(ATarget, SupportedExperts[Option]);
+ Result := ATarget.RegisterPackage(ProjectFileName, GetBplPath, PathExtractFileNameNoExt(ProjectFileName));
+ end;
+ MarkOptionEnd(Option, Result);
+ if not Result then
+ Break;
+ end;
+ MarkOptionEnd(joJCLExperts, Result);
+ end;
+ end;
+ {$ENDIF MSWINDOWS}
+
+ function InstallRepository: Boolean;
+ function AddDialogToRepository(const DialogName: string;
+ const DialogFileName: string; const DialogIconFileName: string;
+ const Designer: string): Boolean;
+ begin
+ Result := True;
+ try
+ WriteLog(Format('Installing %s...', [DialogName]));
+ Target.Repository.AddObject(DialogFileName, BorRADToolRepositoryFormTemplate,
+ Target.Repository.FindPage(ExceptDlgPage, 1), DialogName, DialogIconFileName,
+ ExceptDlgDescription, ExceptDlgAuthor, BorRADToolRepositoryDesignerDfm);
+ WriteLog('-> ' + DialogFileName);
+ WriteLog('-> ' + DialogIconFileName);
+ WriteLog('...done.');
+ except
+ Result := False;
+ end;
+ end;
+ begin
+ Result := True;
+ if OptionChecked[joJCLExceptDlg] then
+ begin
+ MarkOptionBegin(joJCLExceptDlg);
+ {$IFDEF MSWINDOWS}
+ if OptionChecked[joJCLExceptDlgVCL] then
+ begin
+ MarkOptionBegin(joJCLExceptDlgVCL);
+ Result := AddDialogToRepository(ExceptDlgVclName, Distribution.VclDialogFileName,
+ Distribution.VclDialogIconFileName, BorRADToolRepositoryDesignerDfm);
+ MarkOptionEnd(joJCLExceptDlgVCL, Result);
+ end;
+ if Result and OptionChecked[joJCLExceptDlgVCLSnd] then
+ begin
+ MarkOptionBegin(joJCLExceptDlgVCLSnd);
+ Result := AddDialogToRepository(ExceptDlgVclSndName, Distribution.VclDialogSendFileName,
+ Distribution.VclDialogSendIconFileName, BorRADToolRepositoryDesignerDfm);
+ MarkOptionEnd(joJCLExceptDlgVCLSnd, Result);
+ end;
+ {$ENDIF MSWINDOWS}
+ if Result and OptionChecked[joJCLExceptDlgCLX] then
+ begin
+ MarkOptionBegin(joJCLExceptDlgCLX);
+ Result := AddDialogToRepository(ExceptDlgClxName, Distribution.ClxDialogFileName,
+ Distribution.ClxDialogIconFileName, BorRADToolRepositoryDesignerXfm);
+ MarkOptionEnd(joJCLExceptDlgCLX, Result);
+ end;
+ MarkOptionEnd(joJCLExceptDlg, Result);
+ end;
+ end;
+
+ {$IFDEF MSWINDOWS}
+ function InstallHelpFiles: Boolean;
+ function AddHelpToIdeTools: Boolean;
+ var
+ ToolsIndex: Integer;
+ HelpTitle: string;
+ IdeTool: TJclBorRADToolIdeTool;
+ begin
+ Result := True;
+ try
+ IdeTool := Target.IdeTools;
+ HelpTitle := Format(JclHelpTitle, [JclVersionMajor, JclVersionMinor]);
+ if IdeTool.IndexOfTitle(HelpTitle) = -1 then
+ begin
+ ToolsIndex := IdeTool.Count;
+ IdeTool.Count := ToolsIndex + 1;
+ IdeTool.Title[ToolsIndex] := HelpTitle;
+ IdeTool.Path[ToolsIndex] := HHFileName;
+ IdeTool.Parameters[ToolsIndex] := StrDoubleQuote(FDistribution.FJclChmHelpFileName);
+ IdeTool.WorkingDir[ToolsIndex] := Distribution.JclPath;
+ end;
+ except
+ Result := False;
+ end;
+ end;
+
+ function AddHelpToOpenHelp: Boolean;
+ begin
+ Result := Target.OpenHelp.AddHelpFile(Distribution.FJclHlpHelpFileName, JclHelpIndexName);
+ if Result then
+ WriteLog(Format('Added %s to %s Online Help', [Distribution.FJclHlpHelpFileName, Target.RADToolName]))
+ else
+ WriteLog('failed to add help file to Online Help');
+ end;
+
+ function RegisterHelp2Files: Boolean;
+ var
+ //CurrentDir: string;
+ NameSpace, Collection, Description, Identifier, HxSFile, HxIFile: WideString;
+ LangId: Integer;
+ begin
+ Result := True;
+ if (Target.RadToolKind <> brBorlandDevStudio) or (Target.VersionNumber < 3) then
+ Exit;
+
+ WriteLog('Registering help 2.0 files...');
+
+ // to avoid Write AV, data have to be copied in data segment
+ NameSpace := Help2NameSpace;
+ Collection := Help2Collection;
+ Description := Help2Description;
+ Identifier := Help2Identifier;
+ LangId := Help2LangId;
+ HxSFile := Help2HxSFile;
+ HxIFile := Help2HxIFile;
+
+ Distribution.RegHelpCreateTransaction;
+ Distribution.RegHelpRegisterNameSpace(NameSpace, Collection, Description);
+ Distribution.RegHelpRegisterHelpFile(NameSpace, Identifier, LangId, HxSFile, HxIFile);
+ if OptionChecked[joJCLHelpHxSPlugin] then
+ begin
+ MarkOptionBegin(joJCLHelpHxSPlugin);
+ Distribution.RegHelpPlugNameSpaceIn(NameSpace, TJclBDSInstallation(Target).Help2Manager.IdeNamespace);
+ MarkOptionEnd(joJCLHelpHxSPlugin, Result);
+ end;
+
+ Distribution.RegHelpCommitTransaction;
+
+ WriteLog('...defered');
+ end;
+ begin
+ Result := True;
+ if OptionChecked[joJCLHelp] then
+ begin
+ MarkOptionBegin(joJCLHelp);
+
+ if OptionChecked[joJCLHelpHlp] then
+ begin
+ MarkOptionBegin(joJCLHelpHlp);
+ Result := AddHelpToOpenHelp;
+ MarkOptionEnd(joJCLHelpHlp, Result);
+ end;
+
+ if Result and OptionChecked[joJCLHelpChm] then
+ begin
+ MarkOptionBegin(joJCLHelpChm);
+ Result := AddHelpToIdeTools;
+ MarkOptionEnd(joJCLHelpChm, Result);
+ end;
+
+ if Result and OptionChecked[joJCLHelpHxS] then
+ begin
+ MarkOptionBegin(joJCLHelpHxS);
+ Result := RegisterHelp2Files;
+ MarkOptionEnd(joJCLHelpHxS, Result);
+ end;
+
+ MarkOptionEnd(joJCLHelp, Result);
+ end;
+ end;
+ {$ENDIF MSWINDOWS}
+
+ function MakeDemos: Boolean;
+ var
+ SaveDir: string;
+ Index, ID: Integer;
+ ADemoList: TStrings;
+ DemoResult: Boolean;
+ begin
+ Result := True;
+ if OptionChecked[joJCLMakeDemos] then
+ begin
+ MarkOptionBegin(joJCLMakeDemos);
+ SaveDir := GetCurrentDir;
+ try
+ ADemoList := GetDemoList;
+ for Index := 0 to ADemoList.Count - 1 do
+ begin
+ ID := Integer(ADemoList.Objects[Index]);
+ if OptionCheckedById[ID] then
+ begin
+ MarkOptionBegin(ID);
+ DemoResult := CompileApplication(ADemoList.Strings[Index]);
+ MarkOptionEnd(ID, DemoResult);
+ // ahuser: The installation shouldn't fail if some demos can't be compiled like
+ // outdated demos or CLX/Kylix demos. Otherwise the JVCL Installer will
+ // have a hard time finding a valid JCL installation
+ //Result := Result and DemoResult;
+ end;
+ end;
+ finally
+ SetCurrentDir(SaveDir);
+ end;
+
+ MarkOptionEnd(joJCLMakeDemos, Result);
+ end;
+ end;
+
+var
+ Index: Integer;
+ ATarget: TJclBorRADToolInstallation;
+begin
+ AProfilesManager := InstallCore.ProfilesManager;
+ try
+ Target.OutputCallback := WriteLog;
+
+ if Assigned(GUI) then
+ GUI.Status := Format(RsInstallMessage, [TargetName]);
+
+ if Assigned(GUIPage) then
+ begin
+ GUIPage.Show;
+ GUIPage.BeginInstall;
+ end;
+
+ FLogLines.ClearLog;
+
+ WriteIntroduction;
+ Result := CheckDirectories and SetStaticOptions and MakeUnits and CompilePackages and InstallRepository
+ and MakeDemos {$IFDEF MSWINDOWS}and CompileExperts and InstallHelpFiles{$ENDIF MSWINDOWS};
+ if Result then
+ begin
+ if AProfilesManager.MultipleProfileMode then
+ begin
+ for Index := 0 to AProfilesManager.ProfileCount - 1 do
+ if IsProfileEnabled[Index] then
+ begin
+ ATarget := ProfileTargets[Index];
+ if ATarget.Valid then
+ begin
+ WriteLog(StrPadRight(StrRepeat('=', 10) + InstallCore.ProfilesManager.ProfileNames[Index], 80, '='));
+ Result := Result and SetEnvironment(ATarget) and RegisterPackages(ATarget)
+ {$IFDEF MSWINDOWS}and RegisterExperts(ATarget){$ENDIF MSWINDOWS};
+ end;
+ end;
+ end
+ else
+ Result := Result and SetEnvironment(Target) and RegisterPackages(Target)
+ {$IFDEF MSWINDOWS}and RegisterExperts(Target){$ENDIF MSWINDOWS};
+ end;
+
+ if not Result then
+ begin
+ Silent := True;
+ Uninstall(False);
+ end;
+
+ FLogLines.CloseLog;
+ finally
+ Target.OutputCallback := nil;
+ WriteLog('');
+ if Assigned(GUIPage) then
+ GUIPage.EndInstall;
+ end;
+end;
+
+function TJclInstallation.MakePath(const FormatStr: string): string;
+{$IFNDEF KYLIX}
+var
+ VersionStr: string;
+{$ENDIF KYLIX}
+begin
+ {$IFDEF KYLIX}
+ Result := Format(FormatStr, [Target.VersionNumber]);
+ {$ELSE ~KYLIX}
+ VersionStr := Target.VersionNumberStr;
+ if CLRVersion <> '' then
+ VersionStr := Format('%s.net', [VersionStr]);
+ Result := PathGetShortName(Format(FormatStr, [VersionStr]));
+ {$ENDIF ~KYLIX}
+end;
+
+function TJclInstallation.RemoveSettings: Boolean;
+{$IFDEF MSWINDOWS}
+var
+ JclSettingsKey: string;
+{$ENDIF MSWINDOWS}
+begin
+{$IFDEF MSWINDOWS}
+ JclSettingsKey := Target.ConfigDataLocation + '\Jedi\JCL';
+ if RegKeyExists(HKCU, JclSettingsKey) then
+ Result := RegDeleteKeyTree(HKCU, JclSettingsKey)
+ else
+{$ENDIF MSWINDOWS}
+ Result := True;
+end;
+
+function TJclInstallation.Uninstall(AUninstallHelp: Boolean): Boolean;
+ procedure RemoveEnvironment(ATarget: TJclBorRADToolInstallation);
+ begin
+ //ioJclEnvLibPath
+ if CLRVersion = '' then
+ begin
+ if ATarget.RemoveFromLibrarySearchPath(FLibReleaseDir) and
+ ATarget.RemoveFromLibrarySearchPath(Distribution.JclSourceDir) and
+ ATarget.RemoveFromLibrarySearchPath(Distribution.JclIncludeDir) then
+ WriteLog(Format('Removed "%s;%s;%s" from library search path.', [FLibReleaseDir, Distribution.JclSourceDir, Distribution.JclIncludeDir]))
+ else
+ WriteLog('Failed to remove library search path.');
+ {$IFDEF MSWINDOWS}
+ if (ATarget.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in ATarget.Personalities) then
+ with TJclBDSInstallation(ATarget) do
+ begin
+ if RemoveFromCppSearchPath(FLibReleaseDir) and
+ RemoveFromCppSearchPath(Distribution.JclSourceDir) and
+ RemoveFromCppSearchPath(Distribution.JclIncludeDir) and
+ ((IDEVersionNumber < 5) or RemoveFromCppLibraryPath(FLibReleaseDir)) then
+ WriteLog(Format('Removed "%s;%s;%s" from cpp search path.', [FLibReleaseDir, Distribution.JclSourceDir, Distribution.JclIncludeDir]))
+ else
+ WriteLog('Failed to remove cpp search path.');
+ end;
+ {$ENDIF MSWINDOWS}
+
+ //ioJclEnvBrowsingPath
+ if ATarget.RemoveFromLibraryBrowsingPath(Distribution.JclSourcePath) then
+ WriteLog(Format('Removed "%s" from library browsing path.', [Distribution.JclSourcePath]))
+ else
+ WriteLog('Failed to remove library browsing path.');
+ {$IFDEF MSWINDOWS}
+ if (ATarget.RadToolKind = brBorlandDevStudio) and (bpBCBuilder32 in ATarget.Personalities) then
+ with TJclBDSInstallation(ATarget) do
+ begin
+ if RemoveFromCppBrowsingPath(Distribution.JclSourcePath) then
+ WriteLog(Format('Removed "%s" from cpp browsing path.', [Distribution.JclSourcePath]))
+ else
+ WriteLog('Failed to remove cpp browsing path.');
+ end;
+ {$ENDIF MSWINDOWS}
+
+ //ioJclEnvDebugDCUPath
+ if ATarget.RemoveFromDebugDCUPath(FLibDebugDir) then
+ WriteLog(Format('Removed "%s" from Debug DCU Path.', [FLibDebugDir]));
+ end;
+ end;
+
+ procedure RemoveMake;
+ procedure RemoveFileMask(const Directory, Extension: string);
+ var
+ FileList: TStrings;
+ Index: Integer;
+ begin
+ FileList := TStringList.Create;
+ try
+ BuildFileList(Format('%s*%s', [PathAddSeparator(Directory), Extension]), faAnyFile, FileList);
+ for Index := 0 to FileList.Count - 1 do
+ FileDelete(PathAddSeparator(Directory) + FileList.Strings[Index]);
+ finally
+ FileList.Free;
+ end;
+ end;
+ begin
+ if CLRVersion <> '' then
+ begin
+ RemoveFileMask(FLibReleaseDir, '.dcuil');
+ RemoveFileMask(FLibDebugDir, '.dcuil');
+ end
+ else
+ begin
+ RemoveFileMask(FLibReleaseDir, '.dcu');
+ RemoveFileMask(FLibDebugDir, '.dcu');
+ if bpBCBuilder32 in Target.Personalities then
+ begin
+ RemoveFileMask(FLibReleaseDir, '.obj'); // compatibility
+ RemoveFileMask(FLibDebugDir, '.obj'); // compatibility
+ end;
+ end;
+ //ioJclCopyHppFiles: ; // TODO : Delete copied files
+ //ioJclCheckHppFiles: ; // nothing to do
+ end;
+
+ procedure UnregisterPackages(ATarget: TJclBorRADToolInstallation);
+ {$IFNDEF KYLIX}
+ var
+ ABDSTarget: TJclBDSInstallation;
+ {$ENDIF ~KYLIX}
+ begin
+ if CLRVersion = '' then
+ begin
+ {$IFNDEF KYLIX}
+ if ATarget.RadToolKind = brBorlandDevStudio then
+ begin
+ ABDSTarget := ATarget as TJclBDSInstallation;
+ ABDSTarget.CleanPackageCache(BinaryFileName(GetBPLPath, Distribution.JclPath + FullPackageFileName(ATarget, JclDpk)));
+ ABDSTarget.CleanPackageCache(BinaryFileName(GetBPLPath, Distribution.JclPath + FullPackageFileName(ATarget, JclContainersDpk)));
+ if RuntimeInstallation and ATarget.SupportsVisualCLX then
+ ABDSTarget.CleanPackageCache(BinaryFileName(GetBPLPath, Distribution.JclPath + FullPackageFileName(ATarget, JclVClxDpk)));
+ if RuntimeInstallation and ATarget.SupportsVCL then
+ ABDSTarget.CleanPackageCache(BinaryFileName(GetBPLPath, Distribution.JclPath + FullPackageFileName(ATarget, JclVclDpk)));
+ end;
+ {$ENDIF KYLIX}
+ //ioJclPackages
+ ATarget.UnregisterPackage(Distribution.JclPath + FullPackageFileName(ATarget, JclDpk), GetBplPath);
+ ATarget.UnregisterPackage(Distribution.JclPath + FullPackageFileName(ATarget, JclContainersDpk), GetBplPath);
+ if RuntimeInstallation and ATarget.SupportsVisualCLX then
+ ATarget.UnregisterPackage(Distribution.JclPath + FullPackageFileName(ATarget, JclVClxDpk), GetBplPath);
+ if RuntimeInstallation and ATarget.SupportsVCL then
+ ATarget.UnregisterPackage(Distribution.JclPath + FullPackageFileName(ATarget, JclVclDpk), GetBplPath);
+ {$IFDEF MSWINDOWS}
+ RemoveJediRegInformation(Target.ConfigDataLocation, 'JCL', ATarget.RootKey);
+ {$ENDIF MSWINDOWS}
+ end;
+ end;
+
+ procedure DeletePackages;
+ begin
+ if CLRVersion = '' then
+ begin
+ DeletePackage(FullPackageFileName(Target, JclDpk));
+ DeletePackage(FullPackageFileName(Target, JclContainersDpk));
+ if RuntimeInstallation and Target.SupportsVisualCLX then
+ DeletePackage(FullPackageFileName(Target, JclVClxDpk));
+ if RuntimeInstallation and Target.SupportsVCL then
+ DeletePackage(FullPackageFileName(Target, JclVclDpk));
+ end;
+ end;
+ {$IFDEF MSWINDOWS}
+ procedure UnregisterExperts(ATarget: TJclBorRADToolInstallation);
+ procedure UnregisterExpert(const Name: string);
+ var
+ Index: Integer;
+ FileName, ShortFileName: string;
+ begin
+ for Index := ATarget.IdePackages.Count - 1 downto 0 do
+ begin
+ FileName := ATarget.IdePackages.PackageFileNames[Index];
+ ShortFileName := ChangeFileExt(ExtractFileName(FileName), '');
+ if StrMatches(Name, ShortFileName)
+ or StrMatches(Format('%sDLL%s', [Name, StrUpper(ATarget.VersionNumberStr)]), ShortFileName)
+ or StrMatches(Format('%sDLL%d', [Name, ATarget.VersionNumber]), ShortFileName)
+ or StrMatches(Format('%sDLL%s0', [Name, StrUpper(ATarget.VersionNumberStr)]), ShortFileName)
+ or StrMatches(Format('%sDLL%d0', [Name, ATarget.VersionNumber]), ShortFileName) then
+ ATarget.UnregisterPackage(FileName);
+ end;
+ for Index := ATarget.IdePackages.ExpertCount - 1 downto 0 do
+ begin
+ FileName := ATarget.IdePackages.ExpertFileNames[Index];
+ ShortFileName := ChangeFileExt(ExtractFileName(FileName), '');
+ if StrMatches(Name, ShortFileName)
+ or StrMatches(Format('%sDLL%s', [Name, StrUpper(ATarget.VersionNumberStr)]), ShortFileName)
+ or StrMatches(Format('%sDLL%d', [Name, ATarget.VersionNumber]), ShortFileName)
+ or StrMatches(Format('%sDLL%s0', [Name, StrUpper(ATarget.VersionNumberStr)]), ShortFileName)
+ or StrMatches(Format('%sDLL%d0', [Name, ATarget.VersionNumber]), ShortFileName) then
+ ATarget.UnregisterExpert(FileName);
+ end;
+ end;
+ var
+ Option: TInstallerOption;
+ IndexOldExpert: Integer;
+ begin
+ if CLRVersion = '' then
+ begin
+ for Option := Low(SupportedExperts) to High(SupportedExperts) do
+ if not (Option in [joJCLExpertsDsgnPackages, joJCLExpertsDLL]) then
+ UnregisterExpert(SupportedExperts[Option]);
+ for IndexOldExpert := Low(OldExperts) to High(OldExperts) do
+ UnregisterExpert(OldExperts[IndexOldExpert]);
+ end;
+ end;
+
+ procedure DeleteExperts;
+ var
+ Option: TInstallerOption;
+ ProjectFileName: string;
+ begin
+ if CLRVersion = '' then
+ begin
+ for Option := Low(SupportedExperts) to High(SupportedExperts) do
+ if not (Option in [joJCLExpertsDsgnPackages, joJCLExpertsDLL]) then
+ begin
+ ProjectFileName := Distribution.JclPath + FullPackageFileName(Target, SupportedExperts[Option]);
+ if FileExists(ProjectFileName) then
+ Target.UninstallPackage(ProjectFileName, GetBplPath, GetDcpPath);
+ ProjectFileName := Distribution.JclPath + FullLibraryFileName(Target, SupportedExperts[Option]);
+ if FileExists(ProjectFileName) then
+ Result := FileDelete(BinaryFileName(GetBplPath, ProjectFileName));
+ end;
+ end;
+ end;
+
+ procedure UninstallHelp;
+ procedure RemoveHelpFromIdeTools;
+ var
+ HelpIndex: Integer;
+ HelpTitle: string;
+ begin
+ HelpTitle := Format(JclHelpTitle, [JclVersionMajor, JclVersionMinor]);
+ with Target.IdeTools do
+ begin
+ HelpIndex := IndexOfTitle(HelpTitle);
+ if HelpIndex <> -1 then
+ RemoveIndex(HelpIndex);
+ end;
+ end;
+
+ procedure RemoveHelpFromOpenHelp;
+ begin
+ WriteLog(Format('Removing %s from %s Online Help', [Distribution.FJclHlpHelpFileName, Target.RADToolName]));
+ if Target.OpenHelp.RemoveHelpFile(Distribution.FJclHlpHelpFileName, JclHelpIndexName) then
+ WriteLog('...done.')
+ else
+ WriteLog('...failed.');
+ end;
+
+ procedure UnregisterHelp2Files;
+ var
+ NameSpace, Identifier, HxSFile, HxIFile: WideString;
+ LangId: Integer;
+ begin
+ if (Target.RadToolKind <> brBorlandDevStudio) or (Target.VersionNumber < 3) then
+ Exit;
+
+ WriteLog('Unregistering help 2.0 files...');
+
+ // to avoid Write AV, data has to be copied in data segment
+ NameSpace := Help2NameSpace;
+ Identifier := Help2Identifier;
+ LangId := Help2LangId;
+ HxSFile := Help2HxSFile;
+ HxIFile := Help2HxIFile;
+
+ Distribution.RegHelpCreateTransaction;
+ Distribution.RegHelpUnPlugNameSpace(NameSpace, TJclBDSInstallation(Target).Help2Manager.IdeNamespace);
+ Distribution.RegHelpUnregisterHelpFile(NameSpace, Identifier, LangId);
+ Distribution.RegHelpUnregisterNameSpace(NameSpace);
+ Distribution.RegHelpCommitTransaction;
+
+ WriteLog('...defered');
+ end;
+
+ begin
+ if CLRVersion = '' then
+ begin
+ if Target.RadToolKind <> brBorlandDevStudio then
+ begin
+ RemoveHelpFromOpenHelp;
+ RemoveHelpFromIdeTools;
+ end
+ else
+ UnregisterHelp2Files;
+ end;
+ end;
+ {$ENDIF MSWINDOWS}
+ procedure UninstallRepository;
+ procedure RemoveDialogFromRepository(const DialogName, DialogFileName: string);
+ begin
+ Target.Repository.RemoveObjects(ExceptDlgPath, DialogFileName, BorRADToolRepositoryFormTemplate);
+ WriteLog(Format('Removed %s.', [DialogName]));
+ end;
+ begin
+ if (CLRVersion = '') and (Target.RadToolKind <> brBorlandDevStudio) then
+ begin
+ {$IFDEF MSWINDOWS}
+ // ioJclExcDialog
+ // ioJclExcDialogVCL
+ RemoveDialogFromRepository(ExceptDlgVclName, Distribution.VclDialogFileName);
+ //ioJclExcDialogVCLSnd
+ RemoveDialogFromRepository(ExceptDlgVclSndName, Distribution.VclDialogSendFileName);
+ {$ENDIF MSWINDOWS}
+ //ioJclExcDialogCLX
+ RemoveDialogFromRepository(ExceptDlgClxName, Distribution.ClxDialogFileName);
+ end;
+ end;
+
+var
+ Index: Integer;
+ AProfilesManager: IJediProfilesManager;
+ ATarget: TJclBorRADToolInstallation;
+begin
+ AProfilesManager := InstallCore.ProfilesManager;
+ try
+ Target.OutputCallback := WriteLog;
+ if Assigned(GUI) then
+ GUI.Status := Format(RsUninstallMessage, [TargetName]);
+ if Assigned(GUIPage) then
+ GUIPage.Show;
+
+ WriteLog(StrPadRight('Starting Uninstall process', 44, '.'));
+
+ if AProfilesManager.MultipleProfileMode then
+ begin
+ for Index := 0 to AProfilesManager.ProfileCount - 1 do
+ if IsProfileEnabled[Index] then
+ begin
+ ATarget := ProfileTargets[Index];
+ if ATarget.Valid then
+ begin
+ RemoveEnvironment(ATarget);
+ {$IFDEF MSWINDOWS}
+ if not Target.IsTurboExplorer then
+ UnregisterExperts(ATarget);
+ {$ENDIF MSWINDOWS}
+ if not Target.IsTurboExplorer then
+ UnregisterPackages(ATarget);
+ end;
+ end;
+ end
+ else
+ begin
+ RemoveEnvironment(Target);
+ {$IFDEF MSWINDOWS}
+ if not Target.IsTurboExplorer then
+ UnregisterExperts(Target);
+ {$ENDIF MSWINDOWS}
+ if not Target.IsTurboExplorer then
+ UnregisterPackages(Target);
+ end;
+
+ RemoveMake;
+ if not Target.IsTurboExplorer then
+ DeletePackages;
+ {$IFDEF MSWINDOWS}
+ DeleteExperts;
+ if AUninstallHelp then
+ UninstallHelp;
+ {$ENDIF MSWINDOWS}
+ // TODO: ioJclCopyPackagesHppFiles
+ UninstallRepository;
+ // TODO: ioJclMakeDemos:
+ finally
+ Target.OutputCallback := nil;
+ end;
+
+ Result := True;
+end;
+
+procedure TJclInstallation.WriteLog(const Msg: string);
+var
+ Line: string;
+ LineType: TCompileLineType;
+begin
+ if not Silent then
+ begin
+ Line := InstallCore.ProcessLogLine(Msg, LineType, GUIPage);
+ if Line <> '' then
+ FLogLines.Write(Line);
+ end;
+end;
+
+function TJclInstallation.GetBplPath: string;
+var
+ AConfiguration: IJediConfiguration;
+begin
+ if Assigned(GUIPage) then
+ Result := GUIPage.Directories[FGUIBPLPathIndex]
+ else
+ begin
+ AConfiguration := InstallCore.Configuration;
+ if Assigned(AConfiguration) then
+ Result := AConfiguration.OptionAsStringByName[TargetName, RsNameBPLPath]
+ else
+ Result := Target.BPLOutputPath;
+ end;
+ //{$IFDEF MSWINDOWS}
+ //Result := PathGetShortName(Result);
+ //{$ENDIF MSWINDOWS}
+end;
+
+function TJclInstallation.GetDcpPath: string;
+var
+ AConfiguration: IJediConfiguration;
+begin
+ if Assigned(GUIPage) then
+ Result := GUIPage.Directories[FGUIDCPPathIndex]
+ else
+ begin
+ AConfiguration := InstallCore.Configuration;
+ if Assigned(AConfiguration) then
+ Result := AConfiguration.OptionAsStringByName[TargetName, RsNameDCPPath]
+ else
+ Result := FJclDcpPath;
+ end;
+ //{$IFDEF MSWINDOWS}
+ //Result := PathGetShortName(Result);
+ //{$ENDIF MSWINDOWS}
+end;
+
+procedure TJclInstallation.Close;
+ procedure SaveOptions;
+ var
+ AConfiguration: IJediConfiguration;
+ Option: TInstallerOption;
+ Id, Index: Integer;
+ ADemoList: TStrings;
+ begin
+ AConfiguration := InstallCore.Configuration;
+ if not (Assigned(AConfiguration) and Assigned(GUIPage)) then
+ Exit;
+
+ // clean section before saving options
+ AConfiguration.DeleteSection(TargetName);
+ AConfiguration.DeleteSection(FDemoSectionName);
+
+ for Option := Low(TInstallerOption) to High(TInstallerOption) do
+ begin
+ Id := OptionData[Option].Id;
+ AConfiguration.OptionAsBool[TargetName, Id] := GUIPage.OptionChecked[Id];
+ end;
+
+ if not Target.IsTurboExplorer then
+ begin
+ if FRuntimeInstallation and (CLRVersion = '') then
+ begin
+ ADemoList := GetDemoList;
+ for Index := 0 to ADemoList.Count - 1 do
+ begin
+ Id := Integer(ADemoList.Objects[Index]);
+ AConfiguration.OptionAsBool[FDemoSectionName, Id] := GUIPage.OptionChecked[Id];
+ end;
+ end;
+
+ AConfiguration.OptionAsStringByName[TargetName, RsNameBPLPath] := GUIPage.Directories[FGUIBPLPathIndex];
+ if Target.RadToolKind = brCppBuilder then
+ AConfiguration.OptionAsStringByName[TargetName, RsNameBPIPath] := GUIPage.Directories[FGUIDCPPathIndex]
+ else
+ AConfiguration.OptionAsStringByName[TargetName, RsNameDCPPath] := GUIPage.Directories[FGUIDCPPathIndex];
+ end;
+ end;
+begin
+ SaveOptions;
+
+ FGUIPage := nil;
+ FGUI := nil;
+end;
+
+function TJclInstallation.CompileLibraryUnits(const SubDir: string; Debug: Boolean): Boolean;
+var
+ UnitList: TStrings;
+ Compiler: TJclDCC32;
+
+
+ function CompileUnits: Boolean;
+ begin
+ Result := Compiler.Execute(StringsToStr(UnitList, ' '));
+ 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(const TargetDir: string): Boolean;
+ var
+ I: Integer;
+ FileName: string;
+ begin
+ Result := True;
+ for I := 0 to UnitList.Count - 1 do
+ begin
+ FileName := UnitList[I] + '.hpp';
+ if FileExists(FileName) then
+ begin
+ Result := Result and FileCopy(FileName, TargetDir + FileName, True);
+
+ // Always remove once copied because if they are left in place they
+ // will clutter the source folder and might even prevent compilation
+ // when multiple versions of C++ Builder are installed on the same
+ // computer. The easiest way to see this is when checking HPP files.
+ FileDelete(FileName);
+ end;
+ end;
+ end;
+
+var
+ UnitType, LibDescriptor, SaveDir, UnitOutputDir, Path, ExclusionFileName: string;
+ Index, ExcIndex: Integer;
+ Exclusions: TStrings;
+begin
+ Result := True;
+ if Debug then
+ UnitType := 'debug ';
+ LibDescriptor := Format(RsLibDescriptor, [SubDir, UnitType, TargetName]);
+ WriteLog(Format('Making %s', [LibDescriptor]));
+ Path := Format('%s' + DirDelimiter + '%s', [Distribution.JclSourceDir, SubDir]);
+ UnitList := TStringList.Create;
+ try
+ BuildFileList(PathAddSeparator(Path) + '*.pas', faAnyFile, UnitList);
+ ExclusionFileName := PathAddSeparator(FLibReleaseDir) + SubDir + '.exc';
+ if FileExists(ExclusionFileName) then
+ begin
+ Exclusions := TStringList.Create;
+ try
+ Exclusions.LoadFromFile(ExclusionFileName);
+ for Index := 0 to Exclusions.Count - 1 do
+ begin
+ ExcIndex := UnitList.IndexOf(Exclusions.Strings[Index]);
+ if ExcIndex >= 0 then
+ UnitList.Delete(ExcIndex);
+ end;
+ finally
+ Exclusions.Free;
+ end;
+ end;
+ if UnitList.Count = 0 then
+ Exit;
+ for Index := 0 to UnitList.Count - 1 do
+ UnitList.Strings[Index] := ChangeFileExt(UnitList.Strings[Index], '');
+
+ {$IFDEF MSWINDOWS}
+ if CLRVersion <> '' then
+ Compiler := (Target as TJclBDSInstallation).DCCIL
+ else
+ {$ENDIF MSWINDOWS}
+ Compiler := Target.DCC32;
+ Compiler.SetDefaultOptions;
+ //Options.Add('-D' + StringsToStr(Defines, ';'));
+ Compiler.Options.Add('-M');
+ if Debug then
+ begin
+ Compiler.Options.Add('-$C+'); // assertions
+ Compiler.Options.Add('-$D+'); // debug informations
+ Compiler.Options.Add('-$I+'); // I/O checking
+ Compiler.Options.Add('-$L+'); // local debugging symbols
+ Compiler.Options.Add('-$O-'); // optimizations
+ Compiler.Options.Add('-$Q+'); // overflow checking
+ Compiler.Options.Add('-$R+'); // range checking
+ if CLRVersion = '' then
+ Compiler.Options.Add('-$W+'); // stack frames
+ Compiler.Options.Add('-$Y+'); // symbol reference info
+ end
+ else
+ begin
+ Compiler.Options.Add('-$C-'); // assertions
+ Compiler.Options.Add('-$D-'); // debug informations
+ Compiler.Options.Add('-$I-'); // I/O checking
+ Compiler.Options.Add('-$L-'); // local debugging symbols
+ Compiler.Options.Add('-$O+'); // optimizations
+ Compiler.Options.Add('-$Q-'); // overflow checking
+ Compiler.Options.Add('-$R-'); // range checking
+ if CLRVersion = '' then
+ Compiler.Options.Add('-$W-'); // stack frames
+ Compiler.Options.Add('-$Y-'); // symbol reference info
+ end;
+
+ if (bpBCBuilder32 in Target.Personalities) and (CLRVersion = '') then
+ begin
+ Compiler.Options.Add('-D_RTLDLL' + DirSeparator + 'NO_STRICT' + DirSeparator + 'USEPACKAGES'); // $(SYSDEFINES)
+ if Debug then
+ UnitOutputDir := FLibDebugDir
+ else
+ UnitOutputDir := FLibReleaseDir;
+
+ if (Target.RadToolKind = brBorlandDevStudio) and (Target.VersionNumber >= 4) then
+ begin
+ Compiler.AddPathOption('N0', UnitOutputDir); // .dcu files
+ //Compiler.AddPathOption('NH', FIncludeDir); // .hpp files
+ Compiler.AddPathOption('NO', UnitOutputDir); // .obj files
+ if TJclBDSInstallation(Target).DualPackageInstallation and OptionChecked[joJCLCopyPackagesHppFiles] then
+ Compiler.AddPathOption('N1',Target.VclIncludeDir);
+ end
+ else
+ begin
+ Compiler.AddPathOption('N0', UnitOutputDir); // .dcu files
+ //Compiler.AddPathOption('N1', FIncludeDir); // .hpp files
+ Compiler.AddPathOption('N2', UnitOutputDir); // .obj files
+ end;
+ Compiler.Options.Add('-JPHNE');
+ Compiler.Options.Add('--BCB');
+ //Compiler.AddPathOption('O', Format(BCBIncludePath, [Distribution.JclIncludeDir, Distribution.JclSourcePath]));
+ //Compiler.AddPathOption('U', Format(BCBObjectPath, [Distribution.JclIncludeDir, Distribution.JclSourcePath]));
+ end
+ else // Delphi
+ begin
+ if Debug then
+ UnitOutputDir := FLibDebugDir
+ else
+ UnitOutputDir := FLibReleaseDir;
+
+ Compiler.AddPathOption('N', UnitOutputDir); // .dcu files
+ if CLRVersion <> '' then
+ Compiler.Options.Add('--default-namespace:Jedi.Jcl');
+
+ end;
+ Compiler.AddPathOption('I', Distribution.JclIncludeDir);
+ Compiler.AddPathOption('U', Distribution.JclSourcePath);
+ Compiler.AddPathOption('R', Distribution.JclSourcePath);
+
+ SaveDir := GetCurrentDir;
+ Result := SetCurrentDir(Path);
+ {$IFDEF WIN32}
+ Win32Check(Result);
+ {$ELSE}
+ if Result then
+ {$ENDIF}
+ try
+ WriteLog('');
+ WriteLog('Compiling .dcu files...');
+ Result := Result and CompileUnits;
+ if CLRVersion = '' then
+ begin
+ CopyResFiles(UnitOutputDir);
+ if OptionChecked[joJCLCopyHppFiles] then
+ begin
+ MarkOptionBegin(joJCLCopyHppFiles);
+ WriteLog('Copying .hpp files...');
+ Result := Result and CopyHppFiles(Target.VclIncludeDir);
+ MarkOptionEnd(joJCLCopyHppFiles, Result);
+ end;
+ {$IFDEF KYLIX}
+ Compiler.Options.Add('-P'); // generate position independent code (PIC)
+ WriteLog('');
+ WriteLog('Compiling dpu files...');
+ Result := Result and CompileUnits;
+ {$ENDIF KYLIX}
+ end;
+ finally
+ SetCurrentDir(SaveDir);
+ end;
+ finally
+ UnitList.Free;
+ end;
+ if not Result then
+ WriteLog('Failed ' + LibDescriptor);
+end;
+
+{$IFDEF MSWINDOWS}
+function TJclInstallation.CompileCLRPackage(const Name: string): Boolean;
+var
+ ProjectFileName: string;
+begin
+ ProjectFileName := Format('%spackages%s%s.net%s%s%s', [PathAddSeparator(Distribution.JclPath),
+ DirDelimiter, Target.VersionNumberStr, DirDelimiter, Name, SourceExtensionDelphiPackage]);
+ WriteLog(Format('Compiling CLR package %s...', [ProjectFileName]));
+
+ if Assigned(GUIPage) then
+ GUIPage.CompilationStart(ExtractFileName(Name));
+
+ Result := TJclBDSInstallation(Target).CompileDelphiDotNetProject(ProjectFileName,
+ GetBplPath, TargetPlatform, CLRVersion);
+end;
+{$ENDIF MSWINDOWS}
+
+function TJclInstallation.CompilePackage(const Name: string): Boolean;
+var
+ PackageFileName: string;
+{$IFNDEF KYLIX}
+ DpkPackageFileName: string;
+{$ENDIF}
+begin
+ PackageFileName := PathAddSeparator(Distribution.JclPath) + Name;
+ WriteLog(Format('Compiling package %s...', [PackageFileName]));
+
+ if Assigned(GUIPage) then
+ GUIPage.CompilationStart(ExtractFileName(Name));
+
+ if IsDelphiPackage(PackageFileName) and (bpDelphi32 in Target.Personalities) then
+ begin
+ {$IFNDEF KYLIX}
+ if Target.RadToolKind = brBorlandDevStudio then
+ (Target as TJclBDSInstallation).CleanPackageCache(BinaryFileName(GetBplPath, PackageFileName));
+ {$ENDIF ~KYLIX}
+ Result := Target.CompilePackage(PackageFileName, GetBplPath, GetDcpPath);
+ end
+ else if IsBCBPackage(PackageFileName) and (bpBCBuilder32 in Target.Personalities) then
+ begin
+ ConfigureBpr2Mak(PackageFileName);
+ {$IFDEF KYLIX}
+ Result := Target.CompilePackage(PackageFileName, GetBplPath, GetDcpPath);
+ {$ELSE ~KYLIX}
+
+ if Target.RadToolKind = brBorlandDevStudio then
+ (Target as TJclBDSInstallation).CleanPackageCache(BinaryFileName(GetBplPath, 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);
+ Result := ((not FileExists(DpkPackageFileName))
+ or Target.CompilePackage(DpkPackageFileName, GetBplPath, GetDcpPath))
+ and Target.CompilePackage(PackageFileName, GetBplPath, GetDcpPath);
+ {$ENDIF ~KYLIX}
+ end
+ else
+ begin
+ Result := False;
+ WriteLog(Format('No personality supports the extension %s', [ExtractFileExt(PackageFileName)]));
+ end;
+
+ if Result then
+ WriteLog('...done.')
+ else
+ WriteLog('...failed');
+end;
+
+function TJclInstallation.CompileApplication(FileName: string): Boolean;
+var
+ OldDirectory, NewDirectory: string;
+begin
+ NewDirectory := ExtractFileDir(FileName);
+ FileName := ExtractFileName(FileName);
+ WriteLog(Format(RsBuildingMessage, [FileName]));
+ OldDirectory := GetCurrentDir;
+ try
+ SetCurrentDir(NewDirectory);
+ Target.DCC32.Options.Clear;
+ Target.DCC32.SetDefaultOptions;
+ Target.DCC32.AddPathOption('E', Distribution.JclBinDir);
+ Target.DCC32.AddPathOption('N', '.');
+ Target.DCC32.AddPathOption('U', FLibReleaseDir + DirSeparator + Distribution.JclSourcePath);
+ Target.DCC32.AddPathOption('I', Distribution.JclIncludeDir);
+ Result := Target.DCC32.Execute(FileName);
+ finally
+ SetCurrentDir(OldDirectory);
+ end;
+end;
+
+function TJclInstallation.DeletePackage(const Name: string): Boolean;
+var
+ PackageFileName: string;
+ BPLFileName: string;
+begin
+ WriteLog(Format('Deleting package %s.', [Name]));
+ PackageFileName := Distribution.JclPath + Format(Name, [Target.VersionNumberStr]);
+
+ BPLFileName := BinaryFileName(GetBplPath, PackageFileName);
+
+ Result := FileDelete(BPLFileName);
+ Result := FileDelete(ChangeFileExt(BPLFileName, CompilerExtensionMAP)) or Result;
+
+ // delete DCP files that were created to bpl path (old behavior)
+ Result := FileDelete(PathAddSeparator(GetBPLPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionDCP) or Result;
+ // delete DCP files that were created to target dcp path (old behavior)
+ Result := FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionDCP) or Result;
+ // delete BPI files that were created to target dcp path (old behavior)
+ Result := FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionBPI) or Result;
+ // delete LIB files that were created to target dcp path (old behaviour)
+ Result := FileDelete(PathAddSeparator(Target.DCPOutputPath) + PathExtractFileNameNoExt(Name) + CompilerExtensionLIB) or Result;
+
+ // TODO : evtl. remove .HPP Files
+ if Result then
+ WriteLog('...done.')
+ else
+ WriteLog('...failed.');
+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.JclPath + Bcb2MakTemplate));
+ end;
+ {$IFDEF KYLIX}
+ SetEnvironmentVar('OBJDIR', FLibReleaseDir);
+ SetEnvironmentVar('BPILIBDIR', GetDcpPath);
+ SetEnvironmentVar('BPLDIR', GetBplPath);
+ {$ELSE ~KYLIX}
+ if clMake in Target.CommandLineTools then
+ begin
+ Target.Make.Options.Clear;
+ Target.Make.AddPathOption('DBPILIBDIR=', GetDcpPath);
+ Target.Make.AddPathOption('DBPLDIR=', GetBplPath);
+ if OptionChecked[joJCLCopyPackagesHppFiles] then
+ //begin
+ // MarkOptionBegin(joJCLCopyPackagesHppFiles);
+ Target.Make.AddPathOption('DHPPDIR=', Target.VclIncludeDir);
+ // MarkOptionEnd(joJCLCopyPackagesHppFiles, True);
+ //end;
+ end;
+ {$ENDIF ~KYLIX}
+end;
+
+{$IFDEF MSWINDOWS}
+function TJclInstallation.CompileExpert(const Name: string): Boolean;
+var
+ ProjectFileName, ProjectBinaryFileName, ProjectDEFFileName,
+ ProjectDescription: string;
+ LibraryPeImage: TJclPeImage;
+ ExportFuncList: TJclPeExportFuncList;
+ Index: Integer;
+ DEFFile: TStrings;
+ FirstCompilationOk: Boolean;
+const
+ WizardEntryPoint = 'INITWIZARD0001';
+ // @*@JCLWizardInit$qqsx56System@%DelphiInterface$t28Toolsapi@IBorlandIDEServices%pqqrx47System@%DelphiInterface$t19Toolsapi@IOTAWizard%$orpqqrv$v
+ InternalEntryPoint = '@JCLWizardInit$';
+begin
+ ProjectFileName := PathAddSeparator(Distribution.JclPath) + Name;
+
+ WriteLog(Format('Compiling expert %s...', [ProjectFileName]));
+
+ if Assigned(GUIPage) then
+ GUIPage.CompilationStart(ExtractFileName(Name));
+
+ if IsDelphiProject(ProjectFileName) and (bpDelphi32 in Target.Personalities) then
+ Result := Target.CompileProject(ProjectFileName, GetBplPath, GetDcpPath)
+ 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, GetBplPath, GetDcpPath);
+
+ if Result then
+ begin
+ WriteLog('First compilation ok');
+ LibraryPeImage := TJclPeImage.Create;
+ try
+ GetBPRFileInfo(ProjectFileName, ProjectBinaryFileName, @ProjectDescription);
+ ProjectBinaryFileName := PathAddSeparator(GetBplPath) + ProjectBinaryFileName;
+
+ WriteLog(Format('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('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('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('Entry point found, registering expert...');
+ Target.RegisterExpert(ProjectBinaryFileName, ProjectDescription);
+ end;
+ finally
+ LibraryPeImage.Free;
+ end;
+
+ if Result and (not FirstCompilationOk) then
+ // second compilation
+ Result := Target.CompileProject(ProjectFileName, GetBplPath, GetDcpPath)
+ else if not Result then
+ WriteLog('Internal entry point not found');
+ end
+ else
+ WriteLog('First compilation failed');
+ end
+ else
+ Result := False;
+
+ if Result then
+ WriteLog('...done.')
+ else
+ WriteLog('... failed ' + ProjectFileName);
+end;
+{$ENDIF MSWINDOWS}
+
+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;
+
+procedure TJclInstallation.AddDemo(const Directory: string; const FileInfo: TSearchRec);
+begin
+ if not StrSame(ExtractFileExt(FileInfo.Name), '.dproj') then
+ FDemoList.Append(Directory + FileInfo.Name);
+end;
+
+procedure TJclInstallation.AddDemos(const Directory: string);
+begin
+ EnumFiles(Directory + '*.dpr', AddDemo);
+end;
+
+function TJclInstallation.GetDemoList: TStringList;
+ procedure ProcessExcludeFile(const ExcFileName: string);
+ var
+ DemoExclusionList: TStrings;
+ ExclusionFileName, FileName, RequiredList, RequiredItem: string;
+ IndexExc, IndexDemo, SepPos, IndexReq: Integer;
+ ExcludeDemo: Boolean;
+ begin
+ DemoExclusionList := TStringList.Create;
+ try
+ ExclusionFileName := MakePath(PathAddSeparator(Distribution.JclExamplesDir) + ExcFileName);
+ if FileExists(ExclusionFileName) then
+ begin
+ DemoExclusionList.LoadFromFile(ExclusionFileName);
+ for IndexExc := 0 to DemoExclusionList.Count - 1 do
+ begin
+ FileName := DemoExclusionList.Strings[IndexExc];
+ SepPos := Pos('=', FileName);
+ if SepPos > 0 then
+ begin
+ ExcludeDemo := False;
+ RequiredList := Copy(FileName, SepPos + 1, Length(FileName) - SepPos);
+ SetLength(FileName, SepPos - 1);
+ for IndexReq := 0 to PathListItemCount(RequiredList) - 1 do
+ begin
+ RequiredItem := PathListGetItem(RequiredList, IndexReq);
+ if AnsiSameText(ExtractFileExt(RequiredItem), '.dcu') then
+ begin
+ ExcludeDemo := not FileExists(PathAddSeparator(Target.LibFolderName) + RequiredItem);
+ if ExcludeDemo then
+ Break;
+ end;
+ end;
+ end
+ else
+ ExcludeDemo := True;
+
+ if ExcludeDemo then
+ begin
+ if AnsiSameText(ExtractFileExt(FileName), '.exc') then
+ ProcessExcludeFile(FileName)
+ else
+ begin
+ for IndexDemo := FDemoList.Count - 1 downto 0 do
+ if StrMatches(PathAddSeparator(Distribution.JclExamplesDir) + FileName, FDemoList.Strings[IndexDemo]) then
+ FDemoList.Delete(IndexDemo);
+ end;
+ end;
+ end;
+ end;
+ finally
+ DemoExclusionList.Free;
+ end;
+ end;
+begin
+ if not Assigned(FDemoList) then
+ begin
+ FDemoList := TStringList.Create;
+ EnumDirectories(Distribution.JclExamplesDir, AddDemos);
+ FDemoList.CustomSort(DemoNameCompare);
+
+ {$IFDEF KYLIX}
+ ProcessExcludeFile('k%d.exc');
+ {$ELSE ~KYLIX}
+ ProcessExcludeFile('%s.exc');
+ {$ENDIF ~KYLIX}
+ end;
+ Result := FDemoList;
+end;
+{
+function TJclInstallation.Run: Boolean;
+ procedure EnsureDirectoryExists(const DirectoryName, DisplayName: string);
+ begin
+ if not DirectoryExists(DirectoryName) then
+ begin
+ if (MessageDlg(Format(RsCreatePath, [DisplayName]), mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then
+ Abort;
+ if not ForceDirectories(DirectoryName) then
+ begin
+ MessageDlg(Format(RsCantCreatePath, [DirectoryName]), mtError, [mbAbort], 0);
+ Abort;
+ end;
+ end;
+ end;
+var
+ PathEnvVar: string;
+begin
+ Result := True;
+ if OptionSelected(ioJCL) then
+ begin
+ if not OptionSelected(ioJclPackages)
+ and (MessageDlg(RsPackageNodeNotSelected, mtWarning, [mbYes, mbNo], 0) <> mrYes) then
+ Abort;
+
+ EnsureDirectoryExists(BplPath, 'BPL');
+ EnsureDirectoryExists(DcpPath, 'DCP');
+
+ {$IFDEF MSWINDOWS
+ PathEnvVar := RegReadStringDef(HKCU, RegHKCUEnvironmentVar, PathEnvironmentVar, '');
+ PathListIncludeItems(PathEnvVar, RegReadStringDef(HKLM, RegHKLMEnvironmentVar, PathEnvironmentVar, ''));
+ if (PathListItemIndex(PathEnvVar, BplPath) = -1) and (PathListItemIndex(PathEnvVar, PathAddSeparator(BplPath)) = -1)
+ and (MessageDlg(RsAddPathToEnvironment, mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
+ begin
+ PathEnvVar := RegReadStringDef(HKCU, RegHKCUEnvironmentVar, PathEnvironmentVar, '');
+ PathListIncludeItems(PathEnvVar, BplPath);
+ RegWriteString(HKCU, RegHKCUEnvironmentVar, PathEnvironmentVar, PathEnvVar);
+ end;
+ {$ENDIF MSWINDOWS
+
+ InstallationStarted;
+ try
+ Result := InstallSelectedOptions;
+ finally
+ InstallationFinished;
+ end;
+ end;
+ SaveOptions;
+end;
+}
+
+//=== { TJclDistribution } ===================================================
+
+procedure TJclDistribution.Close;
+var
+ I: Integer;
+ Settings: IJediConfiguration;
+begin
+ Settings := InstallCore.Configuration;
+ if Assigned(Settings) and Assigned(FProfilesPage) then
+ for I := 0 to InstallCore.ProfilesManager.ProfileCount - 1 do
+ Settings.OptionAsBoolByName[ProfilesSectionName, InstallCore.ProfilesManager.ProfileNames[I]] := FProfilesPage.IsProfileEnabled[I];
+ for I := 0 to TargetInstallCount - 1 do
+ TargetInstalls[I].Close;
+ FGUI := nil;
+end;
+
+constructor TJclDistribution.Create;
+ procedure RegisterJclOptions;
+ var
+ Option: TInstallerOption;
+ AInstallCore: TJediInstallCore;
+ OptionName: string;
+ begin
+ AInstallCore := InstallCore;
+ for Option := Low(TInstallerOption) to High(TInstallerOption) do
+ begin
+ OptionName := GetEnumName(TypeInfo(TInstallerOption), Integer(Option));
+ OptionName := 'Jcl' + Copy(OptionName, 3, Length(OptionName) - 2);
+ OptionData[Option].Id := AInstallCore.AddInstallOption(OptionName);
+ end;
+ end;
+begin
+ inherited Create;
+
+ RegisterJclOptions;
+
+ {$IFDEF MSWINDOWS}
+ FCLRVersions := TStringList.Create;
+ FRegHelpCommands := TStringList.Create;
+ {$ENDIF MSWINDOWS}
+ FRadToolInstallations := TJclBorRADToolInstallations.Create;
+
+ FTargetInstalls := TObjectList.Create;
+ FTargetInstalls.OwnsObjects := True;
+end;
+
+function TJclDistribution.CreateInstall(Target: TJclBorRADToolInstallation): Boolean;
+ function Supported: 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]) and (bpDelphi32 in Target.Personalities))
+ or (Target.VersionNumber in [3, 4, 5, 6]);
+ else
+ Result := False;
+ end;
+ Result := Result and (Target.Personalities * [bpDelphi32, bpBCBuilder32, bpDelphiNet32, bpDelphiNet64] <> []);
+ {$ENDIF ~KYLIX}
+ end;
+var
+ Inst: TJclInstallation;
+ {$IFDEF MSWINDOWS}
+ Index: Integer;
+ CLRVersion: string;
+ {$ENDIF MSWINDOWS}
+begin
+ if Supported then
+ try
+ Inst := TJclInstallation.Create(Self, Target);
+ FTargetInstalls.Add(Inst);
+ {$IFDEF MSWINDOWS}
+ // .net "virtual" targets
+ if (Target is TJclBDSInstallation) and (Target.IDEVersionNumber >= 3) and (not Target.IsTurboExplorer)
+ and (bpDelphiNet32 in Target.Personalities) then
+ begin
+ for Index := 0 to FCLRVersions.Count - 1 do
+ begin
+ CLRVersion := FCLRVersions.Names[Index];
+ if (CompareCLRVersions(CLRVersion, TJclBDSInstallation(Target).MaxDelphiCLRVersion) = 0)
+ and (CompareCLRVersions(CLRVersion, 'v1.1.2344') >= 0) then // CLR 1.0 not supported by the JCL
+ begin
+ Inst := TJclInstallation.Create(Self, Target, CLRVersion);
+ FTargetInstalls.Add(Inst);
+ {if Target.VersionNumber >= 4 then
+ begin
+ Inst := TJclInstallation.Create(Self, Target, CLRVersion, bp64bit);
+ FTargetInstalls.Add(Inst);
+ end;}
+ end;
+ end;
+ end;
+ {$ENDIF MSWINDOWS}
+ except
+ end;
+ Result := True;
+end;
+
+destructor TJclDistribution.Destroy;
+begin
+ {$IFDEF MSWINDOWS}
+ FCLRVersions.Free;
+ FRegHelpCommands.Free;
+ {$ENDIF MSWINDOWS}
+
+ FRadToolInstallations.Free;
+
+ FTargetInstalls.Free;
+
+ inherited Destroy;
+end;
+
+function TJclDistribution.GetTargetInstall(Index: Integer): TJclInstallation;
+begin
+ Result := TJclInstallation(FTargetInstalls.Items[Index]);
+end;
+
+function TJclDistribution.GetTargetInstallCount: Integer;
+begin
+ Result := FTargetInstalls.Count;
+end;
+
+function TJclDistribution.GetVersion: string;
+ function GetRevision: Integer;
+ var
+ DailyFileName, SvnEntriesFileName, RevisionText: string;
+ TextFile: TJclAnsiMappedTextReader;
+ begin
+ Result := 0;
+
+ DailyFileName := FJclPath + DailyRevisionFileName;
+ if FileExists(DailyFileName) then
+ begin
+ // directory from a daily zip
+ TextFile := TJclAnsiMappedTextReader.Create(DailyFileName);
+ try
+ RevisionText := string(TextFile.ReadLn);
+ Result := StrToIntDef(RevisionText, 0);
+ finally
+ TextFile.Free;
+ end;
+ end;
+
+ if Result = 0 then
+ begin
+ SvnEntriesFileName := FJclPath + EntriesFileName1;
+ if not FileExists(SvnEntriesFileName) then
+ SvnEntriesFileName := FJclPath + EntriesFileName2;
+ if FileExists(SvnEntriesFileName) then
+ begin
+ // directory from subversion
+ TextFile := TJclAnsiMappedTextReader.Create(SvnEntriesFileName);
+ try
+ TextFile.ReadLn;
+ TextFile.ReadLn;
+ TextFile.ReadLn;
+ RevisionText := string(TextFile.ReadLn);
+ Result := StrToIntDef(RevisionText, 0);
+ finally
+ TextFile.Free;
+ end;
+ end;
+ end;
+ end;
+var
+ StableText, Source: string;
+ Revision: Integer;
+begin
+ if JclVersionRelease = 0 then
+ begin
+ Revision := GetRevision;
+ StableText := RsJclVersionTesting;
+ end
+ else
+ begin
+ Revision := 0;
+ StableText := RsJclVersionRelease;
+ end;
+
+ if Revision = 0 then
+ begin
+ Source := RsJclVersionBuild;
+ Revision := JclVersionBuild;
+ end
+ else
+ Source := RsJclVersionRevision;
+
+ Result := Format(RsJclVersionMask, [JclVersionMajor, JclVersionMinor, StableText, Source, Revision])
+end;
+
+procedure TJclDistribution.Init;
+ procedure InitDistribution;
+ var
+ ExceptDialogsPath, InstallerFileName, ProfileName: string;
+ ReadMePage: IJediReadMePage;
+ Index: Integer;
+ Settings: IJediConfiguration;
+ begin
+ InstallerFileName := ParamStr(0);
+
+ FJclPath := PathAddSeparator(ExpandFileName(PathExtractFileDirFixed(InstallerFileName) + '..'));
+ {$IFDEF MSWINDOWS}
+ FJclPath := PathGetShortName(FJclPath);
+ {$ENDIF MSWINDOWS}
+ FLibReleaseDirMask := Format('%slib' + VersionDirExp, [FJclPath]);
+ FLibDebugDirMask := FLibReleaseDirMask + DirDelimiter + 'debug';
+ FJclBinDir := FJclPath + 'bin';
+ FJclSourceDir := FJclPath + 'source';
+ FJclIncludeDir := PathAddSeparator(FJclSourceDir) + 'include';
+ FJclExamplesDir := FJclPath + 'examples';
+ FJclSourcePath := '';
+ for Index := Low(JclSourceDirs) to High(JclSourceDirs) do
+ ListAddItems(FJclSourcePath, DirSeparator, PathAddSeparator(FJclSourceDir) + JclSourceDirs[Index]);
+
+ ExceptDialogsPath := FJclPath + ExceptDlgPath;
+ FClxDialogFileName := ExceptDialogsPath + ExceptDlgClxFileName;
+ FClxDialogIconFileName := ChangeFileExt(FClxDialogFileName, '.ico');
+ FVclDialogFileName := ExceptDialogsPath + ExceptDlgVclFileName;
+ FVclDialogIconFileName := ChangeFileExt(FVclDialogFileName, '.ico');
+ FVclDialogSendFileName := ExceptDialogsPath + ExceptDlgVclSndFileName;
+ FVclDialogSendIconFileName := ChangeFileExt(FVclDialogSendFileName, '.ico');
+ FJclChmHelpFileName := FJclPath + JclChmHelpFile;
+ FJclHlpHelpFileName := FJclPath + JclHlpHelpFile;
+ FJclHxSHelpFileName := FJclPath + JclHxSHelpFile;
+ if not FileExists(FJclChmHelpFileName) then
+ FJclChmHelpFileName := '';
+ if not FileExists(FJclHlpHelpFileName) then
+ FJclHlpHelpFileName := '';
+ if not FileExists(FJclHxSHelpFileName) then
+ FJclHxSHelpFileName := '';
+ {$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);
+ {$ENDIF MSWINDOWS}
+ FJclReadmeFileName := FJclPath + 'docs' + DirDelimiter + ReadmeFileName;
+ if Assigned(GUI) then
+ begin
+ ReadMePage := GUI.CreateReadmePage;
+ ReadMePage.Caption := Version;
+ ReadMePage.ReadmeFileName := FJclReadmeFileName;
+
+ if InstallCore.ProfilesManager.MultipleProfileMode then
+ begin
+ FProfilesPage := GUI.CreateProfilesPage;
+ FProfilesPage.Caption := 'Profiles';
+
+ Settings := InstallCore.Configuration;
+ if Settings <> nil then
+ for Index := 0 to InstallCore.ProfilesManager.ProfileCount - 1 do
+ begin
+ ProfileName := InstallCore.ProfilesManager.ProfileNames[Index];
+ if Settings.ValueExists(ProfilesSectionName, ProfileName) then
+ FProfilesPage.IsProfileEnabled[Index] := Settings.OptionAsBoolByName[ProfilesSectionName, ProfileName];
+ end;
+ end;
+ end;
+
+ {$IFDEF MSWINDOWS}
+ FCLRVersions.Clear;
+ try
+ JclDotNet.TJclClrHost.GetClrVersions(FCLRVersions);
+ except
+ // trap exceptions when no .net runtimes are installed
+ end;
+ {$ENDIF MSWINDOWS}
+ end;
+
+ procedure CreateInstallations;
+ begin
+ if not RADToolInstallations.Iterate(CreateInstall) then
+ raise EJediInstallInitFailure.CreateRes(@RsNoInstall);
+ end;
+
+ procedure InitInstallations;
+ var
+ I: Integer;
+ begin
+ for I := 0 to TargetInstallCount - 1 do
+ TargetInstalls[I].Init;
+ end;
+begin
+ FGUI := InstallCore.InstallGUI;
+
+ InitDistribution;
+ CreateInstallations;
+ InitInstallations;
+end;
+
+function TJclDistribution.Install: Boolean;
+var
+ I: Integer;
+ KeepSettings: Boolean;
+ AInstallation: TJclInstallation;
+begin
+ KeepSettings := True;
+ try
+ if RadToolInstallations.AnyInstanceRunning {$IFDEF MSWINDOWS} and not IsDebuggerAttached {$ENDIF} then
+ begin
+ if Assigned(GUI) then
+ GUI.Dialog(RsCloseRADTool, dtError, [drCancel]);
+ Result := False;
+ Exit;
+ end;
+
+ {$IFDEF MSWINDOWS}
+ if Assigned(GUI) then
+ begin
+ GUI.Status := 'Initializing JCL installation process';
+
+ for I := 0 to TargetInstallCount - 1 do
+ begin
+ AInstallation := TargetInstalls[I];
+ if AInstallation.Enabled and (AInstallation.CLRVersion = '') then
+ begin
+ KeepSettings := GUI.Dialog('Do you want to keep JCL expert settings?',
+ dtConfirmation, [drYes, drNo]) = drYes;
+ Break;
+ end;
+ end;
+ end;
+ RegHelpClearCommands;
+ {$ENDIF MSWINDOWS}
+
+ FNbEnabled := 0;
+ FNbInstalled := 0;
+
+ for I := 0 to TargetInstallCount - 1 do
+ if TargetInstalls[I].Enabled then
+ Inc(FNbEnabled);
+
+ Result := True;
+ for I := 0 to TargetInstallCount - 1 do
+ begin
+ AInstallation := TargetInstalls[I];
+ if AInstallation.Enabled then
+ begin
+ AInstallation.Silent := False;
+ if (AInstallation.CLRVersion = '') and not KeepSettings then
+ AInstallation.RemoveSettings;
+ AInstallation.Uninstall(False);
+ Result := AInstallation.Install;
+ if not Result then
+ Break;
+ Inc(FNbInstalled);
+ end;
+ end;
+
+ {$IFDEF MSWINDOWS}
+ Result := Result and RegHelpExecuteCommands(True);
+ {$ENDIF MSWINDOWS}
+
+ if Assigned(GUI) then
+ begin
+ if Result then
+ GUI.Dialog('Installation success', dtInformation, [drOK])
+ else
+ GUI.Dialog('Installation failed, see logs for details', dtError, [drOK]);
+ end;
+ finally
+ if Assigned(GUI) then
+ GUI.Status := 'Installation finished';
+ end;
+end;
+
+{$IFDEF MSWINDOWS}
+const
+ // Reg Helper constant (chronological order)
+ RHCreateTransaction = 1;
+ RHRegisterNameSpace = 2;
+ RHRegisterFile = 3;
+ RHPlugNameSpace = 4;
+ RHUnplugNameSpace = 5;
+ RHUnregisterFile = 6;
+ RHUnregisterNameSpace = 7;
+ RHCommitTransaction = 8;
+
+procedure TJclDistribution.RegHelpClearCommands;
+begin
+ FRegHelpCommands.Clear;
+end;
+
+procedure TJclDistribution.RegHelpCommitTransaction;
+begin
+ RegHelpInternalAdd(RHCommitTransaction, 'commit', True);
+end;
+
+procedure TJclDistribution.RegHelpCreateTransaction;
+begin
+ RegHelpInternalAdd(RHCreateTransaction, 'create', True);
+end;
+
+function TJclDistribution.RegHelpExecuteCommands(DisplayErrors: Boolean): Boolean;
+var
+ Index: Integer;
+ Parameters, LogFileName, ProgramResult, Verb: string;
+ ResultLines: TJclAnsiMappedTextReader;
+ TargetInstall: TJclInstallation;
+begin
+ Result := True;
+ if FRegHelpCommands.Count = 0 then
+ Exit;
+
+ // step 1: compile the RegHelper utility
+
+ for Index := TargetInstallCount - 1 downto 0 do // from the end (newer releases ready for vista)
+ begin
+ TargetInstall := TargetInstalls[Index];
+ if TargetInstall.Enabled then
+ begin
+ Result := TargetInstall.CompileApplication(JclPath + 'install\RegHelper.dpr');
+ if not Result then
+ begin
+ if Assigned(GUI) then
+ GUI.Dialog('Failed to compile RegHelper utility', dtError, [drOK]);
+ Exit;
+ end;
+ Break;
+ end;
+ end;
+
+ // step 2: create parameters for the RegHelper utility
+
+ LogFileName := JclBinDir + '\RegHelper.log';
+ if FileExists(LogFileName) then
+ FileDelete(LogFileName);
+ Parameters := '-c -o' + LogFileName;
+ for Index := 0 to FRegHelpCommands.Count - 1 do
+ begin
+ case Integer(FRegHelpCommands.Objects[Index]) of
+ RHCreateTransaction:
+ Parameters := Format('%s Create', [Parameters]);
+ RHRegisterNameSpace:
+ Parameters := Format('%s "RegNameSpace;%s"', [Parameters, FRegHelpCommands.Strings[Index]]);
+ RHRegisterFile:
+ Parameters := Format('%s "RegHelpFile;%s"', [Parameters, FRegHelpCommands.Strings[Index]]);
+ RHPlugNameSpace:
+ Parameters := Format('%s "PlugNameSpace;%s"', [Parameters, FRegHelpCommands.Strings[Index]]);
+ RHUnplugNameSpace:
+ Parameters := Format('%s "UnplugNameSpace;%s"', [Parameters, FRegHelpCommands.Strings[Index]]);
+ RHUnregisterFile:
+ Parameters := Format('%s "UnregHelpFile;%s"', [Parameters, FRegHelpCommands.Strings[Index]]);
+ RHUnregisterNameSpace:
+ Parameters := Format('%s "UnregNameSpace;%s"', [Parameters, FRegHelpCommands.Strings[Index]]);
+ RHCommitTransaction:
+ Parameters := Format('%s Commit', [Parameters]);
+ else
+ if Assigned(GUI) then
+ GUI.Dialog('Fatal error: unknown reghelp command', dtError, [drOK]);
+ Exit;
+ end;
+ end;
+
+ // step 3: inform the user and execute RegHelper
+
+ // simple dialog explaining user why we need credentials
+ if Assigned(GUI) and not IsElevated then
+ GUI.Dialog(RsHTMLHelp2Credentials, dtInformation, [drOK]);
+
+ // RegHelper.exe manifest requires elevation on Vista
+ if IsAdministrator or IsWinVista or IsWinServer2008 or IsWin7 or IsWinServer2008R2 then
+ Verb := 'open'
+ else
+ Verb := 'runas';
+
+ Result := JclShell.ShellExecAndWait(JclBinDir + '\RegHelper.exe', Parameters, Verb, SW_HIDE, JclPath + 'help\');
+
+ // step 4: examine output
+ if Result then
+ begin
+ if not DisplayErrors then
+ Exit;
+ Sleep(500); // wait possible antivirus lock
+ ResultLines := TJclAnsiMappedTextReader.Create(LogFileName);
+ try
+ while not ResultLines.Eof do
+ begin
+ ProgramResult := string(ResultLines.ReadLn);
+ if AnsiPos('ERROR', AnsiUpperCase(ProgramResult)) > 0 then
+ begin
+ Result := False;
+ if Assigned(GUI) then
+ GUI.Dialog('RegHelper raised an error while executing RegHelp command: ' + NativeLineBreak + ProgramResult, dtError, [drCancel]);
+ end;
+ end;
+ finally
+ ResultLines.Free;
+ end;
+ end
+ else
+ GUI.Dialog('Fatal error: failed to execute RegHelp utility', dtError, [drOK]);
+end;
+
+procedure TJclDistribution.RegHelpInternalAdd(Command: Integer;
+ Arguments: string; DoNotRepeatCommand: Boolean);
+var
+ Index: Integer;
+ AObject: TObject;
+begin
+ Index := 0;
+ while Index <= FRegHelpCommands.Count do
+ begin
+ if Index = FRegHelpCommands.Count then
+ begin
+ FRegHelpCommands.AddObject(Arguments, TObject(Command));
+ Break;
+ end;
+ AObject := FRegHelpCommands.Objects[Index];
+ if (Integer(AObject) = Command) and
+ (DoNotRepeatCommand or (FRegHelpCommands.Strings[Index] = Arguments)) then
+ Break;
+ if Integer(AObject) > Command then
+ begin
+ FRegHelpCommands.InsertObject(Index, Arguments, TObject(Command));
+ Break;
+ end;
+ Inc(Index);
+ end;
+end;
+
+procedure TJclDistribution.RegHelpPlugNameSpaceIn(const SourceNameSpace,
+ TargetNameSpace: WideString);
+begin
+ RegHelpInternalAdd(RHPlugNameSpace, Format('%s;%s', [SourceNameSpace, TargetNameSpace]), False);
+end;
+
+procedure TJclDistribution.RegHelpRegisterHelpFile(const NameSpace,
+ Identifier: WideString; const LangId: Integer; const HxSFile,
+ HxIFile: WideString);
+begin
+ RegHelpInternalAdd(RHRegisterFile, Format('%s;%s;%d;%s;%s', [NameSpace, Identifier, LangId, HxSFile, HxIFile]), False);
+end;
+
+procedure TJclDistribution.RegHelpRegisterNameSpace(const Name, Collection,
+ Description: WideString);
+begin
+ RegHelpInternalAdd(RHRegisterNameSpace, Format('%s;%s;%s', [Name, Collection, Description]), False);
+end;
+
+procedure TJclDistribution.RegHelpUnPlugNameSpace(const SourceNameSpace,
+ TargetNameSpace: WideString);
+begin
+ RegHelpInternalAdd(RHUnplugNameSpace, Format('%s;%s', [SourceNameSpace, TargetNameSpace]), False);
+end;
+
+procedure TJclDistribution.RegHelpUnregisterHelpFile(const NameSpace,
+ Identifier: WideString; const LangId: Integer);
+begin
+ RegHelpInternalAdd(RHUnregisterFile, Format('%s;%s;%d', [NameSpace, Identifier, LangId]), False);
+end;
+
+procedure TJclDistribution.RegHelpUnregisterNameSpace(const Name: WideString);
+begin
+ RegHelpInternalAdd(RHUnregisterNameSpace, Name, False);
+end;
+{$ENDIF MSWINDOWS}
+
+function TJclDistribution.Uninstall: Boolean;
+var
+ I: Integer;
+ AInstallation: TJclInstallation;
+begin
+ try
+ if RadToolInstallations.AnyInstanceRunning {$IFDEF MSWINDOWS} and not IsDebuggerAttached {$ENDIF} then
+ begin
+ if Assigned(GUI) then
+ GUI.Dialog(RsCloseRADTool, dtError, [drCancel]);
+ Result := False;
+ Exit;
+ end;
+
+ if Assigned(GUI) then
+ GUI.Status := 'Initializing JCL uninstallation process';
+
+ {$IFDEF MSWINDOWS}
+ RegHelpClearCommands;
+ {$ENDIF MSWINDOWS}
+
+ Result := True;
+ for I := 0 to TargetInstallCount - 1 do
+ begin
+ AInstallation := TargetInstalls[I];
+ AInstallation.Silent := False;
+ if AInstallation.Enabled and ((not AInstallation.RemoveSettings) or not AInstallation.Uninstall(True)) then
+ Result := False;
+ end;
+
+ {$IFDEF MSWINDOWS}
+ RegHelpExecuteCommands(False);
+ {$ENDIF MSWINDOWS}
+
+ if Assigned(GUI) then
+ begin
+ if Result then
+ GUI.Dialog('Uninstallation success', dtInformation, [drOK])
+ else
+ GUI.Dialog('Uninstallation failed, see logs for details', dtError, [drOK]);
+ end;
+ finally
+ if Assigned(GUI) then
+ GUI.Status := 'Uninstallation finished';
+ end;
+end;
+
+initialization
+ JediInstall.InstallCore.AddProduct(TJclDistribution.Create);
+
+end.
\ No newline at end of file
diff --git a/official/1.104/install/JediInstall.pas b/official/1.104/install/JediInstall.pas
new file mode 100644
index 0000000..4f00009
--- /dev/null
+++ b/official/1.104/install/JediInstall.pas
@@ -0,0 +1,596 @@
+{**************************************************************************************************}
+{ }
+{ 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) }
+{ Florent Ouchet (new core for more than one target) }
+{ }
+{ Last modified: $Date: 2007-10-15 13:18:28 +0200 (lun., 15 oct. 2007) $ }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-10-15 13:18:28 +0200 (lun., 15 oct. 2007) $ }
+{ Revision: $Rev:: 2197 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JediInstall;
+
+{$I jcl.inc}
+{$I crossplatform.inc}
+
+interface
+
+uses
+ SysUtils, Classes,
+ JclContainerIntf;
+
+type
+ 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;
+
+type
+ TDialogType = (dtWarning, dtError, dtInformation, dtConfirmation);
+ TDialogTypes = set of TDialogType;
+ TDialogResponse = (drYes, drNo, drOK, drCancel);
+ TDialogResponses = set of TDialogResponse;
+
+ EJediInstallInitFailure = class(Exception);
+
+ IJediPage = interface
+ ['{5669B427-F46D-4737-9D1D-680C52CDE3DF}']
+ function GetCaption: string;
+ procedure SetCaption(const Value: string);
+ function GetHintAtPos(ScreenX, ScreenY: Integer): string;
+ procedure Show;
+
+ property Caption: string read GetCaption write SetCaption;
+ end;
+
+ IJediReadmePage = interface(IJediPage)
+ ['{5DA5C5C9-649F-47CF-B64A-55E983CA88EC}']
+ procedure SetReadmeFileName(const Value: string);
+ function GetReadmeFileName: string;
+
+ property ReadmeFileName: string read GetReadmeFileName write SetReadmeFileName;
+ end;
+
+ IJediInstallPage = interface(IJediPage)
+ ['{91C3A26F-0258-410A-9EAF-06F86C5748CF}']
+ procedure AddInstallOption(Id: Integer; Options: TJediInstallGUIOptions;
+ const Caption: string = ''; const Hint: string = ''; Parent: Integer = -1);
+ procedure InitDisplay;
+ function GetOptionChecked(Id: Integer): Boolean;
+ procedure SetOptionChecked(Id: Integer; Value: Boolean);
+ function GetDirectoryCount: Integer;
+ function GetDirectory(Index: Integer): string;
+ procedure SetDirectory(Index: Integer; const Value: string);
+ function AddDirectory(Caption: string): Integer;
+ function GetProgress: Integer;
+ procedure SetProgress(Value: Integer);
+ procedure BeginInstall;
+ procedure MarkOptionBegin(Id: Integer);
+ procedure MarkOptionEnd(Id: Integer; Failed: Boolean);
+ procedure EndInstall;
+ procedure CompilationStart(const ProjectName: string);
+ procedure AddHint(const Line: string);
+ procedure AddWarning(const Line: string);
+ procedure AddError(const Line: string);
+ procedure AddFatal(const Line: string);
+ procedure AddText(const Line: string);
+ procedure CompilationProgress(const FileName: string; LineNumber: Integer);
+ procedure SetIcon(const FileName: string);
+
+ property OptionChecked[Id: Integer]: Boolean read GetOptionChecked write SetOptionChecked;
+ property DirectoryCount: Integer read GetDirectoryCount;
+ property Directories[Index: Integer]: string read GetDirectory write SetDirectory;
+ property Progress: Integer read GetProgress write SetProgress;
+ end;
+
+ IJediProfilesPage = interface(IJediPage)
+ ['{23CD1150-A05F-4C64-A3A5-5335874DF942}']
+ function GetProfileEnabled(Index: Integer): Boolean;
+ procedure SetProfileEnabled(Index: Integer; Value: Boolean);
+ property IsProfileEnabled[Index: Integer]: Boolean read GetProfileEnabled write SetProfileEnabled;
+ end;
+
+ TOptionRec = record
+ Name: string;
+ Value: string;
+ end;
+
+ TOptionArray = array of TOptionRec;
+
+ TStringArray = array of string;
+
+ IJediConfiguration = interface
+ ['{4E96C8E8-ABA7-475D-BDF9-88B158F2CED3}']
+ function GetSections: TStringArray;
+ function GetOptions(const Section: string): TOptionArray;
+ function GetOptionAsBool(const Section: string; Id: Integer): Boolean;
+ procedure SetOptionAsBool(const Section: string; Id: Integer; Value: Boolean);
+ function GetOptionAsBoolByName(const Section: string; const Name: string): Boolean;
+ procedure SetOptionAsBoolByName(const Section: string; const Name: string; Value: Boolean);
+ function GetOptionAsString(const Section: string; Id: Integer): string;
+ procedure SetOptionAsString(const Section: string; Id: Integer; const Value: string);
+ function GetOptionAsStringByName(const Section: string; const Name: string): string;
+ procedure SetOptionAsStringByName(const Section: string; const Name: string; const Value: string);
+
+ procedure Clear;
+ procedure DeleteSection(const Section: string);
+ procedure DeleteOption(const Section: string; Id: Integer);
+ function SectionExists(const Section: string): Boolean;
+ function ValueExists(const Section: string; Id: Integer): Boolean; overload;
+ function ValueExists(const Section: string; const Name: string): Boolean; overload;
+
+ property Sections: TStringArray read GetSections;
+ property Options[const Section: string]: TOptionArray read GetOptions;
+ property OptionAsBool[const Section: string; Id: Integer]: Boolean read GetOptionAsBool
+ write SetOptionAsBool;
+ property OptionAsBoolByName[const Section: string; const Name: string]: Boolean
+ read GetOptionAsBoolByName write SetOptionAsBoolByName;
+ property OptionAsString[const Section: string; Id: Integer]: string read GetOptionAsString
+ write SetOptionAsString;
+ property OptionAsStringByName[const Section: string; const Name: string]: string
+ read GetOptionAsStringByName write SetOptionAsStringByName;
+ end;
+
+ IJediDistribution = interface
+ ['{90E201C9-EA6B-446A-9251-D2516867874D}']
+ end;
+
+ TInstallEvent = procedure of Object;
+
+ // GUI abstraction layer
+ IJediInstallGUI = interface
+ ['{3471A535-51D7-4FBB-B6AE-20D136E38E34}']
+ function Dialog(const Text: string; DialogType: TDialogType = dtInformation;
+ Options: TDialogResponses = [drOK]): TDialogResponse;
+ function CreateReadmePage: IJediReadmePage;
+ function CreateInstallPage: IJediInstallPage;
+ function CreateProfilesPage: IJediProfilesPage;
+ function GetPageCount: Integer;
+ function GetPage(Index: Integer): IJediPage;
+ function GetStatus: string;
+ procedure SetStatus(const Value: string);
+ function GetCaption: string;
+ procedure SetCaption(const Value: string);
+ function GetProgress: Integer;
+ procedure SetProgress(Value: Integer);
+ function GetAutoAcceptDialogs: TDialogTypes;
+ procedure SetAutoAcceptDialogs(Value: TDialogTypes);
+ function GetAutoCloseOnFailure: Boolean;
+ procedure SetAutoCloseOnFailure(Value: Boolean);
+ function GetAutoCloseOnSuccess: Boolean;
+ procedure SetAutoCloseOnSuccess(Value: Boolean);
+ function GetAutoInstall: Boolean;
+ procedure SetAutoInstall(Value: Boolean);
+ function GetAutoUninstall: Boolean;
+ procedure SetAutoUninstall(Value: Boolean);
+ procedure Execute;
+
+ property AutoAcceptDialogs: TDialogTypes read GetAutoAcceptDialogs write SetAutoAcceptDialogs;
+ property AutoCloseOnFailure: Boolean read GetAutoCloseOnFailure write SetAutoCloseOnFailure;
+ property AutoCloseOnSuccess: Boolean read GetAutoCloseOnSuccess write SetAutoCloseOnSuccess;
+ property AutoInstall: Boolean read GetAutoInstall write SetAutoInstall;
+ property AutoUninstall: Boolean read GetAutoUninstall write SetAutoUninstall;
+ property PageCount: Integer read GetPageCount;
+ property Pages[Index: Integer]: IJediPage read GetPage;
+ property Status: string read GetStatus write SetStatus;
+ property Caption: string read GetCaption write SetCaption;
+ property Progress: Integer read GetProgress write SetProgress;
+ end;
+
+ IJediProduct = interface
+ ['{CF5BE67A-4A49-43FB-8F6E-217A51023DA4}']
+ procedure Init;
+ function Install: Boolean;
+ function Uninstall: Boolean;
+ procedure Close;
+ end;
+
+ IJediProfilesManager = interface
+ ['{5B818F08-3325-492A-BFC3-9489F749CB78}']
+ function CheckPrerequisites: Boolean;
+ function GetMultipleProfileMode: Boolean;
+ function GetProfileKey(Index: Integer): LongWord; // HKEY is Windows specific
+ function GetProfileCount: Integer;
+ function GetProfileName(Index: Integer): string;
+ procedure SetMultipleProfileMode(Value: Boolean);
+ property ProfileKeys[Index: Integer]: LongWord read GetProfileKey;
+ property ProfileNames[Index: Integer]: string read GetProfileName;
+ property ProfileCount: Integer read GetProfileCount;
+ property MultipleProfileMode: Boolean read GetMultipleProfileMode write SetMultipleProfileMode;
+ end;
+
+ TJediInstallGUICreator = function: IJediInstallGUI;
+ TJediConfigurationCreator = function: IJediConfiguration;
+
+ TCompileLineType = (clText, clFileProgress, clHint, clWarning, clError, clFatal);
+
+ TJediInstallCore = class(TComponent)
+ private
+ FInstallGUI: IJediInstallGUI;
+ {$IFDEF VisualCLX}
+ FGUIComponent: TComponent;
+ {$ENDIF VisualCLX}
+ FProducts: IJclIntfList;
+ FClosing: Boolean;
+ FOptions: TStrings;
+ FInstallGUICreator: TJediInstallGUICreator;
+ FConfiguration: IJediConfiguration;
+ FConfigurationCreator: TJediConfigurationCreator;
+ FProfilesManager: IJediProfilesManager;
+ function GetProductCount: Integer;
+ function GetProduct(Index: Integer): IJediProduct;
+ function GetInstallGUI: IJediInstallGUI;
+ function GetConfiguration: IJediConfiguration;
+ {$IFDEF VisualCLX}
+ protected
+ procedure Notification(AComponent: TComponent;
+ Operation: TOperation); override;
+ {$ENDIF VisualCLX}
+ public
+ constructor Create; reintroduce;
+ destructor Destroy; override;
+
+ function AddProduct(AProduct: IJediProduct): Integer;
+ procedure Execute;
+ function Install: Boolean;
+ function Uninstall: Boolean;
+ procedure Close;
+ function AddInstallOption(const Name: string): Integer;
+ function GetInstallOptionName(Id: Integer): string;
+ function GetOptionCount: Integer;
+ function ProcessLogLine(const Line: string; var LineType: TCompileLineType;
+ Page: IJediInstallPage): string;
+
+ property ProductCount: Integer read GetProductCount;
+ property Products[Index: Integer]: IJediProduct read GetProduct;
+ property Closing: Boolean read FClosing;
+ property InstallOptionName[Id: Integer]: string read GetInstallOptionName;
+ property OptionCount: Integer read GetOptionCount;
+ property InstallGUI: IJediInstallGUI read GetInstallGUI;
+ property InstallGUICreator: TJediInstallGUICreator read FInstallGUICreator
+ write FInstallGUICreator;
+ property Configuration: IJediConfiguration read GetConfiguration;
+ property ConfigurationCreator: TJediConfigurationCreator read FConfigurationCreator
+ write FConfigurationCreator;
+ property ProfilesManager: IJediProfilesManager read FProfilesManager;
+ end;
+
+var
+ JediTargetOption: Integer = -1;
+
+function InstallCore: TJediInstallCore;
+
+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?';
+ RsConfirmUninstall = 'Do you really want to uninstall the JCL?';
+ 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?';
+ RsHintTarget = 'Installation target';
+
+implementation
+
+uses
+ JclArrayLists, JclFileUtils,
+ JediProfiles;
+
+var
+ InternalInstallCore: TJediInstallCore = nil;
+
+function InstallCore: TJediInstallCore;
+begin
+ if not Assigned(InternalInstallCore) then
+ InternalInstallCore := TJediInstallCore.Create;
+ Result := InternalInstallCore;
+end;
+
+//=== { TJediInstallCore } ===================================================
+
+function TJediInstallCore.AddInstallOption(const Name: string): Integer;
+begin
+ Result := FOptions.IndexOf(Name);
+ if Result = -1 then
+ Result := FOptions.Add(Name);
+end;
+
+function TJediInstallCore.AddProduct(AProduct: IJediProduct): Integer;
+begin
+ Result := FProducts.Size;
+ FProducts.Add(AProduct);
+end;
+
+procedure TJediInstallCore.Close;
+var
+ Index: Integer;
+begin
+ if Closing then
+ Exit;
+ FClosing := True;
+
+ for Index := FProducts.Size - 1 downto 0 do
+ (FProducts.GetObject(Index) as IJediProduct).Close;
+ FProducts.Clear;
+ FProducts := nil;
+ FInstallGUI := nil;
+ FConfiguration := nil;
+end;
+
+constructor TJediInstallCore.Create;
+begin
+ inherited Create(nil);
+
+ FOptions := TStringList.Create;
+ FProducts := TJclIntfArrayList.Create(1);
+ FClosing := False;
+ JediTargetOption := AddInstallOption('joTarget');
+
+ FProfilesManager := TJediProfilesManager.Create;
+end;
+
+destructor TJediInstallCore.Destroy;
+begin
+ Close;
+ FConfigurationCreator := nil;
+ FInstallGUICreator := nil;
+ FProducts := nil;
+ FInstallGUI := nil;
+ FConfiguration := nil;
+ FOptions.Free;
+
+ inherited Destroy;
+end;
+
+procedure TJediInstallCore.Execute;
+var
+ Index: Integer;
+ AInstallGUI: IJediInstallGUI;
+begin
+ FProfilesManager.MultipleProfileMode := ParamPos('MultipleProfiles') >= 1;
+ if FProfilesManager.CheckPrerequisites then
+ begin
+ AInstallGUI := InstallGUI;
+
+ for Index := FProducts.Size - 1 downto 0 do
+ (FProducts.GetObject(Index) as IJediProduct).Init;
+
+ if Assigned(AInstallGUI) then
+ AInstallGUI.Execute;
+ end;
+end;
+
+function TJediInstallCore.GetConfiguration: IJediConfiguration;
+begin
+ if Assigned(FConfigurationCreator) and not Assigned(FConfiguration) then
+ FConfiguration := ConfigurationCreator;
+ Result := FConfiguration;
+end;
+
+function TJediInstallCore.GetInstallGUI: IJediInstallGUI;
+var
+{$IFDEF VisualCLX}
+ CompRef: IInterfaceComponentReference;
+{$ENDIF VisualCLX}
+ AutoAcceptDialogs: TDialogTypes;
+begin
+ if Assigned(FInstallGUICreator) and not Assigned(FInstallGUI) then
+ begin
+ FInstallGUI := InstallGUICreator;
+ AutoAcceptDialogs := [];
+ if ParamPos('AcceptInformations') >= 1 then
+ Include(AutoAcceptDialogs, dtInformation);
+ if ParamPos('AcceptConfirmations') >= 1 then
+ Include(AutoAcceptDialogs, dtConfirmation);
+ if ParamPos('AcceptWarnings') >= 1 then
+ Include(AutoAcceptDialogs, dtWarning);
+ if ParamPos('AcceptErrors') >= 1 then
+ Include(AutoAcceptDialogs, dtError);
+ FInstallGUI.AutoAcceptDialogs := AutoAcceptDialogs;
+ FInstallGUI.AutoCloseOnFailure := ParamPos('CloseOnFailure') >= 1;
+ FInstallGUI.AutoCloseOnSuccess := ParamPos('CloseOnSuccess') >= 1;
+ FInstallGUI.AutoInstall := ParamPos('Install') >= 1;
+ FInstallGUI.AutoUninstall := ParamPos('Uninstall') >= 1;
+ end;
+ Result := FInstallGUI;
+{$IFDEF VisualCLX}
+ Result.QueryInterface(IInterfaceComponentReference, CompRef);
+ if Assigned(CompRef) then
+ begin
+ FGUIComponent := CompRef.GetComponent;
+ FGuiComponent.FreeNotification(Self);
+ end;
+{$ENDIF VisualCLX}
+end;
+
+function TJediInstallCore.GetInstallOptionName(Id: Integer): string;
+begin
+ Result := FOptions.Strings[Id];
+end;
+
+function TJediInstallCore.GetOptionCount: Integer;
+begin
+ Result := FOptions.Count;
+end;
+
+function TJediInstallCore.GetProduct(Index: Integer): IJediProduct;
+begin
+ Result := FProducts.GetObject(Index) as IJediProduct;
+end;
+
+function TJediInstallCore.GetProductCount: Integer;
+begin
+ Result := FProducts.Size;
+end;
+
+function TJediInstallCore.Install: Boolean;
+var
+ Index: Integer;
+begin
+ Result := True;
+ for Index := FProducts.Size - 1 downto 0 do
+ begin
+ Result := (FProducts.GetObject(Index) as IJediProduct).Install;
+ if not Result then
+ Break;
+ end;
+end;
+
+{$IFDEF VisualCLX}
+procedure TJediInstallCore.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if (Operation = opRemove) and (AComponent = FGUIComponent) then
+ begin
+ FGUIComponent := nil;
+ FInstallGUI := nil;
+ end;
+end;
+{$ENDIF VisualCLX}
+
+function TJediInstallCore.ProcessLogLine(const Line: string;
+ var LineType: TCompileLineType; Page: IJediInstallPage): string;
+
+ function HasText(Text: string; const Values: array of string): Boolean;
+ var
+ i: Integer;
+ begin
+ Result := True;
+ Text := AnsiLowerCase(Text);
+ for i := Low(Values) to High(Values) do
+ if Pos(Values[i], Text) > 0 then
+ Exit;
+ Result := False;
+ end;
+
+ function 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
+ if Assigned(Page) then
+ Page.CompilationProgress(FileName, LineNum);
+ Result := True;
+ end;
+ end;
+ end;
+ end;
+
+begin
+ LineType := clText;
+ Result := Line;
+ if Line = '' then
+ Exit;
+
+ if IsCompileFileLine(Line) then
+ begin
+ LineType:= clFileProgress;
+ Result := '';
+ end
+ else if HasText(Line, ['hint: ', 'hinweis: ', 'suggestion: ', 'conseil: ']) then // do not localize
+ begin
+ // hide hint about getter/setter names
+ if (Pos(' H2369 ', Line) = 0) then
+ begin
+ LineType := clHint;
+ if Assigned(Page) then
+ Page.AddHint(Line);
+ end
+ else
+ Result := '';
+ end
+ else if HasText(Line, ['warning: ', 'warnung: ', 'avertissement: ']) then // do not localize
+ begin
+ // hide platform warnings
+ if (Pos(' W1002 ', Line) = 0) then
+ begin
+ LineType := clWarning;
+ if Assigned(Page) then
+ Page.AddWarning(Line);
+ end
+ else
+ Result := '';
+ end
+ else if HasText(Line, ['error: ', 'fehler: ', 'erreur: ']) then // do not localize
+ begin
+ LineType := clError;
+ if Assigned(Page) then
+ Page.AddError(Line);
+ end
+ else if HasText(Line, ['fatal: ', 'schwerwiegend: ', 'fatale: ']) then // do not localize
+ begin
+ LineType := clFatal;
+ if Assigned(Page) then
+ Page.AddFatal(Line);
+ end
+ else if Assigned(Page) then
+ Page.AddText(Line);
+end;
+
+function TJediInstallCore.Uninstall: Boolean;
+var
+ Index: Integer;
+begin
+ Result := True;
+ for Index := FProducts.Size - 1 downto 0 do
+ Result := (FProducts.GetObject(Index) as IJediProduct).Uninstall and Result;
+end;
+
+initialization
+
+finalization
+
+InternalInstallCore.Free;
+
+end.
diff --git a/official/1.104/install/JediInstallConfigIni.pas b/official/1.104/install/JediInstallConfigIni.pas
new file mode 100644
index 0000000..636f9f2
--- /dev/null
+++ b/official/1.104/install/JediInstallConfigIni.pas
@@ -0,0 +1,246 @@
+{**************************************************************************************************}
+{ }
+{ 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 JediInstallConfigIni.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by Florent Ouchet }
+{ are Copyright (C) of Florent Ouchet. All Rights Reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Storage facility into an ini file for the installer core }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JediInstallConfigIni;
+
+{$I jcl.inc}
+{$I crossplatform.inc}
+
+interface
+
+uses
+ JediInstall, IniFiles;
+
+type
+ TJediConfigIni = class(TInterfacedObject, IJediConfiguration)
+ private
+ FIniFile: TMemIniFile;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ // IJediConfiguration
+ function GetSections: TStringArray;
+ function GetOptions(const Section: string): TOptionArray;
+ function GetOptionAsBool(const Section: string; Id: Integer): Boolean;
+ procedure SetOptionAsBool(const Section: string; Id: Integer; Value: Boolean);
+ function GetOptionAsBoolByName(const Section: string; const Name: string): Boolean;
+ procedure SetOptionAsBoolByName(const Section: string; const Name: string; Value: Boolean);
+ function GetOptionAsString(const Section: string; Id: Integer): string;
+ procedure SetOptionAsString(const Section: string; Id: Integer; const Value: string);
+ function GetOptionAsStringByName(const Section: string; const Name: string): string;
+ procedure SetOptionAsStringByName(const Section: string; const Name: string; const Value: string);
+
+ procedure Clear;
+ procedure DeleteSection(const Section: string);
+ procedure DeleteOption(const Section: string; Id: Integer);
+ function SectionExists(const Section: string): Boolean;
+ function ValueExists(const Section: string; Id: Integer): Boolean; overload;
+ function ValueExists(const Section: string; const Name: string): Boolean; overload;
+
+ property Sections: TStringArray read GetSections;
+ property Options[const Section: string]: TOptionArray read GetOptions;
+ property OptionAsBool[const Section: string; Id: Integer]: Boolean read GetOptionAsBool
+ write SetOptionAsBool;
+ property OptionAsBoolByName[const Section: string; const Name: string]: Boolean
+ read GetOptionAsBoolByName write SetOptionAsBoolByName;
+ property OptionAsString[const Section: string; Id: Integer]: string read GetOptionAsString
+ write SetOptionAsString;
+ property OptionAsStringByName[const Section: string; const Name: string]: string
+ read GetOptionAsStringByName write SetOptionAsStringByName;
+ end;
+
+function CreateConfigIni: IJediConfiguration;
+
+implementation
+
+uses
+ SysUtils, Classes,
+ JclSysInfo, JclFileUtils;
+
+resourcestring
+ RsIniFileName = 'JCL-install.ini';
+
+function CreateConfigIni: IJediConfiguration;
+begin
+ Result := TJediConfigIni.Create;
+end;
+
+//=== { TJediConfigIni } =====================================================
+
+procedure TJediConfigIni.Clear;
+begin
+ FIniFile.Clear;
+end;
+
+constructor TJediConfigIni.Create;
+var
+ AFileName: string;
+begin
+ inherited Create;
+
+ AFileName := '';
+
+ if not GetEnvironmentVar('JCL_INSTALL_INI', AFileName) then
+ AFileName := '';
+
+ if AFileName = '' then
+ AFileName := RsIniFileName;
+
+ if not PathIsAbsolute(AFileName) then
+ AFileName := ExtractFilePath(ParamStr(0)) + AFileName;
+
+ FIniFile := TMemIniFile.Create(AFileName);
+end;
+
+procedure TJediConfigIni.DeleteOption(const Section: string; Id: Integer);
+begin
+ FIniFile.DeleteKey(Section, InstallCore.InstallOptionName[Id]);
+end;
+
+procedure TJediConfigIni.DeleteSection(const Section: string);
+begin
+ FIniFile.EraseSection(Section);
+end;
+
+destructor TJediConfigIni.Destroy;
+begin
+ FIniFile.UpdateFile;
+ FIniFile.Free;
+ inherited Destroy;
+end;
+
+function TJediConfigIni.GetOptionAsBool(const Section: string;
+ Id: Integer): Boolean;
+begin
+ Result := FIniFile.ReadBool(Section, InstallCore.InstallOptionName[Id], False);
+end;
+
+function TJediConfigIni.GetOptionAsBoolByName(const Section,
+ Name: string): Boolean;
+begin
+ Result := FIniFile.ReadBool(Section, Name, False);
+end;
+
+function TJediConfigIni.GetOptionAsString(const Section: string;
+ Id: Integer): string;
+begin
+ Result := FIniFile.ReadString(Section, InstallCore.InstallOptionName[Id], '');
+end;
+
+function TJediConfigIni.GetOptionAsStringByName(const Section,
+ Name: string): string;
+begin
+ Result := FIniFile.ReadString(Section, Name, '');
+end;
+
+function TJediConfigIni.GetOptions(const Section: string): TOptionArray;
+var
+ Values: TStrings;
+ Index: Integer;
+ Name: string;
+begin
+ Values := TStringList.Create;
+ try
+ FIniFile.ReadSectionValues(Section, Values);
+ SetLength(Result, Values.Count);
+ for Index := 0 to Values.Count - 1 do
+ begin
+ Name := Values.Names[Index];
+ Result[Index].Name := Name;
+ Result[Index].Value := Values.Values[Name];
+ end;
+ finally
+ Values.Free;
+ end;
+end;
+
+function TJediConfigIni.GetSections: TStringArray;
+var
+ Sections: TStrings;
+ Index: Integer;
+begin
+ Sections := TStringList.Create;
+ try
+ FIniFile.ReadSections(Sections);
+ SetLength(Result, Sections.Count);
+ for Index := 0 to Sections.Count - 1 do
+ Result[Index] := Sections.Strings[Index];
+ finally
+ Sections.Free;
+ end;
+end;
+
+function TJediConfigIni.SectionExists(const Section: string): Boolean;
+begin
+ Result := FIniFile.SectionExists(Section);
+end;
+
+procedure TJediConfigIni.SetOptionAsBool(const Section: string; Id: Integer;
+ Value: Boolean);
+begin
+ FIniFile.WriteBool(Section, InstallCore.InstallOptionName[Id], Value);
+end;
+
+procedure TJediConfigIni.SetOptionAsBoolByName(const Section, Name: string;
+ Value: Boolean);
+begin
+ FIniFile.WriteBool(Section, Name, Value);
+end;
+
+procedure TJediConfigIni.SetOptionAsString(const Section: string; Id: Integer;
+ const Value: string);
+begin
+ FIniFile.WriteString(Section, InstallCore.InstallOptionName[Id], Value);
+end;
+
+procedure TJediConfigIni.SetOptionAsStringByName(const Section, Name,
+ Value: string);
+begin
+ FIniFile.WriteString(Section, Name, Value);
+end;
+
+function TJediConfigIni.ValueExists(const Section: string;
+ Id: Integer): Boolean;
+begin
+ Result := FIniFile.ValueExists(Section, InstallCore.InstallOptionName[Id]);
+end;
+
+function TJediConfigIni.ValueExists(const Section, Name: string): Boolean;
+begin
+ Result := FIniFile.ValueExists(Section, Name);
+end;
+
+initialization
+
+InstallCore.ConfigurationCreator := CreateConfigIni;
+
+end.
diff --git a/official/1.104/install/JediInstaller.bdsproj b/official/1.104/install/JediInstaller.bdsproj
new file mode 100644
index 0000000..db57373
--- /dev/null
+++ b/official/1.104/install/JediInstaller.bdsproj
@@ -0,0 +1,174 @@
+
+
+
+
+ Delphi.Personality
+ 1.0
+ {3A9A06EC-AE74-425F-B057-7BF3B87D937A}
+
+
+
+
+ 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\include;..\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.104/install/JediInstaller.dof b/official/1.104/install/JediInstaller.dof
new file mode 100644
index 0000000..f1b870a
--- /dev/null
+++ b/official/1.104/install/JediInstaller.dof
@@ -0,0 +1,15 @@
+[Directories]
+OutputDir=..\bin
+UnitOutputDir=.
+SearchPath=..\source\include;..\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.104/install/JediInstaller.dpr b/official/1.104/install/JediInstaller.dpr
new file mode 100644
index 0000000..988caea
--- /dev/null
+++ b/official/1.104/install/JediInstaller.dpr
@@ -0,0 +1,36 @@
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-26 13:32:58 +0200 (mer., 26 sept. 2007) $ }
+{ Revision: $Rev:: 2188 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+program JediInstaller;
+
+{$I jcl.inc}
+
+uses
+ Forms,
+ JclInstall in 'JclInstall.pas',
+ JediInstall in 'JediInstall.pas',
+ JediInstallConfigIni in 'JediInstallConfigIni.pas',
+ JclBorlandTools in '..\source\common\JclBorlandTools.pas',
+ JclResources in '..\source\common\JclResources.pas',
+ JediRegInfo in 'JediRegInfo.pas',
+ JclDotNet in '..\source\windows\JclDotNet.pas',
+ FrmCompile in 'VclGui\FrmCompile.pas' {FormCompile},
+ JediGUIReadme in 'VclGui\JediGUIReadme.pas' {ReadmeFrame: TFrame},
+ JediGUIInstall in 'VclGui\JediGUIInstall.pas' {InstallFrame: TFrame},
+ JediGUIMain in 'VclGui\JediGUIMain.pas' {MainForm},
+ JediGUIProfiles in 'VclGui\JediGUIProfiles.pas' {ProfilesFrame: TFrame},
+ JediProfiles in 'JediProfiles.pas';
+
+{$R *.res}
+{$R ..\source\windows\JclCommCtrlAsInvoker.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'JEDI Installer';
+ InstallCore.Execute;
+end.
diff --git a/official/1.104/install/JediInstaller.res b/official/1.104/install/JediInstaller.res
new file mode 100644
index 0000000..c809bc9
Binary files /dev/null and b/official/1.104/install/JediInstaller.res differ
diff --git a/official/1.104/install/JediProfiles.pas b/official/1.104/install/JediProfiles.pas
new file mode 100644
index 0000000..79d524a
--- /dev/null
+++ b/official/1.104/install/JediProfiles.pas
@@ -0,0 +1,296 @@
+{**************************************************************************************************}
+{ }
+{ 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 JediProfiles.pas. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet. Portions created by Florent Ouchet }
+{ are Copyright (C) of Florent Ouchet. All Rights Reserved. }
+{ }
+{ Contributors: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Core unit to manipulate multiple users' profiles at install time }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2008-09-09 21:32:17 +0200 (mar., 09 sept. 2008) $ }
+{ Revision: $Rev:: 2461 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+unit JediProfiles;
+
+{$I jcl.inc}
+
+interface
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ENDIF MSWINDOWS}
+ SysUtils,
+ Classes,
+ JediInstall;
+
+type
+ {$IFDEF MSWINDOWS}
+ TJediProfile = record
+ UserName: string;
+ SID: string;
+ LocalProfile: string;
+ UserKey: HKEY;
+ CloseKey: Boolean;
+ UnloadKey: Boolean;
+ end;
+ {$ENDIF MSWINDOWS}
+
+ TJediProfilesManager = class(TInterfacedObject, IJediProfilesManager)
+ private
+ FMultipleProfileMode: Boolean;
+ {$IFDEF MSWINDOWS}
+ FProfiles: array of TJediProfile;
+ procedure LoadProfiles;
+ {$ENDIF MSWINDOWS}
+ public
+ destructor Destroy; override;
+ { IJediProfileManager }
+ function CheckPrerequisites: Boolean;
+ function GetMultipleProfileMode: Boolean;
+ function GetProfileKey(Index: Integer): LongWord; // HKEY is Windows specific
+ function GetProfileCount: Integer;
+ function GetProfileName(Index: Integer): string;
+ procedure SetMultipleProfileMode(Value: Boolean);
+ property MultipleProfileMode: Boolean read GetMultipleProfileMode write SetMultipleProfileMode;
+ end;
+
+implementation
+
+{$IFDEF MSWINDOWS}
+uses
+ JclAnsiStrings,
+ JclFileUtils,
+ JclRegistry,
+ JclSecurity,
+ JclShell,
+ JclSysInfo,
+ JclWin32;
+
+const
+ RegProfileListKey = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList';
+{$ENDIF MSWINDOWS}
+
+//=== { TJediProfileManager } ================================================
+
+destructor TJediProfilesManager.Destroy;
+{$IFDEF MSWINDOWS}
+var
+ Index: Integer;
+{$ENDIF MSWINDOWS}
+begin
+ {$IFDEF MSWINDOWS}
+ for Index := Low(FProfiles) to High(FProfiles) do
+ begin
+ if FProfiles[Index].CloseKey then
+ begin
+ Windows.RegFlushKey(FProfiles[Index].UserKey);
+ Windows.RegCloseKey(FProfiles[Index].UserKey);
+ end;
+
+ if FProfiles[Index].UnloadKey then
+ Windows.RegUnLoadKey(HKUS, PChar(FProfiles[Index].SID));
+ end;
+ SetLength(FProfiles, 0);
+ {$ENDIF MSWINDOWS}
+ inherited Destroy;
+end;
+
+function TJediProfilesManager.CheckPrerequisites: Boolean;
+{$IFDEF MSWINDOWS}
+var
+ InstallGUI: IJediInstallGUI;
+ Fork: Boolean;
+ Parameters: string;
+ Index: Integer;
+{$ENDIF MSWINDOWS}
+begin
+ {$IFDEF MSWINDOWS}
+ FMultipleProfileMode := FMultipleProfileMode and IsWinNT;
+ Result := not FMultipleProfileMode;
+ if not Result then
+ begin
+ Result := IsElevated;
+ if not Result then
+ begin
+ // attempt to fork as an administrator
+ InstallGUI := InstallCore.InstallGUI;
+ if Assigned(InstallGUI) then
+ Fork := InstallGUI.Dialog('Installation requires administrator privilege, do you want to run installer with' +
+ ' administrator rights?', dtConfirmation, [drYes, drNo]) = drYes
+ else
+ Fork := True;
+ if Fork then
+ begin
+ Parameters := '';
+ for Index := 1 to ParamCount do
+ Parameters := Parameters + AnsiQuotedStr(ParamStr(Index), AnsiDoubleQuote);
+ ShellExecEx(ParamStr(0), Parameters, 'runas');
+ Result := False;
+ end
+ else
+ begin
+ // single profile installation for current user
+ FMultipleProfileMode := False;
+ Result := True;
+ end;
+ end;
+ end;
+ if FMultipleProfileMode and Result then
+ LoadProfiles;
+ {$ENDIF MSWINDOWS}
+ {$IFDEF UNIX}
+ // don't know how to enumerate profiles on Linux
+ Result := not FMultipleProfileMode;
+ FMultipleProfileMode := False;
+ {$ENDIF UNIX}
+end;
+
+function TJediProfilesManager.GetMultipleProfileMode: Boolean;
+begin
+ Result := FMultipleProfileMode;
+end;
+
+function TJediProfilesManager.GetProfileCount: Integer;
+begin
+ {$IFDEF MSWINDOWS}
+ if FMultipleProfileMode then
+ Result := Length(FProfiles)
+ else
+ {$ENDIF MSWINDOWS}
+ Result := 0;
+end;
+
+function TJediProfilesManager.GetProfileKey(Index: Integer): LongWord;
+{$IFDEF MSWINDOWS}
+var
+ NtUserFileName: string;
+ Key: HKEY;
+{$ENDIF MSWINDOWS}
+begin
+ {$IFDEF MSWINDOWS}
+ if FMultipleProfileMode then
+ begin
+ if FProfiles[Index].UserKey = 0 then
+ begin
+ if AnsiSameText(FProfiles[Index].UserName, GetLocalUserName) then
+ FProfiles[Index].UserKey := HKCU
+ else
+ begin
+ NtUserFileName := PathAddSeparator(FProfiles[Index].LocalProfile) + 'NTUSER.DAT';
+ if not RegKeyExists(HKUS, '\' + FProfiles[Index].SID) then
+ begin
+ EnableProcessPrivilege(True, SE_RESTORE_NAME);
+ EnableProcessPrivilege(True, SE_BACKUP_NAME);
+ if RegLoadKey(HKUS, PChar(FProfiles[Index].SID), PChar(NtUserFileName)) = ERROR_SUCCESS then
+ FProfiles[Index].UnloadKey := True
+ else
+ {$IFDEF COMPILER5}
+ RaiseLastWin32Error;
+ {$ELSE ~COMPILER5}
+ RaiseLastOSError;
+ {$ENDIF ~COMPILER5}
+ end;
+ if RegOpenKey(HKUS, PChar(FProfiles[Index].SID), Key) = ERROR_SUCCESS then
+ FProfiles[Index].CloseKey := True
+ else
+ raise EJclSecurityError.CreateFmt('Unable to load profile for user "%s"', [FProfiles[Index].UserName]);
+ FProfiles[Index].UserKey := Key;
+ end;
+ end;
+ Result := FProfiles[Index].UserKey;
+ end
+ else
+ Result := HKCU;
+ {$ENDIF MSWINDOWS}
+ {$IFDEF LINUX}
+ Result := 0;
+ {$ENDIF LINUX}
+end;
+
+function TJediProfilesManager.GetProfileName(Index: Integer): string;
+begin
+ {$IFDEF MSWINDOWS}
+ if FMultipleProfileMode then
+ Result := FProfiles[Index].UserName
+ else
+ {$ENDIF MSWINDOWS}
+ Result := '';
+end;
+
+{$IFDEF MSWINDOWS}
+procedure TJediProfilesManager.LoadProfiles;
+var
+ Index: Integer;
+ SID: PSID;
+ DataSize: Cardinal;
+ Name, Domain: WideString;
+ KeyName, SIDStr, ProfileDir: string;
+ RegProfiles: TStrings;
+begin
+ if FMultipleProfileMode then
+ begin
+ RegProfiles := TStringList.Create;
+ try
+ GetMem(SID, SECURITY_MAX_SID_SIZE);
+ try
+ if RegGetKeyNames(HKLM, RegProfileListKey, RegProfiles) then
+ for Index := 0 to RegProfiles.Count - 1 do
+ begin
+ KeyName := RegProfileListKey + '\' + RegProfiles.Strings[Index];
+ if RegReadBinaryEx(HKLM, KeyName, 'Sid', SID^, SECURITY_MAX_SID_SIZE, DataSize, False)
+ and RegReadStringEx(HKLM, KeyName, 'ProfileImagePath', ProfileDir, False) then
+ begin
+ try
+ SIDStr := SIDToString(SID);
+ LookupAccountBySid(SID, Name, Domain);
+ if SameText(Domain, GetLocalComputerName) then
+ begin
+ SetLength(FProfiles, Length(FProfiles) + 1);
+ FProfiles[High(FProfiles)].UserName := Name;
+ FProfiles[High(FProfiles)].SID := SIDStr;
+ FProfiles[High(FProfiles)].LocalProfile := ProfileDir;
+ FProfiles[High(FProfiles)].UserKey := 0;
+ FProfiles[High(FProfiles)].CloseKey := False;
+ FProfiles[High(FProfiles)].UnloadKey := False;
+ end;
+ except
+ // trap deleted accounts
+ end;
+ end;
+ end;
+ finally
+ FreeMem(SID);
+ end;
+ finally
+ RegProfiles.Free;
+ end;
+ end;
+end;
+{$ENDIF MSWINDOWS}
+
+procedure TJediProfilesManager.SetMultipleProfileMode(Value: Boolean);
+begin
+ FMultipleProfileMode := Value;
+end;
+
+end.
diff --git a/official/1.104/install/JediRegInfo.pas b/official/1.104/install/JediRegInfo.pas
new file mode 100644
index 0000000..631073f
--- /dev/null
+++ b/official/1.104/install/JediRegInfo.pas
@@ -0,0 +1,248 @@
+{**************************************************************************************************}
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License") }
+{ you may 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: JediInfo.pas, released on 2006-02-26. }
+{ }
+{ 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) 2006 Andreas Hausladen. }
+{ All Rights Reserved. }
+{ }
+{ Contributor(s): }
+{ }
+{ You may retrieve the latest version of this file at the Project JEDI's JCL / JVCL }
+{ home page, located at http://jcl.sourceforge.net / http://jvcl.sourceforge.net }
+{ }
+{ Known Issues: }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-26 13:32:58 +0200 (mer., 26 sept. 2007) $ }
+{ Revision: $Rev:: 2188 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
+
+unit JediRegInfo;
+
+{$I jedi.inc}
+
+interface
+
+uses
+ Windows, SysUtils, Classes;
+
+type
+ TJediInformation = record
+ Version: string; // example: '1.98'
+ DcpDir: string; // example: 'C:\Program Files\Borland\Delphi7\Projects\BPL', the JVCL Installer resolves macros
+ BplDir: string; // example: 'C:\Program Files\Borland\Delphi7\Projects\BPL', the JVCL Installer resolves macros
+ RootDir: string; // example: 'C:\Program Files\Borland\Delphi7', the JVCL Installer resolves macros
+ end;
+
+{ InstallJediInformation() writes the "Version", "DcpDir", "BplDir" and "RootDir"
+ values into the registry key IdeRegKey\Jedi\ProjectName. Returns True if the
+ values could be written. }
+function InstallJediRegInformation(const IdeRegKey, ProjectName, Version, DcpDir,
+ BplDir, RootDir: string; RootKey: HKEY = HKEY_CURRENT_USER): Boolean;
+
+{ RemoveJediInformation() deletes the registry key IdeRegKey\Jedi\ProjectName.
+ If there is no further subkeys to IdeRegKey\Jedi and no values in this key,
+ the whole Jedi-key is deleted. }
+procedure RemoveJediRegInformation(const IdeRegKey, ProjectName: string;
+ RootKey: HKEY = HKEY_CURRENT_USER);
+
+{ ReadJediInformation() reads the JEDI Information from the registry. Returns
+ False if Version='' or DcpDir='' or BplDir='' or RootDir=''. }
+function ReadJediRegInformation(const IdeRegKey, ProjectName: string; out Version,
+ DcpDir, BplDir, RootDir: string; RootKey: HKEY = HKEY_CURRENT_USER): Boolean; overload;
+
+{ ReadJediInformation() reads the JEDI Information from the registry. }
+function ReadJediRegInformation(const IdeRegKey, ProjectName: string
+ ; RootKey: HKEY = HKEY_CURRENT_USER): TJediInformation; overload;
+
+{ ParseVersionNumber() converts a version number 'major.minor.release.build' to
+ cardinal like the JclBase JclVersion constant. If the VersionStr is invalid
+ the function returns 0. }
+function ParseVersionNumber(const VersionStr: string): Cardinal;
+
+implementation
+
+uses
+ Registry;
+
+{$IFNDEF RTL140_UP}
+function ExcludeTrailingPathDelimiter(const Path: string): string;
+begin
+ if (Path <> '') and (Path[Length(Path)] = '\') then
+ Result := Copy(Path, 1, Length(Path) - 1)
+ else
+ Result := Path;
+end;
+{$ENDIF ~RTL140_UP}
+
+function InstallJediRegInformation(const IdeRegKey, ProjectName, Version, DcpDir,
+ BplDir, RootDir: string; RootKey: HKEY): Boolean;
+var
+ Reg: TRegistry;
+begin
+ Result := False;
+ if (Version <> '') and (DcpDir <> '') and (BplDir <> '') and (RootDir <> '') then
+ begin
+ Reg := TRegistry.Create;
+ try
+ Reg.RootKey := RootKey;
+ if Reg.OpenKey(IdeRegKey + '\Jedi', True) then // do not localize
+ Reg.CloseKey;
+ if Reg.OpenKey(IdeRegKey + '\Jedi\' + ProjectName, True) then // do not localize
+ begin
+ Reg.WriteString('Version', Version); // do not localize
+ Reg.WriteString('DcpDir', ExcludeTrailingPathDelimiter(DcpDir)); // do not localize
+ Reg.WriteString('BplDir', ExcludeTrailingPathDelimiter(BplDir)); // do not localize
+ Reg.WriteString('RootDir', ExcludeTrailingPathDelimiter(RootDir)); // do not localize
+ Result := True;
+ end;
+ finally
+ Reg.Free;
+ end;
+ end;
+end;
+
+procedure RemoveJediRegInformation(const IdeRegKey, ProjectName: string; RootKey: HKEY);
+var
+ Reg: TRegistry;
+ Names: TStringList;
+ JediKeyName, ProjectKeyName: string;
+begin
+ Reg := TRegistry.Create;
+ try
+ Reg.RootKey := RootKey;
+// (outchy) do not delete target settings
+// Reg.DeleteKey(IdeRegKey + '\Jedi\' + ProjectName); // do not localize
+
+ JediKeyName := IdeRegKey + '\Jedi'; // do not localize
+ ProjectKeyName := JediKeyName + '\' + ProjectName; // do not localize
+
+ if Reg.OpenKey(ProjectKeyName, False) then
+ begin
+ Reg.DeleteValue('Version'); // do not localize
+ Reg.DeleteValue('DcpDir'); // do not localize
+ Reg.DeleteValue('BplDir'); // do not localize
+ Reg.DeleteValue('RootDir'); // do not localize
+
+ Names := TStringList.Create;
+ try
+ Reg.GetKeyNames(Names);
+ if Names.Count = 0 then
+ begin
+ Reg.GetValueNames(Names);
+ if Names.Count = 0 then
+ begin
+ Reg.CloseKey;
+ Reg.DeleteKey(ProjectKeyName); // do not localize
+ end;
+ end;
+ finally
+ Names.Free;
+ end;
+ end;
+
+
+ if Reg.OpenKey(JediKeyName, False) then // do not localize
+ begin
+ Names := TStringList.Create;
+ try
+ Reg.GetKeyNames(Names);
+ if Names.Count = 0 then
+ begin
+ Reg.GetValueNames(Names);
+ if Names.Count = 0 then
+ begin
+ Reg.CloseKey;
+ Reg.DeleteKey(JediKeyName); // do not localize
+ end;
+ end;
+ finally
+ Names.Free;
+ end;
+ end;
+ finally
+ Reg.Free;
+ end;
+end;
+
+function ReadJediRegInformation(const IdeRegKey, ProjectName: string; out Version,
+ DcpDir, BplDir, RootDir: string; RootKey: HKEY): Boolean; overload;
+var
+ Reg: TRegistry;
+begin
+ Version := '';
+ DcpDir := '';
+ BplDir := '';
+ RootDir := '';
+ Reg := TRegistry.Create;
+ try
+ Reg.RootKey := RootKey;
+ if Reg.OpenKeyReadOnly(IdeRegKey + '\Jedi\' + ProjectName) then // do not localize
+ begin
+ if Reg.ValueExists('Version') then // do not localize
+ Version := Reg.ReadString('Version'); // do not localize
+ if Reg.ValueExists('DcpDir') then // do not localize
+ DcpDir := ExcludeTrailingPathDelimiter(Reg.ReadString('DcpDir')); // do not localize
+ if Reg.ValueExists('BplDir') then // do not localize
+ BplDir := ExcludeTrailingPathDelimiter(Reg.ReadString('BplDir')); // do not localize
+ if Reg.ValueExists('RootDir') then // do not localize
+ RootDir := ExcludeTrailingPathDelimiter(Reg.ReadString('RootDir')); // do not localize
+ end;
+ finally
+ Reg.Free;
+ end;
+ Result := (Version <> '') and (DcpDir <> '') and (BplDir <> '') and (RootDir <> '');
+end;
+
+function ReadJediRegInformation(const IdeRegKey, ProjectName: string; RootKey: HKEY): TJediInformation;
+begin
+ ReadJediRegInformation(IdeRegKey, ProjectName, Result.Version, Result.DcpDir,
+ Result.BplDir, Result.RootDir, RootKey);
+end;
+
+function ParseVersionNumber(const VersionStr: string): Cardinal;
+const
+ Shifts: array[0..3] of Integer = (24, 16, 15, 0);
+var
+ S: string;
+ ps: Integer;
+ Count: Integer;
+begin
+ S := VersionStr;
+ Result := 0;
+ if S <> '' then
+ begin
+ Result := 0;
+ try
+ Count := 0;
+ ps := Pos('.', S);
+ while (ps > 0) and (Count < High(Shifts)) do
+ begin
+ Result := Result or (Cardinal(StrToInt(Copy(S, 1, ps - 1))) shl Shifts[Count]);
+ S := Copy(S, ps + 1, MaxInt);
+ ps := Pos('.', S);
+ Inc(Count);
+ end;
+ Result := Result or (Cardinal(StrToInt(Copy(S, 1, MaxInt))) shl Shifts[Count]);
+ except
+ Result := 0;
+ end;
+ end;
+end;
+
+end.
diff --git a/official/1.104/install/QJediInstaller.conf b/official/1.104/install/QJediInstaller.conf
new file mode 100644
index 0000000..a9def6d
--- /dev/null
+++ b/official/1.104/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.104/install/QJediInstaller.dof b/official/1.104/install/QJediInstaller.dof
new file mode 100644
index 0000000..3604433
--- /dev/null
+++ b/official/1.104/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.104/install/QJediInstaller.dpr b/official/1.104/install/QJediInstaller.dpr
new file mode 100644
index 0000000..3b009a3
--- /dev/null
+++ b/official/1.104/install/QJediInstaller.dpr
@@ -0,0 +1,28 @@
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+program QJediInstaller;
+
+uses
+ QForms,
+ JediInstall in 'JediInstall.pas',
+ JclInstall in 'JclInstall.pas',
+ JediInstallConfigIni in 'JediInstallConfigIni.pas',
+ JclResources in '../source/common/JclResources.pas',
+ JclBorlandTools in '../source/common/JclBorlandTools.pas',
+ QJediGUIReadme in 'ClxGui/QJediGUIReadme.pas' {ReadmeFrame: TFrame},
+ QJediGUIInstall in 'ClxGui/QJediGUIInstall.pas' {InstallFrame: TFrame},
+ QJediGUIMain in 'ClxGui/QJediGUIMain.pas' {MainForm};
+
+{$R *.res}
+
+begin
+ Application.Initialize;
+ Application.Title := 'JEDI Installer';
+ InstallCore.Execute;
+end.
diff --git a/official/1.104/install/QJediInstaller.kof b/official/1.104/install/QJediInstaller.kof
new file mode 100644
index 0000000..a6d0fde
--- /dev/null
+++ b/official/1.104/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=../source;../source/common;$(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.104/install/QJediInstaller.res b/official/1.104/install/QJediInstaller.res
new file mode 100644
index 0000000..1b63c2c
Binary files /dev/null and b/official/1.104/install/QJediInstaller.res differ
diff --git a/official/1.104/install/RegHelper.dof b/official/1.104/install/RegHelper.dof
new file mode 100644
index 0000000..b4f1b7f
--- /dev/null
+++ b/official/1.104/install/RegHelper.dof
@@ -0,0 +1,4 @@
+[Directories]
+OutputDir=..\bin
+UnitOutputDir=.
+SearchPath=..\source;..\source\common;..\source\windows
diff --git a/official/1.104/install/RegHelper.dpr b/official/1.104/install/RegHelper.dpr
new file mode 100644
index 0000000..2c657c1
--- /dev/null
+++ b/official/1.104/install/RegHelper.dpr
@@ -0,0 +1,337 @@
+{**************************************************************************************************}
+{ }
+{ 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 RegHelper.dpr. }
+{ }
+{ The Initial Developer of the Original Code is Florent Ouchet. }
+{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. All Rights Reserved. }
+{ }
+{ Contributor(s): }
+{ }
+{ Last modified: $Date: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ }
+{**************************************************************************************************}
+{ }
+{ Last modified: $Date:: 2007-09-17 23:41:02 +0200 (lun., 17 sept. 2007) $ }
+{ Revision: $Rev:: 2175 $ }
+{ Author: $Author:: outchy $ }
+{ }
+{**************************************************************************************************}
+
+program RegHelper;
+
+{$APPTYPE CONSOLE}
+
+uses
+ SysUtils, Windows, ActiveX,
+ JclAnsiStrings, JclBorlandTools, JclSysUtils;
+
+{$R ..\source\windows\JclNoDepAdmin.res}
+{$R RegHelper.res}
+
+type
+ TCommandFunc = function (const Parameters: array of string): Boolean;
+ TCommandRec = record
+ Name: string;
+ ParamCount: Integer;
+ Func: TCommandFunc;
+ Description: string;
+ end;
+
+var
+ Help2Manager: TJclHelp2Manager;
+ ShowCopyright: Boolean = True;
+ ResultFileName: string = '';
+ RegHelperOutput: TEXT;
+ DiscardFollowingCommand: Boolean = False;
+
+function CommandCreate(const Parameters: array of string): Boolean;
+begin
+ Result := Help2Manager.CreateTransaction;
+end;
+
+function CommandCommit(const Parameters: array of string): Boolean;
+begin
+ Result := Help2Manager.CommitTransaction;
+end;
+
+function CommandRegNameSpace(const Parameters: array of string): Boolean;
+var
+ NameSpace, Collection, Description: WideString;
+begin
+ NameSpace := Parameters[0];
+ Collection := Parameters[1];
+ Description := Parameters[2];
+ Result := Help2Manager.RegisterNameSpace(NameSpace, Collection, Description);
+end;
+
+function CommandUnRegNameSpace(const Parameters: array of string): Boolean;
+var
+ NameSpace: WideString;
+begin
+ NameSpace := Parameters[0];
+ Result := Help2Manager.UnregisterNameSpace(NameSpace);
+end;
+
+function CommandRegHelpFile(const Parameters: array of string): Boolean;
+var
+ NameSpace, Identifier, HxSFile, HxIFile: WideString;
+ LangId, Code: Integer;
+begin
+ Val(Parameters[2], LangId, Code);
+ Result := Code = 0;
+ if Result then
+ begin
+ NameSpace := Parameters[0];
+ Identifier := Parameters[1];
+ HxSFile := Parameters[3];
+ HxIFile := Parameters[4];
+ Result := Help2Manager.RegisterHelpFile(NameSpace, Identifier, LangId, HxSFile, HxIFile);
+ end;
+end;
+
+function CommandUnregHelpFile(const Parameters: array of string): Boolean;
+var
+ NameSpace, Identifier: WideString;
+ LangId, Code: Integer;
+begin
+ Val(Parameters[2], LangId, Code);
+ Result := Code = 0;
+ if Result then
+ begin
+ NameSpace := Parameters[0];
+ Identifier := Parameters[1];
+ Result := Help2Manager.UnregisterHelpFile(NameSpace, Identifier, LangId);
+ end;
+end;
+
+function CommandPlugNameSpace(const Parameters: array of string): Boolean;
+var
+ Source, Target: WideString;
+begin
+ Source := Parameters[0];
+ Target := Parameters[1];
+ Result := Help2Manager.PlugNameSpaceIn(Source, Target);
+end;
+
+function CommandUnplugNameSpace(const Parameters: array of string): Boolean;
+var
+ Source, Target: WideString;
+begin
+ Source := Parameters[0];
+ Target := Parameters[1];
+ Result := Help2Manager.UnPlugNameSpace(Source, Target);
+end;
+
+const
+ CommandRecs: array [0..7] of TCommandRec =
+ ( (Name: 'Create'; ParamCount: 0; Func: CommandCreate;
+ Description: ' %s' + AnsiLineBreak +
+ ' Create a new transaction'),
+ (Name: 'Commit'; ParamCount: 0; Func: CommandCommit;
+ Description: ' %s' + AnsiLineBreak +
+ ' Commit previous comands; commands are not applied until committed'),
+
+ (Name: 'RegNameSpace'; ParamCount: 3; Func: CommandRegNameSpace;
+ Description: ' %s;;;' + AnsiLineBreak +
+ ' Register a new namespace named with description set to' + AnsiLineBreak +
+ ' 