From: <tw...@us...> - 2013-07-25 08:06:15
|
Revision: 294 http://sourceforge.net/p/tdbf/code/294 Author: twm Date: 2013-07-25 08:06:07 +0000 (Thu, 25 Jul 2013) Log Message: ----------- * Moved general sources to src, package files to packages and documentation to doc subdirectories. * Warning: Package files are now broken, will fix them shortly Added Paths: ----------- trunk/doc/ trunk/doc/COPYING.LIB trunk/doc/INSTALL trunk/doc/history.txt trunk/doc/install_tdbf_c4.txt trunk/doc/readme.txt trunk/doc/todo.txt trunk/packages/ trunk/packages/package.txt trunk/packages/tdbf.bmp trunk/packages/tdbf.lrs trunk/packages/tdbf.xpm trunk/packages/tdbf_c2006d.bdsproj trunk/packages/tdbf_c2006d.cpp trunk/packages/tdbf_c2006d.res trunk/packages/tdbf_c2006r.bdsproj trunk/packages/tdbf_c2006r.cpp trunk/packages/tdbf_c2006r.res trunk/packages/tdbf_c3.bpk trunk/packages/tdbf_c3.cpp trunk/packages/tdbf_c4.bpk trunk/packages/tdbf_c4.cpp trunk/packages/tdbf_c5d.bpk trunk/packages/tdbf_c5d.cpp trunk/packages/tdbf_c5r.bpk trunk/packages/tdbf_c5r.cpp trunk/packages/tdbf_c6d.bpk trunk/packages/tdbf_c6d.cpp trunk/packages/tdbf_c6r.bpk trunk/packages/tdbf_c6r.cpp trunk/packages/tdbf_d2005d.dpk trunk/packages/tdbf_d2005d.res trunk/packages/tdbf_d2005r.dpk trunk/packages/tdbf_d2005r.res trunk/packages/tdbf_d2006d.dpk trunk/packages/tdbf_d2006r.dpk trunk/packages/tdbf_d3.dpk trunk/packages/tdbf_d4.dpk trunk/packages/tdbf_d4.res trunk/packages/tdbf_d5d.dpk trunk/packages/tdbf_d5d.res trunk/packages/tdbf_d5r.dpk trunk/packages/tdbf_d5r.res trunk/packages/tdbf_d6d.dof trunk/packages/tdbf_d6d.dpk trunk/packages/tdbf_d6d.res trunk/packages/tdbf_d6r.dof trunk/packages/tdbf_d6r.dpk trunk/packages/tdbf_d6r.res trunk/packages/tdbf_d7d.dof trunk/packages/tdbf_d7d.dpk trunk/packages/tdbf_d7d.res trunk/packages/tdbf_d7r.dof trunk/packages/tdbf_d7r.dpk trunk/packages/tdbf_d7r.res trunk/packages/tdbf_k.conf trunk/packages/tdbf_k.dpk trunk/packages/tdbf_k2d.dpk trunk/packages/tdbf_k2d.res trunk/packages/tdbf_k2r.dpk trunk/packages/tdbf_k2r.res trunk/packages/tdbf_k3d.dpk trunk/packages/tdbf_k3r.dpk trunk/packages/tdbf_l.lpk trunk/packages/tdbf_l.pas trunk/packages/tdbf_ld.lpk trunk/packages/tdbf_ld.pas trunk/src/ trunk/src/dbf.dcr trunk/src/dbf.pas trunk/src/dbf_avl.pas trunk/src/dbf_collate.pas trunk/src/dbf_common.inc trunk/src/dbf_common.pas trunk/src/dbf_cursor.pas trunk/src/dbf_dbffile.pas trunk/src/dbf_fields.pas trunk/src/dbf_idxcur.pas trunk/src/dbf_idxfile.pas trunk/src/dbf_lang.pas trunk/src/dbf_memo.pas trunk/src/dbf_parser.pas trunk/src/dbf_pgcfile.pas trunk/src/dbf_pgfile.pas trunk/src/dbf_prscore.pas trunk/src/dbf_prsdef.pas trunk/src/dbf_prssupp.pas trunk/src/dbf_reg.pas trunk/src/dbf_str.inc trunk/src/dbf_str.pas trunk/src/dbf_str_de.pas trunk/src/dbf_str_es.pas trunk/src/dbf_str_fr.pas trunk/src/dbf_str_ita.pas trunk/src/dbf_str_nl.pas trunk/src/dbf_str_pl.pas trunk/src/dbf_str_pt.pas trunk/src/dbf_str_ru.pas trunk/src/dbf_struct.inc trunk/src/dbf_wtil.pas trunk/src/getstrfromint.inc Removed Paths: ------------- trunk/COPYING.LIB trunk/INSTALL trunk/dbf.dcr trunk/dbf.pas trunk/dbf_avl.pas trunk/dbf_collate.pas trunk/dbf_common.inc trunk/dbf_common.pas trunk/dbf_cursor.pas trunk/dbf_dbffile.pas trunk/dbf_fields.pas trunk/dbf_idxcur.pas trunk/dbf_idxfile.pas trunk/dbf_lang.pas trunk/dbf_memo.pas trunk/dbf_parser.pas trunk/dbf_pgcfile.pas trunk/dbf_pgfile.pas trunk/dbf_prscore.pas trunk/dbf_prsdef.pas trunk/dbf_prssupp.pas trunk/dbf_reg.pas trunk/dbf_str.inc trunk/dbf_str.pas trunk/dbf_str_de.pas trunk/dbf_str_es.pas trunk/dbf_str_fr.pas trunk/dbf_str_ita.pas trunk/dbf_str_nl.pas trunk/dbf_str_pl.pas trunk/dbf_str_pt.pas trunk/dbf_str_ru.pas trunk/dbf_struct.inc trunk/dbf_wtil.pas trunk/getstrfromint.inc trunk/history.txt trunk/install_tdbf_c4.txt trunk/package.txt trunk/readme.txt trunk/tdbf.bmp trunk/tdbf.lrs trunk/tdbf.xpm trunk/tdbf_c2006d.bdsproj trunk/tdbf_c2006d.cpp trunk/tdbf_c2006d.res trunk/tdbf_c2006r.bdsproj trunk/tdbf_c2006r.cpp trunk/tdbf_c2006r.res trunk/tdbf_c3.bpk trunk/tdbf_c3.cpp trunk/tdbf_c4.bpk trunk/tdbf_c4.cpp trunk/tdbf_c5d.bpk trunk/tdbf_c5d.cpp trunk/tdbf_c5r.bpk trunk/tdbf_c5r.cpp trunk/tdbf_c6d.bpk trunk/tdbf_c6d.cpp trunk/tdbf_c6r.bpk trunk/tdbf_c6r.cpp trunk/tdbf_d2005d.dpk trunk/tdbf_d2005d.res trunk/tdbf_d2005r.dpk trunk/tdbf_d2005r.res trunk/tdbf_d2006d.dpk trunk/tdbf_d2006r.dpk trunk/tdbf_d3.dpk trunk/tdbf_d4.dpk trunk/tdbf_d4.res trunk/tdbf_d5d.dpk trunk/tdbf_d5d.res trunk/tdbf_d5r.dpk trunk/tdbf_d5r.res trunk/tdbf_d6d.dof trunk/tdbf_d6d.dpk trunk/tdbf_d6d.res trunk/tdbf_d6r.dof trunk/tdbf_d6r.dpk trunk/tdbf_d6r.res trunk/tdbf_d7d.dof trunk/tdbf_d7d.dpk trunk/tdbf_d7d.res trunk/tdbf_d7r.dof trunk/tdbf_d7r.dpk trunk/tdbf_d7r.res trunk/tdbf_k.conf trunk/tdbf_k.dpk trunk/tdbf_k2d.dpk trunk/tdbf_k2d.res trunk/tdbf_k2r.dpk trunk/tdbf_k2r.res trunk/tdbf_k3d.dpk trunk/tdbf_k3r.dpk trunk/tdbf_l.lpk trunk/tdbf_l.pas trunk/tdbf_ld.lpk trunk/tdbf_ld.pas trunk/todo.txt Deleted: trunk/COPYING.LIB =================================================================== --- trunk/COPYING.LIB 2013-07-25 08:04:12 UTC (rev 293) +++ trunk/COPYING.LIB 2013-07-25 08:06:07 UTC (rev 294) @@ -1,510 +0,0 @@ - - GNU LESSER GENERAL PUBLIC LICENSE - Version 2.1, February 1999 - - Copyright (C) 1991, 1999 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -[This is the first released version of the Lesser GPL. It also counts - as the successor of the GNU Library Public License, version 2, hence - the version number 2.1.] - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -Licenses are intended to guarantee your freedom to share and change -free software--to make sure the software is free for all its users. - - This license, the Lesser General Public License, applies to some -specially designated software packages--typically libraries--of the -Free Software Foundation and other authors who decide to use it. You -can use it too, but we suggest you first think carefully about whether -this license or the ordinary General Public License is the better -strategy to use in any particular case, based on the explanations -below. - - When we speak of free software, we are referring to freedom of use, -not price. Our General Public Licenses are designed to make sure that -you have the freedom to distribute copies of free software (and charge -for this service if you wish); that you receive source code or can get -it if you want it; that you can change the software and use pieces of -it in new free programs; and that you are informed that you can do -these things. - - To protect your rights, we need to make restrictions that forbid -distributors to deny you these rights or to ask you to surrender these -rights. These restrictions translate to certain responsibilities for -you if you distribute copies of the library or if you modify it. - - For example, if you distribute copies of the library, whether gratis -or for a fee, you must give the recipients all the rights that we gave -you. You must make sure that they, too, receive or can get the source -code. If you link other code with the library, you must provide -complete object files to the recipients, so that they can relink them -with the library after making changes to the library and recompiling -it. And you must show them these terms so they know their rights. - - We protect your rights with a two-step method: (1) we copyright the -library, and (2) we offer you this license, which gives you legal -permission to copy, distribute and/or modify the library. - - To protect each distributor, we want to make it very clear that -there is no warranty for the free library. Also, if the library is -modified by someone else and passed on, the recipients should know -that what they have is not the original version, so that the original -author's reputation will not be affected by problems that might be -introduced by others. - - Finally, software patents pose a constant threat to the existence of -any free program. We wish to make sure that a company cannot -effectively restrict the users of a free program by obtaining a -restrictive license from a patent holder. Therefore, we insist that -any patent license obtained for a version of the library must be -consistent with the full freedom of use specified in this license. - - Most GNU software, including some libraries, is covered by the -ordinary GNU General Public License. This license, the GNU Lesser -General Public License, applies to certain designated libraries, and -is quite different from the ordinary General Public License. We use -this license for certain libraries in order to permit linking those -libraries into non-free programs. - - When a program is linked with a library, whether statically or using -a shared library, the combination of the two is legally speaking a -combined work, a derivative of the original library. The ordinary -General Public License therefore permits such linking only if the -entire combination fits its criteria of freedom. The Lesser General -Public License permits more lax criteria for linking other code with -the library. - - We call this license the "Lesser" General Public License because it -does Less to protect the user's freedom than the ordinary General -Public License. It also provides other free software developers Less -of an advantage over competing non-free programs. These disadvantages -are the reason we use the ordinary General Public License for many -libraries. However, the Lesser license provides advantages in certain -special circumstances. - - For example, on rare occasions, there may be a special need to -encourage the widest possible use of a certain library, so that it -becomes a de-facto standard. To achieve this, non-free programs must -be allowed to use the library. A more frequent case is that a free -library does the same job as widely used non-free libraries. In this -case, there is little to gain by limiting the free library to free -software only, so we use the Lesser General Public License. - - In other cases, permission to use a particular library in non-free -programs enables a greater number of people to use a large body of -free software. For example, permission to use the GNU C Library in -non-free programs enables many more people to use the whole GNU -operating system, as well as its variant, the GNU/Linux operating -system. - - Although the Lesser General Public License is Less protective of the -users' freedom, it does ensure that the user of a program that is -linked with the Library has the freedom and the wherewithal to run -that program using a modified version of the Library. - - The precise terms and conditions for copying, distribution and -modification follow. Pay close attention to the difference between a -"work based on the library" and a "work that uses the library". The -former contains code derived from the library, whereas the latter must -be combined with the library in order to run. - - GNU LESSER GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License Agreement applies to any software library or other -program which contains a notice placed by the copyright holder or -other authorized party saying it may be distributed under the terms of -this Lesser General Public License (also called "this License"). -Each licensee is addressed as "you". - - A "library" means a collection of software functions and/or data -prepared so as to be conveniently linked with application programs -(which use some of those functions and data) to form executables. - - The "Library", below, refers to any such software library or work -which has been distributed under these terms. A "work based on the -Library" means either the Library or any derivative work under -copyright law: that is to say, a work containing the Library or a -portion of it, either verbatim or with modifications and/or translated -straightforwardly into another language. (Hereinafter, translation is -included without limitation in the term "modification".) - - "Source code" for a work means the preferred form of the work for -making modifications to it. For a library, complete source code means -all the source code for all modules it contains, plus any associated -interface definition files, plus the scripts used to control -compilation and installation of the library. - - Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running a program using the Library is not restricted, and output from -such a program is covered only if its contents constitute a work based -on the Library (independent of the use of the Library in a tool for -writing it). Whether that is true depends on what the Library does -and what the program that uses the Library does. - - 1. You may copy and distribute verbatim copies of the Library's -complete source code as you receive it, in any medium, provided that -you conspicuously and appropriately publish on each copy an -appropriate copyright notice and disclaimer of warranty; keep intact -all the notices that refer to this License and to the absence of any -warranty; and distribute a copy of this License along with the -Library. - - You may charge a fee for the physical act of transferring a copy, -and you may at your option offer warranty protection in exchange for a -fee. - - 2. You may modify your copy or copies of the Library or any portion -of it, thus forming a work based on the Library, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) The modified work must itself be a software library. - - b) You must cause the files modified to carry prominent notices - stating that you changed the files and the date of any change. - - c) You must cause the whole of the work to be licensed at no - charge to all third parties under the terms of this License. - - d) If a facility in the modified Library refers to a function or a - table of data to be supplied by an application program that uses - the facility, other than as an argument passed when the facility - is invoked, then you must make a good faith effort to ensure that, - in the event an application does not supply such function or - table, the facility still operates, and performs whatever part of - its purpose remains meaningful. - - (For example, a function in a library to compute square roots has - a purpose that is entirely well-defined independent of the - application. Therefore, Subsection 2d requires that any - application-supplied function or table used by this function must - be optional: if the application does not supply it, the square - root function must still compute square roots.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Library, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Library, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote -it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Library. - -In addition, mere aggregation of another work not based on the Library -with the Library (or with a work based on the Library) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may opt to apply the terms of the ordinary GNU General Public -License instead of this License to a given copy of the Library. To do -this, you must alter all the notices that refer to this License, so -that they refer to the ordinary GNU General Public License, version 2, -instead of to this License. (If a newer version than version 2 of the -ordinary GNU General Public License has appeared, then you can specify -that version instead if you wish.) Do not make any other change in -these notices. - - Once this change is made in a given copy, it is irreversible for -that copy, so the ordinary GNU General Public License applies to all -subsequent copies and derivative works made from that copy. - - This option is useful when you wish to copy part of the code of -the Library into a program that is not a library. - - 4. You may copy and distribute the Library (or a portion or -derivative of it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you accompany -it with the complete corresponding machine-readable source code, which -must be distributed under the terms of Sections 1 and 2 above on a -medium customarily used for software interchange. - - If distribution of object code is made by offering access to copy -from a designated place, then offering equivalent access to copy the -source code from the same place satisfies the requirement to -distribute the source code, even though third parties are not -compelled to copy the source along with the object code. - - 5. A program that contains no derivative of any portion of the -Library, but is designed to work with the Library by being compiled or -linked with it, is called a "work that uses the Library". Such a -work, in isolation, is not a derivative work of the Library, and -therefore falls outside the scope of this License. - - However, linking a "work that uses the Library" with the Library -creates an executable that is a derivative of the Library (because it -contains portions of the Library), rather than a "work that uses the -library". The executable is therefore covered by this License. -Section 6 states terms for distribution of such executables. - - When a "work that uses the Library" uses material from a header file -that is part of the Library, the object code for the work may be a -derivative work of the Library even though the source code is not. -Whether this is true is especially significant if the work can be -linked without the Library, or if the work is itself a library. The -threshold for this to be true is not precisely defined by law. - - If such an object file uses only numerical parameters, data -structure layouts and accessors, and small macros and small inline -functions (ten lines or less in length), then the use of the object -file is unrestricted, regardless of whether it is legally a derivative -work. (Executables containing this object code plus portions of the -Library will still fall under Section 6.) - - Otherwise, if the work is a derivative of the Library, you may -distribute the object code for the work under the terms of Section 6. -Any executables containing that work also fall under Section 6, -whether or not they are linked directly with the Library itself. - - 6. As an exception to the Sections above, you may also combine or -link a "work that uses the Library" with the Library to produce a -work containing portions of the Library, and distribute that work -under terms of your choice, provided that the terms permit -modification of the work for the customer's own use and reverse -engineering for debugging such modifications. - - You must give prominent notice with each copy of the work that the -Library is used in it and that the Library and its use are covered by -this License. You must supply a copy of this License. If the work -during execution displays copyright notices, you must include the -copyright notice for the Library among them, as well as a reference -directing the user to the copy of this License. Also, you must do one -of these things: - - a) Accompany the work with the complete corresponding - machine-readable source code for the Library including whatever - changes were used in the work (which must be distributed under - Sections 1 and 2 above); and, if the work is an executable linked - with the Library, with the complete machine-readable "work that - uses the Library", as object code and/or source code, so that the - user can modify the Library and then relink to produce a modified - executable containing the modified Library. (It is understood - that the user who changes the contents of definitions files in the - Library will not necessarily be able to recompile the application - to use the modified definitions.) - - b) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (1) uses at run time a - copy of the library already present on the user's computer system, - rather than copying library functions into the executable, and (2) - will operate properly with a modified version of the library, if - the user installs one, as long as the modified version is - interface-compatible with the version that the work was made with. - - c) Accompany the work with a written offer, valid for at least - three years, to give the same user the materials specified in - Subsection 6a, above, for a charge no more than the cost of - performing this distribution. - - d) If distribution of the work is made by offering access to copy - from a designated place, offer equivalent access to copy the above - specified materials from the same place. - - e) Verify that the user has already received a copy of these - materials or that you have already sent this user a copy. - - For an executable, the required form of the "work that uses the -Library" must include any data and utility programs needed for -reproducing the executable from it. However, as a special exception, -the materials to be distributed need not include anything that is -normally distributed (in either source or binary form) with the major -components (compiler, kernel, and so on) of the operating system on -which the executable runs, unless that component itself accompanies -the executable. - - It may happen that this requirement contradicts the license -restrictions of other proprietary libraries that do not normally -accompany the operating system. Such a contradiction means you cannot -use both them and the Library together in an executable that you -distribute. - - 7. You may place library facilities that are a work based on the -Library side-by-side in a single library together with other library -facilities not covered by this License, and distribute such a combined -library, provided that the separate distribution of the work based on -the Library and of the other library facilities is otherwise -permitted, and provided that you do these two things: - - a) Accompany the combined library with a copy of the same work - based on the Library, uncombined with any other library - facilities. This must be distributed under the terms of the - Sections above. - - b) Give prominent notice with the combined library of the fact - that part of it is a work based on the Library, and explaining - where to find the accompanying uncombined form of the same work. - - 8. You may not copy, modify, sublicense, link with, or distribute -the Library except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense, link with, or -distribute the Library is void, and will automatically terminate your -rights under this License. However, parties who have received copies, -or rights, from you under this License will not have their licenses -terminated so long as such parties remain in full compliance. - - 9. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Library or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Library (or any work based on the -Library), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Library or works based on it. - - 10. Each time you redistribute the Library (or any work based on the -Library), the recipient automatically receives a license from the -original licensor to copy, distribute, link with or modify the Library -subject to these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties with -this License. - - 11. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Library at all. For example, if a patent -license would not permit royalty-free redistribution of the Library by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Library. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply, and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 12. If the distribution and/or use of the Library is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Library under this License -may add an explicit geographical distribution limitation excluding those -countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 13. The Free Software Foundation may publish revised and/or new -versions of the Lesser General Public License from time to time. -Such new versions will be similar in spirit to the present version, -but may differ in detail to address new problems or concerns. - -Each version is given a distinguishing version number. If the Library -specifies a version number of this License which applies to it and -"any later version", you have the option of following the terms and -conditions either of that version or of any later version published by -the Free Software Foundation. If the Library does not specify a -license version number, you may choose any version ever published by -the Free Software Foundation. - - 14. If you wish to incorporate parts of the Library into other free -programs whose distribution conditions are incompatible with these, -write to the author to ask for permission. For software which is -copyrighted by the Free Software Foundation, write to the Free -Software Foundation; we sometimes make exceptions for this. Our -decision will be guided by the two goals of preserving the free status -of all derivatives of our free software and of promoting the sharing -and reuse of software generally. - - NO WARRANTY - - 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO -WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. -EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR -OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY -KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE -LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME -THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN -WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY -AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU -FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR -CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE -LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING -RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A -FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Libraries - - If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms -of the ordinary General Public License). - - To apply these terms, attach the following notices to the library. -It is safest to attach them to the start of each source file to most -effectively convey the exclusion of warranty; and each file should -have at least the "copyright" line and a pointer to where the full -notice is found. - - - <one line to give the library's name and a brief idea of what it does.> - Copyright (C) <year> <name of author> - - 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 - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or -your school, if any, to sign a "copyright disclaimer" for the library, -if necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James - Random Hacker. - - <signature of Ty Coon>, 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! - - Deleted: trunk/INSTALL =================================================================== --- trunk/INSTALL 2013-07-25 08:04:12 UTC (rev 293) +++ trunk/INSTALL 2013-07-25 08:06:07 UTC (rev 294) @@ -1,25 +0,0 @@ -To install: - -Delphi / BCB / Kylix --------------------- - -1. Choose File -> Open Project -2. Select the runtime package for your version of delphi / bcb (see packages.txt) -3. Compile -4. Open the design package, and install it - (Note BCB 4 and Delphi 3 and 4 don't have run/designtime seperation) -5. All done. - -Lazarus -------- - -The TDbf component is included in the FPC distribution. This is easiest to use: -1. Project -> Open project -2. Select the dbflaz.lpk in lazarus/components/tdbf/ -3. Install (note that this needs recompilation of lazarus) - -If you have downloaded a seperate version of TDbf, then you need to remove the -TDbf units from the FPC distribution first, because lazarus will detect them, -and while compiling, this will give problems. They're usually located in -fpc/units/fcl/dbf*.{o,ppu}. Then follow the procedure above, but selecting the -package included in the tdbf directory: tdbf_l.lpk. Deleted: trunk/dbf.dcr =================================================================== (Binary files differ) Deleted: trunk/dbf.pas =================================================================== --- trunk/dbf.pas 2013-07-25 08:04:12 UTC (rev 293) +++ trunk/dbf.pas 2013-07-25 08:06:07 UTC (rev 294) @@ -1,3036 +0,0 @@ -unit dbf; - -{ design info in dbf_reg.pas } - -interface - -{$I dbf_common.inc} - -uses - Classes, - Db, - dbf_common, - dbf_dbffile, - dbf_parser, - dbf_prsdef, - dbf_cursor, - dbf_fields, - dbf_pgfile, - dbf_idxfile; -// If you got a compilation error here or asking for dsgnintf.pas, then just add -// this file in your project: -// dsgnintf.pas in 'C: \Program Files\Borland\Delphi5\Source\Toolsapi\dsgnintf.pas' - -type - -//==================================================================== - pBookmarkData = ^TBookmarkData; - TBookmarkData = record - PhysicalRecNo: Integer; - end; - - pDbfRecord = ^TDbfRecordHeader; - TDbfRecordHeader = record - BookmarkData: TBookmarkData; - BookmarkFlag: TBookmarkFlag; - SequentialRecNo: Integer; - DeletedFlag: Char; - end; -//==================================================================== - TDbf = class; -//==================================================================== - TDbfStorage = (stoMemory,stoFile); - TDbfOpenMode = (omNormal,omAutoCreate,omTemporary); - TDbfLanguageAction = (laReadOnly, laForceOEM, laForceANSI, laDefault); - TDbfTranslationMode = (tmNoneAvailable, tmNoneNeeded, tmSimple, tmAdvanced); - TDbfFileName = (dfDbf, dfMemo, dfIndex); -//==================================================================== - TDbfFileNames = set of TDbfFileName; -//==================================================================== - TCompareRecordEvent = procedure(Dbf: TDbf; var Accept: Boolean) of object; - TTranslateEvent = function(Dbf: TDbf; Src, Dest: PChar; ToOem: Boolean): Integer of object; - TLanguageWarningEvent = procedure(Dbf: TDbf; var Action: TDbfLanguageAction) of object; - TConvertFieldEvent = procedure(Dbf: TDbf; DstField, SrcField: TField) of object; - TBeforeAutoCreateEvent = procedure(Dbf: TDbf; var DoCreate: Boolean) of object; -//==================================================================== - // TDbfBlobStream keeps a reference count to number of references to - // this instance. Only if FRefCount reaches zero, then the object will be - // destructed. AddReference `clones' a reference. - // This allows the VCL to use Free on the object to `free' that - // particular reference. - - TDbfBlobStream = class(TMemoryStream) - private - FBlobField: TBlobField; - FMode: TBlobStreamMode; - FDirty: boolean; { has possibly modified data, needs to be written } - FMemoRecNo: Integer; - { -1 : invalid contents } - { 0 : clear, no contents } - { >0 : data from page x } - FReadSize: Integer; - FRefCount: Integer; - - function GetTransliterate: Boolean; - procedure Translate(ToOem: Boolean); - procedure SetMode(NewMode: TBlobStreamMode); - public - constructor Create(FieldVal: TField); - destructor Destroy; override; - - function AddReference: TDbfBlobStream; - procedure FreeInstance; override; - - procedure Cancel; - procedure Commit; - - property Dirty: boolean read FDirty; - property Transliterate: Boolean read GetTransliterate; - property MemoRecNo: Integer read FMemoRecNo write FMemoRecNo; - property ReadSize: Integer read FReadSize write FReadSize; - property Mode: TBlobStreamMode write SetMode; - property BlobField: TBlobField read FBlobField; - end; -//==================================================================== - TDbfIndexDefs = class(TCollection) - public - FOwner: TDbf; - private - function GetItem(N: Integer): TDbfIndexDef; - procedure SetItem(N: Integer; Value: TDbfIndexDef); - protected - function GetOwner: TPersistent; override; - public - constructor Create(AOwner: TDbf); - - function Add: TDbfIndexDef; - function GetIndexByName(const Name: string): TDbfIndexDef; - function GetIndexByField(const Name: string): TDbfIndexDef; - procedure Update; {$ifdef SUPPORT_REINTRODUCE} reintroduce; {$endif} - - property Items[N: Integer]: TDbfIndexDef read GetItem write SetItem; default; - end; -//==================================================================== - TDbfMasterLink = class(TDataLink) - private - FDetailDataSet: TDbf; - FParser: TDbfParser; - FFieldNames: string; - FValidExpression: Boolean; - FOnMasterChange: TNotifyEvent; - FOnMasterDisable: TNotifyEvent; - - function GetFieldsVal: PChar; - - procedure SetFieldNames(const Value: string); - protected - procedure ActiveChanged; override; - procedure CheckBrowseMode; override; - procedure LayoutChanged; override; - procedure RecordChanged(Field: TField); override; - - public - constructor Create(ADataSet: TDbf); - destructor Destroy; override; - - property FieldNames: string read FFieldNames write SetFieldNames; - property ValidExpression: Boolean read FValidExpression write FValidExpression; - property FieldsVal: PChar read GetFieldsVal; - property Parser: TDbfParser read FParser; - - property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange; - property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable; - end; -//==================================================================== - PDbfBlobList = ^TDbfBlobList; - TDbfBlobList = array[0..MaxListSize-1] of TDbfBlobStream; -//==================================================================== - TDbf = class(TDataSet) - private - FDbfFile: TDbfFile; - FCursor: TVirtualCursor; - FOpenMode: TDbfOpenMode; - FStorage: TDbfStorage; - FMasterLink: TDbfMasterLink; - FParser: TDbfParser; - FBlobStreams: PDbfBlobList; - FUserStream: TStream; // user stream to open - FTableName: string; // table path and file name - FRelativePath: string; - FAbsolutePath: string; - FIndexName: string; - FReadOnly: Boolean; - FFilterBuffer: PChar; - FTempBuffer: PChar; - FEditingRecNo: Integer; -{$ifdef SUPPORT_VARIANTS} - FLocateRecNo: Integer; -{$endif} - FLanguageID: Byte; - FTableLevel: Integer; - FExclusive: Boolean; - FShowDeleted: Boolean; - FPosting: Boolean; - FDisableResyncOnPost: Boolean; - FTempExclusive: Boolean; - FInCopyFrom: Boolean; - FStoreDefs: Boolean; - FCopyDateTimeAsString: Boolean; - FFindRecordFilter: Boolean; - FIndexFile: TIndexFile; - FDateTimeHandling: TDateTimeHandling; - FTranslationMode: TDbfTranslationMode; - FIndexDefs: TDbfIndexDefs; - FBeforeAutoCreate: TBeforeAutoCreateEvent; - FOnTranslate: TTranslateEvent; - FOnLanguageWarning: TLanguageWarningEvent; - FOnLocaleError: TDbfLocaleErrorEvent; - FOnIndexMissing: TDbfIndexMissingEvent; - FOnCompareRecord: TNotifyEvent; - FOnCopyDateTimeAsString: TConvertFieldEvent; - - function GetIndexName: string; - function GetVersion: string; - function GetPhysicalRecNo: Integer; - function GetLanguageStr: string; - function GetCodePage: Cardinal; - function GetExactRecordCount: Integer; - function GetPhysicalRecordCount: Integer; - function GetKeySize: Integer; - function GetMasterFields: string; - function FieldDefsStored: Boolean; - - procedure SetIndexName(AIndexName: string); - procedure SetDbfIndexDefs(const Value: TDbfIndexDefs); - procedure SetFilePath(const Value: string); - procedure SetTableName(const S: string); - procedure SetVersion(const S: string); - procedure SetLanguageID(NewID: Byte); - procedure SetDataSource(Value: TDataSource); - procedure SetMasterFields(const Value: string); - procedure SetTableLevel(const NewLevel: Integer); - procedure SetPhysicalRecNo(const NewRecNo: Integer); - - procedure MasterChanged(Sender: TObject); - procedure MasterDisabled(Sender: TObject); - procedure DetermineTranslationMode; - procedure UpdateRange; - procedure SetShowDeleted(Value: Boolean); - procedure GetFieldDefsFromDbfFieldDefs; - procedure InitDbfFile(FileOpenMode: TPagedFileMode); - function ParseIndexName(const AIndexName: string): string; - procedure ParseFilter(const AFilter: string); - function GetDbfFieldDefs: TDbfFieldDefs; - function ReadCurrentRecord(Buffer: PChar; var Acceptable: Boolean): TGetResult; - function SearchKeyBuffer(Buffer: PChar; SearchType: TSearchKeyType): Boolean; - procedure SetRangeBuffer(LowRange: PChar; HighRange: PChar); - - protected - { abstract methods } - function AllocRecordBuffer: PChar; override; {virtual abstract} - procedure ClearCalcFields(Buffer: PChar); override; - procedure FreeRecordBuffer(var Buffer: PChar); override; {virtual abstract} - procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract} - function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; {virtual abstract} - function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract} - function GetRecordSize: Word; override; {virtual abstract} - procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override; {virtual abstract} - procedure InternalClose; override; {virtual abstract} - procedure InternalDelete; override; {virtual abstract} - procedure InternalFirst; override; {virtual abstract} - procedure InternalGotoBookmark(ABookmark: Pointer); override; {virtual abstract} - procedure InternalHandleException; override; {virtual abstract} - procedure InternalInitFieldDefs; override; {virtual abstract} - procedure InternalInitRecord(Buffer: PChar); override; {virtual abstract} - procedure InternalLast; override; {virtual abstract} - procedure InternalOpen; override; {virtual abstract} - procedure InternalEdit; override; {virtual} - procedure InternalCancel; override; {virtual} -{$ifndef FPC} -{$ifndef DELPHI_3} - procedure InternalInsert; override; {virtual} -{$endif} -{$endif} - procedure InternalPost; override; {virtual abstract} - procedure InternalSetToRecord(Buffer: PChar); override; {virtual abstract} - procedure InitFieldDefs; override; - function IsCursorOpen: Boolean; override; {virtual abstract} - procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; {virtual abstract} - procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract} - procedure SetFieldData(Field: TField; Buffer: Pointer); - {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract} - - { virtual methods (mostly optionnal) } - function GetDataSource: TDataSource; {$ifndef VER1_0}override;{$endif} - function GetRecordCount: Integer; override; {virtual} - function GetRecNo: Integer; override; {virtual} - function GetCanModify: Boolean; override; {virtual} - procedure SetRecNo(Value: Integer); override; {virual} - procedure SetFiltered(Value: Boolean); override; {virtual;} - procedure SetFilterText(const Value: String); override; {virtual;} -{$ifdef SUPPORT_DEFCHANGED} - procedure DefChanged(Sender: TObject); override; -{$endif} - function FindRecord(Restart, GoForward: Boolean): Boolean; override; - - function GetIndexFieldNames: string; {virtual;} - procedure SetIndexFieldNames(const Value: string); {virtual;} - -{$ifdef SUPPORT_VARIANTS} - function LocateRecordLinear(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean; - function LocateRecordIndex(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean; - function LocateRecord(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean; -{$endif} - - procedure DoFilterRecord(var Acceptable: Boolean); - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - - { abstract methods } - function GetFieldData(Field: TField; Buffer: Pointer): Boolean; - {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract} - { virtual methods (mostly optionnal) } - procedure Resync(Mode: TResyncMode); override; - function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; {virtual} -{$ifdef SUPPORT_NEW_TRANSLATE} - function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; override; {virtual} -{$else} - procedure Translate(Src, Dest: PChar; ToOem: Boolean); override; {virtual} -{$endif} - -{$ifdef SUPPORT_OVERLOAD} - function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; - {$ifdef SUPPORT_BACKWARD_FIELDDATA} overload; override; {$else} reintroduce; overload; {$endif} - procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); - {$ifdef SUPPORT_BACKWARD_FIELDDATA} overload; override; {$else} reintroduce; overload; {$endif} -{$endif} - - function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; - procedure CheckDbfFieldDefs(ADbfFieldDefs: TDbfFieldDefs); - -{$ifdef VER1_0} - procedure DataEvent(Event: TDataEvent; Info: Longint); override; -{$endif} - - // my own methods and properties - // most look like ttable functions but they are not tdataset related - // I (try to) use the same syntax to facilitate the conversion between bde and TDbf - - // index support (use same syntax as ttable but is not related) -{$ifdef SUPPORT_DEFAULT_PARAMS} - procedure AddIndex(const AIndexName, AFields: String; Options: TIndexOptions; const DescFields: String=''); -{$else} - procedure AddIndex(const AIndexName, AFields: String; Options: TIndexOptions); -{$endif} - procedure RegenerateIndexes; - - procedure CancelRange; - procedure CheckMasterRange; -{$ifdef SUPPORT_VARIANTS} - function SearchKey(Key: Variant; SearchType: TSearchKeyType; KeyIsANSI: boolean - {$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}): Boolean; - procedure SetRange(LowRange: Variant; HighRange: Variant; KeyIsANSI: boolean - {$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}); -{$endif} - function PrepareKey(Buffer: Pointer; BufferType: TExpressionType): PChar; - function SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType; KeyIsANSI: boolean - {$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}): Boolean; - procedure SetRangePChar(LowRange: PChar; HighRange: PChar; KeyIsANSI: boolean - {$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}); - function GetCurrentBuffer: PChar; - procedure ExtractKey(KeyBuffer: PChar); - procedure UpdateIndexDefs; override; - procedure GetFileNames(Strings: TStrings; Files: TDbfFileNames); {$ifdef SUPPORT_DEFAULT_PARAMS} overload; {$endif} -{$ifdef SUPPORT_DEFAULT_PARAMS} - function GetFileNames(Files: TDbfFileNames = [dfDbf] ): string; overload; -{$else} - function GetFileNamesString(Files: TDbfFileNames (* = [dfDbf] *) ): string; -{$endif} - procedure GetIndexNames(Strings: TStrings); - procedure GetAllIndexFiles(Strings: TStrings); - - procedure TryExclusive; - procedure EndExclusive; - function LockTable(const Wait: Boolean): Boolean; - procedure UnlockTable; - procedure OpenIndexFile(IndexFile: string); - procedure DeleteIndex(const AIndexName: string); - procedure CloseIndexFile(const AIndexName: string); - procedure RepageIndexFile(const AIndexFile: string); - procedure CompactIndexFile(const AIndexFile: string); - -{$ifdef SUPPORT_VARIANTS} - function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override; - function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; override; -{$endif} - - function IsDeleted: Boolean; - procedure Undelete; - - procedure CreateTable; - procedure CreateTableEx(ADbfFieldDefs: TDbfFieldDefs); - procedure CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer); - procedure RestructureTable(ADbfFieldDefs: TDbfFieldDefs; Pack: Boolean); - procedure PackTable; - procedure EmptyTable; - procedure Zap; - -{$ifndef SUPPORT_INITDEFSFROMFIELDS} - procedure InitFieldDefsFromFields; -{$endif} - - property AbsolutePath: string read FAbsolutePath; - property DbfFieldDefs: TDbfFieldDefs read GetDbfFieldDefs; - property PhysicalRecNo: Integer read GetPhysicalRecNo write SetPhysicalRecNo; - property LanguageID: Byte read FLanguageID write SetLanguageID; - property LanguageStr: String read GetLanguageStr; - property CodePage: Cardinal read GetCodePage; - property ExactRecordCount: Integer read GetExactRecordCount; - property PhysicalRecordCount: Integer read GetPhysicalRecordCount; - property KeySize: Integer read GetKeySize; - property DbfFile: TDbfFile read FDbfFile; - property UserStream: TStream read FUserStream write FUserStream; - property DisableResyncOnPost: Boolean read FDisableResyncOnPost write FDisableResyncOnPost; - published - property DateTimeHandling: TDateTimeHandling - read FDateTimeHandling write FDateTimeHandling default dtBDETimeStamp; - property Exclusive: Boolean read FExclusive write FExclusive default false; - property FilePath: string read FRelativePath write SetFilePath; - property FilePathFull: string read FAbsolutePath write SetFilePath stored false; - property Indexes: TDbfIndexDefs read FIndexDefs write SetDbfIndexDefs stored false; - property IndexDefs: TDbfIndexDefs read FIndexDefs write SetDbfIndexDefs; - property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames stored false; - property IndexName: string read GetIndexName write SetIndexName; - property MasterFields: string read GetMasterFields write SetMasterFields; - property MasterSource: TDataSource read GetDataSource write SetDataSource; - property OpenMode: TDbfOpenMode read FOpenMode write FOpenMode default omNormal; - property ReadOnly: Boolean read FReadOnly write FReadonly default false; - property ShowDeleted: Boolean read FShowDeleted write SetShowDeleted default false; - property Storage: TDbfStorage read FStorage write FStorage default stoFile; - property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False; - property TableName: string read FTableName write SetTableName; - property TableLevel: Integer read FTableLevel write SetTableLevel; - property Version: string read GetVersion write SetVersion stored false; - property BeforeAutoCreate: TBeforeAutoCreateEvent read FBeforeAutoCreate write FBeforeAutoCreate; - property OnCompareRecord: TNotifyEvent read FOnCompareRecord write FOnCompareRecord; - property OnLanguageWarning: TLanguageWarningEvent read FOnLanguageWarning write FOnLanguageWarning; - property OnLocaleError: TDbfLocaleErrorEvent read FOnLocaleError write FOnLocaleError; - property OnIndexMissing: TDbfIndexMissingEvent read FOnIndexMissing write FOnIndexMissing; - property OnCopyDateTimeAsString: TConvertFieldEvent read FOnCopyDateTimeAsString write FOnCopyDateTimeAsString; - property OnTranslate: TTranslateEvent read FOnTranslate write FOnTranslate; - - // redeclared data set properties - property Active; - property FieldDefs stored FieldDefsStored; - property Filter; - property Filtered; - property FilterOptions; - property BeforeOpen; - property AfterOpen; - property BeforeClose; - property AfterClose; - property BeforeInsert; - property AfterInsert; - property BeforeEdit; - property AfterEdit; - property BeforePost; - property AfterPost; - property BeforeCancel; - property AfterCancel; - property BeforeDelete; - property AfterDelete; -{$ifdef SUPPORT_REFRESHEVENTS} - property BeforeRefresh; - property AfterRefresh; -{$endif} - property BeforeScroll; - property AfterScroll; - property OnCalcFields; - property OnDeleteError; - property OnEditError; - property OnFilterRecord; - property OnNewRecord; - property OnPostError; - end; - - TDbf_GetBasePathFunction = function: string; - -var - DbfBasePath: TDbf_GetBasePathFunction; - -implementation - -uses - SysUtils, -{$ifndef FPC} - DBConsts, -{$endif} -{$ifdef WINDOWS} - Windows, -{$else} -{$ifdef KYLIX} - Libc, -{$endif} - Types, - dbf_wtil, -{$endif} -{$ifdef SUPPORT_SEPARATE_VARIANTS_UNIT} - Variants, -{$endif} - dbf_idxcur, - dbf_memo, - dbf_str; - -{$ifdef FPC} -const - // TODO: move these to DBConsts - SNotEditing = 'Dataset not in edit or insert mode'; - SCircularDataLink = 'Circular datalinks are not allowed'; -{$endif} - -function TableLevelToDbfVersion(TableLevel: integer): TXBaseVersion; -begin - case TableLevel of - 3: Result := xBaseIII; - 7: Result := xBaseVII; - TDBF_TABLELEVEL_FOXPRO: Result := xFoxPro; - else - {4:} Result := xBaseIV; - end; -end; - -//========================================================== -//============ TDbfBlobStream -//========================================================== -constructor TDbfBlobStream.Create(FieldVal: TField); -begin - FBlobField := FieldVal as TBlobField; - FReadSize := 0; - FMemoRecNo := 0; - FRefCount := 1; - FDirty := false; -end; - -destructor TDbfBlobStream.Destroy; -begin - // only continue destroy if all references released - if FRefCount = 1 then - begin - // this is the last reference - inherited - end else begin - // fire event when dirty, and the last "user" is freeing it's reference - // tdbf always has the last reference - if FDirty and (FRefCount = 2) then - begin - // a second referer to instance has changed the data, remember modified -// TDbf(FBlobField.DataSet).SetModified(true); - // is following better? seems to provide notification for user (from VCL) - if not (FBlobField.DataSet.State in [dsCalcFields, dsFilter, dsNewValue]) then - TDbf(FBlobField.DataSet).DataEvent(deFieldChange, PtrInt(FBlobField)); - end; - end; - Dec(FRefCount); -end; - -procedure TDbfBlobStream.FreeInstance; -begin - // only continue freeing if all references released - if FRefCount = 0 then - inherited; -end; - -procedure TDbfBlobStream.SetMode(NewMode: TBlobStreamMode); -begin - FMode := NewMode; - FDirty := FDirty or (NewMode = bmWrite) or (NewMode = bmReadWrite); -end; - -procedure TDbfBlobStream.Cancel; -begin - FDirty := false; - FMemoRecNo := -1; -end; - -procedure TDbfBlobStream.Commit; -var - Dbf: TDbf; -begin - if FDirty then - begin - Size := Position; // Strange but it leave tailing trash bytes if I do not write that. - Dbf := TDbf(FBlobField.DataSet); - Translate(true); - Dbf.FDbfFile.MemoFile.WriteMemo(FMemoRecNo, FReadSize, Self); - Dbf.FDbfFile.SetFieldData(FBlobField.FieldNo-1, ftInteger, @FMemoRecNo, - @pDbfRecord(TDbf(FBlobField.DataSet).ActiveBuffer)^.DeletedFlag, false); - FDirty := false; - end; -end; - -function TDbfBlobStream.AddReference: TDbfBlobStream; -begin - Inc(FRefCount); - Result := Self; -end; - -function TDbfBlobStream.GetTransliterate: Boolean; -begin - Result := FBlobField.Transliterate; -end; - -procedure TDbfBlobStream.Translate(ToOem: Boolean); -var - bytesToDo, numBytes: Integer; - bufPos: PChar; - saveChar: Char; -begin - if (Transliterate) and (Size > 0) then - begin - // get number of bytes to be translated - bytesToDo := Size; - // make space for final null-terminator - Size := Size + 1; - bufPos := Memory; - repeat - // process blocks of 512 bytes - numBytes := bytesToDo; - if numBytes > 512 then - numBytes := 512; - // null-terminate memory - saveChar := bufPos[numBytes]; - bufPos[numBytes] := #0; - // translate memory - TDbf(FBlobField.DataSet).Translate(bufPos, bufPos, ToOem); - // restore char - bufPos[numBytes] := saveChar; - // numBytes bytes translated - Dec(bytesToDo, numBytes); - Inc(bufPos, numBytes); - until bytesToDo = 0; - // cut ending null-terminator - Size := Size - 1; - end; -end; - -//==================================================================== -// TDbf = TDataset Descendant. -//==================================================================== -constructor TDbf.Create(AOwner: TComponent); {override;} -begin - inherited; - - if DbfGlobals = nil then - DbfGlobals := TDbfGlobals.Create; - - BookmarkSize := sizeof(TBookmarkData); - FIndexDefs := TDbfIndexDefs.Create(Self); - FMasterLink := TDbfMasterLink.Create(Self); - FMasterLink.OnMasterChange := MasterChanged; - FMasterLink.OnMasterDisable := MasterDisabled; - FDateTimeHandling := dtBDETimeStamp; - FStorage := stoFile; - FOpenMode := omNormal; - FParser := nil; - FPosting := false; - FReadOnly := false; - FExclusive := false; - FDisableResyncOnPost := false; - FTempExclusive := false; - FCopyDateTimeAsString := false; - FInCopyFrom := false; - FFindRecordFilter := false; - FEditingRecNo := -1; - FTableLevel := 4; - FIndexName := EmptyStr; - FilePath := EmptyStr; - FTempBuffer := nil; - FFilterBuffer := nil; - FIndexFile := nil; - FOnTranslate := nil; - FOnCopyDateTimeAsString := nil; -end; - -destructor TDbf.Destroy; {override;} -var - I: Integer; -begin - inherited Destroy; - - if FIndexDefs <> nil then - begin - for I := FIndexDefs.Count - 1 downto 0 do - TDbfIndexDef(FIndexDefs.Items[I]).Free; - FIndexDefs.Free; - end; - FMasterLink.Free; -end; - -function TDbf.AllocRecordBuffer: PChar; {override virtual abstract from TDataset} -begin - GetMem(Result, SizeOf(TDbfRecordHeader)+FDbfFile.RecordSize+CalcFieldsSize+1); -end; - -procedure TDbf.FreeRecordBuffer(var Buffer: PChar); {override virtual abstract from TDataset} -begin - FreeMemAndNil(Pointer(Buffer)); -end; - -procedure TDbf.GetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset} -begin - pBookmarkData(Data)^ := pDbfRecord(Buffer)^.BookmarkData; -end; - -function TDbf.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; {override virtual abstract from TDataset} -begin - Result := pDbfRecord(Buffer)^.BookmarkFlag; -end; - -function TDbf.GetCurrentBuffer: PChar; -begin - case State of - dsFilter: Result ... [truncated message content] |
From: <tw...@us...> - 2013-07-27 13:27:24
|
Revision: 306 http://sourceforge.net/p/tdbf/code/306 Author: twm Date: 2013-07-27 13:27:20 +0000 (Sat, 27 Jul 2013) Log Message: ----------- * Packages for Delphi 7 * turn off dotNET-Warnings Modified Paths: -------------- trunk/src/dbf_common.inc Added Paths: ----------- trunk/packages/Delphi7/dcltdbf.dof trunk/packages/Delphi7/dcltdbf.dpk trunk/packages/Delphi7/dcltdbf.res trunk/packages/Delphi7/dcu/ trunk/packages/Delphi7/tdbf.dof trunk/packages/Delphi7/tdbf.dpk trunk/packages/Delphi7/tdbf.res trunk/packages/Delphi7/tdbfDelphi7.bpg Removed Paths: ------------- trunk/packages/Delphi7/tdbf_d7d.dof trunk/packages/Delphi7/tdbf_d7d.dpk trunk/packages/Delphi7/tdbf_d7d.res trunk/packages/Delphi7/tdbf_d7r.dof trunk/packages/Delphi7/tdbf_d7r.dpk trunk/packages/Delphi7/tdbf_d7r.res Property Changed: ---------------- trunk/packages/Delphi7/ Index: trunk/packages/Delphi7 =================================================================== --- trunk/packages/Delphi7 2013-07-27 13:10:38 UTC (rev 305) +++ trunk/packages/Delphi7 2013-07-27 13:27:20 UTC (rev 306) Property changes on: trunk/packages/Delphi7 ___________________________________________________________________ Added: svn:ignore ## -0,0 +1,2 ## +dcltdbf.cfg +tdbf.cfg Copied: trunk/packages/Delphi7/dcltdbf.dof (from rev 303, trunk/packages/Delphi7/tdbf_d7d.dof) =================================================================== --- trunk/packages/Delphi7/dcltdbf.dof (rev 0) +++ trunk/packages/Delphi7/dcltdbf.dof 2013-07-27 13:27:20 UTC (rev 306) @@ -0,0 +1,141 @@ +[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=0 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=1 +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=TDbf for Delphi 7 Designtime +[Directories] +OutputDir= +UnitOutputDir=.\dcu +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages=vcl;rtl;xmlide;xmlrtl;vclx;corbaide;proide;dsnapcrba;dsnap;dbrtl;vcldb;bdertl;delphicorba;vclie;stride;direct +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1043 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=1 +Item0=$(DELPHI)\Lib\Debug +[HistoryLists\hlUnitOutputDirectory] +Count=1 +Item0=.\dcu Copied: trunk/packages/Delphi7/dcltdbf.dpk (from rev 303, trunk/packages/Delphi7/tdbf_d7d.dpk) =================================================================== --- trunk/packages/Delphi7/dcltdbf.dpk (rev 0) +++ trunk/packages/Delphi7/dcltdbf.dpk 2013-07-27 13:27:20 UTC (rev 306) @@ -0,0 +1,37 @@ +package dcltdbf; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'TDbf for Delphi 7 Designtime'} +{$LIBSUFFIX '70'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + designide, + tdbf; + +contains + dbf_reg in '..\..\src\dbf_reg.pas'; + +end. Copied: trunk/packages/Delphi7/dcltdbf.res (from rev 303, trunk/packages/Delphi7/tdbf_d7d.res) =================================================================== (Binary files differ) Copied: trunk/packages/Delphi7/tdbf.dof (from rev 303, trunk/packages/Delphi7/tdbf_d7r.dof) =================================================================== --- trunk/packages/Delphi7/tdbf.dof (rev 0) +++ trunk/packages/Delphi7/tdbf.dof 2013-07-27 13:27:20 UTC (rev 306) @@ -0,0 +1,141 @@ +[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=1 +U=0 +V=1 +W=0 +X=1 +Y=0 +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=1 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription=TDbf for Delphi 7 -runtime- +[Directories] +OutputDir= +UnitOutputDir=.\dcu +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages=vcl;rtl;xmlide;xmlrtl;vclx;corbaide;proide;dsnapcrba;dsnap;dbrtl;vcldb;bdertl;delphicorba;vclie;stride;direct +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication=C:\Program Files\Borland\Delphi7\Bin\delphi32.exe +Launcher= +UseLauncher=0 +DebugCWD= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1043 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=1 +Item0=$(DELPHI)\Lib\Debug +[HistoryLists\hlUnitOutputDirectory] +Count=1 +Item0=.\dcu Copied: trunk/packages/Delphi7/tdbf.dpk (from rev 303, trunk/packages/Delphi7/tdbf_d7r.dpk) =================================================================== --- trunk/packages/Delphi7/tdbf.dpk (rev 0) +++ trunk/packages/Delphi7/tdbf.dpk 2013-07-27 13:27:20 UTC (rev 306) @@ -0,0 +1,55 @@ +package tdbf; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS ON} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'TDbf for Delphi 7 -runtime-'} +{$LIBSUFFIX '70'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl, + vcldb; + +contains + dbf_collate in '..\..\src\dbf_collate.pas', + dbf_common in '..\..\src\dbf_common.pas', + dbf_str in '..\..\src\dbf_str.pas', + dbf_cursor in '..\..\src\dbf_cursor.pas', + dbf_parser in '..\..\src\dbf_parser.pas', + dbf_prsdef in '..\..\src\dbf_prsdef.pas', + dbf_prscore in '..\..\src\dbf_prscore.pas', + dbf_prssupp in '..\..\src\dbf_prssupp.pas', + dbf_pgfile in '..\..\src\dbf_pgfile.pas', + dbf_memo in '..\..\src\dbf_memo.pas', + dbf_lang in '..\..\src\dbf_lang.pas', + dbf_fields in '..\..\src\dbf_fields.pas', + dbf_idxfile in '..\..\src\dbf_idxfile.pas', + dbf_idxcur in '..\..\src\dbf_idxcur.pas', + dbf_dbffile in '..\..\src\dbf_dbffile.pas', + dbf_avl in '..\..\src\dbf_avl.pas', + dbf_pgcfile in '..\..\src\dbf_pgcfile.pas', + dbf_wtil in '..\..\src\dbf_wtil.pas', + dbf in '..\..\src\dbf.pas'; + +end. Copied: trunk/packages/Delphi7/tdbf.res (from rev 303, trunk/packages/Delphi7/tdbf_d7r.res) =================================================================== (Binary files differ) Added: trunk/packages/Delphi7/tdbfDelphi7.bpg =================================================================== --- trunk/packages/Delphi7/tdbfDelphi7.bpg (rev 0) +++ trunk/packages/Delphi7/tdbfDelphi7.bpg 2013-07-27 13:27:20 UTC (rev 306) @@ -0,0 +1,24 @@ +#------------------------------------------------------------------------------ +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 = tdbf.bpl dcltdbf60.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + + +tdbf.bpl: tdbf.dpk + $(DCC) + +dcltdbf60.bpl: dcltdbf.dpk + $(DCC) + + Deleted: trunk/packages/Delphi7/tdbf_d7d.dof =================================================================== --- trunk/packages/Delphi7/tdbf_d7d.dof 2013-07-27 13:10:38 UTC (rev 305) +++ trunk/packages/Delphi7/tdbf_d7d.dof 2013-07-27 13:27:20 UTC (rev 306) @@ -1,149 +0,0 @@ -[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=TDbf for Delphi 7 -[Directories] -OutputDir= -UnitOutputDir= -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath= -Packages=vclx;vcl;rtl;dbrtl;vcldb;bdertl;vclactnband -Conditionals= -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -Launcher= -UseLauncher=0 -DebugCWD= -[Language] -ActiveLang= -ProjectLang= -RootDir=H:\WinProgs\Borland\Delphi7\Bin\ -[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=2057 -CodePage=1252 -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= -[Excluded Packages] -h:\winprogs\borland\delphi7\Bin\dclindy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors -h:\winprogs\borland\delphi7\Bin\dclmcn70.bpl=Borland DataSnap Connection Components -H:\WinProgs\Borland\Delphi7\Bin\dclmid70.bpl=Borland MyBase DataAccess Components -h:\winprogs\borland\delphi7\Bin\dclado70.bpl=Borland ADO DB Components -h:\winprogs\borland\delphi7\Bin\dclbde70.bpl=Borland BDE DB Components -h:\winprogs\borland\delphi7\Bin\DCLIB70.bpl=InterBase Data Access Components -h:\winprogs\borland\delphi7\Bin\dcltee70.bpl=TeeChart Components -h:\winprogs\borland\delphi7\Bin\dcldss70.bpl=Borland Decision Cube Components -h:\winprogs\borland\delphi7\Bin\dclclxdb70.bpl=Borland CLX Database Components -H:\WinProgs\Borland\Delphi7\Bin\dclclxstd70.bpl=Borland CLX Standard Components -h:\winprogs\borland\delphi7\Bin\dcl31w70.bpl=Delphi 1.0 Compatibility Components -h:\winprogs\borland\delphi7\Bin\dclIntraweb_50_70.bpl=Intraweb 5.0 Design Package for Delphi 7 Deleted: trunk/packages/Delphi7/tdbf_d7d.dpk =================================================================== --- trunk/packages/Delphi7/tdbf_d7d.dpk 2013-07-27 13:10:38 UTC (rev 305) +++ trunk/packages/Delphi7/tdbf_d7d.dpk 2013-07-27 13:27:20 UTC (rev 306) @@ -1,36 +0,0 @@ -package tdbf_d7d; - -{$R *.res} - -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DESCRIPTION 'TDbf for Delphi 7'} -{$IMPLICITBUILD OFF} - -requires - designide, - tdbf_d7r; - -contains - dbf_reg in '..\..\src\dbf_reg.pas'; - -end. Deleted: trunk/packages/Delphi7/tdbf_d7d.res =================================================================== (Binary files differ) Deleted: trunk/packages/Delphi7/tdbf_d7r.dof =================================================================== --- trunk/packages/Delphi7/tdbf_d7r.dof 2013-07-27 13:10:38 UTC (rev 305) +++ trunk/packages/Delphi7/tdbf_d7r.dof 2013-07-27 13:27:20 UTC (rev 306) @@ -1,139 +0,0 @@ -[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=TDbf for Delphi 7 RunTime -[Directories] -OutputDir= -UnitOutputDir= -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath= -Packages=vclx;vcl;rtl;dbrtl;vcldb;bdertl;vclactnband -Conditionals= -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -Launcher= -UseLauncher=0 -DebugCWD= -[Language] -ActiveLang= -ProjectLang= -RootDir=H:\WinProgs\Borland\Delphi7\Bin\ -[Version Info] -IncludeVerInfo=1 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=2057 -CodePage=1252 -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; Deleted: trunk/packages/Delphi7/tdbf_d7r.dpk =================================================================== --- trunk/packages/Delphi7/tdbf_d7r.dpk 2013-07-27 13:10:38 UTC (rev 305) +++ trunk/packages/Delphi7/tdbf_d7r.dpk 2013-07-27 13:27:20 UTC (rev 306) @@ -1,54 +0,0 @@ -package tdbf_d7r; - -{$R *.res} -{$ALIGN 8} -{$ASSERTIONS ON} -{$BOOLEVAL OFF} -{$DEBUGINFO ON} -{$EXTENDEDSYNTAX ON} -{$IMPORTEDDATA ON} -{$IOCHECKS ON} -{$LOCALSYMBOLS ON} -{$LONGSTRINGS ON} -{$OPENSTRINGS ON} -{$OPTIMIZATION ON} -{$OVERFLOWCHECKS OFF} -{$RANGECHECKS OFF} -{$REFERENCEINFO ON} -{$SAFEDIVIDE OFF} -{$STACKFRAMES OFF} -{$TYPEDADDRESS OFF} -{$VARSTRINGCHECKS ON} -{$WRITEABLECONST OFF} -{$MINENUMSIZE 1} -{$IMAGEBASE $400000} -{$DESCRIPTION 'TDbf for Delphi 7 RunTime'} -{$IMPLICITBUILD OFF} - -requires - rtl, - dbrtl, - vcl; - -contains - dbf_collate in '..\..\src\dbf_collate.pas', - dbf_common in '..\..\src\dbf_common.pas', - dbf_str in '..\..\src\dbf_str.pas', - dbf_cursor in '..\..\src\dbf_cursor.pas', - dbf_parser in '..\..\src\dbf_parser.pas', - dbf_prsdef in '..\..\src\dbf_prsdef.pas', - dbf_prscore in '..\..\src\dbf_prscore.pas', - dbf_prssupp in '..\..\src\dbf_prssupp.pas', - dbf_pgfile in '..\..\src\dbf_pgfile.pas', - dbf_memo in '..\..\src\dbf_memo.pas', - dbf_lang in '..\..\src\dbf_lang.pas', - dbf_fields in '..\..\src\dbf_fields.pas', - dbf_idxfile in '..\..\src\dbf_idxfile.pas', - dbf_idxcur in '..\..\src\dbf_idxcur.pas', - dbf_dbffile in '..\..\src\dbf_dbffile.pas', - dbf_avl in '..\..\src\dbf_avl.pas', - dbf_pgcfile in '..\..\src\dbf_pgcfile.pas', - dbf_wtil in '..\..\src\dbf_wtil.pas', - dbf in '..\..\src\dbf.pas'; - -end. Deleted: trunk/packages/Delphi7/tdbf_d7r.res =================================================================== (Binary files differ) Modified: trunk/src/dbf_common.inc =================================================================== --- trunk/src/dbf_common.inc 2013-07-27 13:10:38 UTC (rev 305) +++ trunk/src/dbf_common.inc 2013-07-27 13:27:20 UTC (rev 306) @@ -291,8 +291,16 @@ {$define SUPPORT_INCLTRAILPATHDELIM} // Was missing 20130529 {$define SUPPORT_INCLTRAILBACKSLASH} // Was missing 20130529 + + {$warn UNSAFE_TYPE off} + {$warn UNSAFE_CODE off} + {$warn UNSAFE_CAST off} {$endif} +{$ifdef Delphi_7} + {$define SUPPORT_NATIVEINT} +{$endif} + {$ifdef Delphi_2009} {$define WINAPI_IS_UNICODE} {$define SUPPORT_TRECORDBUFFER} This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <tw...@us...> - 2013-07-27 16:33:17
|
Revision: 313 http://sourceforge.net/p/tdbf/code/313 Author: twm Date: 2013-07-27 16:33:14 +0000 (Sat, 27 Jul 2013) Log Message: ----------- compiles now for Win64 (untested) Modified Paths: -------------- trunk/packages/DelphiXE2/tdbf.dproj trunk/packages/DelphiXE2/tdbf.res trunk/packages/DelphiXE4/dcltdbf.dproj trunk/packages/DelphiXE4/tdbf.dproj trunk/packages/DelphiXE4/tdbf.res trunk/src/dbf.pas trunk/src/dbf_common.inc trunk/src/dbf_common.pas trunk/src/dbf_dbffile.pas trunk/src/dbf_idxcur.pas trunk/src/dbf_idxfile.pas trunk/src/dbf_prscore.pas trunk/src/dbf_prsdef.pas Added Paths: ----------- trunk/packages/DelphiXE2/dcu/ trunk/packages/DelphiXE4/dcu/ trunk/src/ansistrings.inc Modified: trunk/packages/DelphiXE2/tdbf.dproj =================================================================== --- trunk/packages/DelphiXE2/tdbf.dproj 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/packages/DelphiXE2/tdbf.dproj 2013-07-27 16:33:14 UTC (rev 313) @@ -4,15 +4,20 @@ <MainSource>tdbf.dpk</MainSource> <Base>True</Base> <Config Condition="'$(Config)'==''">Debug</Config> - <TargetedPlatforms>1</TargetedPlatforms> + <TargetedPlatforms>3</TargetedPlatforms> <AppType>Package</AppType> <FrameworkType>VCL</FrameworkType> <ProjectVersion>13.4</ProjectVersion> - <Platform Condition="'$(Platform)'==''">Win32</Platform> + <Platform Condition="'$(Platform)'==''">Win64</Platform> </PropertyGroup> <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> <Base>true</Base> </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''"> + <Base_Win64>true</Base_Win64> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''"> <Base_Win32>true</Base_Win32> <CfgParent>Base</CfgParent> @@ -23,11 +28,29 @@ <CfgParent>Base</CfgParent> <Base>true</Base> </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''"> + <Cfg_1_Win64>true</Cfg_1_Win64> + <CfgParent>Cfg_1</CfgParent> + <Cfg_1>true</Cfg_1> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''"> + <Cfg_1_Win32>true</Cfg_1_Win32> + <CfgParent>Cfg_1</CfgParent> + <Cfg_1>true</Cfg_1> + <Base>true</Base> + </PropertyGroup> <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''"> <Cfg_2>true</Cfg_2> <CfgParent>Base</CfgParent> <Base>true</Base> </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win64)'!=''"> + <Cfg_2_Win64>true</Cfg_2_Win64> + <CfgParent>Cfg_2</CfgParent> + <Cfg_2>true</Cfg_2> + <Base>true</Base> + </PropertyGroup> <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''"> <Cfg_2_Win32>true</Cfg_2_Win32> <CfgParent>Cfg_2</CfgParent> @@ -35,6 +58,7 @@ <Base>true</Base> </PropertyGroup> <PropertyGroup Condition="'$(Base)'!=''"> + <DCC_DcuOutput>.\dcu</DCC_DcuOutput> <DCC_ImageBase>00400000</DCC_ImageBase> <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> <DllSuffix>160</DllSuffix> @@ -51,11 +75,15 @@ <DCC_E>false</DCC_E> <DCC_F>false</DCC_F> </PropertyGroup> + <PropertyGroup Condition="'$(Base_Win64)'!=''"> + <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + <VerInfo_Locale>1033</VerInfo_Locale> + </PropertyGroup> <PropertyGroup Condition="'$(Base_Win32)'!=''"> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace> <VerInfo_Locale>1033</VerInfo_Locale> - <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> </PropertyGroup> <PropertyGroup Condition="'$(Cfg_1)'!=''"> <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols> @@ -63,14 +91,25 @@ <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo> <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define> </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''"> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + <VerInfo_Locale>1033</VerInfo_Locale> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''"> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + <VerInfo_Locale>1033</VerInfo_Locale> + </PropertyGroup> <PropertyGroup Condition="'$(Cfg_2)'!=''"> <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define> <DCC_Optimize>false</DCC_Optimize> <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames> </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_2_Win64)'!=''"> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + <VerInfo_Locale>1033</VerInfo_Locale> + </PropertyGroup> <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''"> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> - <DCC_DcuOutput>.\dcu</DCC_DcuOutput> <VerInfo_Locale>1033</VerInfo_Locale> </PropertyGroup> <ItemGroup> @@ -147,14 +186,12 @@ <VersionInfoKeys Name="Comments"/> </VersionInfoKeys> <Excluded_Packages> - <Excluded_Packages Name="$(BDSBIN)\bcboffice2k160.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages> - <Excluded_Packages Name="$(BDSBIN)\bcbofficexp160.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages> <Excluded_Packages Name="$(BDSBIN)\dcloffice2k160.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDSBIN)\dclofficexp160.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages> </Excluded_Packages> </Delphi.Personality> <Platforms> - <Platform value="Win64">False</Platform> + <Platform value="Win64">True</Platform> <Platform value="Win32">True</Platform> </Platforms> </BorlandProject> Modified: trunk/packages/DelphiXE2/tdbf.res =================================================================== (Binary files differ) Modified: trunk/packages/DelphiXE4/dcltdbf.dproj =================================================================== --- trunk/packages/DelphiXE4/dcltdbf.dproj 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/packages/DelphiXE4/dcltdbf.dproj 2013-07-27 16:33:14 UTC (rev 313) @@ -152,8 +152,6 @@ </Excluded_Packages> </Delphi.Personality> <Platforms> - <Platform value="iOSDevice">False</Platform> - <Platform value="iOSSimulator">False</Platform> <Platform value="OSX32">False</Platform> <Platform value="Win32">True</Platform> <Platform value="Win64">False</Platform> Modified: trunk/packages/DelphiXE4/tdbf.dproj =================================================================== --- trunk/packages/DelphiXE4/tdbf.dproj 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/packages/DelphiXE4/tdbf.dproj 2013-07-27 16:33:14 UTC (rev 313) @@ -4,7 +4,7 @@ <MainSource>tdbf.dpk</MainSource> <Base>True</Base> <Config Condition="'$(Config)'==''">Debug</Config> - <TargetedPlatforms>1</TargetedPlatforms> + <TargetedPlatforms>3</TargetedPlatforms> <AppType>Package</AppType> <FrameworkType>VCL</FrameworkType> <ProjectVersion>14.6</ProjectVersion> @@ -18,11 +18,28 @@ <CfgParent>Base</CfgParent> <Base>true</Base> </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''"> + <Base_Win64>true</Base_Win64> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''"> <Cfg_1>true</Cfg_1> <CfgParent>Base</CfgParent> <Base>true</Base> </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''"> + <Cfg_1_Win32>true</Cfg_1_Win32> + <CfgParent>Cfg_1</CfgParent> + <Cfg_1>true</Cfg_1> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''"> + <Cfg_1_Win64>true</Cfg_1_Win64> + <CfgParent>Cfg_1</CfgParent> + <Cfg_1>true</Cfg_1> + <Base>true</Base> + </PropertyGroup> <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''"> <Cfg_2>true</Cfg_2> <CfgParent>Base</CfgParent> @@ -34,7 +51,14 @@ <Cfg_2>true</Cfg_2> <Base>true</Base> </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win64)'!=''"> + <Cfg_2_Win64>true</Cfg_2_Win64> + <CfgParent>Cfg_2</CfgParent> + <Cfg_2>true</Cfg_2> + <Base>true</Base> + </PropertyGroup> <PropertyGroup Condition="'$(Base)'!=''"> + <DCC_DcuOutput>.\dcu</DCC_DcuOutput> <DCC_ImageBase>00400000</DCC_ImageBase> <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> <DllSuffix>160</DllSuffix> @@ -56,12 +80,25 @@ <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace> <VerInfo_Locale>1033</VerInfo_Locale> </PropertyGroup> + <PropertyGroup Condition="'$(Base_Win64)'!=''"> + <VerInfo_Locale>1033</VerInfo_Locale> + <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + </PropertyGroup> <PropertyGroup Condition="'$(Cfg_1)'!=''"> <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols> <DCC_DebugInformation>false</DCC_DebugInformation> <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo> <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define> </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''"> + <VerInfo_Locale>1033</VerInfo_Locale> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''"> + <VerInfo_Locale>1033</VerInfo_Locale> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + </PropertyGroup> <PropertyGroup Condition="'$(Cfg_2)'!=''"> <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define> <DCC_Optimize>false</DCC_Optimize> @@ -71,9 +108,12 @@ <DCC_Description>TDbf for Delphi XE3 runtime</DCC_Description> <DllSuffix>180</DllSuffix> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> - <DCC_DcuOutput>.\dcu</DCC_DcuOutput> <VerInfo_Locale>1033</VerInfo_Locale> </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_2_Win64)'!=''"> + <VerInfo_Locale>1033</VerInfo_Locale> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + </PropertyGroup> <ItemGroup> <DelphiCompile Include="$(MainSource)"> <MainSource>MainSource</MainSource> @@ -100,6 +140,7 @@ <DCCReference Include="..\..\src\dbf_pgcfile.pas"/> <DCCReference Include="..\..\src\dbf_wtil.pas"/> <DCCReference Include="..\..\src\dbf.pas"/> + <None Include="..\..\src\ansistrings.inc"/> <BuildConfiguration Include="Debug"> <Key>Cfg_2</Key> <CfgParent>Base</CfgParent> @@ -153,10 +194,8 @@ </Excluded_Packages> </Delphi.Personality> <Platforms> - <Platform value="iOSDevice">False</Platform> - <Platform value="iOSSimulator">False</Platform> <Platform value="Win32">True</Platform> - <Platform value="Win64">False</Platform> + <Platform value="Win64">True</Platform> </Platforms> </BorlandProject> <ProjectFileVersion>12</ProjectFileVersion> Modified: trunk/packages/DelphiXE4/tdbf.res =================================================================== (Binary files differ) Added: trunk/src/ansistrings.inc =================================================================== --- trunk/src/ansistrings.inc (rev 0) +++ trunk/src/ansistrings.inc 2013-07-27 16:33:14 UTC (rev 313) @@ -0,0 +1,80 @@ +// These are inlined recirections to functions that were +// moved to the AnsiStrings unit to prevent ambiguous overloaded errors +// in Delphi XE4 and up. + +function StrLen(Str: PAnsiChar): integer; inline; +begin + Result := AnsiStrings.StrLen(Str); +end; + +function StrCopy(Dest, Source: PAnsiChar): PAnsiChar; inline; +begin + Result := AnsiStrings.StrCopy(Dest, Source) +end; + +function FloatToText(BufferArg: PAnsiChar; const Value; ValueType: TFloatValue; + Format: TFloatFormat; Precision, Digits: Integer): Integer; inline; +begin + Result := AnsiStrings.FloatToText(BufferArg, Value, ValueType, Format, Precision, Digits); +end; + +function AnsiStrUpper(Str: PAnsiChar): PAnsiChar; inline; +begin + Result := AnsiStrings.AnsiStrUpper(Str) +end; + +function AnsiStrLower(Str: PAnsiChar): PAnsiChar; inline; +begin + Result := AnsiStrings.AnsiStrLower(Str) +end; + +function AnsiStrIComp(S1, S2: PAnsiChar): Integer; inline; +begin + Result := AnsiStrings.AnsiStrIComp(S1, S2); +end; + +function AnsiStrLIComp(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; inline; +begin + Result := AnsiStrings.AnsiStrLIComp(S1, S2, MaxLen); +end; + +function AnsiStrPos(Str, SubStr: PAnsiChar): PAnsiChar; inline; +begin + Result := AnsiStrings.AnsiStrPos(Str, Substr); +end; + +function AnsiStrLComp(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; inline; +begin + Result := AnsiStrings.AnsiStrLComp(S1, S2, MaxLen); +end; + +function AnsiStrComp(S1, S2: PAnsiChar): Integer; inline; +begin + Result := AnsiStrings.AnsiStrComp(S1, S2); +end; + +function StrScan(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; inline; +begin + Result := AnsiStrings.StrScan(Str, Chr); +end; + +function TextToFloat(Buffer: PAnsiChar; var Value; ValueType: TFloatValue): Boolean; inline; +begin + Result := AnsiStrings.TextToFloat(Buffer, Value, ValueType); +end; + +function StrLComp(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; inline; +begin + Result := AnsiStrings.StrLComp(Str1, Str2, MaxLen); +end; + +function StrPLCopy(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar; inline; +begin + Result := AnsiStrings.StrPLCopy(Dest, Source, MaxLen); +end; + +function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; inline; +begin + Result := AnsiStrings.StrLCopy(Dest, Source, MaxLen); +end; + Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/src/dbf.pas 2013-07-27 16:33:14 UTC (rev 313) @@ -503,15 +503,7 @@ {$endif} {$ifdef SUPPORT_ANSISTRINGS_UNIT} -function StrLen(Str: PAnsiChar): integer; inline; -begin - Result := AnsiStrings.StrLen(Str); -end; - -function StrCopy(Dest, Source: PAnsiChar): PAnsiChar; -begin - Result := AnsiStrings.StrCopy(Dest, Source) -end; +{$include 'ansistrings.inc'} {$endif} function TableLevelToDbfVersion(TableLevel: integer): TXBaseVersion; Modified: trunk/src/dbf_common.inc =================================================================== --- trunk/src/dbf_common.inc 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/src/dbf_common.inc 2013-07-27 16:33:14 UTC (rev 313) @@ -14,8 +14,9 @@ {.$define HUNGARIAN} // enables assembler routines, 486+ only - +{$ifndef Win64} {$define USE_ASSEMBLER_486_UP} +{$endif} // test compatibility @@ -306,6 +307,9 @@ {$define SUPPORT_TRECORDBUFFER} {$define SUPPORT_CHARINSET} {$define SUPPORT_MAXLISTSIZEDEPRECATED} +{$endif} + +{$ifdef Delphi_XE} {$define SUPPORT_FORMATSETTINGS} {$endif} Modified: trunk/src/dbf_common.pas =================================================================== --- trunk/src/dbf_common.pas 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/src/dbf_common.pas 2013-07-27 16:33:14 UTC (rev 313) @@ -166,9 +166,22 @@ {$ifdef MSWINDOWS} uses +{$ifdef SUPPORT_ANSISTRINGS_UNIT} + AnsiStrings, +{$ENDIF} Windows; +{$else} +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +uses + AnsiStrings; +{$ENDIF} {$endif} +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +{$include 'ansistrings.inc'} +{$endif} + + //==================================================================== function GetCompletePath(const Base, Path: string): string; Modified: trunk/src/dbf_dbffile.pas =================================================================== --- trunk/src/dbf_dbffile.pas 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/src/dbf_dbffile.pas 2013-07-27 16:33:14 UTC (rev 313) @@ -199,11 +199,19 @@ {$ifdef SUPPORT_MATH_UNIT} Math, {$endif} +{$ifdef SUPPORT_ANSISTRINGS_UNIT} + AnsiStrings, +{$ENDIF} dbf_str, dbf_lang, dbf_prssupp, dbf_prsdef; const sDBF_DEC_SEP = '.'; +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +{$include 'ansistrings.inc'} +{$endif} + + {$I dbf_struct.inc} Modified: trunk/src/dbf_idxcur.pas =================================================================== --- trunk/src/dbf_idxcur.pas 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/src/dbf_idxcur.pas 2013-07-27 16:33:14 UTC (rev 313) @@ -55,6 +55,15 @@ //==================================================================== implementation +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +uses + AnsiStrings; +{$ENDIF} + +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +{$include 'ansistrings.inc'} +{$endif} + //========================================================== //============ TIndexCursor //========================================================== Modified: trunk/src/dbf_idxfile.pas =================================================================== --- trunk/src/dbf_idxfile.pas 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/src/dbf_idxfile.pas 2013-07-27 16:33:14 UTC (rev 313) @@ -405,12 +405,19 @@ implementation uses +{$ifdef SUPPORT_ANSISTRINGS_UNIT} + AnsiStrings, +{$ENDIF} dbf_dbffile, dbf_fields, dbf_str, dbf_prssupp, dbf_lang; +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +{$include 'ansistrings.inc'} +{$endif} + const RecBOF = 0; RecEOF = MaxInt; Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/src/dbf_prscore.pas 2013-07-27 16:33:14 UTC (rev 313) @@ -249,6 +249,15 @@ implementation +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +uses + AnsiStrings; +{$ENDIF} + +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +{$include 'ansistrings.inc'} +{$endif} + procedure LinkVariable(ExprRec: PExpressionRec); begin ///with ExprRec^ do Modified: trunk/src/dbf_prsdef.pas =================================================================== --- trunk/src/dbf_prsdef.pas 2013-07-27 15:55:25 UTC (rev 312) +++ trunk/src/dbf_prsdef.pas 2013-07-27 16:33:14 UTC (rev 313) @@ -354,6 +354,15 @@ implementation +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +uses + AnsiStrings; +{$endif} + +{$ifdef SUPPORT_ANSISTRINGS_UNIT} +{$include 'ansistrings.inc'} +{$endif} + function ExprCharToExprType(ExprChar: Char): TExpressionType; begin case ExprChar of This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <tw...@us...> - 2013-08-15 15:59:09
|
Revision: 316 http://sourceforge.net/p/tdbf/code/316 Author: twm Date: 2013-08-15 15:59:07 +0000 (Thu, 15 Aug 2013) Log Message: ----------- * Win64 support for XE2/3/4 * compiles for Delphi 2007, XE2/3/4 Modified Paths: -------------- trunk/packages/Delphi2007/dcltdbf.dproj trunk/packages/Delphi2007/tdbf.dpk trunk/packages/Delphi2007/tdbf.dproj trunk/packages/DelphiXE2/tdbf.dpk trunk/packages/DelphiXE2/tdbf.dproj trunk/packages/DelphiXE3/tdbf.dpk trunk/packages/DelphiXE3/tdbf.dproj trunk/packages/DelphiXE3/tdbf.res trunk/packages/DelphiXE4/dcltdbf.dproj trunk/packages/DelphiXE4/tdbf.dpk trunk/src/dbf.pas trunk/src/dbf_common.inc trunk/src/dbf_common.pas trunk/src/dbf_dbffile.pas trunk/src/dbf_idxcur.pas trunk/src/dbf_idxfile.pas trunk/src/dbf_prscore.pas trunk/src/dbf_prsdef.pas trunk/src/dbf_wtil.pas Added Paths: ----------- trunk/packages/Delphi2007/tdbf2007.groupproj trunk/src/dbf_ansistrings.pas Removed Paths: ------------- trunk/src/ansistrings.inc Modified: trunk/packages/Delphi2007/dcltdbf.dproj =================================================================== --- trunk/packages/Delphi2007/dcltdbf.dproj 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/packages/Delphi2007/dcltdbf.dproj 2013-08-15 15:59:07 UTC (rev 316) @@ -60,40 +60,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - <Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDS)\bin\bcbie100.bpl">File c:\program files (x86)\codegear\rad studio\5.0\bin\bcbie100.bpl not found</Excluded_Packages> Modified: trunk/packages/Delphi2007/tdbf.dpk =================================================================== --- trunk/packages/Delphi2007/tdbf.dpk 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/packages/Delphi2007/tdbf.dpk 2013-08-15 15:59:07 UTC (rev 316) @@ -51,6 +51,7 @@ dbf_avl in '..\..\src\dbf_avl.pas', dbf_pgcfile in '..\..\src\dbf_pgcfile.pas', dbf_wtil in '..\..\src\dbf_wtil.pas', - dbf in '..\..\src\dbf.pas'; + dbf in '..\..\src\dbf.pas', + dbf_AnsiStrings in '..\..\src\dbf_AnsiStrings.pas'; end. Modified: trunk/packages/Delphi2007/tdbf.dproj =================================================================== --- trunk/packages/Delphi2007/tdbf.dproj 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/packages/Delphi2007/tdbf.dproj 2013-08-15 15:59:07 UTC (rev 316) @@ -105,6 +105,7 @@ <DCCReference Include="$(SystemRoot)\System32\rtl.dcp" /> <DCCReference Include="$(SystemRoot)\System32\vcl.dcp" /> <DCCReference Include="..\..\src\dbf.pas" /> + <DCCReference Include="..\..\src\dbf_AnsiStrings.pas" /> <DCCReference Include="..\..\src\dbf_avl.pas" /> <DCCReference Include="..\..\src\dbf_collate.pas" /> <DCCReference Include="..\..\src\dbf_common.pas" /> Added: trunk/packages/Delphi2007/tdbf2007.groupproj =================================================================== --- trunk/packages/Delphi2007/tdbf2007.groupproj (rev 0) +++ trunk/packages/Delphi2007/tdbf2007.groupproj 2013-08-15 15:59:07 UTC (rev 316) @@ -0,0 +1,44 @@ +<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> + <PropertyGroup> + <ProjectGuid>{e5761f12-aa14-4452-a83b-4d0ffba751b6}</ProjectGuid> + </PropertyGroup> + <ItemGroup /> + <ItemGroup> + <Projects Include="dcltdbf.dproj" /> + <Projects Include="tdbf.dproj" /> + </ItemGroup> + <ProjectExtensions> + <Borland.Personality>Default.Personality</Borland.Personality> + <Borland.ProjectType /> + <BorlandProject> + <BorlandProject xmlns=""> <Default.Personality> </Default.Personality> </BorlandProject></BorlandProject> + </ProjectExtensions> + <Target Name="tdbf"> + <MSBuild Projects="tdbf.dproj" Targets="" /> + </Target> + <Target Name="tdbf:Clean"> + <MSBuild Projects="tdbf.dproj" Targets="Clean" /> + </Target> + <Target Name="tdbf:Make"> + <MSBuild Projects="tdbf.dproj" Targets="Make" /> + </Target> + <Target Name="dcltdbf"> + <MSBuild Projects="dcltdbf.dproj" Targets="" /> + </Target> + <Target Name="dcltdbf:Clean"> + <MSBuild Projects="dcltdbf.dproj" Targets="Clean" /> + </Target> + <Target Name="dcltdbf:Make"> + <MSBuild Projects="dcltdbf.dproj" Targets="Make" /> + </Target> + <Target Name="Build"> + <CallTarget Targets="tdbf;dcltdbf" /> + </Target> + <Target Name="Clean"> + <CallTarget Targets="tdbf:Clean;dcltdbf:Clean" /> + </Target> + <Target Name="Make"> + <CallTarget Targets="tdbf:Make;dcltdbf:Make" /> + </Target> + <Import Condition="Exists('$(MSBuildBinPath)\Borland.Group.Targets')" Project="$(MSBuildBinPath)\Borland.Group.Targets" /> +</Project> \ No newline at end of file Modified: trunk/packages/DelphiXE2/tdbf.dpk =================================================================== --- trunk/packages/DelphiXE2/tdbf.dpk 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/packages/DelphiXE2/tdbf.dpk 2013-08-15 15:59:07 UTC (rev 316) @@ -54,6 +54,7 @@ dbf_avl in '..\..\src\dbf_avl.pas', dbf_pgcfile in '..\..\src\dbf_pgcfile.pas', dbf_wtil in '..\..\src\dbf_wtil.pas', - dbf in '..\..\src\dbf.pas'; + dbf in '..\..\src\dbf.pas', + dbf_AnsiStrings in '..\..\src\dbf_AnsiStrings.pas'; end. Modified: trunk/packages/DelphiXE2/tdbf.dproj =================================================================== --- trunk/packages/DelphiXE2/tdbf.dproj 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/packages/DelphiXE2/tdbf.dproj 2013-08-15 15:59:07 UTC (rev 316) @@ -8,7 +8,7 @@ <AppType>Package</AppType> <FrameworkType>VCL</FrameworkType> <ProjectVersion>13.4</ProjectVersion> - <Platform Condition="'$(Platform)'==''">Win64</Platform> + <Platform Condition="'$(Platform)'==''">Win32</Platform> </PropertyGroup> <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> <Base>true</Base> @@ -76,6 +76,7 @@ <DCC_F>false</DCC_F> </PropertyGroup> <PropertyGroup Condition="'$(Base_Win64)'!=''"> + <DCC_BplOutput>..\bin64</DCC_BplOutput> <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> <VerInfo_Locale>1033</VerInfo_Locale> @@ -138,6 +139,7 @@ <DCCReference Include="..\..\src\dbf_pgcfile.pas"/> <DCCReference Include="..\..\src\dbf_wtil.pas"/> <DCCReference Include="..\..\src\dbf.pas"/> + <DCCReference Include="..\..\src\dbf_AnsiStrings.pas"/> <BuildConfiguration Include="Debug"> <Key>Cfg_2</Key> <CfgParent>Base</CfgParent> @@ -186,6 +188,8 @@ <VersionInfoKeys Name="Comments"/> </VersionInfoKeys> <Excluded_Packages> + <Excluded_Packages Name="$(BDSBIN)\bcboffice2k160.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages> + <Excluded_Packages Name="$(BDSBIN)\bcbofficexp160.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages> <Excluded_Packages Name="$(BDSBIN)\dcloffice2k160.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDSBIN)\dclofficexp160.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages> </Excluded_Packages> Modified: trunk/packages/DelphiXE3/tdbf.dpk =================================================================== --- trunk/packages/DelphiXE3/tdbf.dpk 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/packages/DelphiXE3/tdbf.dpk 2013-08-15 15:59:07 UTC (rev 316) @@ -54,6 +54,7 @@ dbf_avl in '..\..\src\dbf_avl.pas', dbf_pgcfile in '..\..\src\dbf_pgcfile.pas', dbf_wtil in '..\..\src\dbf_wtil.pas', - dbf in '..\..\src\dbf.pas'; + dbf in '..\..\src\dbf.pas', + dbf_AnsiStrings in '..\..\src\dbf_AnsiStrings.pas'; end. Modified: trunk/packages/DelphiXE3/tdbf.dproj =================================================================== --- trunk/packages/DelphiXE3/tdbf.dproj 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/packages/DelphiXE3/tdbf.dproj 2013-08-15 15:59:07 UTC (rev 316) @@ -4,7 +4,7 @@ <MainSource>tdbf.dpk</MainSource> <Base>True</Base> <Config Condition="'$(Config)'==''">Debug</Config> - <TargetedPlatforms>1</TargetedPlatforms> + <TargetedPlatforms>3</TargetedPlatforms> <AppType>Package</AppType> <FrameworkType>VCL</FrameworkType> <ProjectVersion>14.4</ProjectVersion> @@ -18,11 +18,28 @@ <CfgParent>Base</CfgParent> <Base>true</Base> </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''"> + <Base_Win64>true</Base_Win64> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''"> <Cfg_1>true</Cfg_1> <CfgParent>Base</CfgParent> <Base>true</Base> </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''"> + <Cfg_1_Win32>true</Cfg_1_Win32> + <CfgParent>Cfg_1</CfgParent> + <Cfg_1>true</Cfg_1> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''"> + <Cfg_1_Win64>true</Cfg_1_Win64> + <CfgParent>Cfg_1</CfgParent> + <Cfg_1>true</Cfg_1> + <Base>true</Base> + </PropertyGroup> <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''"> <Cfg_2>true</Cfg_2> <CfgParent>Base</CfgParent> @@ -34,7 +51,14 @@ <Cfg_2>true</Cfg_2> <Base>true</Base> </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win64)'!=''"> + <Cfg_2_Win64>true</Cfg_2_Win64> + <CfgParent>Cfg_2</CfgParent> + <Cfg_2>true</Cfg_2> + <Base>true</Base> + </PropertyGroup> <PropertyGroup Condition="'$(Base)'!=''"> + <DCC_DcuOutput>.\dcu</DCC_DcuOutput> <DCC_ImageBase>00400000</DCC_ImageBase> <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> <DllSuffix>160</DllSuffix> @@ -55,14 +79,26 @@ <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace> <VerInfo_Locale>1033</VerInfo_Locale> - <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> </PropertyGroup> + <PropertyGroup Condition="'$(Base_Win64)'!=''"> + <VerInfo_Locale>1033</VerInfo_Locale> + <DCC_Namespace>System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + </PropertyGroup> <PropertyGroup Condition="'$(Cfg_1)'!=''"> <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols> <DCC_DebugInformation>false</DCC_DebugInformation> <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo> <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define> </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''"> + <VerInfo_Locale>1033</VerInfo_Locale> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''"> + <VerInfo_Locale>1033</VerInfo_Locale> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + </PropertyGroup> <PropertyGroup Condition="'$(Cfg_2)'!=''"> <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define> <DCC_Optimize>false</DCC_Optimize> @@ -72,9 +108,13 @@ <DCC_Description>TDbf for Delphi XE3 runtime</DCC_Description> <DllSuffix>170</DllSuffix> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> - <DCC_DcuOutput>.\dcu</DCC_DcuOutput> <VerInfo_Locale>1033</VerInfo_Locale> </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_2_Win64)'!=''"> + <DCC_BplOutput>..\bin64</DCC_BplOutput> + <VerInfo_Locale>1033</VerInfo_Locale> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + </PropertyGroup> <ItemGroup> <DelphiCompile Include="$(MainSource)"> <MainSource>MainSource</MainSource> @@ -101,6 +141,7 @@ <DCCReference Include="..\..\src\dbf_pgcfile.pas"/> <DCCReference Include="..\..\src\dbf_wtil.pas"/> <DCCReference Include="..\..\src\dbf.pas"/> + <DCCReference Include="..\..\src\dbf_AnsiStrings.pas"/> <BuildConfiguration Include="Debug"> <Key>Cfg_2</Key> <CfgParent>Base</CfgParent> @@ -155,7 +196,7 @@ </Delphi.Personality> <Platforms> <Platform value="Win32">True</Platform> - <Platform value="Win64">False</Platform> + <Platform value="Win64">True</Platform> </Platforms> </BorlandProject> <ProjectFileVersion>12</ProjectFileVersion> Modified: trunk/packages/DelphiXE3/tdbf.res =================================================================== (Binary files differ) Modified: trunk/packages/DelphiXE4/dcltdbf.dproj =================================================================== --- trunk/packages/DelphiXE4/dcltdbf.dproj 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/packages/DelphiXE4/dcltdbf.dproj 2013-08-15 15:59:07 UTC (rev 316) @@ -152,6 +152,8 @@ </Excluded_Packages> </Delphi.Personality> <Platforms> + <Platform value="iOSDevice">False</Platform> + <Platform value="iOSSimulator">False</Platform> <Platform value="OSX32">False</Platform> <Platform value="Win32">True</Platform> <Platform value="Win64">False</Platform> Modified: trunk/packages/DelphiXE4/tdbf.dpk =================================================================== --- trunk/packages/DelphiXE4/tdbf.dpk 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/packages/DelphiXE4/tdbf.dpk 2013-08-15 15:59:07 UTC (rev 316) @@ -54,6 +54,7 @@ dbf_avl in '..\..\src\dbf_avl.pas', dbf_pgcfile in '..\..\src\dbf_pgcfile.pas', dbf_wtil in '..\..\src\dbf_wtil.pas', - dbf in '..\..\src\dbf.pas'; + dbf in '..\..\src\dbf.pas', + dbf_AnsiStrings in '..\..\src\dbf_AnsiStrings.pas'; end. Deleted: trunk/src/ansistrings.inc =================================================================== --- trunk/src/ansistrings.inc 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/ansistrings.inc 2013-08-15 15:59:07 UTC (rev 316) @@ -1,80 +0,0 @@ -// These are inlined recirections to functions that were -// moved to the AnsiStrings unit to prevent ambiguous overloaded errors -// in Delphi XE4 and up. - -function StrLen(Str: PAnsiChar): integer; inline; -begin - Result := AnsiStrings.StrLen(Str); -end; - -function StrCopy(Dest, Source: PAnsiChar): PAnsiChar; inline; -begin - Result := AnsiStrings.StrCopy(Dest, Source) -end; - -function FloatToText(BufferArg: PAnsiChar; const Value; ValueType: TFloatValue; - Format: TFloatFormat; Precision, Digits: Integer): Integer; inline; -begin - Result := AnsiStrings.FloatToText(BufferArg, Value, ValueType, Format, Precision, Digits); -end; - -function AnsiStrUpper(Str: PAnsiChar): PAnsiChar; inline; -begin - Result := AnsiStrings.AnsiStrUpper(Str) -end; - -function AnsiStrLower(Str: PAnsiChar): PAnsiChar; inline; -begin - Result := AnsiStrings.AnsiStrLower(Str) -end; - -function AnsiStrIComp(S1, S2: PAnsiChar): Integer; inline; -begin - Result := AnsiStrings.AnsiStrIComp(S1, S2); -end; - -function AnsiStrLIComp(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; inline; -begin - Result := AnsiStrings.AnsiStrLIComp(S1, S2, MaxLen); -end; - -function AnsiStrPos(Str, SubStr: PAnsiChar): PAnsiChar; inline; -begin - Result := AnsiStrings.AnsiStrPos(Str, Substr); -end; - -function AnsiStrLComp(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; inline; -begin - Result := AnsiStrings.AnsiStrLComp(S1, S2, MaxLen); -end; - -function AnsiStrComp(S1, S2: PAnsiChar): Integer; inline; -begin - Result := AnsiStrings.AnsiStrComp(S1, S2); -end; - -function StrScan(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; inline; -begin - Result := AnsiStrings.StrScan(Str, Chr); -end; - -function TextToFloat(Buffer: PAnsiChar; var Value; ValueType: TFloatValue): Boolean; inline; -begin - Result := AnsiStrings.TextToFloat(Buffer, Value, ValueType); -end; - -function StrLComp(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; inline; -begin - Result := AnsiStrings.StrLComp(Str1, Str2, MaxLen); -end; - -function StrPLCopy(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar; inline; -begin - Result := AnsiStrings.StrPLCopy(Dest, Source, MaxLen); -end; - -function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; inline; -begin - Result := AnsiStrings.StrLCopy(Dest, Source, MaxLen); -end; - Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/dbf.pas 2013-08-15 15:59:07 UTC (rev 316) @@ -294,8 +294,15 @@ destructor Destroy; override; { abstract methods } + + {$ifdef SUPPORT_TVALUEBUFFER_VAR} + function GetFieldData(Field: TField; var Buffer: TDbfValueBuffer): Boolean; + {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract} + {$else SUPPORT_TVALUEBUFFER_VAR} function GetFieldData(Field: TField; Buffer: TDbfValueBuffer): Boolean; {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract} + {$endif SUPPORT_TVALUEBUFFER_VAR} + { virtual methods (mostly optionnal) } procedure Resync(Mode: TResyncMode); override; function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; {virtual} @@ -306,11 +313,16 @@ {$endif} {$ifdef SUPPORT_OVERLOAD} + {$ifdef SUPPORT_TVALUEBUFFER_VAR} + function GetFieldData(Field: TField; var Buffer: TDbfValueBuffer; NativeFormat: Boolean): Boolean; overload; + {$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif} + {$else SUPPORT_TVALUEBUFFER_VAR} function GetFieldData(Field: TField; Buffer: TDbfValueBuffer; NativeFormat: Boolean): Boolean; overload; {$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif} + {$endif SUPPORT_TVALUEBUFFER_VAR} procedure SetFieldData(Field: TField; Buffer: TDbfValueBuffer; NativeFormat: Boolean); overload; {$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif} -{$endif} +{$endif SUPPORT_OVERLOAD} function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; procedure CheckDbfFieldDefs(ADbfFieldDefs: TDbfFieldDefs); @@ -488,9 +500,7 @@ {$ifdef SUPPORT_SEPARATE_VARIANTS_UNIT} Variants, {$endif} -{$ifdef SUPPORT_ANSISTRINGS_UNIT} - AnsiStrings, -{$ENDIF} + dbf_AnsiStrings, dbf_idxcur, dbf_memo, dbf_str; @@ -502,10 +512,6 @@ SCircularDataLink = 'Circular datalinks are not allowed'; {$endif} -{$ifdef SUPPORT_ANSISTRINGS_UNIT} -{$include 'ansistrings.inc'} -{$endif} - function TableLevelToDbfVersion(TableLevel: integer): TXBaseVersion; begin case TableLevel of @@ -729,14 +735,22 @@ // ftBCD: // ftDateTime is more difficult though +{$ifdef SUPPORT_TVALUEBUFFER_VAR} +function TDbf.GetFieldData(Field: TField; var Buffer: TDbfValueBuffer): Boolean; {override virtual abstract from TDataset} +{$else SUPPORT_TVALUEBUFFER_VAR} function TDbf.GetFieldData(Field: TField; Buffer: TDbfValueBuffer): Boolean; {override virtual abstract from TDataset} +{$endif SUPPORT_TVALUEBUFFER_VAR} {$ifdef SUPPORT_OVERLOAD} begin { calling through 'old' delphi 3 interface, use compatible/'native' format } Result := GetFieldData(Field, Buffer, true); end; +{$ifdef SUPPORT_TVALUEBUFFER_VAR} +function TDbf.GetFieldData(Field: TField; var Buffer: TDbfValueBuffer; NativeFormat: Boolean): Boolean; {overload; override;} +{$else SUPPORT_TVALUEBUFFER_VAR} function TDbf.GetFieldData(Field: TField; Buffer: TDbfValueBuffer; NativeFormat: Boolean): Boolean; {overload; override;} +{$endif SUPPORT_TVALUEBUFFER_VAR} {$else} const { no overload => delphi 3 => use compatible/'native' format } @@ -2072,7 +2086,7 @@ begin Result := FOnTranslate(Self, Src, Dest, ToOem); if Result = -1 then - Result := StrLen(Dest); + Result := dbfStrLen(Dest); end else begin if FTranslationMode <> tmNoneNeeded then begin @@ -2758,7 +2772,7 @@ procedure TDbf.ExtractKey(KeyBuffer: PAnsiChar); begin if FIndexFile <> nil then - StrCopy(FIndexFile.ExtractKeyFromBuffer(GetCurrentBuffer), KeyBuffer) + dbfStrCopy(FIndexFile.ExtractKeyFromBuffer(GetCurrentBuffer), KeyBuffer) else KeyBuffer[0] := #0; end; Copied: trunk/src/dbf_ansistrings.pas (from rev 313, trunk/src/ansistrings.inc) =================================================================== --- trunk/src/dbf_ansistrings.pas (rev 0) +++ trunk/src/dbf_ansistrings.pas 2013-08-15 15:59:07 UTC (rev 316) @@ -0,0 +1,102 @@ +unit dbf_AnsiStrings; + +{$I dbf_common.inc} + +interface + +uses + SysUtils; + +type + TdbfStrLen = function(Str: PAnsiChar): integer; + TdbfStrCopy = function(Dest, Source: PAnsiChar): PAnsiChar; + TdbfStrLCopy = function(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; + TdbfFloatToText = function(BufferArg: PAnsiChar; const Value; ValueType: TFloatValue; + Format: TFloatFormat; Precision, Digits: Integer): Integer; + TdbfFloatToTextFmt = function(BufferArg: PAnsiChar; const Value; ValueType: TFloatValue; + Format: TFloatFormat; Precision, Digits: Integer; FormatSettings: TFormatSettings): Integer; + TdbfStrUpper = function(Str: PAnsiChar): PAnsiChar; + TdbfStrLower = function(Str: PAnsiChar): PAnsiChar; + TdbfStrIComp = function(S1, S2: PAnsiChar): Integer; + TdbfStrLIComp = function(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; + TdbfStrPos = function(Str, SubStr: PAnsiChar): PAnsiChar; + TdbfStrLComp = function(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer; + TdbfStrComp = function(S1, S2: PAnsiChar): Integer; + TdbfStrScan = function(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; + TdbfTextToFloatFmt = function(Buffer: PAnsiChar; var Value; ValueType: TFloatValue; FormatSettings: TFormatSettings): Boolean; + TdbfTextToFloat = function(Buffer: PAnsiChar; var Value; ValueType: TFloatValue): Boolean; + TdbfStrPLCopy = function(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar; + +var + dbfStrLen: TdbfStrLen = nil; + dbfStrCopy: TdbfStrCopy = nil; + dbfStrLCopy: TdbfStrLCopy = nil; + dbfFloatToText: TdbfFloatToText = nil; + dbfFloatToTextFmt: TdbfFloatToTextFmt = nil; + dbfStrUpper: TdbfStrUpper = nil; + dbfStrLower: TdbfStrLower = nil; + dbfStrIComp: TdbfStrIComp = nil; + dbfStrLIComp: TdbfStrLIComp = nil; + dbfStrPos: TdbfStrPos = nil; + dbfStrLComp: TdbfStrLComp = nil; + dbfStrComp: TdbfStrComp = nil; + dbfStrScan: TdbfStrScan = nil; + dbfTextToFloatFmt: TdbfTextToFloatFmt = nil; + dbfTextToFloat: TdbfTextToFloat = nil; + dbfStrPLCopy: TdbfStrPLCopy = nil; + +implementation + +{$IFDEF SUPPORT_ANSISTRINGS_UNIT} +uses + AnsiStrings; +{$ENDIF} + +{$IFDEF SUPPORT_ANSISTRINGS_UNIT} + +procedure Init; +begin + dbfStrLen := @AnsiStrings.StrLen; + dbfStrCopy := @AnsiStrings.StrCopy; + dbfStrLCopy := @AnsiStrings.StrLCopy; + dbfFloatToText := @AnsiStrings.FloatToText; + dbfFloatToTextFmt := @AnsiStrings.FloatToText; +// dbfStrUpper := @AnsiStrings.StrUpper; +// dbfStrLower := @AnsiStrings.StrLower; + dbfStrIComp := @AnsiStrings.StrIComp; +// dbfStrLIComp := @AnsiStrings.StrLIComp; +// dbfStrPos := @AnsiStrings.StrPos; + dbfStrLComp := @AnsiStrings.StrLComp; +// dbfStrComp := @AnsiStrings.StrComp; + dbfStrScan := @AnsiStrings.StrScan; + dbfTextToFloatFmt := @AnsiStrings.TextToFloat; + dbfTextToFloat := @AnsiStrings.TextToFloat; + dbfStrPLCopy := @AnsiStrings.StrPLCopy; +end; +{$ELSE} + +procedure Init; +begin + dbfStrLen := @SysUtils.StrLen; + dbfStrCopy := @SysUtils.StrCopy; + dbfStrLCopy := @SysUtils.StrLCopy; + dbfFloatToText := @SysUtils.FloatToText; + dbfFloatToTextFmt := @SysUtils.FloatToText; +// dbfStrUpper := @SysUtils.StrUpper; +// dbfStrLower := @SysUtils.StrLower; + dbfStrIComp := @SysUtils.StrIComp; +// dbfStrLIComp := @SysUtils.StrLIComp; +// dbfStrPos := @SysUtils.StrPos; + dbfStrLComp := @SysUtils.StrLComp; +// dbfStrComp := @SysUtils.StrComp; + dbfStrScan := @SysUtils.StrScan; + dbfTextToFloatFmt := @SysUtils.TextToFloat; + dbfTextToFloat := @SysUtils.TextToFloat; + dbfStrPLCopy := @SysUtils.StrPLCopy; +end; +{$ENDIF} + +initialization + Init; +end. + Modified: trunk/src/dbf_common.inc =================================================================== --- trunk/src/dbf_common.inc 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/dbf_common.inc 2013-08-15 15:59:07 UTC (rev 316) @@ -322,6 +322,7 @@ {$ifdef Delphi_XE} {$define SUPPORT_FORMATSETTINGS} + {$define SUPPORT_FORMATSETTINGS_CREATE} {$endif} {$ifdef DELPHI_XE3} @@ -332,6 +333,7 @@ {$ifdef DELPHI_XE4} {$define SUPPORT_TRECBUF} {$define SUPPORT_ANSISTRINGS_UNIT} + {$define SUPPORT_TVALUEBUFFER_VAR} {$endif} //------------------------------------------------------ Modified: trunk/src/dbf_common.pas =================================================================== --- trunk/src/dbf_common.pas 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/dbf_common.pas 2013-08-15 15:59:07 UTC (rev 316) @@ -172,22 +172,13 @@ {$ifdef MSWINDOWS} uses -{$ifdef SUPPORT_ANSISTRINGS_UNIT} - AnsiStrings, -{$ENDIF} + dbf_AnsiStrings, Windows; {$else} -{$ifdef SUPPORT_ANSISTRINGS_UNIT} uses - AnsiStrings; -{$ENDIF} + dbf_AnsiStrings; {$endif} -{$ifdef SUPPORT_ANSISTRINGS_UNIT} -{$include 'ansistrings.inc'} -{$endif} - - //==================================================================== function GetCompletePath(const Base, Path: string): string; @@ -546,7 +537,7 @@ wideBytes: Cardinal; begin if Length = -1 then - Length := StrLen(Src); + Length := dbfStrLen(Src); Result := Length; if (FromCP = GetOEMCP) and (ToCP = GetACP) then begin Modified: trunk/src/dbf_dbffile.pas =================================================================== --- trunk/src/dbf_dbffile.pas 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/dbf_dbffile.pas 2013-08-15 15:59:07 UTC (rev 316) @@ -199,19 +199,12 @@ {$ifdef SUPPORT_MATH_UNIT} Math, {$endif} -{$ifdef SUPPORT_ANSISTRINGS_UNIT} - AnsiStrings, -{$ENDIF} + dbf_AnsiStrings, dbf_str, dbf_lang, dbf_prssupp, dbf_prsdef; const sDBF_DEC_SEP = '.'; -{$ifdef SUPPORT_ANSISTRINGS_UNIT} -{$include 'ansistrings.inc'} -{$endif} - - {$I dbf_struct.inc} @@ -226,7 +219,7 @@ // we use them with this variable (initialized in the inialization section). // Otherwise the code is more complex. var - FORMAT_SETTIGS_DECIMAL_POINT: TFormatSettings; + FORMAT_SETTINGS_DECIMAL_POINT: TFormatSettings; {$endif SUPPORT_FORMATSETTINGSTYPE} @@ -240,7 +233,7 @@ endChar := (PAnsiChar(Src) + Size)^; (PAnsiChar(Src) + Size)^ := #0; // convert to double - if TextToFloat(PAnsiChar(Src), eValue, fvExtended, FORMAT_SETTIGS_DECIMAL_POINT) then + if dbfTextToFloatFmt(PAnsiChar(Src), eValue, fvExtended, FORMAT_SETTINGS_DECIMAL_POINT) then Result := eValue else Result := 0; @@ -261,14 +254,14 @@ if DecimalSeparator <> sDBF_DEC_SEP then begin // search dec sep - iPos := StrScan(PAnsiChar(Src), AnsiChar(sDBF_DEC_SEP)); + iPos := dbfStrScan(Src, AnsiChar(sDBF_DEC_SEP)); // replace if iPos <> nil then iPos^ := AnsiChar(DecimalSeparator); end else iPos := nil; // convert to double - if TextToFloat(PAnsiChar(Src), eValue {$ifndef VER1_0}, fvExtended{$endif}) then + if dbfTextToFloat(Src, eValue {$ifndef VER1_0}, fvExtended{$endif}) then Result := eValue else Result := 0; @@ -288,7 +281,7 @@ s : AnsiString; resLen: Integer; begin - resLen := FloatToText(@Buffer, Val, fvExtended, ffFixed, Size, Precision, FORMAT_SETTIGS_DECIMAL_POINT); + resLen := dbfFloatToTextFmt(PAnsiChar(@Buffer), Val, fvExtended, ffFixed, Size, Precision, FORMAT_SETTINGS_DECIMAL_POINT); SetString(s, PChar(@Buffer), resLen); B := PAnsiChar(s); @@ -306,7 +299,7 @@ resLen: Integer; begin // convert to temporary buffer - resLen := FloatToText(PWideChar(@Buffer[0]), Val, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, Size, Precision); + resLen := dbfFloatToText(PWideChar(@Buffer[0]), Val, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, Size, Precision); // prevent overflow in destination buffer if resLen > Size then resLen := Size; @@ -315,7 +308,7 @@ // we only have to convert if decimal separator different if DecimalSeparator <> sDBF_DEC_SEP then begin - iPos := StrScan(@Buffer[0], AnsiChar(DecimalSeparator)); + iPos := dbfStrScan(PAnsiChar(@Buffer[0]), AnsiChar(DecimalSeparator)); if iPos <> nil then iPos^ := sDBF_DEC_SEP; end; @@ -471,10 +464,10 @@ // 'FOX..WIN' -> Charset 1252 (ansi) if (LangStr[0] = 'D') and (LangStr[1] = 'B') then begin - if StrLComp(LangStr+2, 'WIN', 3) = 0 then + if dbfStrLComp(LangStr+2, 'WIN', 3) = 0 then FFileCodePage := 1252 else - if StrLComp(LangStr+2, 'HEBREW', 6) = 0 then + if dbfStrLComp(LangStr+2, 'HEBREW', 6) = 0 then begin FFileCodePage := 1255; end else begin @@ -483,9 +476,9 @@ FFileCodePage := FFileCodePage * 10 + Ord(LangStr[5]) - Ord('0'); end; end else - if StrLComp(LangStr, 'FOX', 3) = 0 then + if dbfStrLComp(LangStr, 'FOX', 3) = 0 then begin - if StrLComp(LangStr+5, 'WIN', 3) = 0 then + if dbfStrLComp(LangStr+5, 'WIN', 3) = 0 then FFileCodePage := 1252 else FFileCodePage := GetIntFromStrLength(LangStr+5, 3, 0) @@ -664,7 +657,7 @@ FillChar(Header^, HeaderSize, #0); PDbfHdr(Header)^.VerDBF := $04; // write language string - StrPLCopy( + dbfStrPLCopy( @PAfterHdrVII(PAnsiChar(Header)+SizeOf(rDbfHdr))^.LanguageDriverName[32], // Was PChar!!! ConstructLangName(FFileCodePage, lLocaleID, false), 63-32); @@ -726,7 +719,7 @@ if FDbfVersion = xBaseVII then begin FillChar(lFieldDescVII, SizeOf(lFieldDescVII), #0); - StrPLCopy(lFieldDescVII.FieldName, lFieldDef.FieldName, SizeOf(lFieldDescVII.FieldName)-1); + dbfStrPLCopy(lFieldDescVII.FieldName, lFieldDef.FieldName, SizeOf(lFieldDescVII.FieldName)-1); lFieldDescVII.FieldType := lFieldDef.NativeFieldType; lFieldDescVII.FieldSize := lSize; lFieldDescVII.FieldPrecision := lPrec; @@ -734,7 +727,7 @@ //lFieldDescVII.MDXFlag := ??? end else begin FillChar(lFieldDescIII, SizeOf(lFieldDescIII), #0); - StrPLCopy(lFieldDescIII.FieldName, lFieldDef.FieldName, SizeOf(lFieldDescIII.FieldName)-1); + dbfStrPLCopy(lFieldDescIII.FieldName, lFieldDef.FieldName, SizeOf(lFieldDescIII.FieldName)-1); lFieldDescIII.FieldType := lFieldDef.NativeFieldType; lFieldDescIII.FieldSize := lSize; lFieldDescIII.FieldPrecision := lPrec; @@ -1722,7 +1715,7 @@ SaveDateToDst; end; ftString: - StrLCopy(PAnsiChar(Dst), PAnsiChar(Src), FieldSize); + dbfStrLCopy(PAnsiChar(Dst), PAnsiChar(Src), FieldSize); end else begin case DataType of ftString: @@ -1960,7 +1953,7 @@ ftString: begin // copy data - Len := StrLen(PAnsiChar(Src)); + Len := dbfStrLen(PAnsiChar(Src)); if Len > FieldSize then Len := FieldSize; Move(Src^, Dst^, Len); @@ -2761,7 +2754,7 @@ {$IFDEF WINAPI_IS_UNICODE} TempCodePageList.Add(Pointer(StrToIntDef(string(CodePageString), -1))); // Avoid conversion to AnsiString {$ELSE} - TempCodePageList.Add(Pointer(GetIntFromStrLength(CodePageString, StrLen(CodePageString), -1))); + TempCodePageList.Add(Pointer(GetIntFromStrLength(CodePageString, dbfStrLen(CodePageString), -1))); {$ENDIF} // continue enumeration @@ -2832,20 +2825,23 @@ Result := FCodePages.IndexOf(Pointer(ACodePage)) >= 0; end; +{$ifdef SUPPORT_FORMATSETTINGSTYPE} function GetUserDefaultLocaleSettings: TFormatSettings; begin -{$IFDEF RTL220_UP} - Result := TFormatSettings.Create(GetUserDefaultLCID); -{$ELSE} +{$ifdef SUPPORT_FORMATSETTINGS_CREATE} + Result := TFormatSettings.Create(''); +{$else} +// Result := TFormatSettings.Create(GetUserDefaultLCID); GetLocaleFormatSettings(GetUserDefaultLCID, Result); -{$ENDIF} +{$endif} end; +{$endif SUPPORT_FORMATSETTINGSTYPE} initialization {$ifdef SUPPORT_FORMATSETTINGSTYPE} - FORMAT_SETTIGS_DECIMAL_POINT := GetUserDefaultLocaleSettings; - FORMAT_SETTIGS_DECIMAL_POINT.DecimalSeparator := '.'; - FORMAT_SETTIGS_DECIMAL_POINT.ThousandSeparator := #0; + FORMAT_SETTINGS_DECIMAL_POINT := GetUserDefaultLocaleSettings; + FORMAT_SETTINGS_DECIMAL_POINT.DecimalSeparator := '.'; + FORMAT_SETTINGS_DECIMAL_POINT.ThousandSeparator := #0; {$endif SUPPORT_FORMATSETTINGSTYPE} finalization FreeAndNil(DbfGlobals); Modified: trunk/src/dbf_idxcur.pas =================================================================== --- trunk/src/dbf_idxcur.pas 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/dbf_idxcur.pas 2013-08-15 15:59:07 UTC (rev 316) @@ -55,15 +55,9 @@ //==================================================================== implementation -{$ifdef SUPPORT_ANSISTRINGS_UNIT} uses - AnsiStrings; -{$ENDIF} + dbf_AnsiStrings; -{$ifdef SUPPORT_ANSISTRINGS_UNIT} -{$include 'ansistrings.inc'} -{$endif} - //========================================================== //============ TIndexCursor //========================================================== @@ -152,9 +146,9 @@ end; Result := etInteger; end else begin - StrPLCopy(ABuffer, AnsiString(Key), TIndexFile(PagedFile).KeyLen); // PChar cast removed, AnsiString cast added + dbfStrPLCopy(ABuffer, AnsiString(Key), TIndexFile(PagedFile).KeyLen); // PChar cast removed, AnsiString cast added // we have null-terminated string, pad with spaces if string too short - currLen := StrLen(ABuffer); + currLen := dbfStrLen(ABuffer); FillChar(ABuffer[currLen], TIndexFile(PagedFile).KeyLen-currLen, ' '); Result := etString; end; @@ -174,7 +168,7 @@ // nothing needs to be done end else begin // check if string long enough then no copying needed - userLen := StrLen(Key); + userLen := dbfStrLen(Key); keyLen := TIndexFile(PagedFile).KeyLen; if userLen < keyLen then begin Modified: trunk/src/dbf_idxfile.pas =================================================================== --- trunk/src/dbf_idxfile.pas 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/dbf_idxfile.pas 2013-08-15 15:59:07 UTC (rev 316) @@ -405,19 +405,13 @@ implementation uses -{$ifdef SUPPORT_ANSISTRINGS_UNIT} - AnsiStrings, -{$ENDIF} + dbf_AnsiStrings, dbf_dbffile, dbf_fields, dbf_str, dbf_prssupp, dbf_lang; -{$ifdef SUPPORT_ANSISTRINGS_UNIT} -{$include 'ansistrings.inc'} -{$endif} - const RecBOF = 0; RecEOF = MaxInt; @@ -1602,7 +1596,7 @@ procedure TMdx4Tag.SetTagName(NewName: string); begin - StrPLCopy(PMdx4Tag(Tag)^.TagName, AnsiString(NewName), 10); // Was PChar, AnsiString cast added + dbfStrPLCopy(PMdx4Tag(Tag)^.TagName, AnsiString(NewName), 10); // Was PChar, AnsiString cast added PMdx4Tag(Tag)^.TagName[10] := #0; end; @@ -1687,7 +1681,7 @@ procedure TMdx7Tag.SetTagName(NewName: string); begin - StrPLCopy(PMdx7Tag(Tag)^.TagName, AnsiString(NewName), 10); // was PChar, AnsiString cast added + dbfStrPLCopy(PMdx7Tag(Tag)^.TagName, AnsiString(NewName), 10); // was PChar, AnsiString cast added PMdx7Tag(Tag)^.TagName[32] := #0; end; @@ -1735,7 +1729,7 @@ GetMem(TempBuffer, TDbfFile(DbfFile).RecordSize); try TDbfFile(DbfFile).InitRecord(TempBuffer); - FResultLen := StrLen(ExtractFromBuffer(TempBuffer)); + FResultLen := dbfStrLen(ExtractFromBuffer(TempBuffer)); finally FreeMem(TempBuffer); end; @@ -2264,7 +2258,7 @@ PIndexHdr(FIndexHeader)^.KeyLen := SwapWordLE(8); CalcKeyProperties; // key desc - StrPLCopy(PIndexHdr(FIndexHeader)^.KeyDesc, AnsiString(FieldDesc), 219); // Was PChar, AnsiString cast added + dbfStrPLCopy(PIndexHdr(FIndexHeader)^.KeyDesc, AnsiString(FieldDesc), 219); // Was PChar, AnsiString cast added PIndexHdr(FIndexHeader)^.KeyDesc[219] := #0; // init various @@ -2938,7 +2932,7 @@ ExtValue := PDouble(Result)^; FloatToDecimal(FloatRec, ExtValue, {$ifndef FPC_VERSION}fvExtended,{$endif} 9999, 15); if ExtValue <> 0.0 then - NumDecimals := StrLen(PAnsiChar(@FloatRec.Digits[0])) + NumDecimals := dbfStrLen(PAnsiChar(@FloatRec.Digits[0])) else NumDecimals := 0; // maximum number of decimals possible to encode in BCD is 16 Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/dbf_prscore.pas 2013-08-15 15:59:07 UTC (rev 316) @@ -249,15 +249,9 @@ implementation -{$ifdef SUPPORT_ANSISTRINGS_UNIT} uses - AnsiStrings; -{$ENDIF} + dbf_AnsiStrings; -{$ifdef SUPPORT_ANSISTRINGS_UNIT} -{$include 'ansistrings.inc'} -{$endif} - procedure LinkVariable(ExprRec: PExpressionRec); begin ///with ExprRec^ do @@ -1285,7 +1279,7 @@ // convert to string Param^.Res.AssureSpace(width); extVal := PDouble(Param^.Args[0])^; - resWidth := FloatToText(Param^.Res.MemoryPos^, extVal, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, 18, numDigits); + resWidth := dbfFloatToText(Param^.Res.MemoryPos^, extVal, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, 18, numDigits); // always use dot as decimal separator if numDigits > 0 then Param^.Res.MemoryPos^[resWidth-numDigits-1] := '.'; @@ -1382,7 +1376,7 @@ var srcLen, index, count: Integer; begin - srcLen := StrLen(Param^.Args[0]); + srcLen := dbfStrLen(Param^.Args[0]); index := PInteger(Param^.Args[1])^ - 1; if Param^.Args[2] <> nil then begin @@ -1398,7 +1392,7 @@ var srcLen, index, count: Integer; begin - srcLen := StrLen(Param^.Args[0]); + srcLen := dbfStrLen(Param^.Args[0]); index := 0; count := PInteger(Param^.Args[1])^; if index + count > srcLen then @@ -1413,7 +1407,7 @@ begin // first copy Arg0 := Param^.Args[0]; - Len := StrLen(Arg0); + Len := dbfStrLen(Arg0); Param^.Res.Append(Arg0, Len); // Append may have reallocated memory, // but correct for "Inc(FMemoryPos^, Length);" @@ -1430,7 +1424,7 @@ begin // first copy Arg0 := Param^.Args[0]; - Len := StrLen(Arg0); + Len := dbfStrLen(Arg0); Param^.Res.Append(Arg0, Len); // Append may have reallocated memory, // but correct for "Inc(FMemoryPos^, Length);" @@ -1647,7 +1641,7 @@ match: boolean; str0, str1: AnsiString; // Was string begin - arg1len := StrLen(Param^.Args[1]); + arg1len := dbfStrLen(Param^.Args[1]); if Param^.Args[1][0] = '*' then begin if Param^.Args[1][arg1len-1] = '*' then @@ -1657,7 +1651,7 @@ setlength(str1, arg1len-2); match := Pos(str1, str0)>0; // Was AnsiPos(str0, str1) = 0 end else begin - arg0len := StrLen(Param^.Args[0]); + arg0len := dbfStrLen(Param^.Args[0]); // at least length without asterisk match := arg0len >= arg1len - 1; if match then @@ -1666,7 +1660,7 @@ end else if Param^.Args[1][arg1len-1] = '*' then begin - arg0len := StrLen(Param^.Args[0]); + arg0len := dbfStrLen(Param^.Args[0]); match := arg0len >= arg1len - 1; if match then match := AnsiStrLIComp(Param^.Args[0], Param^.Args[1], arg1len-1) = 0; @@ -1706,7 +1700,7 @@ arg0len, arg1len: integer; match: boolean; begin - arg1len := StrLen(Param^.Args[1]); + arg1len := dbfStrLen(Param^.Args[1]); if Param^.Args[1][0] = '*' then begin if Param^.Args[1][arg1len-1] = '*' then @@ -1715,7 +1709,7 @@ match := AnsiStrPos(Param^.Args[0], Param^.Args[1]+1) <> nil; Param^.Args[1][arg1len-1] := '*'; end else begin - arg0len := StrLen(Param^.Args[0]); + arg0len := dbfStrLen(Param^.Args[0]); // at least length without asterisk match := arg0len >= arg1len - 1; if match then @@ -1724,7 +1718,7 @@ end else if Param^.Args[1][arg1len-1] = '*' then begin - arg0len := StrLen(Param^.Args[0]); + arg0len := dbfStrLen(Param^.Args[0]); match := arg0len >= arg1len - 1; if match then match := AnsiStrLComp(Param^.Args[0], Param^.Args[1], arg1len-1) = 0; @@ -1761,7 +1755,7 @@ procedure FuncStr_GTE(Param: PExpressionRec); begin - Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrComp(Param^.Args[0], Param^.Args[1]) >= 0); // Was Char + Param^.Res.MemoryPos^^ := AnsiChar(dbfStrComp(Param^.Args[0], Param^.Args[1]) >= 0); // Was Char end; procedure Func_FF_EQ(Param: PExpressionRec); Modified: trunk/src/dbf_prsdef.pas =================================================================== --- trunk/src/dbf_prsdef.pas 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/dbf_prsdef.pas 2013-08-15 15:59:07 UTC (rev 316) @@ -354,15 +354,9 @@ implementation -{$ifdef SUPPORT_ANSISTRINGS_UNIT} uses - AnsiStrings; -{$endif} + dbf_AnsiStrings; -{$ifdef SUPPORT_ANSISTRINGS_UNIT} -{$include 'ansistrings.inc'} -{$endif} - function ExprCharToExprType(ExprChar: Char): TExpressionType; begin case ExprChar of @@ -392,7 +386,7 @@ procedure _StringConstant(Param: PExpressionRec); begin with Param^ do - Res.Append(Args[0], StrLen(Args[0])); + Res.Append(Args[0], dbfStrLen(Args[0])); end; procedure _StringVariable(Param: PExpressionRec); @@ -404,7 +398,7 @@ else length := -1; if length = -1 then - length := StrLen(PPAnsiChar(Param^.Args[0])^); // Was PPChar + length := dbfStrLen(PPAnsiChar(Param^.Args[0])^); // Was PPChar Param^.Res.Append(PPAnsiChar(Param^.Args[0])^, length); // Was PPChar end; Modified: trunk/src/dbf_wtil.pas =================================================================== --- trunk/src/dbf_wtil.pas 2013-08-07 13:09:35 UTC (rev 315) +++ trunk/src/dbf_wtil.pas 2013-08-15 15:59:07 UTC (rev 316) @@ -577,21 +577,21 @@ function OemToChar(lpszSrc: PAnsiChar; lpszDst: PAnsiChar): BOOL; begin if lpszDst <> lpszSrc then - StrCopy(lpszDst, lpszSrc); + dbfStrCopy(lpszDst, lpszSrc); Result := true; end; function CharToOem(lpszSrc: PAnsiChar; lpszDst: PAnsiChar): BOOL; begin if lpszDst <> lpszSrc then - StrCopy(lpszDst, lpszSrc); + dbfStrCopy(lpszDst, lpszSrc); Result := true; end; function OemToCharBuff(lpszSrc: PAnsiChar; lpszDst: PAnsiChar; cchDstLength: DWORD): BOOL; begin if lpszDst <> lpszSrc then - StrLCopy(lpszDst, lpszSrc, cchDstLength); + dbfStrLCopy(lpszDst, lpszSrc, cchDstLength); {$ifdef HUNGARIAN} OemHunHun(lpszDst, cchDstLength); {$endif} @@ -601,7 +601,7 @@ function CharToOemBuff(lpszSrc: PAnsiChar; lpszDst: PAnsiChar; cchDstLength: DWORD): BOOL; begin if lpszDst <> lpszSrc then - StrLCopy(lpszDst, lpszSrc, cchDstLength); + dbfStrLCopy(lpszDst, lpszSrc, cchDstLength); {$ifdef HUNGARIAN} AnsiHunHun(lpszDst, cchDstLength); {$endif} @@ -632,7 +632,7 @@ function CompareString(Locale: LCID; dwCmpFlags: DWORD; lpString1: PAnsiChar; cchCount1: Integer; lpString2: PAnsiChar; cchCount2: Integer): Integer; begin - Result := StrLComp(lpString1, lpString2, cchCount1) + 2; + Result := dbfStrLComp(lpString1, lpString2, cchCount1) + 2; if Result > 2 then Result := 3; if Result < 2 then Result := 1; end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <tw...@us...> - 2014-07-13 18:43:06
|
Revision: 326 http://sourceforge.net/p/tdbf/code/326 Author: twm Date: 2014-07-13 18:43:03 +0000 (Sun, 13 Jul 2014) Log Message: ----------- added support for unary negative operators (taken from Lazarus version) Modified Paths: -------------- trunk/src/dbf_prscore.pas trunk/src/dbf_prsdef.pas Property Changed: ---------------- trunk/packages/DelphiXE6/ Index: trunk/packages/DelphiXE6 =================================================================== --- trunk/packages/DelphiXE6 2014-07-13 18:27:04 UTC (rev 325) +++ trunk/packages/DelphiXE6 2014-07-13 18:43:03 UTC (rev 326) Property changes on: trunk/packages/DelphiXE6 ___________________________________________________________________ Added: svn:ignore ## -0,0 +1 ## +tdbfXE6_prjgroup.tvsconfig Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2014-07-13 18:27:04 UTC (rev 325) +++ trunk/src/dbf_prscore.pas 2014-07-13 18:43:03 UTC (rev 326) @@ -124,6 +124,11 @@ procedure FuncDateToStr(Param: PExpressionRec); procedure FuncSubString(Param: PExpressionRec); procedure FuncUppercase(Param: PExpressionRec); +procedure FuncNegative_F_F(Param: PExpressionRec); +procedure FuncNegative_I_I(Param: PExpressionRec); +{$ifdef SUPPORT_INT64} +procedure FuncNegative_L_L(Param: PExpressionRec); +{$endif} procedure FuncLowercase(Param: PExpressionRec); procedure FuncAdd_F_FF(Param: PExpressionRec); procedure FuncAdd_F_FI(Param: PExpressionRec); @@ -492,6 +497,10 @@ case ResultType of etBoolean: ExprWord := TBooleanConstant.Create(EmptyStr, PBoolean(FExpResult)^); etFloat: ExprWord := TFloatConstant.CreateAsDouble(EmptyStr, PDouble(FExpResult)^); + etInteger: ExprWord := TIntegerConstant.Create(PInteger(FExpResult)^); +{$ifdef SUPPORT_INT64} + etLargeInt:ExprWord := TLargeIntConstant.Create(PInt64(FExpResult)^); +{$endif} etString: ExprWord := TStringConstant.Create(string(FExpResult)); // Added string cast end; @@ -1434,6 +1443,26 @@ dbfStrLower(Arg0); end; +procedure FuncNegative_F_F(Param: PExpressionRec); +begin + with Param^ do + PDouble(Res.MemoryPos^)^ := -PDouble(Args[0])^; +end; + +procedure FuncNegative_I_I(Param: PExpressionRec); +begin + with Param^ do + PInteger(Res.MemoryPos^)^ := -PInteger(Args[0])^; +end; + +{$ifdef SUPPORT_INT64} +procedure FuncNegative_L_L(Param: PExpressionRec); +begin + with Param^ do + PInt64(Res.MemoryPos^)^ := -PInt64(Args[0])^; +end; +{$endif} + procedure FuncAdd_F_FF(Param: PExpressionRec); begin PDouble(Param^.Res.MemoryPos^)^ := PDouble(Param^.Args[0])^ + PDouble(Param^.Args[1])^; @@ -2065,6 +2094,11 @@ Add(TComma.Create(',', nil)); // operators - name, param types, result type, func addr, precedence + Add(TFunction.CreateOper('-@', 'I', etInteger, FuncNegative_I_I, 20)); + Add(TFunction.CreateOper('-@', 'F', etFloat, FuncNegative_F_F, 20)); +{$ifdef SUPPORT_INT64} + Add(TFunction.CreateOper('-@', 'L', etLargeInt, FuncNegative_L_L, 20)); +{$endif} Add(TFunction.CreateOper('+', 'SS', etString, nil, 40)); Add(TFunction.CreateOper('+', 'FF', etFloat, FuncAdd_F_FF, 40)); Add(TFunction.CreateOper('+', 'FI', etFloat, FuncAdd_F_FI, 40)); Modified: trunk/src/dbf_prsdef.pas =================================================================== --- trunk/src/dbf_prsdef.pas 2014-07-13 18:27:04 UTC (rev 325) +++ trunk/src/dbf_prsdef.pas 2014-07-13 18:43:03 UTC (rev 326) @@ -205,6 +205,17 @@ function AsPointer: PAnsiChar; override; // Was PChar end; +{$ifdef SUPPORT_INT64} + TLargeIntConstant = class(TConstant) + private + FValue: Int64; + public + constructor Create(AValue: Int64); + + function AsPointer: PAnsiChar; override; + end; +{$endif} + TBooleanConstant = class(TConstant) private FValue: Boolean; @@ -640,6 +651,22 @@ Result := PAnsiChar(@FValue); // Was PChar end; +{$ifdef SUPPORT_INT64} +{ TLargeIntConstant } + +constructor TLargeIntConstant.Create(AValue: Int64); +begin + inherited Create(IntToStr(AValue), etLargeInt, _LargeIntVariable); + + FValue := AValue; +end; + +function TLargeIntConstant.AsPointer: PAnsiChar; +begin + Result := PAnsiChar(@FValue); +end; +{$endif} + { TVariable } constructor TVariable.Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <na...@us...> - 2015-08-06 15:13:26
|
Revision: 515 http://sourceforge.net/p/tdbf/code/515 Author: nashev Date: 2015-08-06 15:13:22 +0000 (Thu, 06 Aug 2015) Log Message: ----------- Merged revision(s) 330-514 from branches/paulenandrew: Change version to 6.9.2 ........ fix compiler errors in dbf_ansistrings for Free Pascal ........ fix compiler errors in dbf_dbffile for Free Pascal ........ expose TIndexFile.CompareKeys in TDbf.CompareKeys ........ change TDbf.ExtractKey to extract key from index instead of evaluate it from record buffer ........ prevent Access Violation in TDbf.IsDeleted if $booleval is on ........ prevent Access Violation in TDbf.IsDeleted if $booleval is on ........ use fmShareExclusive in exclusive create/open mode ........ only lock a record if the table is shared ........ fix memo file not being maintained correctly if block size is not the default of 1024 ........ fix exception inserting into index leaving page locked ........ update references to record number when inserting a record ........ when setting IndexName, do not resync index unless it changed ........ fix error when opening a table leaving it in an intermediate state ........ changed the default TableLevel from 4 to 5, supports a much larger record size and is otherwise almost identical ........ maintain record number order within index entries with the same key ........ update FCachedSize when adding backlink to FoxPro file ........ Add "Invalid MDX file." error message (and translations) ........ Add "Invalid MDX file." error message (and translations) ........ ensure consistent behaviour when normalizing index name ........ do not assume MDX page size is 1024 or block size is 512 ........ fix memory leak if error opening an index ........ preserve deleted flag in TDbf.CopyFrom ........ if a memo field is set to an empty value, clear the reference so that it is null (consistent with BDE) ........ Add support for SetKey, GotoKey and GotoNearest ........ Maintain IndexDefs when DeleteIndex is used to delete an index ........ Add support for @, O, I and + dBASE 7 index key types and I and + FoxPro index key types ........ Add support for @, O, I and + dBASE 7 index key types and I and + FoxPro index key types ........ Add support for @, O, I and + dBASE 7 index key types and I and + FoxPro index key types ........ preserve autoincrement field values in TDbf.CopyFrom ........ limit index name length in header to 8 (compatibility with BDE) ........ if TagsUsed is more than 47 tags in an index file, raise "Invalid MDX file." exception ........ fix record buffer corruption if there is an error parsing the value of an F (Float), N (Numeric) or O (Double) field ........ use record packing for index file declarations ........ add support for up to 47 indexes, fix errors if an index file has more than 34 indexes ........ use correct tag size when clearing level 7 indexes ........ if size of tags in index file is too large, raise "Invalid MDX file." exception ........ fix potential Range Check Error when deleting an entry from an index ........ maintain linked list in tag table (compatibility with BDE and other engines) ........ fix Zap leaving cached data in the file ........ fix copying of memo file data when restructuring ........ open FoxPro MDX index file (FoxPro CDX index file still not supported) ........ create FoxPro DBF file with VerDBF = $30 ($02 is not compatible with BDE or Visual FoxPro 6.0) ........ fix access is denied error trying to write corrections to the DBF header when opening read only ........ fix ordering of floating point numeric index ........ ensure GetCanModify returns False if table is not Active ........ fix Division by zero error if index file block size is 0, raise "Invalid MDX. file" exception ........ fix record count in DBF header (was not working as intended) ........ add support for files larger than 4 GB (requires compiler to support Int64) ........ add support for building/maintaining Date (D) index ........ fix calculation of tag offset in index file ........ fix access violation closing a table that is locked without explicitly unlocking ........ use and recognize NUL instead of space to fill empty level 7 Character (C) fields, but not level 7 C index keys (consistent with BDE) ........ fix index key violation error handling ........ preserve cursor if GetRecord finds no record ........ fix index file key length error handling, raise "Invalid MDX file." exception ........ fix Integer overflow errors if more than 2,147,483,648 entries in an index file (requires compiler to support Int64) ........ use and recognize NUL instead of space to fill empty level 7 Character (C) fields, but not level 7 C index keys (consistent with BDE) ........ Add support for @, O, I and + dBASE 7 index key types and I and + FoxPro index key types ........ fix inaccurate floating point values in numeric index ........ consistently use EParserException for parser error ........ fix error handling if invalid record number in index ........ recalculate key length when rebuilding an index, to correct it if necessary ........ implement DeleteMdxFile to delete MDX index file and clear MDX flag, implement DeleteIndexFile to delete index file ........ consistently use EDbfIndexError for index error ........ add OnIndexInvalidEvent - set Handled to continue anyway, DeleteLink to clear MDX flag ........ fix problems if index key length does not match parser result length ........ fix error handling updating an index ........ fix potential access violation if TDBF_INDEX_CHECK is defined ........ fix problems maintaining an index if leaf nodes are not on the same level (though they should be), raise "Invalid MDX file." exception ........ fix problems if index key length does not match parser result length ........ fix error handling of out of range value in index page ........ fix error handling and potential access violation when there is an index key violation ........ fix error handling in parser if too many arguments/operands ........ fix sporadic access violation and other errors when creating/destroying a table in a multi-threaded application (fixes bug #68) ........ fix writing of EOF terminator when inserting a record (fixes bug #58) ........ fix incorrect parser linked list ........ if there is a file read/write error, raise an exception ........ if there is a file read/write error, raise an exception ........ Change index locking algorithm to avoid resyncs, achieves much better performance (consistent with BDE) ........ Change index locking algorithm to avoid resyncs, achieves much better performance (consistent with BDE) ........ Change index locking algorithm to avoid resyncs, achieves much better performance (consistent with BDE) ........ if there is a file read/write error, raise an exception ........ Use BufferAhead and DisableResyncOnPost by default when table is exclusive or write locked, achieves much better performance ........ Use dynamic buffer size, achieves much better performance with both random and sequential access (performance comparable to BDE) ........ Re-read current record if table is shared, under limited conditions so that performance is not affected (similar to BDE) ........ add OnProgress event to report the progress of long-running functions and allow cancellation, used when copying and restructuring (similar to BDE) ........ if there is a file read/write error, raise an exception ........ add OnProgress event to report the progress of long-running functions and allow cancellation, used when copying and restructuring (similar to BDE) ........ add missing message translations (fr, ita, nl, pl, ru) ........ add missing message translations (fr, ita, nl, pl, ru) ........ include deleted records in distinct index (compatible with BDE) ........ build index using partial bulkloading, achieves much better performance (comparable to BDE) ........ build index using partial bulkloading, achieves much better performance (comparable to BDE) ........ build index using partial bulkloading, achieves much better performance (comparable to BDE) ........ add support for files larger than 4 GB (requires compiler to support Int64) ........ change index locking algorithm to avoid resyncs, achieves much better performance (consistent with BDE) ........ add OnProgress event to report the progress of long-running functions and allow cancellation, used when copying and restructuring (similar to BDE) ........ fix record and table locking algorithm - when table is locked, can edit a record anyway and adding a record causes it to hang (also compatible with BDE) ........ use dynamic buffer size, achieves much better performance with both random and sequential access (performance similar to BDE) ........ add more robust Numeric (N) and Float (F) field value translation - prevents potential access violation, supports exponential notation for integers (also compatible with BDE) ........ fix error handling updating an index ........ fix error handling updating an index (revert) ........ add more robust error handling for invalid index header, page or entry ........ ensure consistent behaviour when normalizing index name ........ add TDbf.BatchMove method (similar to BDE batch move) ........ add support for SetKey, GotoKey and GotoNearest ........ add support for SetKey, GotoKey and GotoNearest ........ fully support TableLevel 5 ........ prevent Access Violation in TDbf.IsDeleted and TDbf.Undelete if table is closed and $booleval is on ........ if there is no active record, preventing it from reading the table twice (forwards then backwards) ........ add OnProgress event to report the progress of long-running functions and allow cancellation, used when copying and restructuring (similar to BDE) ........ do not use OnIndexMissing with a FoxPro table ........ do not use OnIndexMissing with a FoxPro table ........ fix error handling updating an index ........ add more robust Numeric (N) and Float (F) field value translation - prevents potential access violation, supports exponential notation for integers (also compatible with BDE) ........ ensure consistent behaviour when normalizing index name ........ do not convert index expression to upper case ........ fix error handling updating an index ........ treat level 7 null value the same as an empty value when comparing Character (C) index keys (consistent with BDE) ........ add SoundEx() function ........ Packages for Delphi XE7 ........ Packages for Delphi XE8 ........ * Bugfix: function GetFieldType of TDateTimeFieldVar and TBooleanFieldVar is now declared protected (was private) * ParseExpression parameter is now declared const ........ GetFieldInfo parameter is now const ........ if cond. define TDBF_IGNORE_INVALID_INDICES is given, ignore invalid index files so we can still open dbf files even if the index files are broken (patch by DS) ........ If cond. define TDBF_INDEX_NO_RESYNC is set, indices are not synced to the file on disk. This results in tremendous speed improvements if you access the tables read only. Don't enable this for read write access because it can corrupt the data. (Patch by DS) ........ oops, forgot these two changes for the following to actually compile and work: if cond. define TDBF_IGNORE_INVALID_INDICES is given, ignore invalid index files so we can still open dbf files even if the index files are broken (patch by DS) ........ add more robust Str() function to parser ........ add more robust Str() function to parser ........ add concept of null value to parser, use it to implement DTOS(null) = null instead of "18991230" ........ make third parameter optional in SubStr() ........ evaluate operators with equal precedence from left to right ........ add Empty() function to parser ........ add Proper() function to parser ........ add Val() function to parser ........ add Proper() function to parser ........ add Chr() function to parser ........ add LTrim(), RTrim() and Trim() functions to parser ........ add Asc() function to parser ........ add Right() function to parser ........ add Abs() function to parser ........ add CDOW(), Day(), Month(), Year() functions to parser ........ add Len() function to parser ........ add IIF() function to parser ........ Add Date() function to parser ........ add Ceil(), Ceiling(), Round() functions to parser ........ fix index parser to be case sensitive ........ add RecNo() function to parser ........ add RecNo() function to parser ........ add RecNo() function to parser ........ add concept of null value to parser, use it to implement DTOS(null) = null instead of "18991230" ........ make native field information available in parser ........ make native field information available in parser ........ allow concatenating a string using the + or - binary operator only in an index expression ........ make native field information available in parser ........ add unary plus (+) operator to parser ........ add binary plus (+) operator for strings, dates ........ add binary minus (-) operator for strings, dates ........ fix sporadic access violation and other errors when creating/destroying a table in a multi-threaded application (fixes bug #68) ........ fix sporadic access violation and other errors when creating/destroying a table in a multi-threaded application (fixes bug #68) ........ if there is a file read/write error, raise an exception ........ add Proper() function to parser ........ fix sporadic access violation and other errors when creating/destroying a table in a multi-threaded application (fixes bug #68) ........ if there is a file read/write error, raise an exception ........ fix record and table locking algorithm - when table is locked, can edit a record anyway and adding a record causes it to hang (also compatible with BDE) ........ build index using partial bulkloading, achieves much better performance (comparable to BDE) ........ Re-read current record if table is shared, under limited conditions so that performance is not affected (similar to BDE) ........ fixes so that it compiles in Free Pascal on Linux ........ fixes so that it compiles in Free Pascal on Linux ........ fixes so that it compiles in compiler that does not support Int64 ........ maintain linked list in tag table (compatibility with BDE and other engines) ........ Change index locking algorithm to avoid resyncs, achieves much better performance (consistent with BDE) ........ fix PhysicalRecNo property when filtering ........ prevent Access Violation in TDbf.LocateRecord if no index active and $booleval is on ........ add checking of required fields (call inherited InternalPost) ........ fix exception in TDataSet.Post if State = dsSetKey (Free Pascal) ........ fix AV in GotoKey/GotoNearest if dataset is empty ........ overload Define*Variable() functions to allow old interface to be called (needed by Free Pascal fcl-db) ........ fix $BOOLEVAL directives ........ fix AV in TDbf.GotoKey if index not active ........ consistently use little endianness for bookmark (allows it to be passed between architectures to support middle-tier) ........ Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf.pas trunk/src/dbf_ansistrings.pas trunk/src/dbf_collate.pas trunk/src/dbf_common.pas trunk/src/dbf_cursor.pas trunk/src/dbf_dbffile.pas trunk/src/dbf_idxcur.pas trunk/src/dbf_idxfile.pas trunk/src/dbf_memo.pas trunk/src/dbf_parser.pas trunk/src/dbf_pgfile.pas trunk/src/dbf_prscore.pas trunk/src/dbf_prsdef.pas trunk/src/dbf_prssupp.pas trunk/src/dbf_str.inc trunk/src/dbf_str.pas trunk/src/dbf_str_de.pas trunk/src/dbf_str_es.pas trunk/src/dbf_str_fr.pas trunk/src/dbf_str_ita.pas trunk/src/dbf_str_nl.pas trunk/src/dbf_str_pl.pas trunk/src/dbf_str_pt.pas trunk/src/dbf_str_ru.pas trunk/src/dbf_wtil.pas Added Paths: ----------- trunk/src/dbf_soundex.inc Removed Paths: ------------- trunk/src/getstrfromint.inc Property Changed: ---------------- trunk/ Index: trunk =================================================================== --- trunk 2015-08-06 12:08:17 UTC (rev 514) +++ trunk 2015-08-06 15:13:22 UTC (rev 515) Property changes on: trunk ___________________________________________________________________ Added: svn:mergeinfo ## -0,0 +1 ## +/branches/paulenandrew:330-514 \ No newline at end of property Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-08-06 12:08:17 UTC (rev 514) +++ trunk/doc/history.txt 2015-08-06 15:13:22 UTC (rev 515) @@ -40,6 +40,122 @@ - fix memory leak when inserting duplicate item in AVL tree - add german localization strings (thx heiko) +following changes thx paulenandrew: +- fix compiler errors in dbf_ansistrings for Free Pascal +- fix compiler errors in dbf_dbffile for Free Pascal +- expose TIndexFile.CompareKeys in TDbf.CompareKeys +- change TDbf.ExtractKey to extract key from index instead of evaluate it from record buffer +- prevent Access Violation in TDbf.IsDeleted and TDbf.Undelete if table is closed and $booleval is on +- use fmShareExclusive in exclusive create/open mode +- only lock a record if the table is shared +- fix memo file not being maintained correctly if block size is not the default of 1024 +- fix exception inserting into index leaving page locked +- update references to record number when inserting a record +- when setting IndexName, do not resync index unless it changed +- fix error when opening a table leaving it in an intermediate state +- fully support TableLevel 5 +- changed the default TableLevel from 4 to 5, supports a much larger record size and is otherwise almost identical +- maintain record number order within index entries with the same key +- update FCachedSize when adding backlink to FoxPro file +- ensure consistent behaviour when normalizing index name +- do not assume MDX page size is 1024 or block size is 512 +- fix memory leak if error opening an index +- preserve deleted flag in TDbf.CopyFrom +- if a memo field is set to an empty value, clear the reference so that it is null (consistent with BDE) +- add support for SetKey, GotoKey and GotoNearest +- maintain IndexDefs when DeleteIndex is used to delete an index +- add support for @, O, I and + dBASE 7 index key types and I and + FoxPro index key types +- preserve autoincrement field values in TDbf.CopyFrom +- limit index name length in header to 8 (compatibility with BDE) +- if TagsUsed is more than 47 tags in an index file, raise "Invalid MDX file." exception +- fix record buffer corruption if there is an error parsing the value of an F (Float), N (Numeric) or O (Double) field +- use record packing for index file declarations +- add support for up to 47 indexes, fix errors if an index file has more than 34 indexes +- use correct tag size when clearing level 7 indexes +- if size of tags in index file is too large, raise "Invalid MDX file." exception +- fix potential Range Check Error when deleting an entry from an index +- maintain linked list in tag table (compatibility with BDE and other engines) +- fix Zap leaving cached data in the file +- fix copying of memo file data when restructuring +- open FoxPro MDX index file (FoxPro CDX index file still not supported) +- create FoxPro DBF file with VerDBF = $30 ($02 is not compatible with BDE or Visual FoxPro 6.0) +- fix access is denied error trying to write corrections to the DBF header when opening read only +- fix ordering of floating point numeric index +- ensure GetCanModify returns False if table is not Active +- fix Division by zero error if index file block size is 0, raise "Invalid MDX. file" exception +- fix record count in DBF header (was not working as intended) +- add support for files larger than 4 GB (requires compiler to support Int64) +- add support for building/maintaining Date (D) index +- fix calculation of tag offset in index file +- fix access violation closing a table that is locked without explicitly unlocking +- use and recognize NUL instead of space to fill empty level 7 Character (C) fields, but not level 7 C index keys (consistent with BDE) +- fix error handling and potential access violation when there is an index key violation +- preserve cursor if GetRecord finds no record +- fix index file key length error handling, raise "Invalid MDX file." exception +- fix Integer overflow errors if more than 2,147,483,648 entries in an index file (requires compiler to support Int64) +- fix inaccurate floating point values in numeric index +- consistently use EParserException for parser error +- recalculate key length when rebuilding an index, to correct it if necessary +- implement DeleteMdxFile to delete MDX index file and clear MDX flag, implement DeleteIndexFile to delete index file +- consistently use EDbfIndexError for index error +- add OnIndexInvalidEvent - set Handled to continue anyway, DeleteLink to clear MDX flag +- fix problems if index key length does not match parser result length +- fix error handling updating an index +- fix potential access violation if TDBF_INDEX_CHECK is defined +- fix problems maintaining an index if leaf nodes are not on the same level (though they should be), raise "Invalid MDX file." exception +- fix error handling of out of range value in index page +- fix error handling in parser if too many arguments/operands +- fix sporadic access violation and other errors when creating/destroying a table in a multi-threaded application (fixes bug #68) +- fix writing of EOF terminator when inserting a record (fixes bug #58) +- fix incorrect parser linked list +- if there is a file read/write error, raise an exception +- change index locking algorithm to avoid resyncs, achieves much better performance (consistent with BDE) +- use BufferAhead and DisableResyncOnPost by default when table is exclusive or write locked, achieves much better performance +- use dynamic buffer size, achieves much better performance with both random and sequential access (performance similar to BDE) +- re-read current record if table is shared, under limited conditions so that performance is not affected (similar to BDE) +- add OnProgress event to report the progress of long-running functions and allow cancellation, used when copying and restructuring (similar to BDE) +- add missing message translations (fr, ita, nl, pl, ru) +- include deleted records in distinct index (compatible with BDE) +- build index using partial bulkloading, achieves much better performance (comparable to BDE) +- fix record and table locking algorithm - when table is locked, can edit a record anyway and adding a record causes it to hang (also compatible with BDE) +- add more robust Numeric (N) and Float (F) field value translation - prevents potential access violation, supports exponential notation for integers (also compatible with BDE) +- add more robust error handling for invalid index header, page or entry +- add TDbf.BatchMove method (similar to BDE batch move) +- if there is no active record, preventing it from reading the table twice (forwards then backwards) +- do not use OnIndexMissing with a FoxPro table +- do not convert index expression to upper case +- treat level 7 null value the same as an empty value when comparing Character (C) index keys (consistent with BDE) +- add more robust Str() function to parser +- add concept of null value to parser, use it to implement DTOS(null) = null instead of "18991230" +- make third parameter optional in SubStr() +- evaluate operators with equal precedence from left to right +- add Empty() function to parser +- add Proper() function to parser +- add Val() function to parser +- add Chr() function to parser +- add LTrim(), RTrim() and Trim() functions to parser +- add Asc() function to parser +- add Right() function to parser +- add Abs() function to parser +- add CDOW(), Date(), Day(), Month(), Year() functions to parser +- add Len() function to parser +- add IIF() function to parser +- add Ceil(), Ceiling(), Round() functions to parser +- fix index parser to be case sensitive +- add RecNo() function to parser +- make native field information available in parser +- allow concatenating a string using the + or - binary operator only in an index expression +- add unary plus (+) operator to parser +- add binary plus (+) operator for strings, dates +- add binary minus (-) operator for strings, dates +- fixes so that it compiles in Free Pascal on Linux +- fixes so that it compiles in compiler that does not support Int64 +- fix PhysicalRecNo property when filtering +- prevent Access Violation in TDbf.LocateRecord if no index active and $booleval is on +- add checking of required fields (call inherited InternalPost) +- fix exception in TDataSet.Post if State = dsSetKey (Free Pascal) +- consistently use little endianness for bookmark (allows it to be passed between architectures to support middle-tier) + ------------------------ V6.9.1 Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2015-08-06 12:08:17 UTC (rev 514) +++ trunk/src/dbf.pas 2015-08-06 15:13:22 UTC (rev 515) @@ -2,6 +2,8 @@ { design info in dbf_reg.pas } +{$BOOLEVAL OFF} + interface {$I dbf_common.inc} @@ -37,7 +39,7 @@ TDbfRecordHeader = record BookmarkData: TBookmarkData; BookmarkFlag: TBookmarkFlag; - SequentialRecNo: Integer; + SequentialRecNo: TSequentialRecNo; DeletedFlag: AnsiChar; end; //==================================================================== @@ -48,6 +50,9 @@ TDbfLanguageAction = (laReadOnly, laForceOEM, laForceANSI, laDefault); TDbfTranslationMode = (tmNoneAvailable, tmNoneNeeded, tmSimple, tmAdvanced); TDbfFileName = (dfDbf, dfMemo, dfIndex); + TDbfBatchMode = (bmAppend, bmUpdate, bmAppendUpdate, bmDelete, bmCopy); + TDbfBatchOption = (boUsePhysicalFieldNo); + TDbfBatchOptions = set of TDbfBatchOption; //==================================================================== TDbfFileNames = set of TDbfFileName; //==================================================================== @@ -191,10 +196,19 @@ FOnTranslate: TTranslateEvent; FOnLanguageWarning: TLanguageWarningEvent; FOnLocaleError: TDbfLocaleErrorEvent; + FOnIndexInvalid: TDbfIndexInvalidEvent; FOnIndexMissing: TDbfIndexMissingEvent; FOnCompareRecord: TNotifyEvent; FOnCopyDateTimeAsString: TConvertFieldEvent; + FOnProgress: TPagedFileProgressEvent; + FScrolling: Boolean; + FKeyBufferLen: Integer; + FKeyBuffer: Pointer; + function GetKeyBuffer: PAnsiChar; + function InitKeyBuffer(Buffer: PAnsiChar): PAnsiChar; + procedure PostKeyBuffer(Commit: Boolean); + function GetIndexName: string; function GetVersion: string; function GetPhysicalRecNo: Integer; @@ -230,6 +244,8 @@ function ReadCurrentRecord(Buffer: TDbfRecordBuffer; var Acceptable: Boolean): TGetResult; function SearchKeyBuffer(Buffer: PAnsiChar; SearchType: TSearchKeyType): Boolean; procedure SetRangeBuffer(LowRange: PAnsiChar; HighRange: PAnsiChar); + procedure UpdateLock; + function ResyncSharedReadCurrentRecord: Boolean; protected { abstract methods } @@ -257,7 +273,8 @@ procedure InternalInsert; override; {virtual} {$endif} {$endif} - procedure InternalPost; override; {virtual abstract} + procedure InternalPost; override; {virtual} + procedure InternalRefresh; override; procedure InternalSetToRecord(Buffer: TDbfRecordBuffer); override; {virtual abstract} procedure InitFieldDefs; override; function IsCursorOpen: Boolean; override; {virtual abstract} @@ -278,6 +295,8 @@ procedure DefChanged(Sender: TObject); override; {$endif} function FindRecord(Restart, GoForward: Boolean): Boolean; override; + procedure DoBeforeScroll; override; + procedure DoAfterScroll; override; function GetIndexFieldNames: string; {virtual;} procedure SetIndexFieldNames(const Value: string); {virtual;} @@ -293,6 +312,13 @@ constructor Create(AOwner: TComponent); override; destructor Destroy; override; + procedure SetKey; + function GotoCommon(SearchKeyType: TSearchKeyType): Boolean; + procedure GotoNearest; + function GotoKey: Boolean; + procedure Cancel; override; + procedure Post; override; + { abstract methods } {$ifdef SUPPORT_TVALUEBUFFER_VAR} @@ -327,9 +353,7 @@ function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; procedure CheckDbfFieldDefs(ADbfFieldDefs: TDbfFieldDefs); -{$ifdef VER1_0} - procedure DataEvent(Event: TDataEvent; Info: Longint); override; -{$endif} + procedure DataEvent(Event: TDataEvent; Info: {$ifdef FPC_VERSION}Ptrint{$else}Longint{$endif}); override; // my own methods and properties // most look like ttable functions but they are not tdataset related @@ -358,6 +382,7 @@ {$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}); function GetCurrentBuffer: TDbfRecordBuffer; procedure ExtractKey(KeyBuffer: PAnsiChar); + function CompareKeys(Key1, Key2: PAnsiChar): Integer; procedure UpdateIndexDefs; override; procedure GetFileNames(Strings: TStrings; Files: TDbfFileNames); {$ifdef SUPPORT_DEFAULT_PARAMS} overload; {$endif} {$ifdef SUPPORT_DEFAULT_PARAMS} @@ -390,10 +415,15 @@ procedure CreateTable; procedure CreateTableEx(ADbfFieldDefs: TDbfFieldDefs); procedure CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer); + procedure BatchMove(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer; Mode: TDbfBatchMode; Options: TDbfBatchOptions; FieldMappings: TStrings); procedure RestructureTable(ADbfFieldDefs: TDbfFieldDefs; Pack: Boolean); procedure PackTable; procedure EmptyTable; procedure Zap; + procedure BatchStart; + procedure BatchUpdate; + procedure BatchFinish; + function DeleteMdxFile: Boolean; {$ifndef SUPPORT_INITDEFSFROMFIELDS} procedure InitFieldDefsFromFields; @@ -440,9 +470,11 @@ property OnCompareRecord: TNotifyEvent read FOnCompareRecord write FOnCompareRecord; property OnLanguageWarning: TLanguageWarningEvent read FOnLanguageWarning write FOnLanguageWarning; property OnLocaleError: TDbfLocaleErrorEvent read FOnLocaleError write FOnLocaleError; + property OnIndexInvalid: TDbfIndexInvalidEvent read FOnIndexInvalid write FOnIndexInvalid; property OnIndexMissing: TDbfIndexMissingEvent read FOnIndexMissing write FOnIndexMissing; property OnCopyDateTimeAsString: TConvertFieldEvent read FOnCopyDateTimeAsString write FOnCopyDateTimeAsString; property OnTranslate: TTranslateEvent read FOnTranslate write FOnTranslate; + property OnProgress: TPagedFileProgressEvent read FOnProgress write FOnProgress; // redeclared data set properties property Active; @@ -516,10 +548,12 @@ begin case TableLevel of 3: Result := xBaseIII; + 4: Result := xBaseIV; + 5: Result := xBaseV; 7: Result := xBaseVII; TDBF_TABLELEVEL_FOXPRO: Result := xFoxPro; else - {4:} Result := xBaseIV; + Result := xUnknown; end; end; @@ -579,6 +613,7 @@ procedure TDbfBlobStream.Commit; var Dbf: TDbf; + Src: Pointer; begin if FDirty then begin @@ -586,7 +621,11 @@ Dbf := TDbf(FBlobField.DataSet); Translate(true); Dbf.FDbfFile.MemoFile.WriteMemo(FMemoRecNo, FReadSize, Self); - Dbf.FDbfFile.SetFieldData(FBlobField.FieldNo-1, ftInteger, @FMemoRecNo, + if Size <> 0 then + Src := @FMemoRecNo + else + Src := nil; + Dbf.FDbfFile.SetFieldData(FBlobField.FieldNo-1, ftInteger, Src, @pDbfRecord(TDbf(FBlobField.DataSet).ActiveBuffer)^.DeletedFlag, false); FDirty := false; end; @@ -644,9 +683,6 @@ begin inherited; - if DbfGlobals = nil then - DbfGlobals := TDbfGlobals.Create; - BookmarkSize := sizeof(TBookmarkData); FIndexDefs := TDbfIndexDefs.Create(Self); FMasterLink := TDbfMasterLink.Create(Self); @@ -665,7 +701,7 @@ FInCopyFrom := false; FFindRecordFilter := false; FEditingRecNo := -1; - FTableLevel := 4; + FTableLevel := 5; FIndexName := EmptyStr; FilePath := EmptyStr; FTempBuffer := nil; @@ -689,6 +725,8 @@ FIndexDefs.Free; end; FMasterLink.Free; + + FreeMemAndNil(FKeyBuffer); end; function TDbf.AllocRecordBuffer: TDbfRecordBuffer; {override virtual abstract from TDataset} @@ -704,6 +742,7 @@ procedure TDbf.GetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); {override virtual abstract from TDataset} begin pBookmarkData(Data)^ := pDbfRecord(Buffer)^.BookmarkData; + pBookmarkData(Data)^.PhysicalRecNo := SwapIntLE(DWORD(pBookmarkData(Data)^.PhysicalRecNo)); end; function TDbf.GetBookmarkFlag(Buffer: TDbfRecordBuffer): TBookmarkFlag; {override virtual abstract from TDataset} @@ -716,7 +755,7 @@ case State of dsFilter: Result := TDbfRecordBuffer(FFilterBuffer); dsCalcFields: Result := TDbfRecordBuffer(CalcBuffer); -// dsSetKey: Result := FKeyBuffer; // TO BE Implemented + dsSetKey: Result := GetKeyBuffer; else if IsEmpty then begin @@ -801,7 +840,10 @@ begin if (Field.FieldNo >= 0) then begin - Dst := @PDbfRecord(ActiveBuffer)^.DeletedFlag; + if State = dsSetKey then + Dst := @PDbfRecord(GetKeyBuffer)^.DeletedFlag + else + Dst := @PDbfRecord(ActiveBuffer)^.DeletedFlag; FDbfFile.SetFieldData(Field.FieldNo - 1, Field.DataType, Buffer, Dst, NativeFormat); end else begin { ***** fkCalculated, fkLookup ***** } Dst := @PDbfRecord(CalcBuffer)^.DeletedFlag; @@ -827,11 +869,11 @@ if Length(Filter) > 0 then begin {$ifndef VER1_0} - Acceptable := Boolean((FParser.ExtractFromBuffer(PAnsiChar(GetCurrentBuffer)))^); + Acceptable := Boolean((FParser.ExtractFromBuffer(PAnsiChar(GetCurrentBuffer), PhysicalRecNo))^); {$else} // strange problem // dbf.pas(716,19) Error: Incompatible types: got "CHAR" expected "BOOLEAN" - Acceptable := not ((FParser.ExtractFromBuffer(GetCurrentBuffer))^ = #0); + Acceptable := not ((FParser.ExtractFromBuffer(GetCurrentBuffer), PhysicalRecNo)^ = #0); {$endif} end; @@ -863,8 +905,8 @@ pRecord: pDbfRecord; acceptable: Boolean; SaveState: TDataSetState; - lPhysicalRecNo: Integer; // s: string; + lSequentialRecNo: TSequentialRecNo; begin if FCursor = nil then begin @@ -873,6 +915,7 @@ end; pRecord := pDbfRecord(Buffer); + lSequentialRecNo := FCursor.SequentialRecNo; acceptable := false; repeat Result := grOK; @@ -899,14 +942,9 @@ if (Result = grOK) then begin - lPhysicalRecNo := FCursor.PhysicalRecNo; - if (lPhysicalRecNo = 0) or not FDbfFile.IsRecordPresent(lPhysicalRecNo) then - begin - Result := grError; - end else begin - FDbfFile.ReadRecord(lPhysicalRecNo, @pRecord^.DeletedFlag); - acceptable := (FShowDeleted or (pRecord^.DeletedFlag <> '*')) - end; + Result := ReadCurrentRecord(Buffer, acceptable); + if lSequentialRecNo = 0 then + lSequentialRecNo := FCursor.SequentialRecNo; end; if (Result = grOK) and acceptable then @@ -914,7 +952,7 @@ pRecord^.BookmarkData.PhysicalRecNo := FCursor.PhysicalRecNo; pRecord^.BookmarkFlag := bfCurrent; pRecord^.SequentialRecNo := FCursor.SequentialRecNo; - GetCalcFields(TDbfRecBuf(Buffer)); + GetCalcFields(Buffer); if Filtered or FFindRecordFilter then begin @@ -930,7 +968,11 @@ until (Result <> grOK) or acceptable; if Result <> grOK then + begin + if lSequentialRecNo <> 0 then + FCursor.SequentialRecNo := lSequentialRecNo; pRecord^.BookmarkData.PhysicalRecNo := -1; + end; end; function TDbf.GetRecordSize: Word; {override virtual abstract from TDataset} @@ -1045,18 +1087,18 @@ end; procedure TDbf.InternalGotoBookmark(ABookmark: Pointer); {override virtual abstract from TDataset} +var + APhysicalRecNo: Integer; begin - with PBookmarkData(ABookmark)^ do - begin - if (PhysicalRecNo = 0) then begin - First; - end else - if (PhysicalRecNo = MaxInt) then begin - Last; - end else begin - if FCursor.PhysicalRecNo <> PhysicalRecNo then - FCursor.PhysicalRecNo := PhysicalRecNo; - end; + APhysicalRecNo := Integer(SwapIntLE(DWORD(PBookmarkData(ABookmark)^.PhysicalRecNo))); + if (APhysicalRecNo = 0) then begin + First; + end else + if (APhysicalRecNo = MaxInt) then begin + Last; + end else begin + if FCursor.PhysicalRecNo <> APhysicalRecNo then + FCursor.PhysicalRecNo := APhysicalRecNo; end; end; @@ -1071,6 +1113,7 @@ TempFieldDef: TDbfFieldDef; TempMdxFile: TIndexFile; BaseName, lIndexName: string; + lIndexDef: TDbfIndexDef; begin FieldDefs.Clear; @@ -1116,6 +1159,12 @@ if FIndexDefs.GetIndexByName(lIndexName) = nil then TempMdxFile.GetIndexInfo(lIndexName, FIndexDefs.Add); end; + for I := Pred(FIndexDefs.Count) downto 0 do + begin + lIndexDef := FIndexDefs[I]; + if FDbfFile.IndexNames.IndexOf(lIndexDef.IndexFile) < 0 then + lIndexDef.Free; + end; end; procedure TDbf.InitFieldDefs; @@ -1141,6 +1190,7 @@ FDbfFile.AutoCreate := false; FDbfFile.DateTimeHandling := FDateTimeHandling; FDbfFile.OnLocaleError := FOnLocaleError; + FDbfFile.OnIndexInvalid := FOnIndexInvalid; FDbfFile.OnIndexMissing := FOnIndexMissing; end; @@ -1212,138 +1262,145 @@ begin // close current file FreeAndNil(FDbfFile); + try - // does file not exist? -> create - if ((FStorage = stoFile) and - not FileExists(FAbsolutePath + FTableName) and - (FOpenMode in [omAutoCreate, omTemporary])) or - ((FStorage = stoMemory) and (FUserStream = nil)) then - begin - doCreate := true; - if Assigned(FBeforeAutoCreate) then - FBeforeAutoCreate(Self, doCreate); - if doCreate then - CreateTable - else - exit; - end; + // does file not exist? -> create + if ((FStorage = stoFile) and + not FileExists(FAbsolutePath + FTableName) and + (FOpenMode in [omAutoCreate, omTemporary])) or + ((FStorage = stoMemory) and (FUserStream = nil)) then + begin + doCreate := true; + if Assigned(FBeforeAutoCreate) then + FBeforeAutoCreate(Self, doCreate); + if doCreate then + CreateTable + else + exit; + end; - // now we know for sure the file exists - InitDbfFile(DbfOpenMode[FReadOnly, FExclusive]); - FDbfFile.Open; + // now we know for sure the file exists + InitDbfFile(DbfOpenMode[FReadOnly, FExclusive]); + FDbfFile.Open; + UpdateLock; - // fail open? -{$ifndef FPC} - if FDbfFile.ForceClose then - Abort; -{$endif} + // fail open? + {$ifndef FPC} + if FDbfFile.ForceClose then + Abort; + {$endif} - // determine dbf version - case FDbfFile.DbfVersion of - xBaseIII: FTableLevel := 3; - xBaseIV: FTableLevel := 4; - xBaseVII: FTableLevel := 7; - xFoxPro: FTableLevel := TDBF_TABLELEVEL_FOXPRO; - end; - // 11.09.2007 \xC5\xF1\xE4\xE8 0, \xED\xE0\xEF\xF0\xE8\xEC\xE5\xF0 DBaseIII, \xE1\xF3\xE4\xE5\xEC \xF1\xF7\xE8\xF2\xE0\xF2\xFC \xE8\xE7 DbfGlobals - if FDbfFile.LanguageID=0 then begin - FDbfFile.UseCodePage := DbfGlobals.DefaultCreateCodePage; // GETACPOEM; - FDbfFile.FileLangId := DbfGlobals.DefaultCreateLangId; // DbfLangId_RUS_866 - end; - // \xD0\xE5\xE0\xEB\xFC\xED\xFB\xE9 locale \xE8\xE7 \xE7\xE0\xE3\xEE\xEB\xEE\xE2\xEA\xE0 \xF4\xE0\xE9\xEB\xE0 - FLanguageID := FDbfFile.LanguageID; + // determine dbf version + case FDbfFile.DbfVersion of + xBaseIII: FTableLevel := 3; + xBaseIV: FTableLevel := 4; + xBaseV: FTableLevel := 5; + xBaseVII: FTableLevel := 7; + xFoxPro: FTableLevel := TDBF_TABLELEVEL_FOXPRO; + end; + // 11.09.2007 \xC5\xF1\xE4\xE8 0, \xED\xE0\xEF\xF0\xE8\xEC\xE5\xF0 DBaseIII, \xE1\xF3\xE4\xE5\xEC \xF1\xF7\xE8\xF2\xE0\xF2\xFC \xE8\xE7 DbfGlobals + if FDbfFile.LanguageID=0 then begin + FDbfFile.UseCodePage := DbfGlobals.DefaultCreateCodePage; // GETACPOEM; + FDbfFile.FileLangId := DbfGlobals.DefaultCreateLangId; // DbfLangId_RUS_866 + end; + // \xD0\xE5\xE0\xEB\xFC\xED\xFB\xE9 locale \xE8\xE7 \xE7\xE0\xE3\xEE\xEB\xEE\xE2\xEA\xE0 \xF4\xE0\xE9\xEB\xE0 + FLanguageID := FDbfFile.LanguageID; - // build VCL fielddef list from native DBF FieldDefs -(* - if (FDbfFile.HeaderSize = 0) or (FDbfFile.FieldDefs.Count = 0) then - begin - if FieldDefs.Count > 0 then + // build VCL fielddef list from native DBF FieldDefs + (* + if (FDbfFile.HeaderSize = 0) or (FDbfFile.FieldDefs.Count = 0) then begin - CreateTableFromFieldDefs; + if FieldDefs.Count > 0 then + begin + CreateTableFromFieldDefs; + end else begin + CreateTableFromFields; + end; end else begin - CreateTableFromFields; - end; - end else begin -*) -// GetFieldDefsFromDbfFieldDefs; -// end; + *) + // GetFieldDefsFromDbfFieldDefs; + // end; -{$ifdef SUPPORT_FIELDDEFS_UPDATED} - FieldDefs.Updated := False; - FieldDefs.Update; -{$else} - InternalInitFieldDefs; -{$endif} + {$ifdef SUPPORT_FIELDDEFS_UPDATED} + FieldDefs.Updated := False; + FieldDefs.Update; + {$else} + InternalInitFieldDefs; + {$endif} - // create the fields dynamically - if DefaultFields then - CreateFields; // Create fields from fielddefs. + // create the fields dynamically + if DefaultFields then + CreateFields; // Create fields from fielddefs. - BindFields(true); + BindFields(true); - // create array of blobstreams to store memo's in. each field is a possible blob - FBlobStreams := AllocMem(FieldDefs.Count * SizeOf(TDbfBlobStream)); + // create array of blobstreams to store memo's in. each field is a possible blob + FBlobStreams := AllocMem(FieldDefs.Count * SizeOf(TDbfBlobStream)); - // check codepage settings - DetermineTranslationMode; - if FTranslationMode = tmNoneAvailable then - begin - // no codepage available? ask user - LanguageAction := laReadOnly; - if Assigned(FOnLanguageWarning) then - FOnLanguageWarning(Self, LanguageAction); - case LanguageAction of - laReadOnly: FTranslationMode := tmNoneAvailable; - laForceOEM: - begin - FDbfFile.UseCodePage := GetOEMCP; - FTranslationMode := tmSimple; - end; - laForceANSI: - begin - FDbfFile.UseCodePage := GetACP; - FTranslationMode := tmNoneNeeded; - end; - laDefault: - begin - FDbfFile.UseCodePage := DbfGlobals.DefaultOpenCodePage; - DetermineTranslationMode; - end; + // check codepage settings + DetermineTranslationMode; + if FTranslationMode = tmNoneAvailable then + begin + // no codepage available? ask user + LanguageAction := laReadOnly; + if Assigned(FOnLanguageWarning) then + FOnLanguageWarning(Self, LanguageAction); + case LanguageAction of + laReadOnly: FTranslationMode := tmNoneAvailable; + laForceOEM: + begin + FDbfFile.UseCodePage := GetOEMCP; + FTranslationMode := tmSimple; + end; + laForceANSI: + begin + FDbfFile.UseCodePage := GetACP; + FTranslationMode := tmNoneNeeded; + end; + laDefault: + begin + FDbfFile.UseCodePage := DbfGlobals.DefaultOpenCodePage; + DetermineTranslationMode; + end; + end; end; - end; - // allocate a record buffer for temporary data - FTempBuffer := AllocRecordBuffer; + // allocate a record buffer for temporary data + FTempBuffer := AllocRecordBuffer; - // open indexes - for I := 0 to FIndexDefs.Count - 1 do - begin - lIndex := FIndexDefs.Items[I]; - lIndexName := ParseIndexName(lIndex.IndexFile); - // if index does not exist -> create, if it does exist -> open only - FDbfFile.OpenIndex(lIndexName, lIndex.SortField, false, lIndex.Options); - end; + // open indexes + for I := 0 to FIndexDefs.Count - 1 do + begin + lIndex := FIndexDefs.Items[I]; + lIndexName := ParseIndexName(lIndex.IndexFile); + // if index does not exist -> create, if it does exist -> open only + FDbfFile.OpenIndex(lIndexName, lIndex.SortField, false, lIndex.Options); + end; - // parse filter expression - try - ParseFilter(Filter); - except - // oops, a problem with parsing, clear filter for now - on E: EDbfError do Filter := EmptyStr; - end; + // parse filter expression + try + ParseFilter(Filter); + except + // oops, a problem with parsing, clear filter for now + on E: EDbfError do Filter := EmptyStr; + end; - SetIndexName(FIndexName); + SetIndexName(FIndexName); -// SetIndexName will have made the cursor for us if no index selected :-) -// if FCursor = nil then FCursor := TDbfCursor.Create(FDbfFile); + // SetIndexName will have made the cursor for us if no index selected :-) + // if FCursor = nil then FCursor := TDbfCursor.Create(FDbfFile); - if FMasterLink.Active and Assigned(FIndexFile) then - CheckMasterRange; - InternalFirst; + if FMasterLink.Active and Assigned(FIndexFile) then + CheckMasterRange; + InternalFirst; -// FDbfFile.SetIndex(FIndexName); -// FDbfFile.FIsCursorOpen := true; + // FDbfFile.SetIndex(FIndexName); + // FDbfFile.FIsCursorOpen := true; + except + InternalClose; + raise; + end; end; function TDbf.GetCodePage: Cardinal; @@ -1362,14 +1419,17 @@ function TDbf.LockTable(const Wait: Boolean): Boolean; begin - CheckActive; + if not(Assigned(FDbfFile) and FDbfFile.Active) then + CheckActive; Result := FDbfFile.LockAllPages(Wait); + UpdateLock; end; procedure TDbf.UnlockTable; begin CheckActive; FDbfFile.UnlockAllPages; + UpdateLock; end; procedure TDbf.InternalEdit; @@ -1384,7 +1444,7 @@ if Assigned(FBlobStreams^[I]) then FBlobStreams^[I].Cancel; // try to lock this record - FDbfFile.LockRecord(FEditingRecNo, @pDbfRecord(ActiveBuffer)^.DeletedFlag); + FDbfFile.LockRecord(FEditingRecNo, @pDbfRecord(ActiveBuffer)^.DeletedFlag, BufferCount = 1); // succeeded! end; @@ -1399,11 +1459,13 @@ {$endif} {$endif} -procedure TDbf.InternalPost; {override virtual abstract from TDataset} +procedure TDbf.InternalPost; {override virtual from TDataset} var pRecord: pDbfRecord; I, newRecord: Integer; begin + // inherited method checks required fields + inherited; // if internalpost is called, we know we are active pRecord := pDbfRecord(ActiveBuffer); // commit blobs @@ -1420,12 +1482,24 @@ // insert newRecord := FDbfFile.Insert(@pRecord^.DeletedFlag); if newRecord > 0 then + begin FCursor.PhysicalRecNo := newRecord; + pRecord^.BookmarkData.PhysicalRecNo := newRecord; + pRecord^.BookmarkFlag := bfCurrent; + pRecord^.SequentialRecNo := FCursor.SequentialRecNo; + end; end; // set flag that TDataSet is about to post...so we can disable resync FPosting := true; end; +procedure TDbf.InternalRefresh; +begin + if Assigned(FDbfFile) then + FDbfFile.ResyncSharedReadBuffer; + inherited; +end; + procedure TDbf.Resync(Mode: TResyncMode); begin // try to increase speed @@ -1538,6 +1612,7 @@ FDbfFile.FileLangID := FLanguageID; FDbfFile.Open; FDbfFile.FinishCreate(ADbfFieldDefs, 512); + UpdateLock; // if creating memory table, copy stream pointer if FStorage = stoMemory then @@ -1579,6 +1654,40 @@ FDbfFile.Zap; end; +procedure TDbf.BatchStart; +begin + DisableControls; + if Assigned(FDbfFile) then + FDbfFile.BatchStart; + FInCopyFrom := True; +end; + +procedure TDbf.BatchUpdate; +begin + if Assigned(FDbfFile) then + FDbfFile.BatchUpdate; +end; + +procedure TDbf.BatchFinish; +begin + FInCopyFrom := False; + if Assigned(FDbfFile) then + FDbfFile.BatchFinish; + EnableControls; +end; + +function TDbf.DeleteMdxFile: Boolean; +begin + CheckActive; + Result:= Assigned(DbfFile.MdxFile); + if Result then + begin + IndexName:= ''; + DbfFile.DeleteMdxFile; + InternalInitFieldDefs; + end; +end; + procedure TDbf.RestructureTable(ADbfFieldDefs: TDbfFieldDefs; Pack: Boolean); begin CheckInactive; @@ -1589,10 +1698,16 @@ // open dbf file InitDbfFile(pfExclusiveOpen); FDbfFile.Open; + UpdateLock; // do restructure try - FDbfFile.RestructureTable(ADbfFieldDefs, Pack); + BatchStart; + try + FDbfFile.RestructureTable(ADbfFieldDefs, Pack); + finally + BatchFinish; + end; finally // close file FreeAndNil(FDbfFile); @@ -1608,20 +1723,89 @@ oldIndexName := IndexName; IndexName := EmptyStr; // pack - FDbfFile.RestructureTable(nil, true); + FDbfFile.OnProgress := FOnProgress; + try + BatchStart; + try + FDbfFile.RestructureTable(nil, true); + finally + BatchFinish; + end; + finally + FDbfFile.OnProgress := nil; + end; // reselect index IndexName := oldIndexName; end; procedure TDbf.CopyFrom(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer); -var - lPhysFieldDefs, lFieldDefs: TDbfFieldDefs; +begin + BatchMove(DataSet, FileName, DateTimeAsString, Level, bmCopy, [], nil); +end; + +procedure TDbf.BatchMove(DataSet: TDataSet; FileName: string; DateTimeAsString: Boolean; Level: Integer; Mode: TDbfBatchMode; Options: TDbfBatchOptions; FieldMappings: TStrings); // 02/25/2011 spb CR 18708 +var // 03/08/2011 spb CR 18716 + lPhysFieldDefs, lFieldDefs: TDbfFieldDefs; // 03/08/2011 pb CR 18706 lSrcField, lDestField: TField; I: integer; + cur, last: Integer; + lSourceFields: TList; + lDestinationFields: TList; + lSourceFieldCount : Integer; + lDestinationFieldCount : Integer; + SourceName: string; + DestinationName: string; + lSrcFieldDef, lDestFieldDef: TDbfFieldDef; + CopyLen: Integer; + SrcBuffer: PChar; + DestBuffer: PChar; + CopyBlob: Boolean; + BlobStream: TMemoryStream; + lBlobPageNo: Integer; + + procedure GetFieldMappingNames; + var + SeparatorPos: Integer; + begin + SeparatorPos := Pos('=', FieldMappings[I]); + if SeparatorPos > 1 then + begin + SourceName := Trim(Copy(FieldMappings[I], 1, Pred(SeparatorPos))); + DestinationName := Trim(Copy(FieldMappings[I], Succ(SeparatorPos), Length(FieldMappings[I]))); + end + else + begin + SourceName := Trim(FieldMappings[I]); + DestinationName := SourceName; + end; + end; + + procedure AddSourceField; + begin + if Assigned(lSrcField) then + with lFieldDefs.AddFieldDef do + begin + if Length(lSrcField.Name) > 0 then + FieldName := lSrcField.Name + else + FieldName := lSrcField.FieldName; + FieldType := lSrcField.DataType; + Required := lSrcField.Required; + if (1 <= lSrcField.FieldNo) + and (lSrcField.FieldNo <= lPhysFieldDefs.Count) then + begin + Size := lPhysFieldDefs.Items[lSrcField.FieldNo-1].Size; + Precision := lPhysFieldDefs.Items[lSrcField.FieldNo-1].Precision; + end; + end; + end; + begin - FInCopyFrom := true; +//FInCopyFrom := true; lFieldDefs := TDbfFieldDefs.Create(nil); lPhysFieldDefs := TDbfFieldDefs.Create(nil); + lSourceFields := nil; + lDestinationFields := nil; try if Active then Close; @@ -1641,73 +1825,217 @@ end else begin {$ifdef SUPPORT_FIELDDEF_TPERSISTENT} lPhysFieldDefs.Assign(DataSet.FieldDefs); -{$endif} +{$endif} IndexDefs.Clear; end; // convert list of tfields into a list of tdbffielddefs // so that our tfields will correspond to the source tfields - for I := 0 to Pred(DataSet.FieldCount) do + lSourceFields := TList.Create; + lDestinationFields := TList.Create; + if Mode = bmCopy then begin - lSrcField := DataSet.Fields[I]; - with lFieldDefs.AddFieldDef do - begin - if Length(lSrcField.Name) > 0 then - FieldName := AnsiString(lSrcField.Name) - else - FieldName := AnsiString(lSrcField.FieldName); - FieldType := lSrcField.DataType; - Required := lSrcField.Required; - if (1 <= lSrcField.FieldNo) - and (lSrcField.FieldNo <= lPhysFieldDefs.Count) then + if boUsePhysicalfieldNo in Options then + lSourceFieldCount := DataSet.FieldDefs.Count + else + lSourceFieldCount := DataSet.FieldCount; + if Assigned(FieldMappings) and (FieldMappings.Count > 0) then + for I := 0 to Pred(FieldMappings.Count) do begin - Size := lPhysFieldDefs.Items[lSrcField.FieldNo-1].Size; - Precision := lPhysFieldDefs.Items[lSrcField.FieldNo-1].Precision; + GetFieldMappingNames; + lSrcField := DataSet.Fields.FindField(SourceName); + AddSourceField; + lSourceFields.Add(Pointer(lSrcField)); + end + else + for I := 0 to Pred(lSourceFieldCount) do + begin + if boUsePhysicalfieldNo in Options then + lSrcField := DataSet.Fields.FieldByNumber(Succ(I)) + else + lSrcField := DataSet.Fields[I]; + AddSourceField; + lSourceFields.Add(Pointer(lSrcField)); end; - end; - end; - - CreateTableEx(lFieldDefs); - Open; - DataSet.First; -{$ifdef USE_CACHE} - FDbfFile.BufferAhead := true; - if DataSet is TDbf then - TDbf(DataSet).DbfFile.BufferAhead := true; -{$endif} - while not DataSet.EOF do + CreateTableEx(lFieldDefs); + Open; + lDestinationFieldCount := FieldDefs.Count; + for I := 1 to lDestinationFieldCount do + lDestinationFields.Add(Pointer(Fields.FieldByNumber(I))); + end + else if Mode = bmAppend then begin - Append; - for I := 0 to Pred(FieldCount) do - begin - lSrcField := DataSet.Fields[I]; - lDestField := Fields[I]; - if not lSrcField.IsNull then + Open; + lDestinationFieldCount := FieldDefs.Count; + lSourceFields.Count := lDestinationFieldCount; + lDestinationFields.Count := lDestinationFieldCount; + if Assigned(FieldMappings) then + for I := 0 to Pred(FieldMappings.Count) do begin - if lSrcField.DataType = ftDateTime then - begin - if FCopyDateTimeAsString then + GetFieldMappingNames; + lDestField := Fields.FindField(DestinationName); + lSrcField := DataSet.Fields.FindField(SourceName); + if Assigned(lDestField) then + if (1 <= lDestField.FieldNo) and (lDestField.FieldNo <= lDestinationFieldCount) then + begin + lSourceFields[Pred(lDestField.FieldNo)] := lSrcField; + lDestinationFields[Pred(lDestField.FieldNo)] := lDestField; + end; + end + else + for I := 1 to lDestinationFieldCount do + if I <= DataSet.FieldDefs.Count then begin - lDestField.AsString := lSrcField.AsString; - if Assigned(FOnCopyDateTimeAsString) then - FOnCopyDateTimeAsString(Self, lDestField, lSrcField) - end else - lDestField.AsDateTime := lSrcField.AsDateTime; - end else - lDestField.Assign(lSrcField); + lSourceFields[Pred(I)] := Pointer(DataSet.Fields.FieldByNumber(I)); + lDestinationfields[Pred(I)] := Pointer(Fields.FieldByNumber(I)); + end; + end; + BatchStart; + try + if DataSet is TDbf then + TDbf(DataSet).BatchStart; + try + cur := 0; + if Assigned(FOnProgress) and (DataSet is TDbf) then + begin + last := TDbf(DataSet).PhysicalRecordCount; + FDbfFile.OnProgress := FOnProgress; + FDbfFile.DoProgress(cur, last, STRING_PROGRESS_APPENDINGRECORDS); + end + else + last := -1; + try + BlobStream := TMemoryStream.Create; + try + while not DataSet.EOF do + begin + Append; + for I := 0 to Pred(lDestinationFields.Count) do + begin + lSrcField := TField(lSourceFields[I]); + lDestField := TField(lDestinationFields[I]); + if Assigned(lSrcField) and Assigned(lDestField) then + begin + CopyLen := -1; + CopyBlob := False; + if DataSet is TDbf then + begin + lSrcFieldDef := TDbf(DataSet).DbfFieldDefs.Items[Pred(lSrcField.FieldNo)]; + lDestFieldDef := DbfFieldDefs.Items[Pred(lDestField.FieldNo)]; + if lSrcFieldDef.NativeFieldType = lDestFieldDef.NativeFieldType then + begin + if lSrcFieldDef.IsBlob then + CopyBlob := True + else + begin + if lSrcFieldDef.NativeFieldType = 'C' then + begin + if lSrcFieldDef.Size > lDestFieldDef.Size then + CopyLen := lDestFieldDef.Size + else + CopyLen := lSrcFieldDef.Size; + end + else + begin + if (lSrcFieldDef.Size = lDestFieldDef.Size) and (lSrcFieldDef.Precision = lDestFieldDef.Precision) then + CopyLen := lSrcFieldDef.Size; + end; + end; + end + end + else + begin + lSrcFieldDef := nil; + lDestFieldDef := nil; + end; + SrcBuffer := PChar(@pDbfRecord(DataSet.ActiveBuffer).DeletedFlag); + DestBuffer := PChar(@pDbfRecord(ActiveBuffer).DeletedFlag); + if CopyBlob then + begin + if FDbfFile.GetFieldDataFromDef(lSrcFieldDef, ftInteger, SrcBuffer, @lBlobPageNo, false) and (lBlobPageNo > 0) then + begin + TDbf(DataSet).FDbfFile.MemoFile.ReadMemo(lBlobPageNo, BlobStream); + BlobStream.Position := 0; + FDbfFile.MemoFile.WriteMemo(lBlobPageNo, 0, BlobStream); + FDbfFile.SetFieldData(lDestFieldDef.Index, ftInteger, @lBlobPageNo, DestBuffer, false); + BlobStream.Clear; + end; + end + else + begin + if CopyLen > 0 then + begin + Inc(SrcBuffer, lSrcFieldDef.Offset); + Inc(DestBuffer, lDestFieldDef.Offset); + Move(SrcBuffer^, DestBuffer^, CopyLen); + if (lDestFieldDef.NativeFieldType = 'C') and (TDbf(DataSet).DbfFile.DbfVersion >= xBaseVII) and (lDestFieldDef.Size > lSrcFieldDef.Size) and (not lSrcField.IsNull) then + FillChar((DestBuffer + CopyLen)^, lDestFieldDef.Size - lSrcFieldDef.Size, ' '); + end + else + begin + if not lSrcField.IsNull then + begin + if lSrcField.DataType = ftDateTime then + begin + if FCopyDateTimeAsString then + begin + lDestField.AsString := lSrcField.AsString; + if Assigned(FOnCopyDateTimeAsString) then + FOnCopyDateTimeAsString(Self, lDestField, lSrcField) + end else + lDestField.AsDateTime := lSrcField.AsDateTime; + end else + lD... [truncated message content] |
From: <pau...@us...> - 2015-08-31 20:19:31
|
Revision: 527 http://sourceforge.net/p/tdbf/code/527 Author: paulenandrew Date: 2015-08-31 20:19:29 +0000 (Mon, 31 Aug 2015) Log Message: ----------- Merge revisions 521, 525 and 526 from branches/paulenandrew to trunk [r521] fix AV compiling constant expression - broken by adding RecNo() function to parser [r525] move RecNo() from TCustomExpressionParser to TDbfParser [r526] do not convert expression to upper case when parsing (in particular, effects string constants) Revision Links: -------------- http://sourceforge.net/p/tdbf/code/521 http://sourceforge.net/p/tdbf/code/525 http://sourceforge.net/p/tdbf/code/526 Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_dbffile.pas trunk/src/dbf_parser.pas trunk/src/dbf_prscore.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-08-31 18:53:06 UTC (rev 526) +++ trunk/doc/history.txt 2015-08-31 20:19:29 UTC (rev 527) @@ -155,6 +155,7 @@ - add checking of required fields (call inherited InternalPost) - fix exception in TDataSet.Post if State = dsSetKey (Free Pascal) - consistently use little endianness for bookmark (allows it to be passed between architectures to support middle-tier) +- do not convert expression to upper case when parsing (in particular, effects string constants) ------------------------ V6.9.1 Modified: trunk/src/dbf_dbffile.pas =================================================================== --- trunk/src/dbf_dbffile.pas 2015-08-31 18:53:06 UTC (rev 526) +++ trunk/src/dbf_dbffile.pas 2015-08-31 20:19:29 UTC (rev 527) @@ -1424,13 +1424,15 @@ var I: Integer; lfi: TDbfFieldDef; - FieldNameUpper: AnsiString; + AFieldName: string; begin - FieldNameUpper := dbfStrUpper(PAnsiChar(FieldName)); + AFieldName := FieldName; + UniqueString(AFieldName); + AFieldName := dbfStrUpper(PAnsiChar(AFieldName)); for I := 0 to FFieldDefs.Count-1 do begin lfi := TDbfFieldDef(FFieldDefs.Items[I]); - if lfi.fieldName = FieldNameUpper then + if lfi.fieldName = AFieldName then begin Result := lfi; exit; Modified: trunk/src/dbf_parser.pas =================================================================== --- trunk/src/dbf_parser.pas 2015-08-31 18:53:06 UTC (rev 526) +++ trunk/src/dbf_parser.pas 2015-08-31 20:19:29 UTC (rev 527) @@ -81,6 +81,11 @@ dbf_dbffile, dbf_str; +procedure FuncRecNo(Param: PExpressionRec); +begin + PInteger(Param^.Res.MemoryPos^)^ := -1; +end; + type // TFieldVar aids in retrieving field values from records // in their proper type @@ -515,6 +520,7 @@ FWordsList.AddList(DbfWordsSensNoPartialList, 0, DbfWordsSensNoPartialList.Count - 1); end; end; + FWordsList.Add(TVaryingFunction.Create('RECNO', '', '', 0, etInteger, FuncRecNo, '')); if Length(lExpression) > 0 then ParseExpression(lExpression); end; @@ -667,10 +673,10 @@ // execute expression EvaluateCurrent; Result := PAnsiChar(ExpResult); - if Assigned(CurrentRec) then - IsNull := LastRec.IsNullPtr^ - else - IsNull := False; + IsNull := False; + if LastRec <> nil then + if LastRec.IsNullPtr <> nil then + IsNull := LastRec.IsNullPtr^; end else begin // simple field, get field result Result := TFieldVar(FFieldVarList.Objects[0]).FieldVal; Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2015-08-31 18:53:06 UTC (rev 526) +++ trunk/src/dbf_prscore.pas 2015-08-31 20:19:29 UTC (rev 527) @@ -260,7 +260,6 @@ procedure Func_NOT(Param: PExpressionRec); procedure FuncAdd_S(Param: PExpressionRec); -procedure FuncRecNo(Param: PExpressionRec); procedure FuncSub_S(Param: PExpressionRec); var @@ -360,12 +359,10 @@ ExprTree := MakeTree(ExpColl, 0, ExpColl.Count - 1); FCurrentRec := nil; CheckArguments(ExprTree); -// LinkVariables(ExprTree); + LinkVariables(ExprTree); if Optimize then -// RemoveConstants(ExprTree); OptimizeExpr(ExprTree); // all constant expressions are evaluated and replaced by variables - LinkVariables(ExprTree); FCurrentRec := nil; FExpResultPos := FExpResult; MakeLinkedList(ExprTree, @FExpResult, @FExpResultPos, @FExpResultSize); @@ -1291,6 +1288,7 @@ Result^.ExprWord := nil; Result^.ResetDest := false; Result^.ExpressionContext := @FExpressionContext; + Result^.IsNullPtr := nil; end; procedure TCustomExpressionParser.Evaluate(AnExpression: string); @@ -2592,11 +2590,6 @@ Param^.Res.Append(Param^.Args[0], Len); end; -procedure FuncRecNo(Param: PExpressionRec); -begin - PInteger(Param^.Res.MemoryPos^)^ := -1; -end; - procedure FuncRight(Param: PExpressionRec); var srcLen, index, count: Integer; @@ -2916,7 +2909,6 @@ Add(TFunction.Create('LTRIM', '', 'S', 1, etString, FuncLTrim, '')); Add(TFunction.Create('MONTH', '', 'D', 1, etInteger, FuncMonth, '')); Add(TFunction.Create('PROPER', '', 'S', 1, etString, FuncProper, '')); - Add(TVaryingFunction.Create('RECNO', '', '', 0, etInteger, FuncRecNo, '')); Add(TFunction.Create('RIGHT', '', 'SI', 2, etString, FuncRight, '')); Add(TFunction.Create('ROUND', '', 'FI', 2, etFloat, FuncRound_F_FI, '')); Add(TFunction.Create('ROUND', '', 'FF', 2, etFloat, FuncRound_F_FF, '')); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-01 13:04:44
|
Revision: 529 http://sourceforge.net/p/tdbf/code/529 Author: paulenandrew Date: 2015-09-01 13:04:41 +0000 (Tue, 01 Sep 2015) Log Message: ----------- Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_prscore.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-01 12:53:40 UTC (rev 528) +++ trunk/doc/history.txt 2015-09-01 13:04:41 UTC (rev 529) @@ -156,6 +156,7 @@ - fix exception in TDataSet.Post if State = dsSetKey (Free Pascal) - consistently use little endianness for bookmark (allows it to be passed between architectures to support middle-tier) - do not convert expression to upper case when parsing (in particular, effects string constants) +- fix access violation parsing the expression "," ------------------------ V6.9.1 Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2015-09-01 12:53:40 UTC (rev 528) +++ trunk/src/dbf_prscore.pas 2015-09-01 13:04:41 UTC (rev 529) @@ -722,8 +722,11 @@ if LastItem = FirstItem then begin Result^.ExprWord := TExprWord(Expr.Items[FirstItem]); - Result^.Oper := Result^.ExprWord.ExprFunc; - exit; + if Result^.ExprWord.ResultType <> etComma then + begin + Result^.Oper := Result^.ExprWord.ExprFunc; + exit; + end; end; // no...more complex, find operator with lowest precedence This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-01 13:29:40
|
Revision: 530 http://sourceforge.net/p/tdbf/code/530 Author: paulenandrew Date: 2015-09-01 13:29:37 +0000 (Tue, 01 Sep 2015) Log Message: ----------- fix access violation parsing the expression "()", "(())", etc.; implement error "Empty parentheses" if empty parentheses are used in an expression, eg. "()" or "1 + ()" Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_prscore.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-01 13:04:41 UTC (rev 529) +++ trunk/doc/history.txt 2015-09-01 13:29:37 UTC (rev 530) @@ -157,6 +157,8 @@ - consistently use little endianness for bookmark (allows it to be passed between architectures to support middle-tier) - do not convert expression to upper case when parsing (in particular, effects string constants) - fix access violation parsing the expression "," +- fix access violation parsing the expression "()", "(())", etc. +- implement error "Empty parentheses" if empty parentheses are used in an expression, eg. "()" or "1 + ()" ------------------------ V6.9.1 Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2015-09-01 13:04:41 UTC (rev 529) +++ trunk/src/dbf_prscore.pas 2015-09-01 13:29:37 UTC (rev 530) @@ -670,6 +670,15 @@ I, IArg, IStart, IEnd, lPrec, brCount: Integer; ExprWord: TExprWord; begin + // detect empty brackets + I := FirstItem; + while I < LastItem do + begin + if (TExprWord(Expr.Items[I]).ResultType = etLeftBracket) and (TExprWord(Expr.Items[I + 1]).ResultType = etRightBracket) then + raise EParserError.Create('Empty parentheses'); + Inc(I); + end; + // remove redundant brackets brCount := 0; while (FirstItem+brCount < LastItem) and (TExprWord( This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-01 13:45:25
|
Revision: 531 http://sourceforge.net/p/tdbf/code/531 Author: paulenandrew Date: 2015-09-01 13:45:23 +0000 (Tue, 01 Sep 2015) Log Message: ----------- fix access violation parsing an expression that creates an unquoted empty string constant, eg. "STR(0,0)" Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_prsdef.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-01 13:29:37 UTC (rev 530) +++ trunk/doc/history.txt 2015-09-01 13:45:23 UTC (rev 531) @@ -159,6 +159,7 @@ - fix access violation parsing the expression "," - fix access violation parsing the expression "()", "(())", etc. - implement error "Empty parentheses" if empty parentheses are used in an expression, eg. "()" or "1 + ()" +- fix access violation parsing an expression that creates an unquoted empty string constant, eg. "STR(0,0)" ------------------------ V6.9.1 Modified: trunk/src/dbf_prsdef.pas =================================================================== --- trunk/src/dbf_prsdef.pas 2015-09-01 13:29:37 UTC (rev 530) +++ trunk/src/dbf_prsdef.pas 2015-09-01 13:45:23 UTC (rev 531) @@ -700,14 +700,17 @@ // Isn't there an Unquote function for doing this, anyway? // --- 2014-07-13 twm Len := Length(AValue); - firstChar := AValue[1]; - lastChar := AValue[Len]; - if (firstChar = lastChar) and ((firstChar = '''') or (firstChar = '"')) then begin - s := Copy(AValue, 2, Len - 2); - s := StringReplace(s, firstChar + firstChar, firstChar, [rfReplaceAll, rfIgnoreCase]); - FValue := AnsiString(s); - end else - FValue := AnsiString(AValue); // AnsiString cast added + if Len <> 0 then + begin + firstChar := AValue[1]; + lastChar := AValue[Len]; + if (firstChar = lastChar) and ((firstChar = '''') or (firstChar = '"')) then begin + s := Copy(AValue, 2, Len - 2); + s := StringReplace(s, firstChar + firstChar, firstChar, [rfReplaceAll, rfIgnoreCase]); + FValue := AnsiString(s); + end else + FValue := AnsiString(AValue); // AnsiString cast added + end; end; function TStringConstant.AsPointer: PAnsiChar; // Was PChar This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-01 14:15:00
|
Revision: 532 http://sourceforge.net/p/tdbf/code/532 Author: paulenandrew Date: 2015-09-01 14:14:57 +0000 (Tue, 01 Sep 2015) Log Message: ----------- fix "List index out of bounds (0)" trying to evaluate a field-based expression after 'Field "<...>" is an invalid field type to based index on Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_parser.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-01 13:45:23 UTC (rev 531) +++ trunk/doc/history.txt 2015-09-01 14:14:57 UTC (rev 532) @@ -160,6 +160,7 @@ - fix access violation parsing the expression "()", "(())", etc. - implement error "Empty parentheses" if empty parentheses are used in an expression, eg. "()" or "1 + ()" - fix access violation parsing an expression that creates an unquoted empty string constant, eg. "STR(0,0)" +- fix "List index out of bounds (0)" trying to evaluate a field-based expression after 'Field "<...>" is an invalid field type to based index on' ------------------------ V6.9.1 Modified: trunk/src/dbf_parser.pas =================================================================== --- trunk/src/dbf_parser.pas 2015-09-01 13:45:23 UTC (rev 531) +++ trunk/src/dbf_parser.pas 2015-09-01 14:14:57 UTC (rev 532) @@ -606,6 +606,8 @@ begin inherited; + FFieldType := etUnknown; + // test if already freed if FFieldVarList <> nil then begin @@ -679,11 +681,19 @@ IsNull := LastRec^.IsNullPtr^; end else begin // simple field, get field result - Result := TFieldVar(FFieldVarList.Objects[0]).FieldVal; - // if string then dereference - if FFieldType = etString then - Result := PAnsiChar(PPAnsiChar(Result)^); // Was PPChar - IsNull := TFieldVar(FFieldVarList.Objects[0]).IsNullPtr^; + if FFieldVarList.Count <> 0 then + begin + Result := TFieldVar(FFieldVarList.Objects[0]).FieldVal; + // if string then dereference + if FFieldType = etString then + Result := PAnsiChar(PPAnsiChar(Result)^); // Was PPChar + IsNull := TFieldVar(FFieldVarList.Objects[0]).IsNullPtr^; + end + else + begin + Result := PAnsiChar(ExpResult); + IsNull := False; + end; end; end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-01 15:57:13
|
Revision: 534 http://sourceforge.net/p/tdbf/code/534 Author: paulenandrew Date: 2015-09-01 15:57:10 +0000 (Tue, 01 Sep 2015) Log Message: ----------- change STRING_INDEX_BASED_ON_UNKNOWN_FIELD and STRING_INDEX_BASED_ON_INVALID_FIELD messages so that they make sense for a filter as well as for an index Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_parser.pas trunk/src/dbf_str.inc trunk/src/dbf_str.pas trunk/src/dbf_str_de.pas trunk/src/dbf_str_es.pas trunk/src/dbf_str_fr.pas trunk/src/dbf_str_ita.pas trunk/src/dbf_str_nl.pas trunk/src/dbf_str_pl.pas trunk/src/dbf_str_pt.pas trunk/src/dbf_str_ru.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/doc/history.txt 2015-09-01 15:57:10 UTC (rev 534) @@ -161,6 +161,7 @@ - implement error "Empty parentheses" if empty parentheses are used in an expression, eg. "()" or "1 + ()" - fix access violation parsing an expression that creates an unquoted empty string constant, eg. "STR(0,0)" - fix "List index out of bounds (0)" trying to evaluate a field-based expression after 'Field "<...>" is an invalid field type to based index on' +- change STRING_INDEX_BASED_ON_UNKNOWN_FIELD and STRING_INDEX_BASED_ON_INVALID_FIELD messages so that they make sense for a filter as well as for an index ------------------------ V6.9.1 Modified: trunk/src/dbf_parser.pas =================================================================== --- trunk/src/dbf_parser.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_parser.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -539,7 +539,7 @@ // is this variable a fieldname? FieldInfo := GetVariableInfo(VarName); if FieldInfo = nil then - raise ExceptionClass.CreateFmt(STRING_INDEX_BASED_ON_UNKNOWN_FIELD, [VarName]); + raise ExceptionClass.CreateFmt(STRING_PARSER_UNKNOWN_FIELD, [VarName]); // define field in parser FillChar(VariableFieldInfo, SizeOf(VariableFieldInfo), 0); @@ -588,7 +588,7 @@ TempFieldVar.ExprWord := DefineDateTimeVariable(VarName, TempFieldVar.FieldVal, TempFieldVar.IsNullPtr, @VariableFieldInfo); end; else - raise ExceptionClass.CreateFmt(STRING_INDEX_BASED_ON_INVALID_FIELD, [VarName]); + raise ExceptionClass.CreateFmt(STRING_PARSER_INVALID_FIELDTYPE, [VarName]); end; // add to our own list Modified: trunk/src/dbf_str.inc =================================================================== --- trunk/src/dbf_str.inc 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str.inc 2015-09-01 15:57:10 UTC (rev 534) @@ -15,8 +15,8 @@ STRING_INVALID_VCL_FIELD_TYPE: string; STRING_INVALID_MDX_FILE: string; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD: string; - STRING_INDEX_BASED_ON_INVALID_FIELD: string; + STRING_PARSER_UNKNOWN_FIELD: string; + STRING_PARSER_INVALID_FIELDTYPE: string; STRING_INDEX_EXPRESSION_TOO_LONG: string; STRING_INVALID_INDEX_TYPE: string; STRING_CANNOT_OPEN_INDEX: string; Modified: trunk/src/dbf_str.pas =================================================================== --- trunk/src/dbf_str.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -28,8 +28,8 @@ STRING_INVALID_VCL_FIELD_TYPE := 'Cannot create field "%s", VCL field type %x not supported by DBF.'; STRING_INVALID_MDX_FILE := 'Invalid MDX file.'; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Index based on unknown field "%s".'; - STRING_INDEX_BASED_ON_INVALID_FIELD := 'Field "%s" is an invalid field type to base index on.'; + STRING_PARSER_UNKNOWN_FIELD := 'Unknown field "%s".'; + STRING_PARSER_INVALID_FIELDTYPE := 'Invalid field type for field ''%s''.'; STRING_INDEX_EXPRESSION_TOO_LONG := 'Index result for "%s" too long, >100 characters (%d).'; STRING_INVALID_INDEX_TYPE := 'Invalid index type: can only be string or float.'; STRING_CANNOT_OPEN_INDEX := 'Cannot open index: "%s".'; Modified: trunk/src/dbf_str_de.pas =================================================================== --- trunk/src/dbf_str_de.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str_de.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -28,8 +28,8 @@ STRING_INVALID_VCL_FIELD_TYPE := 'Feld "%s" kann nicht erzeugt werden: VCL-Feldtyp %x wird nicht von DBF unterst\xFCtzt.'; STRING_INVALID_MDX_FILE := 'Ung\xFCltige MDX-Datei.'; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Index basiert auf unbekanntem Feld "%s".'; - STRING_INDEX_BASED_ON_INVALID_FIELD := 'Feld "%s" hat ung\xFCltigen Feldtyp f\xFCr einen Index.'; + STRING_PARSER_UNKNOWN_FIELD := 'Unbekanntem Feld "%s".'; + STRING_PARSER_INVALID_FIELDTYPE := 'Ung\xFCltiger Feldtyp f\xFCr das Feld ''%s''.'; STRING_INDEX_EXPRESSION_TOO_LONG := 'Das Ergebnis des Index-Ausdrucks "%s" ist zu lang, >100 Zeichen (%d).'; STRING_INVALID_INDEX_TYPE := 'Ung\xFCltiger Indextyp: nur Zeichen oder Numerisch erlaubt.'; STRING_CANNOT_OPEN_INDEX := '\xD6ffnen des Index ist gescheitert: "%s".'; Modified: trunk/src/dbf_str_es.pas =================================================================== --- trunk/src/dbf_str_es.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str_es.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -28,8 +28,8 @@ STRING_INVALID_VCL_FIELD_TYPE := 'No se puede crear el campo "%s", campo VCL tipo %x no soportado por DBF.'; STRING_INVALID_MDX_FILE := 'Archivo MDX inv\xE1lido.'; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Indice basado en campo desconocido "%s".'; - STRING_INDEX_BASED_ON_INVALID_FIELD := 'Campo "%s" inv\xE1lido para crear un \xEDndice.'; + STRING_PARSER_UNKNOWN_FIELD := 'Campo desconocido "%s".'; + STRING_PARSER_INVALID_FIELDTYPE := 'Tipo de campo inv\xE1lido para el campo ''%s''.'; STRING_INDEX_EXPRESSION_TOO_LONG := 'Resultado de \xEDndice para "%s" demasiado largo, >100 caracteres (%d).'; STRING_INVALID_INDEX_TYPE := 'Tipo de \xEDndice invalido: solo puede ser string o float.'; STRING_CANNOT_OPEN_INDEX := 'No se puede abrir el \xEDndice: "%s".'; Modified: trunk/src/dbf_str_fr.pas =================================================================== --- trunk/src/dbf_str_fr.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str_fr.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -28,8 +28,8 @@ STRING_INVALID_VCL_FIELD_TYPE := 'Impossible de cr\xE9er le champ "%s", champ type %x VCL non support\xE9 par DBF'; STRING_INVALID_MDX_FILE := 'Fichier MDX invalide.'; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Index bas\xE9 sur un champ inconnu %s'; - STRING_INDEX_BASED_ON_INVALID_FIELD := 'Impossible de contruire un index sur ce type de champ "%s"'; + STRING_PARSER_UNKNOWN_FIELD := 'Champ inconnu %s'; + STRING_PARSER_INVALID_FIELDTYPE := 'Type de champ invalide pour le champ %s'; STRING_INDEX_EXPRESSION_TOO_LONG := 'R\xE9sultat d''Index trop long pour "%s", >100 caract\xE8res (%d).'; STRING_INVALID_INDEX_TYPE := 'Type d''index non valide: doit \xEAtre string ou float'; STRING_CANNOT_OPEN_INDEX := 'Impossible d''ouvrir l''index: "%s"'; Modified: trunk/src/dbf_str_ita.pas =================================================================== --- trunk/src/dbf_str_ita.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str_ita.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -28,8 +28,8 @@ STRING_INVALID_VCL_FIELD_TYPE := 'Non pu\xF2 creare campo "%s", tipo di campo VCL %x non supportato da DBF.'; STRING_INVALID_MDX_FILE := 'File MDX non valido.'; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Indice basato su un campo sconosciuto "%s"'; - STRING_INDEX_BASED_ON_INVALID_FIELD := 'Campo "%s" \xE8 di tipo non valido per un indice'; + STRING_PARSER_UNKNOWN_FIELD := 'Campo sconosciuto "%s"'; + STRING_PARSER_INVALID_FIELDTYPE := 'Tipo di campo non valido per il campo ''%s''.'; STRING_INDEX_EXPRESSION_TOO_LONG := 'Risultato index per "%s" troppo a lungo, >100 caratteri (%d).'; STRING_INVALID_INDEX_TYPE := 'Tipo indice non valido: Pu\xF2 essere solo string o float'; STRING_CANNOT_OPEN_INDEX := 'Non \xE8 possibile aprire indice : "%s"'; Modified: trunk/src/dbf_str_nl.pas =================================================================== --- trunk/src/dbf_str_nl.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str_nl.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -28,8 +28,8 @@ STRING_INVALID_VCL_FIELD_TYPE := 'Veld "%s": VCL veldtype %x wordt niet ondersteund door DBF.'; STRING_INVALID_MDX_FILE := 'Ongeldig MDX bestand.'; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Index gebaseerd op onbekend veld "%s".'; - STRING_INDEX_BASED_ON_INVALID_FIELD := 'Veld "%s" heeft een ongeldig veldtype om index op te baseren.'; + STRING_PARSER_UNKNOWN_FIELD := 'Onbekend veld "%s".'; + STRING_PARSER_INVALID_FIELDTYPE := 'Veldtype is ongeldig voor veld ''%s''.'; STRING_INDEX_EXPRESSION_TOO_LONG := 'Index expressie resultaat "%s" is te lang, >100 karakters (%d).'; STRING_INVALID_INDEX_TYPE := 'Ongeldig index type: kan alleen karakter of numeriek.'; STRING_CANNOT_OPEN_INDEX := 'Openen index gefaald: "%s".'; Modified: trunk/src/dbf_str_pl.pas =================================================================== --- trunk/src/dbf_str_pl.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str_pl.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -28,8 +28,8 @@ STRING_INVALID_VCL_FIELD_TYPE := 'Nie mog\xEA tworzy\xE6 pola "%s", typ pola VCL %x nie wspierany przez DBF.'; STRING_INVALID_MDX_FILE := 'Uszkodzony plik bazy.'; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD := 'Kluczowe pole indeksu "%s" nie istnieje'; - STRING_INDEX_BASED_ON_INVALID_FIELD := 'Typ pola "%s" niedozwolony dla indeks\xF3w'; + STRING_PARSER_UNKNOWN_FIELD := '"%s" nie istnieje'; + STRING_PARSER_INVALID_FIELDTYPE := 'B\xB3\xEAdny typ pola dla pola ''%s''.'; STRING_INDEX_EXPRESSION_TOO_LONG := 'Zbyt d\xB3ugi wynik "%s", >100 znak\xF3w (%d).'; STRING_INVALID_INDEX_TYPE := 'Z\xB3y typ indeksu: tylko string lub float'; STRING_CANNOT_OPEN_INDEX := 'Nie mog\xEA otworzy\xE6 indeksu: "%s"'; Modified: trunk/src/dbf_str_pt.pas =================================================================== --- trunk/src/dbf_str_pt.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str_pt.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -28,8 +28,8 @@ STRING_INVALID_VCL_FIELD_TYPE := 'N\xE3o se pode criar o campo "%s", campo VCL tipo %x n\xE3o suportado por DBF.'; STRING_INVALID_MDX_FILE := 'Arquivo MDX inv\xE1lido.'; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD := '\xCDndice baseado em campo desconhecido "%s".'; - STRING_INDEX_BASED_ON_INVALID_FIELD := 'Campo "%s" inv\xE1lido para criar um \xEDndice.'; + STRING_PARSER_UNKNOWN_FIELD := 'Campo desconhecido "%s".'; + STRING_PARSER_INVALID_FIELDTYPE := 'Tipo de campo inv\xE1lido para o campo ''%s''.'; STRING_INDEX_EXPRESSION_TOO_LONG := 'Resultado de \xEDndice para "%s" demasiado grande, >100 caracteres (%d).'; STRING_INVALID_INDEX_TYPE := 'Tipo de \xEDndice inv\xE1lido: s\xF3 pode ser string ou float.'; STRING_CANNOT_OPEN_INDEX := 'N\xE3o se pode abrir o \xEDndice: "%s".'; Modified: trunk/src/dbf_str_ru.pas =================================================================== --- trunk/src/dbf_str_ru.pas 2015-09-01 14:47:57 UTC (rev 533) +++ trunk/src/dbf_str_ru.pas 2015-09-01 15:57:10 UTC (rev 534) @@ -31,8 +31,8 @@ STRING_INVALID_VCL_FIELD_TYPE := '\xCD\xE5\xE2\xEE\xE7\xEC\xEE\xE6\xED\xEE \xF1\xEE\xE7\xE4\xE0\xF2\xFC \xEF\xEE\xEB\xE5 "%s", \xD2\xE8\xEF \xE4\xE0\xED\xED\xFB\xF5 VCL[%x] \xED\xE5 \xEC\xEE\xE6\xE5\xF2 \xE1\xFB\xF2\xFC \xE7\xE0\xEF\xE8\xF1\xE0\xED \xE2 DBF.'; STRING_INVALID_MDX_FILE := '\xD4\xE0\xE9\xEB MDX \xEF\xEE\xE2\xF0\xE5\xE6\xE4\xE5\xED \xE8\xEB\xE8 \xE5\xE3\xEE \xF1\xF2\xF0\xF3\xEA\xF2\xF3\xF0\xE0 \xED\xE5 MDX.'; - STRING_INDEX_BASED_ON_UNKNOWN_FIELD := '\xC8\xED\xE4\xE5\xEA\xF1 \xF1\xF1\xFB\xEB\xE0\xE5\xF2\xF1\xFF \xED\xE0 \xED\xE5\xF1\xF3\xF9\xE5\xF1\xF2\xE2\xF3\xFE\xF9\xE5\xE5 \xEF\xEE\xEB\xE5 "%s".'; - STRING_INDEX_BASED_ON_INVALID_FIELD := '\xCF\xEE\xEB\xE5 "%s" \xED\xE5 \xEC\xEE\xE6\xE5\xF2 \xE1\xFB\xF2\xFC \xE8\xED\xE4\xE5\xEA\xF1\xE8\xF0\xEE\xE2\xE0\xED\xED\xEE. \xC8\xED\xE4\xE5\xEA\xF1\xFB \xED\xE5 \xEF\xEE\xE4\xE4\xE5\xF0\xE6\xE8\xE2\xE0\xFE\xF2 \xF2\xE0\xEA\xEE\xE9 \xF2\xE8\xEF \xEF\xEE\xEB\xFF.'; + STRING_PARSER_UNKNOWN_FIELD := '\xCD\xE5\xF1\xF3\xF9\xE5\xF1\xF2\xE2\xF3\xFE\xF9\xE5\xE5 \xEF\xEE\xEB\xE5 "%s".'; + STRING_PARSER_INVALID_FIELDTYPE := '\xD2\xE8\xEF \xE7\xED\xE0\xF7\xE5\xED\xE8\xFF, \xE7\xE0\xF2\xF0\xE5\xE1\xEE\xE2\xE0\xED\xED\xFB\xE9 \xEF\xEE\xEB\xE5\xEC "%s" \xED\xE5\xE2\xEE\xE7\xEC\xEE\xE6\xE5\xED.'; STRING_INDEX_EXPRESSION_TOO_LONG := '%s: \xD1\xEB\xE8\xF8\xEA\xEE\xEC \xE4\xEB\xE8\xED\xED\xEE\xE5 \xE7\xED\xE0\xF7\xE5\xED\xE8\xE5 \xE4\xEB\xFF \xE8\xED\xE4\xE5\xEA\xF1\xE0 (%d). \xC4\xEE\xEB\xE6\xED\xEE \xE1\xFB\xF2\xFC \xED\xE5 \xE1\xEE\xEB\xFC\xF8\xE5 100 \xF1\xE8\xEC\xE2\xEE\xEB\xEE\xE2.'; STRING_INVALID_INDEX_TYPE := '\xCD\xE5\xE2\xEE\xE7\xEC\xEE\xE6\xED\xFB\xE9 \xF2\xE8\xEF \xE8\xED\xE4\xE5\xEA\xF1\xE0: \xE8\xED\xE4\xE5\xEA\xF1\xE0\xF6\xE8\xFF \xE2\xEE\xE7\xEC\xEE\xE6\xED\xEE \xF2\xEE\xEB\xFC\xEA\xEE \xEF\xEE \xF7\xE8\xF1\xEB\xF3 \xE8\xEB\xE8 \xF1\xF2\xF0\xEE\xEA\xE5'; STRING_CANNOT_OPEN_INDEX := '\xCD\xE5\xE2\xEE\xE7\xEC\xEE\xE6\xED\xEE \xEE\xF2\xEA\xF0\xFB\xF2\xFC \xE8\xED\xE4\xE5\xEA\xF1 "%s".'; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-02 20:19:30
|
Revision: 536 http://sourceforge.net/p/tdbf/code/536 Author: paulenandrew Date: 2015-09-02 20:19:27 +0000 (Wed, 02 Sep 2015) Log Message: ----------- add flexibility to the parser allowing overriding reading a word and adding a field variable Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_parser.pas trunk/src/dbf_prscore.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-01 19:03:02 UTC (rev 535) +++ trunk/doc/history.txt 2015-09-02 20:19:27 UTC (rev 536) @@ -162,6 +162,7 @@ - fix access violation parsing an expression that creates an unquoted empty string constant, eg. "STR(0,0)" - fix "List index out of bounds (0)" trying to evaluate a field-based expression after 'Field "<...>" is an invalid field type to based index on' - change STRING_INDEX_BASED_ON_UNKNOWN_FIELD and STRING_INDEX_BASED_ON_INVALID_FIELD messages so that they make sense for a filter as well as for an index +- add flexibility to the parser allowing ReadWord and GetVariableInfo to be overriden ------------------------ V6.9.1 Modified: trunk/src/dbf_parser.pas =================================================================== --- trunk/src/dbf_parser.pas 2015-09-01 19:03:02 UTC (rev 535) +++ trunk/src/dbf_parser.pas 2015-09-02 20:19:27 UTC (rev 536) @@ -43,7 +43,7 @@ procedure FillExpressList; override; procedure HandleUnknownVariable(VarName: string); override; - function GetVariableInfo(VarName: AnsiString): TDbfFieldDef; + function GetVariableInfo(VarName: AnsiString): TDbfFieldDef; virtual; function CurrentExpression: string; override; procedure ValidateExpression(AExpression: string); virtual; function GetResultType: TExpressionType; override; Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2015-09-01 19:03:02 UTC (rev 535) +++ trunk/src/dbf_prscore.pas 2015-09-02 20:19:27 UTC (rev 536) @@ -81,6 +81,7 @@ function IsIndex: Boolean; virtual; procedure OptimizeExpr(var ExprRec: PExpressionRec); virtual; function ExceptionClass: TExceptionClass; virtual; + procedure ReadWord(const AnExpr: string; var isConstant: Boolean; var I1, I2: Integer; Len: Integer); virtual; property CurrentRec: PExpressionRec read FCurrentRec write FCurrentRec; property LastRec: PExpressionRec read FLastRec write FLastRec; @@ -821,164 +822,17 @@ I, I1, I2, Len, DecSep: Integer; W, S: string; TempWord: TExprWord; - - procedure ReadConstant(AnExpr: string; isHex: Boolean); - begin - isConstant := true; - - while (I2 <= Len) and (CharInSet(AnExpr[I2], ['0'..'9']) or - (isHex and CharInSet(AnExpr[I2], ['a'..'f', 'A'..'F']))) do - Inc(I2); - if I2 <= Len then - begin - if AnExpr[I2] = FDecimalSeparator then - begin - Inc(I2); - while (I2 <= Len) and CharInSet(AnExpr[I2], ['0'..'9']) do - Inc(I2); - end; - if (I2 <= Len) and (AnExpr[I2] = 'e') then - begin - Inc(I2); - if (I2 <= Len) and CharInSet(AnExpr[I2], ['+', '-']) then - Inc(I2); - while (I2 <= Len) and CharInSet(AnExpr[I2], ['0'..'9']) do - Inc(I2); - end; - end; - end; - - procedure ReadWord(AnExpr: string); - var - OldI2: Integer; - constChar: Char; - begin - isConstant := false; - I1 := I2; - while (I1 < Len) and (AnExpr[I1] = ' ') do - Inc(I1); - I2 := I1; - if I1 <= Len then - begin - if AnExpr[I2] = HexChar then - begin - Inc(I2); - OldI2 := I2; - ReadConstant(AnExpr, true); - if I2 = OldI2 then - begin - isConstant := false; - while (I2 <= Len) and CharInSet(AnExpr[I2], ['a'..'z', 'A'..'Z', '_', '0'..'9']) do - Inc(I2); - end; - end - else if AnExpr[I2] = FDecimalSeparator then - ReadConstant(AnExpr, false) - else - // String constants can be delimited by ' or " - // but need not be - see below - // To use a delimiter inside the string, double it up to escape it - case AnExpr[I2] of - '''', '"': - begin - isConstant := true; - constChar := AnExpr[I2]; - Inc(I2); - while (I2 <= Len) do begin - // Regular character? - if (AnExpr[I2] <> constChar) then - Inc(I2) - else begin - // we do have a const, now check for escaped consts - if (I2 + 1 <= Len) and - (AnExpr[I2 + 1] = constChar) then begin - Inc(I2,2) //skip past, deal with duplicates later - end else begin - // at the trailing delimiter - Inc(I2); //move past delimiter - break; - end; - end; - end; - end; - // However string constants can also appear without delimiters - 'a'..'z', 'A'..'Z', '_': - begin - while (I2 <= Len) and CharInSet(AnExpr[I2], ['a'..'z', 'A'..'Z', '_', '0'..'9']) do - Inc(I2); - end; - '>', '<': - begin - if (I2 <= Len) then - Inc(I2); - if CharInSet(AnExpr[I2], ['=', '<', '>']) then - Inc(I2); - end; - '=': - begin - if (I2 <= Len) then - Inc(I2); - if CharInSet(AnExpr[I2], ['=', '<', '>']) then - Inc(I2); - end; - '&': - begin - if (I2 <= Len) then - Inc(I2); - if CharInSet(AnExpr[I2], ['&']) then - Inc(I2); - end; - '|': - begin - if (I2 <= Len) then - Inc(I2); - if CharInSet(AnExpr[I2], ['|']) then - Inc(I2); - end; - ':': - begin - if (I2 <= Len) then - Inc(I2); - if AnExpr[I2] = '=' then - Inc(I2); - end; - '!': - begin - if (I2 <= Len) then - Inc(I2); - if AnExpr[I2] = '=' then //support for != - Inc(I2); - end; - '+': - begin - Inc(I2); - if (AnExpr[I2] = '+') and FWordsList.Search(PChar('++'), I) then // PChar intended here - Inc(I2); - end; - '-': - begin - Inc(I2); - if (AnExpr[I2] = '-') and FWordsList.Search(PChar('--'), I) then // PChar intended here - Inc(I2); - end; - '^', '/', '\', '*', '(', ')', '%', '~', '$': - Inc(I2); - '0'..'9': - ReadConstant(AnExpr, false); - else - begin - Inc(I2); - end; - end; - end; - end; - begin I2 := 1; S := Trim(AnExpression); Len := Length(S); repeat - ReadWord(S); + isConstant := false; + I1 := I2; + while (I1 < Len) and (S[I1] = ' ') do + Inc(I1); + I2 := I1; + ReadWord(S, isConstant, I1, I2, Len); W := Trim(Copy(S, I1, I2 - I1)); if isConstant then begin @@ -1286,6 +1140,155 @@ Result := EParserError; end; +procedure TCustomExpressionParser.ReadWord(const AnExpr: string; + var isConstant: Boolean; var I1, I2: Integer; Len: Integer); +var + I: Integer; + OldI2: Integer; + constChar: Char; + + procedure ReadConstant(AnExpr: string; isHex: Boolean); + begin + isConstant := true; + + while (I2 <= Len) and (CharInSet(AnExpr[I2], ['0'..'9']) or + (isHex and CharInSet(AnExpr[I2], ['a'..'f', 'A'..'F']))) do + Inc(I2); + if I2 <= Len then + begin + if AnExpr[I2] = FDecimalSeparator then + begin + Inc(I2); + while (I2 <= Len) and CharInSet(AnExpr[I2], ['0'..'9']) do + Inc(I2); + end; + if (I2 <= Len) and (AnExpr[I2] = 'e') then + begin + Inc(I2); + if (I2 <= Len) and CharInSet(AnExpr[I2], ['+', '-']) then + Inc(I2); + while (I2 <= Len) and CharInSet(AnExpr[I2], ['0'..'9']) do + Inc(I2); + end; + end; + end; + +begin + if I1 <= Len then + begin + if AnExpr[I2] = HexChar then + begin + Inc(I2); + OldI2 := I2; + ReadConstant(AnExpr, true); + if I2 = OldI2 then + begin + isConstant := false; + while (I2 <= Len) and CharInSet(AnExpr[I2], ['a'..'z', 'A'..'Z', '_', '0'..'9']) do + Inc(I2); + end; + end + else if AnExpr[I2] = FDecimalSeparator then + ReadConstant(AnExpr, false) + else + // String constants can be delimited by ' or " + // but need not be - see below + // To use a delimiter inside the string, double it up to escape it + case AnExpr[I2] of + '''', '"': + begin + isConstant := true; + constChar := AnExpr[I2]; + Inc(I2); + while (I2 <= Len) do begin + // Regular character? + if (AnExpr[I2] <> constChar) then + Inc(I2) + else begin + // we do have a const, now check for escaped consts + if (I2 + 1 <= Len) and + (AnExpr[I2 + 1] = constChar) then begin + Inc(I2,2) //skip past, deal with duplicates later + end else begin + // at the trailing delimiter + Inc(I2); //move past delimiter + break; + end; + end; + end; + end; + // However string constants can also appear without delimiters + 'a'..'z', 'A'..'Z', '_': + begin + while (I2 <= Len) and CharInSet(AnExpr[I2], ['a'..'z', 'A'..'Z', '_', '0'..'9']) do + Inc(I2); + end; + '>', '<': + begin + if (I2 <= Len) then + Inc(I2); + if CharInSet(AnExpr[I2], ['=', '<', '>']) then + Inc(I2); + end; + '=': + begin + if (I2 <= Len) then + Inc(I2); + if CharInSet(AnExpr[I2], ['=', '<', '>']) then + Inc(I2); + end; + '&': + begin + if (I2 <= Len) then + Inc(I2); + if CharInSet(AnExpr[I2], ['&']) then + Inc(I2); + end; + '|': + begin + if (I2 <= Len) then + Inc(I2); + if CharInSet(AnExpr[I2], ['|']) then + Inc(I2); + end; + ':': + begin + if (I2 <= Len) then + Inc(I2); + if AnExpr[I2] = '=' then + Inc(I2); + end; + '!': + begin + if (I2 <= Len) then + Inc(I2); + if AnExpr[I2] = '=' then //support for != + Inc(I2); + end; + '+': + begin + Inc(I2); + if (AnExpr[I2] = '+') and FWordsList.Search(PChar('++'), I) then // PChar intended here + Inc(I2); + end; + '-': + begin + Inc(I2); + if (AnExpr[I2] = '-') and FWordsList.Search(PChar('--'), I) then // PChar intended here + Inc(I2); + end; + '^', '/', '\', '*', '(', ')', '%', '~', '$': + Inc(I2); + '0'..'9': + ReadConstant(AnExpr, false); + else + begin + Inc(I2); + end; + end; + end; +end; + function TCustomExpressionParser.MakeRec: PExpressionRec; var I: Integer; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-03 12:12:10
|
Revision: 539 http://sourceforge.net/p/tdbf/code/539 Author: paulenandrew Date: 2015-09-03 12:12:07 +0000 (Thu, 03 Sep 2015) Log Message: ----------- add flexibility to the parser allowing custom parsing of constants and date/time constants Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_prscore.pas trunk/src/dbf_prsdef.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-02 21:13:12 UTC (rev 538) +++ trunk/doc/history.txt 2015-09-03 12:12:07 UTC (rev 539) @@ -163,6 +163,7 @@ - fix "List index out of bounds (0)" trying to evaluate a field-based expression after 'Field "<...>" is an invalid field type to based index on' - change STRING_INDEX_BASED_ON_UNKNOWN_FIELD and STRING_INDEX_BASED_ON_INVALID_FIELD messages so that they make sense for a filter as well as for an index - add flexibility to the parser allowing ReadWord and GetVariableInfo to be overriden +- add flexibility to the parser allowing custom parsing of constants and date/time constants ------------------------ V6.9.1 Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2015-09-02 21:13:12 UTC (rev 538) +++ trunk/src/dbf_prscore.pas 2015-09-03 12:12:07 UTC (rev 539) @@ -82,6 +82,7 @@ procedure OptimizeExpr(var ExprRec: PExpressionRec); virtual; function ExceptionClass: TExceptionClass; virtual; procedure ReadWord(const AnExpr: string; var isConstant: Boolean; var I1, I2: Integer; Len: Integer); virtual; + function CreateConstant(W: string): TConstant; virtual; property CurrentRec: PExpressionRec read FCurrentRec write FCurrentRec; property LastRec: PExpressionRec read FLastRec write FLastRec; @@ -530,6 +531,7 @@ etLargeInt:ExprWord := TLargeIntConstant.Create(PInt64(FExpResult)^); {$endif} etString: ExprWord := TStringConstant.Create(string(FExpResult)); // Added string cast + etDateTime: ExprWord := TDateTimeConstant.Create(EmptyStr, PDateTime(FExpResult)^); end; // fill in structure @@ -819,7 +821,7 @@ procedure TCustomExpressionParser.ParseString(AnExpression: string; DestCollection: TExprCollection); var isConstant: Boolean; - I, I1, I2, Len, DecSep: Integer; + I, I1, I2, Len: Integer; W, S: string; TempWord: TExprWord; begin @@ -836,31 +838,12 @@ W := Trim(Copy(S, I1, I2 - I1)); if isConstant then begin - if W[1] = HexChar then + if W <> '' then begin - // convert hexadecimal to decimal - W[1] := '$'; - W := IntToStr(StrToInt(W)); + TempWord := CreateConstant(W); + DestCollection.Add(TempWord); + FConstantsList.Add(TempWord); end; - if (W[1] = '''') or (W[1] = '"') then begin - // StringConstant will handle any escaped quotes - TempWord := TStringConstant.Create(W); - end else begin - DecSep := Pos(FDecimalSeparator, W); - if (DecSep > 0) then - begin -{$IFDEF ENG_NUMBERS} - // we'll have to convert FDecimalSeparator into DecimalSeparator - // otherwise the OS will not understand what we mean - W[DecSep] := DecimalSeparator; -{$ENDIF} - TempWord := TFloatConstant.Create(W, W) - end else begin - TempWord := TIntegerConstant.Create(StrToInt(W)); - end; - end; - DestCollection.Add(TempWord); - FConstantsList.Add(TempWord); end else if Length(W) > 0 then if FWordsList.Search(PChar(W), I) then // PChar intended here @@ -1289,6 +1272,35 @@ end; end; +function TCustomExpressionParser.CreateConstant(W: string): TConstant; +var + DecSep: Integer; +begin + if W[1] = HexChar then + begin + // convert hexadecimal to decimal + W[1] := '$'; + W := IntToStr(StrToInt(W)); + end; + if (W[1] = '''') or (W[1] = '"') then begin + // StringConstant will handle any escaped quotes + Result := TStringConstant.Create(W); + end else begin + DecSep := Pos(FDecimalSeparator, W); + if (DecSep > 0) then + begin + {$IFDEF ENG_NUMBERS} + // we'll have to convert FDecimalSeparator into DecimalSeparator + // otherwise the OS will not understand what we mean + W[DecSep] := DecimalSeparator; + {$ENDIF} + Result := TFloatConstant.Create(W, W) + end else begin + Result := TIntegerConstant.Create(StrToInt(W)); + end; + end; +end; + function TCustomExpressionParser.MakeRec: PExpressionRec; var I: Integer; Modified: trunk/src/dbf_prsdef.pas =================================================================== --- trunk/src/dbf_prsdef.pas 2015-09-02 21:13:12 UTC (rev 538) +++ trunk/src/dbf_prsdef.pas 2015-09-03 12:12:07 UTC (rev 539) @@ -248,6 +248,15 @@ property Value: Boolean read FValue write FValue; end; + TDateTimeConstant = class(TConstant) + private + FValue: TDateTime; + public + constructor Create(AName: string; AValue: TDateTime); + function AsPointer: PAnsiChar; override; + property Value: TDateTime read FValue write FValue; + end; + TVariableFieldInfo = record DbfFieldDef: Pointer; NativeFieldType: Char; @@ -762,6 +771,20 @@ end; {$endif} +{ TDateTimeConstant } + +constructor TDateTimeConstant.Create(AName: string; AValue: TDateTime); +begin + inherited Create(AName, etDateTime, _DateTimeVariable); + + FValue := AValue; +end; + +function TDateTimeConstant.AsPointer: PAnsiChar; +begin + Result := PAnsiChar(@FValue); +end; + { TVariable } constructor TVariable.Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc; AIsNullPtr: PBoolean; AFieldInfo: PVariableFieldInfo); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-18 11:47:15
|
Revision: 547 http://sourceforge.net/p/tdbf/code/547 Author: paulenandrew Date: 2015-09-18 11:47:12 +0000 (Fri, 18 Sep 2015) Log Message: ----------- Merge revisions 540 to 546 from branches/paulenandrew to trunk Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf.pas trunk/src/dbf_ansistrings.pas trunk/src/dbf_collate.pas trunk/src/dbf_dbffile.pas trunk/src/dbf_idxfile.pas trunk/src/dbf_parser.pas trunk/src/dbf_prscore.pas trunk/src/dbf_prsdef.pas trunk/src/dbf_prssupp.pas trunk/src/dbf_soundex.inc Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/doc/history.txt 2015-09-18 11:47:12 UTC (rev 547) @@ -123,7 +123,6 @@ - add TDbf.BatchMove method (similar to BDE batch move) - if there is no active record, preventing it from reading the table twice (forwards then backwards) - do not use OnIndexMissing with a FoxPro table -- do not convert index expression to upper case - treat level 7 null value the same as an empty value when comparing Character (C) index keys (consistent with BDE) - add more robust Str() function to parser - add concept of null value to parser, use it to implement DTOS(null) = null instead of "18991230" @@ -164,6 +163,8 @@ - change STRING_INDEX_BASED_ON_UNKNOWN_FIELD and STRING_INDEX_BASED_ON_INVALID_FIELD messages so that they make sense for a filter as well as for an index - add flexibility to the parser allowing ReadWord and GetVariableInfo to be overriden - add flexibility to the parser allowing custom parsing of constants and date/time constants +- fix compiler errors in Delphi XE, mostly related to use of PChar instead of PAnsiChar +- fix to allow all 32 characters of a level 7 index tag name to be used ------------------------ V6.9.1 Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf.pas 2015-09-18 11:47:12 UTC (rev 547) @@ -353,7 +353,11 @@ function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; procedure CheckDbfFieldDefs(ADbfFieldDefs: TDbfFieldDefs); + {$ifdef DELPHI_XE} + procedure DataEvent(Event: TDataEvent; Info: NativeInt); override; + {$else} procedure DataEvent(Event: TDataEvent; Info: {$ifdef FPC_VERSION}Ptrint{$else}Longint{$endif}); override; + {$endif} // my own methods and properties // most look like ttable functions but they are not tdataset related @@ -755,7 +759,7 @@ case State of dsFilter: Result := TDbfRecordBuffer(FFilterBuffer); dsCalcFields: Result := TDbfRecordBuffer(CalcBuffer); - dsSetKey: Result := GetKeyBuffer; + dsSetKey: Result := TDbfRecordBuffer(GetKeyBuffer); else if IsEmpty then begin @@ -942,7 +946,7 @@ if (Result = grOK) then begin - Result := ReadCurrentRecord(Buffer, acceptable); + Result := ReadCurrentRecord(TDbfRecordBuffer(Buffer), acceptable); if lSequentialRecNo = 0 then lSequentialRecNo := FCursor.SequentialRecNo; end; @@ -1757,8 +1761,8 @@ DestinationName: string; lSrcFieldDef, lDestFieldDef: TDbfFieldDef; CopyLen: Integer; - SrcBuffer: PChar; - DestBuffer: PChar; + SrcBuffer: PAnsiChar; + DestBuffer: PAnsiChar; CopyBlob: Boolean; BlobStream: TMemoryStream; lBlobPageNo: Integer; @@ -1947,8 +1951,8 @@ lSrcFieldDef := nil; lDestFieldDef := nil; end; - SrcBuffer := PChar(@pDbfRecord(DataSet.ActiveBuffer).DeletedFlag); - DestBuffer := PChar(@pDbfRecord(ActiveBuffer).DeletedFlag); + SrcBuffer := PAnsiChar(@pDbfRecord(DataSet.ActiveBuffer).DeletedFlag); + DestBuffer := PAnsiChar(@pDbfRecord(ActiveBuffer).DeletedFlag); if CopyBlob then begin if FDbfFile.GetFieldDataFromDef(lSrcFieldDef, ftInteger, SrcBuffer, @lBlobPageNo, false) and (lBlobPageNo > 0) then @@ -3111,12 +3115,12 @@ function TDbf.ResyncSharedReadCurrentRecord: Boolean; var - Buffer: PChar; + Buffer: PAnsiChar; begin Result := FDbfFile.ResyncSharedReadBuffer; if Result then begin - Buffer := GetCurrentBuffer; + Buffer := PAnsiChar(GetCurrentBuffer); Result := Assigned(Buffer); end; if Result then @@ -3274,7 +3278,11 @@ FieldDefs.Update; end; +{$ifdef DELPHI_XE} +procedure TDbf.DataEvent(Event: TDataEvent; Info: NativeInt); +{$else} procedure TDbf.DataEvent(Event: TDataEvent; Info: {$ifdef FPC_VERSION}Ptrint{$else}Longint{$endif}); +{$endif} begin if ((Event = deDataSetChange) or (Event = deLayoutChange)) and Assigned(FDbfFile) and (not ControlsDisabled) then FDbfFile.ResyncSharedFlushBuffer; @@ -3363,7 +3371,7 @@ function TDbf.InitKeyBuffer(Buffer: PAnsiChar): PAnsiChar; begin FillChar(Buffer^, RecordSize, 0); - InitRecord(Buffer); + InitRecord(TDbfRecordBuffer(Buffer)); Result := Buffer; end; Modified: trunk/src/dbf_ansistrings.pas =================================================================== --- trunk/src/dbf_ansistrings.pas 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf_ansistrings.pas 2015-09-18 11:47:12 UTC (rev 547) @@ -26,6 +26,8 @@ TdbfTextToFloat = function(Buffer: PAnsiChar; var Value; ValueType: TFloatValue): Boolean; TdbfTextToFloatFmt = function(Buffer: PAnsiChar; var Value; ValueType: TFloatValue; const FormatSettings: TFormatSettings): Boolean; TdbfStrPLCopy = function(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar; + TdbfTrimLeft = function(const S: AnsiString): AnsiString; + TdbfTrimRight = function(const S: AnsiString): AnsiString; var dbfStrLen: TdbfStrLen = nil; @@ -44,6 +46,8 @@ dbfTextToFloatFmt: TdbfTextToFloatFmt = nil; dbfTextToFloat: TdbfTextToFloat = nil; dbfStrPLCopy: TdbfStrPLCopy = nil; + dbfTrimLeft: TdbfTrimLeft = nil; + dbfTrimRight: TdbfTrimRight = nil; implementation @@ -72,6 +76,8 @@ dbfTextToFloatFmt := AnsiStrings.TextToFloat; dbfTextToFloat := AnsiStrings.TextToFloat; dbfStrPLCopy := AnsiStrings.StrPLCopy; + dbfTrimLeft := AnsiStrings.TrimLeft; + dbfTrimRight := AnsiStrings.TrimRight; end; {$ELSE} @@ -94,6 +100,8 @@ dbfTextToFloatFmt := @SysUtils.TextToFloat; dbfTextToFloat := @SysUtils.TextToFloat; dbfStrPLCopy := @SysUtils.StrPLCopy; + dbfTrimLeft := @SysUtils.TrimLeft; + dbfTrimRight := @SysUtils.TrimRight; end; {$else} procedure Init; @@ -114,6 +122,8 @@ dbfTextToFloatFmt := SysUtils.TextToFloat; dbfTextToFloat := SysUtils.TextToFloat; dbfStrPLCopy := SysUtils.StrPLCopy; + dbfTrimLeft := SysUtils.TrimLeft; + dbfTrimRight := SysUtils.TrimRight; end; {$endif} Modified: trunk/src/dbf_collate.pas =================================================================== --- trunk/src/dbf_collate.pas 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf_collate.pas 2015-09-18 11:47:12 UTC (rev 547) @@ -64,9 +64,9 @@ end; end; -function DbfCompareString( CollationTable :PCollationTable; String1 :PChar; nLength1 :integer; String2 :PChar; nLength2 :integer ) :integer; +function DbfCompareString(CollationTable: PCollationTable; String1: PAnsiChar; nLength1: Integer; String2: PAnsiChar; nLength2: Integer): Integer; var - nCnt, nMax, nVal1, nVal2 :integer; + nCnt, nMax, nVal1, nVal2: Integer; const ONE_LESS_THAN_TWO = 1; EQUAL = 2; Modified: trunk/src/dbf_dbffile.pas =================================================================== --- trunk/src/dbf_dbffile.pas 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf_dbffile.pas 2015-09-18 11:47:12 UTC (rev 547) @@ -1310,7 +1310,7 @@ // if restructure, initialize dest if DbfFieldDefs <> nil then begin - DestDbfFile.InitRecord(pDestBuff); + DestDbfFile.InitRecord(PAnsiChar(pDestBuff)); // copy deleted mark (the first byte) pDestBuff^ := pBuff^; end; @@ -1424,7 +1424,7 @@ var I: Integer; lfi: TDbfFieldDef; - AFieldName: string; + AFieldName: AnsiString; begin AFieldName := FieldName; UniqueString(AFieldName); @@ -1578,7 +1578,7 @@ if Result and (Dst <> nil) then begin timeStamp.Date := SwapIntLE(PInteger(Src)^) - JulianDateDelta; - timeStamp.Time := SwapIntLE(PInteger(PChar(Src)+4)^); + timeStamp.Time := SwapIntLE(PInteger(PAnsiChar(Src)+4)^); date := TimeStampToDateTime(timeStamp); SaveDateToDst; end; @@ -1676,14 +1676,14 @@ // ldy := GetIntFromStrLength(PAnsiChar(Src) + 0, 4, 1); // ldm := GetIntFromStrLength(PAnsiChar(Src) + 4, 2, 1); // ldd := GetIntFromStrLength(PAnsiChar(Src) + 6, 2, 1); - StrToInt32Width(ldy, PChar(Src) + 0, 4, 1); - StrToInt32Width(ldm, PChar(Src) + 4, 2, 1); - StrToInt32Width(ldd, PChar(Src) + 6, 2, 1); + StrToInt32Width(ldy, PAnsiChar(Src) + 0, 4, 1); + StrToInt32Width(ldm, PAnsiChar(Src) + 4, 2, 1); + StrToInt32Width(ldd, PAnsiChar(Src) + 6, 2, 1); //if (ly<1900) or (ly>2100) then ly := 1900; //Year from 0001 to 9999 is possible //everyting else is an error, an empty string too //Do DateCorrection with Delphis possibillities for one or two digits - if (ldy < 100) and (PChar(Src)[0] = #32) and (PChar(Src)[1] = #32) then + if (ldy < 100) and (PAnsiChar(Src)[0] = #32) and (PAnsiChar(Src)[1] = #32) then CorrectYear(ldy); try date := EncodeDate(ldy, ldm, ldd); @@ -1918,19 +1918,19 @@ end; ftSmallInt: // GetStrFromInt_Width(PSmallInt(Src)^, FieldSize, PAnsiChar(Dst), #32); - IntToStrWidth(PSmallInt(Src)^, FieldSize, PChar(Dst), True, #32); + IntToStrWidth(PSmallInt(Src)^, FieldSize, PAnsiChar(Dst), True, #32); {$ifdef SUPPORT_INT64} ftLargeInt: // GetStrFromInt64_Width(PLargeInt(Src)^, FieldSize, PAnsiChar(Dst), #32); - IntToStrWidth(PInt64(Src)^, FieldSize, PChar(Dst), True, #32); + IntToStrWidth(PInt64(Src)^, FieldSize, PAnsiChar(Dst), True, #32); {$endif} ftFloat, ftCurrency: // FloatToDbfStr(PDouble(Src)^, FieldSize, FieldPrec, PAnsiChar(Dst)); - FloatToStrWidth(PDouble(Src)^, FieldSize, FieldPrec, PChar(Dst), True); + FloatToStrWidth(PDouble(Src)^, FieldSize, FieldPrec, PAnsiChar(Dst), True); ftInteger: // GetStrFromInt_Width(PInteger(Src)^, FieldSize, PAnsiChar(Dst), // IsBlobFieldToPadChar[TempFieldDef.IsBlob]); - IntToStrWidth(PInteger(Src)^, FieldSize, PChar(Dst), True, IsBlobFieldToPadChar[TempFieldDef.IsBlob]); + IntToStrWidth(PInteger(Src)^, FieldSize, PAnsiChar(Dst), True, IsBlobFieldToPadChar[TempFieldDef.IsBlob]); ftDate, ftDateTime: begin LoadDateFromSrc; @@ -1940,9 +1940,9 @@ // GetStrFromInt_Width(year, 4, PAnsiChar(Dst), '0'); // GetStrFromInt_Width(month, 2, PAnsiChar(Dst)+4, '0'); // GetStrFromInt_Width(day, 2, PAnsiChar(Dst)+6, '0'); - IntToStrWidth(year, 4, PChar(Dst), True, DBF_ZERO); - IntToStrWidth(month, 2, PChar(Dst)+4, True, DBF_ZERO); - IntToStrWidth(day, 2, PChar(Dst)+6, True, DBF_ZERO); + IntToStrWidth(year, 4, PAnsiChar(Dst), True, DBF_ZERO); + IntToStrWidth(month, 2, PAnsiChar(Dst)+4, True, DBF_ZERO); + IntToStrWidth(day, 2, PAnsiChar(Dst)+6, True, DBF_ZERO); // do time too if datetime if DataType = ftDateTime then begin @@ -1951,9 +1951,9 @@ // GetStrFromInt_Width(hour, 2, PAnsiChar(Dst)+8, '0'); // GetStrFromInt_Width(minute, 2, PAnsiChar(Dst)+10, '0'); // GetStrFromInt_Width(sec, 2, PAnsiChar(Dst)+12, '0'); - IntToStrWidth(hour, 2, PChar(Dst)+8, True, DBF_ZERO); - IntToStrWidth(minute, 2, PChar(Dst)+10, True, DBF_ZERO); - IntToStrWidth(sec, 2, PChar(Dst)+12, True, DBF_ZERO); + IntToStrWidth(hour, 2, PAnsiChar(Dst)+8, True, DBF_ZERO); + IntToStrWidth(minute, 2, PAnsiChar(Dst)+10, True, DBF_ZERO); + IntToStrWidth(sec, 2, PAnsiChar(Dst)+12, True, DBF_ZERO); end; end; ftString: @@ -2198,7 +2198,7 @@ tempExclusive := IsSharedAccess; if tempExclusive then TryExclusive; // always uppercase index expression -// IndexField := AnsiUpperCase(IndexField); + IndexField := AnsiUpperCase(IndexField); try try // create index if asked Modified: trunk/src/dbf_idxfile.pas =================================================================== --- trunk/src/dbf_idxfile.pas 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf_idxfile.pas 2015-09-18 11:47:12 UTC (rev 547) @@ -82,17 +82,17 @@ TDbfIndexParser = class(TDbfParser) private - function GetKeyType: Char; + function GetKeyType: AnsiChar; protected FResultLen: Integer; function IsIndex: Boolean; override; procedure ValidateExpression(AExpression: string); override; - function ExceptionClass: TExceptionClass; override; + function ExceptionClass: ExceptClass; override; public constructor Create(ADbfFile: Pointer); override; property ResultLen: Integer read FResultLen; - property KeyType: Char read GetKeyType; + property KeyType: AnsiChar read GetKeyType; end; //=========================================================================== TIndexFile = class; @@ -121,7 +121,7 @@ FHighPage: Integer; FHighPageTemp: Integer; - procedure LocalInsert(RecNo: Integer; Buffer: PChar; LowerPageNo: Integer); + procedure LocalInsert(RecNo: Integer; Buffer: PAnsiChar; LowerPageNo: Integer); procedure LocalDelete; procedure Delete; @@ -1477,7 +1477,7 @@ Result := Integer(SwapIntLE(DWORD(PMdxEntry(Entry)^.RecBlockNo))); end; -function TMdxPage.GetKeyData: PChar; +function TMdxPage.GetKeyData: PAnsiChar; begin Result := @PMdxEntry(Entry)^.KeyData; end; @@ -1493,7 +1493,7 @@ end; end; -function TMdxPage.GetKeyDataFromEntry(AEntry: Integer): PChar; +function TMdxPage.GetKeyDataFromEntry(AEntry: Integer): PAnsiChar; begin Result := @PMdxEntry(GetEntry(AEntry))^.KeyData; end; @@ -1737,7 +1737,7 @@ procedure TMdx7Tag.SetTagName(NewName: string); begin - dbfStrPLCopy(PMdx7Tag(Tag)^.TagName, AnsiString(NewName), 10); // was PChar, AnsiString cast added + dbfStrPLCopy(PMdx7Tag(Tag)^.TagName, AnsiString(NewName), 32); // was PChar, AnsiString cast added PMdx7Tag(Tag)^.TagName[32] := #0; end; @@ -1812,12 +1812,12 @@ raise ExceptionClass.CreateFmt(STRING_INDEX_EXPRESSION_TOO_LONG, [AExpression, FResultLen]); end; -function TDbfIndexParser.ExceptionClass: TExceptionClass; +function TDbfIndexParser.ExceptionClass: ExceptClass; begin Result := EDbfErrorInvalidIndex; end; -function TDbfIndexParser.GetKeyType: Char; +function TDbfIndexParser.GetKeyType: AnsiChar; var lDbfFieldDef: TDbfFieldDef; begin @@ -2491,7 +2491,7 @@ FLeaves[I] := FLeaves[I].LowerPage; // parse expression try - FParsers[I].ParseExpression(PIndexHdr(FIndexHeader)^.KeyDesc); + FParsers[I].ParseExpression(AnsiString(PIndexHdr(FIndexHeader)^.KeyDesc)); except {$IFDEF TDBF_IGNORE_INVALID_INDICES} on E: EDbfErrorInvalidIndex do @@ -2964,7 +2964,7 @@ end; end else - Inc(PChar(PEntry), KeyRecLen); + Inc(PAnsiChar(PEntry), KeyRecLen); PMdxEntry(PPEntry^) := PEntry; end else @@ -2980,7 +2980,7 @@ if (FCurrentParser.ResultType=etString) and (Len>FCurrentParser.ResultBufferSize) then Len:= FCurrentParser.ResultBufferSize; Move(FUserKey^, PEntry^.KeyData, Len); - Inc(PChar(PPEntry), SizeOf(Pointer)); + Inc(PAnsiChar(PPEntry), SizeOf(Pointer)); Inc(EntryCount); end; DoProgress(FProgressPosition, FProgressMax, STRING_PROGRESS_READINGRECORDS); @@ -3000,7 +3000,7 @@ FUserRecNo := PEntry^.RecBlockNo; FUserKey := @PEntry^.KeyData; InsertCurrent(AUniqueMode); - Inc(PChar(PPEntry), SizeOf(Pointer)); + Inc(PAnsiChar(PPEntry), SizeOf(Pointer)); Inc(EntryIndex); DoProgress(FProgressPosition, FProgressMax, STRING_PROGRESS_WRITING_RECORDS); end; @@ -3073,7 +3073,7 @@ MergeSort2(List, TempList, L, L1); MergeSort2(List, TempList, R0, R); MergeSort3(List, TempList, L, L1, R0, R); - Move(TempList[L], List[L], C * SizeOf(Pointer)); + Move(TempList^[L], List^[L], C * SizeOf(Pointer)); end; end; @@ -3084,7 +3084,7 @@ procedure MergeAppend(var J: Integer); begin MergeSortCheckCancel; - TempList[I] := List[J]; + TempList^[I] := List^[J]; Inc(I); Inc(J); end; @@ -3093,7 +3093,7 @@ I := L0; while (L0 <= L1) and (R0 <= R1) do begin - if MergeSortCompare(List[L0], List[R0]) <= 0 then + if MergeSortCompare(List^[L0], List^[R0]) <= 0 then MergeAppend(L0) else MergeAppend(R0); @@ -3111,8 +3111,8 @@ function TIndexFile.MergeSortCompare(Item1, Item2: Pointer): Integer; var - KeyData1: PChar; - KeyData2: PChar; + KeyData1: PAnsiChar; + KeyData2: PAnsiChar; begin KeyData1 := @PMdxEntry(Item1).KeyData; KeyData2 := @PMdxEntry(Item2).KeyData; @@ -3407,16 +3407,16 @@ DbfFieldDef := FCurrentParser.DbfFieldDef; if Assigned(DbfFieldDef) then if DbfFieldDef.NativeFieldType = PIndexHdr(FIndexHeader)^.KeyType then - Result := Buffer + DbfFieldDef.Offset; + Result := PAnsiChar(Buffer) + DbfFieldDef.Offset; end else begin // KeyBuffer := FCurrentParser.ExtractFromBuffer(Buffer); - KeyBuffer := FCurrentParser.ExtractFromBuffer(Buffer, RecNo, IsNull); + KeyBuffer := FCurrentParser.ExtractFromBuffer(PAnsiChar(Buffer), RecNo, IsNull); // if (KeyType = 'D') and (FCurrentParser.ExtractIsNull(Buffer)) then if (KeyType = 'D') and IsNull then PDouble(KeyBuffer)^ := 1E100; - Result := PrepareKey(KeyBuffer, FCurrentParser.ResultType); + Result := PAnsiChar(PrepareKey(TDbfRecordBuffer(KeyBuffer), FCurrentParser.ResultType)); end; if not Assigned(Result) then raise EDbfError.Create(STRING_INVALID_INDEX_TYPE); @@ -3497,11 +3497,11 @@ procedure TIndexFile.ConstructInsertErrorMsg; var - InfoKey: string; + InfoKey: AnsiString; begin if Length(FInsertError) > 0 then exit; SetLength(InfoKey, KeyLen); - CopyCurrentKey(FUserKey, PChar(InfoKey)); + CopyCurrentKey(FUserKey, PAnsiChar(InfoKey)); FInsertError := Format(STRING_KEY_VIOLATION, [GetName, PhysicalRecNo, TrimRight(InfoKey)]); end; @@ -3748,7 +3748,7 @@ FRoot.PageNo := SwapIntLE(PIndexHdr(FIndexHeader)^.RootPage); end; -function TIndexFile.SearchKey(Key: PChar; SearchType: TSearchKeyType): Boolean; +function TIndexFile.SearchKey(Key: PAnsiChar; SearchType: TSearchKeyType): Boolean; var findres: Integer; currRecNo: TSequentialRecNo; Modified: trunk/src/dbf_parser.pas =================================================================== --- trunk/src/dbf_parser.pas 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf_parser.pas 2015-09-18 11:47:12 UTC (rev 547) @@ -60,8 +60,8 @@ procedure ClearExpressions; override; procedure ParseExpression(const AExpression: string); virtual; - function ExtractFromBuffer(Buffer: PChar; RecNo: Integer): PAnsiChar; overload; virtual; - function ExtractFromBuffer(Buffer: PChar; RecNo: Integer; var IsNull: Boolean): PAnsiChar; overload; virtual; + function ExtractFromBuffer(Buffer: PAnsiChar; RecNo: Integer): PAnsiChar; overload; virtual; + function ExtractFromBuffer(Buffer: PAnsiChar; RecNo: Integer; var IsNull: Boolean): PAnsiChar; overload; virtual; property DbfFile: Pointer read FDbfFile write FDbfFile; property Expression: string read FCurrentExpression; Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf_prscore.pas 2015-09-18 11:47:12 UTC (rev 547) @@ -80,7 +80,7 @@ function GetResultType: TExpressionType; virtual; function IsIndex: Boolean; virtual; procedure OptimizeExpr(var ExprRec: PExpressionRec); virtual; - function ExceptionClass: TExceptionClass; virtual; + function ExceptionClass: ExceptClass; virtual; procedure ReadWord(const AnExpr: string; var isConstant: Boolean; var I1, I2: Integer; Len: Integer); virtual; function CreateConstant(W: string): TConstant; virtual; @@ -1118,7 +1118,7 @@ RemoveConstants(ExprRec); end; -function TCustomExpressionParser.ExceptionClass: TExceptionClass; +function TCustomExpressionParser.ExceptionClass: ExceptClass; begin Result := EParserError; end; @@ -1499,7 +1499,7 @@ var Size: Integer; Precision: Integer; - PadChar: Char; + PadChar: AnsiChar; {$ifdef SUPPORT_INT64} IntValue: Int64; {$else} @@ -1551,14 +1551,14 @@ procedure FuncDateToStr(Param: PExpressionRec); var - TempStr: string; + TempStr: AnsiString; begin // create in temporary string - DateTimeToString(TempStr, 'yyyymmdd', PDateTimeRec(Param^.Args[0])^.DateTime); + TempStr := FormatDateTime('YYYYMMDD', PDateTimeRec(Param^.Args[0])^.DateTime); if Param^.ArgList[0]^.IsNullPtr^ then FillChar(PAnsiChar(TempStr)^, Length(TempStr), ' '); // copy to buffer - Param^.Res.Append(PAnsiChar(AnsiString(TempStr)), Length(TempStr)); // Was PChar + Param^.Res.Append(PAnsiChar(TempStr), Length(TempStr)); // Was PChar end; procedure FuncSubString(Param: PExpressionRec); @@ -2313,12 +2313,12 @@ var ArgIndex: Integer; FloatValue: Extended; - StringValue: string; - Buffer: array[0..19] of Char; + StringValue: AnsiString; + Buffer: array[0..19] of AnsiChar; Len: Integer; - ResSource: PChar; + ResSource: PAnsiChar; ResLength: Integer; - Arg: PChar; + Arg: PAnsiChar; ArgType: TExpressionType; ArgIsNull: Boolean; Precision: Integer; @@ -2392,7 +2392,7 @@ begin StringValue := FormatDateTime('YYYYMMDD', PDateTime(Arg)^); Len := ResLength; - ResSource := pChar(StringValue); + ResSource := PAnsiChar(StringValue); end; end; end; @@ -2461,11 +2461,19 @@ procedure FuncCDOW(Param: PExpressionRec); var ADate: TDateTime; + ADayOfWeek: Word; TempStr: AnsiString; begin ADate := PDateTimeRec(Param^.Args[0])^.DateTime; if ADate <> 0 then - TempStr := ShortDayNames[DayOfWeek(ADate)] + begin + ADayOfWeek := DayOfWeek(ADate); + {$ifdef DELPHI_XE} + TempStr := FormatSettings.ShortDayNames[ADayOfWeek]; + {$else} + TempStr := ShortDayNames[ADayOfWeek]; + {$endif} + end else TempStr := ' '; Param^.Res.Append(PAnsiChar(TempStr), Length(TempStr)); @@ -2573,8 +2581,8 @@ Param^.Res.Append(Param^.Args[0], dbfStrLen(Param^.Args[0])) else begin - TempStr := TrimLeft(Param^.Args[0]); - Param^.Res.Append(PChar(TempStr), Length(TempStr)); + TempStr := dbfTrimLeft(Param^.Args[0]); + Param^.Res.Append(PAnsiChar(TempStr), Length(TempStr)); end; end; @@ -2676,22 +2684,22 @@ Param^.Res.Append(Param^.Args[0], dbfStrLen(Param^.Args[0])) else begin - TempStr := TrimRight(Param^.Args[0]); - Param^.Res.Append(pchar(TempStr), Length(TempStr)); + TempStr := dbfTrimRight(Param^.Args[0]); + Param^.Res.Append(PAnsiChar(TempStr), Length(TempStr)); end; end; {$I dbf_soundex.inc} procedure FuncSoundex(Param: PExpressionRec); var - Src: pchar; + Src: PAnsiChar; Dest: AnsiString; begin with Param^ do begin Src := Param^.Args[0]; Dest := Soundex(src); - Param^.Res.Append(pchar(Dest), Length(Dest)); + Param^.Res.Append(PAnsiChar(Dest), Length(Dest)); end; end; @@ -2706,7 +2714,7 @@ TempStr: AnsiString; Code: Integer; begin - TempStr := TrimLeft(Param^.Args[0]); + TempStr := dbfTrimLeft(Param^.Args[0]); Index := 0; while (Index<Length(TempStr)) and (TempStr[Succ(Index)] in [DBF_ZERO..DBF_NINE, DBF_POSITIVESIGN, DBF_NEGATIVESIGN, DBF_DECIMAL]) do Inc(Index); Modified: trunk/src/dbf_prsdef.pas =================================================================== --- trunk/src/dbf_prsdef.pas 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf_prsdef.pas 2015-09-18 11:47:12 UTC (rev 547) @@ -88,7 +88,7 @@ TExprCollection = class(TNoOwnerCollection) public - procedure Check(ExceptionClass: TExceptionClass); + procedure Check(ExceptionClass: ExceptClass); procedure EraseExtraBrackets; end; @@ -259,7 +259,7 @@ TVariableFieldInfo = record DbfFieldDef: Pointer; - NativeFieldType: Char; + NativeFieldType: AnsiChar; Size: Integer; Precision: Integer; end; @@ -287,7 +287,7 @@ // constructor Create(AName: string; AValue: PDouble); constructor Create(AName: string; AValue: PDouble; AIsNullPtr: PBoolean; AFieldInfo: PVariableFieldInfo); - function AsPointer: PChar; override; + function AsPointer: PAnsiChar; override; end; TStringVariable = class(TVariable) @@ -302,7 +302,7 @@ constructor Create(AName: string; AValue: PPAnsiChar; AIsNullPtr: PBoolean; AFieldInfo: PVariableFieldInfo); function LenAsPointer: PInteger; override; - function AsPointer: PChar; override; + function AsPointer: PAnsiChar; override; property FixedLen: Integer read FFixedLen; end; @@ -347,7 +347,7 @@ // constructor Create(AName: string; AValue: PBoolean); constructor Create(AName: string; AValue: PBoolean; AIsNullPtr: PBoolean; AFieldInfo: PVariableFieldInfo); - function AsPointer: PChar; override; + function AsPointer: PAnsiChar; override; end; TLeftBracket = class(TExprWord) @@ -433,7 +433,7 @@ function ExprStrLen(P: PAnsiChar; IncludeTrailingSpaces: Boolean): Integer; begin - Result := StrLen(P); + Result := dbfStrLen(P); if not IncludeTrailingSpaces then while (Result > 0) and ((P + Pred(Result))^ = ' ') do Dec(Result); @@ -1017,7 +1017,7 @@ { TExprCollection } -procedure TExprCollection.Check(ExceptionClass: TExceptionClass); +procedure TExprCollection.Check(ExceptionClass: ExceptClass); var brCount, I: Integer; begin Modified: trunk/src/dbf_prssupp.pas =================================================================== --- trunk/src/dbf_prssupp.pas 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf_prssupp.pas 2015-09-18 11:47:12 UTC (rev 547) @@ -60,16 +60,19 @@ DBF_NINE = '9'; -function IntToStrWidth(Val: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; const FieldSize: Integer; const Dest: PChar; Pad: Boolean; PadChar: Char): Integer; -function FloatToStrWidth(const Val: Extended; const FieldSize, FieldPrec: Integer; const Dest: PChar; Pad: Boolean): Integer; +function IntToStrWidth(Val: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; const FieldSize: Integer; const Dest: PAnsiChar; Pad: Boolean; PadChar: AnsiChar): Integer; +function FloatToStrWidth(const Val: Extended; const FieldSize, FieldPrec: Integer; const Dest: PAnsiChar; Pad: Boolean): Integer; function StrToIntWidth(var IntValue: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; Src: Pointer; Size: Integer; Default: Integer): Boolean; function StrToInt32Width(var IntValue: Integer; Src: Pointer; Size: Integer; Default: Integer): Boolean; -function StrToFloatWidth(var FloatValue: Extended; const Src: PChar; const Size: Integer; Default: Extended): Boolean; +function StrToFloatWidth(var FloatValue: Extended; const Src: PAnsiChar; const Size: Integer; Default: Extended): Boolean; implementation -uses SysUtils; +uses + SysUtils, + dbf_AnsiStrings, + dbf_common; destructor TOCollection.Destroy; begin @@ -202,14 +205,14 @@ type TFloatResult = record - Dest: PChar; - P: PChar; + Dest: PAnsiChar; + P: PAnsiChar; FieldSize: Integer; FieldPrec: Integer; Len: Integer; end; -procedure FloatPutChar(var FloatResult: TFloatResult; C: Char); +procedure FloatPutChar(var FloatResult: TFloatResult; C: AnsiChar); begin Inc(FloatResult.Len); if FloatResult.Len <= FloatResult.FieldSize then @@ -231,13 +234,13 @@ DigitCount: SmallInt; DigitMin: SmallInt; DigitMax: SmallInt; - DigitChar: Char; + DigitChar: AnsiChar; DecCount: Integer; begin FloatReset(FloatResult); if FloatRec.Negative then FloatPutChar(FloatResult, DBF_NEGATIVESIGN); - DigitCount := StrLen(FloatRec.Digits); + DigitCount := dbfStrLen(@FloatRec.Digits); if Exponent <= 0 then begin DigitMin := Exponent; @@ -254,7 +257,7 @@ while (Digit < DigitMax) or ((FieldPrec <> 0) and (DecCount < FieldPrec) and (FloatResult.Len < FloatResult.FieldSize - Ord(DecCount<0))) do begin if (Digit >= 0) and (Digit < DigitCount) then - DigitChar := FloatRec.Digits[Digit] + DigitChar := AnsiChar(FloatRec.Digits[Digit]) else DigitChar := DBF_ZERO; if Digit=Exponent then @@ -272,7 +275,7 @@ procedure DecimalToDbfStrFormat(var FloatResult: TFloatResult; const FloatRec: TFloatRec; Format: TFloatFormat; FieldPrec: Integer); var Exponent: SmallInt; - ExponentBuffer: array[1..5] of Char; + ExponentBuffer: array[1..5] of AnsiChar; Index: Byte; begin if Format=ffExponent then @@ -291,7 +294,7 @@ while Exponent<>0 do begin Inc(Index); - ExponentBuffer[Index] := Char(Ord(DBF_ZERO) + (Exponent mod 10)); + ExponentBuffer[Index] := AnsiChar(Ord(DBF_ZERO) + (Exponent mod 10)); Exponent := Exponent div 10; end; while Index>0 do @@ -311,7 +314,7 @@ Precision: Integer; begin DecimalToDbfStrFormat(FloatResult, FloatRec, Format, FieldPrec); - Precision:= Integer(StrLen(FloatRec.Digits)); + Precision:= Integer(dbfStrLen(@FloatRec.Digits)); if FloatResult.Len > FloatResult.FieldSize then begin Precision:= Precision - (FloatResult.Len - FloatResult.FieldSize); @@ -329,7 +332,7 @@ end; end; -function NumberPad(const FloatResult: TFloatResult; const Dest: PChar; Pad: Boolean; PadChar: Char): Integer; +function NumberPad(const FloatResult: TFloatResult; const Dest: PAnsiChar; Pad: Boolean; PadChar: AnsiChar): Integer; begin Result:= FloatResult.Len; if Pad and (FloatResult.Len <> FloatResult.FieldSize) then @@ -340,13 +343,13 @@ end; end; -function IntToStrWidth(Val: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; const FieldSize: Integer; const Dest: PChar; Pad: Boolean; PadChar: Char): Integer; +function IntToStrWidth(Val: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; const FieldSize: Integer; const Dest: PAnsiChar; Pad: Boolean; PadChar: AnsiChar): Integer; var FloatResult: TFloatResult; Negative: Boolean; IntValue: Integer; - Buffer: array[0..{$ifdef SUPPORT_INT64}18{$else}9{$endif}] of Char; - P: PChar; + Buffer: array[0..{$ifdef SUPPORT_INT64}18{$else}9{$endif}] of AnsiChar; + P: PAnsiChar; begin FillChar(FloatResult, SizeOf(FloatResult), 0); FloatResult.Dest := Buffer; @@ -358,10 +361,10 @@ else IntValue := Val; repeat - FloatPutChar(FloatResult, Char(Ord(DBF_ZERO) + (IntValue mod 10))); + FloatPutChar(FloatResult, AnsiChar(Ord(DBF_ZERO) + (IntValue mod 10))); IntValue := IntValue div 10; until IntValue = 0; - P:= FloatResult.P; + P := FloatResult.P; FloatResult.Dest := Dest; if FloatResult.Len+Ord(Negative) > FieldSize then begin @@ -383,12 +386,12 @@ Result:= NumberPad(FloatResult, Dest, Pad, PadChar); end; -function Int64ToStrWidth(Val: Int64; const FieldSize: Integer; const Dest: PChar; Pad: Boolean; PadChar: Char): Integer; +function Int64ToStrWidth(Val: Int64; const FieldSize: Integer; const Dest: PAnsiChar; Pad: Boolean; PadChar: AnsiChar): Integer; begin Result:= IntToStrWidth(Val, FieldSize, Dest, Pad, PadChar); end; -function FloatToStrWidth(const Val: Extended; const FieldSize, FieldPrec: Integer; const Dest: PChar; Pad: Boolean): Integer; +function FloatToStrWidth(const Val: Extended; const FieldSize, FieldPrec: Integer; const Dest: PAnsiChar; Pad: Boolean): Integer; var FloatResult: TFloatResult; FloatRec: TFloatRec; @@ -406,13 +409,13 @@ function StrToIntWidth(var IntValue: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; Src: Pointer; Size: Integer; Default: Integer): Boolean; var - P: PChar; + P: PAnsiChar; Negative: Boolean; Digit: Byte; FloatValue: Extended; begin P := Src; - while (P < PChar(Src) + Size) and (P^ = ' ') do + while (P < PAnsiChar(Src) + Size) and (P^ = ' ') do Inc(P); Dec(Size, P - Src); Src := P; @@ -452,7 +455,7 @@ else Result := False; Inc(P); - until (P = PChar(Src) + Size) or (not Result); + until (P = PAnsiChar(Src) + Size) or (not Result); if not Result then begin Result := StrToFloatWidth(FloatValue, Src, Size, Default); @@ -484,16 +487,20 @@ {$endif} end; -function StrToFloatWidth(var FloatValue: Extended; const Src: PChar; const Size: Integer; Default: Extended): Boolean; +function StrToFloatWidth(var FloatValue: Extended; const Src: PAnsiChar; const Size: Integer; Default: Extended): Boolean; var - Buffer: array[0..20] of Char; + Buffer: array[0..20] of AnsiChar; begin Result := Size < SizeOf(Buffer); if Result then begin Move(Src^, Buffer, Size); Buffer[Size] := #0; - Result:= TextToFloat(@Buffer, FloatValue {$ifndef VER1_0}, fvExtended{$endif}, DbfFormatSettings); + {$ifdef VER1_0} + Result:= dbfTextToFloat(@Buffer, FloatValue, DbfFormatSettings); + {$else} + Result:= dbfTextToFloatFmt(@Buffer, FloatValue, fvExtended, DbfFormatSettings); + {$endif} end; if not Result then FloatValue := Default; Modified: trunk/src/dbf_soundex.inc =================================================================== --- trunk/src/dbf_soundex.inc 2015-09-18 11:42:15 UTC (rev 546) +++ trunk/src/dbf_soundex.inc 2015-09-18 11:47:12 UTC (rev 547) @@ -2,10 +2,10 @@ const soundextable:packed array['A'..'Z'] of AnsiChar = '.123.12..22455.12623.1.2.2'; var - SoundString: string; - I1: integer; // input - I2: INTEGER; // output - C2: CHAR; + SoundString: AnsiString; + I1: Integer; // input + I2: Integer; // output + C2: AnsiChar; len: integer; begin len := Length(aString); @@ -16,7 +16,7 @@ I1 := 0; repeat Inc(I1); - C2 := UPCASE(aString[I1]); + C2 := UpCase(aString[I1]); until (I1 >= len) or (C2 <> ' '); // if first non-blank is not alphabetic, result is 0000 This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-18 19:58:11
|
Revision: 558 http://sourceforge.net/p/tdbf/code/558 Author: paulenandrew Date: 2015-09-18 19:58:08 +0000 (Fri, 18 Sep 2015) Log Message: ----------- fix compiler information and warning messages in Free Pascal, mostly related to unused parameters or uninitialized var parameters Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf.pas trunk/src/dbf_avl.pas trunk/src/dbf_collate.pas trunk/src/dbf_common.pas trunk/src/dbf_dbffile.pas trunk/src/dbf_fields.pas trunk/src/dbf_idxfile.pas trunk/src/dbf_memo.pas trunk/src/dbf_parser.pas trunk/src/dbf_pgfile.pas trunk/src/dbf_prscore.pas trunk/src/dbf_prsdef.pas trunk/src/dbf_prssupp.pas trunk/src/dbf_struct.inc Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/doc/history.txt 2015-09-18 19:58:08 UTC (rev 558) @@ -165,6 +165,7 @@ - add flexibility to the parser allowing custom parsing of constants and date/time constants - fix compiler errors in Delphi XE, mostly related to use of PChar instead of PAnsiChar - fix to allow all 32 characters of a level 7 index tag name to be used +- fix compiler information and warning messages in Free Pascal, mostly related to unused parameters or uninitialized var parameters ------------------------ V6.9.1 Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -137,7 +137,7 @@ procedure ActiveChanged; override; procedure CheckBrowseMode; override; procedure LayoutChanged; override; - procedure RecordChanged(Field: TField); override; + procedure RecordChanged({%H-}Field: TField); override; public constructor Create(ADataSet: TDbf); @@ -207,7 +207,7 @@ FKeyBuffer: Pointer; function GetKeyBuffer: PAnsiChar; function InitKeyBuffer(Buffer: PAnsiChar): PAnsiChar; - procedure PostKeyBuffer(Commit: Boolean); + procedure PostKeyBuffer({%H-}Commit: Boolean); function GetIndexName: string; function GetVersion: string; @@ -224,7 +224,7 @@ procedure SetDbfIndexDefs(const Value: TDbfIndexDefs); procedure SetFilePath(const Value: string); procedure SetTableName(const S: string); - procedure SetVersion(const S: string); + procedure SetVersion(const {%H-}S: string); procedure SetLanguageID(NewID: Byte); procedure SetDataSource(Value: TDataSource); procedure SetMasterFields(const Value: string); @@ -254,9 +254,9 @@ procedure FreeRecordBuffer(var Buffer: TDbfRecordBuffer); override; {virtual abstract} procedure GetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); override; {virtual abstract} function GetBookmarkFlag(Buffer: TDbfRecordBuffer): TBookmarkFlag; override; {virtual abstract} - function GetRecord(Buffer: TDbfRecBuf; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract} + function GetRecord(Buffer: TDbfRecBuf; GetMode: TGetMode; {%H-}DoCheck: Boolean): TGetResult; override; {virtual abstract} function GetRecordSize: Word; override; {virtual abstract} - procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override; {virtual abstract} + procedure InternalAddRecord(Buffer: Pointer; {%H-}AAppend: Boolean); override; {virtual abstract} procedure InternalClose; override; {virtual abstract} procedure InternalDelete; override; {virtual abstract} procedure InternalFirst; override; {virtual abstract} @@ -281,7 +281,7 @@ function IsCursorOpen: Boolean; override; {virtual abstract} procedure SetBookmarkFlag(Buffer: TDbfRecordBuffer; Value: TBookmarkFlag); override; {virtual abstract} procedure SetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); override; {virtual abstract} - procedure SetFieldData(Field: TField; Buffer: TDbfValueBuffer); + procedure {%H-}SetFieldData(Field: TField; Buffer: TDbfValueBuffer); {$ifdef SUPPORT_OVERLOAD}overload;{$ENDIF} override; {virtual abstract} { virtual methods (mostly optionnal) } @@ -304,7 +304,7 @@ {$ifdef SUPPORT_VARIANTS} function LocateRecordLinear(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean; - function LocateRecordIndex(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean; + function LocateRecordIndex(const {%H-}KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean; function LocateRecord(const KeyFields: String; const KeyValues: Variant; Options: TLocateOptions): Boolean; {$endif} @@ -366,7 +366,7 @@ // index support (use same syntax as ttable but is not related) {$ifdef SUPPORT_DEFAULT_PARAMS} - procedure AddIndex(const AIndexName, AFields: String; Options: TIndexOptions; const DescFields: String=''); + procedure AddIndex(const AIndexName, AFields: String; Options: TIndexOptions; const {%H-}DescFields: String=''); {$else} procedure AddIndex(const AIndexName, AFields: String; Options: TIndexOptions); {$endif} @@ -549,7 +549,7 @@ const // TODO: move these to DBConsts SNotEditing = 'Dataset not in edit or insert mode'; - SCircularDataLink = 'Circular datalinks are not allowed'; +//SCircularDataLink = 'Circular datalinks are not allowed'; {$endif} function TableLevelToDbfVersion(TableLevel: integer): TXBaseVersion; @@ -2286,6 +2286,7 @@ checkmatch := false; repeat + acceptable := True; if ReadCurrentRecord(TDbfRecordBuffer(TempBuffer), acceptable) = grError then begin Result := false; Modified: trunk/src/dbf_avl.pas =================================================================== --- trunk/src/dbf_avl.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_avl.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -5,7 +5,7 @@ {$I dbf_common.inc} uses - Dbf_Common; + dbf_common; type TBal = -1..1; @@ -101,6 +101,7 @@ Result := true; H := 0; end else begin + HR := 0; Result := CheckTree_T(X^.Left, H) and CheckTree_T(X^.Right, HR) and ((X^.Left = nil) or (X^.Left^.Data.ID < X^.Data.ID)) and ((X^.Right = nil) or (X^.Right^.Data.ID > X^.Data.ID)) and @@ -114,6 +115,7 @@ var H: Integer; begin + H := 0; Result := CheckTree_T(X, H); end; Modified: trunk/src/dbf_collate.pas =================================================================== --- trunk/src/dbf_collate.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_collate.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -765,7 +765,7 @@ 025, 023, 027, 029, 128, 134, 126, 035, 045, 043, 047, 049, 061, 059, 063, 065, 039, 077, 084, 082, 086, 088, 132, 020, 130, 107, 105, 109, 122, 119, 101, 120 ); - BLLT1DA0 :PCollationTable = @_BLLT1DA0; + {%H-}BLLT1DA0 :PCollationTable = @_BLLT1DA0; @@ -790,17 +790,17 @@ 024, 022, 026, 032, 030, 028, 034, 040, 050, 048, 052, 054, 066, 064, 068, 070, 044, 082, 089, 087, 091, 095, 093, 018, 097, 116, 114, 118, 120, 130, 110, 132 ); - BLLT1NL0 :PCollationTable = @_BLLT1NL0; + {%H-}BLLT1NL0 :PCollationTable = @_BLLT1NL0; - BLLT1CA0 :PCollationTable = @_BLLT1NL0; + {%H-}BLLT1CA0 :PCollationTable = @_BLLT1NL0; - BLLT1IT0 :PCollationTable = @_BLLT1NL0; + {%H-}BLLT1IT0 :PCollationTable = @_BLLT1NL0; - BLLT1ES0 :PCollationTable = @_BLLT1NL0; + {%H-}BLLT1ES0 :PCollationTable = @_BLLT1NL0; - BLLT1UK0 :PCollationTable = @_BLLT1NL0; + {%H-}BLLT1UK0 :PCollationTable = @_BLLT1NL0; - BLLT1PT0 :PCollationTable = @_BLLT1NL0; + {%H-}BLLT1PT0 :PCollationTable = @_BLLT1NL0; @@ -825,9 +825,9 @@ 024, 022, 026, 028, 127, 125, 129, 034, 044, 042, 046, 048, 060, 058, 062, 064, 038, 076, 083, 081, 085, 087, 131, 018, 133, 106, 104, 108, 121, 118, 100, 120 ); - BLLT1FI0 :PCollationTable = @_BLLT1FI0; + {%H-}BLLT1FI0 :PCollationTable = @_BLLT1FI0; - BLLT1SV0 :PCollationTable = @_BLLT1FI0; + {%H-}BLLT1SV0 :PCollationTable = @_BLLT1FI0; @@ -852,9 +852,9 @@ 137, 135, 139, 145, 143, 141, 147, 153, 163, 161, 165, 167, 179, 177, 181, 183, 157, 195, 202, 200, 204, 208, 206, 097, 210, 229, 227, 231, 233, 243, 223, 245 ); - BLLT1FR0 :PCollationTable = @_BLLT1FR0; + {%H-}BLLT1FR0 :PCollationTable = @_BLLT1FR0; - BLLT1DE0 :PCollationTable = @_BLLT1FR0; + {%H-}BLLT1DE0 :PCollationTable = @_BLLT1FR0; @@ -879,7 +879,7 @@ 022, 032, 024, 030, 028, 026, 129, 038, 046, 052, 048, 050, 062, 068, 064, 066, 042, 080, 085, 091, 087, 089, 131, 018, 133, 106, 112, 108, 110, 123, 127, 122 ); - BLLT1IS0 :PCollationTable = @_BLLT1IS0; + {%H-}BLLT1IS0 :PCollationTable = @_BLLT1IS0; @@ -904,7 +904,7 @@ 024, 022, 026, 030, 028, 133, 129, 036, 046, 044, 048, 050, 062, 060, 064, 066, 040, 078, 085, 083, 087, 091, 089, 020, 131, 110, 108, 112, 114, 124, 104, 126 ); - BLLT1NO0 :PCollationTable = @_BLLT1NO0; + {%H-}BLLT1NO0 :PCollationTable = @_BLLT1NO0; @@ -1186,11 +1186,11 @@ 096, 097, 098, 099, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127 ); - china :PCollationTable = @_china; + {%H-}china :PCollationTable = @_china; - korea :PCollationTable = @_china; + {%H-}korea :PCollationTable = @_china; - taiwan :PCollationTable = @_china; + {%H-}taiwan :PCollationTable = @_china; DB936CN0 :PCollationTable = @_china; @@ -1221,7 +1221,7 @@ 247, 248, 249, 250, 251, 195, 196, 176, 177, 178, 179, 180, 181, 182, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 252, 253, 254, 255 ); - thai :PCollationTable = @_thai; + {%H-}thai :PCollationTable = @_thai; db874th0 :PCollationTable = @_thai; @@ -1300,7 +1300,7 @@ 083, 084, 085, 087, 086, 088, 089, 092, 096, 097, 098, 099, 104, 105, 106, 107, 094, 113, 115, 116, 117, 119, 118, 071, 141, 129, 130, 131, 132, 137, 140, 138 ); - ACCGEN :PCollationTable = @_ACCGEN; + {%H-}ACCGEN :PCollationTable = @_ACCGEN; @@ -1325,7 +1325,7 @@ 083, 082, 084, 085, 137, 141, 136, 088, 093, 092, 094, 095, 101, 100, 102, 103, 090, 109, 112, 111, 113, 114, 139, 071, 138, 126, 125, 127, 134, 132, 123, 133 ); - ACCNRDAN :PCollationTable = @_ACCNRDAN; + {%H-}ACCNRDAN :PCollationTable = @_ACCNRDAN; @@ -1350,7 +1350,7 @@ 084, 083, 085, 086, 139, 138, 087, 090, 095, 094, 096, 097, 103, 102, 104, 105, 092, 111, 114, 113, 115, 116, 140, 071, 141, 128, 127, 129, 136, 134, 125, 135 ); - ACCSWFIN :PCollationTable = @_ACCSWFIN; + {%H-}ACCSWFIN :PCollationTable = @_ACCSWFIN; @@ -1536,7 +1536,7 @@ 065, 067, 069, 065, 071, 065, 065, 077, 081, 083, 081, 085, 093, 095, 097, 093, 079, 107, 109, 111, 113, 109, 115, 167, 109, 130, 132, 130, 134, 144, 035, 142 ); - il2czw :PCollationTable = @_il2czw; + {%H-}il2czw :PCollationTable = @_il2czw; @@ -1648,7 +1648,7 @@ 180, 149, 154, 157, 160, 161, 168, 176, 175, 181, 118, 123, 126, 129, 136, 142, 147, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255 ); - grcp437 :PCollationTable = @_grcp437; + {%H-}grcp437 :PCollationTable = @_grcp437; db437gr0 :PCollationTable = @_grcp437; @@ -1677,7 +1677,7 @@ ); dbhebrew :PCollationTable = @_dbhebrew; - Hebrew :PCollationTable = @_dbhebrew; + {%H-}Hebrew :PCollationTable = @_dbhebrew; @@ -1702,7 +1702,7 @@ 142, 158, 143, 133, 130, 131, 163, 162, 153, 177, 150, 178, 187, 189, 166, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 173, 154, 151, 254, 255 ); - slovene :PCollationTable = @_slovene; + {%H-}slovene :PCollationTable = @_slovene; db852sl0 :PCollationTable = @_slovene; @@ -1791,9 +1791,9 @@ 065, 067, 065, 065, 069, 065, 065, 073, 077, 079, 077, 077, 087, 089, 087, 087, 075, 099, 101, 103, 105, 101, 107, 157, 101, 121, 123, 121, 125, 135, 035, 133 ); - cskamenw :PCollationTable = @_cskamenw; + {%H-}cskamenw :PCollationTable = @_cskamenw; - cskamen :PCollationTable = @_cskamenw; + {%H-}cskamen :PCollationTable = @_cskamenw; @@ -1905,9 +1905,9 @@ 172, 117, 121, 123, 125, 127, 131, 133, 137, 139, 146, 148, 150, 152, 154, 156, 160, 162, 165, 164, 167, 169, 176, 178, 180, 182, 141, 171, 157, 170, 183, 255 ); - angreek1 :PCollationTable = @_angreek1; + {%H-}angreek1 :PCollationTable = @_angreek1; - ACCGREEK :PCollationTable = @_angreek1; + {%H-}ACCGREEK :PCollationTable = @_angreek1; @@ -1932,7 +1932,7 @@ 150, 067, 068, 069, 066, 120, 085, 080, 083, 095, 097, 094, 096, 110, 111, 088, 091, 130, 131, 137, 138, 139, 136, 248, 151, 174, 172, 173, 171, 187, 166, 249 ); - ansislov :PCollationTable = @_ansislov; + {%H-}ansislov :PCollationTable = @_ansislov; @@ -1957,7 +1957,7 @@ 067, 069, 068, 070, 079, 066, 071, 085, 093, 090, 091, 092, 111, 110, 109, 108, 103, 128, 133, 132, 134, 135, 141, 246, 247, 158, 159, 157, 164, 107, 152, 173 ); - ANTURK :PCollationTable = @_ANTURK; + {%H-}ANTURK :PCollationTable = @_ANTURK; @@ -2057,7 +2057,7 @@ 171, 167, 163, 197, 175, 183, 186, 152, 172, 168, 164, 176, 188, 184, 180, 192, 199, 154, 173, 169, 165, 205, 177, 035, 185, 174, 170, 166, 178, 149, 212, 210 ); - BLROM800 :PCollationTable = @_BLROM800; + {%H-}BLROM800 :PCollationTable = @_BLROM800; @@ -2082,7 +2082,7 @@ 106, 104, 108, 112, 110, 114, 116, 122, 132, 130, 134, 136, 148, 146, 150, 152, 126, 164, 170, 168, 172, 176, 174, 092, 178, 197, 195, 199, 201, 211, 191, 212 ); - ORAWE850 :PCollationTable = @_ORAWE850 ; + {%H-}ORAWE850 :PCollationTable = @_ORAWE850 ; @@ -2107,7 +2107,7 @@ 114, 116, 118, 120, 122, 124, 126, 132, 138, 140, 142, 144, 154, 156, 158, 160, 222, 172, 176, 178, 180, 182, 184, 092, 186, 201, 203, 205, 207, 217, 223, 218 ); - SYDC850 :PCollationTable = @_SYDC850; + {%H-}SYDC850 :PCollationTable = @_SYDC850; @@ -2132,7 +2132,7 @@ 097, 098, 099, 096, 101, 103, 105, 111, 116, 118, 119, 120, 129, 130, 131, 132, 113, 144, 147, 148, 149, 146, 151, 080, 146, 164, 165, 166, 168, 176, 035, 177 ); - SYDC437 :PCollationTable = @_SYDC437; + {%H-}SYDC437 :PCollationTable = @_SYDC437; @@ -2157,7 +2157,7 @@ 078, 084, 076, 183, 077, 079, 082, 090, 099, 096, 097, 098, 111, 112, 110, 109, 186, 123, 129, 131, 127, 198, 128, 218, 201, 147, 149, 146, 145, 208, 203, 158 ); - db2andeu :PCollationTable = @_db2andeu; + {%H-}db2andeu :PCollationTable = @_db2andeu; initialization Modified: trunk/src/dbf_common.pas =================================================================== --- trunk/src/dbf_common.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_common.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -391,7 +391,7 @@ {$ifdef SUPPORT_FORMATSETTINGS} Result := FormatSettings.DecimalSeparator; {$else SUPPORT_FORMATSETTINGS} - Result := SysUtils.DecimalSeparator; + Result := SysUtils.DecimalSeparator{%H-}; {$endif SUPPORT_FORMATSETTINGS} end; Modified: trunk/src/dbf_dbffile.pas =================================================================== --- trunk/src/dbf_dbffile.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_dbffile.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -351,7 +351,7 @@ // FFileCodePage := GetIntFromStrLength(LangStr+2, 3, 0); StrToInt32Width(Integer(FFileCodePage), LangStr+2, 3, 0); if (Ord(LangStr[5]) >= Ord('0')) and (Ord(LangStr[5]) <= Ord('9')) then - FFileCodePage := FFileCodePage * 10 + Ord(LangStr[5]) - Ord('0'); + FFileCodePage := FFileCodePage * 10 + Ord(LangStr[5]) {%H-}- Ord('0'); end; end else if dbfStrLComp(LangStr, 'FOX', 3) = 0 then @@ -802,7 +802,7 @@ //FillHeader(0); lDataHdr := PDbfHdr(Header); - GetLocalTime(SystemTime); + GetLocalTime(SystemTime{%H-}); lDataHdr^.Year := SystemTime.wYear - 1900; lDataHdr^.Month := SystemTime.wMonth; lDataHdr^.Day := SystemTime.wDay; @@ -953,7 +953,7 @@ for I := 0 to lFieldPropsHdr.NumStdProps - 1 do begin // read property data - ReadBlock(@lStdProp, SizeOf(lStdProp), lFieldOffset+I*SizeOf(lStdProp)); + ReadBlock(@lStdProp, SizeOf(lStdProp), lFieldOffset+I*SizeOf(lStdProp)){%H-}; // is this a constraint? if lStdProp.FieldOffset = 0 then begin @@ -986,7 +986,7 @@ end; // get data for this property if dataPtr <> nil then - ReadBlock(dataPtr, lStdProp.DataSize, lPropHdrOffset + lStdProp.DataOffset); + ReadBlock(dataPtr, lStdProp.DataSize, lPropHdrOffset + lStdProp.DataOffset){%H-}; end; end; // read custom properties...not implemented @@ -1128,6 +1128,7 @@ SysUtils.DeleteFile(DestFileName); SysUtils.DeleteFile(ChangeFileExt(DestFileName, GetMemoExt)); end else begin + NewBaseName:= ''; I := 0; FindNextName(DestFileName, NewBaseName, I); SysUtils.RenameFile(DestFileName, NewBaseName); @@ -1183,6 +1184,7 @@ CheckExclusiveAccess; // make up some temporary filenames + NewBaseName := ''; lRecNo := 0; FindNextName(FileName, NewBaseName, lRecNo); @@ -1652,6 +1654,7 @@ ftSmallInt: begin // PSmallInt(Dst)^ := GetIntFromStrLength(Src, FieldSize, 0); + IntValue := 0; Result := StrToInt32Width(IntValue, Src, FieldSize, 0); if Result then Result := (IntValue >= Low(SmallInt)) and (IntValue <= High(SmallInt)); @@ -1669,6 +1672,7 @@ ftFloat, ftCurrency: begin // PDouble(Dst)^ := DbfStrToFloat(Src, FieldSize); + FloatValue := 0; Result := StrToFloatWidth(FloatValue, Src, FieldSize, 0); if Result then PDouble(Dst)^ := FloatValue; @@ -1679,8 +1683,11 @@ // ldy := GetIntFromStrLength(PAnsiChar(Src) + 0, 4, 1); // ldm := GetIntFromStrLength(PAnsiChar(Src) + 4, 2, 1); // ldd := GetIntFromStrLength(PAnsiChar(Src) + 6, 2, 1); + ldy := 0; StrToInt32Width(ldy, PAnsiChar(Src) + 0, 4, 1); + ldm := 0; StrToInt32Width(ldm, PAnsiChar(Src) + 4, 2, 1); + ldd := 0; StrToInt32Width(ldd, PAnsiChar(Src) + 6, 2, 1); //if (ly<1900) or (ly>2100) then ly := 1900; //Year from 0001 to 9999 is possible @@ -1698,8 +1705,11 @@ if (AFieldDef.FieldType = ftDateTime) and (DataType = ftDateTime) then begin // get hour, minute, second + lth := 0; StrToInt32Width(lth, PAnsiChar(Src) + 8, 2, 1); + ltm := 0; StrToInt32Width(ltm, PAnsiChar(Src) + 10, 2, 1); + lts := 0; StrToInt32Width(lts, PAnsiChar(Src) + 12, 2, 1); // encode try @@ -2850,8 +2860,9 @@ TempCodePageList.Add(Pointer(StrToIntDef(string(CodePageString), -1))); // Avoid conversion to AnsiString {$ELSE} //TempCodePageList.Add(Pointer(GetIntFromStrLength(CodePageString, dbfStrLen(CodePageString), -1))); + IntValue := 0; if StrToInt32Width(IntValue, CodePageString, dbfStrLen(CodePageString), -1) then - TempCodePageList.Add(Pointer(IntValue)); + TempCodePageList.Add({%H-}Pointer(IntValue)); {$ENDIF} // continue enumeration @@ -2919,7 +2930,7 @@ function TDbfGlobals.CodePageInstalled(ACodePage: Integer): Boolean; begin - Result := FCodePages.IndexOf(Pointer(ACodePage)) >= 0; + Result := FCodePages.IndexOf({%H-}Pointer(ACodePage)) >= 0; end; {$ifdef SUPPORT_FORMATSETTINGSTYPE} @@ -2929,8 +2940,12 @@ Result := TFormatSettings.Create(''); {$else} // Result := TFormatSettings.Create(GetUserDefaultLCID); +{$ifdef FPC} + Result := FormatSettings; +{$else} GetLocaleFormatSettings(GetUserDefaultLCID, Result); {$endif} +{$endif} end; {$endif SUPPORT_FORMATSETTINGSTYPE} Modified: trunk/src/dbf_fields.pas =================================================================== --- trunk/src/dbf_fields.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_fields.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -283,11 +283,11 @@ {$ifdef SUPPORT_FIELDDEF_ATTRIBUTES} DbDest.Attributes := []; DbDest.ChildDefs.Clear; +{$endif} DbDest.DataType := FFieldType; DbDest.Required := FRequired; DbDest.Size := FSize; DbDest.Name := string(FFieldName); -{$endif} end else {$endif} inherited AssignTo(Dest); Modified: trunk/src/dbf_idxfile.pas =================================================================== --- trunk/src/dbf_idxfile.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_idxfile.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -22,7 +22,6 @@ {$endif} dbf_parser, dbf_prsdef, - dbf_cursor, dbf_collate, dbf_common; @@ -367,8 +366,8 @@ function Update(RecNo: Integer; PrevBuffer, NewBuffer: TDbfRecordBuffer): Boolean; procedure Delete(RecNo: Integer; Buffer: TDbfRecordBuffer); function CheckKeyViolation(Buffer: TDbfRecordBuffer; RecNo: Integer): Boolean; - procedure RecordDeleted(RecNo: Integer; Buffer: TDbfRecordBuffer); - function RecordRecalled(RecNo: Integer; Buffer: TDbfRecordBuffer): Boolean; + procedure RecordDeleted({%H-}RecNo: Integer; {%H-}Buffer: TDbfRecordBuffer); + function RecordRecalled({%H-}RecNo: Integer; {%H-}Buffer: TDbfRecordBuffer): Boolean; procedure DeleteIndex(const AIndexName: string); procedure RepageFile; procedure CompactFile; @@ -459,7 +458,7 @@ RecBOF = 0; RecEOF = MaxInt; - lcidBinary = $0A03; +//lcidBinary = $0A03; KeyFormat_Expression = $00; KeyFormat_Data = $10; @@ -700,7 +699,7 @@ function LocaleCallBack(LocaleString: PAnsiChar): Integer; stdcall; begin - LCIDList.Add(Pointer(StrToInt(String('$'+LocaleString)))); + LCIDList.Add({%H-}Pointer(StrToInt(String('$'+LocaleString)))); Result := 1; end; @@ -3413,6 +3412,7 @@ else begin // KeyBuffer := FCurrentParser.ExtractFromBuffer(Buffer); + IsNull := False; KeyBuffer := FCurrentParser.ExtractFromBuffer(PAnsiChar(Buffer), RecNo, IsNull); // if (KeyType = 'D') and (FCurrentParser.ExtractIsNull(Buffer)) then if (KeyType = 'D') and IsNull then @@ -3655,6 +3655,7 @@ if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then begin DeleteKey := ExtractKeyFromBuffer(PrevBuffer, RecNo); + FillChar(TempBuffer{%H-}, SizeOf(TempBuffer), 0); Move(DeleteKey^, TempBuffer, SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen)); DeleteKey := @TempBuffer[0]; InsertKey := ExtractKeyFromBuffer(NewBuffer, RecNo); @@ -4160,7 +4161,7 @@ function TIndexFile.GetSequentialRecordCount: TSequentialRecNo; begin - Result := FRoot.Weight * (FRoot.HighIndex + 1); + Result := TSequentialRecNo(FRoot.Weight) * (TSequentialRecNo(FRoot.HighIndex) + 1); end; function TIndexFile.GetSequentialRecNo: TSequentialRecNo; @@ -4473,7 +4474,7 @@ function TIndexFile.VersionPosition: TPagedFileOffset; begin - Result := TPagedFileOffset(FMdxTag.HeaderPageNo) * PageSize + Integer(@PIndexHdr(nil)^.Version); + Result := TPagedFileOffset(FMdxTag.HeaderPageNo) * PageSize + {%H-}TPagedFileOffset(@PIndexHdr(nil)^.Version); end; function TIndexFile.ReadVersion(PVersion: PByte): Boolean; Modified: trunk/src/dbf_memo.pas =================================================================== --- trunk/src/dbf_memo.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_memo.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -66,12 +66,12 @@ TNullMemoFile = class(TMemoFile) protected - procedure SetHeaderOffset(NewValue: Integer); override; - procedure SetRecordSize(NewValue: Integer); override; - procedure SetHeaderSize(NewValue: Integer); override; + procedure SetHeaderOffset({%H-}NewValue: Integer); override; + procedure SetRecordSize({%H-}NewValue: Integer); override; + procedure SetHeaderSize({%H-}NewValue: Integer); override; - function LockSection(const Offset: TPagedFileOffset; const Length: Cardinal; const Wait: Boolean): Boolean; override; - function UnlockSection(const Offset: TPagedFileOffset; const Length: Cardinal): Boolean; override; + function LockSection(const {%H-}Offset: TPagedFileOffset; const {%H-}Length: Cardinal; const {%H-}Wait: Boolean): Boolean; override; + function UnlockSection(const {%H-}Offset: TPagedFileOffset; const {%H-}Length: Cardinal): Boolean; override; function GetBlockLen: Integer; override; function GetMemoSize: Integer; override; Modified: trunk/src/dbf_parser.pas =================================================================== --- trunk/src/dbf_parser.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_parser.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -45,7 +45,7 @@ procedure HandleUnknownVariable(VarName: string); override; function GetVariableInfo(VarName: AnsiString): TDbfFieldDef; virtual; function CurrentExpression: string; override; - procedure ValidateExpression(AExpression: string); virtual; + procedure ValidateExpression({%H-}AExpression: string); virtual; function GetResultType: TExpressionType; override; function GetResultLen: Integer; @@ -542,7 +542,7 @@ raise ExceptionClass.CreateFmt(STRING_PARSER_UNKNOWN_FIELD, [VarName]); // define field in parser - FillChar(VariableFieldInfo, SizeOf(VariableFieldInfo), 0); + FillChar(VariableFieldInfo{%H-}, SizeOf(VariableFieldInfo), 0); VariableFieldInfo.DbfFieldDef := FieldInfo; VariableFieldInfo.NativeFieldType := FieldInfo.NativeFieldType; VariableFieldInfo.Size := FieldInfo.Size; @@ -656,6 +656,7 @@ var IsNull: Boolean; begin + IsNull := False; Result := ExtractFromBuffer(Buffer, RecNo, IsNull); end; Modified: trunk/src/dbf_pgfile.pas =================================================================== --- trunk/src/dbf_pgfile.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_pgfile.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -408,7 +408,7 @@ else if PageNo = 0 then Result := 0 else - Result := FHeaderOffset + FHeaderSize + (TPagedFileOffset(FPageSize) * (PageNo - 1)); + Result := TPagedFileOffset(FHeaderOffset) + FHeaderSize + (TPagedFileOffset(FPageSize) * (TPagedFileOffset(PageNo) - 1)); end; procedure TPagedFile.CheckCachedSize(const APosition: TPagedFileOffset); @@ -537,7 +537,7 @@ begin if FBufferAhead then begin - Offset := TPagedFileOffset(IntRecNum - FBufferPage) * PageSize; + Offset := (TPagedFileOffset(IntRecNum) - FBufferPage) * PageSize; if (FBufferPage <> -1) and (FBufferPage <= IntRecNum) and // (Offset+RecordSize <= FBufferReadSize) then (Offset + RecordSize <= FBufferSize) then @@ -553,7 +553,7 @@ exit; end; // reset offset into buffer - Offset := TPagedFileOffset(IntRecNum - FBufferPage) * PageSize; + Offset := (TPagedFileOffset(IntRecNum) - FBufferPage) * PageSize; end; // now we have this record in buffer Move(PAnsiChar(FBufferPtr)[Offset], Buffer^, RecordSize); // Was PChar @@ -571,10 +571,10 @@ begin if FBufferAhead then begin - RecEnd := TPagedFileOffset(IntRecNum - FBufferPage + PagesPerRecord) * PageSize; + RecEnd := (TPagedFileOffset(IntRecNum) - FBufferPage + PagesPerRecord) * PageSize; if (FBufferPage <> -1) and (FBufferPage <= IntRecNum) and // (RecEnd <= FBufferMaxSize) then - (RecEnd <= FBufferMaxSize) and (RecEnd <= FBufferSize + RecordSize) then + (RecEnd <= FBufferMaxSize) and (RecEnd <= TPagedFileOffset(FBufferSize) + RecordSize) then begin // extend buffer? if RecEnd > FBufferSize then @@ -582,7 +582,7 @@ end else begin // record outside buffer, need to synchronize first SynchronizeBuffer(IntRecNum); - RecEnd := PagesPerRecord * PageSize; + RecEnd := TPagedFileOffset(PagesPerRecord) * PageSize; FBufferSize := RecEnd; end; // we can write this record to buffer @@ -849,9 +849,9 @@ if RecordCount <> NewValue then begin if FPageOffsetByHeader then - FCachedSize := FHeaderSize + FHeaderOffset + FPageSize * NewValue + FCachedSize := FHeaderSize + TPagedFileOffset(FHeaderOffset) + (TPagedFileOffset(FPageSize) * NewValue) else - FCachedSize := FPageSize * NewValue; + FCachedSize := TPagedFileOffset(FPageSize) * NewValue; // FCachedSize := CalcPageOffset(NewValue); FRecordCount := NewValue; FStream.Size := FCachedSize; Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_prscore.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -846,6 +846,8 @@ end; end else if Length(W) > 0 then + begin + I := -1; if FWordsList.Search(PChar(W), I) then // PChar intended here begin DestCollection.Add(FWordsList.Items[I]) @@ -860,6 +862,7 @@ raise ExceptionClass.Create('Unknown variable '''+W+''' found.'); end; end; + end; until I2 > Len; end; @@ -1251,12 +1254,14 @@ '+': begin Inc(I2); + I := -1; if (AnExpr[I2] = '+') and FWordsList.Search(PChar('++'), I) then // PChar intended here Inc(I2); end; '-': begin Inc(I2); + I := -1; if (AnExpr[I2] = '-') and FWordsList.Search(PChar('--'), I) then // PChar intended here Inc(I2); end; @@ -1292,7 +1297,7 @@ {$IFDEF ENG_NUMBERS} // we'll have to convert FDecimalSeparator into DecimalSeparator // otherwise the OS will not understand what we mean - W[DecSep] := DecimalSeparator; + W[DecSep] := DecimalSeparator{%H-}; {$ENDIF} Result := TFloatConstant.Create(W, W) end else begin @@ -1363,6 +1368,7 @@ p := Pos('(', S); if p > 0 then S := Copy(S, 1, p - 1); + I := -1; if FWordsList.Search(pchar(S), I) then // PChar intended here Result := TExprWord(FWordsList.Items[I]).Description else Modified: trunk/src/dbf_prsdef.pas =================================================================== --- trunk/src/dbf_prsdef.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_prsdef.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -129,7 +129,7 @@ function GetDescription: string; virtual; function GetTypeSpec: string; virtual; function GetShortName: string; virtual; - procedure SetFixedLen(NewLen: integer); virtual; + procedure SetFixedLen({%H-}NewLen: integer); virtual; public constructor Create(AName: string; AExprFunc: TExprFunc); overload; constructor Create(AName: string; AExprFunc: TExprFunc; AIsNullPtr: PBoolean); overload; @@ -158,7 +158,7 @@ public function KeyOf(Item: Pointer): Pointer; override; function Compare(Key1, Key2: Pointer): Integer; override; - procedure FreeItem(Item: Pointer); override; + procedure FreeItem({%H-}Item: Pointer); override; end; TExpressList = class(TSortedCollection) @@ -970,6 +970,7 @@ { also add ShortName as reference } if Length(TExprWord(Item).ShortName) > 0 then begin + I := -1; FShortList.Search(FShortList.KeyOf(Item), I); FShortList.Insert(I, Item); end; @@ -999,6 +1000,7 @@ Result := inherited Search(Key, Index); if not Result then begin + SecIndex := -1; Result := FShortList.Search(Key, SecIndex); if Result then Index := IndexOf(FShortList.Items[SecIndex]); Modified: trunk/src/dbf_prssupp.pas =================================================================== --- trunk/src/dbf_prssupp.pas 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_prssupp.pas 2015-09-18 19:58:08 UTC (rev 558) @@ -26,7 +26,7 @@ TNoOwnerCollection = class(TOCollection) public - procedure FreeItem(Item: Pointer); override; + procedure FreeItem({%H-}Item: Pointer); override; end; { TSortedCollection object } @@ -129,6 +129,7 @@ I: Integer; begin IndexOf := -1; + I := -1; if Search(KeyOf(Item), I) then begin while (I < Count) and (Item <> Items[I]) do @@ -141,6 +142,7 @@ var Index: Integer; begin + Index := -1; if Search(KeyOf(Item), Index) then Delete(Index); Add(Item); @@ -150,6 +152,7 @@ var I: Integer; begin + I := -1; Search(KeyOf(Item), I); Insert(I, Item); end; @@ -353,7 +356,8 @@ Buffer: array[0..{$ifdef SUPPORT_INT64}18{$else}9{$endif}] of AnsiChar; P: PAnsiChar; begin - FillChar(FloatResult, SizeOf(FloatResult), 0); + FillChar(Buffer{%H-}, SizeOf(Buffer), 0); + FillChar(FloatResult{%H-}, SizeOf(FloatResult), 0); FloatResult.Dest := Buffer; FloatResult.FieldSize := FieldSize; FloatReset(FloatResult); @@ -398,7 +402,7 @@ FloatResult: TFloatResult; FloatRec: TFloatRec; begin - FillChar(FloatResult, SizeOf(FloatResult), 0); + FillChar(FloatResult{%H-}, SizeOf(FloatResult), 0); FloatResult.Dest := Dest; FloatResult.FieldSize := FieldSize; FloatToDecimal(FloatRec, Val, fvExtended, 15, FieldPrec); @@ -460,6 +464,7 @@ until (P = PAnsiChar(Src) + Size) or (not Result); if not Result then begin + FloatValue := 0; Result := StrToFloatWidth(FloatValue, Src, Size, Default); if Result then IntValue:= Round(FloatValue); @@ -474,6 +479,7 @@ var AIntValue: Int64; begin + AIntValue := 0; Result := StrToIntWidth(AIntValue, Src, Size, Default); if Result then begin @@ -499,6 +505,7 @@ Result := Size < SizeOf(Buffer); if Result then begin + FillChar(Buffer{%H-}, SizeOf(Buffer), 0); Move(Src^, Buffer, Size); Buffer[Size] := #0; {$ifdef SUPPORT_FORMATSETTINGSTYPE} @@ -519,7 +526,7 @@ initialization {$IFDEF SUPPORT_FORMATSETTINGSTYPE} - FillChar(DbfFormatSettings, SizeOf(DbfFormatSettings), 0); + FillChar(DbfFormatSettings{%H-}, SizeOf(DbfFormatSettings), 0); DbfFormatSettings.DecimalSeparator:= DBF_DECIMAL; {$ENDIF} Modified: trunk/src/dbf_struct.inc =================================================================== --- trunk/src/dbf_struct.inc 2015-09-18 16:23:39 UTC (rev 557) +++ trunk/src/dbf_struct.inc 2015-09-18 19:58:08 UTC (rev 558) @@ -2,13 +2,13 @@ const //==================================================================== - FieldPropType_Required = $01; - FieldPropType_Min = $02; - FieldPropType_Max = $03; - FieldPropType_Default = $04; - FieldPropType_Constraint = $06; + {%H-}FieldPropType_Required = $01; + {%H-}FieldPropType_Min = $02; + {%H-}FieldPropType_Max = $03; + {%H-}FieldPropType_Default = $04; +//FieldPropType_Constraint = $06; - FieldDescVII_AutoIncOffset = 42; + {%H-}FieldDescVII_AutoIncOffset = 42; //==================================================================== // File structures @@ -16,7 +16,7 @@ type - PDbfHdr = ^rDbfHdr; + PDbfHdr = {%H-}^rDbfHdr; rDbfHdr = packed record VerDBF : Byte; // 0 Year : Byte; // 1 @@ -36,17 +36,17 @@ Dummy3 : Word; // 30-31 end; //==================================================================== - PAfterHdrIII = ^rAfterHdrIII; + PAfterHdrIII = {%H-}^rAfterHdrIII; rAfterHdrIII = packed record // Empty end; //==================================================================== - PAfterHdrVII = ^rAfterHdrVII; + PAfterHdrVII = {%H-}^rAfterHdrVII; rAfterHdrVII = packed record LanguageDriverName : array[32..63] of AnsiChar; Dummy : array[64..67] of Byte; end; //==================================================================== - PFieldDescIII = ^rFieldDescIII; + PFieldDescIII = {%H-}^rFieldDescIII; rFieldDescIII = packed record FieldName : array[0..10] of AnsiChar; FieldType : AnsiChar; // 11 @@ -58,7 +58,7 @@ end; //==================================================================== // OH 2000-11-15 dBase7 support. Header Update (add fields like Next AutoInc Value) - rFieldDescVII = packed record + rFieldDescVII = {%H-}packed record FieldName : array [0..31] of AnsiChar; FieldType : AnsiChar; // 32 FieldSize : Byte; // 33 @@ -73,7 +73,7 @@ Reserved3 : Word; // 46-47 end; //==================================================================== - PFieldPropsHdr = ^rFieldPropsHdr; + PFieldPropsHdr = {%H-}^rFieldPropsHdr; rFieldPropsHdr = packed record NumStdProps : Word; // 0..1 StartStdProps : Word; // 2..3 @@ -85,7 +85,7 @@ Size : Word; // 14..15 ; Actual size of structure, including data end; //==================================================================== - PStdPropEntry = ^rStdPropEntry; + PStdPropEntry = {%H-}^rStdPropEntry; rStdPropEntry = packed record GenNumber : Word; // 0..1 ; Generational number. More than one value may exist for a property. The current value is the value with the highest generational number. FieldOffset : Word; // 2..3 ; Table field offset - base one. 01 for the first field in the table, 02 for the second field, etc. Note: this will be 0 in the case of a constraint. @@ -115,7 +115,7 @@ DataSize : Word; // 13..14 ; Width of database field associated with the property, and hence size of the data (includes 0 terminator in the case of a constraint). end; //==================================================================== - PCustomPropEntry = ^rCustomPropEntry; + PCustomPropEntry = {%H-}^rCustomPropEntry; rCustomPropEntry = packed record GenNumber : Word; // 0..1 ; same as standard FieldOffset : Word; // 2..3 ; same as standard @@ -127,7 +127,7 @@ DataLength : Word; // 12..13 ; Length of the Custom property data (does not include null terminator). end; //==================================================================== - PRIPropEntry = ^rRIPropEntry; + PRIPropEntry = {%H-}^rRIPropEntry; rRIPropEntry = packed record RelationType : Byte; // 0 ; 0x07 if Master (parent), 0x08 if Dependent (child). Number : Word; // 1..2 ; Sequential number, 1 based counting. If this number is 0, this RI rule has been dropped. This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-09-23 12:09:30
|
Revision: 569 http://sourceforge.net/p/tdbf/code/569 Author: paulenandrew Date: 2015-09-23 12:09:28 +0000 (Wed, 23 Sep 2015) Log Message: ----------- Change version number to 7.0 Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf.pas trunk/src/dbf_common.pas trunk/src/dbf_reg.pas trunk/src/dbf_str.inc trunk/src/dbf_str.pas trunk/src/dbf_str_de.pas trunk/src/dbf_str_es.pas trunk/src/dbf_str_fr.pas trunk/src/dbf_str_ita.pas trunk/src/dbf_str_nl.pas trunk/src/dbf_str_pl.pas trunk/src/dbf_str_pt.pas trunk/src/dbf_str_ru.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/doc/history.txt 2015-09-23 12:09:28 UTC (rev 569) @@ -33,7 +33,7 @@ ------------------------ -V6.9.2 +V7.0 - compile fixes for delphi 4, 5 (pdouble) - fix indexes to work properly with ansi upper/lower casing Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -2789,7 +2789,7 @@ function TDbf.GetVersion: string; begin - Result := Format('%d.%02d', [TDBF_MAJOR_VERSION, TDBF_MINOR_VERSION]); + Result := DbfVersionString; end; procedure TDbf.SetVersion(const S: string); Modified: trunk/src/dbf_common.pas =================================================================== --- trunk/src/dbf_common.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_common.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -16,10 +16,13 @@ const - TDBF_MAJOR_VERSION = 6; - TDBF_MINOR_VERSION = 9; - TDBF_SUB_MINOR_VERSION = 2; + TDBF_MAJOR_VERSION = 7; + TDBF_MINOR_VERSION = 0; + TDBF_SUB_MINOR_VERSION = 0; +function DbfVersionString: string; + +const TDBF_TABLELEVEL_FOXPRO = 25; JulianDateDelta = 1721425; { number of days between 1.1.4714 BC and "0" } @@ -189,6 +192,15 @@ //==================================================================== +function DbfVersionString: string; +begin + Result := Format('TDbf %d.%d', [TDBF_MAJOR_VERSION, TDBF_MINOR_VERSION]); + if TDBF_SUB_MINOR_VERSION <> 0 then + {%H-}Result := Result + Format('.%d', [TDBF_SUB_MINOR_VERSION]); +end; + +//==================================================================== + function GetCompletePath(const Base, Path: string): string; begin if IsFullFilePath(Path) Modified: trunk/src/dbf_reg.pas =================================================================== --- trunk/src/dbf_reg.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_reg.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -265,7 +265,7 @@ procedure TVersionProperty.Edit; {override;} begin ShowMessage( - Format(STRING_VERSION,[TDBF_MAJOR_VERSION, TDBF_MINOR_VERSION]) + + DbfVersionString + ' : a dBase component'+#13+ 'for Delphi and c++ builder with no BDE.'+#13+ #13 + Modified: trunk/src/dbf_str.inc =================================================================== --- trunk/src/dbf_str.inc 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str.inc 2015-09-23 12:09:28 UTC (rev 569) @@ -1,6 +1,5 @@ var STRING_FILE_NOT_FOUND: string; - STRING_VERSION: string; STRING_RECORD_LOCKED: string; STRING_READ_ERROR: string; Modified: trunk/src/dbf_str.pas =================================================================== --- trunk/src/dbf_str.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -12,7 +12,6 @@ initialization STRING_FILE_NOT_FOUND := 'Open: file not found: "%s".'; - STRING_VERSION := 'TDbf V%d.%d'; STRING_RECORD_LOCKED := 'Record locked.'; STRING_READ_ERROR := 'Error while reading occured.'; Modified: trunk/src/dbf_str_de.pas =================================================================== --- trunk/src/dbf_str_de.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str_de.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -12,7 +12,6 @@ initialization STRING_FILE_NOT_FOUND := '\xD6ffnen: Datei nicht gefunden: "%s"'; - STRING_VERSION := 'TDbf V%d.%d'; STRING_RECORD_LOCKED := 'Datensatz gesperrt.'; STRING_READ_ERROR := 'Lesefehler.'; Modified: trunk/src/dbf_str_es.pas =================================================================== --- trunk/src/dbf_str_es.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str_es.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -12,7 +12,6 @@ initialization STRING_FILE_NOT_FOUND := 'Apertura: archivo no encontrado: "%s".'; - STRING_VERSION := 'TDbf V%d.%d'; STRING_RECORD_LOCKED := 'Registro bloqueado.'; STRING_READ_ERROR := 'Error de lectura.'; Modified: trunk/src/dbf_str_fr.pas =================================================================== --- trunk/src/dbf_str_fr.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str_fr.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -12,7 +12,6 @@ initialization STRING_FILE_NOT_FOUND := 'Ouverture: fichier non trouv\xE9: "%s"'; - STRING_VERSION := 'TDbf V%d.%d'; STRING_RECORD_LOCKED := 'Enregistrement verrouill\xE9.'; STRING_READ_ERROR := 'Erreur de lecture.'; Modified: trunk/src/dbf_str_ita.pas =================================================================== --- trunk/src/dbf_str_ita.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str_ita.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -12,7 +12,6 @@ initialization STRING_FILE_NOT_FOUND := 'Apertura: file non trovato: "%s"'; - STRING_VERSION := 'TDbf V%d.%d'; STRING_RECORD_LOCKED := 'Record gi\xE0 in uso.'; STRING_READ_ERROR := 'Errore di lettura.'; Modified: trunk/src/dbf_str_nl.pas =================================================================== --- trunk/src/dbf_str_nl.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str_nl.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -12,7 +12,6 @@ initialization STRING_FILE_NOT_FOUND := 'Openen: bestand niet gevonden: "%s"'; - STRING_VERSION := 'TDbf V%d.%d'; STRING_RECORD_LOCKED := 'Record in gebruik.'; STRING_READ_ERROR := 'Error tijdens lezen.'; Modified: trunk/src/dbf_str_pl.pas =================================================================== --- trunk/src/dbf_str_pl.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str_pl.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -12,7 +12,6 @@ initialization STRING_FILE_NOT_FOUND := 'Open: brak pliku: "%s"'; - STRING_VERSION := 'TDbf V%d.%d'; STRING_RECORD_LOCKED := 'Rekord zablokowany.'; STRING_READ_ERROR := 'Nieprzeczytane.'; Modified: trunk/src/dbf_str_pt.pas =================================================================== --- trunk/src/dbf_str_pt.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str_pt.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -12,7 +12,6 @@ initialization STRING_FILE_NOT_FOUND := 'Abertura: arquivo n\xE3o encontrado: "%s".'; - STRING_VERSION := 'TDbf V%d.%d'; STRING_RECORD_LOCKED := 'Registro bloqueado.'; STRING_READ_ERROR := 'Erro de leitura.'; Modified: trunk/src/dbf_str_ru.pas =================================================================== --- trunk/src/dbf_str_ru.pas 2015-09-22 09:24:17 UTC (rev 568) +++ trunk/src/dbf_str_ru.pas 2015-09-23 12:09:28 UTC (rev 569) @@ -15,7 +15,6 @@ initialization STRING_FILE_NOT_FOUND := '\xD4\xE0\xE9\xEB "%s" \xED\xE5 \xF1\xF3\xF9\xE5\xF1\xF2\xE2\xF3\xE5\xF2. \xCE\xF2\xEA\xF0\xFB\xF2\xFC \xED\xE5\xE2\xEE\xE7\xEC\xEE\xE6\xED\xEE.'; - STRING_VERSION := 'TDbf V%d.%d'; STRING_RECORD_LOCKED := '\xC7\xE0\xEF\xE8\xF1\xFC (\xF1\xF2\xF0\xEE\xEA\xE0 \xF2\xE0\xE1\xEB\xE8\xF6\xFB) \xE7\xE0\xE1\xEB\xEE\xEA\xE8\xF0\xEE\xE2\xE0\xED\xE0.'; STRING_READ_ERROR := '\xCE\xF8\xE8\xE1\xEA\xE0 \xF7\xF2\xE5\xED\xE8\xFF \xF1 \xE4\xE8\xF1\xEA\xE0.'; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-11-03 20:13:45
|
Revision: 586 http://sourceforge.net/p/tdbf/code/586 Author: paulenandrew Date: 2015-11-03 20:13:40 +0000 (Tue, 03 Nov 2015) Log Message: ----------- Add TDbf Demo 1.3.6 to trunc/demo, fix inconsistent end of line characters in TDbf_Demo.dpr, history.txt, tdbf_demo5.bpr and tdbf_demo5.cpp Added Paths: ----------- trunk/demo/ trunk/demo/COPYING trunk/demo/Calc.dfm trunk/demo/Calc.pas trunk/demo/Compatibility.dfm trunk/demo/Compatibility.pas trunk/demo/CopyTable.dfm trunk/demo/CopyTable.pas trunk/demo/CreateTable.dfm trunk/demo/CreateTable.pas trunk/demo/EditTopics.dfm trunk/demo/EditTopics.pas trunk/demo/Filter.dfm trunk/demo/Filter.pas trunk/demo/Index.dfm trunk/demo/Index.pas trunk/demo/Main.dfm trunk/demo/Main.pas trunk/demo/Pack.dfm trunk/demo/Pack.pas trunk/demo/TDbf_Demo.dpr trunk/demo/TDbf_Demo.res trunk/demo/data/ trunk/demo/data/DBASE3+.DBT trunk/demo/data/DBASE3+.dbf trunk/demo/data/DBASE4.dbf trunk/demo/data/DBASEWIN.dbf trunk/demo/data/TDBF_DEMO.DBF trunk/demo/data/TDBF_DEMO.dbt trunk/demo/data/Table1 trunk/demo/data/Table2 trunk/demo/data/VisualDBase.dbf trunk/demo/data/VisualDBase.dbt trunk/demo/data/dbase4.dbt trunk/demo/data/dbasewin.dbt trunk/demo/data/disco.DBF trunk/demo/data/disco.mdx trunk/demo/data/price.ndx trunk/demo/data/table1.DBF trunk/demo/data/table1.dbt trunk/demo/data/tdbf_demo.mdx trunk/demo/data/title.ndx trunk/demo/history.txt trunk/demo/multipleuse.dfm trunk/demo/multipleuse.pas trunk/demo/schema.dfm trunk/demo/schema.pas trunk/demo/schema2.dfm trunk/demo/schema2.pas trunk/demo/search.dfm trunk/demo/search.pas trunk/demo/simple.dfm trunk/demo/simple.pas trunk/demo/specialfields.dfm trunk/demo/tdbf_demo5.bpr trunk/demo/tdbf_demo5.cpp trunk/demo/tdbf_demo5.res Added: trunk/demo/COPYING =================================================================== --- trunk/demo/COPYING (rev 0) +++ trunk/demo/COPYING 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program 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 General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. Property changes on: trunk/demo/COPYING ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/Calc.dfm =================================================================== (Binary files differ) Index: trunk/demo/Calc.dfm =================================================================== --- trunk/demo/Calc.dfm 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/Calc.dfm 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/Calc.dfm ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/Calc.pas =================================================================== --- trunk/demo/Calc.pas (rev 0) +++ trunk/demo/Calc.pas 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,30 @@ +unit Calc; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + Grids, ExtCtrls, DBCtrls, DBGrids; + +type + TCalcForm = class(TForm) + DBNavigator1: TDBNavigator; + DBGrid1: TDBGrid; + private + { D\xE9clarations priv\xE9es } + public + { D\xE9clarations publiques } + end; + +var + CalcForm: TCalcForm; + +implementation + +uses Main; + +{$R *.DFM} + +end. + + Property changes on: trunk/demo/Calc.pas ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/Compatibility.dfm =================================================================== (Binary files differ) Index: trunk/demo/Compatibility.dfm =================================================================== --- trunk/demo/Compatibility.dfm 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/Compatibility.dfm 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/Compatibility.dfm ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/Compatibility.pas =================================================================== --- trunk/demo/Compatibility.pas (rev 0) +++ trunk/demo/Compatibility.pas 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,47 @@ +unit Compatibility; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + Db, dbf, StdCtrls, DBCtrls, ExtCtrls, Grids, DBGrids; + +type + TCompatibilityForm = class(TForm) + Dbf1: TDbf; + DataSource1: TDataSource; + DBNavigator1: TDBNavigator; + DBGrid1: TDBGrid; + RadioGroup1: TRadioGroup; + Label1: TLabel; + DBMemo1: TDBMemo; + procedure RadioGroup1Click(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + CompatibilityForm: TCompatibilityForm; + +implementation + +{$R *.dfm} + +procedure TCompatibilityForm.RadioGroup1Click(Sender: TObject); +var + filename:string; +begin + case RadioGroup1.ItemIndex of + 0: filename:='DBASE3+.dbf'; + 1: filename:='DBASE4.dbf'; + 2: filename:='DBASEWIN.dbf'; + 3: filename:='VisualDBase.dbf'; + end; + dbf1.Active:=false; + dbf1.TableName:=filename; + dbf1.Active:=true; +end; + +end. Property changes on: trunk/demo/Compatibility.pas ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/CopyTable.dfm =================================================================== (Binary files differ) Index: trunk/demo/CopyTable.dfm =================================================================== --- trunk/demo/CopyTable.dfm 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/CopyTable.dfm 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/CopyTable.dfm ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/CopyTable.pas =================================================================== --- trunk/demo/CopyTable.pas (rev 0) +++ trunk/demo/CopyTable.pas 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,111 @@ +unit CopyTable; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, Grids, DBGrids, Db, dbf; + +type + TCopyTableForm = class(TForm) + DataSource1: TDataSource; + DBGrid1: TDBGrid; + DBGrid2: TDBGrid; + DataSource2: TDataSource; + Panel1: TPanel; + Panel2: TPanel; + Copy1In2: TButton; + Clear1: TButton; + Add100_1: TButton; + Dbf1: TDbf; + Dbf2: TDbf; + Dbf1Field1: TIntegerField; + Dbf1Field2: TStringField; + FastCopy: TCheckBox; + procedure Clear1Click(Sender: TObject); + procedure Add100_1Click(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure Copy1In2Click(Sender: TObject); + private + { D\xE9clarations priv\xE9es } + public + { D\xE9clarations publiques } + end; + +var + CopyTableForm: TCopyTableForm; + +implementation + +{$R *.DFM} + +procedure TCopyTableForm.Clear1Click(Sender: TObject); +begin + try + Dbf1.Active:=false; + Dbf1.CreateTable; + finally + Dbf1.Active:=true; + Add100_1Click(Sender); + end; +end; + +procedure TCopyTableForm.Add100_1Click(Sender: TObject); +var + x:integer; + RandomString:string; +begin + Dbf1.DisableControls; + try + for x:=1 to 100 do begin + Dbf1.Append; + RandomString:= + chr(random(26)+65)+ + chr(random(10)+48)+ + chr(random(10)+48)+ + chr(random(10)+48)+ + chr(random(10)+48); + + Dbf1Field1.AsInteger:=Random(10000); + Dbf1Field2.AsString:=RandomString; + Dbf1.Post; + end; + finally + Dbf1.EnableControls; + end; +end; + +procedure TCopyTableForm.FormShow(Sender: TObject); +begin + Dbf1.Active:=false; + Dbf2.Active:=false; + Clear1Click(Sender); + Dbf1.Active:=true; +end; + +procedure TCopyTableForm.Copy1In2Click(Sender: TObject); +var + i:integer; +begin + Dbf2.Active:=false; + Dbf2.CreateTableEx(Dbf1.DbfFieldDefs); + Dbf2.Active:=true; + Dbf1.First; + if FastCopy.Checked then begin + Dbf1.DisableControls; + Dbf2.DisableControls; + end; + while not Dbf1.Eof do begin + Dbf2.Insert; + For i:=0 to Dbf1.FieldCount-1 do begin + Dbf2.Fields[i].Value:=Dbf1.Fields[i].Value; + end; + Dbf2.Post; + Dbf1.Next; + end; + Dbf1.EnableControls; + Dbf2.EnableControls; +end; + +end. + Property changes on: trunk/demo/CopyTable.pas ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/CreateTable.dfm =================================================================== (Binary files differ) Index: trunk/demo/CreateTable.dfm =================================================================== --- trunk/demo/CreateTable.dfm 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/CreateTable.dfm 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/CreateTable.dfm ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/CreateTable.pas =================================================================== --- trunk/demo/CreateTable.pas (rev 0) +++ trunk/demo/CreateTable.pas 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,117 @@ +unit CreateTable; + +interface + + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + Grids, DBGrids, Db, Dbf, StdCtrls, Dbf_Fields, Dbf_Common; + +type + TCreateTableForm = class(TForm) + CreateMethod1: TButton; + Dbf1: TDbf; + DataSource1: TDataSource; + DBGrid1: TDBGrid; + Populate: TButton; + CreateMethod2: TButton; + procedure CreateMethod1Click(Sender: TObject); + procedure PopulateClick(Sender: TObject); + procedure CreateMethod2Click(Sender: TObject); + private + { D\xE9clarations priv\xE9es } + public + { D\xE9clarations publiques } + end; + +var + CreateTableForm: TCreateTableForm; + +implementation + +{$R *.DFM} + +procedure TCreateTableForm.CreateMethod1Click(Sender: TObject); +begin + With Dbf1 do begin + Close; + TableName := 'table1.dbf'; +// Method 1 + with FieldDefs do begin + Clear; + Add('Field1',ftString,10,False); + Add('Field2',ftInteger,0,False); + Add('Address',ftMemo,0,False); + Add('Date',ftDate,0,False); + end; + CreateTable; + Open; + end; +end; + +procedure TCreateTableForm.PopulateClick(Sender: TObject); +var + i:integer; + f1,f2:TField; +begin + f1:=Dbf1.FieldByName('Field1'); + f2:=Dbf1.FieldByName('Field2'); + for i:=0 to 100 do begin + Dbf1.Append; + f1.AsString:= + chr((i * 1 + 4) mod 26 + 65)+ + chr((i * 2 + 5) mod 26 + 65)+ + chr((i * 3 + 6) mod 26 + 65); + f2.AsInteger:=i; + Dbf1.Post; + end; +end; + + +procedure TCreateTableForm.CreateMethod2Click(Sender: TObject); +var + TempFieldDefs: TDbfFieldDefs; +begin + with Dbf1 do begin + Close; + TableName := 'table1.dbf'; +// Method 2 + TempFieldDefs := TDbfFieldDefs.Create(Self); + try + with TempFieldDefs.AddFieldDef do begin + FieldName := 'Field1'; + NativeFieldType := 'C'; + Size := 10; + end; + with TempFieldDefs.AddFieldDef do begin + FieldName := 'Field2'; + NativeFieldType := 'I'; + Size := 10; + Precision := 3; + end; + with TempFieldDefs.AddFieldDef do begin + FieldName := 'fAutoInc'; + NativeFieldType := '+'; + end; + with TempFieldDefs.AddFieldDef do begin + FieldName := 'f_I'; + NativeFieldType := 'I'; + end; + with TempFieldDefs.AddFieldDef do begin + FieldName := 'f_O'; + NativeFieldType := 'O'; + end; + with TempFieldDefs.AddFieldDef do begin + FieldName := 'f_@'; + NativeFieldType := 'I'; //'@'; + end; + Dbf1.CreateTableEx(TempFieldDefs); + finally + FreeAndNil(TempFieldDefs); + end; + Open; + end; +end; + +end. + Property changes on: trunk/demo/CreateTable.pas ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/EditTopics.dfm =================================================================== (Binary files differ) Index: trunk/demo/EditTopics.dfm =================================================================== --- trunk/demo/EditTopics.dfm 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/EditTopics.dfm 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/EditTopics.dfm ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/EditTopics.pas =================================================================== --- trunk/demo/EditTopics.pas (rev 0) +++ trunk/demo/EditTopics.pas 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,97 @@ +unit EditTopics; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, DBCtrls, Grids, DBGrids, ExtCtrls, ComCtrls, Buttons, db; + +type + TEditTopicsForm = class(TForm) + Grid1: TDBGrid; + DBNavigator1: TDBNavigator; + Button1: TButton; + DBRichEdit1: TDBRichEdit; + Panel1: TPanel; + SpeedButton1: TSpeedButton; + SpeedButton2: TSpeedButton; + SpeedButton3: TSpeedButton; + SpeedButton4: TSpeedButton; + SpeedButton5: TSpeedButton; + SpeedButton6: TSpeedButton; + SpeedButton7: TSpeedButton; + SpeedButton8: TSpeedButton; + SpeedButton9: TSpeedButton; + Pack: TButton; + SpeedButton10: TSpeedButton; + SpeedButton11: TSpeedButton; + SpeedButton12: TSpeedButton; + SpeedButton13: TSpeedButton; + procedure Button1Click(Sender: TObject); + procedure SpeedButton1Click(Sender: TObject); + procedure DBRichEdit1Enter(Sender: TObject); + procedure PackClick(Sender: TObject); + private + { D\xE9clarations priv\xE9es } + public + { D\xE9clarations publiques } + end; + +var + EditTopicsForm: TEditTopicsForm; + +implementation + +uses Main; + +{$R *.DFM} + +procedure TEditTopicsForm.Button1Click(Sender: TObject); +begin + Close; +end; + + + + +procedure TEditTopicsForm.SpeedButton1Click(Sender: TObject); +var + att:TTextAttributes; +begin + att:=DBRichedit1.SelAttributes; + + case TSpeedButton(Sender).Tag of + 0: if fsBold in att.Style then att.Style:=att.Style - [fsBold] else att.Style:=att.Style + [fsBold]; + 1: if fsItalic in att.Style then att.Style:=att.Style - [fsItalic] else att.Style:=att.Style + [fsItalic]; + 2: if fsUnderline in att.Style then att.Style:=att.Style - [fsUnderline] else att.Style:=att.Style + [fsUnderline]; + 3: att.size:=8; + 4: att.size:=10; + 5: att.size:=12; + 6: att.Color:=clBlack; + 7: att.Color:=clMaroon; + 8: att.Color:=clNavy; + 9: att.Name:='Arial'; + 10:att.Name:='Times New Roman'; + 11:att.Name:='Courier New'; + 12:att.Color:=clGreen; + end; + +end; + +procedure TEditTopicsForm.DBRichEdit1Enter(Sender: TObject); +begin + if Mainform.DbfDemo.State=dsBrowse then MainForm.DbfDemo.Edit; +end; + + +procedure TEditTopicsForm.PackClick(Sender: TObject); +begin + MainForm.DbfDemo.PackTable; +end; + + + + + +end. + Property changes on: trunk/demo/EditTopics.pas ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/Filter.dfm =================================================================== (Binary files differ) Index: trunk/demo/Filter.dfm =================================================================== --- trunk/demo/Filter.dfm 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/Filter.dfm 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/Filter.dfm ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/Filter.pas =================================================================== --- trunk/demo/Filter.pas (rev 0) +++ trunk/demo/Filter.pas 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,83 @@ +unit Filter; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, ComCtrls,db; + +type + TFilterForm = class(TForm) + Button1: TButton; + DBGrid1: TDBGrid; + GroupBox1: TGroupBox; + cbITA: TCheckBox; + cbUSA: TCheckBox; + cbHOL: TCheckBox; + cbUK: TCheckBox; + cbGER: TCheckBox; + cbSWE: TCheckBox; + cbOTH: TCheckBox; + GroupBox2: TGroupBox; + Label1: TLabel; + Label2: TLabel; + Year_From: TEdit; + Year_To: TEdit; + cbBLANK: TCheckBox; + GroupBox3: TGroupBox; + Filter_on: TRadioButton; + Filter_off: TRadioButton; + procedure Button1Click(Sender: TObject); + procedure FilterChange(Sender: TObject); + procedure Year_FromChange(Sender: TObject); + procedure Year_ToChange(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure FormHide(Sender: TObject); + private + { D\xE9clarations priv\xE9es } + public + { D\xE9clarations publiques } + end; + +var + FilterForm: TFilterForm; + +implementation + +uses Main; + +{$R *.DFM} + +procedure TFilterForm.Button1Click(Sender: TObject); +begin + Close; +end; + +procedure TFilterForm.FilterChange(Sender: TObject); +begin + mainform.DbfDisco.filtered:=filter_on.checked; + mainform.DbfDisco.refresh; +end; + +procedure TFilterForm.Year_FromChange(Sender: TObject); +begin + Year_From.Tag:=StrToIntDef(Year_From.Text,0); +end; + +procedure TFilterForm.Year_ToChange(Sender: TObject); +begin + Year_To.Tag:=StrToIntDef(Year_To.Text,99); +end; + +procedure TFilterForm.FormShow(Sender: TObject); +begin + Filter_on.Checked:=true; +end; + +procedure TFilterForm.FormHide(Sender: TObject); +begin + Filter_off.Checked:=true; +end; + +end. + Property changes on: trunk/demo/Filter.pas ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/Index.dfm =================================================================== (Binary files differ) Index: trunk/demo/Index.dfm =================================================================== --- trunk/demo/Index.dfm 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/Index.dfm 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/Index.dfm ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/Index.pas =================================================================== --- trunk/demo/Index.pas (rev 0) +++ trunk/demo/Index.pas 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,115 @@ +unit Index; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, Db, DBCtrls, Grids, DBGrids, ComCtrls, Dbf_Cursor; + +type + TIndexForm = class(TForm) + Button1: TButton; + DBGrid1: TDBGrid; + Button2: TButton; + Button3: TButton; + Button4: TButton; + Button5: TButton; + GroupBox1: TGroupBox; + Edit1: TEdit; + Edit2: TEdit; + Label1: TLabel; + Label2: TLabel; + SearchEdit: TEdit; + SearchResultLabel: TLabel; + RebuildButton: TButton; + ExpressionCheckBox: TCheckBox; + procedure Button2Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure Button4Click(Sender: TObject); + procedure Button1Click(Sender: TObject); + procedure Button5Click(Sender: TObject); + procedure RebuildButtonClick(Sender: TObject); + procedure ApplyButtonClick(Sender: TObject); + procedure SearchEditChange(Sender: TObject); + private + { D\xE9clarations priv\xE9es } + public + { D\xE9clarations publiques } + end; + +var + IndexForm: TIndexForm; + +implementation + +uses + Main, Dbf_Common; + +{$R *.DFM} + +procedure TIndexForm.Button2Click(Sender: TObject); +begin + MainForm.DbfDisco.IndexName:='AUTHOR'; +end; + +procedure TIndexForm.Button3Click(Sender: TObject); +begin + MainForm.DbfDisco.IndexName:='TITLE.NDX'; +end; + +procedure TIndexForm.Button4Click(Sender: TObject); +begin + MainForm.DbfDisco.IndexName:=''; +end; + +procedure TIndexForm.Button1Click(Sender: TObject); +begin + Close; +end; + +procedure TIndexForm.Button5Click(Sender: TObject); +begin + MainForm.DbfDisco.IndexName:='PRICE.NDX'; +end; + +procedure TIndexForm.RebuildButtonClick(Sender: TObject); +begin + // need exclusive access + MainForm.DbfDisco.Close; + MainForm.DbfDisco.Exclusive := true; + MainForm.DbfDisco.Open; + // create descending MDX index for author field + MainForm.DbfDisco.AddIndex('AUTHOR', 'AUTHOR', [ixDescending]); + // create NDX index for title field + MainForm.DbfDisco.AddIndex('TITLE.NDX', 'TITLE', []); + if ExpressionCheckBox.Checked then + begin + // create NDX expression index for price; title + MainForm.DbfDisco.AddIndex('PRICE.NDX', 'STR(PRICE, 7, 2)+TITLE', [ixExpression]); + end else begin + // create simple NDX index for price + MainForm.DbfDisco.AddIndex('PRICE.NDX', 'PRICE', []); + end; + // close exclusive + MainForm.DbfDisco.Close; + MainForm.DbfDisco.Exclusive := false; + MainForm.DbfDisco.Open; + // show message + Application.MessageBox('Index recreating done.', 'Done', MB_OK or MB_ICONINFORMATION); +end; + +procedure TIndexForm.ApplyButtonClick(Sender: TObject); +begin + MainForm.DbfDisco.SetRangePChar(PChar(Edit1.Text), PChar(Edit2.Text)); +end; + +procedure TIndexForm.SearchEditChange(Sender: TObject); +begin + if MainForm.DbfDisco.SearchKeyPChar(PChar(SearchEdit.Text), stGreaterEqual) then + SearchResultLabel.Color := clGreen + else + SearchResultLabel.Color := clRed +end; + +end. + Property changes on: trunk/demo/Index.pas ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/Main.dfm =================================================================== (Binary files differ) Index: trunk/demo/Main.dfm =================================================================== --- trunk/demo/Main.dfm 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/Main.dfm 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/Main.dfm ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/Main.pas =================================================================== --- trunk/demo/Main.pas (rev 0) +++ trunk/demo/Main.pas 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,236 @@ +unit Main; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, Db, ExtCtrls, DBCtrls, Grids, DBGrids, Menus, Buttons, + ComCtrls, dbf, shellapi; + +type + TMainForm = class(TForm) + DemoButton: TButton; + DbfDemo: TDbf; + DataSourceDemo: TDataSource; + DbfDisco: TDbf; + DatasourceDisco: TDataSource; + Button1: TButton; + DBNavigator1: TDBNavigator; + DBText1: TDBText; + DBGrid1: TDBGrid; + Bevel1: TBevel; + Bevel2: TBevel; + Label1: TLabel; + Bevel3: TBevel; + Image1: TImage; + DBRichEdit1: TDBRichEdit; + DbfDiscoAUTHOR: TStringField; + DbfDiscoTITLE: TStringField; + DbfDiscoCOMPANY: TStringField; + DbfDiscoCOUNTRY: TStringField; + DbfDiscoYEAR: TSmallintField; + DbfDiscoPRICE: TFloatField; + DbfDiscoNOTE: TStringField; + DbfDiscoQTY: TSmallintField; + DbfDemoID: TStringField; + DbfDemoTITLE: TStringField; + DbfDemoDESCR: TMemoField; + DbfDemoDEMO: TStringField; + DbfDiscoCALCPRICE: TCurrencyField; + LabelEmail: TLabel; + label_website: TLabel; + DbfDiscoHIGHPRICE: TBooleanField; + DbfDiscoLAST_SELL: TDateField; + DbfDiscoIN_STOCK: TBooleanField; + LabelVersion: TLabel; + PopupMenu1: TPopupMenu; + Edit1: TMenuItem; + procedure DbfDemoAfterScroll(DataSet: TDataSet); + procedure DemoButtonClick(Sender: TObject); + procedure DbfDiscoFilterRecord(DataSet: TDataSet; var Accept: Boolean); + procedure ButtonCloseClick(Sender: TObject); + procedure DBGrid1MouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure DbfDiscoCalcFields(DataSet: TDataSet); + procedure FormCreate(Sender: TObject); + procedure DataSourceDemoStateChange(Sender: TObject); + procedure LabelEmailMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure label_websiteMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure Edit1Click(Sender: TObject); + private + { D\xE9clarations priv\xE9es } + public + { D\xE9clarations publiques } + lastForm:TForm; + end; +var + MainForm: TMainForm; + +implementation + +uses EditTopics, Simple, Index, Search, Filter, Calc, Schema, Schema2, + CreateTable, Pack, CopyTable, multipleuse, compatibility; + +{$R *.DFM} + + + +procedure TMainForm.DbfDemoAfterScroll(DataSet: TDataSet); +begin + DemoButton.Enabled:=length(trim(DbfDemo.FieldByName('DEMO').AsString))>0; +end; + +procedure TMainForm.DemoButtonClick(Sender: TObject); +var + demo:string; + newForm:TForm; +begin + newForm:=nil; + demo:=trim(DbfDemo.FieldByName('DEMO').AsString); + if demo='simple' then newForm:=simpleForm + else if demo='index' then newForm:=indexForm + else if demo='search' then newForm:=SearchForm + else if demo='filter' then newForm:=FilterForm + else if demo='memo' then newForm:=EditTopicsForm + else if demo='calc' then newForm:=CalcForm + else if demo='schema' then newForm:=Schema1Form + else if demo='schema2' then newForm:=Schema2Form + else if demo='create' then newForm:=CreateTableForm + else if demo='pack' then newForm:=PackTableForm + else if demo='copy' then newForm:=CopyTableForm + else if demo='multiple' then newForm:=MultipleUseForm + else if demo='compatib' then newForm:=CompatibilityForm + else ; + if (lastForm<>newForm) and (lastform<>nil) then lastForm.Hide; + if (newform<>nil) then newForm.Show; + lastForm:=newForm; +end; + +procedure TMainForm.DbfDiscoFilterRecord(DataSet: TDataSet; + var Accept: Boolean); +var + year:integer; + country:string; + correct_year:boolean; + correct_country:boolean; +begin + year:=StrToIntDef(DbfDiscoYear.AsString,0); + Country:=DbfDiscoCountry.AsString; + correct_year:= + ((year=0) and FilterForm.cbBlank.checked) + or + ((year >= FilterForm.Year_From.Tag) + and (year <= FilterForm.Year_To.Tag)); + + if Country='USA' then correct_country:=FilterForm.cbUSA.checked + else if Country='USA' then correct_country:=FilterForm.cbUSA.checked + else if Country='SWE' then correct_country:=FilterForm.cbSWE.checked + else if Country='UK' then correct_country:=FilterForm.cbUK.checked + else if Country='GER' then correct_country:=FilterForm.cbGER.checked + else if Country='HOL' then correct_country:=FilterForm.cbHOL.checked + else if Country='ITA' then correct_country:=FilterForm.cbITA.checked + else correct_country:=FilterForm.cbOTH.checked; + + Accept:=correct_year and correct_country; + +end; + +procedure TMainForm.ButtonCloseClick(Sender: TObject); +begin + Close; +end; + +procedure TMainForm.DBGrid1MouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if (ssShift in Shift) and (ssCtrl in Shift) then EditTopicsForm.showModal; +end; + +procedure TMainForm.DbfDiscoCalcFields(DataSet: TDataSet); +var + Price:double; + Qty:double; + CalcPrice:double; +begin + try + Price:=DbfDiscoPRICE.AsFloat; + Qty:=DbfDiscoQTY.AsFloat; + calcPrice:=Price*Qty; + DbfDiscoCALCPRICE.AsFloat:=calcPrice; + DbfDiscoHighPrice.AsBoolean:=calcPrice>=10; + except + DbfDiscoCALCPRICE.AsFloat:=0; + DbfDiscoHighPrice.AsBoolean:=false; + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +var + path:string; +begin + path:=ExtractFilePath(Application.ExeName)+'data'; + createdir(path); +(* + I do that sometime for debugging purposes sometime + + DeleteFile(path+'\author.ndx'); + DeleteFile(path+'\id.ndx'); + DeleteFile(path+'\title.ndx'); + DeleteFile(path+'\price.ndx'); + + FileCopy(path+'savebase\disco.dbf' ,path+'disco.dbf'); + FileCopy(path+'savebase\tdbf_demo.dbf',path+'tdbf_demo.dbf'); + FileCopy(path+'savebase\tdbf_demo.dbt' ,path+'tdbf_demo.dbt'); +*) + LabelVersion.Caption:='TDbf Version: '+DbfDemo.Version; + DbfDemo.Active:=true; + DbfDisco.Active:=true; +end; + + +procedure TMainForm.DataSourceDemoStateChange(Sender: TObject); +var + ed:boolean; +begin + ed:=DbfDemo.State in [dsEdit,dsInsert]; + if editTopicsForm=nil then exit; + with editTopicsForm do begin + speedButton1.enabled:=ed; + speedButton2.enabled:=ed; + speedButton3.enabled:=ed; + speedButton4.enabled:=ed; + speedButton5.enabled:=ed; + speedButton6.enabled:=ed; + speedButton7.enabled:=ed; + speedButton8.enabled:=ed; + speedButton9.enabled:=ed; + end; +end; + +procedure TMainForm.LabelEmailMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + // Nice and easy isn't it ? + ShellExecute(handle,'open','mailto:Micha Nelissen <mi...@ne...>', + nil,nil,SW_SHOWNORMAL); +end; + +procedure TMainForm.label_websiteMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + // Nice and easy isn't it ? + ShellExecute(handle,'open','http://tdbf.sf.net',nil,nil,SW_SHOWNORMAL); +end; + +procedure TMainForm.Edit1Click(Sender: TObject); +begin + if (lastForm<>EditTopicsForm) and (lastform<>nil) then lastForm.Hide; + EditTopicsForm.Show; + lastForm:=EditTopicsForm; +end; + +end. + + Property changes on: trunk/demo/Main.pas ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/Pack.dfm =================================================================== (Binary files differ) Index: trunk/demo/Pack.dfm =================================================================== --- trunk/demo/Pack.dfm 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/Pack.dfm 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/Pack.dfm ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/Pack.pas =================================================================== --- trunk/demo/Pack.pas (rev 0) +++ trunk/demo/Pack.pas 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,203 @@ +unit Pack; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + Db, ExtCtrls, DBCtrls, Grids, DBGrids, dbf, StdCtrls; + +type + TPackTableForm = class(TForm) + DBGrid1: TDBGrid; + DBNavigator1: TDBNavigator; + DataSource1: TDataSource; + Dbf1: TDbf; + Panel1: TPanel; + Button2: TButton; + Button3: TButton; + Dbf1Field1: TStringField; + GroupBox1: TGroupBox; + Label1: TLabel; + Label2: TLabel; + labnormal: TLabel; + labdeleted: TLabel; + Button5: TButton; + ShowDeleted: TCheckBox; + Dbf1Deleted: TBooleanField; + DBMemo1: TDBMemo; + Splitter1: TSplitter; + Dbf1Field2: TMemoField; + GroupBox2: TGroupBox; + Label3: TLabel; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Dbf1Field3: TFloatField; + procedure FormShow(Sender: TObject); + procedure ClearTableClick(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure Button5Click(Sender: TObject); + procedure RefreshInfo(Sender: TObject); + procedure Dbf1AfterDelete(DataSet: TDataSet); + procedure ShowDeletedClick(Sender: TObject); + procedure Dbf1AfterPost(DataSet: TDataSet); + procedure Dbf1CalcFields(DataSet: TDataSet); + private + { D\xE9clarations priv\xE9es } + public + { D\xE9clarations publiques } + batchmode:boolean; + end; + +var + PackTableForm: TPackTableForm; + +implementation + +{$R *.DFM} + +procedure TPackTableForm.FormShow(Sender: TObject); +begin + Dbf1.Active:=false; + ClearTableClick(Sender); + Dbf1.Active:=true; +end; + +procedure TPackTableForm.ClearTableClick(Sender: TObject); +begin + try + Dbf1.Active:=false; + Dbf1.CreateTable; + finally + Dbf1.Active:=true; + end; + RefreshInfo(Sender); +end; + +procedure TPackTableForm.Button2Click(Sender: TObject); +var + x,i,r:integer; + RandomString:string; + MemoString:string; + recno:integer; +begin + Dbf1.DisableControls; + batchMode:=true; + try + for x:=1 to 10 do begin + Dbf1.Append; + recno:=Dbf1.RecordCount; + RandomString:= + chr(random(26)+65)+ + chr(random(26)+65)+ + IntToStr(recno); + + r:=Random(100); + Dbf1Field1.AsString:=RandomString; + MemoString:=''; + for i:=1 to r do begin + MemoString:=MemoString+'<<<' + RandomString + + ' : '+IntToStr(i)+' of '+IntToStr(r)+' >>>' + #13 + #10; + end; + Dbf1Field2.AsString:=MemoString; + Dbf1.Post; + end; + finally + batchMode:=false; + Dbf1.EnableControls; + end; + RefreshInfo(Sender); +end; + +procedure TPackTableForm.Button3Click(Sender: TObject); +var + x:integer; + OldShowDeleted:boolean; +begin + Dbf1.DisableControls; + batchMode:=true; + OldShowDeleted:=Dbf1.ShowDeleted; + Dbf1.ShowDeleted:=false; + try + for x:=1 to 5 do begin + if Dbf1.Eof then begin + dbf1.first; + if dbf1.Eof then exit; + end; + dbf1.delete; + end; + Dbf1.ShowDeleted:=OldShowDeleted; + finally + batchMode:=false; + Dbf1.EnableControls; + end; + RefreshInfo(Sender); +end; + +procedure TPackTableForm.Button5Click(Sender: TObject); +begin + Dbf1.TryExclusive; + if not Dbf1.Exclusive then + begin + ShowMessage('Failed to get exclusive access'); + exit; + end; + try + Dbf1.PackTable; + finally + Dbf1.EndExclusive; + RefreshInfo(Sender); + end; +end; + +procedure TPackTableForm.RefreshInfo(Sender: TObject); +var + nbdeleted,nbnormal:integer; + b:string; + OldShowDeleted:boolean; +begin + if batchMode then exit; + Dbf1.DisableControls; + b:=Dbf1.Bookmark; + OldShowDeleted:=Dbf1.ShowDeleted; + Dbf1.ShowDeleted:=true; + try + nbnormal:=0; + nbdeleted:=0; + Dbf1.First; + While not Dbf1.Eof do begin + if Dbf1.IsDeleted then inc(nbdeleted) + else inc(nbnormal); + Dbf1.Next; + end; + labnormal.caption:=intToStr(nbnormal); + labdeleted.caption:=intToStr(nbdeleted); + finally + Dbf1.ShowDeleted:=OldShowDeleted; + Dbf1.EnableControls; + Dbf1.Bookmark:=b; + end; +end; + +procedure TPackTableForm.Dbf1AfterDelete(DataSet: TDataSet); +begin + RefreshInfo(nil); +end; + +procedure TPackTableForm.ShowDeletedClick(Sender: TObject); +begin + Dbf1.ShowDeleted:=ShowDeleted.Checked; +end; + +procedure TPackTableForm.Dbf1AfterPost(DataSet: TDataSet); +begin + RefreshInfo(nil); +end; + +procedure TPackTableForm.Dbf1CalcFields(DataSet: TDataSet); +begin + Dbf1Deleted.AsBoolean:=Dbf1.IsDeleted; +end; + +end. Property changes on: trunk/demo/Pack.pas ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/TDbf_Demo.dpr =================================================================== --- trunk/demo/TDbf_Demo.dpr (rev 0) +++ trunk/demo/TDbf_Demo.dpr 2015-11-03 20:13:40 UTC (rev 586) @@ -0,0 +1,40 @@ +program tdbf_demo; + +uses + Forms, + EditTopics in 'EditTopics.pas' {EditTopicsForm}, + Filter in 'Filter.pas' {FilterForm}, + Index in 'Index.pas' {IndexForm}, + Main in 'Main.pas' {MainForm}, + Schema in 'schema.pas' {Schema1Form}, + Schema2 in 'schema2.pas' {Schema2Form}, + Search in 'search.pas' {SearchForm}, + Simple in 'simple.pas' {SimpleForm}, + Pack in 'Pack.pas' {PackTableForm}, + CopyTable in 'CopyTable.pas' {CopyTableForm}, + CreateTable in 'CreateTable.pas' {CreateTableForm}, + multipleuse in 'multipleuse.pas' {MultipleUseForm}, + Compatibility in 'Compatibility.pas' {CompatibilityForm}, + Calc in 'Calc.pas' {CalcForm}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.CreateForm(TEditTopicsForm, EditTopicsForm); + Application.CreateForm(TFilterForm, FilterForm); + Application.CreateForm(TIndexForm, IndexForm); + Application.CreateForm(TSchema1Form, Schema1Form); + Application.CreateForm(TSchema2Form, Schema2Form); + Application.CreateForm(TSearchForm, SearchForm); + Application.CreateForm(TSimpleForm, SimpleForm); + Application.CreateForm(TPackTableForm, PackTableForm); + Application.CreateForm(TCopyTableForm, CopyTableForm); + Application.CreateForm(TCreateTableForm, CreateTableForm); + Application.CreateForm(TMultipleUseForm, MultipleUseForm); + Application.CreateForm(TCompatibilityForm, CompatibilityForm); + Application.CreateForm(TCalcForm, CalcForm); + Application.Run; +end. + Added: trunk/demo/TDbf_Demo.res =================================================================== (Binary files differ) Index: trunk/demo/TDbf_Demo.res =================================================================== --- trunk/demo/TDbf_Demo.res 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/TDbf_Demo.res 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/TDbf_Demo.res ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/data/DBASE3+.DBT =================================================================== (Binary files differ) Index: trunk/demo/data/DBASE3+.DBT =================================================================== --- trunk/demo/data/DBASE3+.DBT 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/data/DBASE3+.DBT 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/data/DBASE3+.DBT ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/data/DBASE3+.dbf =================================================================== (Binary files differ) Index: trunk/demo/data/DBASE3+.dbf =================================================================== --- trunk/demo/data/DBASE3+.dbf 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/data/DBASE3+.dbf 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/data/DBASE3+.dbf ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/data/DBASE4.dbf =================================================================== (Binary files differ) Index: trunk/demo/data/DBASE4.dbf =================================================================== --- trunk/demo/data/DBASE4.dbf 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/data/DBASE4.dbf 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/data/DBASE4.dbf ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/data/DBASEWIN.dbf =================================================================== (Binary files differ) Index: trunk/demo/data/DBASEWIN.dbf =================================================================== --- trunk/demo/data/DBASEWIN.dbf 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/data/DBASEWIN.dbf 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/data/DBASEWIN.dbf ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/data/TDBF_DEMO.DBF =================================================================== (Binary files differ) Index: trunk/demo/data/TDBF_DEMO.DBF =================================================================== --- trunk/demo/data/TDBF_DEMO.DBF 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/data/TDBF_DEMO.DBF 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/data/TDBF_DEMO.DBF ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/data/TDBF_DEMO.dbt =================================================================== (Binary files differ) Index: trunk/demo/data/TDBF_DEMO.dbt =================================================================== --- trunk/demo/data/TDBF_DEMO.dbt 2015-11-03 19:59:47 UTC (rev 585) +++ trunk/demo/data/TDBF_DEMO.dbt 2015-11-03 20:13:40 UTC (rev 586) Property changes on: trunk/demo/data/TDBF_DEMO.dbt ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Added: trunk/demo/data/Table1 =================================================================== (Binary files differ) Index: trunk/demo/data/Tab... [truncated message content] |
From: <pau...@us...> - 2015-11-05 14:19:24
|
Revision: 609 http://sourceforge.net/p/tdbf/code/609 Author: paulenandrew Date: 2015-11-05 14:19:22 +0000 (Thu, 05 Nov 2015) Log Message: ----------- demo: replace tdbf_demo5.bpr project with working C++ Builder 10 Seattle project Modified Paths: -------------- trunk/doc/INSTALL Added Paths: ----------- trunk/demo/tdbf_demo.cbproj trunk/demo/tdbf_demo.cpp trunk/demo/tdbf_demo_Icon.ico Removed Paths: ------------- trunk/demo/tdbf_demo5.bpr trunk/demo/tdbf_demo5.cpp trunk/demo/tdbf_demo5.res Added: trunk/demo/tdbf_demo.cbproj =================================================================== --- trunk/demo/tdbf_demo.cbproj (rev 0) +++ trunk/demo/tdbf_demo.cbproj 2015-11-05 14:19:22 UTC (rev 609) @@ -0,0 +1,801 @@ +<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> + <PropertyGroup> + <ProjectGuid>{22C5DCA7-B35C-4034-AF34-90063CB2EB07}</ProjectGuid> + <ProjectType>CppVCLApplication</ProjectType> + <MainSource>tdbf_demo.cpp</MainSource> + <Base>True</Base> + <Config Condition="'$(Config)'==''">Release</Config> + <FrameworkType>VCL</FrameworkType> + <ProjectVersion>18.0</ProjectVersion> + <Platform Condition="'$(Platform)'==''">Win32</Platform> + <TargetedPlatforms>1025</TargetedPlatforms> + <AppType>Application</AppType> + </PropertyGroup> + <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Base)'=='true') or '$(Base_iOSDevice64)'!=''"> + <Base_iOSDevice64>true</Base_iOSDevice64> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''"> + <Base_Win32>true</Base_Win32> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''"> + <Base_Win64>true</Base_Win64> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''"> + <Cfg_1>true</Cfg_1> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Cfg_1)'=='true') or '$(Cfg_1_iOSDevice64)'!=''"> + <Cfg_1_iOSDevice64>true</Cfg_1_iOSDevice64> + <CfgParent>Cfg_1</CfgParent> + <Cfg_1>true</Cfg_1> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''"> + <Cfg_1_Win32>true</Cfg_1_Win32> + <CfgParent>Cfg_1</CfgParent> + <Cfg_1>true</Cfg_1> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''"> + <Cfg_1_Win64>true</Cfg_1_Win64> + <CfgParent>Cfg_1</CfgParent> + <Cfg_1>true</Cfg_1> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''"> + <Cfg_2>true</Cfg_2> + <CfgParent>Base</CfgParent> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Cfg_2)'=='true') or '$(Cfg_2_iOSDevice64)'!=''"> + <Cfg_2_iOSDevice64>true</Cfg_2_iOSDevice64> + <CfgParent>Cfg_2</CfgParent> + <Cfg_2>true</Cfg_2> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''"> + <Cfg_2_Win32>true</Cfg_2_Win32> + <CfgParent>Cfg_2</CfgParent> + <Cfg_2>true</Cfg_2> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win64)'!=''"> + <Cfg_2_Win64>true</Cfg_2_Win64> + <CfgParent>Cfg_2</CfgParent> + <Cfg_2>true</Cfg_2> + <Base>true</Base> + </PropertyGroup> + <PropertyGroup Condition="'$(Base)'!=''"> + <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> + <DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace> + <SanitizedProjectName>tdbf_demo</SanitizedProjectName> + <VerInfo_Locale>2057</VerInfo_Locale> + <TASM_IncludePath>..\tdbf5;$(BDS)\include;$(BDS)\include\vcl;$(TASM_IncludePath)</TASM_IncludePath> + <DCC_AdditionalSwitches> -M</DCC_AdditionalSwitches> + <PackageImports>rtl.bpi;vcl.bpi;vclx.bpi;vcljpg.bpi;dbrtl.bpi;vcldb.bpi;$(PackageImports)</PackageImports> + <BRCC_IncludePath>..\tdbf5;$(BDS)\include;$(BDS)\include\vcl;$(BRCC_IncludePath)</BRCC_IncludePath> + <BCC_SourceDebuggingOn>true</BCC_SourceDebuggingOn> + <TASM_AdditionalSwitches> /w2</TASM_AdditionalSwitches> + <BCC_DebugLineNumbers>true</BCC_DebugLineNumbers> + <BCC_GenerateWindowsApp>true</BCC_GenerateWindowsApp> + <DCC_UnitSearchPath>.\;$(BDS)\lib;$(BDS)\lib\obj;..\src;$(DCC_UnitSearchPath)</DCC_UnitSearchPath> + <AllPackageLibs>rtl.lib;vcl.lib;vclx.lib;dbrtl.lib;vcldb.lib;vcldbx.lib;tdbf_c10d.lib</AllPackageLibs> + <ILINK_FullDebugInfo>true</ILINK_FullDebugInfo> + <BCC_IncludePath>..\tdbf5;$(BDS)\include;$(BDS)\include\vcl;$(BCC_IncludePath)</BCC_IncludePath> + <DCC_IncludePath>.\;$(BDS)\lib;$(BDS)\lib\obj;$(DCC_IncludePath)</DCC_IncludePath> + <FinalOutputDir>.</FinalOutputDir> + <DCC_CBuilderOutput>JPHNE</DCC_CBuilderOutput> + <ILINK_LibraryPath>..\tdbf5;$(BDS)\Projects\Lib;$(BDS)\lib\obj;$(BDS)\lib;$(BDS)\lib\psdk;$(ILINK_LibraryPath)</ILINK_LibraryPath> + <BCC_InlineFunctionExpansion>false</BCC_InlineFunctionExpansion> + <BCC_DisableOptimizations>true</BCC_DisableOptimizations> + <TASM_Debugging>Full</TASM_Debugging> + <BCC_PCHCache>true</BCC_PCHCache> + <ILINK_AppType>Windows</ILINK_AppType> + </PropertyGroup> + <PropertyGroup Condition="'$(Base_iOSDevice64)'!=''"> + <BRCC_Defines>_DEBUG;$(BRCC_Defines)</BRCC_Defines> + <BCC_Defines>NO_STRICT;$(BCC_Defines)</BCC_Defines> + <BCC_UserSuppliedOptions> -tWM -5 -Vx -r- -k -Ve</BCC_UserSuppliedOptions> + <TASM_Defines>_DEBUG;$(TASM_Defines)</TASM_Defines> + </PropertyGroup> + <PropertyGroup Condition="'$(Base_Win32)'!=''"> + <OutputExt>exe</OutputExt> + <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + <IncludePath>$(BDSINCLUDE)\windows\vcl;$(IncludePath)</IncludePath> + <Icon_MainIcon>tdbf_demo_Icon.ico</Icon_MainIcon> + <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File> + <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes> + <VerInfo_Locale>1033</VerInfo_Locale> + <BCC_UserSuppliedOptions> -tWM -5 -Vx -r- -k -Ve</BCC_UserSuppliedOptions> + <BRCC_Defines>_DEBUG;$(BRCC_Defines)</BRCC_Defines> + <TASM_Defines>_DEBUG;$(TASM_Defines)</TASM_Defines> + </PropertyGroup> + <PropertyGroup Condition="'$(Base_Win64)'!=''"> + <Icon_MainIcon>tdbf_demo_Icon.ico</Icon_MainIcon> + <IncludePath>$(BDSINCLUDE)\windows\vcl;$(IncludePath)</IncludePath> + <TASM_Defines>_DEBUG;$(TASM_Defines)</TASM_Defines> + <BRCC_Defines>_DEBUG;$(BRCC_Defines)</BRCC_Defines> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1)'!=''"> + <TASM_DisplaySourceLines>true</TASM_DisplaySourceLines> + <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe> + <ILINK_DisableIncrementalLinking>true</ILINK_DisableIncrementalLinking> + <DCC_AdditionalSwitches> -M -V</DCC_AdditionalSwitches> + <DCC_Define>DEBUG;$(DCC_Define);$(DCC_Define)</DCC_Define> + <ILINK_LibraryPath>$(BDS)\lib\debug;$(ILINK_LibraryPath);$(ILINK_LibraryPath)</ILINK_LibraryPath> + <IntermediateOutputDir>Debug_Build</IntermediateOutputDir> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1_iOSDevice64)'!=''"> + <BCC_Defines>_DEBUG;$(BCC_Defines);$(BCC_Defines)</BCC_Defines> + <BCC_UserSuppliedOptions> -tWM -5 -Vx -r- -k -Ve -k</BCC_UserSuppliedOptions> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''"> + <AppEnableHighDPI>true</AppEnableHighDPI> + <BCC_Defines>_DEBUG;$(BCC_Defines);$(BCC_Defines)</BCC_Defines> + <BCC_UserSuppliedOptions> -tWM -5 -Vx -r- -k -Ve -k</BCC_UserSuppliedOptions> + <LinkPackageStatics>rtl.lib;vcl.lib;vclx.lib;vcljpg.lib;dbrtl.lib;vcldb.lib;vcldbx.lib;TDBF_C5R.lib</LinkPackageStatics> + <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_1_Win64)'!=''"> + <BCC_Defines>_DEBUG;$(BCC_Defines);$(BCC_Defines)</BCC_Defines> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_2)'!=''"> + <IntermediateOutputDir>Release_Build</IntermediateOutputDir> + <TASM_Debugging>None</TASM_Debugging> + <DCC_AdditionalSwitches> -M -$O+</DCC_AdditionalSwitches> + <BCC_OptimizationLevel>Level2</BCC_OptimizationLevel> + <ILINK_LibraryPath>$(BDS)\lib\release;$(ILINK_LibraryPath);$(ILINK_LibraryPath)</ILINK_LibraryPath> + <BCC_InlineFunctionExpansion>true</BCC_InlineFunctionExpansion> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_2_iOSDevice64)'!=''"> + <BT_BuildType>Debug</BT_BuildType> + <BCC_Defines>NDEBUG;$(BCC_Defines);$(BCC_Defines)</BCC_Defines> + <BCC_UserSuppliedOptions> -tWM -5 -Vx -r- -k -Ve -r</BCC_UserSuppliedOptions> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''"> + <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> + <VerInfo_Locale>1033</VerInfo_Locale> + <AppEnableHighDPI>true</AppEnableHighDPI> + <BCC_Defines>NDEBUG;$(BCC_Defines);$(BCC_Defines)</BCC_Defines> + <BCC_UserSuppliedOptions> -tWM -5 -Vx -r- -k -Ve -r</BCC_UserSuppliedOptions> + <LinkPackageStatics>rtl.lib;vcl.lib;vclx.lib;dbrtl.lib;vcldb.lib;vcldbx.lib;tdbf_c10d.lib</LinkPackageStatics> + <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes> + </PropertyGroup> + <PropertyGroup Condition="'$(Cfg_2_Win64)'!=''"> + <BCC_Defines>NDEBUG;$(BCC_Defines);$(BCC_Defines)</BCC_Defines> + </PropertyGroup> + <ItemGroup> + <DelphiCompile Include="Calc.pas"> + <BuildOrder>4</BuildOrder> + <Form>CalcForm</Form> + <BuildOrder>13</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="CopyTable.pas"> + <BuildOrder>3</BuildOrder> + <Form>CopyTableForm</Form> + <BuildOrder>10</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="CreateTable.pas"> + <BuildOrder>4</BuildOrder> + <Form>CreateTableForm</Form> + <BuildOrder>13</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="EditTopics.pas"> + <BuildOrder>5</BuildOrder> + <Form>EditTopicsForm</Form> + <BuildOrder>12</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="Filter.pas"> + <BuildOrder>6</BuildOrder> + <Form>FilterForm</Form> + <BuildOrder>11</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="Index.pas"> + <BuildOrder>7</BuildOrder> + <Form>IndexForm</Form> + <BuildOrder>2</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="Main.pas"> + <BuildOrder>8</BuildOrder> + <Form>MainForm</Form> + <BuildOrder>1</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="Pack.pas"> + <BuildOrder>9</BuildOrder> + <Form>PackTableForm</Form> + <BuildOrder>0</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="schema.pas"> + <BuildOrder>3</BuildOrder> + <Form>Schema1Form</Form> + <BuildOrder>10</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="schema2.pas"> + <BuildOrder>6</BuildOrder> + <Form>Schema2Form</Form> + <BuildOrder>11</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="search.pas"> + <BuildOrder>5</BuildOrder> + <Form>SearchForm</Form> + <BuildOrder>12</BuildOrder> + </DelphiCompile> + <DelphiCompile Include="simple.pas"> + <BuildOrder>7</BuildOrder> + <Form>SimpleForm</Form> + <BuildOrder>2</BuildOrder> + </DelphiCompile> + <CppCompile Include="tdbf_demo.cpp"> + <BuildOrder>-1</BuildOrder> + <BuildOrder>0</BuildOrder> + </CppCompile> + <ResFiles Include="tdbf_demo.res"> + <BuildOrder>-1</BuildOrder> + <BuildOrder>1</BuildOrder> + </ResFiles> + <FormResources Include="schema2.dfm"/> + <FormResources Include="schema.dfm"/> + <FormResources Include="Pack.dfm"/> + <FormResources Include="search.dfm"/> + <FormResources Include="simple.dfm"/> + <FormResources Include="CreateTable.dfm"/> + <FormResources Include="CopyTable.dfm"/> + <FormResources Include="Calc.dfm"/> + <FormResources Include="EditTopics.dfm"/> + <FormResources Include="Main.dfm"/> + <FormResources Include="Index.dfm"/> + <FormResources Include="Filter.dfm"/> + <BuildConfiguration Include="Release"> + <Key>Cfg_2</Key> + <CfgParent>Base</CfgParent> + </BuildConfiguration> + <BuildConfiguration Include="Base"> + <Key>Base</Key> + </BuildConfiguration> + <BuildConfiguration Include="Debug"> + <Key>Cfg_1</Key> + <CfgParent>Base</CfgParent> + </BuildConfiguration> + </ItemGroup> + <Import Project="$(BDS)\Bin\CodeGear.Cpp.Targets"/> + <ProjectExtensions> + <Borland.Personality>CPlusPlusBuilder.Personality.12</Borland.Personality> + <Borland.ProjectType>CppVCLApplication</Borland.ProjectType> + <BorlandProject> + <CPlusPlusBuilder.Personality> + <VersionInfo> + <VersionInfo Name="IncludeVerInfo">0</VersionInfo> + <VersionInfo Name="AutoIncBuild">0</VersionInfo> + <VersionInfo Name="MajorVer">1</VersionInfo> + <VersionInfo Name="MinorVer">0</VersionInfo> + <VersionInfo Name="Release">0</VersionInfo> + <VersionInfo Name="Build">0</VersionInfo> + <VersionInfo Name="Debug">0</VersionInfo> + <VersionInfo Name="PreRelease">0</VersionInfo> + <VersionInfo Name="Special">0</VersionInfo> + <VersionInfo Name="Private">0</VersionInfo> + <VersionInfo Name="DLL">0</VersionInfo> + <VersionInfo Name="Locale">2057</VersionInfo> + <VersionInfo Name="CodePage">1252</VersionInfo> + </VersionInfo> + <VersionInfoKeys> + <VersionInfoKeys Name="CompanyName"/> + <VersionInfoKeys Name="FileDescription"/> + <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys> + <VersionInfoKeys Name="InternalName"/> + <VersionInfoKeys Name="LegalCopyright"/> + <VersionInfoKeys Name="LegalTrademarks"/> + <VersionInfoKeys Name="OriginalFilename"/> + <VersionInfoKeys Name="ProductName"/> + <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> + <VersionInfoKeys Name="Comments"/> + </VersionInfoKeys> + <HistoryLists_hlIncludePath> + <HistoryLists_hlIncludePath Name="Count">3</HistoryLists_hlIncludePath> + <HistoryLists_hlIncludePath Name="Item0">..\tdbf5;$(BCB)\include;$(BCB)\include\vcl</HistoryLists_hlIncludePath> + <HistoryLists_hlIncludePath Name="Item1">$(BCB)\include;$(BCB)\include\vcl</HistoryLists_hlIncludePath> + <HistoryLists_hlIncludePath Name="Item2">$(BCB)\include;$(BCB)\include\vcl;..\tdbf5</HistoryLists_hlIncludePath> + </HistoryLists_hlIncludePath> + <HistoryLists_hlLibraryPath> + <HistoryLists_hlLibraryPath Name="Count">3</HistoryLists_hlLibraryPath> + <HistoryLists_hlLibraryPath Name="Item0">..\tdbf5;$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib</HistoryLists_hlLibraryPath> + <HistoryLists_hlLibraryPath Name="Item1">$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib</HistoryLists_hlLibraryPath> + <HistoryLists_hlLibraryPath Name="Item2">$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;..\tdbf5</HistoryLists_hlLibraryPath> + </HistoryLists_hlLibraryPath> + <HistoryLists_hlDebugSourcePath> + <HistoryLists_hlDebugSourcePath Name="Count">1</HistoryLists_hlDebugSourcePath> + <HistoryLists_hlDebugSourcePath Name="Item0">$(BCB)\source\vcl</HistoryLists_hlDebugSourcePath> + </HistoryLists_hlDebugSourcePath> + <HistoryLists_hlConditionals> + <HistoryLists_hlConditionals Name="Count">1</HistoryLists_hlConditionals> + <HistoryLists_hlConditionals Name="Item0">_DEBUG</HistoryLists_hlConditionals> + </HistoryLists_hlConditionals> + <Debugging> + <Debugging Name="DebugSourceDirs">$(BCB)\source\vcl</Debugging> + </Debugging> + <Parameters> + <Parameters Name="RunParams"/> + <Parameters Name="HostApplication"/> + <Parameters Name="RemoteHost"/> + <Parameters Name="RemotePath"/> + <Parameters Name="RemoteDebug">0</Parameters> + </Parameters> + <Compiler> + <Compiler Name="ShowInfoMsgs">0</Compiler> + <Compiler Name="LinkDebugVcl">1</Compiler> + <Compiler Name="LinkCGLIB">0</Compiler> + </Compiler> + <CORBA> + <CORBA Name="AddServerUnit">1</CORBA> + <CORBA Name="AddClientUnit">1</CORBA> + <CORBA Name="PrecompiledHeaders">1</CORBA> + </CORBA> + <ProjectProperties> + <ProjectProperties Name="AutoShowDeps">False</ProjectProperties> + <ProjectProperties Name="ManagePaths">True</ProjectProperties> + <ProjectProperties Name="VerifyPackages">True</ProjectProperties> + <ProjectProperties Name="IndexFiles">False</ProjectProperties> + </ProjectProperties> + <Source> + <Source Name="MainSource">tdbf_demo.cpp</Source> + </Source> + <Excluded_Packages> + <Excluded_Packages Name="$(BDSBIN)\bcboffice2k230.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages> + <Excluded_Packages Name="$(BDSBIN)\bcbofficexp230.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages> + <Excluded_Packages Name="C:\Users\paulb\Documents\Subversion\TDbf\trunk\packages\CPB2006\bpl\tdbf\tdbf_c2006d.bpl">File C:\Users\paulb\Documents\Subversion\TDbf\trunk\packages\CPB2006\bpl\tdbf\tdbf_c2006d.bpl not found</Excluded_Packages> + </Excluded_Packages> + </CPlusPlusBuilder.Personality> + <Platforms> + <Platform value="iOSDevice64">True</Platform> + <Platform value="Win32">True</Platform> + <Platform value="Win64">False</Platform> + </Platforms> + <Deployment Version="2"> + <DeployFile Condition="'$(DynamicRTL)'=='true'" LocalName="$(BDS)\Redist\osx32\libcgcrtl.dylib" Class="DependencyModule"> + <Platform Name="OSX32"> + <Overwrite>true</Overwrite> + </Platform> + </DeployFile> + <DeployFile Condition="'$(DynamicRTL)'=='true' And '$(Multithreaded)'!='true'" LocalName="$(BDS)\bin\cc32230.dll" Class="DependencyModule"> + <Platform Name="Win32"> + <Overwrite>true</Overwrite> + </Platform> + </DeployFile> + <DeployFile Condition="'$(UsingDelphiRTL)'=='true'" LocalName="$(BDS)\bin\borlndmm.dll" Class="DependencyModule"> + <Platform Name="Win32"> + <Overwrite>true</Overwrite> + </Platform> + </DeployFile> + <DeployFile Condition="'$(UsingDelphiRTL)'=='true'" LocalName="$(BDS)\bin64\borlndmm.dll" Class="DependencyModule"> + <Platform Name="Win64"> + <Overwrite>true</Overwrite> + </Platform> + </DeployFile> + <DeployFile Condition="'$(DynamicRTL)'=='true'" LocalName="$(BDS)\Redist\osx32\libcgstl.dylib" Class="DependencyModule"> + <Platform Name="OSX32"> + <Overwrite>true</Overwrite> + </Platform> + </DeployFile> + <DeployFile Condition="'$(DynamicRTL)'=='true' And '$(Multithreaded)'=='true'" LocalName="$(BDS)\bin\cc32230mt.dll" Class="DependencyModule"> + <Platform Name="Win32"> + <Overwrite>true</Overwrite> + </Platform> + </DeployFile> + <DeployFile Condition="'$(DynamicRTL)'=='true' And '$(Multithreaded)'=='true'" LocalName="$(BDS)\bin64\cc64230mt.dll" Class="DependencyModule"> + <Platform Name="Win64"> + <Overwrite>true</Overwrite> + </Platform> + </DeployFile> + <DeployFile Condition="'$(DynamicRTL)'=='true' And '$(Multithreaded)'!='true'" LocalName="$(BDS)\bin64\cc64230.dll" Class="DependencyModule"> + <Platform Name="Win64"> + <Overwrite>true</Overwrite> + </Platform> + </DeployFile> + <DeployClass Name="DependencyModule"> + <Platform Name="Win32"> + <Operation>0</Operation> + <Extensions>.dll;.bpl</Extensions> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + <Extensions>.dylib</Extensions> + </Platform> + <Platform Name="OSX32"> + <RemoteDir>Contents\MacOS</RemoteDir> + <Operation>1</Operation> + <Extensions>.dylib</Extensions> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + <Extensions>.dylib</Extensions> + </Platform> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + <Extensions>.dylib</Extensions> + </Platform> + </DeployClass> + <DeployClass Name="ProjectOSXResource"> + <Platform Name="OSX32"> + <RemoteDir>Contents\Resources</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="AndroidClassesDexFile"> + <Platform Name="Android"> + <RemoteDir>classes</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="AdditionalDebugSymbols"> + <Platform Name="Win32"> + <RemoteDir>Contents\MacOS</RemoteDir> + <Operation>0</Operation> + </Platform> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="OSX32"> + <RemoteDir>Contents\MacOS</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="iPad_Launch768"> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="Android_LauncherIcon144"> + <Platform Name="Android"> + <RemoteDir>res\drawable-xxhdpi</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="AndroidLibnativeMipsFile"> + <Platform Name="Android"> + <RemoteDir>library\lib\mips</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Required="true" Name="ProjectOutput"> + <Platform Name="Win32"> + <Operation>0</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="OSX32"> + <RemoteDir>Contents\MacOS</RemoteDir> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + <Platform Name="Android"> + <RemoteDir>library\lib\armeabi-v7a</RemoteDir> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="DependencyFramework"> + <Platform Name="Win32"> + <Operation>0</Operation> + </Platform> + <Platform Name="OSX32"> + <RemoteDir>Contents\MacOS</RemoteDir> + <Operation>1</Operation> + <Extensions>.framework</Extensions> + </Platform> + </DeployClass> + <DeployClass Name="iPhone_Launch640"> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="iPad_Launch1024"> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="ProjectiOSDeviceDebug"> + <Platform Name="iOSDevice64"> + <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="AndroidLibnativeX86File"> + <Platform Name="Android"> + <RemoteDir>library\lib\x86</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="iPhone_Launch320"> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="ProjectiOSInfoPList"> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="AndroidLibnativeArmeabiFile"> + <Platform Name="Android"> + <RemoteDir>library\lib\armeabi</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="DebugSymbols"> + <Platform Name="Win32"> + <Operation>0</Operation> + </Platform> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="OSX32"> + <RemoteDir>Contents\MacOS</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="iPad_Launch1536"> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="Android_SplashImage470"> + <Platform Name="Android"> + <RemoteDir>res\drawable-normal</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="Android_LauncherIcon96"> + <Platform Name="Android"> + <RemoteDir>res\drawable-xhdpi</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="Android_SplashImage640"> + <Platform Name="Android"> + <RemoteDir>res\drawable-large</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="iPhone_Launch640x1136"> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="ProjectiOSEntitlements"> + <Platform Name="iOSDevice64"> + <RemoteDir>../</RemoteDir> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <RemoteDir>../</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="Android_LauncherIcon72"> + <Platform Name="Android"> + <RemoteDir>res\drawable-hdpi</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="AndroidGDBServer"> + <Platform Name="Android"> + <RemoteDir>library\lib\armeabi-v7a</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="ProjectOSXInfoPList"> + <Platform Name="OSX32"> + <RemoteDir>Contents</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="ProjectOSXEntitlements"> + <Platform Name="OSX32"> + <RemoteDir>../</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="iPad_Launch2048"> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="AndroidSplashStyles"> + <Platform Name="Android"> + <RemoteDir>res\values</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="Android_SplashImage426"> + <Platform Name="Android"> + <RemoteDir>res\drawable-small</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="AndroidSplashImageDef"> + <Platform Name="Android"> + <RemoteDir>res\drawable</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="ProjectiOSResource"> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="ProjectAndroidManifest"> + <Platform Name="Android"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="Android_DefaultAppIcon"> + <Platform Name="Android"> + <RemoteDir>res\drawable</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="File"> + <Platform Name="Win32"> + <Operation>0</Operation> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>0</Operation> + </Platform> + <Platform Name="OSX32"> + <RemoteDir>Contents\Resources\StartUp\</RemoteDir> + <Operation>0</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>0</Operation> + </Platform> + <Platform Name="Android"> + <Operation>0</Operation> + </Platform> + <Platform Name="iOSSimulator"> + <Operation>0</Operation> + </Platform> + </DeployClass> + <DeployClass Name="AndroidServiceOutput"> + <Platform Name="Android"> + <RemoteDir>library\lib\armeabi-v7a</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Required="true" Name="DependencyPackage"> + <Platform Name="Win32"> + <Operation>0</Operation> + <Extensions>.bpl</Extensions> + </Platform> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + <Extensions>.dylib</Extensions> + </Platform> + <Platform Name="OSX32"> + <RemoteDir>Contents\MacOS</RemoteDir> + <Operation>1</Operation> + <Extensions>.dylib</Extensions> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + <Extensions>.dylib</Extensions> + </Platform> + <Platform Name="iOSSimulator"> + <Operation>1</Operation> + <Extensions>.dylib</Extensions> + </Platform> + </DeployClass> + <DeployClass Name="Android_LauncherIcon48"> + <Platform Name="Android"> + <RemoteDir>res\drawable-mdpi</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="Android_SplashImage960"> + <Platform Name="Android"> + <RemoteDir>res\drawable-xlarge</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="Android_LauncherIcon36"> + <Platform Name="Android"> + <RemoteDir>res\drawable-ldpi</RemoteDir> + <Operation>1</Operation> + </Platform> + </DeployClass> + <DeployClass Name="ProjectiOSDeviceResourceRules"> + <Platform Name="iOSDevice64"> + <Operation>1</Operation> + </Platform> + <Platform Name="iOSDevice32"> + <Operation>1</Operation> + </Platform> + </DeployClass> + <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/> + <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/> + <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/> + <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/> + <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/> + <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/> + <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/> + </Deployment> + </BorlandProject> + <ProjectFileVersion>12</ProjectFileVersion> + </ProjectExtensions> + <Import Project="$(BDS)\Bin\CodeGear.Cpp.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Cpp.Targets')"/> + <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/> + <Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/> +</Project> Property changes on: trunk/demo/tdbf_demo.cbproj ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Added: trunk/demo/tdbf_demo.cpp =================================================================== --- trunk/demo/tdbf_demo.cpp (rev 0) +++ trunk/demo/tdbf_demo.cpp 2015-11-05 14:19:22 UTC (rev 609) @@ -0,0 +1,42 @@ +//--------------------------------------------------------------------------- +#include <vcl.h> +#pragma hdrstop +USEFORMNS("Pack.pas", Pack, PackTableForm); +USEFORMNS("Main.pas", Main, MainForm); +USEFORMNS("Index.pas", Index, IndexForm); +USEFORMNS("schema.pas", Schema, Schema1Form); +USEFORMNS("Calc.pas", Calc, CalcForm); +USEFORMNS("search.pas", Search, SearchForm); +USEFORMNS("schema2.pas", Schema2, Schema2Form); +USEFORMNS("simple.pas", Simple, SimpleForm); +USEFORMNS("CopyTable.pas", Copytable, CopyTableForm); +USEFORMNS("Filter.pas", Filter, FilterForm); +USEFORMNS("EditTopics.pas", Edittopics, EditTopicsForm); +USEFORMNS("CreateTable.pas", Createtable, CreateTableForm); +//--------------------------------------------------------------------------- +WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) +{ + try + { + Application->Initialize(); + Application->CreateForm(__classid(TMainForm), &MainForm); + Application->CreateForm(__classid(TSimpleForm), &SimpleForm); + Application->CreateForm(__classid(TCopyTableForm), &CopyTableForm); + Application->CreateForm(__classid(TCreateTableForm), &CreateTableForm); + Application->CreateForm(__classid(TEditTopicsForm), &EditTopicsForm); + Application->CreateForm(__classid(TFilterForm), &FilterForm); + Application->CreateForm(__classid(TIndexForm), &IndexForm); + Application->CreateForm(__classid(TPackTableForm), &PackTableForm); + Application->CreateForm(__classid(TSchema1Form), &Schema1Form); + Application->CreateForm(__classid(TSchema2Form), &Schema2Form); + Application->CreateForm(__classid(TSearchForm), &SearchForm); + Application->CreateForm(__classid(TCalcForm), &CalcForm); + Application->Run(); + } + catch (Exception &exception) + { + Application->ShowException(&exception); + } + return 0; +} +//--------------------------------------------------------------------------- Property changes on: trunk/demo/tdbf_demo.cpp ___________________________________________________________________ Added: svn:eol-style ## -0,0 +1 ## +native \ No newline at end of property Deleted: trunk/demo/tdbf_demo5.bpr =================================================================== --- trunk/demo/tdbf_demo5.bpr 2015-11-05 14:10:05 UTC (rev 608) +++ trunk/demo/tdbf_demo5.bpr 2015-11-05 14:19:22 UTC (rev 609) @@ -1,123 +0,0 @@ -<?xml version='1.0' encoding='utf-8' ?> -<!-- C++Builder XML Project --> -<PROJECT> - <MACROS> - <VERSION value="BCB.05.03"/> - <PROJECT value="tdbf_demo5.exe"/> - <OBJFILES value="simple.obj CopyTable.obj CreateTable.obj EditTopics.obj Filter.obj - Index.obj Main.obj Pack.obj schema.obj schema2.obj search.obj Calc.obj - tdbf_demo5.obj"/> - <RESFILES value="tdbf_demo5.res"/> - <IDLFILES value=""/> - <IDLGENFILES value=""/> - <DEFFILE value=""/> - <RESDEPEN value="$(RESFILES) simple.dfm CopyTable.dfm CreateTable.dfm EditTopics.dfm - Filter.dfm Index.dfm Main.dfm Pack.dfm schema.dfm schema2.dfm search.dfm - Calc.dfm"/> - <LIBFILES value=""/> - <LIBRARIES value="TDBF_C5R.lib vcldbx50.lib vcldb50.lib vcljpg50.lib vclx50.lib vcl50.lib"/> - <SPARELIBS value="vcl50.lib vclx50.lib vcljpg50.lib vcldb50.lib vcldbx50.lib TDBF_C5R.lib"/> - <PACKAGES value="vcl50.bpi vclx50.bpi vcljpg50.bpi vcldb50.bpi"/> - <PATHCPP value=".;"/> - <PATHPAS value=".;"/> - <PATHRC value=".;"/> - <PATHASM value=".;"/> - <DEBUGLIBPATH value="$(BCB)\lib\debug"/> - <RELEASELIBPATH value="$(BCB)\lib\release"/> - <LINKER value="ilink32"/> - <USERDEFINES value="_DEBUG"/> - <SYSDEFINES value="NO_STRICT"/> - <MAINSOURCE value="tdbf_demo5.cpp"/> - <INCLUDEPATH value="..\tdbf5;$(BCB)\include;$(BCB)\include\vcl"/> - <LIBPATH value="..\tdbf5;$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib"/> - <WARNINGS value="-w-par -w-8027 -w-8026"/> - <WARNOPTSTR value=""/> - </MACROS> - <OPTIONS> - <IDLCFLAGS value="-I..\tdbf5 -I$(BCB)\include -I$(BCB)\include\vcl -src_suffix cpp -D_DEBUG - -boa"/> - <CFLAG1 value="-Od -H=dbfdemo.csm -Hc -Vx -Ve -X- -r- -a8 -5 -b- -k -y -v -vi- -c -tW -tWM"/> - <PFLAGS value="-$Y+ -$W -$T -$O- -$J- -v -JPHNE -M"/> - <RFLAGS value=""/> - <AFLAGS value="/mx /w2 /zi"/> - <LFLAGS value="-D"" -aa -Tpe -x -v"/> - </OPTIONS> - <LINKER> - <ALLOBJ value="c0w32.obj sysinit.obj $(OBJFILES)"/> - <ALLRES value="$(RESFILES)"/> - <ALLLIB value="$(LIBFILES) $(LIBRARIES) import32.lib cp32mt.lib"/> - </LINKER> - <IDEOPTIONS> -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=2057 -CodePage=1252 - -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= - -[HistoryLists\hlIncludePath] -Count=3 -Item0=..\tdbf5;$(BCB)\include;$(BCB)\include\vcl -Item1=$(BCB)\include;$(BCB)\include\vcl -Item2=$(BCB)\include;$(BCB)\include\vcl;..\tdbf5 - -[HistoryLists\hlLibraryPath] -Count=3 -Item0=..\tdbf5;$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib -Item1=$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib -Item2=$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;..\tdbf5 - -[HistoryLists\hlDebugSourcePath] -Count=1 -Item0=$(BCB)\source\vcl - -[HistoryLists\hlConditionals] -Count=1 -Item0=_DEBUG - -[Debugging] -DebugSourceDirs=$(BCB)\source\vcl - -[Parameters] -RunParams= -HostApplication= -RemoteHost= -RemotePath= -RemoteDebug=0 - -[Compiler] -ShowInfoMsgs=0 -LinkDebugVcl=1 -LinkCGLIB=0 - -[CORBA] -AddServerUnit=1 -AddClientUnit=1 -PrecompiledHeaders=1 - -[Language] -ActiveLang= -ProjectLang= -RootDir= - </IDEOPTIONS> -</PROJECT> \ No newline at end of file Deleted: trunk/demo/tdbf_demo5.cpp =================================================================== --- trunk/demo/tdbf_demo5.cpp 2015-11-05 14:10:05 UTC (rev 608) +++ trunk/demo/tdbf_demo5.cpp 2015-11-05 14:19:22 UTC (rev 609) @@ -1,43 +0,0 @@ -//--------------------------------------------------------------------------- -#include <vcl.h> -#pragma hdrstop -USERES("tdbf_demo5.res"); -USEFORMNS("simple.pas", Simple, SimpleForm); -USEFORMNS("CopyTable.pas", Copytable, CopyTableForm); -USEFORMNS("CreateTable.pas", Createtable, CreateTableForm); -USEFORMNS("EditTopics.pas", Edittopics, EditTopicsForm); -USEFORMNS("Filter.pas", Filter, FilterForm); -USEFORMNS("Index.pas", Index, IndexForm); -USEFORMNS("Main.pas", Main, MainForm); -USEFORMNS("Pack.pas", Pack, PackTableForm); -USEFORMNS("schema.pas", Schema, Schema1Form); -USEFORMNS("schema2.pas", Schema2, Schema2Form); -USEFORMNS("search.pas", Search, SearchForm); -USEFORMNS("Calc.pas", Calc, CalcForm); -//--------------------------------------------------------------------------- -WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int) -{ - try - { - Application->Initialize(); - Application->CreateForm(__classid(TMainForm), &MainForm); - Application->CreateForm(__classid(TSimpleForm), &SimpleForm); - Application->CreateForm(__classid(TCopyTableForm), &CopyTableForm); - Application->CreateForm(__classid(TCreateTableForm), &CreateTableForm); - Application->CreateForm(__classid(TEditTopicsForm), &EditTopicsForm); - Application->CreateForm(__classid(TFilterForm), &FilterForm); - Application->CreateForm(__classid(TIndexForm), &IndexForm); - Application->CreateForm(__classid(TPackTableForm), &PackTableForm); - Application->CreateForm(__classid(TSchema1Form), &Schema1Form); - Application->CreateForm(__classid(TSchema2Form), &Schema2Form); - Application->CreateForm(__classid(TSearchForm), &SearchForm); - Application->CreateForm(__classid(TCalcForm), &CalcForm); - Application->Run(); - } - catch (Exception &exception) - { - Application->ShowException(&exception); - } - return 0; -} -//--------------------------------------------------------------------------- Deleted: trunk/demo/tdbf_demo5.res =================================================================== (Binary files differ) Added: trunk/demo/tdbf_demo_Icon.ico =================================================================== (Binary files differ) Index: trunk/demo/tdbf_demo_Icon.ico =================================================================== --- trunk/demo/tdbf_demo_Icon.ico 2015-11-05 14:10:05 UTC (rev 608) +++ trunk/demo/tdbf_demo_Icon.ico 2015-11-05 14:19:22 UTC (rev 609) Property changes on: trunk/demo/tdbf_demo_Icon.ico ___________________________________________________________________ Added: svn:mime-type ## -0,0 +1 ## +application/octet-stream \ No newline at end of property Modified: trunk/doc/INSTALL =================================================================== --- trunk/doc/INSTALL 2015-11-05 14:10:05 UTC (rev 608) +++ trunk/doc/INSTALL 2015-11-05 14:19:22 UTC (rev 609) @@ -1,14 +1,14 @@ -To install -========== +To install in the IDE +===================== -Delphi / BCB / Kylix +Delphi / C++ Builder -------------------- 1. Choose File -> Open Project -2. Select the runtime package for your version of delphi / bcb (see packages.txt) +2. Select the runtime package for your version of Delphi / C++ Builder (see packages.txt) 3. Compile 4. Open the design package, and install it - (Note BCB 4 and Delphi 3 and 4 don't have run/designtime seperation) + (Note BCB 4 and Delphi 3 and 4 don't have run/designtime separation) 5. All done. Lazarus @@ -28,11 +28,13 @@ To build the demo ================= -Delphi (requires version 5 or higher) / BCB / Kylix ---------------------------------------------------- +Delphi / C++ Builder +-------------------- +Requires Delphi version 5 or higher or C++ Builder version 10 Seattle or higher + 1. Choose File -> Open Project -2. Select demo/TDbf_Demo.dpr for Delphi or demo/tdbf_demo5.bpr for BCB +2. Select demo/TDbf_Demo.dpr for Delphi or demo/tdbf_demo.cbproj for C++ Builder 3. Compile Lazarus This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-11-25 13:55:53
|
Revision: 637 http://sourceforge.net/p/tdbf/code/637 Author: paulenandrew Date: 2015-11-25 13:55:51 +0000 (Wed, 25 Nov 2015) Log Message: ----------- fix field attributes for Free Pascal, ftAutoInc should be faReadOnly Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_common.inc trunk/src/dbf_fields.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-11-24 12:17:46 UTC (rev 636) +++ trunk/doc/history.txt 2015-11-25 13:55:51 UTC (rev 637) @@ -33,6 +33,12 @@ ------------------------ +V7.0.1 + +following changes thx paulenandrew: +- fix field attributes for Free Pascal, ftAutoInc should be faReadOnly + +------------------------ V7.0 - compile fixes for delphi 4, 5 (pdouble) Modified: trunk/src/dbf_common.inc =================================================================== --- trunk/src/dbf_common.inc 2015-11-24 12:17:46 UTC (rev 636) +++ trunk/src/dbf_common.inc 2015-11-25 13:55:51 UTC (rev 637) @@ -472,6 +472,7 @@ {$define SUPPORT_DEFAULT_PARAMS} {$define SUPPORT_OVERLOAD} {$define SUPPORT_NEW_TRANSLATE} + {$define SUPPORT_FIELDDEF_ATTRIBUTES} {$define SUPPORT_FIELDDEF_TPERSISTENT} {$define SUPPORT_FIELDTYPES_V4} {$define SUPPORT_UINT32_CARDINAL} Modified: trunk/src/dbf_fields.pas =================================================================== --- trunk/src/dbf_fields.pas 2015-11-24 12:17:46 UTC (rev 636) +++ trunk/src/dbf_fields.pas 2015-11-25 13:55:51 UTC (rev 637) @@ -282,8 +282,10 @@ // what a shame :-) {$ifdef SUPPORT_FIELDDEF_ATTRIBUTES} DbDest.Attributes := []; +{$ifndef FPC} DbDest.ChildDefs.Clear; {$endif} +{$endif} DbDest.DataType := FFieldType; DbDest.Required := FRequired; DbDest.Size := FSize; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2015-11-25 13:57:09
|
Revision: 638 http://sourceforge.net/p/tdbf/code/638 Author: paulenandrew Date: 2015-11-25 13:57:07 +0000 (Wed, 25 Nov 2015) Log Message: ----------- enforce read only fields, ftAutoInc is read-only Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-11-25 13:55:51 UTC (rev 637) +++ trunk/doc/history.txt 2015-11-25 13:57:07 UTC (rev 638) @@ -37,6 +37,7 @@ following changes thx paulenandrew: - fix field attributes for Free Pascal, ftAutoInc should be faReadOnly +- enforce read only fields, ftAutoInc is read-only ------------------------ V7.0 Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2015-11-25 13:55:51 UTC (rev 637) +++ trunk/src/dbf.pas 2015-11-25 13:57:07 UTC (rev 638) @@ -525,7 +525,9 @@ System.Generics.Collections, {$endif} SysUtils, -{$ifndef FPC} +{$ifdef FPC} + dbconst, +{$else} DBConsts, {$endif} {$ifdef WINDOWS} @@ -848,6 +850,8 @@ begin if (Field.FieldNo >= 0) then begin + if Field.ReadOnly and not (State in [dsSetKey, dsFilter]) then + DatabaseErrorFmt({$ifdef FPC}SReadOnlyField{$else}SFieldReadOnly{$endif}, [Field.DisplayName]); if State = dsSetKey then Dst := @PDbfRecord(GetKeyBuffer)^.DeletedFlag else This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2016-01-26 17:43:57
|
Revision: 639 http://sourceforge.net/p/tdbf/code/639 Author: paulenandrew Date: 2016-01-26 17:43:55 +0000 (Tue, 26 Jan 2016) Log Message: ----------- fix potential Access Violation caused by heap corruption if there is a calculated field and SetKey is used Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2015-11-25 13:57:07 UTC (rev 638) +++ trunk/doc/history.txt 2016-01-26 17:43:55 UTC (rev 639) @@ -33,6 +33,12 @@ ------------------------ +V7.0.2 + +following changes thx paulenandrew: +- fix potential Access Violation caused by heap corruption if there is a calculated field and SetKey is used + +------------------------ V7.0.1 following changes thx paulenandrew: Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2015-11-25 13:57:07 UTC (rev 638) +++ trunk/src/dbf.pas 2016-01-26 17:43:55 UTC (rev 639) @@ -741,7 +741,7 @@ function TDbf.AllocRecordBuffer: TDbfRecordBuffer; {override virtual abstract from TDataset} begin - GetMem(Result, SizeOf(TDbfRecordHeader)+FDbfFile.RecordSize+CalcFieldsSize+1); + GetMem(Result, SizeOf(TDbfRecordHeader) + RecordSize + CalcFieldsSize + 1); end; procedure TDbf.FreeRecordBuffer(var Buffer: TDbfRecordBuffer); {override virtual abstract from TDataset} @@ -3399,7 +3399,7 @@ var Len: Integer; begin - Len := SizeOf(TDbfRecordHeader) + RecordSize; + Len := SizeOf(TDbfRecordHeader) + RecordSize + CalcFieldsSize + 1; if (FKeyBuffer = nil) then GetMem(FKeyBuffer, Len) else This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2016-02-16 15:28:36
|
Revision: 640 http://sourceforge.net/p/tdbf/code/640 Author: paulenandrew Date: 2016-02-16 15:28:35 +0000 (Tue, 16 Feb 2016) Log Message: ----------- flush all indexes (not just current or first one) after edit/insert/delete if table opened for shared access Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_idxfile.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2016-01-26 17:43:55 UTC (rev 639) +++ trunk/doc/history.txt 2016-02-16 15:28:35 UTC (rev 640) @@ -37,6 +37,7 @@ following changes thx paulenandrew: - fix potential Access Violation caused by heap corruption if there is a calculated field and SetKey is used +- flush all indexes (not just current or first one) after edit/insert/delete if table opened for shared access ------------------------ V7.0.1 Modified: trunk/src/dbf_idxfile.pas =================================================================== --- trunk/src/dbf_idxfile.pas 2016-01-26 17:43:55 UTC (rev 639) +++ trunk/src/dbf_idxfile.pas 2016-02-16 15:28:35 UTC (rev 640) @@ -4466,7 +4466,7 @@ if NeedLocks and (FIndexVersion >= xBaseIV) then begin try - FRoot.Flush; + Flush; PVersion := @PIndexHdr(FIndexHeader).Version; if PVersion^ = High(PVersion^) then PVersion^ := 0 This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2016-04-27 14:37:26
|
Revision: 642 http://sourceforge.net/p/tdbf/code/642 Author: paulenandrew Date: 2016-04-27 14:37:25 +0000 (Wed, 27 Apr 2016) Log Message: ----------- correct progress information when building an index (Sorting records and Writing records) Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_idxfile.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2016-03-04 16:47:10 UTC (rev 641) +++ trunk/doc/history.txt 2016-04-27 14:37:25 UTC (rev 642) @@ -39,6 +39,7 @@ - fix potential Access Violation caused by heap corruption if there is a calculated field and SetKey is used - flush all indexes (not just current or first one) after edit/insert/delete if table opened for shared access - correct conversion of integer value to text if it is outside the 32-bit signed range (introduced in v7.0, fixes bug 85) +- correct progress information when building an index (Sorting records and Writing records) ------------------------ V7.0.1 Modified: trunk/src/dbf_idxfile.pas =================================================================== --- trunk/src/dbf_idxfile.pas 2016-03-04 16:47:10 UTC (rev 641) +++ trunk/src/dbf_idxfile.pas 2016-04-27 14:37:25 UTC (rev 642) @@ -383,7 +383,6 @@ procedure MergeSort(List: PDbfPointerList; L, R: Integer); procedure MergeSort2(List, TempList: PDbfPointerList; L, R: Integer); procedure MergeSort3(List, TempList: PDbfPointerList; L0, L1, R0, R1: Integer); - procedure MergeSortCheckCancel; function MergeSortCompare(Item1, Item2: Pointer): Integer; procedure PrepareRename(NewFileName: string); procedure CalcRegenerateIndexes; @@ -2992,9 +2991,13 @@ end; DoProgress(FProgressPosition, FProgressMax, STRING_PROGRESS_READINGRECORDS); end; - DoProgress(-1, FProgressMax, STRING_PROGRESS_SORTING_RECORDS); + FProgressPosition := 0; + FProgressMax := -1; + DoProgress(FProgressPosition, FProgressMax, STRING_PROGRESS_SORTING_RECORDS); MergeSort(PPEntries, 0, Pred(EntryCount)); - DoProgress(-1, FProgressMax, STRING_PROGRESS_WRITING_RECORDS); + FProgressPosition := 0; + FProgressMax := EntryCount; + DoProgress(FProgressPosition, FProgressMax, STRING_PROGRESS_WRITING_RECORDS); if FUniqueMode = iuUnique then AUniqueMode := iuDistinct else @@ -3009,6 +3012,7 @@ InsertCurrent(AUniqueMode); Inc(PAnsiChar(PPEntry), SizeOf(Pointer)); Inc(EntryIndex); + Inc(FProgressPosition); DoProgress(FProgressPosition, FProgressMax, STRING_PROGRESS_WRITING_RECORDS); end; end; @@ -3090,7 +3094,8 @@ procedure MergeAppend(var J: Integer); begin - MergeSortCheckCancel; + Inc(FProgressPosition); + DoProgress(FProgressPosition, FProgressMax, STRING_PROGRESS_SORTING_RECORDS); TempList^[I] := List^[J]; Inc(I); Inc(J); @@ -3111,11 +3116,6 @@ MergeAppend(R0); end; -procedure TIndexFile.MergeSortCheckCancel; -begin - DoProgress(FProgressPosition, FProgressMax, STRING_PROGRESS_SORTING_RECORDS); -end; - function TIndexFile.MergeSortCompare(Item1, Item2: Pointer): Integer; var KeyData1: PAnsiChar; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2016-07-07 16:06:38
|
Revision: 646 http://sourceforge.net/p/tdbf/code/646 Author: paulenandrew Date: 2016-07-07 16:06:36 +0000 (Thu, 07 Jul 2016) Log Message: ----------- fix RestructureTable method's handling of incompatible field types Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_dbffile.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2016-04-27 15:58:59 UTC (rev 645) +++ trunk/doc/history.txt 2016-07-07 16:06:36 UTC (rev 646) @@ -40,6 +40,7 @@ - flush all indexes (not just current or first one) after edit/insert/delete if table opened for shared access - correct conversion of integer value to text if it is outside the 32-bit signed range (introduced in v7.0, fixes bug 85) - correct progress information when building an index (Sorting records and Writing records) +- fix RestructureTable method's handling of incompatible field types ------------------------ V7.0.1 Modified: trunk/src/dbf_dbffile.pas =================================================================== --- trunk/src/dbf_dbffile.pas 2016-04-27 15:58:59 UTC (rev 645) +++ trunk/src/dbf_dbffile.pas 2016-07-07 16:06:36 UTC (rev 646) @@ -1175,6 +1175,10 @@ RestructFieldInfo: PRestructFieldInfo; BlobStream: TMemoryStream; last: Integer; + Buffer: array[0..7] of Char; + DoubleValue: Double absolute Buffer; + IntValue: Integer absolute Buffer; + Int64Value: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; begin // nothing to do? if (RecordSize < 1) or ((DbfFieldDefs = nil) and not Pack) then @@ -1326,28 +1330,60 @@ for lFieldNo := 0 to DestFieldDefs.Count-1 do begin TempDstDef := DestFieldDefs.Items[lFieldNo]; + if TempDstDef.CopyFrom >= 0 then + TempSrcDef := FFieldDefs.Items[TempDstDef.CopyFrom] + else + TempSrcDef := FFieldDefs.Items[lFieldNo]; // handle blob fields differently // don't try to copy new blob fields! // DbfFieldDefs = nil -> pack only // TempDstDef.CopyFrom >= 0 -> copy existing (blob) field if TempDstDef.IsBlob and ((DbfFieldDefs = nil) or (TempDstDef.CopyFrom >= 0)) then begin - // get current blob blockno - if GetFieldData(lFieldNo, ftInteger, pBuff, @lBlobPageNo, false) and (lBlobPageNo > 0) then + if TempSrcDef.IsBlob then begin - BlobStream.Clear; - FMemoFile.ReadMemo(lBlobPageNo, BlobStream); - BlobStream.Position := 0; - // always append - DestDbfFile.FMemoFile.WriteMemo(lBlobPageNo, 0, BlobStream); - // write new blockno - DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobPageNo, pDestBuff, false); + // get current blob blockno + if GetFieldData(lFieldNo, ftInteger, pBuff, @lBlobPageNo, false) and (lBlobPageNo > 0) then + begin + BlobStream.Clear; + FMemoFile.ReadMemo(lBlobPageNo, BlobStream); + BlobStream.Position := 0; + // always append + DestDbfFile.FMemoFile.WriteMemo(lBlobPageNo, 0, BlobStream); + // write new blockno + DestDbfFile.SetFieldData(lFieldNo, ftInteger, @lBlobPageNo, pDestBuff, false); + end; end; end else if (DbfFieldDefs <> nil) and (TempDstDef.CopyFrom >= 0) then begin // copy content of field - with RestructFieldInfo[lFieldNo] do - Move(pBuff[SourceOffset], pDestBuff[DestOffset], Size); + if (TempSrcDef.NativeFieldType = TempDstDef.NativeFieldType) or + (CharInSet(TempSrcDef.NativeFieldType, ['F', 'N']) and CharInSet(TempDstDef.NativeFieldType, ['F', 'N'])) or + (CharInSet(TempSrcDef.NativeFieldType, ['+', 'I']) and CharInSet(TempDstDef.NativeFieldType, ['+', 'I'])) then + begin + // Source and destination native types are compatible + with RestructFieldInfo[lFieldNo] do + Move(pBuff[SourceOffset], pDestBuff[DestOffset], Size); + end + else + begin + // Source and destination native types are both numeric, but incompatible + if (TempSrcDef.FieldType in [ftFloat, ftInteger, ftAutoInc]) and (TempDstDef.FieldType in [ftFloat, ftInteger, ftAutoInc]) then + begin + if GetFieldData(lFieldNo, TempSrcDef.FieldType, pBuff, @Buffer, True) then + begin + if (TempSrcDef.FieldType = ftFloat) and (TempDstDef.FieldType in [ftInteger, ftAutoInc]) then + begin + Int64Value := Round(DoubleValue); + if (Int64Value >= Low(IntValue)) and (Int64Value <= High(IntValue)) then + IntValue := Int64Value; + end; + if (TempSrcDef.FieldType in [ftInteger, ftAutoInc]) and (TempDstDef.FieldType = ftFloat) then + DoubleValue := IntValue; + DestDbfFile.SetFieldData(lFieldNo, TempDstDef.FieldType, @Buffer, pDestBuff, True); + end; + end; + end; end; end; end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |