diff --git a/wst/tags/3.1/COPYING.LGPL b/wst/tags/3.1/COPYING.LGPL new file mode 100644 index 000000000..92b8903ff --- /dev/null +++ b/wst/tags/3.1/COPYING.LGPL @@ -0,0 +1,481 @@ + GNU LIBRARY GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 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. + +[This is the first released version of the library GPL. It is + numbered 2 because it goes with version 2 of the ordinary GPL.] + + 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 Library General Public License, applies to some +specially designated Free Software Foundation software, and to any +other libraries whose authors decide to use it. You can use it for +your libraries, 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 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 a program 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. + + Our method of protecting your rights has two steps: (1) copyright +the library, and (2) offer you this license which gives you legal +permission to copy, distribute and/or modify the library. + + Also, for each distributor's protection, we want to make certain +that everyone understands that there is no warranty for this free +library. If the library is modified by someone else and passed on, we +want its recipients to know that what they have is not the original +version, 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 companies distributing free +software will individually obtain patent licenses, thus in effect +transforming the program into proprietary software. To prevent this, +we have made it clear that any patent must be licensed for everyone's +free use or not licensed at all. + + Most GNU software, including some libraries, is covered by the ordinary +GNU General Public License, which was designed for utility programs. This +license, the GNU Library General Public License, applies to certain +designated libraries. This license is quite different from the ordinary +one; be sure to read it in full, and don't assume that anything in it is +the same as in the ordinary license. + + The reason we have a separate public license for some libraries is that +they blur the distinction we usually make between modifying or adding to a +program and simply using it. Linking a program with a library, without +changing the library, is in some sense simply using the library, and is +analogous to running a utility program or application program. However, in +a textual and legal sense, the linked executable is a combined work, a +derivative of the original library, and the ordinary General Public License +treats it as such. + + Because of this blurred distinction, using the ordinary General +Public License for libraries did not effectively promote software +sharing, because most developers did not use the libraries. We +concluded that weaker conditions might promote sharing better. + + However, unrestricted linking of non-free programs would deprive the +users of those programs of all benefit from the free status of the +libraries themselves. This Library General Public License is intended to +permit developers of non-free programs to use free libraries, while +preserving your freedom as a user of such programs to change the free +libraries that are incorporated in them. (We have not seen how to achieve +this as regards changes in header files, but we have achieved it as regards +changes in the actual functions of the Library.) The hope is that this +will lead to faster development of free libraries. + + 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, while the latter only +works together with the library. + + Note that it is possible for a library to be covered by the ordinary +General Public License rather than by this special one. + + GNU LIBRARY GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library which +contains a notice placed by the copyright holder or other authorized +party saying it may be distributed under the terms of this Library +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 compile 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) 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. + + c) 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. + + d) 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 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. + + 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 to +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 Library 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. + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 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 + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the Free + 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. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/wst/tags/3.1/COPYING.modifiedLGPL b/wst/tags/3.1/COPYING.modifiedLGPL new file mode 100644 index 000000000..5f13ea54e --- /dev/null +++ b/wst/tags/3.1/COPYING.modifiedLGPL @@ -0,0 +1,26 @@ +This is the file COPYING.modifiedLGPL, it applies to several units in the +Lazarus sources distributed by members of the Lazarus Development Team. +All files contains headers showing the appropriate license. See there if this +modification can be applied. + +These files are distributed under the Library GNU General Public License +(see the file COPYING.LPGL) with the following modification: + +As a special exception, the copyright holders of this library give you +permission to link this library with independent modules to produce an +executable, regardless of the license terms of these independent modules, +and to copy and distribute the resulting executable under terms of your choice, +provided that you also meet, for each linked independent module, the terms +and conditions of the license of that module. An independent module is a +module which is not derived from or based on this library. If you modify this +library, you may extend this exception to your version of the library, but +you are not obligated to do so. If you do not wish to do so, delete this +exception statement from your version. + + +If you didn't receive a copy of the file COPYING.LGPL, contact: + Free Software Foundation, Inc., + 675 Mass Ave + Cambridge, MA 02139 + USA + diff --git a/wst/tags/3.1/base_binary_formatter.pas b/wst/tags/3.1/base_binary_formatter.pas new file mode 100644 index 000000000..53f814b3e --- /dev/null +++ b/wst/tags/3.1/base_binary_formatter.pas @@ -0,0 +1,1273 @@ +{ This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit base_binary_formatter; + +{$mode objfpc}{$H+} +{$DEFINE wst_binary_header} + +interface + +uses + Classes, SysUtils, Contnrs, TypInfo, + base_service_intf, binary_streamer; + +const + sROOT = 'ROOT'; +{$IFDEF wst_binary_header} + sHEADER = 'HEADER'; +{$ENDIF} + +type + EBinaryFormatterException = class(EServiceException) + End; + + TDataName = AnsiString; + TDataType = ( + dtInt8U, dtInt8S, + dtInt16U, dtInt16S, + dtInt32U, dtInt32S, + dtInt64U, dtInt64S, + dtBool, dtEnum, + dtSingle, dtDouble, dtExtended, dtCurrency, + dtString, + dtObject, dtArray + ); + + PStringBuffer = ^TStringBuffer; + PObjectBuffer = ^TObjectBuffer; + PArrayBuffer = ^TArrayBuffer; + PDataBuffer = ^TDataBuffer; + + TDataBuffer = Record + Name : TDataName; + Case DataType : TDataType of + dtInt8S : ( Int8S : TInt8S ); + dtInt8U : ( Int8U : TInt8U ); + dtInt16U : ( Int16U : TInt16U ); + dtInt16S : ( Int16S : TInt16S ); + dtInt32U : ( Int32U : TInt32U ); + dtInt32S : ( Int32S : TInt32S ); + dtInt64U : ( Int64U : TInt64U ); + dtInt64S : ( Int64S : TInt64S ); + dtBool : ( BoolData : TBoolData ); + dtEnum : ( EnumData : TEnumData ); + dtSingle : ( SingleData : TFloat_Single_4 ); + dtDouble : ( DoubleData : TFloat_Double_8 ); + dtExtended : ( ExtendedData : TFloat_Extended_10 ); + dtCurrency : ( CurrencyData : TFloat_Currency_8 ); + + dtString : ( StrData : PStringBuffer ); + dtObject : ( ObjectData : PObjectBuffer ); + dtArray : ( ArrayData : PArrayBuffer ); + End; + + TStringBuffer = Record + Data : String; + End; + + PObjectBufferItem = ^TObjectBufferItem; + TObjectBufferItem = Record + Data : PDataBuffer; + Next : PObjectBufferItem; + End; + + TObjectBuffer = Record + NilObject : TBoolData; + Count : Integer; + Head : PObjectBufferItem; + Last : PObjectBufferItem; + Attributes : PObjectBuffer; + End; + + PDataBufferList = ^TDataBufferList; + TDataBufferList = array[0..MAX_ARRAY_LENGTH] of PDataBuffer; + TArrayBuffer = Record + Count : Integer; + Items : PDataBufferList; + Attributes : PObjectBuffer; + End; + + { TStackItem } + + TStackItem = class + private + FScopeObject: PDataBuffer; + FScopeType: TScopeType; + Public + constructor Create(const AScopeObject : PDataBuffer;AScopeType : TScopeType); + function GetItemCount():Integer;virtual;abstract; + function Find(var AName : TDataName):PDataBuffer;virtual;abstract; + function GetByIndex(const AIndex : Integer):PDataBuffer;virtual;abstract; + function CreateBuffer( + Const AName : String; + const ADataType : TDataType + ):PDataBuffer;virtual;abstract; + procedure NilCurrentScope();virtual;abstract; + function IsCurrentScopeNil():Boolean;virtual;abstract; + property ScopeObject : PDataBuffer Read FScopeObject; + property ScopeType : TScopeType Read FScopeType; + End; + + { TObjectStackItem } + + TObjectStackItem = class(TStackItem) + Public + constructor Create(const AScopeObject : PDataBuffer); + function GetItemCount():Integer;override; + function Find(var AName : TDataName):PDataBuffer;override; + function GetByIndex(const AIndex : Integer):PDataBuffer;override; + function CreateBuffer( + Const AName : String; + const ADataType : TDataType + ):PDataBuffer;override; + procedure NilCurrentScope();override; + function IsCurrentScopeNil():Boolean;override; + End; + + { TArrayStackItem } + + TArrayStackItem = class(TStackItem) + Private + FIndex : Integer; + Public + constructor Create(const AScopeObject : PDataBuffer); + function GetItemCount():Integer;override; + function Find(var AName : TDataName):PDataBuffer;override; + function GetByIndex(const AIndex : Integer):PDataBuffer;override; + function CreateBuffer( + Const AName : String; + const ADataType : TDataType + ):PDataBuffer;override; + procedure NilCurrentScope();override; + function IsCurrentScopeNil():Boolean;override; + End; + + { TBaseBinaryFormatter } + + TBaseBinaryFormatter = class(TSimpleFactoryItem,IFormatterBase) + private + FRootData : PDataBuffer; + FStack : TObjectStack; + FSerializationStyle : TSerializationStyle; + {$IFDEF wst_binary_header} + FHeaderEnterCount : Integer; + {$ENDIF} + private + function GetCurrentScopeObject():PDataBuffer; + procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); + function GetSerializationStyle():TSerializationStyle; + protected + function HasScope():Boolean; + procedure CheckScope(); + procedure ClearStack(); + procedure PushStack(AScopeObject : PDataBuffer;Const AScopeType : TScopeType = stObject); + function StackTop():TStackItem; + function PopStack():TStackItem; + function GetRootData() : PDataBuffer; + protected + procedure PutFloat( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : TFloat_Extended_10 + ); + procedure PutInt( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : TInt64S + ); + procedure PutStr( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : String + ); + procedure PutEnum( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : TEnumData + ); + procedure PutBool( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : Boolean + ); + procedure PutInt64( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : Int64 + ); + procedure PutObj( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : TObject + ); + + function GetDataBuffer(var AName : String):PDataBuffer; + procedure GetEnum( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : TEnumData + ); + procedure GetBool( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : Boolean + ); + procedure GetFloat( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : TFloat_Extended_10 + ); + procedure GetInt( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : TInt64S + ); + procedure GetInt64( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : Int64 + ); + procedure GetStr( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : String + ); + procedure GetObj( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : TObject + ); + public + constructor Create();override; + destructor Destroy();override; + + function GetCurrentScope():string; + procedure Clear(); + + procedure BeginObject( + Const AName : string; + Const ATypeInfo : PTypeInfo + ); + procedure BeginArray( + Const AName : string; + Const AItemTypeInfo : PTypeInfo; + Const ABounds : Array Of Integer + ); + procedure NilCurrentScope(); + function IsCurrentScopeNil():Boolean; + procedure EndScope(); + procedure AddScopeAttribute(Const AName,AValue : string); + //If the scope is an array the return value must be the array' length; + function BeginScopeRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo; + const AScopeType : TScopeType = stObject + ):Integer; + procedure EndScopeRead(); + + procedure BeginHeader(); + procedure EndHeader(); + + property CurrentScope : String Read GetCurrentScope; + + procedure Put( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData + ); + procedure Get( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData + ); + + procedure SaveToStream(AStream : TStream); + procedure LoadFromStream(AStream : TStream); + + procedure Error(Const AMsg:string); + procedure Error(Const AMsg:string; Const AArgs : array of const); + End; + + TDBGPinterProc = procedure(const AMsg:string); + + procedure ClearObj(const AOwner: PDataBuffer); + function LoadObjectFromStream(const AStoreRdr : IDataStoreReader):PDataBuffer; + procedure SaveObjectToStream(const ARoot: PDataBuffer; const ADest : IDataStore); + function CreateArrayBuffer( + const ALength : Integer; + const AName : TDataName; + const AOwner : PDataBuffer = nil + ):PDataBuffer; + function CreateObjBuffer( + const ADataType : TDataType; + const AName : TDataName; + const AOwner : PDataBuffer = nil + ):PDataBuffer; + + procedure PrintObj(const ARoot: PDataBuffer; const ALevel : Integer; const APrinterProc : TDBGPinterProc); + +implementation + +procedure PrintObj(const ARoot: PDataBuffer; const ALevel : Integer; const APrinterProc : TDBGPinterProc); +Var + p : PObjectBufferItem; + s : string; + i ,j: Integer; +Begin + If Not Assigned(ARoot) Then + Exit; + s := StringOfChar(' ',ALevel); + Case ARoot^.DataType Of + dtInt8S : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int8S) ); + dtInt8U : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int8U) ); + dtInt32U : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int32U) ); + dtInt32S : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int32S) ); + dtInt64U : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int64U) ); + dtInt64S : APrinterProc( s + ARoot^.Name + ' = ' + IntToStr(ARoot^.Int64S) ); + + dtSingle : APrinterProc( s + ARoot^.Name + ' = ' + FloatToStr(ARoot^.SingleData) ); + dtDouble : APrinterProc( s + ARoot^.Name + ' = ' + FloatToStr(ARoot^.DoubleData) ); + dtExtended : APrinterProc( s + ARoot^.Name + ' = ' + FloatToStr(ARoot^.ExtendedData) ); + dtCurrency : APrinterProc( s + ARoot^.Name + ' = ' + FloatToStr(ARoot^.CurrencyData) ); + + dtString : APrinterProc( s + ARoot^.Name + ' = ' + ARoot^.StrData^.Data ); + dtObject : + Begin + APrinterProc( s + ARoot^.Name + ' = '); + If Not Assigned(ARoot^.ObjectData) Then Begin + APrinterProc(s + ' '); + End Else Begin + APrinterProc('( ' + IntToStr(ARoot^.ObjectData^.Count) + ' Objects )'); + p := ARoot^.ObjectData^.Head; + i := ALevel + 1; + While Assigned(p) Do Begin + PrintObj(p^.Data,i,APrinterProc); + p := p^.Next; + End; + End; + End; + dtArray : + Begin + APrinterProc( s + ARoot^.Name + ' = '); + If Not Assigned(ARoot^.ArrayData) Then Begin + APrinterProc(s + ' '); + End Else Begin + j := ARoot^.ArrayData^.Count; + APrinterProc('( Objects[ '+ IntToStr(j)+ '] )'); + i := ALevel + 1; + For j := 0 To Pred(j) Do Begin + PrintObj(ARoot^.ArrayData^.Items^[j],i,APrinterProc); + End; + End; + End; + End; +End; + +function FindObj(const AOwner: PDataBuffer; const AName : TDataName) : PDataBuffer; +Var + p : PObjectBufferItem; +Begin + Assert(AOwner^.DataType >= dtObject); + Result := Nil; + p:= AOwner^.ObjectData^.Head; + While Assigned(p) Do Begin + If AnsiSameText(AName,p^.Data^.Name) Then Begin + Result := p^.Data; + Exit; + End; + p := p^.Next; + End; +End; + +procedure AddObj( + const AOwner, AChildData: PDataBuffer; + const AIndex : Integer = -1 +); +Var + p : PObjectBufferItem; +Begin + If ( AOwner^.DataType = dtObject ) Then Begin + p := GetMem(SizeOf(PObjectBufferItem^)); + p^.Data := AChildData; + p^.Next := Nil; + If Assigned(AOwner^.ObjectData^.Head) Then Begin + AOwner^.ObjectData^.Last^.Next := p; + End Else Begin + AOwner^.ObjectData^.Head := p; + End; + AOwner^.ObjectData^.Last := p; + Inc(AOwner^.ObjectData^.Count); + End Else If ( AOwner^.DataType = dtArray ) Then Begin + If ( AIndex >= 0 ) And ( AIndex < AOwner^.ArrayData^.Count ) Then + AOwner^.ArrayData^.Items^[AIndex] := AChildData + Else + Raise EBinaryFormatterException.CreateFmt('Invalid array acces : %d',[AIndex]) + End Else Begin + Raise EBinaryFormatterException.CreateFmt('Invalid data type in this context : %d',[Ord(AOwner^.DataType)]) + End; +End; + +function CreateObjBuffer( + const ADataType : TDataType; + const AName : TDataName; + const AOwner : PDataBuffer = nil +):PDataBuffer; +var + resLen, i : Integer; +begin + resLen := SizeOf(PDataBuffer^); + Result := GetMem(resLen); + Try + FillChar(Result^,resLen,#0); + Result^.Name := AName; + Result^.DataType := ADataType; + Case Result^.DataType Of + dtString : + Begin + i := SizeOf(PStringBuffer^); + Result^.StrData := GetMem(i); + FillChar(Result^.StrData^,i,#0); + Result^.StrData^.Data := ''; + End; + dtObject : + Begin + Result^.ObjectData := GetMem(SizeOf(PObjectBuffer^)); + FillChar(Result^.ObjectData^,SizeOf(PObjectBuffer^),#0); + End; + End; + If Assigned(AOwner) Then + AddObj(AOwner,Result); + Except + Freemem(Result,resLen); + Result := nil; + Raise; + End; +end; + +function CreateArrayBuffer( + const ALength : Integer; + const AName : TDataName; + const AOwner : PDataBuffer = nil +):PDataBuffer; +Var + i, resLen : Integer; +begin + Assert(ALength>=0); + resLen := SizeOf(PDataBuffer^); + Result := GetMem(resLen); + Try + FillChar(Result^,resLen,#0); + Result^.Name := AName; + Result^.DataType := dtArray; + Result^.ArrayData := GetMem(SizeOf(PArrayBuffer^)); + FillChar(Result^.ArrayData^,SizeOf(PArrayBuffer^),#0); + Result^.ArrayData^.Count := ALength; + If ( ALength > 0 ) Then Begin + i := ALength*SizeOf(PDataBuffer); + Result^.ArrayData^.Items := GetMem(i); + FillChar(Result^.ArrayData^.Items^[0],i,#0); + End Else Begin + Result^.ArrayData^.Items := Nil; + End; + If Assigned(AOwner) Then + AddObj(AOwner,Result); + Except + Freemem(Result,resLen); + Result := nil; + Raise; + End; +end; + +procedure SaveObjectToStream(const ARoot: PDataBuffer; const ADest : IDataStore); +Var + p : PObjectBufferItem; + i : TInt32S; +Begin + If Not Assigned(ARoot) Then + Exit; + i := Ord(ARoot^.DataType); + ADest.WriteInt32S(i); + ADest.WriteStr(ARoot^.Name); + Case ARoot^.DataType Of + dtInt8S : ADest.WriteInt8S(ARoot^.Int8S); + dtInt8U : ADest.WriteInt8U(ARoot^.Int8U); + dtInt16U : ADest.WriteInt16U(ARoot^.Int16U); + dtInt16S : ADest.WriteInt16S(ARoot^.Int16S); + dtInt32U : ADest.WriteInt32U(ARoot^.Int32U); + dtInt32S : ADest.WriteInt32S(ARoot^.Int32S); + dtInt64U : ADest.WriteInt64U(ARoot^.Int64U); + dtInt64S : ADest.WriteInt64S(ARoot^.Int64S); + + dtSingle : ADest.WriteSingle(ARoot^.SingleData); + dtDouble : ADest.WriteDouble(ARoot^.DoubleData); + dtExtended : ADest.WriteExtended(ARoot^.ExtendedData); + dtCurrency : ADest.WriteCurrency(ARoot^.CurrencyData); + + dtString : ADest.WriteStr(ARoot^.StrData^.Data); + dtBool : ADest.WriteBool(ARoot^.BoolData); + dtEnum : ADest.WriteEnum(ARoot^.EnumData); + dtObject : + Begin + i := ARoot^.ObjectData^.Count; + ADest.WriteInt32S(i); + + If ( i > 0 ) Then Begin + p := ARoot^.ObjectData^.Head; + For i := 1 To i Do Begin + SaveObjectToStream(p^.Data,ADest); + p := p^.Next; + End; + End; + End; + dtArray : + Begin + i := ARoot^.ArrayData^.Count; + ADest.WriteInt32S(i); + + If ( i > 0 ) Then Begin + For i := 0 To Pred(i) Do Begin + SaveObjectToStream(ARoot^.ArrayData^.Items^[i],ADest); + End; + End; + End; + End; +End; + +function LoadObjectFromStream(const AStoreRdr : IDataStoreReader):PDataBuffer; +Var + i : TInt32S; + s : string; +Begin + Result := Nil; + If AStoreRdr.IsAtEof() Then + Exit; + i := AStoreRdr.ReadInt32S(); + s := AStoreRdr.ReadStr(); + If ( TDataType(i) < dtArray ) Then + Result := CreateObjBuffer(TDataType(i),s); + Case TDataType(i) Of + dtInt8S : Result^.Int8S := AStoreRdr.ReadInt8S(); + dtInt8U : Result^.Int8S := AStoreRdr.ReadInt8U(); + dtInt16U : Result^.Int16U := AStoreRdr.ReadInt16U(); + dtInt16S : Result^.Int16S := AStoreRdr.ReadInt16S(); + dtInt32U : Result^.Int32U := AStoreRdr.ReadInt32U(); + dtInt32S : Result^.Int32S := AStoreRdr.ReadInt32S(); + dtInt64U : Result^.Int64U := AStoreRdr.ReadInt64U(); + dtInt64S : Result^.Int64S := AStoreRdr.ReadInt64S(); + + dtSingle : Result^.SingleData := AStoreRdr.ReadSingle(); + dtDouble : Result^.DoubleData := AStoreRdr.ReadDouble(); + dtExtended : Result^.ExtendedData := AStoreRdr.ReadExtended(); + dtCurrency : Result^.CurrencyData := AStoreRdr.ReadCurrency(); + + dtString : Result^.StrData^.Data := AStoreRdr.ReadStr(); + dtBool : Result^.BoolData := AStoreRdr.ReadBool(); + dtEnum : Result^.EnumData := AStoreRdr.ReadEnum(); + dtObject : + Begin + i := AStoreRdr.ReadInt32S(); + For i := 1 To i Do Begin + AddObj(Result,LoadObjectFromStream(AStoreRdr)); + End; + End; + dtArray : + Begin + i := AStoreRdr.ReadInt32S(); + Result := CreateArrayBuffer(i,s); + For i := 0 To Pred(i) Do Begin + AddObj(Result,LoadObjectFromStream(AStoreRdr),i); + End; + End; + End; +End; + +procedure ClearObjectBuffer(var ABuffer : PObjectBuffer); +var + p,q : PObjectBufferItem; +begin + if Assigned(ABuffer) then begin + if Assigned(ABuffer^.Attributes) then + ClearObjectBuffer(ABuffer^.Attributes); + p := ABuffer^.Head; + while Assigned(p) do begin + q := p; + p := p^.Next; + ClearObj(q^.Data); + Freemem(q^.Data); + q^.Data := Nil; + Freemem(q); + end; + //ABuffer^.Head := nil; + //ABuffer^.Last := nil; + Freemem(ABuffer); + ABuffer := nil; + end; +end; + +procedure ClearObj(const AOwner: PDataBuffer); +Var + i , j: Integer; + eltLen : Integer; +Begin + AOwner^.Name := ''; + Case AOwner^.DataType Of + dtString : + Begin + AOwner^.StrData^.Data := ''; + Freemem(AOwner^.StrData); + AOwner^.StrData := Nil; + End; + dtObject : + Begin + ClearObjectBuffer(AOwner^.ObjectData); + End; + dtArray : + Begin + eltLen := SizeOf(PDataBuffer^); + For j := 0 to Pred(AOwner^.ArrayData^.Count) Do Begin + ClearObj(AOwner^.ArrayData^.Items^[j]); + Freemem(AOwner^.ArrayData^.Items^[j],eltLen); + AOwner^.ArrayData^.Items^[j] := Nil; + End; + i := AOwner^.ArrayData^.Count * SizeOf(PDataBuffer); + Freemem(AOwner^.ArrayData^.Items,i); + AOwner^.ArrayData^.Items := Nil; + ClearObjectBuffer(AOwner^.ArrayData^.Attributes); + i := SizeOf(PArrayBuffer^); + Freemem(AOwner^.ArrayData,i); + AOwner^.ArrayData := Nil; + End; + End; +End; + + +{ TStackItem } + +constructor TStackItem.Create(const AScopeObject: PDataBuffer; AScopeType: TScopeType); +begin + Assert(Assigned(AScopeObject)); + FScopeObject := AScopeObject; + FScopeType := AScopeType; +end; + +{ TObjectStackItem } + +constructor TObjectStackItem.Create(const AScopeObject: PDataBuffer); +begin + Inherited Create(AScopeObject,stObject); +end; + +function TObjectStackItem.GetItemCount(): Integer; +begin + Result := ScopeObject^.ObjectData^.Count; +end; + +function TObjectStackItem.Find(var AName: TDataName): PDataBuffer; +begin + Result := FindObj(ScopeObject,AName); +end; + +function TObjectStackItem.GetByIndex(const AIndex: Integer): PDataBuffer; +Var + p : PObjectBufferItem; + i : Integer; +begin + If ( AIndex >=0 ) And ( AIndex < ScopeObject^.ObjectData^.Count) Then Begin + p := ScopeObject^.ObjectData^.Head; + For i := 1 To AIndex Do + p := p^.Next; + Result := p^.Data; + End Else + Raise EBinaryFormatterException.CreateFmt('Invalid index access : %d',[AIndex]); +end; + +function TObjectStackItem.CreateBuffer( + Const AName : String; + const ADataType : TDataType +):PDataBuffer; +begin + Result := CreateObjBuffer(ADataType,AName,ScopeObject); +end; + +procedure TObjectStackItem.NilCurrentScope(); +begin + Assert(ScopeObject^.ObjectData^.Count = 0); + ScopeObject^.ObjectData^.NilObject := True; +end; + +function TObjectStackItem.IsCurrentScopeNil(): Boolean; +begin + Result:= ScopeObject^.ObjectData^.NilObject; +end; + +//---------------------------------------------------------------- +{ TBaseBinaryFormatter } + +procedure TBaseBinaryFormatter.ClearStack(); +Var + i, c : Integer; +begin + c := FStack.Count; + For I := 1 To c Do + FStack.Pop().Free(); +end; + +procedure TBaseBinaryFormatter.PushStack(AScopeObject: PDataBuffer;const AScopeType: TScopeType); +begin + If ( AScopeType = stObject ) Then + FStack.Push(TObjectStackItem.Create(AScopeObject)) + Else If ( AScopeType = stArray ) Then + FStack.Push(TArrayStackItem.Create(AScopeObject)) + Else + Assert(False); +end; + +function TBaseBinaryFormatter.StackTop(): TStackItem; +begin + Result := FStack.Peek() as TStackItem; +end; + +function TBaseBinaryFormatter.PopStack(): TStackItem; +begin + Result := FStack.Pop() as TStackItem; +end; + +function TBaseBinaryFormatter.GetRootData(): PDataBuffer; +begin + Result := FRootData; +end; + +procedure TBaseBinaryFormatter.PutFloat( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : TFloat_Extended_10 +); +begin + Case GetTypeData(ATypeInfo)^.FloatType Of + ftSingle : StackTop().CreateBuffer(AName,dtSingle)^.SingleData := AData; + ftDouble : StackTop().CreateBuffer(AName,dtDouble)^.DoubleData := AData; + ftExtended : StackTop().CreateBuffer(AName,dtExtended)^.ExtendedData := AData; + ftCurr : StackTop().CreateBuffer(AName,dtCurrency)^.CurrencyData := AData; + Else + StackTop().CreateBuffer(AName,dtExtended)^.ExtendedData := AData; + End; +end; + +function TBaseBinaryFormatter.GetCurrentScopeObject(): PDataBuffer; +begin + Result := StackTop().ScopeObject; +end; + +procedure TBaseBinaryFormatter.SetSerializationStyle( + const ASerializationStyle: TSerializationStyle +); +begin + FSerializationStyle := ASerializationStyle; +end; + +function TBaseBinaryFormatter.GetSerializationStyle(): TSerializationStyle; +begin + Result := FSerializationStyle; +end; + +function TBaseBinaryFormatter.HasScope(): Boolean; +begin + Result := Assigned(FStack.Peek); +end; + +procedure TBaseBinaryFormatter.CheckScope(); +begin + If Not HasScope() Then + Error('There is no scope.'); +end; + +function TBaseBinaryFormatter.GetCurrentScope: String; +begin + Result := GetCurrentScopeObject()^.Name; +end; + +procedure TBaseBinaryFormatter.PutInt( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : TInt64S +); +begin + Case GetTypeData(ATypeInfo)^.OrdType Of + otSByte : StackTop().CreateBuffer(AName,dtInt8S)^.Int8S := AData; + otUByte : StackTop().CreateBuffer(AName,dtInt8U)^.Int8U := AData; + otSWord : StackTop().CreateBuffer(AName,dtInt16S)^.Int16S := AData; + otUWord : StackTop().CreateBuffer(AName,dtInt16U)^.Int16U := AData; + otULong : StackTop().CreateBuffer(AName,dtInt32U)^.Int32U := AData; + otSLong : StackTop().CreateBuffer(AName,dtInt32S)^.Int32S := AData; + End; +end; + +procedure TBaseBinaryFormatter.PutStr( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : String +); +begin + StackTop().CreateBuffer(AName,dtString)^.StrData^.Data := AData; +end; + +procedure TBaseBinaryFormatter.PutEnum( + const AName: String; + const ATypeInfo: PTypeInfo; + const AData: TEnumData +); +begin + StackTop().CreateBuffer(AName,dtEnum)^.EnumData := AData; +end; + +procedure TBaseBinaryFormatter.PutBool( + const AName: String; + const ATypeInfo: PTypeInfo; + const AData: Boolean +); +begin + StackTop().CreateBuffer(AName,dtBool)^.BoolData := AData; +end; + +procedure TBaseBinaryFormatter.PutInt64( + const AName: String; + const ATypeInfo: PTypeInfo; + const AData: Int64 +); +begin + StackTop().CreateBuffer(AName,dtInt64S)^.Int64S := AData; +end; + +procedure TBaseBinaryFormatter.PutObj( + const AName: String; + const ATypeInfo: PTypeInfo; + const AData: TObject +); +begin + TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Save(AData As TBaseRemotable, Self,AName,ATypeInfo); +end; + +function TBaseBinaryFormatter.GetDataBuffer(var AName: String): PDataBuffer; +begin + Result := StackTop().Find(AName); + If Not Assigned(Result) Then + Error('Param not found : "%s"',[AName]); +end; + +procedure TBaseBinaryFormatter.GetEnum( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: TEnumData +); +begin + AData := GetDataBuffer(AName)^.EnumData; +end; + +procedure TBaseBinaryFormatter.GetBool( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: Boolean +); +begin + AData := GetDataBuffer(AName)^.BoolData; +end; + +procedure TBaseBinaryFormatter.GetFloat( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : TFloat_Extended_10 +); +Var + t : PDataBuffer; +begin + t := GetDataBuffer(AName); + Case GetTypeData(ATypeInfo)^.FloatType Of + ftSingle : AData := t^.SingleData; + ftDouble : AData := t^.DoubleData; + ftExtended : AData := t^.ExtendedData; + ftCurr : AData := t^.CurrencyData; + Else + AData := t^.ExtendedData; + End; +end; + +procedure TBaseBinaryFormatter.GetInt( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: TInt64S +); +Var + t : PDataBuffer; +begin + t := GetDataBuffer(AName); + Case GetTypeData(ATypeInfo)^.OrdType Of + otSByte : AData := t^.Int8S; + otUByte : AData := t^.Int8U; + otSWord : AData := t^.Int16S; + otUWord : AData := t^.Int16U; + otSLong : AData := t^.Int32S; + otULong : AData := t^.Int32U; + Else + Assert(False); + End; +end; + +procedure TBaseBinaryFormatter.GetInt64( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: Int64 +); +begin + AData := GetDataBuffer(AName)^.Int64S; +end; + +procedure TBaseBinaryFormatter.GetStr( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: String +); +begin + AData := GetDataBuffer(AName)^.StrData^.Data; +end; + +procedure TBaseBinaryFormatter.GetObj( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: TObject +); +begin + TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); +end; + +procedure TBaseBinaryFormatter.Clear(); +begin + ClearStack(); + ClearObj(FRootData); + Freemem(FRootData); + FRootData := CreateObjBuffer(dtObject,sROOT); + PushStack(FRootData,stObject); +end; + +procedure TBaseBinaryFormatter.BeginArray(const AName: string;const AItemTypeInfo: PTypeInfo; const ABounds: array of Integer); +Var + i, j, k : Integer; +begin + If ( Length(ABounds) < 2 ) Then + Raise EBinaryFormatterException.Create('Invalid array bounds.'); + i := ABounds[0]; + j := ABounds[1]; + k := ( j - i + 1 ); + If ( k < 0 ) Then + Raise EBinaryFormatterException.Create('Invalid array bounds.'); + PushStack(CreateArrayBuffer(k,AName,StackTop().ScopeObject),stArray); +end; + +procedure TBaseBinaryFormatter.NilCurrentScope(); +begin + CheckScope(); + StackTop().NilCurrentScope(); +end; + +function TBaseBinaryFormatter.IsCurrentScopeNil(): Boolean; +begin + Result := StackTop().IsCurrentScopeNil(); +end; + +procedure TBaseBinaryFormatter.BeginObject(const AName: TDataName;const ATypeInfo: PTypeInfo); +begin + PushStack(StackTop().CreateBuffer(AName,dtObject)); +end; + +procedure TBaseBinaryFormatter.EndScope(); +begin + FStack.Pop().Free(); +end; + +procedure TBaseBinaryFormatter.AddScopeAttribute(const AName, AValue: string); +begin +end; + +function TBaseBinaryFormatter.BeginScopeRead( + var AScopeName : string; + const ATypeInfo : PTypeInfo; + const AScopeType : TScopeType = stObject +): Integer; +Var + locNode : PDataBuffer; + stk : TStackItem; +begin + stk := StackTop(); + locNode := stk.Find(AScopeName); + If Not Assigned(locNode) Then + Error('Scope not found : "%s"',[AScopeName]); + PushStack(locNode,AScopeType); + Result := StackTop().GetItemCount(); +end; + +procedure TBaseBinaryFormatter.EndScopeRead(); +begin + PopStack().Free(); +end; + +procedure TBaseBinaryFormatter.BeginHeader(); +begin +{$IFDEF wst_binary_header} + if ( FHeaderEnterCount <= 0 ) then begin + Inc(FHeaderEnterCount); + BeginObject(sHEADER,nil); + end; +{$ENDIF} +end; + +procedure TBaseBinaryFormatter.EndHeader(); +begin +{$IFDEF wst_binary_header} + if ( FHeaderEnterCount > 0 ) then begin + Dec(FHeaderEnterCount); + EndScope(); + end; +{$ENDIF} +end; + +procedure TBaseBinaryFormatter.Put(const AName: String; const ATypeInfo: PTypeInfo;const AData); +Var + intData : Integer; + int64Data : Int64; + strData : string; + objData : TObject; + boolData : Boolean; + enumData : TEnumData; + floatDt : TFloat_Extended_10; +begin + Case ATypeInfo^.Kind Of + tkLString, tkAString : + Begin + strData := String(AData); + PutStr(AName,ATypeInfo,strData); + End; + tkInt64,tkQWord : + Begin + int64Data := Int64(AData); + PutInt64(AName,ATypeInfo,int64Data); + End; + tkClass : + Begin + objData := TObject(AData); + PutObj(AName,ATypeInfo,objData); + End; + tkBool : + Begin + boolData := Boolean(AData); + PutBool(AName,ATypeInfo,boolData); + End; + tkInteger, tkEnumeration : + Begin + enumData := 0; + Case GetTypeData(ATypeInfo)^.OrdType Of + otSByte : enumData := ShortInt(AData); + otUByte : enumData := Byte(AData); + otSWord : enumData := SmallInt(AData); + otUWord : enumData := Word(AData); + otSLong : enumData := LongInt(AData); + otULong : enumData := LongWord(AData); + End; + If ( ATypeInfo^.Kind = tkInteger ) Then + PutInt(AName,ATypeInfo,enumData) + Else + PutEnum(AName,ATypeInfo,enumData); + End; + tkFloat : + Begin + floatDt := 0; + Case GetTypeData(ATypeInfo)^.FloatType Of + ftSingle : floatDt := Single(AData); + ftDouble : floatDt := Double(AData); + ftExtended : floatDt := Extended(AData); + ftCurr : floatDt := Currency(AData); + ftComp : floatDt := Comp(AData); + End; + PutFloat(AName,ATypeInfo,floatDt); + End; + End; +end; + +procedure TBaseBinaryFormatter.Get( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData +); +Var + int64Data : Int64; + strData : string; + objData : TObject; + boolData : Boolean; + enumData : TEnumData; + floatDt : TFloat_Extended_10; +begin + Case ATypeInfo^.Kind Of + tkInt64, tkQWord : + Begin + int64Data := 0; + GetInt64(ATypeInfo,AName,int64Data); + Int64(AData) := int64Data; + End; + tkLString, tkAString : + Begin + strData := ''; + GetStr(ATypeInfo,AName,strData); + String(AData) := strData; + End; + tkClass : + Begin + objData := TObject(AData); + GetObj(ATypeInfo,AName,objData); + TObject(AData) := objData; + End; + tkBool : + Begin + boolData := False; + GetBool(ATypeInfo,AName,boolData); + Boolean(AData) := boolData; + End; + tkInteger, tkEnumeration : + Begin + enumData := 0; + If ( ATypeInfo^.Kind = tkInteger ) Then + GetInt(ATypeInfo,AName,enumData) + Else + GetEnum(ATypeInfo,AName,enumData); + Case GetTypeData(ATypeInfo)^.OrdType Of + otSByte : ShortInt(AData) := enumData; + otUByte : Byte(AData) := enumData; + otSWord : SmallInt(AData) := enumData; + otUWord : Word(AData) := enumData; + otSLong : LongInt(AData) := enumData; + otULong : LongWord(AData) := enumData; + End; + End; + tkFloat : + Begin + floatDt := 0; + GetFloat(ATypeInfo,AName,floatDt); + Case GetTypeData(ATypeInfo)^.FloatType Of + ftSingle : Single(AData) := floatDt; + ftDouble : Double(AData) := floatDt; + ftExtended : Extended(AData) := floatDt; + ftCurr : Currency(AData) := floatDt; + ftComp : Comp(AData) := floatDt; + End; + End; + End; +end; + +procedure TBaseBinaryFormatter.SaveToStream(AStream: TStream); +Var + locStore : IDataStore; +begin + locStore := CreateBinaryWriter(AStream); + SaveObjectToStream(FRootData,locStore); +end; + +procedure TBaseBinaryFormatter.LoadFromStream(AStream: TStream); +Var + locRdr : IDataStoreReader; + tmpRoot : PDataBuffer; +begin + locRdr := CreateBinaryReader(AStream); + tmpRoot := LoadObjectFromStream(locRdr); + + ClearStack(); + ClearObj(FRootData); + Freemem(FRootData); + FRootData := tmpRoot; + PushStack(FRootData,stObject); +end; + +procedure TBaseBinaryFormatter.Error(const AMsg: string); +begin + Raise EBinaryFormatterException.Create(AMsg); +end; + +procedure TBaseBinaryFormatter.Error(const AMsg: string;const AArgs: array of const); +begin + Raise EBinaryFormatterException.CreateFmt(AMsg,AArgs); +end; + +constructor TBaseBinaryFormatter.Create(); +begin + FRootData := CreateObjBuffer(dtObject,sROOT); + FStack := TObjectStack.Create(); + PushStack(FRootData,stObject); +end; + +destructor TBaseBinaryFormatter.Destroy(); +begin + ClearStack(); + FreeAndNil(FStack); + ClearObj(FRootData); + Freemem(FRootData); + inherited Destroy(); +end; + +{ TArrayStackItem } + +constructor TArrayStackItem.Create(const AScopeObject: PDataBuffer); +begin + Inherited Create(AScopeObject,stArray); + FIndex := 0; +end; + +function TArrayStackItem.GetItemCount(): Integer; +begin + Result := ScopeObject^.ArrayData^.Count; +end; + +function TArrayStackItem.Find(var AName: TDataName): PDataBuffer; +begin + If ( FIndex >= 0 ) And ( FIndex < ScopeObject^.ArrayData^.Count ) Then + Result := ScopeObject^.ArrayData^.Items^[FIndex] + Else + Raise EBinaryFormatterException.CreateFmt('Invalid array index : %d',[FIndex]); + Inc(FIndex); +end; + +function TArrayStackItem.GetByIndex(const AIndex: Integer): PDataBuffer; +begin + If ( AIndex >= 0 ) And ( AIndex < ScopeObject^.ArrayData^.Count ) Then + Result := ScopeObject^.ArrayData^.Items^[AIndex] + Else + Raise EBinaryFormatterException.CreateFmt('Invalid array index : %d',[AIndex]); +end; + +function TArrayStackItem.CreateBuffer( + const AName : String; + const ADataType : TDataType +): PDataBuffer; +begin + If ( FIndex >= 0 ) And ( FIndex < ScopeObject^.ArrayData^.Count ) Then + Result := CreateObjBuffer(ADataType,AName,Nil) + Else + Raise EBinaryFormatterException.CreateFmt('Invalid array index : %d',[FIndex]); + ScopeObject^.ArrayData^.Items^[FIndex] := Result; + Inc(FIndex); +end; + +procedure TArrayStackItem.NilCurrentScope(); +begin +end; + +function TArrayStackItem.IsCurrentScopeNil(): Boolean; +begin + Result := False; +end; + +end. diff --git a/wst/tags/3.1/base_service_intf.pas b/wst/tags/3.1/base_service_intf.pas new file mode 100644 index 000000000..a4e923bed --- /dev/null +++ b/wst/tags/3.1/base_service_intf.pas @@ -0,0 +1,2858 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit base_service_intf; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, Contnrs; + +const + stBase = 0; + stObject = stBase + 1; + stArray = stBase + 2; + +Type + TScopeType = Integer; + THeaderDirection = ( hdOut, hdIn ); + THeaderDirections = set of THeaderDirection; +const + AllHeaderDirection = [Low(THeaderDirection)..High(THeaderDirection)]; + +type + + EServiceException = class(Exception) + End; + + EBaseRemoteException = class(EServiceException) + private + FFaultCode: string; + FFaultString: string; + Published + property FaultCode : string Read FFaultCode Write FFaultCode; + property FaultString : string Read FFaultString Write FFaultString; + End; + + ETypeRegistryException = class(EServiceException) + End; + + IItemFactory = Interface; + IFormatterBase = Interface; + IFormatterRegistry = Interface; + + TBaseRemotable = class; + THeaderBlock = class; + + //Utility interface used to configure its parent. + IPropertyManager = Interface + ['{A3A6B8F4-E50D-4956-B416-C642C72E4672}'] + procedure SetProperty(Const AName,AValue:string); + procedure SetProperties(Const APropsStr:string); + function GetProperty(Const AName:String):string; + function GetPropertyNames(ADest : TStrings):Integer; + procedure Clear(); + procedure Copy(ASource:IPropertyManager; Const AClearBefore : Boolean); + End; + + IItemFactory = interface + ['{38258BC0-CBE6-437B-B104-9A62475E53AC}'] + function CreateInstance():IInterface; + end; + + IItemFactoryEx = interface(IItemFactory) + ['{66B77926-7E45-4780-8FFB-FB78625EDC1D}'] + function GetPropertyManager( + const APropertyGroup : string; + const ACreateIfNotExists : Boolean + ):IPropertyManager; + end; + + IFormatterRegistry = Interface + ['{E4D69D2A-F0A5-43E1-8C56-B47E7AB5D1AF}'] + function Find(const AFormatterName : string):IFormatterBase; + procedure Register( + const AFormatterName : string; + AFactory : IItemFactory + ); + End; + + ICallContext = Interface + ['{855EB8E2-0700-45B1-B852-2101023200E0}'] + procedure AddObjectToFree(const AObject : TObject); + procedure Clear(); + function AddHeader( + const AHeader : THeaderBlock; + const AKeepOwnership : Boolean + ):Integer; + function GetHeaderCount(const ADirections : THeaderDirections):Integer; + function GetHeader(const AIndex : Integer) : THeaderBlock; + procedure ClearHeaders(const ADirection : THeaderDirection); + End; + + TSerializationStyle = ( ssNodeSerialization, ssAttibuteSerialization ); + + IFormatterBase = Interface + ['{2AB3BF54-B7D6-4C46-8245-133C8775E9C1}'] + procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); + function GetSerializationStyle():TSerializationStyle; + function GetCurrentScope():string; + procedure Clear(); + + procedure BeginObject( + Const AName : string; + Const ATypeInfo : PTypeInfo + ); + procedure BeginArray( + Const AName : string; + Const AItemTypeInfo : PTypeInfo; + Const ABounds : Array Of Integer + ); + procedure NilCurrentScope(); + function IsCurrentScopeNil():Boolean; + procedure EndScope(); + procedure AddScopeAttribute(Const AName,AValue : string); + //If the scope is an array the return value must be the array' length; + function BeginScopeRead( + Var AScopeName : string; + Const ATypeInfo : PTypeInfo; + Const AScopeType : TScopeType = stObject + ):Integer; + procedure EndScopeRead(); + property CurrentScope : String Read GetCurrentScope; + + procedure BeginHeader(); + procedure EndHeader(); + + procedure Put( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData + ); + procedure Get( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData + ); + + procedure SaveToStream(AStream : TStream); + procedure LoadFromStream(AStream : TStream); + + // This procedures will raise exceptions!!! + procedure Error(Const AMsg:string); + procedure Error(Const AMsg:string; Const AArgs : array of const); + End; + + { TSimpleCallContext } + + TSimpleCallContext = class(TInterfacedObject,ICallContext) + private + FHeaderList : TObjectList; + FFreeObjectList : TObjectList; + protected + procedure AddObjectToFree(const AObject : TObject); + procedure Clear(); + function AddHeader( + const AHeader : THeaderBlock; + const AKeepOwnership : Boolean + ):Integer; + function GetHeaderCount(const ADirections : THeaderDirections):Integer; + function GetHeader(const AIndex : Integer) : THeaderBlock; + procedure ClearHeaders(const ADirection : THeaderDirection); + procedure FreeHeader(AHeader : THeaderBlock); + Public + constructor Create(); + destructor Destroy();override; + End; + + { TBaseRemotable } + TBaseRemotableClass = class of TBaseRemotable; + TBaseRemotable = class(TPersistent) + Public + constructor Create();virtual; + class procedure Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + Const AName : String; + Const ATypeInfo : PTypeInfo + );virtual;abstract; + class procedure Load( + Var AObject : TObject; + AStore : IFormatterBase; + var AName : String; + const ATypeInfo : PTypeInfo + );virtual;abstract; + End; + + TAbstractSimpleRemotableClass = class of TAbstractSimpleRemotable; + TAbstractSimpleRemotable = class(TBaseRemotable) + end; + + TAbstractComplexRemotableClass = class of TAbstractComplexRemotable; + TAbstractComplexRemotable = class(TBaseRemotable) + end; + + TBaseComplexRemotableClass = class of TBaseComplexRemotable; + + { TBaseComplexRemotable } + + TBaseComplexRemotable = class(TAbstractComplexRemotable) + public + class procedure Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo + );override; + class procedure Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : string; + const ATypeInfo : PTypeInfo + );override; + class procedure RegisterAttributeProperty(const AProperty : shortstring);virtual; + class procedure RegisterAttributeProperties(const APropertList : array of shortstring);virtual; + class function IsAttributeProperty(const AProperty : shortstring):Boolean; + procedure Assign(Source: TPersistent); override; + end; + + + THeaderBlockClass = class of THeaderBlock; + + { THeaderBlock } + + THeaderBlock = class(TBaseComplexRemotable) + private + FDirection: THeaderDirection; + FmustUnderstand: Integer; + FUnderstood: Boolean; + function HasmustUnderstand: boolean; + procedure SetmustUnderstand(const AValue: Integer); + public + property Direction : THeaderDirection read FDirection write FDirection; + property Understood : Boolean read FUnderstood write FUnderstood; + published + property mustUnderstand : Integer read FmustUnderstand write SetmustUnderstand stored HasmustUnderstand; + end; + + TBaseArrayRemotableClass = class of TBaseArrayRemotable; + + { TBaseArrayRemotable } + + TBaseArrayRemotable = class(TAbstractComplexRemotable) + protected + procedure CheckIndex(const AIndex : Integer); + function GetLength():Integer;virtual;abstract; + public + class function GetItemTypeInfo():PTypeInfo;virtual;abstract; + destructor Destroy();override; + + procedure SetLength(const ANewSize : Integer);virtual;abstract; + property Length : Integer Read GetLength; + End; + + { TBaseObjectArrayRemotable + An implementation for array handling. The array items are "owned" by + this class instance, so one has not to free them. + } + TBaseObjectArrayRemotable = class(TBaseArrayRemotable) + Private + FArray : Array Of TBaseRemotable; + Protected + function GetItem(AIndex: Integer): TBaseRemotable; + function GetLength():Integer;override; + Public + class procedure Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + Const AName : String; + Const ATypeInfo : PTypeInfo + );override; + class procedure Load( + Var AObject : TObject; + AStore : IFormatterBase; + var AName : String; + const ATypeInfo : PTypeInfo + );override; + + class function GetItemClass():TBaseRemotableClass;virtual;abstract; + class function GetItemTypeInfo():PTypeInfo;override; + + constructor Create();override; + + procedure SetLength(Const ANewSize : Integer);override; + Property Item[AIndex:Integer] : TBaseRemotable Read GetItem;Default; + End; + + TBaseObjectArrayRemotableClass = class of TBaseObjectArrayRemotable; + + { TBaseSimpleTypeArrayRemotable } + + TBaseSimpleTypeArrayRemotable = class(TBaseArrayRemotable) + protected + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );virtual;abstract; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );virtual;abstract; + public + class procedure Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo + );override; + class procedure Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : string; + const ATypeInfo : PTypeInfo + );override; + end; + + { TArrayOfStringRemotable } + // --------- AnsiString !!!! ---------- + TArrayOfStringRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of ansistring; + function GetItem(AIndex: Integer): ansistring; + procedure SetItem(AIndex: Integer; const AValue: ansistring); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : ansistring read GetItem write SetItem; default; + end; + + { TArrayOfBooleanRemotable } + + TArrayOfBooleanRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of Boolean; + function GetItem(AIndex: Integer): Boolean; + procedure SetItem(AIndex: Integer; const AValue: Boolean); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : Boolean read GetItem write SetItem; default; + end; + + { TArrayOfInt8URemotable } + + TArrayOfInt8URemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of Byte; + function GetItem(AIndex: Integer): Byte; + procedure SetItem(AIndex: Integer; const AValue: Byte); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : Byte read GetItem write SetItem; default; + end; + + { TArrayOfInt8SRemotable } + + TArrayOfInt8SRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of ShortInt; + function GetItem(AIndex: Integer): ShortInt; + procedure SetItem(AIndex: Integer; const AValue: ShortInt); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : ShortInt read GetItem write SetItem; default; + end; + + { TArrayOfInt16SRemotable } + + TArrayOfInt16SRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of SmallInt; + function GetItem(AIndex: Integer): SmallInt; + procedure SetItem(AIndex: Integer; const AValue: SmallInt); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : SmallInt read GetItem write SetItem; default; + end; + + { TArrayOfInt16URemotable } + + TArrayOfInt16URemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of Word; + function GetItem(AIndex: Integer): Word; + procedure SetItem(AIndex: Integer; const AValue: Word); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : Word read GetItem write SetItem; default; + end; + + { TArrayOfInt32URemotable } + + TArrayOfInt32URemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of LongWord; + function GetItem(AIndex: Integer): LongWord; + procedure SetItem(AIndex: Integer; const AValue: LongWord); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : LongWord read GetItem write SetItem; default; + end; + + { TArrayOfInt32SRemotable } + + TArrayOfInt32SRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of LongInt; + function GetItem(AIndex: Integer): LongInt; + procedure SetItem(AIndex: Integer; const AValue: LongInt); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : LongInt read GetItem write SetItem; default; + end; + + { TArrayOfInt64SRemotable } + + TArrayOfInt64SRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of Int64; + function GetItem(AIndex: Integer): Int64; + procedure SetItem(AIndex: Integer; const AValue: Int64); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : Int64 read GetItem write SetItem; default; + end; + + { TArrayOfInt64URemotable } + + TArrayOfInt64URemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of QWord; + function GetItem(AIndex: Integer): QWord; + procedure SetItem(AIndex: Integer; const AValue: QWord); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer);override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : QWord read GetItem write SetItem; default; + end; + + { TArrayOfFloatSingleRemotable } + + TArrayOfFloatSingleRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of Single; + function GetItem(AIndex: Integer): Single; + procedure SetItem(AIndex: Integer; const AValue: Single); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : Single read GetItem write SetItem; default; + end; + + { TArrayOfFloatDoubleRemotable } + + TArrayOfFloatDoubleRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of Double; + function GetItem(AIndex: Integer): Double; + procedure SetItem(AIndex: Integer; const AValue: Double); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : Double read GetItem write SetItem; default; + end; + + { TArrayOfFloatExtendedRemotable } + + TArrayOfFloatExtendedRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of Extended; + function GetItem(AIndex: Integer): Extended; + procedure SetItem(AIndex: Integer; const AValue: Extended); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : Extended read GetItem write SetItem; default; + end; + + { TArrayOfFloatCurrencyRemotable } + + TArrayOfFloatCurrencyRemotable = class(TBaseSimpleTypeArrayRemotable) + private + FData : array of Currency; + function GetItem(AIndex: Integer): Currency; + procedure SetItem(AIndex: Integer; const AValue: Currency); + protected + function GetLength():Integer;override; + procedure SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer + );override; + procedure LoadItem( + AStore : IFormatterBase; + const AIndex : Integer + );override; + public + class function GetItemTypeInfo():PTypeInfo;override; + procedure SetLength(const ANewSize : Integer);override; + property Item[AIndex:Integer] : Currency read GetItem write SetItem; default; + end; + + { TBaseFactoryRegistryItem } + // Implementation helpers + TBaseFactoryRegistryItem = class + private + FFactory: IItemFactory; + FName: string; + public + constructor Create( + const AName : string; + const AFactory : IItemFactory + ); + destructor Destroy();override; + property Name : string Read FName; + property Factory : IItemFactory Read FFactory; + End; + + { TBaseFactoryRegistry } + TBaseFactoryRegistry = class(TInterfacedObject,IInterface) + private + FList : TObjectList; + function GetCount: Integer; + function GetItem(Index: Integer): TBaseFactoryRegistryItem; + protected + function FindFactory(const AName: string): IItemFactory; + procedure Register( + const AName : string; + const AFactory : IItemFactory + ); + protected + property Count : Integer read GetCount; + property Item[Index:Integer] : TBaseFactoryRegistryItem read GetItem; + public + constructor Create(); + destructor Destroy();override; + End; + + { TSimpleFactoryItem } + + TSimpleFactoryItem = class(TInterfacedObject) + public + constructor Create();virtual; + End; + + TSimpleFactoryItemClass = class of TSimpleFactoryItem; + + { TSimpleItemFactory } + + TSimpleItemFactory = class(TInterfacedPersistent,IInterface,IItemFactory) + private + FItemClass : TSimpleFactoryItemClass; + protected + function CreateInstance():IInterface; + public + constructor Create(AItemClass : TSimpleFactoryItemClass); + End; + + { TSimpleItemFactoryEx } + + TSimpleItemFactoryEx = class(TSimpleItemFactory,IInterface,IItemFactory,IItemFactoryEx) + private + FPropertyNames : TStringList; + FProperties : IInterfaceList; + protected + function GetPropertyManager( + const APropertyGroup : string; + const ACreateIfNotExists : Boolean + ):IPropertyManager; + public + constructor Create(AItemClass : TSimpleFactoryItemClass); + destructor Destroy();override; + End; + + TTypeRegistryItemOption = ( trioNonVisibleToMetadataService ); + TTypeRegistryItemOptions = set of TTypeRegistryItemOption; + + { TTypeRegistryItem } + + TTypeRegistryItem = class + private + FDataType: PTypeInfo; + FNameSpace: string; + FDeclaredName : string; + FOptions: TTypeRegistryItemOptions; + FSynonymTable : TStringList; + public + constructor Create( + ANameSpace : string; + ADataType : PTypeInfo; + Const ADeclaredName : string = '' + ); + destructor Destroy();override; + procedure AddPascalSynonym(const ASynonym : string);//inline; + function IsSynonym(const APascalTypeName : string):Boolean;//inline; + + property DataType : PTypeInfo read FDataType; + property NameSpace : string read FNameSpace; + property DeclaredName : string read FDeclaredName; + property Options : TTypeRegistryItemOptions read FOptions write FOptions; + end; + + { TTypeRegistry } + + TTypeRegistry = class + Private + FList : TObjectList; + function GetCount: Integer; + function GetItemByIndex(Index: Integer): TTypeRegistryItem; + function GetItemByTypeInfo(Index: PTypeInfo): TTypeRegistryItem; + Public + constructor Create(); + destructor Destroy();override; + function IndexOf(Const ATypeInfo : PTypeInfo):Integer; + function Add(AItem:TTypeRegistryItem):Integer; + function Register( + Const ANameSpace : String; + Const ADataType : PTypeInfo; + Const ADeclaredName : String = '' + ):TTypeRegistryItem; + function Find(ATypeInfo : PTypeInfo; Const AExact : Boolean):TTypeRegistryItem;overload; + function Find(const APascalTypeName : string):TTypeRegistryItem;overload; + function FindByDeclaredName(const ATypeName,ANameSpace : string):TTypeRegistryItem; + Property Count : Integer Read GetCount; + Property Item[Index:Integer] : TTypeRegistryItem Read GetItemByIndex;default; + Property ItemByTypeInfo[Index:PTypeInfo] : TTypeRegistryItem Read GetItemByTypeInfo; + End; + + TPropStoreType = ( pstNever, pstOptional, pstAlways ); + + EPropertyException = class(Exception) + end; + + { TStoredPropertyManager } + + TStoredPropertyManager = class(TInterfacedObject,IPropertyManager) + private + FData : TStringList; + procedure Error(Const AMsg:string); + procedure Error(Const AMsg:string; Const AArgs : array of const); + protected + procedure SetProperty(Const AName,AValue:string); + procedure SetProperties(Const APropsStr:string); + function GetProperty(Const AName:String):string; + function GetPropertyNames(ADest : TStrings):Integer; + procedure Clear(); + procedure Copy(ASource:IPropertyManager; Const AClearBefore : Boolean); + public + constructor Create(); + destructor Destroy();override; + end; + +const + sXSD_NS = 'http://www.w3.org/2001/XMLSchema'; + sXSD = 'xsd'; + sSOAP_ENV = 'http://schemas.xmlsoap.org/soap/envelope/'; + sSOAP_ENV_ABR = 'SOAP-ENV'; + sWST_BASE_NS = 'urn:wst_base'; + + PROP_LIST_DELIMITER = ';'; + + function GetTypeRegistry():TTypeRegistry; + procedure RegisterStdTypes(); + + function IsStoredPropClass(AClass : TClass;PropInfo : PPropInfo) : TPropStoreType; + +implementation + +Var + TypeRegistryInstance : TTypeRegistry = Nil; + +function GetTypeRegistry():TTypeRegistry; +begin + If Not Assigned(TypeRegistryInstance) Then + TypeRegistryInstance := TTypeRegistry.Create(); + Result := TypeRegistryInstance; +end; + +procedure RegisterStdTypes(); +Var + r : TTypeRegistry; + ri : TTypeRegistryItem; +begin + r := GetTypeRegistry(); + r.Register(sXSD_NS,TypeInfo(Integer),'int').AddPascalSynonym('Integer'); + r.Register(sXSD_NS,TypeInfo(LongWord),'unsignedInt'); + + r.Register(sXSD_NS,TypeInfo(string),'string').AddPascalSynonym('string'); + r.Register(sXSD_NS,TypeInfo(AnsiString),'ansistring').AddPascalSynonym('ansistring'); + r.Register(sXSD_NS,TypeInfo(boolean),'boolean').AddPascalSynonym('boolean'); + + r.Register(sXSD_NS,TypeInfo(Byte),'unsignedByte').AddPascalSynonym('Byte'); + r.Register(sXSD_NS,TypeInfo(ShortInt),'byte').AddPascalSynonym('ShortInt'); + r.Register(sXSD_NS,TypeInfo(Word),'unsignedShort').AddPascalSynonym('Word'); + r.Register(sXSD_NS,TypeInfo(SmallInt),'short').AddPascalSynonym('SmallInt'); + r.Register(sXSD_NS,TypeInfo(Int64),'long').AddPascalSynonym('Int64'); + r.Register(sXSD_NS,TypeInfo(QWord),'int').AddPascalSynonym('QWord'); + + r.Register(sXSD_NS,TypeInfo(Single),'float').AddPascalSynonym('Single'); + r.Register(sXSD_NS,TypeInfo(Currency),'float').AddPascalSynonym('Currency'); + r.Register(sXSD_NS,TypeInfo(Comp),'float').AddPascalSynonym('Comp'); + r.Register(sXSD_NS,TypeInfo(Double),'double').AddPascalSynonym('Double'); + r.Register(sXSD_NS,TypeInfo(Extended),'double').AddPascalSynonym('Extended'); + + ri := r.Register(sWST_BASE_NS,TypeInfo(TBaseArrayRemotable),'TBaseArrayRemotable'); + ri.Options := ri.Options + [trioNonVisibleToMetadataService]; + + THeaderBlock.RegisterAttributeProperty('mustUnderstand'); + ri := r.Register(sSOAP_ENV,TypeInfo(THeaderBlock),'THeaderBlock'); + ri.Options := ri.Options + [trioNonVisibleToMetadataService]; + + + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfStringRemotable),'TArrayOfStringRemotable').AddPascalSynonym('TArrayOfStringRemotable'); + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfBooleanRemotable),'TArrayOfBooleanRemotable').AddPascalSynonym('TArrayOfBooleanRemotable'); + + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfInt8URemotable),'TArrayOfInt8URemotable').AddPascalSynonym('TArrayOfInt8URemotable'); + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfInt8SRemotable),'TArrayOfInt8SRemotable').AddPascalSynonym('TArrayOfInt8SRemotable'); + + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfInt16URemotable),'TArrayOfInt16URemotable').AddPascalSynonym('TArrayOfInt16URemotable'); + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfInt16SRemotable),'TArrayOfInt16SRemotable').AddPascalSynonym('TArrayOfInt16SRemotable'); + + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfInt32URemotable),'TArrayOfInt32URemotable').AddPascalSynonym('TArrayOfInt32URemotable'); + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfInt32SRemotable),'TArrayOfInt32SRemotable').AddPascalSynonym('TArrayOfInt32SRemotable'); + + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfInt64URemotable),'TArrayOfInt64URemotable').AddPascalSynonym('TArrayOfInt64URemotable'); + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfInt64SRemotable),'TArrayOfInt64SRemotable').AddPascalSynonym('TArrayOfInt64SRemotable'); + + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatSingleRemotable),'TArrayOfFloatSingleRemotable').AddPascalSynonym('TArrayOfFloatSingleRemotable'); + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatDoubleRemotable),'TArrayOfFloatDoubleRemotable').AddPascalSynonym('TArrayOfFloatDoubleRemotable'); + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatExtendedRemotable),'TArrayOfFloatExtendedRemotable').AddPascalSynonym('TArrayOfFloatExtendedRemotable'); + r.Register(sWST_BASE_NS,TypeInfo(TArrayOfFloatCurrencyRemotable),'TArrayOfFloatCurrencyRemotable').AddPascalSynonym('TArrayOfFloatCurrencyRemotable'); +end; + +function IsStoredPropClass(AClass : TClass;PropInfo : PPropInfo) : TPropStoreType; +begin + case (PropInfo^.PropProcs shr 4) and 3 of + ptfield: + Result := pstOptional; + ptconst: + begin + if LongBool(PropInfo^.StoredProc) then + Result := pstAlways + else + Result := pstNever; + end; + ptstatic, + ptvirtual: + Result := pstOptional; + end; +end; + +{ TBaseRemotable } + +constructor TBaseRemotable.Create(); +begin +end; + +{ TBaseComplexRemotable } +Type + TEnumBuffer = Record + Case TOrdType Of + otSByte : (ShortIntData : ShortInt); + otUByte : (ByteData : Byte); + otSWord : (SmallIntData : SmallInt); + otUWord : (WordData : Word); + otSLong : (SLongIntData : LongInt); + otULong : (ULongIntData : LongWord); + End; + TFloatBuffer = Record + Case TFloatType Of + ftSingle : (SingleData : Single); + ftDouble : (DoubleData : Double); + ftExtended : (ExtendedData : Extended); + ftCurr : (CurrencyData : Currency); + ftComp : (CompData : Comp); + End; + + { TSerializeOptions } + + TSerializeOptions = class + private + FAttributeFieldList : TStringList; + private + FElementClass: TBaseComplexRemotableClass; + procedure AddAttributeField(const AAttributeField : string); + function GetAttributeCount: Integer; + function GetAttributeField(AIndex : Integer): string; + public + constructor Create(const AElementClass : TBaseComplexRemotableClass); + destructor Destroy();override; + function IsAttributeField(const AField : string):Boolean; + property ElementClass : TBaseComplexRemotableClass read FElementClass; + property AttributeFieldCount : Integer read GetAttributeCount; + property AttributeField[AIndex : Integer] : string read GetAttributeField; + end; + + { TSerializeOptionsRegistry } + + TSerializeOptionsRegistry = class + private + FList : TObjectList; + private + function GetCount: Integer; + function GetItem(AIndex : Integer): TSerializeOptions; + function IndexOf(const AElementClass : TBaseComplexRemotableClass):Integer; + public + constructor Create(); + destructor Destroy();override; + function RegisterClass(const AElementClass : TBaseComplexRemotableClass):TSerializeOptions; + function Find(const AElementClass : TBaseComplexRemotableClass):TSerializeOptions; + property Count : Integer read GetCount; + property Item[AIndex : Integer] : TSerializeOptions read GetItem; + end; + +var + SerializeOptionsRegistryInstance : TSerializeOptionsRegistry = nil; + +function GetSerializeOptionsRegistry():TSerializeOptionsRegistry; +begin + if not Assigned(SerializeOptionsRegistryInstance) then + SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create(); + Result := SerializeOptionsRegistryInstance; +end; + +{ TSerializeOptionsRegistry } + +function TSerializeOptionsRegistry.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TSerializeOptionsRegistry.GetItem(AIndex : Integer): TSerializeOptions; +begin + Result := FList[AIndex] as TSerializeOptions; +end; + +function TSerializeOptionsRegistry.IndexOf( + const AElementClass: TBaseComplexRemotableClass +): Integer; +begin + for Result := 0 to Pred(Count) do begin + if ( Item[Result].ElementClass = AElementClass ) then + Exit; + end; + Result := -1; +end; + +constructor TSerializeOptionsRegistry.Create(); +begin + FList := TObjectList.Create(True); +end; + +destructor TSerializeOptionsRegistry.Destroy(); +begin + FreeAndNil(FList); + inherited Destroy(); +end; + +function TSerializeOptionsRegistry.RegisterClass( + const AElementClass: TBaseComplexRemotableClass +): TSerializeOptions; +var + i, j, k, c : Integer; + ri : TSerializeOptions; +begin + i := IndexOf(AElementClass); + if ( i < 0 ) then begin + c := FList.Count; + i := FList.Add(TSerializeOptions.Create(AElementClass)); + Result := FList[i] as TSerializeOptions; + for j := 0 to Pred(c) do begin + ri := FList[j] as TSerializeOptions; + for k := 0 to Pred(ri.AttributeFieldCount) do begin + Result.FAttributeFieldList.Add(ri.FAttributeFieldList[k]); + end; + end; + end; + Result := FList[i] as TSerializeOptions; +end; + +function TSerializeOptionsRegistry.Find( + const AElementClass: TBaseComplexRemotableClass +): TSerializeOptions; +var + i : Integer; +begin + i := IndexOf(AElementClass); + if ( i >= 0 ) then + Result := FList[i] as TSerializeOptions + else + Result := nil; +end; + +{ TSerializeOptions } + +procedure TSerializeOptions.AddAttributeField(const AAttributeField: string); +begin + if ( FAttributeFieldList.IndexOf(AAttributeField) < 0 ) then + FAttributeFieldList.Add(AAttributeField); +end; + +function TSerializeOptions.GetAttributeCount: Integer; +begin + Result := FAttributeFieldList.Count; +end; + +function TSerializeOptions.GetAttributeField(AIndex : Integer): string; +begin + Result := FAttributeFieldList[AIndex]; +end; + +constructor TSerializeOptions.Create(const AElementClass: TBaseComplexRemotableClass); +begin + FElementClass := AElementClass; + FAttributeFieldList := TStringList.Create(); + FAttributeFieldList.Duplicates := dupIgnore; +end; + +destructor TSerializeOptions.Destroy(); +begin + FreeAndNil(FAttributeFieldList); + inherited Destroy(); +end; + +function TSerializeOptions.IsAttributeField(const AField: string): Boolean; +begin + Result := ( FAttributeFieldList.IndexOf(AField) >= 0 ); +end; + +class procedure TBaseComplexRemotable.Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : String; + const ATypeInfo : PTypeInfo +); +Var + propList : PPropList; + i, propCount, propListLen : Integer; + pt : PTypeInfo; + int64Data : Int64; + strData : String; + objData : TObject; + boolData : Boolean; + enumData : TEnumBuffer; + floatDt : TFloatBuffer; + p : PPropInfo; + oldSS,ss : TSerializationStyle; +begin + oldSS := AStore.GetSerializationStyle(); + AStore.BeginObject(AName,ATypeInfo); + try + if not Assigned(AObject) then begin + AStore.NilCurrentScope(); + Exit; + end; + propCount := GetTypeData(ATypeInfo)^.PropCount; + if ( propCount > 0 ) then begin + propListLen := GetPropList(ATypeInfo,propList); + try + ss := AStore.GetSerializationStyle(); + for i := 0 to Pred(propCount) do begin + p := propList^[i]; + pt := p^.PropType; + if IsStoredProp(AObject,p) then begin + if IsAttributeProperty(p^.Name) then begin + if ( ss <> ssAttibuteSerialization ) then + ss := ssAttibuteSerialization; + end else begin + if ( ss <> ssNodeSerialization ) then + ss := ssNodeSerialization; + end; + if ( ss <> AStore.GetSerializationStyle() ) then + AStore.SetSerializationStyle(ss); + case pt^.Kind of + tkInt64,tkQWord : + begin + int64Data := GetOrdProp(AObject,p^.Name); + AStore.Put(p^.Name,pt,int64Data); + end; + tkLString, tkAString : + begin + strData := GetStrProp(AObject,p^.Name); + AStore.Put(p^.Name,pt,strData); + end; + tkClass : + begin + objData := GetObjectProp(AObject,p^.Name); + AStore.Put(p^.Name,pt,objData); + end; + tkBool : + begin + boolData := Boolean(GetOrdProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,boolData); + end; + tkEnumeration,tkInteger : + begin + FillChar(enumData,SizeOf(enumData),#0); + case GetTypeData(p^.PropType)^.OrdType of + otSByte : + begin + enumData.ShortIntData := ShortInt(GetOrdProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,enumData.ShortIntData); + end; + otUByte : + begin + enumData.ByteData := Byte(GetOrdProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,enumData.ByteData); + end; + otSWord : + begin + enumData.SmallIntData := SmallInt(GetOrdProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,enumData.SmallIntData); + end; + otUWord : + begin + enumData.WordData := Word(GetOrdProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,enumData.WordData); + end; + otSLong : + begin + enumData.SLongIntData := LongInt(GetOrdProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,enumData.SLongIntData); + end; + otULong : + begin + enumData.ULongIntData := LongWord(GetOrdProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,enumData.ULongIntData); + end; + end; + end; + tkFloat : + begin + FillChar(floatDt,SizeOf(floatDt),#0); + case GetTypeData(p^.PropType)^.FloatType of + ftSingle : + begin + floatDt.SingleData := Single(GetFloatProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,floatDt.SingleData); + end; + ftDouble : + begin + floatDt.DoubleData := Double(GetFloatProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,floatDt.DoubleData); + end; + ftExtended : + begin + floatDt.ExtendedData := Extended(GetFloatProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,floatDt.ExtendedData); + end; + ftCurr : + begin + floatDt.CurrencyData := Currency(GetFloatProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,floatDt.CurrencyData); + end; + ftComp : + begin + floatDt.CompData := Comp(GetFloatProp(AObject,p^.Name)); + AStore.Put(p^.Name,pt,floatDt.CompData); + end; + end; + end; + end; + end; + end; + finally + Freemem(propList,propListLen*SizeOf(Pointer)); + end; + end; + finally + AStore.EndScope(); + AStore.SetSerializationStyle(oldSS); + end; +end; + +Type + TFloatExtendedType = Extended; +class procedure TBaseComplexRemotable.Load( + Var AObject : TObject; + AStore : IFormatterBase; + var AName : String; + const ATypeInfo : PTypeInfo +); +Var + propList : PPropList; + i, propCount, propListLen : Integer; + pt : PTypeInfo; + propName : String; + int64Data : Int64; + strData : String; + objData : TObject; + objDataCreateHere : Boolean; + boolData : Boolean; + p : PPropInfo; + enumData : TEnumBuffer; + floatDt : TFloatExtendedType; + floatBuffer : TFloatBuffer; + persistType : TPropStoreType; + objTypeData : PTypeData; + oldSS,ss : TSerializationStyle; +begin + oldSS := AStore.GetSerializationStyle(); + AStore.BeginScopeRead(AName,ATypeInfo); + try + if AStore.IsCurrentScopeNil() then + Exit; // ???? FreeAndNil(AObject); + If Not Assigned(AObject) Then + AObject := Create(); + objTypeData := GetTypeData(ATypeInfo); + propCount := objTypeData^.PropCount; + If ( propCount > 0 ) Then Begin + propListLen := GetPropList(ATypeInfo,propList); + Try + For i := 0 To Pred(propCount) Do Begin + p := propList^[i]; + persistType := IsStoredPropClass(objTypeData^.ClassType,p); + If ( persistType in [pstOptional,pstAlways] ) Then Begin + pt := p^.PropType; + propName := p^.Name; + if IsAttributeProperty(p^.Name) then begin + ss := ssAttibuteSerialization; + end else begin + ss := ssNodeSerialization; + end; + if ( ss <> AStore.GetSerializationStyle() ) then + AStore.SetSerializationStyle(ss); + try + Case pt^.Kind Of + tkInt64,tkQWord : + Begin + AStore.Get(pt,propName,int64Data); + SetOrdProp(AObject,propName,int64Data); + End; + tkLString, tkAString : + Begin + AStore.Get(pt,propName,strData); + SetStrProp(AObject,propName,strData); + End; + tkBool : + Begin + AStore.Get(pt,propName,boolData); + SetOrdProp(AObject,propName,Ord(boolData)); + End; + tkClass : + Begin + objData := GetObjectProp(AObject,propName); + objDataCreateHere := not Assigned(objData); + try + AStore.Get(pt,propName,objData); + if objDataCreateHere then + SetObjectProp(AObject,propName,objData); + finally + if objDataCreateHere then + FreeAndNil(objData); + end; + End; + tkEnumeration,tkInteger : + Begin + FillChar(enumData,SizeOf(enumData),#0); + Case GetTypeData(p^.PropType)^.OrdType Of + otSByte : + Begin + AStore.Get(pt,propName,enumData.ShortIntData); + int64Data := enumData.ShortIntData; + End; + otUByte : + Begin + AStore.Get(pt,propName,enumData.ByteData); + int64Data := enumData.ByteData; + End; + otSWord : + Begin + AStore.Get(pt,propName,enumData.SmallIntData); + int64Data := enumData.SmallIntData; + End; + otUWord : + Begin + AStore.Get(pt,propName,enumData.WordData); + int64Data := enumData.WordData; + End; + otSLong: + Begin + AStore.Get(pt,propName,enumData.SLongIntData); + int64Data := enumData.SLongIntData; + End; + otULong : + Begin + AStore.Get(pt,propName,enumData.ULongIntData); + int64Data := enumData.ULongIntData; + End; + End; + SetOrdProp(AObject,propName,int64Data); + End; + tkFloat : + Begin + FillChar(floatDt,SizeOf(floatBuffer),#0); + Case GetTypeData(p^.PropType)^.FloatType Of + ftSingle : + Begin + AStore.Get(pt,propName,floatBuffer.SingleData); + floatDt := floatBuffer.SingleData; + End; + ftDouble : + Begin + AStore.Get(pt,propName,floatBuffer.DoubleData); + floatDt := floatBuffer.DoubleData; + End; + ftExtended : + Begin + AStore.Get(pt,propName,floatBuffer.ExtendedData); + floatDt := floatBuffer.ExtendedData; + End; + ftCurr : + Begin + AStore.Get(pt,propName,floatBuffer.CurrencyData); + floatDt := floatBuffer.CurrencyData; + End; + ftComp : + Begin + AStore.Get(pt,propName,floatBuffer.CompData); + floatDt := floatBuffer.CompData; + End; + End; + SetFloatProp(AObject,propName,floatDt); + End; + End; + except + on E : EServiceException do begin + if ( persistType = pstAlways ) then + raise; + end; + end; + End; + End; + Finally + Freemem(propList,propListLen*SizeOf(Pointer)); + End; + End; + finally + AStore.EndScopeRead(); + AStore.SetSerializationStyle(oldSS); + end; +end; + +class procedure TBaseComplexRemotable.RegisterAttributeProperty(const AProperty: shortstring); +var + ri : TSerializeOptions; +begin + ri := GetSerializeOptionsRegistry().Find(Self); + if not Assigned(ri) then + ri := GetSerializeOptionsRegistry().RegisterClass(Self); + ri.AddAttributeField(AProperty); +end; + +class procedure TBaseComplexRemotable.RegisterAttributeProperties( + const APropertList : array of shortstring +); +var + i : Integer; +begin + for i := Low(APropertList) to High(APropertList) do + RegisterAttributeProperty(APropertList[i]); +end; + +class function TBaseComplexRemotable.IsAttributeProperty(const AProperty: shortstring): Boolean; +var + ri : TSerializeOptions; + pc : TClass; +begin + Result := False; + if ( Self = TBaseComplexRemotable ) then + Exit; + pc := Self; + while Assigned(pc) and pc.InheritsFrom(TBaseComplexRemotable) do begin + ri := GetSerializeOptionsRegistry().Find(TBaseComplexRemotableClass(pc)); + if Assigned(ri) then begin + Result := ri.IsAttributeField(AProperty); + Exit; + end; + pc := pc.ClassParent; + end; +end; + +procedure TBaseComplexRemotable.Assign(Source: TPersistent); +var + propList : PPropList; + i, propCount, propListLen : Integer; + p, sp : PPropInfo; + selfTypeInfo : PTypeInfo; +begin + if not Assigned(Source) then + Exit; + selfTypeInfo := Self.ClassInfo; + propCount := GetTypeData(selfTypeInfo)^.PropCount; + if ( propCount > 0 ) then begin + propListLen := GetPropList(selfTypeInfo,propList); + try + for i := 0 to Pred(propCount) do begin + p := propList^[i]; + sp := GetPropInfo(Source,p^.Name); + if Assigned(sp) and Assigned(sp^.GetProc) and + Assigned(p^.SetProc) + then begin + case p^.PropType^.Kind of + tkInt64,tkQWord, tkBool, tkEnumeration,tkInteger : + SetOrdProp(Self,p,GetOrdProp(Source,p^.Name)); + tkLString, tkAString : + SetStrProp(Self,p,GetStrProp(Source,p^.Name)); + tkClass : + SetObjectProp(Self,p,GetObjectProp(Source,p^.Name)); + tkFloat : + SetFloatProp(Self,p,GetFloatProp(Source,p^.Name)); + end; + end; + end; + finally + Freemem(propList,propListLen*SizeOf(Pointer)); + end; + end; +end; + +{ TBaseObjectArrayRemotable } + +function TBaseObjectArrayRemotable.GetItem(AIndex: Integer): TBaseRemotable; +begin + CheckIndex(AIndex); + Result := FArray[AIndex]; +end; + +function TBaseObjectArrayRemotable.GetLength(): Integer; +begin + Result := System.Length(FArray); +end; + +const sARRAY_ITEM = 'item'; +class procedure TBaseObjectArrayRemotable.Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : String; + const ATypeInfo : PTypeInfo +); +Var + itmTypInfo : PTypeInfo; + i,j : Integer; + nativObj : TBaseObjectArrayRemotable; + itm : TObject; +begin + If Assigned(AObject) Then Begin + Assert(AObject.InheritsFrom(TBaseObjectArrayRemotable)); + nativObj := AObject as TBaseObjectArrayRemotable; + j := nativObj.Length; + End Else + j := 0; + itmTypInfo := PTypeInfo(GetItemClass().ClassInfo); + AStore.BeginArray(AName,itmTypInfo,[0,Pred(j)]); + Try + For i := 0 To Pred(j) Do Begin + itm := nativObj.Item[i]; + AStore.Put(sARRAY_ITEM,itmTypInfo,itm); + End; + Finally + AStore.EndScope(); + End; +end; + +class procedure TBaseObjectArrayRemotable.Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : String; + const ATypeInfo : PTypeInfo +); +Var + i, len : Integer; + nativObj : TBaseObjectArrayRemotable; + s : string; + itmTypInfo : PTypeInfo; + itm : TBaseRemotable; +begin + len := AStore.BeginScopeRead(AName,ATypeInfo, stArray); + Try + If Not Assigned(AObject) Then + AObject := Create(); + itmTypInfo := PTypeInfo(GetItemClass().ClassInfo); + nativObj := AObject as TBaseObjectArrayRemotable; + If ( len > 0 ) Then Begin + s := ''; + nativObj.SetLength(len); + For i := 0 To Pred(len) Do Begin + itm := nativObj[i]; + AStore.Get(itmTypInfo,s,itm); + End; + End; + Finally + AStore.EndScopeRead(); + End; +end; + +class function TBaseObjectArrayRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result:= GetItemClass().ClassInfo; +end; + +constructor TBaseObjectArrayRemotable.Create(); +begin + FArray := Nil; +end; + +procedure TBaseObjectArrayRemotable.SetLength(const ANewSize: Integer); +var + i,oldLen : Integer; + itmClss : TBaseRemotableClass; +begin + oldLen := GetLength; + if ( oldLen = ANewSize ) then + Exit; + + if ( ANewSize < 0 ) then + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + + if ( oldLen > ANewSize ) then begin + for i := ANewSize to Pred(oldLen) do + FreeAndNil(FArray[i]); + System.SetLength(FArray,ANewSize); + end else begin + System.SetLength(FArray,ANewSize); + itmClss := GetItemClass(); + for i := oldLen to Pred(ANewSize) do + FArray[i] := itmClss.Create(); + end; +end; + +{ TBaseFactoryRegistryItem } + +constructor TBaseFactoryRegistryItem.Create( + const AName : string; + const AFactory : IItemFactory +); +begin + Assert(Assigned(AFactory)); + FName := AName; + FFactory := AFactory; +end; + +destructor TBaseFactoryRegistryItem.Destroy(); +begin + FName := ''; + FFactory := nil; + inherited Destroy(); +end; + +function TBaseFactoryRegistry.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TBaseFactoryRegistry.GetItem(Index: Integer): TBaseFactoryRegistryItem; +begin + Result := FList[Index] as TBaseFactoryRegistryItem; +end; + +{ TBaseFactoryRegistry } +function TBaseFactoryRegistry.FindFactory(const AName: string): IItemFactory; +Var + i , c : Integer; + s : string; +begin + s := LowerCase(Trim(AName)); + c := Pred(FList.Count); + For i := 0 To c Do Begin + If AnsiSameText(TBaseFactoryRegistryItem(FList[i]).Name,s) Then Begin + Result := TBaseFactoryRegistryItem(FList[i]).Factory; + Exit; + End; + End; + Result := Nil; +end; + +procedure TBaseFactoryRegistry.Register( + const AName : string; + const AFactory : IItemFactory +); +begin + Assert(Assigned(AFactory)); + If Not Assigned(FindFactory(AName)) Then + FList.Add(TBaseFactoryRegistryItem.Create(AName,AFactory)); +end; + +constructor TBaseFactoryRegistry.Create(); +begin + FList := TObjectList.Create(True); + inherited Create(); +end; + +destructor TBaseFactoryRegistry.Destroy(); +begin + FList.Free(); + inherited Destroy(); +end; + +{ TSimpleItemFactory } + +function TSimpleItemFactory.CreateInstance(): IInterface; +begin + Result := FItemClass.Create() as IInterface; +end; + +constructor TSimpleItemFactory.Create(AItemClass: TSimpleFactoryItemClass); +begin + Assert(Assigned(AItemClass)); + FItemClass := AItemClass; +end; + +{ TSimpleItemFactoryEx } + +function TSimpleItemFactoryEx.GetPropertyManager( + const APropertyGroup : string; + const ACreateIfNotExists : Boolean +):IPropertyManager; +var + i : Integer; + s : string; +begin + Result := nil; + s := Trim(APropertyGroup); + i := FPropertyNames.IndexOf(s); + if ( i < 0 ) then begin + if not ACreateIfNotExists then + Exit; + i := FPropertyNames.Add(s); + FProperties.Add(TStoredPropertyManager.Create() as IInterface); + end; + Result := FProperties.Get(i) as IPropertyManager; +end; + +constructor TSimpleItemFactoryEx.Create(AItemClass: TSimpleFactoryItemClass); +begin + inherited Create(AItemClass); + FPropertyNames := TStringList.Create(); + FProperties := TInterfaceList.Create(); +end; + +destructor TSimpleItemFactoryEx.Destroy(); +begin + FreeAndNil(FPropertyNames); + FProperties := nil; + inherited Destroy(); +end; + +{ TSimpleFactoryItem } + +constructor TSimpleFactoryItem.Create(); +begin +end; + + +{ TSimpleCallContext } + +procedure TSimpleCallContext.Clear(); +begin + FHeaderList.Clear(); + FFreeObjectList.Clear();; +end; + +procedure TSimpleCallContext.AddObjectToFree(const AObject: TObject); +begin + if ( FFreeObjectList.IndexOf(AObject) < 0 ) then + FFreeObjectList.Add(AObject); +end; + +function TSimpleCallContext.AddHeader( + const AHeader: THeaderBlock; + const AKeepOwnership: Boolean +): Integer; +begin + Result := FHeaderList.IndexOf(AHeader); + if ( Result = -1 ) then + Result := FHeaderList.Add(AHeader); + if AKeepOwnership then + AddObjectToFree(AHeader); +end; + +function TSimpleCallContext.GetHeaderCount(const ADirections : THeaderDirections):Integer; +var + i : Integer; +begin + if ( ADirections = [Low(THeaderDirection)..High(THeaderDirection)] ) then + Result := FHeaderList.Count + else begin + Result := 0; + for i := 0 to Pred(FHeaderList.Count) do begin + if ( THeaderBlock(FHeaderList[i]).Direction in ADirections ) then + Inc(Result); + end; + end; +end; + +function TSimpleCallContext.GetHeader(const AIndex: Integer): THeaderBlock; +begin + Result := FHeaderList[AIndex] as THeaderBlock; +end; + +procedure TSimpleCallContext.ClearHeaders(const ADirection: THeaderDirection); +var + i, c : Integer; + h : THeaderBlock; + fl : TObjectList; +begin + c := FHeaderList.Count; + if ( c > 0 ) then begin + fl := TObjectList.Create(False); + try + for i := 0 to Pred(c) do begin + h := FHeaderList[i] as THeaderBlock; + if ( h.Direction = ADirection ) then + fl.Add(h); + end; + for i := 0 to Pred(fl.Count) do + FreeHeader(fl[i] as THeaderBlock); + finally + fl.Free(); + end; + end; +end; + +procedure TSimpleCallContext.FreeHeader(AHeader: THeaderBlock); +begin + if Assigned(AHeader) then begin + if ( FHeaderList.IndexOf(AHeader) >= 0 ) then + FHeaderList.Remove(AHeader); + if ( FFreeObjectList.IndexOf(AHeader) >= 0 ) then + FHeaderList.Remove(AHeader) + else + AHeader.Free(); + end; +end; + +constructor TSimpleCallContext.Create(); +begin + FHeaderList := TObjectList.Create(False); + FFreeObjectList := TObjectList.Create(True); +end; + +destructor TSimpleCallContext.Destroy(); +begin + FreeAndNil(FHeaderList); + FreeAndNil(FFreeObjectList); + inherited Destroy(); +end; + +{ TTypeRegistryItem } + +constructor TTypeRegistryItem.Create( + ANameSpace : String; + ADataType : PTypeInfo; + Const ADeclaredName : String +); +begin + FNameSpace := ANameSpace; + FDataType := ADataType; + FDeclaredName := Trim(ADeclaredName); + If ( Length(FDeclaredName) = 0 ) Then + FDeclaredName := FDataType^.Name; +end; + +destructor TTypeRegistryItem.Destroy(); +begin + FreeAndNil(FSynonymTable); + inherited Destroy(); +end; + +procedure TTypeRegistryItem.AddPascalSynonym(const ASynonym: string); //inline; +begin + if AnsiSameText(ASynonym,DataType^.Name) then + Exit; + if not Assigned(FSynonymTable) then begin + FSynonymTable := TStringList.Create(); + FSynonymTable.Add(FDataType^.Name); + end; + if ( FSynonymTable.IndexOf(ASynonym) = -1 ) then + FSynonymTable.Add(AnsiLowerCase(ASynonym)); +end; + +function TTypeRegistryItem.IsSynonym(const APascalTypeName: string): Boolean;//inline; +begin + Result := AnsiSameText(APascalTypeName,DataType^.Name); + if ( not Result ) and Assigned(FSynonymTable) then + Result := ( FSynonymTable.IndexOf(APascalTypeName) >= 0 ) ; +end; + +{ TTypeRegistry } + +function TTypeRegistry.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TTypeRegistry.GetItemByIndex(Index: Integer): TTypeRegistryItem; +begin + Result := FList[Index] as TTypeRegistryItem; +end; + +function TTypeRegistry.GetItemByTypeInfo(Index: PTypeInfo): TTypeRegistryItem; +Var + i : Integer; +begin + Assert(Assigned(Index)); + i := IndexOf(Index); + If ( i > -1 ) Then + Result := FList[i] as TTypeRegistryItem + Else + Raise ETypeRegistryException.CreateFmt('Type not registered : %s',[Index^.Name]) +end; + +constructor TTypeRegistry.Create(); +begin + Inherited Create(); + FList := TObjectList.Create(True); +end; + +destructor TTypeRegistry.Destroy(); +begin + FreeAndNil(FList); + inherited Destroy(); +end; + +function TTypeRegistry.IndexOf(Const ATypeInfo: PTypeInfo): Integer; +begin + For Result := 0 To Pred(Count) Do Begin + If ( ATypeInfo^.Kind = Item[Result].DataType^.Kind ) And + AnsiSameText(ATypeInfo^.Name,Item[Result].DataType^.Name) + Then + Exit; + End; + Result := -1; +end; + +function TTypeRegistry.Add(AItem: TTypeRegistryItem): Integer; +begin + Result := IndexOf(AItem.DataType); + If ( Result = -1 ) Then + Result := FList.Add(AItem) + Else + Raise ETypeRegistryException.CreateFmt('Type already registered : "%s"',[AItem.DataType^.Name]); +end; + +function TTypeRegistry.Register( + Const ANameSpace : String; + Const ADataType : PTypeInfo; + Const ADeclaredName : String = '' +): TTypeRegistryItem; +var + i : Integer; +begin + i := IndexOf(ADataType); + if ( i = -1 ) then + i := Add(TTypeRegistryItem.Create(ANameSpace,ADataType,ADeclaredName)); + Result := Item[i]; +end; + +function TTypeRegistry.Find(ATypeInfo : PTypeInfo; Const AExact : Boolean):TTypeRegistryItem; +Var + i : Integer; + searchClass : TClass; +begin + Result := Nil; + i := IndexOf(ATypeInfo); + If ( i > -1 ) Then + Result := Item[i] + Else If ( Not AExact ) And + Assigned(ATypeInfo) And + ( ATypeInfo^.Kind = tkClass ) + Then Begin + searchClass := GetTypeData(ATypeInfo)^.ClassType; + For i := 0 To Pred(Count) Do Begin + Result := Item[i]; + If ( Result.DataType^.Kind = tkClass ) And + searchClass.InheritsFrom(GetTypeData(Result.DataType)^.ClassType) + Then + Exit; + End; + Result := Nil; + End; +end; + +function TTypeRegistry.Find(const APascalTypeName: string): TTypeRegistryItem; +var + i,c : Integer; +begin + c := Count; + for i := 0 to Pred(c) do begin + Result := Item[i]; + if Result.IsSynonym(APascalTypeName) then + Exit; + end; + Result := nil; +end; + +function TTypeRegistry.FindByDeclaredName( + const ATypeName, + ANameSpace : string +): TTypeRegistryItem; +var + i, c : Integer; +begin + c := Count; + for i := 0 to Pred(c) do begin + Result := Item[i]; + if AnsiSameText(ANameSpace,Result.NameSpace) and + AnsiSameText(ATypeName,Result.DeclaredName) + then + Exit; + end; + Result := nil; +end; + + +{ TBaseSimpleTypeArrayRemotable } + + +class procedure TBaseSimpleTypeArrayRemotable.Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo +); +var + i,j : Integer; + nativObj : TBaseSimpleTypeArrayRemotable; +begin + if Assigned(AObject) then begin + Assert(AObject.InheritsFrom(TBaseSimpleTypeArrayRemotable)); + nativObj := AObject as TBaseSimpleTypeArrayRemotable; + j := nativObj.Length; + end else begin + j := 0; + end; + AStore.BeginArray(AName,GetItemTypeInfo(),[0,Pred(j)]); + try + for i := 0 to Pred(j) do begin + nativObj.SaveItem(AStore,sARRAY_ITEM,i); + end; + finally + AStore.EndScope(); + end; +end; + +class procedure TBaseSimpleTypeArrayRemotable.Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : String; + const ATypeInfo : PTypeInfo +); +Var + i, len : Integer; + nativObj : TBaseSimpleTypeArrayRemotable; +begin ; + len := AStore.BeginScopeRead(AName,ATypeInfo, stArray); + try + if not Assigned(AObject) then + AObject := Create(); + nativObj := nil; + nativObj := AObject as TBaseSimpleTypeArrayRemotable; + if ( len > 0 ) then begin + nativObj.SetLength(len); + for i := 0 to Pred(len) do begin + nativObj.LoadItem(AStore,i); + end; + end; + finally + AStore.EndScopeRead(); + end; +end; + +{ TArrayOfStringRemotable } + +function TArrayOfStringRemotable.GetItem(AIndex: Integer): ansistring; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfStringRemotable.SetItem(AIndex: Integer;const AValue: ansistring); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfStringRemotable.GetLength(): Integer; +begin + Result := System.Length(FData) +end; + +procedure TArrayOfStringRemotable.SaveItem( + AStore : IFormatterBase; + const AName : String; + const AIndex : Integer +); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(ansistring),FData[AIndex]); +end; + +procedure TArrayOfStringRemotable.LoadItem( + AStore : IFormatterBase; + const AIndex : Integer +); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(ansistring),sName,FData[AIndex]); +end; + +class function TArrayOfStringRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(ansistring); +end; + +procedure TArrayOfStringRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TBaseArrayRemotable } + +procedure TBaseArrayRemotable.CheckIndex(const AIndex : Integer); +begin + if ( AIndex < 0 ) or ( AIndex >= Length ) then + raise EServiceException.CreateFmt('Index out of bound : %d',[AIndex]); +end; + +destructor TBaseArrayRemotable.Destroy(); +begin + SetLength(0); + inherited Destroy(); +end; + +{ TArrayOfBooleanRemotable } + +function TArrayOfBooleanRemotable.GetItem(AIndex: Integer): Boolean; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfBooleanRemotable.SetItem(AIndex: Integer;const AValue: Boolean); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfBooleanRemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfBooleanRemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(Boolean),FData[AIndex]); +end; + +procedure TArrayOfBooleanRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(Boolean),sName,FData[AIndex]); +end; + +class function TArrayOfBooleanRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Boolean); +end; + +procedure TArrayOfBooleanRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfInt8URemotable } + +function TArrayOfInt8URemotable.GetItem(AIndex: Integer): Byte; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfInt8URemotable.SetItem(AIndex: Integer; const AValue: Byte); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfInt8URemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfInt8URemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(Byte),FData[AIndex]); +end; + +procedure TArrayOfInt8URemotable.LoadItem(AStore: IFormatterBase; const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(Byte),sName,FData[AIndex]); +end; + +class function TArrayOfInt8URemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Byte); +end; + +procedure TArrayOfInt8URemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfInt8SRemotable } + +function TArrayOfInt8SRemotable.GetItem(AIndex: Integer): ShortInt; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfInt8SRemotable.SetItem(AIndex: Integer; const AValue: ShortInt); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfInt8SRemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfInt8SRemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(ShortInt),FData[AIndex]); +end; + +procedure TArrayOfInt8SRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(ShortInt),sName,FData[AIndex]); +end; + +class function TArrayOfInt8SRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(ShortInt); +end; + +procedure TArrayOfInt8SRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfInt16SRemotable } + +function TArrayOfInt16SRemotable.GetItem(AIndex: Integer): SmallInt; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfInt16SRemotable.SetItem(AIndex: Integer;const AValue: SmallInt); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfInt16SRemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfInt16SRemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(SmallInt),FData[AIndex]); +end; + +procedure TArrayOfInt16SRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(SmallInt),sName,FData[AIndex]); +end; + +class function TArrayOfInt16SRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(SmallInt); +end; + +procedure TArrayOfInt16SRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfInt16URemotable } + +function TArrayOfInt16URemotable.GetItem(AIndex: Integer): Word; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfInt16URemotable.SetItem(AIndex: Integer; const AValue: Word); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfInt16URemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfInt16URemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(Word),FData[AIndex]); +end; + +procedure TArrayOfInt16URemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(Word),sName,FData[AIndex]); +end; + +class function TArrayOfInt16URemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Word); +end; + +procedure TArrayOfInt16URemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfInt32URemotable } + +function TArrayOfInt32URemotable.GetItem(AIndex: Integer): LongWord; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfInt32URemotable.SetItem(AIndex: Integer;const AValue: LongWord); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfInt32URemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfInt32URemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(LongWord),FData[AIndex]); +end; + +procedure TArrayOfInt32URemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(LongWord),sName,FData[AIndex]); +end; + +class function TArrayOfInt32URemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(LongWord); +end; + +procedure TArrayOfInt32URemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfInt32SRemotable } + +function TArrayOfInt32SRemotable.GetItem(AIndex: Integer): LongInt; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfInt32SRemotable.SetItem(AIndex: Integer; const AValue: LongInt); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfInt32SRemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfInt32SRemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(LongInt),FData[AIndex]); +end; + +procedure TArrayOfInt32SRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(LongInt),sName,FData[AIndex]); +end; + +class function TArrayOfInt32SRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(LongInt); +end; + +procedure TArrayOfInt32SRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfInt64SRemotable } + +function TArrayOfInt64SRemotable.GetItem(AIndex: Integer): Int64; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfInt64SRemotable.SetItem(AIndex: Integer; const AValue: Int64); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfInt64SRemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfInt64SRemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(Int64),FData[AIndex]); +end; + +procedure TArrayOfInt64SRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(Int64),sName,FData[AIndex]); +end; + +class function TArrayOfInt64SRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Int64); +end; + +procedure TArrayOfInt64SRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfInt64URemotable } + +function TArrayOfInt64URemotable.GetItem(AIndex: Integer): QWord; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfInt64URemotable.SetItem(AIndex: Integer; const AValue: QWord); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfInt64URemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfInt64URemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(QWord),FData[AIndex]); +end; + +procedure TArrayOfInt64URemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(QWord),sName,FData[AIndex]); +end; + +class function TArrayOfInt64URemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(QWord); +end; + +procedure TArrayOfInt64URemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfFloatSingleRemotable } + +function TArrayOfFloatSingleRemotable.GetItem(AIndex: Integer): Single; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfFloatSingleRemotable.SetItem(AIndex: Integer;const AValue: Single); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfFloatSingleRemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfFloatSingleRemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(Single),FData[AIndex]); +end; + +procedure TArrayOfFloatSingleRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(Single),sName,FData[AIndex]); +end; + +class function TArrayOfFloatSingleRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Single); +end; + +procedure TArrayOfFloatSingleRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfFloatDoubleRemotable } + +function TArrayOfFloatDoubleRemotable.GetItem(AIndex: Integer): Double; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfFloatDoubleRemotable.SetItem(AIndex: Integer;const AValue: Double); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfFloatDoubleRemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfFloatDoubleRemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(Double),FData[AIndex]); +end; + +procedure TArrayOfFloatDoubleRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(Double),sName,FData[AIndex]); +end; + +class function TArrayOfFloatDoubleRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Double); +end; + +procedure TArrayOfFloatDoubleRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfFloatExtendedRemotable } + +function TArrayOfFloatExtendedRemotable.GetItem(AIndex: Integer): Extended; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfFloatExtendedRemotable.SetItem(AIndex: Integer;const AValue: Extended); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfFloatExtendedRemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfFloatExtendedRemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(Extended),FData[AIndex]); +end; + +procedure TArrayOfFloatExtendedRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(Extended),sName,FData[AIndex]); +end; + +class function TArrayOfFloatExtendedRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Extended); +end; + +procedure TArrayOfFloatExtendedRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + +{ TArrayOfFloatCurrencyRemotable } + +function TArrayOfFloatCurrencyRemotable.GetItem(AIndex: Integer): Currency; +begin + CheckIndex(AIndex); + Result := FData[AIndex]; +end; + +procedure TArrayOfFloatCurrencyRemotable.SetItem(AIndex: Integer;const AValue: Currency); +begin + CheckIndex(AIndex); + FData[AIndex] := AValue; +end; + +function TArrayOfFloatCurrencyRemotable.GetLength(): Integer; +begin + Result := System.Length(FData); +end; + +procedure TArrayOfFloatCurrencyRemotable.SaveItem(AStore: IFormatterBase; + const AName: String; const AIndex: Integer); +begin + AStore.Put(sARRAY_ITEM,TypeInfo(Currency),FData[AIndex]); +end; + +procedure TArrayOfFloatCurrencyRemotable.LoadItem(AStore: IFormatterBase;const AIndex: Integer); +var + sName : string; +begin + sName := sARRAY_ITEM; + AStore.Get(TypeInfo(Currency),sName,FData[AIndex]); +end; + +class function TArrayOfFloatCurrencyRemotable.GetItemTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Currency); +end; + +procedure TArrayOfFloatCurrencyRemotable.SetLength(const ANewSize: Integer); +var + i : Integer; +begin + if ( ANewSize < 0 ) then + i := 0 + else + i := ANewSize; + System.SetLength(FData,i); +end; + + +{ THeaderBlock } + +function THeaderBlock.HasmustUnderstand: boolean; +begin + Result := ( FmustUnderstand <> 0 ); +end; + +procedure THeaderBlock.SetmustUnderstand(const AValue: Integer); +begin + if ( AValue <> 0 ) then + FmustUnderstand := 1 + else + FmustUnderstand := 0; +end; + +{ TStoredPropertyManager } + +procedure TStoredPropertyManager.Error(Const AMsg: string); +begin + raise EPropertyException.Create(AMsg); +end; + +procedure TStoredPropertyManager.Error( + Const AMsg: string; + Const AArgs: array of const +); +begin + raise EPropertyException.CreateFmt(AMsg,AArgs); +end; + +procedure TStoredPropertyManager.SetProperty(Const AName, AValue: string); +begin + FData.Values[AName] := AValue; +end; + +procedure TStoredPropertyManager.SetProperties(Const APropsStr: string); +var + lst : TStringList; + i : Integer; +begin + if ( Length(Trim(APropsStr)) = 0 ) then + Exit; + lst := TStringList.Create(); + try + lst.QuoteChar := #0; + lst.Delimiter := PROP_LIST_DELIMITER; + lst.DelimitedText := APropsStr; + for i := 0 to Pred(lst.Count) do + SetProperty(lst.Names[i],lst.ValueFromIndex[i]); + finally + lst.Free(); + end; +end; + +function TStoredPropertyManager.GetProperty(Const AName: String): string; +begin + Result := FData.Values[AName]; +end; + +function TStoredPropertyManager.GetPropertyNames(ADest: TStrings): Integer; +var + i : Integer; +begin + ADest.Clear(); + Result := FData.Count; + for i := 0 to Pred(Result) do + ADest.Add(FData.Names[i]); +end; + +procedure TStoredPropertyManager.Clear(); +begin + FData.Clear(); +end; + +procedure TStoredPropertyManager.Copy( + ASource : IPropertyManager; + Const AClearBefore : Boolean +); +var + lst : TStringList; + i : Integer; + s : string; +begin + if AClearBefore then + Clear(); + if Assigned(ASource) then begin + lst := TStringList.Create(); + try + ASource.GetPropertyNames(lst); + for i := 0 to Pred(lst.Count) do begin + s := lst[i]; + SetProperty(s,ASource.GetProperty(s)); + end; + finally + lst.Free(); + end; + end; +end; + +constructor TStoredPropertyManager.Create(); +begin + FData := TStringList.Create(); +end; + +destructor TStoredPropertyManager.Destroy(); +begin + FreeAndNil(FData); + inherited Destroy(); +end; + + +initialization + TypeRegistryInstance := TTypeRegistry.Create(); + SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create(); + +finalization + FreeAndNil(SerializeOptionsRegistryInstance); + FreeAndNil(TypeRegistryInstance); +end. diff --git a/wst/tags/3.1/base_soap_formatter.pas b/wst/tags/3.1/base_soap_formatter.pas new file mode 100644 index 000000000..977a45051 --- /dev/null +++ b/wst/tags/3.1/base_soap_formatter.pas @@ -0,0 +1,1280 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit base_soap_formatter; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, Contnrs, + DOM, + base_service_intf; + +Const + sPROTOCOL_NAME = 'SOAP'; + + sXML_NS = 'xmlns'; + sXSI_NS = 'http://www.w3.org/1999/XMLSchema-instance'; + sXSI_TYPE = 'xsi:type'; + sXSI_NIL = 'xsi:nil'; + + sSOAP_ENC = 'http://schemas.xmlsoap.org/soap/encoding/'; + sSOAP_ENC_ABR = 'SOAP-ENC'; + + sARRAY_TYPE = 'arrayType'; + + sCONTENT_TYPE = 'contenttype'; + sSOAP_CONTENT_TYPE = 'text/xml'; + + sHEADER = 'Header'; + sENVELOPE = 'Envelope'; + +Type + + TEnumIntType = Int64; + + { ESOAPException } + + ESOAPException = class(EBaseRemoteException) + End; + + { TStackItem } + + TStackItem = class + private + FNameSpace: string; + FScopeObject: TDOMNode; + FScopeType: TScopeType; + function GetItemsCount: Integer; + Public + constructor Create(AScopeObject : TDOMNode;AScopeType : TScopeType); + function FindNode(var ANodeName : string):TDOMNode;virtual;abstract; + procedure SetNameSpace(const ANameSpace : string); + property ScopeObject : TDOMNode Read FScopeObject; + property ScopeType : TScopeType Read FScopeType; + property NameSpace : string Read FNameSpace; + property ItemsCount : Integer read GetItemsCount; + End; + + { TObjectStackItem } + + TObjectStackItem = class(TStackItem) + Public + function FindNode(var ANodeName : string):TDOMNode;override; + End; + + { TArrayStackItem } + + TArrayStackItem = class(TStackItem) + Private + FIndex : Integer; + Public + function FindNode(var ANodeName : string):TDOMNode;override; + End; + + TSOAPEncodingStyle = ( Encoded, Litteral ); + TSOAPDocumentStyle = ( RPC, Document ); + +{$M+} + + { TSOAPBaseFormatter } + + TSOAPBaseFormatter = class(TSimpleFactoryItem,IFormatterBase) + private + FContentType: string; + FEncodingStyle: TSOAPEncodingStyle; + FStyle: TSOAPDocumentStyle; + FHeaderEnterCount : Integer; + + FNameSpaceCounter : Integer; + FDoc : TXMLDocument; + FStack : TObjectStack; + + FKeepedStyle : TSOAPDocumentStyle; + FKeepedEncoding : TSOAPEncodingStyle; + FSerializationStyle : TSerializationStyle; + + procedure InternalClear(const ACreateDoc : Boolean); + + function NextNameSpaceCounter():Integer;//inline; + function HasScope():Boolean;//inline; + + procedure CheckScope();//inline; + function InternalPutData( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : string + ):TDOMNode; + function PutEnum( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : TEnumIntType + ):TDOMNode; + function PutBool( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : Boolean + ):TDOMNode; + function PutInt64( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : Int64 + ):TDOMNode; + function PutStr( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : String + ):TDOMNode; + function PutFloat( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : Extended + ):TDOMNode; + procedure PutObj( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData : TObject + ); + + function GetNodeValue(var AName : String):DOMString; + procedure GetEnum( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : TEnumIntType + ); + procedure GetBool( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : Boolean + ); + procedure GetInt( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : Integer + ); + procedure GetInt64( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : Int64 + ); + procedure GetFloat( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : Extended + ); + procedure GetStr( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : String + ); + procedure GetObj( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData : TObject + ); + protected + function GetXmlDoc():TXMLDocument; + function PushStack(AScopeObject : TDOMNode;Const AScopeType : TScopeType = stObject):TStackItem; + function FindAttributeByValueInNode( + Const AAttValue : String; + Const ANode : TDOMNode; + Out AResAtt : string + ):boolean; + function FindAttributeByNameInNode( + Const AAttName : String; + Const ANode : TDOMNode; + Out AResAttValue : string + ):boolean; + function FindAttributeByValueInScope(Const AAttValue : String):String; + function FindAttributeByNameInScope(Const AAttName : String):String; + protected + function GetCurrentScope():String; + function GetCurrentScopeObject():TDOMElement; + function StackTop():TStackItem; + function PopStack():TStackItem; + procedure ClearStack(); + procedure BeginScope( + Const AScopeName,ANameSpace : string; + Const ANameSpaceShortName : string = ''; + Const AScopeType : TScopeType = stObject + ); + + procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); + function GetSerializationStyle():TSerializationStyle; + procedure SetStyleAndEncoding( + const AStyle : TSOAPDocumentStyle; + const AEncoding : TSOAPEncodingStyle + ); + procedure RestoreStyleAndEncoding(); + procedure Prepare(); + function ReadHeaders(ACallContext : ICallContext):Integer; + function WriteHeaders(ACallContext : ICallContext):Integer; + public + constructor Create();override; + destructor Destroy();override; + procedure Clear(); + + procedure BeginObject( + Const AName : string; + Const ATypeInfo : PTypeInfo + ); + procedure BeginArray( + Const AName : string; + Const AItemTypeInfo : PTypeInfo; + Const ABounds : Array Of Integer + ); + + procedure NilCurrentScope(); + function IsCurrentScopeNil():Boolean; + procedure EndScope(); + procedure AddScopeAttribute(Const AName,AValue : string); + function BeginScopeRead( + Var AScopeName : string; + Const ATypeInfo : PTypeInfo; + Const AScopeType : TScopeType = stObject + ):Integer; + procedure EndScopeRead(); + + procedure BeginHeader(); + procedure EndHeader(); + + procedure Put( + Const AName : String; + Const ATypeInfo : PTypeInfo; + Const AData + ); + procedure Get( + Const ATypeInfo : PTypeInfo; + Var AName : String; + Var AData + ); + + procedure SaveToStream(AStream : TStream); + procedure LoadFromStream(AStream : TStream); + + procedure Error(Const AMsg:string); + procedure Error(Const AMsg:string; Const AArgs : array of const); + Published + property EncodingStyle : TSOAPEncodingStyle Read FEncodingStyle Write FEncodingStyle; + property ContentType : string Read FContentType Write FContentType; + property Style : TSOAPDocumentStyle Read FStyle Write FStyle; + End; +{$M-} + +implementation +Uses XMLWrite, XMLRead, StrUtils, + imp_utils; + +function GetNodeItemsCount(const ANode : TDOMNode): Integer; +var + chdLst : TDOMNodeList; +begin + if ANode.HasChildNodes then begin + chdLst := ANode.ChildNodes; + try + Result := chdLst.Count + finally + chdLst.Release(); + end; + end else begin + Result := 0; + end; +end; + +{ TStackItem } + +function TStackItem.GetItemsCount: Integer; +begin + Result := GetNodeItemsCount(ScopeObject); +end; + +constructor TStackItem.Create(AScopeObject: TDOMNode; AScopeType: TScopeType); +begin + FScopeObject := AScopeObject; + FScopeType := AScopeType; +end; + +procedure TStackItem.SetNameSpace(const ANameSpace: string); +begin + FNameSpace := ANameSpace; +end; + +{ TObjectStackItem } + +function TObjectStackItem.FindNode(var ANodeName: string): TDOMNode; +begin + Result:= ScopeObject.FindNode(ANodeName); +end; + +{ TArrayStackItem } + +function TArrayStackItem.FindNode(var ANodeName: string): TDOMNode; +var + chdLst : TDOMNodeList; +begin + if not ScopeObject.HasChildNodes then + raise ESOAPException.Create('This node has no children.'); + chdLst := ScopeObject.ChildNodes; + try + if ( FIndex >= chdLst.Count ) then + raise ESOAPException.CreateFmt('Index out of bound : %d',[FIndex]); + Result:= chdLst.Item[FIndex]; + Inc(FIndex); + ANodeName := Result.NodeName; + finally + chdLst.Release(); + end; +end; + +{ TSOAPBaseFormatter } + +procedure TSOAPBaseFormatter.ClearStack(); +Var + i, c : Integer; +begin + c := FStack.Count; + For I := 1 To c Do + FStack.Pop().Free(); +end; + +function TSOAPBaseFormatter.PushStack( + AScopeObject : TDOMNode; + Const AScopeType : TScopeType +) : TStackItem; +begin + if ( AScopeType = stArray ) then + Result := FStack.Push(TArrayStackItem.Create(AScopeObject,AScopeType)) as TStackItem + else + Result := FStack.Push(TObjectStackItem.Create(AScopeObject,AScopeType)) as TStackItem; +end; + +function TSOAPBaseFormatter.BeginScopeRead( + Var AScopeName : string; + Const ATypeInfo : PTypeInfo; + Const AScopeType : TScopeType = stObject +):Integer; +Var + locNode : TDOMNode; + stk : TStackItem; + + typData : TTypeRegistryItem; + nmspc,nmspcSH : string; + strNodeName : string; +begin + if ( Style = Document ) then begin + typData := GetTypeRegistry().Find(ATypeInfo,False); + if not Assigned(typData) then + Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]); + nmspc := typData.NameSpace; + if IsStrEmpty(nmspc) then + nmspcSH := '' + else begin + nmspcSH := FindAttributeByValueInScope(nmspc); + if not IsStrEmpty(nmspcSH) then begin + nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt); + end; + End; + if IsStrEmpty(nmspcSH) then begin + strNodeName := AScopeName + end else begin + if ( Pos(':',AScopeName) < 1 ) then + strNodeName := nmspcSH + ':' + AScopeName + else + strNodeName := AScopeName; + end; + end else begin + nmspcSH := ''; + strNodeName := AScopeName; + end; + + stk := StackTop(); + locNode := stk.FindNode(strNodeName);//(AScopeName); + If Not Assigned(locNode) Then + Error('Scope not found : "%s"',[strNodeName]);//[AScopeName]); + PushStack(locNode,AScopeType); + if ( Style = Document ) then begin + StackTop().SetNameSpace(nmspc); + end; + if locNode.HasChildNodes then + Result := GetNodeItemsCount(locNode) + else + Result := 0; +end; + +procedure TSOAPBaseFormatter.EndScopeRead(); +begin + PopStack().Free(); +end; + +procedure TSOAPBaseFormatter.BeginHeader(); +begin + if ( FHeaderEnterCount <= 0 ) then begin + Inc(FHeaderEnterCount); + Prepare(); + BeginScope(sHEADER,sSOAP_ENV,sSOAP_ENV_ABR); + SetStyleAndEncoding(Document,Litteral); + end; +end; + +procedure TSOAPBaseFormatter.EndHeader(); +begin + if ( FHeaderEnterCount > 0 ) then begin + Dec(FHeaderEnterCount); + RestoreStyleAndEncoding(); + EndScope(); + end; +end; + +procedure TSOAPBaseFormatter.InternalClear(const ACreateDoc: Boolean); +begin + ClearStack(); + FreeAndNil(FDoc); + if ACreateDoc then + FDoc := TXMLDocument.Create(); +end; + +function TSOAPBaseFormatter.NextNameSpaceCounter(): Integer; +begin + Inc(FNameSpaceCounter); + Result := FNameSpaceCounter; +end; + +function TSOAPBaseFormatter.HasScope(): Boolean; +begin + Result := Assigned(FStack.Peek); +end; + +function TSOAPBaseFormatter.FindAttributeByValueInNode( + Const AAttValue : String; + Const ANode : TDOMNode; + Out AResAtt : string +):boolean; +Var + i,c : Integer; +begin + AResAtt := ''; + If Assigned(ANode) And Assigned(ANode.Attributes) Then Begin + c := Pred(ANode.Attributes.Length); + For i := 0 To c Do Begin + If AnsiSameText(AAttValue,ANode.Attributes.Item[i].NodeValue) Then Begin + AResAtt := ANode.Attributes.Item[i].NodeName; + Result := True; + Exit; + End; + End; + End; + Result := False; +end; + +function TSOAPBaseFormatter.FindAttributeByNameInNode( + const AAttName: String; + const ANode: TDOMNode; + Out AResAttValue: string +): boolean; +var + i,c : Integer; +begin + AResAttValue := ''; + If Assigned(ANode) And Assigned(ANode.Attributes) Then Begin + c := Pred(ANode.Attributes.Length); + For i := 0 To c Do Begin + If AnsiSameText(AAttName,ANode.Attributes.Item[i].NodeName) Then Begin + AResAttValue := ANode.Attributes.Item[i].NodeValue; + Result := True; + Exit; + End; + End; + End; + Result := False; +end; + +function TSOAPBaseFormatter.FindAttributeByValueInScope(const AAttValue: String): String; +Var + tmpNode : TDOMNode; +begin + If HasScope() Then Begin + tmpNode := GetCurrentScopeObject(); + While Assigned(tmpNode) Do Begin + If FindAttributeByValueInNode(AAttValue,tmpNode,Result) Then + Exit; + tmpNode := tmpNode.ParentNode; + End; + End; + Result := ''; +end; + +function TSOAPBaseFormatter.FindAttributeByNameInScope(const AAttName: String): String; +var + tmpNode : TDOMNode; +begin + if HasScope() then begin + tmpNode := GetCurrentScopeObject(); + while Assigned(tmpNode) do begin + if FindAttributeByNameInNode(AAttName,tmpNode,Result) then + Exit; + tmpNode := tmpNode.ParentNode; + end; + end; + Result := ''; +end; + +procedure TSOAPBaseFormatter.CheckScope(); +begin + If Not HasScope() Then + Error('There is no scope.'); +end; + +function ExtractNameSpaceShortName(const ANameSpaceDeclaration : string):string; +var + i : integer; +begin + i := AnsiPos(sXML_NS,ANameSpaceDeclaration); + if ( i > 0 ) then begin + Result := Copy(ANameSpaceDeclaration, (i + Length(sXML_NS) + 1 ), MaxInt ); + end else begin + Result := ''; + end; +end; + +function TSOAPBaseFormatter.InternalPutData( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : string +): TDOMNode; +Var + namespaceLongName, namespaceShortName, strName, strNodeName, s : string; + regItem : TTypeRegistryItem; +begin + strNodeName := AName; + if ( Style = Document ) then begin + namespaceShortName := Copy(FindAttributeByValueInScope(StackTop().NameSpace),AnsiPos(':',namespaceShortName) + 1,MaxInt); + if not IsStrEmpty(namespaceShortName) then begin + s := ExtractNameSpaceShortName(namespaceShortName); + if not IsStrEmpty(s) then + strNodeName := s + ':' + strNodeName; + end; + end; + + if ( FSerializationStyle = ssNodeSerialization ) then begin + Result := FDoc.CreateElement(strNodeName); + Result.AppendChild(FDoc.CreateTextNode(AData)); + GetCurrentScopeObject().AppendChild(Result); + end else begin + Result := GetCurrentScopeObject(); + (Result as TDOMElement).SetAttribute(strNodeName,AData); + end; + If ( EncodingStyle = Encoded ) Then Begin + regItem := GetTypeRegistry().ItemByTypeInfo[ATypeInfo]; + strName := regItem.DeclaredName; + namespaceLongName := regItem.NameSpace; + If Not IsStrEmpty(namespaceLongName) Then Begin + namespaceShortName := FindAttributeByValueInScope(namespaceLongName); + If IsStrEmpty(namespaceShortName) Then Begin + namespaceShortName := Format('ns%d',[NextNameSpaceCounter()]); + AddScopeAttribute(sXML_NS + ':'+namespaceShortName,namespaceLongName); + End Else Begin + namespaceShortName := ExtractNameSpaceShortName(namespaceShortName);//Copy(namespaceShortName,AnsiPos(':',namespaceShortName) + 1,MaxInt); + End; + strName := Format('%s:%s',[namespaceShortName,strName]) + End; + (Result As TDOMElement).SetAttribute(sXSI_TYPE,strName); + End; +end; + +function TSOAPBaseFormatter.PutEnum( + const AName: String; + const ATypeInfo: PTypeInfo; + const AData: TEnumIntType +): TDOMNode; +begin + Result := InternalPutData(AName,ATypeInfo,GetEnumName(ATypeInfo,AData)); +end; + +function TSOAPBaseFormatter.PutBool( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : Boolean +): TDOMNode; +begin + Result := InternalPutData(AName,ATypeInfo,LowerCase(BoolToStr(AData))); +end; + +function TSOAPBaseFormatter.PutInt64( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : Int64 +): TDOMNode; +begin + Result := InternalPutData(AName,ATypeInfo,IntToStr(AData)); +end; + +function TSOAPBaseFormatter.PutStr( + const AName: String; + const ATypeInfo: PTypeInfo; + const AData: String +):TDOMNode; +begin + Result := InternalPutData(AName,ATypeInfo,AData); +end; + +procedure TSOAPBaseFormatter.PutObj( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : TObject +); +begin + TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Save(AData As TBaseRemotable, Self,AName,ATypeInfo); +end; + +function TSOAPBaseFormatter.PutFloat( + const AName : String; + const ATypeInfo : PTypeInfo; + const AData : Extended +):TDOMNode; +Var + s, frmt : string; + prcsn,i : Integer; +begin + Case GetTypeData(ATypeInfo)^.FloatType Of + ftSingle, + ftCurr, + ftComp : prcsn := 7; + ftDouble, + ftExtended : prcsn := 15; + End; + frmt := '#.' + StringOfChar('#',prcsn) + 'E-0'; + s := FormatFloat(frmt,AData); + i := Pos(',',s); + If ( i > 0 ) Then + s[i] := '.'; + Result := InternalPutData(AName,ATypeInfo,s); +end; + +function TSOAPBaseFormatter.GetNodeValue(var AName: String): DOMString; +Var + locElt : TDOMNode; + namespaceShortName, strNodeName, s : string; +begin + strNodeName := AName; + if ( Style = Document ) then begin + namespaceShortName := Copy(FindAttributeByValueInScope(StackTop().NameSpace),AnsiPos(':',namespaceShortName) + 1,MaxInt); + if not IsStrEmpty(namespaceShortName) then begin + s := ExtractNameSpaceShortName(namespaceShortName); + if not IsStrEmpty(s) then + strNodeName := s + ':' + strNodeName; + end; + end; + + if ( FSerializationStyle = ssNodeSerialization ) then begin + locElt := StackTop().FindNode(strNodeName) As TDOMElement; + end else begin + locElt := GetCurrentScopeObject().GetAttributeNode(strNodeName); + end; + + if Assigned(locElt) then begin + if locElt.HasChildNodes then + Result := locElt.FirstChild.NodeValue + else + Result := locElt.NodeValue; + end else begin + Error('Param not found : "%s"',[AName]); + end; + //WriteLn(StringOfChar(' ',FStack.Count), AName,' = ',Result); +end; + +procedure TSOAPBaseFormatter.GetEnum( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: TEnumIntType +); +Var + locBuffer : String; +begin + locBuffer := Trim(GetNodeValue(AName)); + If IsStrEmpty(locBuffer) Then + AData := 0 + Else + AData := GetEnumValue(ATypeInfo,locBuffer) +End; + +procedure TSOAPBaseFormatter.GetBool( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : Boolean +); +Var + locBuffer : String; +begin + locBuffer := LowerCase(Trim(GetNodeValue(AName))); + If IsStrEmpty(locBuffer) Then + AData := False + Else + AData := StrToBool(locBuffer); +end; + +procedure TSOAPBaseFormatter.GetInt( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: Integer +); +begin + AData := StrToIntDef(Trim(GetNodeValue(AName)),0); +end; + +procedure TSOAPBaseFormatter.GetInt64( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : Int64 +); +begin + AData := StrToInt64Def(Trim(GetNodeValue(AName)),0); +end; + +procedure TSOAPBaseFormatter.GetFloat( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : Extended +); +begin + AData := StrToFloatDef(Trim(GetNodeValue(AName)),0); +end; + +procedure TSOAPBaseFormatter.GetStr( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : String +); +begin + AData := GetNodeValue(AName); +end; + +procedure TSOAPBaseFormatter.GetObj( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : TObject +); +begin + TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); +end; + +function TSOAPBaseFormatter.GetXmlDoc(): TXMLDocument; +begin + Result := FDoc; +end; + +function TSOAPBaseFormatter.GetCurrentScope(): String; +begin + CheckScope(); + Result:= GetCurrentScopeObject().NodeName; +end; + +function TSOAPBaseFormatter.GetCurrentScopeObject(): TDOMElement; +begin + Result := StackTop().ScopeObject As TDOMElement; +end; + +function TSOAPBaseFormatter.StackTop(): TStackItem; +begin + CheckScope(); + Result := FStack.Peek() as TStackItem; +end; + +function TSOAPBaseFormatter.PopStack(): TStackItem; +begin + CheckScope(); + Result := FStack.Pop() as TStackItem; +end; + +constructor TSOAPBaseFormatter.Create(); +begin + Inherited Create(); + FContentType := sSOAP_CONTENT_TYPE; + FStack := TObjectStack.Create(); + FDoc := TXMLDocument.Create(); + FDoc.Encoding := 'UTF-8'; +end; + +destructor TSOAPBaseFormatter.Destroy(); +begin + FDoc.Free(); + ClearStack(); + FStack.Free(); + inherited Destroy(); +end; + +procedure TSOAPBaseFormatter.Clear(); +begin + InternalClear(True); +end; + +procedure TSOAPBaseFormatter.BeginObject( + const AName : string; + const ATypeInfo : PTypeInfo +); +Var + typData : TTypeRegistryItem; + nmspc,nmspcSH : string; + mustAddAtt : Boolean; + strNodeName : string; +begin + typData := GetTypeRegistry().Find(ATypeInfo,False); + If Not Assigned(typData) Then + Error('Object type not registered : %s',[IfThen(Assigned(ATypeInfo),ATypeInfo^.Name,'')]); + mustAddAtt := False; + nmspc := typData.NameSpace; + If IsStrEmpty(nmspc) Then + nmspcSH := 'tns' + Else Begin + nmspcSH := FindAttributeByValueInScope(nmspc); + If IsStrEmpty(nmspcSH) Then Begin + nmspcSH := 'ns' + IntToStr(NextNameSpaceCounter()); + If HasScope() Then + AddScopeAttribute('xmlns:'+nmspcSH, nmspc) + Else Begin + mustAddAtt := True; + End; + End Else Begin + nmspcSH := Copy(nmspcSH,Length('xmlns:')+1,MaxInt); + End; + End; + + if ( Style = Document ) then begin + strNodeName := nmspcSH + ':' + AName; + end else begin + strNodeName := AName; + end; + + BeginScope(strNodeName,''); + If mustAddAtt Then + AddScopeAttribute('xmlns:'+nmspcSH, nmspc); + if ( EncodingStyle = Encoded ) then + AddScopeAttribute(sXSI_TYPE,Format('%s:%s',[nmspcSH,typData.DeclaredName])); + StackTop().SetNameSpace(nmspc); +end; + +procedure TSOAPBaseFormatter.BeginArray( + const AName : string; + const AItemTypeInfo : PTypeInfo; + const ABounds : array of Integer +); +Var + typData : TTypeRegistryItem; + nmspc,nmspcSH : string; + i,j, k : Integer; + strNodeName : string; +begin + If ( Length(ABounds) < 2 ) Then + Error('Invalid array bounds.'); + i := ABounds[0]; + j := ABounds[1]; + k := j - i + 1; + If ( k < 0 ) Then + Error('Invalid array bounds.'); + k := j - i + 1; + typData := GetTypeRegistry().Find(AItemTypeInfo,False); + If Not Assigned(typData) Then + Error('Array item''type not registered.'); + nmspc := typData.NameSpace; + If IsStrEmpty(nmspc) Then + nmspcSH := 'tns' + Else Begin + nmspcSH := FindAttributeByValueInScope(nmspc); + If IsStrEmpty(nmspcSH) Then Begin + nmspcSH := 'ns' + IntToStr(NextNameSpaceCounter()); + AddScopeAttribute('xmlns:'+nmspcSH, nmspc); + End; + End; + + if ( Style = Document ) then begin + strNodeName := nmspcSH + ':' + AName; + end else begin + strNodeName := AName; + end; + + BeginScope(strNodeName,''); + + if ( EncodingStyle = Encoded ) then begin + //AddScopeAttribute(sXSI_TYPE,nmspc); + //SOAP-ENC:arrayType="xsd:int[2]" + AddScopeAttribute( + Format('%s:%s',[sSOAP_ENC_ABR,sARRAY_TYPE]) , + Format('%s:%s[%d]',[nmspcSH,typData.DeclaredName,k]) + ); + end; + StackTop().SetNameSpace(nmspc); +end; + +procedure TSOAPBaseFormatter.NilCurrentScope(); +begin + CheckScope(); + GetCurrentScopeObject().SetAttribute(sXSI_NIL,'true'); +end; + +function TSOAPBaseFormatter.IsCurrentScopeNil(): Boolean; +Var + s,nsShortName,nilName : string; +begin + CheckScope(); + nsShortName := FindAttributeByValueInScope(sXSI_NS); + Result := False; + if not IsStrEmpty(nsShortName) then begin + nsShortName := Copy(nsShortName,1 + Pos(':',nsShortName),MaxInt); + if not IsStrEmpty(nsShortName) Then + nsShortName := nsShortName + ':'; + nilName := nsShortName + 'nil'; + s := Trim(GetCurrentScopeObject().GetAttribute(nilName)); + if ( Length(s) > 0 ) and ( AnsiSameText(s,'true') or AnsiSameText(s,'"true"') ) then + Result := True; + end +end; + +procedure TSOAPBaseFormatter.BeginScope( + Const AScopeName,ANameSpace : string; + Const ANameSpaceShortName : string; + Const AScopeType : TScopeType +); +Var + nsStr, scpStr : String; + e : TDOMElement; + hasNmspc, addAtt : Boolean; +begin + scpStr := AScopeName; + hasNmspc := Not IsStrEmpty(ANameSpace); + If hasNmspc Then Begin + nsStr := FindAttributeByValueInScope(ANameSpace); + addAtt := IsStrEmpty(nsStr); + If addAtt Then Begin + If IsStrEmpty(ANameSpaceShortName) Then + nsStr := 'ns' + IntToStr(NextNameSpaceCounter()) + Else + nsStr := Trim(ANameSpaceShortName); + End Else Begin + nsStr := Copy(nsStr,Succ(AnsiPos(':',nsStr)),MaxInt); + End; + scpStr := nsStr + ':' + scpStr; + End; + + e := FDoc.CreateElement(scpStr); + If HasScope() Then + GetCurrentScopeObject().AppendChild(e) + Else + FDoc.AppendChild(e); + PushStack(e,AScopeType); + if hasNmspc and addAtt then begin + e.SetAttribute('xmlns:'+nsStr,ANameSpace); + StackTop().SetNameSpace(ANameSpace); + end; +end; + +procedure TSOAPBaseFormatter.SetSerializationStyle(const ASerializationStyle: TSerializationStyle); +begin + FSerializationStyle := ASerializationStyle; +end; + +function TSOAPBaseFormatter.GetSerializationStyle(): TSerializationStyle; +begin + Result := FSerializationStyle; +end; + +procedure TSOAPBaseFormatter.SetStyleAndEncoding( + const AStyle: TSOAPDocumentStyle; + const AEncoding: TSOAPEncodingStyle +); +begin + FKeepedStyle := Style; + FKeepedEncoding := EncodingStyle; + Style := AStyle; + EncodingStyle := AEncoding; +end; + +procedure TSOAPBaseFormatter.RestoreStyleAndEncoding(); +begin + EncodingStyle := FKeepedEncoding; + Style := FKeepedStyle; +end; + +procedure TSOAPBaseFormatter.Prepare(); +var + locDoc : TDOMDocument; +begin + locDoc := GetXmlDoc(); + if Assigned(locDoc.DocumentElement) and + AnsiSameText(locDoc.DocumentElement.NodeName,( sSOAP_ENV_ABR + ':' + sENVELOPE )) + then begin + ClearStack(); + PushStack(locDoc.DocumentElement,stObject); + end else begin + BeginScope(sENVELOPE,sSOAP_ENV,sSOAP_ENV_ABR); + AddScopeAttribute('xmlns:xsi',sXSI_NS); + AddScopeAttribute('xmlns:'+sXSD, sXSD_NS); + AddScopeAttribute('xmlns:'+sSOAP_ENC_ABR, sSOAP_ENC); + end; +end; + +function TSOAPBaseFormatter.ReadHeaders(ACallContext: ICallContext): Integer; + + function ExtractTypeInfo(ANode : TDOMElement) : TTypeRegistryItem; + var + j : Integer; + ndName, nsSN, nsLN, s : string; + begin + ndName := ANode.NodeName; + j := Pos(':',ndName); + if ( j > 0 ) then + nsSN := Copy(ndName,1,Pred(j)) + else + nsSN := ''; + if IsStrEmpty(nsSN) then + s := sXML_NS + else + s := sXML_NS + ':' + nsSN; + nsLN := FindAttributeByNameInScope(s); + Result := GetTypeRegistry().FindByDeclaredName(Copy(ndName,Succ(j),MaxInt),nsLN); + end; + +var + i : Integer; + nd : TDOMElement; + typItm : TTypeRegistryItem; + tmpObj : THeaderBlock; + locName : string; + chdLst : TDOMNodeList; +begin + SetStyleAndEncoding(Document,Litteral); + try + Result := StackTop().ItemsCount; + if ( Result > 0 ) then begin + chdLst := StackTop().ScopeObject.ChildNodes; + try + for i := 0 to Pred(Result) do begin + nd := chdLst.Item[i] as TDOMElement; + typItm := ExtractTypeInfo(nd); + if Assigned(typItm) then begin + if ( typItm.DataType^.Kind = tkClass ) then begin + tmpObj := nil; + locName := nd.NodeName; + Get(typItm.DataType,locName,tmpObj); + if Assigned(tmpObj) then begin + tmpObj.Direction := hdIn; + ACallContext.AddHeader(tmpObj,True); + end; + end; + end; + end; + finally + chdLst.Release(); + end; + end; + finally + RestoreStyleAndEncoding(); + end; +end; + +function TSOAPBaseFormatter.WriteHeaders(ACallContext : ICallContext): Integer; +var + ptyp : PTypeInfo; + h : THeaderBlock; + i, c : Integer; +begin + Result := ACallContext.GetHeaderCount([hdOut]); + if ( Result > 0 ) then begin + BeginHeader(); + try + c := ACallContext.GetHeaderCount(AllHeaderDirection); + for i := 0 to Pred(c) do begin + h := ACallContext.GetHeader(i); + if ( h.Direction = hdOut ) then begin + ptyp := PTypeInfo(h.ClassInfo); + Put(GetTypeRegistry().ItemByTypeInfo[ptyp].DeclaredName,ptyp,h); + end; + end; + finally + EndHeader(); + end; + end; +end; + +procedure TSOAPBaseFormatter.EndScope(); +begin + CheckScope(); + FStack.Pop().Free(); +end; + +procedure TSOAPBaseFormatter.AddScopeAttribute(const AName, AValue: string); +begin + CheckScope(); + GetCurrentScopeObject().SetAttribute(AName,AValue); +end; + +procedure TSOAPBaseFormatter.Put( + const AName: String; + const ATypeInfo: PTypeInfo; + const AData +); +Var + int64Data : Int64; + strData : string; + objData : TObject; + boolData : Boolean; + enumData : TEnumIntType; + floatDt : Extended; +begin + Case ATypeInfo^.Kind Of + tkInt64, tkQWord : + Begin + int64Data := Int64(AData); + PutInt64(AName,ATypeInfo,int64Data); + End; + tkLString, tkAString : + Begin + strData := String(AData); + PutStr(AName,ATypeInfo,strData); + End; + tkClass : + Begin + objData := TObject(AData); + PutObj(AName,ATypeInfo,objData); + End; + tkBool : + Begin + boolData := Boolean(AData); + PutBool(AName,ATypeInfo,boolData); + End; + tkInteger, tkEnumeration : + Begin + enumData := 0; + Case GetTypeData(ATypeInfo)^.OrdType Of + otSByte : enumData := ShortInt(AData); + otUByte : enumData := Byte(AData); + otSWord : enumData := SmallInt(AData); + otUWord : enumData := Word(AData); + otSLong, + otULong : enumData := LongInt(AData); + End; + If ( ATypeInfo^.Kind = tkInteger ) Then + PutInt64(AName,ATypeInfo,enumData) + Else + PutEnum(AName,ATypeInfo,enumData); + End; + tkFloat : + Begin + floatDt := 0; + Case GetTypeData(ATypeInfo)^.FloatType Of + ftSingle : floatDt := Single(AData); + ftDouble : floatDt := Double(AData); + ftExtended : floatDt := Extended(AData); + ftCurr : floatDt := Currency(AData); + ftComp : floatDt := Comp(AData); + End; + PutFloat(AName,ATypeInfo,floatDt); + End; + End; +end; + +procedure TSOAPBaseFormatter.Get( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData +); +Var + int64Data : Int64; + strData : string; + objData : TObject; + boolData : Boolean; + enumData : TEnumIntType; + floatDt : Extended; +begin + Case ATypeInfo^.Kind Of + tkInt64,tkQWord : + Begin + int64Data := 0; + GetInt64(ATypeInfo,AName,int64Data); + Int64(AData) := int64Data; + End; + tkLString, tkAString : + Begin + strData := ''; + GetStr(ATypeInfo,AName,strData); + String(AData) := strData; + End; + tkClass : + Begin + objData := TObject(AData); + GetObj(ATypeInfo,AName,objData); + TObject(AData) := objData; + End; + tkBool : + Begin + boolData := False; + GetBool(ATypeInfo,AName,boolData); + Boolean(AData) := boolData; + End; + tkInteger, tkEnumeration : + Begin + enumData := 0; + If ( ATypeInfo^.Kind = tkInteger ) Then + GetInt64(ATypeInfo,AName,enumData) + Else + GetEnum(ATypeInfo,AName,enumData); + Case GetTypeData(ATypeInfo)^.OrdType Of + otSByte : ShortInt(AData) := enumData; + otUByte : Byte(AData) := enumData; + otSWord : SmallInt(AData) := enumData; + otUWord : Word(AData) := enumData; + otSLong, + otULong : LongInt(AData) := enumData; + End; + End; + tkFloat : + Begin + floatDt := 0; + GetFloat(ATypeInfo,AName,floatDt); + Case GetTypeData(ATypeInfo)^.FloatType Of + ftSingle : Single(AData) := floatDt; + ftDouble : Double(AData) := floatDt; + ftExtended : Extended(AData) := floatDt; + ftCurr : Currency(AData) := floatDt; + ftComp : Comp(AData) := floatDt; + End; + End; + End; +end; + +procedure TSOAPBaseFormatter.SaveToStream(AStream: TStream); +begin + WriteXMLFile(FDoc,AStream); +end; + +procedure TSOAPBaseFormatter.LoadFromStream(AStream: TStream); +Var + nd : TDOMNode; +begin + InternalClear(False); + ReadXMLFile(FDoc,AStream); + nd := GetXmlDoc().DocumentElement; + If Assigned(nd) Then + PushStack(nd); +end; + +procedure TSOAPBaseFormatter.Error(const AMsg: string); +begin + Raise ESOAPException.Create(AMsg); +end; + +procedure TSOAPBaseFormatter.Error(const AMsg: string;const AArgs: array of const); +begin + Raise ESOAPException.CreateFmt(AMsg,AArgs); +end; + +end. diff --git a/wst/tags/3.1/binary_formatter.pas b/wst/tags/3.1/binary_formatter.pas new file mode 100644 index 000000000..100d22d18 --- /dev/null +++ b/wst/tags/3.1/binary_formatter.pas @@ -0,0 +1,204 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit binary_formatter; + +{$mode objfpc}{$H+} + + +interface + +uses + Classes, SysUtils, TypInfo, + base_service_intf, service_intf, imp_utils, + base_binary_formatter; + +Const + sCONTENT_TYPE = 'contenttype'; + sBINARY_CONTENT = 'binary'; + sPROTOCOL_NAME = sBINARY_CONTENT; + + sTARGET = 'target'; + +Type + +{$M+} + TBinaryFormatter = class(TBaseBinaryFormatter,IFormatterClient) + private + FPropMngr : IPropertyManager; + FCallProcedureName : string; + FCallTarget : String; + protected + public + function GetPropertyManager():IPropertyManager; + + procedure BeginCall( + const AProcName, + ATarget : string; + ACallContext : ICallContext + ); + procedure EndCall(); + procedure BeginCallRead(ACallContext : ICallContext); + + function GetCallProcedureName():String; + function GetCallTarget():String; + End; + + + { TBinaryCallMaker } + + TBinaryCallMaker = class(TSimpleFactoryItem,ICallMaker) + Private + FPropMngr : IPropertyManager; + Public + constructor Create();override; + destructor Destroy();override; + function GetPropertyManager():IPropertyManager; + procedure MakeCall( + ASerializer : IFormatterClient; + ATransport : ITransport + ); + End; + +implementation + +function TBinaryFormatter.GetPropertyManager(): IPropertyManager; +begin + If Not Assigned(FPropMngr) Then + FPropMngr := TPublishedPropertyManager.Create(Self); + Result := FPropMngr; +end; + +procedure TBinaryFormatter.BeginCall( + const AProcName, + ATarget : string; + ACallContext : ICallContext +); +begin + FCallProcedureName := AProcName; + FCallTarget := ATarget; + + BeginObject('Body',Nil); + BeginObject(FCallTarget,Nil); + BeginObject(FCallProcedureName,Nil); +end; + +procedure TBinaryFormatter.EndCall(); +begin + EndScope(); + EndScope(); + EndScope(); +end; + +procedure TBinaryFormatter.BeginCallRead(ACallContext : ICallContext); +Var + s,nme : string; + e : EBaseRemoteException; +begin + ClearStack(); + PushStack(GetRootData(),stObject); + s := 'Body'; + BeginScopeRead(s,nil); + s := StackTop().GetByIndex(0)^.Name; + If AnsiSameText(s,'Fault') Then Begin + BeginScopeRead(s,nil,stObject); + e := EBaseRemoteException.Create(''); + Try + nme := 'faultcode'; + Get(TypeInfo(string),nme,s); + e.FaultCode := s; + nme := 'faultstring'; + Get(TypeInfo(string),nme,s); + e.FaultString := s; + e.Message := Format('%s : "%s"',[e.FaultCode,e.FaultString]); + Except + FreeAndNil(e); + Raise; + End; + Raise e; + End; + FCallTarget := s; + BeginScopeRead(FCallTarget,nil); + FCallProcedureName := StackTop().GetByIndex(0)^.Name; + BeginScopeRead(FCallProcedureName,nil); +end; + +function TBinaryFormatter.GetCallProcedureName(): String; +begin + Result := FCallProcedureName; +end; + +function TBinaryFormatter.GetCallTarget(): String; +begin + Result := FCallTarget; +end; + +{ TBinaryCallMaker } + +constructor TBinaryCallMaker.Create(); +begin + FPropMngr := TPublishedPropertyManager.Create(Self); +end; + +destructor TBinaryCallMaker.Destroy(); +begin + FPropMngr := Nil; + inherited Destroy(); +end; + +function TBinaryCallMaker.GetPropertyManager(): IPropertyManager; +begin + Result:= FPropMngr; +end; + +procedure TBinaryCallMaker.MakeCall( + ASerializer : IFormatterClient; + ATransport : ITransport +); +Var + rqt, rsps : TMemoryStream; +begin + Assert(Assigned(ASerializer)); + Assert(Assigned(ATransport)); + ATransport.GetPropertyManager().SetProperty( + sCONTENT_TYPE, + sBINARY_CONTENT + ); + rsps := Nil; + rqt := TMemoryStream.Create(); + Try + rsps := TMemoryStream.Create(); + ASerializer.SaveToStream(rqt); + rqt.Position := 0; + ATransport.SendAndReceive(rqt,rsps); + rqt.Clear(); + rsps.Position := 0; + ASerializer.Clear(); + ASerializer.LoadFromStream(rsps); + Finally + rsps.Free(); + rqt.Free(); + End; +end; + +procedure RegisterBinaryProtocol(); +begin + GetFormaterRegistry().Register( + sPROTOCOL_NAME, + TSimpleItemFactory.Create(TBinaryFormatter) as IItemFactory, + TSimpleItemFactory.Create(TBinaryCallMaker) as IItemFactory + ); +end; + +Initialization + RegisterBinaryProtocol(); +end. diff --git a/wst/tags/3.1/binary_streamer.pas b/wst/tags/3.1/binary_streamer.pas new file mode 100644 index 000000000..14283208d --- /dev/null +++ b/wst/tags/3.1/binary_streamer.pas @@ -0,0 +1,436 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit binary_streamer; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +Const + MAX_ARRAY_LENGTH = 1024*1024; + +Type + + TInt8U = Byte; TInt8S = ShortInt; + TInt16U = Word; TInt16S = SmallInt; + TInt32U = LongWord; TInt32S = LongInt; + TInt64S = Int64;TInt64U = QWord; + TBoolData = Boolean; + TEnumData = Int64; + TStringData = AnsiString; + + TFloat_Single_4 = Single; + TFloat_Double_8 = Double; + TFloat_Extended_10 = Extended; + TFloat_Currency_8 = Currency; + + IDataStore = Interface + ['{CA767A0E-7660-4765-9959-6960A69B1660}'] + procedure WriteInt8U(Const AData : TInt8U); + procedure WriteInt8S(Const AData : TInt8S); + + procedure WriteInt16U(Const AData : TInt16U); + procedure WriteInt16S(Const AData : TInt16S); + + procedure WriteInt32U(Const AData : TInt32U); + procedure WriteInt32S(Const AData : TInt32S); + + procedure WriteInt64U(Const AData : TInt64U); + procedure WriteInt64S(Const AData : TInt64S); + + procedure WriteBool(Const AData : TBoolData); + procedure WriteEnum(Const AData : TEnumData); + procedure WriteStr(Const AData : TStringData); + + procedure WriteSingle(Const AData : TFloat_Single_4); + procedure WriteDouble(Const AData : TFloat_Double_8); + procedure WriteExtended(Const AData : TFloat_Extended_10); + procedure WriteCurrency(Const AData : TFloat_Currency_8); + End; + + IDataStoreReader = Interface + ['{AF50317E-6DD6-40C5-A2F6-3ED5F478564F}'] + function IsAtEof():Boolean; + function ReadInt8U():TInt8U; + function ReadInt8S():TInt8S; + + function ReadInt16U():TInt16U; + function ReadInt16S():TInt16S; + + function ReadInt32U():TInt32U; + function ReadInt32S():TInt32S; + + function ReadInt64U():TInt64U; + function ReadInt64S():TInt64S; + + function ReadBool():TBoolData; + function ReadEnum():TEnumData; + function ReadStr():TStringData; + + function ReadSingle():TFloat_Single_4; + function ReadDouble():TFloat_Double_8; + function ReadExtended():TFloat_Extended_10; + function ReadCurrency():TFloat_Currency_8; + End; + + function CreateBinaryReader(AStream : TStream):IDataStoreReader; + function CreateBinaryWriter(AStream : TStream):IDataStore; + + procedure ReverseBytes(var AData; const ALength : Integer);{$IFDEF ENDIAN_BIG}inline;{$ENDIF} + function Reverse_16(AValue:Word):Word;inline; + function Reverse_32(AValue:DWord):DWord;inline; + function Reverse_64(AValue:QWord):QWord;inline; + + function Reverse_Single(AValue:Single):Single;inline; + function Reverse_Double(AValue:Double):Double;inline; + function Reverse_Extended(AValue:Extended):Extended;inline; + function Reverse_Currency(AValue:Currency):Currency;inline; + +implementation + +{$IFDEF ENDIAN_BIG} +procedure ReverseBytes(var AData; const ALength : Integer);inline; +begin +end; +{$ELSE} // assume ENDIAN_LITTLE +procedure ReverseBytes(var AData; const ALength : Integer); +Var + i,j : PtrInt; + c : Byte; + pDt : ^Byte; +begin + pDt := @AData; + j := ALength div 2; + For i := 0 To Pred(j) Do Begin + c := pDt[i]; + pDt[i] := pDt[(ALength - 1 ) - i]; + pDt[(ALength - 1 ) - i] := c; + End; +end; +{$ENDIF} + +function Reverse_16(AValue:Word):Word;inline; +begin + Result := AValue; + ReverseBytes(Result,2) +end; + +function Reverse_32(AValue:DWord):DWord;inline; +begin + Result := AValue; + ReverseBytes(Result,4) +end; + +function Reverse_64(AValue:QWord):QWord;inline; +begin + Result := AValue; + ReverseBytes(Result,8) +end; + +function Reverse_Single(AValue:Single):Single;inline; +begin + Result := AValue; + ReverseBytes(Result,4) +end; + +function Reverse_Double(AValue:Double):Double;inline; +begin + Result := AValue; + ReverseBytes(Result,8) +end; + +function Reverse_Extended(AValue:Extended):Extended;inline; +begin + Result := AValue; + ReverseBytes(Result,10); +end; + +function Reverse_Currency(AValue:Currency):Currency;inline; +begin + Result := AValue; + ReverseBytes(Result,8); +end; + +Type + { TDataStore } + + TDataStore = class(TInterfacedObject,IDataStore) + Private + FStream : TStream; + Protected + procedure WriteInt8U(Const AData : TInt8U); + procedure WriteInt8S(Const AData : TInt8S); + + procedure WriteInt16U(Const AData : TInt16U); + procedure WriteInt16S(Const AData : TInt16S); + + procedure WriteInt32U(Const AData : TInt32U); + procedure WriteInt32S(Const AData : TInt32S); + + procedure WriteInt64U(Const AData : TInt64U); + procedure WriteInt64S(Const AData : TInt64S); + + procedure WriteBool(Const AData : TBoolData); + procedure WriteEnum(Const AData : TEnumData); + procedure WriteStr(Const AData : TStringData); + + procedure WriteSingle(Const AData : TFloat_Single_4); + procedure WriteDouble(Const AData : TFloat_Double_8); + procedure WriteExtended(Const AData : TFloat_Extended_10); + procedure WriteCurrency(Const AData : TFloat_Currency_8); + Public + constructor Create(AStream : TStream); + End; + + { TDataStoreReader } + + TDataStoreReader = class(TInterfacedObject,IDataStoreReader) + Private + FStream : TStream; + Protected + function IsAtEof():Boolean; + function ReadInt8U():TInt8U; + function ReadInt8S():TInt8S; + + function ReadInt16U():TInt16U; + function ReadInt16S():TInt16S; + + function ReadInt32U():TInt32U; + function ReadInt32S():TInt32S; + + function ReadInt64U():TInt64U; + function ReadInt64S():TInt64S; + + function ReadBool():TBoolData; + function ReadEnum():TEnumData; + function ReadStr():TStringData; + + function ReadSingle():TFloat_Single_4; + function ReadDouble():TFloat_Double_8; + function ReadExtended():TFloat_Extended_10; + function ReadCurrency():TFloat_Currency_8; + Public + constructor Create(AStream : TStream); + End; + +function CreateBinaryWriter(AStream : TStream):IDataStore; +begin + Result := TDataStore.Create(AStream) As IDataStore; +end; + +function CreateBinaryReader(AStream : TStream):IDataStoreReader; +begin + Result := TDataStoreReader.Create(AStream) As IDataStoreReader; +end; + +{ TDataStore } + +procedure TDataStore.WriteInt8U(const AData: TInt8U); +begin + FStream.Write(AData,SizeOf(AData)); +end; + +procedure TDataStore.WriteInt8S(const AData: TInt8S); +begin + FStream.Write(AData,SizeOf(AData)); +end; + +procedure TDataStore.WriteInt16U(const AData: TInt16U); +begin + FStream.Write(Reverse_16(AData),SizeOf(AData)); +end; + +procedure TDataStore.WriteInt16S(const AData: TInt16S); +begin + FStream.Write(Reverse_16(AData),SizeOf(AData)); +end; + +procedure TDataStore.WriteInt32U(const AData: TInt32U); +begin + FStream.Write(Reverse_32(AData),SizeOf(AData)); +end; + +procedure TDataStore.WriteInt32S(const AData: TInt32S); +begin + FStream.Write(Reverse_32(AData),SizeOf(AData)); +end; + +procedure TDataStore.WriteInt64U(const AData: TInt64U); +begin + FStream.Write(Reverse_64(AData),SizeOf(AData)); +end; + +procedure TDataStore.WriteInt64S(const AData: TInt64S); +begin + FStream.Write(Reverse_64(AData),SizeOf(AData)); +end; + +procedure TDataStore.WriteBool(const AData: TBoolData); +Var + i : TInt8U; +begin + If AData Then + i := 1 + Else + i := 0; + WriteInt8U(i); +end; + +procedure TDataStore.WriteEnum(const AData: TEnumData); +begin + WriteInt64S(AData); +end; + +procedure TDataStore.WriteStr(const AData: TStringData); +Var + i : TInt32S; +begin + i := Length(AData); + WriteInt32S(i); + If ( i > 0 ) Then + FStream.Write(AData[1],i); +end; + +procedure TDataStore.WriteSingle(const AData: TFloat_Single_4); +begin + FStream.Write(Reverse_Single(AData),SizeOf(AData)); +end; + +procedure TDataStore.WriteDouble(const AData: TFloat_Double_8); +begin + FStream.Write(Reverse_Double(AData),SizeOf(AData)); +end; + +procedure TDataStore.WriteExtended(const AData: TFloat_Extended_10); +begin + FStream.Write(Reverse_Extended(AData),SizeOf(AData)); +end; + +procedure TDataStore.WriteCurrency(const AData: TFloat_Currency_8); +begin + FStream.Write(Reverse_Currency(AData),SizeOf(AData)); +end; + +constructor TDataStore.Create(AStream: TStream); +begin + Assert(Assigned(AStream)); + FStream := AStream; +end; + +{ TDataStoreReader } + +function TDataStoreReader.IsAtEof(): Boolean; +begin + Result := ( FStream.Position >= FStream.Size ); +end; + +function TDataStoreReader.ReadInt8U(): TInt8U; +begin + FStream.Read(Result,SizeOf(Result)); +end; + +function TDataStoreReader.ReadInt8S(): TInt8S; +begin + FStream.Read(Result,SizeOf(Result)); +end; + +function TDataStoreReader.ReadInt16U(): TInt16U; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_16(Result); +end; + +function TDataStoreReader.ReadInt16S(): TInt16S; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_16(Result); +end; + +function TDataStoreReader.ReadInt32U(): TInt32U; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_32(Result); +end; + +function TDataStoreReader.ReadInt32S(): TInt32S; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_32(Result); +end; + +function TDataStoreReader.ReadInt64U(): TInt64U; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_64(Result); +end; + +function TDataStoreReader.ReadInt64S(): TInt64S; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_64(Result); +end; + +function TDataStoreReader.ReadBool(): TBoolData; +begin + Result := ( ReadInt8U() > 0 ); +end; + +function TDataStoreReader.ReadEnum(): TEnumData; +begin + Result := ReadInt64S(); +end; + +function TDataStoreReader.ReadStr(): TStringData; +Var + i : TInt32S; +begin + i := ReadInt32S(); + SetLength(Result,i); + If ( i > 0 ) Then + FStream.ReadBuffer(Result[1],i); +end; + +function TDataStoreReader.ReadSingle(): TFloat_Single_4; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_Single(Result); +end; + +function TDataStoreReader.ReadDouble(): TFloat_Double_8; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_Double(Result); +end; + +function TDataStoreReader.ReadExtended(): TFloat_Extended_10; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_Extended(Result); +end; + +function TDataStoreReader.ReadCurrency(): TFloat_Currency_8; +begin + FStream.Read(Result,SizeOf(Result)); + Result := Reverse_Currency(Result); +end; + +constructor TDataStoreReader.Create(AStream: TStream); +begin + Assert(Assigned(AStream)); + FStream := AStream; +end; + +end. diff --git a/wst/tags/3.1/doc/WebServiceToolKit.odt b/wst/tags/3.1/doc/WebServiceToolKit.odt new file mode 100644 index 000000000..b63291cc2 Binary files /dev/null and b/wst/tags/3.1/doc/WebServiceToolKit.odt differ diff --git a/wst/tags/3.1/doc/WebServiceToolKit.rtf b/wst/tags/3.1/doc/WebServiceToolKit.rtf new file mode 100644 index 000000000..f7d76618f --- /dev/null +++ b/wst/tags/3.1/doc/WebServiceToolKit.rtf @@ -0,0 +1,1170 @@ +{\rtf1\ansi\deff1\adeflang1025 +{\fonttbl{\f0\froman\fprq2\fcharset0 Times New Roman;}{\f1\froman\fprq2\fcharset0 Nimbus Roman No9 L;}{\f2\fswiss\fprq2\fcharset0 Nimbus Sans L{\*\falt Arial};}{\f3\fnil\fprq1\fcharset0 Courier 10 Pitch;}{\f4\fmodern\fprq1\fcharset0 Courier New;}{\f5\fnil\fprq0\fcharset2 StarSymbol{\*\falt Arial Unicode MS};}{\f6\fnil\fprq2\fcharset0 Nimbus Sans L{\*\falt Arial};}{\f7\fnil\fprq2\fcharset0 HG Mincho Light J{\*\falt msmincho};}} +{\colortbl;\red0\green0\blue0;\red0\green0\blue128;\red204\green204\blue204;\red128\green128\blue128;} +{\stylesheet{\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\snext1 Normal;} +{\s2\sa120\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\sbasedon1\snext2 Body Text;} +{\s3\sb240\sa120\keepn\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\afs28\lang255\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\loch\f2\fs28\lang1033\sbasedon1\snext2 Heading;} +{\s4\sb240\sa120\keepn\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b\sbasedon3\snext2{\*\soutlvl0} heading 1;} +{\s5\sb240\sa120\keepn\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b\sbasedon3\snext2{\*\soutlvl1} heading 2;} +{\s6\sb240\sa120\keepn\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b\sbasedon3\snext2{\*\soutlvl2} heading 3;} +{\s7\sb240\sa120\keepn\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b\sbasedon3\snext2{\*\soutlvl3} heading 4;} +{\s8\sb240\sa120\keepn\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\afs23\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\b\loch\f2\fs23\lang1033\b\sbasedon3\snext2{\*\soutlvl4} heading 5;} +{\s9\sb240\sa120\keepn\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\afs21\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs21\lang1033\b\loch\f2\fs21\lang1033\b\sbasedon3\snext2{\*\soutlvl5} heading 6;} +{\s10\cf0\tqc\tx4818\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\sbasedon1\snext10 header;} +{\s11\li283\ri0\lin283\rin0\fi-283\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs20\lang1033\loch\f1\fs20\lang1033\sbasedon1\snext11 footnote text;} +{\s12\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\sbasedon1\snext12 Index;} +{\s13\sb240\sa120\keepn\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b\sbasedon3\snext13 Contents Heading;} +{\s14\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\sbasedon12\snext14 toc 1;} +{\s15\li283\ri0\lin283\rin0\fi0\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\sbasedon12\snext15 toc 2;} +{\s16\li566\ri0\lin566\rin0\fi0\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\sbasedon12\snext16 toc 3;} +{\s17\li849\ri0\lin849\rin0\fi0\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\sbasedon12\snext17 toc 4;} +{\s18\li1132\ri0\lin1132\rin0\fi0\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\sbasedon12\snext18 toc 5;} +{\s19\li1415\ri0\lin1415\rin0\fi0\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033\sbasedon12\snext19 toc 6;} +{\s20\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af4\afs20\lang255\ltrch\dbch\af4\langfe255\hich\f4\fs20\lang1033\loch\f4\fs20\lang1033\sbasedon1\snext20 Preformatted Text;} +{\*\cs22\cf0\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 Footnote Symbol;} +{\*\cs23\cf0\rtlch\af5\afs18\lang255\ltrch\dbch\af5\langfe255\hich\f5\fs18\lang1033\loch\f5\fs18\lang1033 Bullet Symbols;} +{\*\cs24\cf2\ul\ulc0\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 Internet link;} +{\*\cs25\cf0\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 Endnote Symbol;} +{\*\cs26\cf0{\*\updnprop5801}\up10\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 Footnote anchor;} +{\*\cs27\cf0{\*\updnprop5801}\up10\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 Endnote anchor;} +}{\*\listtable{\list\listtemplateid1 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid1} +{\list\listtemplateid2 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10146 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid2} +{\list\listtemplateid3 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid3} +{\list\listtemplateid4 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid4} +{\list\listtemplateid5 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid5} +{\list\listtemplateid6 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid6} +{\list\listtemplateid7 +{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'00.;}{\levelnumbers\'01;}\fi-360\li720} +{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'01.;}{\levelnumbers\'01;}\fi-360\li1080} +{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'02.;}{\levelnumbers\'01;}\fi-360\li1440} +{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'03.;}{\levelnumbers\'01;}\fi-360\li1800} +{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'04.;}{\levelnumbers\'01;}\fi-360\li2160} +{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'05.;}{\levelnumbers\'01;}\fi-360\li2520} +{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'06.;}{\levelnumbers\'01;}\fi-360\li2880} +{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'07.;}{\levelnumbers\'01;}\fi-360\li3240} +{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'08.;}{\levelnumbers\'01;}\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'09.;}{\levelnumbers\'01;}\fi-360\li3960}}\listid7} +{\list\listtemplateid8 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid8} +{\list\listtemplateid9 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid9} +{\list\listtemplateid10 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid10} +{\list\listtemplateid11 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10132 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid11} +{\list\listtemplateid12 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u57354 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid12} +{\list\listtemplateid13 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li720} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1080} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1440} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li1800} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2160} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2520} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li2880} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3240} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u10004 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-360\li3960}}\listid13} +{\list\listtemplateid14 +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li707} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li1414} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li2121} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li2828} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li3535} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li4242} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li4949} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li5656} +{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li6363} +{\*\soutlvl{\listlevel\levelnfc23\leveljc0\levelstartat1\levelfollow0{\leveltext \'01\u8226 ?;}{\levelnumbers;}\f5\fs18\f5\fs18\f5\fs18\f5\fi-283\li7070}}\listid14} +{\list\listtemplateid15 +{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'00);}{\levelnumbers\'02;}\fi-360\li720} +{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'01);}{\levelnumbers\'02;}\fi-360\li1080} +{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'02);}{\levelnumbers\'02;}\fi-360\li1440} +{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'03);}{\levelnumbers\'02;}\fi-360\li1800} +{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'04);}{\levelnumbers\'02;}\fi-360\li2160} +{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'05);}{\levelnumbers\'02;}\fi-360\li2520} +{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'06);}{\levelnumbers\'02;}\fi-360\li2880} +{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'07);}{\levelnumbers\'02;}\fi-360\li3240} +{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'08);}{\levelnumbers\'02;}\fi-360\li3600} +{\*\soutlvl{\listlevel\levelnfc4\leveljc0\levelstartat1\levelfollow0{\leveltext \'03(\'09);}{\levelnumbers\'02;}\fi-360\li3960}}\listid15} +}{\listoverridetable{\listoverride\listid1\listoverridecount0\ls0}{\listoverride\listid2\listoverridecount0\ls1}{\listoverride\listid3\listoverridecount0\ls2}{\listoverride\listid4\listoverridecount0\ls3}{\listoverride\listid5\listoverridecount0\ls4}{\listoverride\listid6\listoverridecount0\ls5}{\listoverride\listid7\listoverridecount0\ls6}{\listoverride\listid8\listoverridecount0\ls7}{\listoverride\listid9\listoverridecount0\ls8}{\listoverride\listid10\listoverridecount0\ls9}{\listoverride\listid11\listoverridecount0\ls10}{\listoverride\listid12\listoverridecount0\ls11}{\listoverride\listid13\listoverridecount0\ls12}{\listoverride\listid14\listoverridecount0\ls13}{\listoverride\listid15\listoverridecount0\ls14}} + +{\info{\title Web Service Toolkit for FPC & Lazarus}{\keywords Web Service FPC, Lazarus}{\creatim\yr2006\mo4\dy20\hr13\min39}{\revtim\yr2006\mo8\dy21\hr14\min36}{\printim\yr1601\mo1\dy1\hr0\min0}{\comment StarWriter}{\vern6800}}\deftab709 +{\*\pgdsctbl +{\pgdsc0\pgdscuse195\pgwsxn11905\pghsxn16837\marglsxn1134\margrsxn1134\margtsxn1134\margbsxn1134\headery0{\*\headeryb283\headerxl0\headerxr0\headeryh0}{\header \pard\plain \s10\cf0\ul\ulc0\qr\tqc\tx4818\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ab\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\b\loch\f1\fs24\lang1033\b {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b Web Service Toolkit for FPC & Lazarus} +\par } +\pgdscnxt0 Standard;} +{\pgdsc1\pgdscuse195\pgwsxn11905\pghsxn16837\marglsxn1134\margrsxn1134\margtsxn1134\margbsxn1134\pgdscnxt1 Footnote;} +{\pgdsc2\pgdscuse195\pgwsxn11905\pghsxn16837\marglsxn1134\margrsxn1134\margtsxn1134\margbsxn1134\pgdscnxt2 Endnote;}} +\paperh16837\paperw11905\margl1134\margr1134\margt1134\margb1134\sectd\sbknone\pgwsxn11905\pghsxn16837\marglsxn1134\margrsxn1134\margtsxn1693\margbsxn1134\headery1134{\header \pard\plain \s10\cf0\ul\ulc0\qr\tqc\tx4818\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ab\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\b\loch\f1\fs24\lang1033\b {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b Web Service Toolkit for FPC & Lazarus} +\par } +\ftnbj\ftnstart1\ftnrstcont\ftnnar\aenddoc\aftnrstcont\aftnstart1\aftnnrlc +\pard\plain \sb240\sa120\keepn\f2\fs32\b\f7\fs32\b\fs32\b\qr \ltrpar\s4\cf0\qr{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b +\par \pard\plain \sb240\sa120\keepn\f2\fs32\b\f7\fs32\b\fs32\b \ltrpar\s4\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b +\par \pard\plain \sb240\sa120\keepn\f2\fs32\b\f7\fs32\b\fs32\b \ltrpar\s4\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b +\par \pard\plain \sb240\sa120\keepn\f2\fs32\b\f7\fs32\b\fs32\b \ltrpar\s4\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b +\par \pard\plain \sb240\sa120\keepn\f2\fs32\b\f7\fs32\b\fs32\b \ltrpar\s4\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b +\par \pard\plain \sb240\sa120\keepn\f2\fs32\b\f7\fs32\b\fs32\b \ltrpar\s4\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b +\par \pard\plain \ltrpar\s1\cf0\ul\ulc0\qc{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs96\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs96\lang1033\loch\f1\fs96\lang1033 {\rtlch \ltrch\loch\f1\fs96\lang1033\i0\b0 Web Service Toolkit for FPC & Lazarus} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs96\lang1033\i0\b0 0.3.1} +\par \pard\plain \ltrpar\s1\cf0\qc{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs96\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs96\lang1033\loch\f1\fs96\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs40\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs40\lang1033\loch\f1\fs40\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\ul\ulc0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs40\lang255\ab\ltrch\dbch\af6\langfe255\hich\f1\fs40\lang1033\b\loch\f1\fs40\lang1033\b {\rtlch \ltrch\loch\f1\fs40\lang1033\i0\b Inoussa OUEDRAOGO} +\par \page\sect\sbknone\cols1\ltrsect +\pard\plain \ltrpar\s13\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b {\rtlch \ltrch\loch\f2\fs32\lang1033\i0\b Table des mati\'e8res} +\par \pard\plain \ltrpar\s14\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Web Service Toolkit for FPC & Lazarus\tab 4} +\par \pard\plain \ltrpar\s15\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li283\ri0\lin283\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Client Side ( service consumption )\tab 5} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 overview\tab 5} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Example\tab 5} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Connection Parameters \tab 8} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 HTTP Proxy Parameters \tab 8} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Multi-Address service ( Address per operation )\tab 9} +\par \pard\plain \ltrpar\s15\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li283\ri0\lin283\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Server Side ( service creation )\tab 10} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Overview.\tab 10} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Example\tab 10} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Defining the service Interface\tab 10} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Providing an implementation for the service\tab 11} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Providing a binder for the service.\tab 13} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Host the service into an application server.\tab 14} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 WSDL generation.\tab 17} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The Meta data Service.\tab 18} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 WSDL generation API.\tab 18} +\par \pard\plain \ltrpar\s18\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li1132\ri0\lin1132\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 WSDL Customization.\tab 18} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Sample\tab 18} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Services Extensions \'96 Server side\tab 18} +\par \pard\plain \ltrpar\s15\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li283\ri0\lin283\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Services meta data.\tab 20} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Extended Meta data.\tab 20} +\par \pard\plain \ltrpar\s15\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li283\ri0\lin283\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Headers support.\tab 22} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The THeaderBlock class \tab 22} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Defining header class.\tab 22} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The ICallContext interface.\tab 22} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Client side headers.\tab 23} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Server side headers.\tab 23} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The ICallControl interface.\tab 23} +\par \pard\plain \ltrpar\s15\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li283\ri0\lin283\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 SOAP Specific.\tab 25} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Binding style.\tab 25} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Client side.\tab 25} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Server side.\tab 25} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Encoding style.\tab 25} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Client side.\tab 25} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Server side.\tab 25} +\par \pard\plain \ltrpar\s15\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li283\ri0\lin283\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Provided examples\tab 26} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Client side examples\tab 26} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Server side examples\tab 26} +\par \pard\plain \ltrpar\s15\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li283\ri0\lin283\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Status\tab 26} +\par \pard\plain \ltrpar\s16\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li566\ri0\lin566\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Serialization\tab 26} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 SOAP serializer\tab 26} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Binary serializer\tab 27} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Class type serialization. \tab 27} +\par \pard\plain \ltrpar\s18\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li1132\ri0\lin1132\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The root \'93TBaseRemotable\'94 class.\tab 28} +\par \pard\plain \ltrpar\s18\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li1132\ri0\lin1132\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The \'93TBaseComplexRemotable\'94 serialization.\tab 28} +\par \pard\plain \ltrpar\s19\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li1415\ri0\lin1415\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Attribute properties.\tab 29} +\par \pard\plain \ltrpar\s18\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li1132\ri0\lin1132\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Provided array implementations.\tab 29} +\par \pard\plain \ltrpar\s17\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li849\ri0\lin849\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Test cases\tab 30} +\par \pard\plain \ltrpar\s15\cf0\tldot\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\li283\ri0\lin283\rin0\fi0\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Author\tab 30} +\par \sect\sectd\sbknone\pgwsxn11905\pghsxn16837\marglsxn1134\margrsxn1134\margtsxn1693\margbsxn1134\headery1134{\header \pard\plain \s10\cf0\ul\ulc0\qr\tqc\tx4818\tqr\tx9637{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ab\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\b\loch\f1\fs24\lang1033\b {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b Web Service Toolkit for FPC & Lazarus} +\par } + +\pard\plain \sb240\sa120\keepn\f2\fs32\b\f7\fs32\b\fs32\b \ltrpar\s4\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b +\par \page\pard\plain \sb240\sa120\keepn\f2\fs32\b\f7\fs32\b\fs32\b \ltrpar\s4\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs32\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs32\lang1033\b\loch\f2\fs32\lang1033\b {\rtlch \ltrch\loch\f2\fs32\lang1033\i0\b Web Service Toolkit f{\fs28 or FPC & Lazarus}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs28\lang255\ai\ltrch\dbch\af6\langfe255\hich\f1\fs28\lang1033\i\loch\f1\fs28\lang1033\i {\rtlch \ltrch\loch \'93}{\rtlch \ltrch\loch\f1\fs28\lang1033\i\b0 Web Service Toolkit\'94 is a web services package for FPC and Lazarus; \'93Web Service Toolkit\'94 is meant to ease web services {\b consumption and creation} by FPC and Lazarus users.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b +\par \page\pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i\b Client Side ( service consumption )} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b overview} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch \'93}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Web Service Toolkit\'94 is made of two parts, a command line tool \'93ws_helper\'94 and a collection of support units. Given an interface definition file( describing \'e0 web service ), \'93ws_helper\'94 will create a FPC unit containing a proxy implementing that interfa +ce. At runtime when a call targeting the web service is issued, the proxy's role is to :} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj (a)\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls14\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 marshall the call parameters, } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj (b)\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls14\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 make the call to the target web service, } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj (c)\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls14\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 receive the call return and unmarshall output parameters to the caller.} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj \tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Behind the scene, the proxy will take care of the SOAP plumbing details.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Example} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 We will use the {\i \'93google web api\'94}, freely available for personal use at this address \'93http://www.google.com/apis/\'94.In order to use this service, we have to translate its exposed WSDL interface to Pascal langage. By now \'93Web Service Toolkit\'94 does not contai +n a WSDL to pascal compiler, so we will assume this translation available as below ( this is an incomplete translation, but it's enough for the sample ).} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [code]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Unit googlewebapi;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$mode objfpc\}\{$H+\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 uses SysUtils, Classes;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Type} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 IGoogleSearch = Interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function doSpellingSuggestion(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const key:string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const phrase:string} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ):string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Implementation} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Invoking \'93ws_helper\'94 at the prompt with the file \'93googlewebapi.pas\'94 as argument will produce a file \'93googlewebapi_proxy.pas\'94 as below;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [code]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Unit googlewebapi_proxy;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$mode objfpc\}\{$H+\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Uses SysUtils, Classes, base_service_intf, service_intf, googlewebapi;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Type} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TGoogleSearch_Proxy=class(TBaseProxy,IGoogleSearch)} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Protected} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 class function GetServiceType() : PTypeInfo;override;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function doSpellingSuggestion(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const key : string; } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const phrase : string} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ):string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Implementation} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 uses LResources, metadata_repository;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{ TGoogleSearch_Proxy implementation \}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 class function TGoogleSearch_Proxy.GetServiceType() : PTypeInfo;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 result := TypeInfo(IGoogleSearch);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function TGoogleSearch_Proxy.doSpellingSuggestion(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const key : string; } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const phrase : string} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ):string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Var} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locSerializer : IFormatterClient;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 strPrmName : string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locSerializer := GetSerializer();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Try} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locSerializer.BeginCall('doSpellingSuggestion', GetTarget(),(Self as ICallContext));} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locSerializer.Put('key', TypeInfo(string), key);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locSerializer.Put('phrase', TypeInfo(string), phrase);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locSerializer.EndCall();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 MakeCall();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locSerializer.BeginCallRead((Self as ICallContext));} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 strPrmName := 'return';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locSerializer.Get(TypeInfo(string), strPrmName, result);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Finally} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locSerializer.Clear();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 initialization} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$i googlewebapi.lrs\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$IF DECLARED(Register_googlewebapi_ServiceMetadata)\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Register_googlewebapi_ServiceMetadata();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$ENDIF\} } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Then we can build a sample program for the {\f3 \'93IGoogleSearch\'94} service(see below). In order to compile this program you must have Indy ( tested with Indy10 ) which can be found at this location \'93{\field{\*\fldinst HYPERLINK "http://www.indyproject.org/Sockets/index.en.iwp" }{\fldrslt \*\cs24\cf2\ul\ulc0\rtlch\ltrch\dbch\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 http://www.indyproject.org/Sockets/index.en.iwp}}\'94 or ICS( tested +with the latest ICS-V5 Distribution ) at that address \'93http://www.overbyte.be/frame_index.html\'94 as it is used for the HTTP protocol.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [code]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 program test_google_api;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$mode objfpc\}\{$H+\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 uses} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Classes, SysUtils,} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 service_intf, soap_formatter,} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 //indy_http_protocol,} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ics_http_protocol,} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 googlewebapi, googlewebapi_proxy;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 sADDRESS = 'http:address=http://api.google.com/search/beta2';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 sTARGET = 'urn:GoogleSearch';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 sKEY = '';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 sSERVICE_PROTOCOL = 'SOAP';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Var} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 tmpObj : IGoogleSearch;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 strBuffer : string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ICS_RegisterHTTP_Transport();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 WriteLn();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 WriteLn('Enter phrase to spell :');} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ReadLn(strBuffer);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 tmpObj := TGoogleSearch_Proxy.Create(sTARGET,sSERVICE_PROTOCOL,sADDRESS);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Try} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 strBuffer := tmpObj.doSpellingSuggestion(sKEY,strBuffer);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 WriteLn('google spell >>> ',strBuffer);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Except} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 On E : Exception Do} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 WriteLn(E.Message);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ReadLn();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The units {\b service_intf, soap_formatter, indy_http_protocol, ics_http_protoco}l as provided with this toolkit; Below is the result of a execution session spelling for \'93freepscal lzarus\'94 written with a missing letter 'a' beetwen the letter 'p' and the the le +tter 's' and a missing letter 'a' between the letter 'L' and the the letter 'z' .} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Listing]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 E:\\Inoussa\\Sources\\lazarus\\wst\\v0.2> .\\tests\\google_api\\test_google_api} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Enter phrase to spell :} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 freepscal lzarus} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 google spell >>> freepascal lazarus} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/Listing]} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Google spells it correctly : \'93freepascal lazarus\'94!} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b\qj \ltrpar\s6\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Connection Parameters } +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b HTTP Proxy Parameters } +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 HTTP Connection through proxy are supported. Below is an example address string. } +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 sADDRESS = 'http:address=http://api.google.com/search/beta2'+} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ';ProxyServer=197.150.10.10;ProxyPort=9881'+} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ';ProxyUsername=inoussa;ProxyPassword=wst';} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The general format is: } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch {\chcbpat3 }}{\chcbpat3{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 protocol:paramName=paramValue(;paramName=paramValue)*}} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 For HTTP the supported parameters are: } +\par \pard\plain {\listtext\pard\plain \li707\ri0\lin707\rin0\fi-283\f5\fs18\f5\fs18\f5\fs18 \u8226\'2d\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls13\aspalpha\li707\ri0\lin707\rin0\fi-283\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 address {\b ( required for a service supporting a unique address )} } +\par \pard\plain {\listtext\pard\plain \li707\ri0\lin707\rin0\fi-283\f5\fs18\f5\fs18\f5\fs18 \u8226\'2d\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls13\aspalpha\li707\ri0\lin707\rin0\fi-283\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ProxyServer } +\par \pard\plain {\listtext\pard\plain \li707\ri0\lin707\rin0\fi-283\f5\fs18\f5\fs18\f5\fs18 \u8226\'2d\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls13\aspalpha\li707\ri0\lin707\rin0\fi-283\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ProxyPort } +\par \pard\plain {\listtext\pard\plain \li707\ri0\lin707\rin0\fi-283\f5\fs18\f5\fs18\f5\fs18 \u8226\'2d\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls13\aspalpha\li707\ri0\lin707\rin0\fi-283\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ProxyUsername } +\par \pard\plain {\listtext\pard\plain \li707\ri0\lin707\rin0\fi-283\sa120\f5\fs18\f5\fs18\f5\fs18 \u8226\'2d\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls13\aspalpha\li707\ri0\lin707\rin0\fi-283\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ProxyPassword } +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Multi-Address service ( Address per operation )} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Certain services ( like the eBay SOAP services ) use a address per operation. The toolkit uses extended meta data ( see the services meta data chapter below ) to set operation's addresses. The \'93ebay\'94 SOAP sample located under the {\chcbpat3\b\fs20\f3 tests\\ebay} folder demonst +rates the operation's address setting.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \page\pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b\qj \ltrpar\s5\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i\b Server Side ( service creation )} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Overview.} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Web Service Toolkit contains a server side framework for service creation. Key features are:} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls12\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Service definition( interface ) is separated from implementation,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls12\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Interface and implementations are not bound to message protocol,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls12\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 WSDL generation} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls12\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Support for SOAP 1.1 and a binary protocol,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls12\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The framework is not bound to a transport protocol.} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Example} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 In order to create a service, we have to :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls11\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 define its interface, } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls11\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 provide an implementation and register that one for the service, } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls11\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 provide a binder that will route calls targeting the service to the implementation and register that one,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls11\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 host the service into an application server( TCP server, HTTP Server, ... ).} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Defining the service Interface} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 We will use the interface defined above for our sample. The complete projects of the example is located in the folder \'93\\tests\\tcp_server\\calculator\'94. } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 [{\b Code]}} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b unit calculator;} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$mode objfpc\}\{$H+\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 uses SysUtils, base_service_intf;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Type} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TBinaryArgsResult = class(TBaseComplexRemotable)} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 private} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FArg_A: Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FArg_B: Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FArg_OP: string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FArg_R: Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Published} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Property Arg_A : Integer Read FArg_A Write FArg_A;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Property Arg_B : Integer Read FArg_B Write FArg_B;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Property Arg_R : Integer Read FArg_R Write FArg_R;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Property Arg_OP : string Read FArg_OP Write FArg_OP;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ICalculator = Interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function AddInt(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const A:Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const B:Integer} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ):TBinaryArgsResult;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function DivInt(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const A:Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const B:Integer} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ):Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 implementation} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 uses base_soap_formatter;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Initialization} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 GetTypeRegistry().Register(sXSD_NS,TypeInfo(TBinaryArgsResult),'TBinaryArgsResult');} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/code]} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Providing an implementation for the service} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch \'93}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ws_helper\'94 has options to generate proxy file, basic implementation skeleton file and a binder file ( see the listing above). } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Listing ws_helper usage]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ws_helper [-p] [-b] [-i] [-oPATH] inputFilename} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 -p Generate service proxy} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 -b Generate service binder} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 -i Generate service minimal implementation} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 -o PATH Output directory} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/Listing]} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Executing \'93ws_helper\'94 with the {\chcbpat3\b0\fs20\f3 -i} and {\chcbpat3\b0\fs20\f3 -b} options as above will produce two files : {\chcbpat3\b0\fs20\f3 calculator_imp.pas} and {\chcbpat3\b0\fs20\f3 calculator_binder.pas.}} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Listing ws_helper execution session]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ws_helper\\ws_helper.exe -i -b -osrv tests\\tcp_server\\calculator\\calculator.pas} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ws_helper Copyright (c) 2006 by Inoussa OUEDRAOGO} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 File "tests\\tcp_server\\calculator\\calculator.pas" parsed succesfully.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/Listing]} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The {\chcbpat3\b0\fs20\f3 calculator_imp.pas} unit contains a skeleton implementation class for the interface. It defines a procedure named {\chcbpat3\b0\fs20\f3 RegisterCalculatorImplementationFactory}. The procedure registers the class as the service implementation provider in the implementation re +gistry.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b Unit calculator_imp;} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$mode objfpc\}\{$H+\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Uses SysUtils, Classes, } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 base_service_intf, server_service_intf, server_service_imputils, calculator;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Type} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TCalculator_ServiceImp=class(TBaseServiceImplementation,ICalculator)} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Protected} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function AddInt(Const A : Integer;Const B : Integer):TBinaryArgsResult;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function DivInt(Const A : Integer;Const B : Integer):Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure RegisterCalculatorImplementationFactory();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Implementation} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{ TCalculator_ServiceImp implementation \}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function TCalculator_ServiceImp.AddInt( Const A : Integer; Const B : Integer):TBinaryArgsResult;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result := TBinaryArgsResult.Create();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Try} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Arg_OP := '+';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Arg_A := A;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Arg_B := B;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Arg_R := A + B;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Except} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FreeAndNil(Result);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Raise;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function TCalculator_ServiceImp.DivInt( Const A : Integer; Const B : Integer):Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result := A div B;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure RegisterCalculatorImplementationFactory();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 GetServiceImplementationRegistry().Register('Calculator',TImplementationFactory.Create(TCalculator_ServiceImp) as IServiceImplementationFactory);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End. } +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/code]} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b\qj \ltrpar\s7\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b\qj \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Providing a binder for the service.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The binder's role is to:} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10132\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls10\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 unpack the incoming message,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10132\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls10\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 set up the call stack,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10132\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls10\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 make the call against the registered implementation,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10132\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls10\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 serialize the execution stack to create the return message.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The calculator_binder.pas unit generated by ws_helper, contains :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u8226\'2d\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls9\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 TCalculator_ServiceBinder : the actual binder class,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u8226\'2d\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls9\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 TCalculator_ServiceBinderFactory a factory class for the binder and} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u8226\'2d\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls9\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Server_service_RegisterCalculatorService : the binder factory registration procedure.} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u8226\'2d\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The following code extract shows the unit interface part and a method handler of the binder.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code part of calculator_binder.pas]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b Unit calculator_binder;} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$mode objfpc\}\{$H+\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Uses SysUtils, Classes, base_service_intf, server_service_intf, calculator;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Type} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TCalculator_ServiceBinder=class(TBaseServiceBinder)} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Protected} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure AddIntHandler(AFormatter:IFormatterResponse);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure DivIntHandler(AFormatter:IFormatterResponse);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Public} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 constructor Create();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TCalculator_ServiceBinderFactory = class(TInterfacedObject,IItemFactory)} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 protected} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function CreateInstance():IInterface;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure Server_service_RegisterCalculatorService();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Implementation} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 uses TypInfo;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure TCalculator_ServiceBinder.AddIntHandler(AFormatter:IFormatterResponse);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Var} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 tmpObj : ICalculator;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 callCtx : ICallContext;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 strPrmName : string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procName,trgName : string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 A : Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 B : Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 returnVal : TBinaryArgsResult;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locTypeInfo : PTypeInfo;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 callCtx := CreateCallContext();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locTypeInfo := TypeInfo(TBinaryArgsResult);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 If ( locTypeInfo^.Kind in [tkClass,tkInterface] ) Then} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Pointer(returnVal) := Nil;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 strPrmName := 'A'; AFormatter.Get(TypeInfo(Integer),strPrmName,A);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 strPrmName := 'B'; AFormatter.Get(TypeInfo(Integer),strPrmName,B);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 tmpObj := Self.GetFactory().CreateInstance() as ICalculator;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 returnVal := tmpObj.AddInt(A,B);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locTypeInfo := TypeInfo(TBinaryArgsResult);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(returnVal)) Then} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 callCtx.AddObject(TObject(returnVal));} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procName := AFormatter.GetCallProcedureName();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 trgName := AFormatter.GetCallTarget();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AFormatter.Clear();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AFormatter.BeginCallResponse(procName,trgName);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AFormatter.Put('return',TypeInfo(TBinaryArgsResult),returnVal);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AFormatter.EndCallResponse();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 callCtx := Nil;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/Code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Host the service into an application server.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The application server's role is to route incoming service requests to the Web Service Toolkit runtime. For the runtime to process service requests :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls8\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The services and their implementations have to be registered ,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls8\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The message protocol (SOAP, binary,...) have to be registered. } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The runtime interface is defined in the {\chcbpat3\b\fs20\f3 server_service_intf} unit. This unit contains :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls7\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 GetServerServiceRegistry}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 , which returns the service registry,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls7\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 GetServiceImplementationRegistry}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 which returns the service implementation registry,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls7\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 GetFormatterRegistry}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 which returns the message format registry and} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls7\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 HandleServiceRequest}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 which is the unique entry point for request processing.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit is provided with a simple TCP server ( using ICS components ) hosting the sample {\b\i Calculator} service defined early in this document located in the \\tests\\tcp_server folder. The complete source files of the sample is in that directory and the cl +ient application in the \\client sub folder. The registrations are done in the application's main form {\f4 OnCreate} event as printed above:} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure TfMain.FormCreate(Sender: TObject);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Server_service_RegisterCalculatorService();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 RegisterCalculatorImplementationFactory();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Server_service_RegisterSoapFormat();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Server_service_RegisterBinaryFormat();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end; } +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/Code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 Server_service_RegisterCalculatorService}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 located in the {\chcbpat3\b\fs20\f3 calculator_binder} unit ( generated by {\b\f4 ws_helper} ) registers the {\b\i Calculator} service by calling in turn {\b\f4 GetServerServiceRegistry:}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ab\ltrch\dbch\af6\langfe255\hich\f4\fs24\lang1033\b\loch\f4\fs24\lang1033\b +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code located in calculator_binder.pas]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure Server_service_RegisterCalculatorService();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 GetServerServiceRegistry().Register(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 'Calculator',} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TCalculator_ServiceBinderFactory.Create() as IItemFactory} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 RegisterCalculatorImplementationFactory}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 located in the {\chcbpat3\b\fs20\f3 calculator_imp} unit ( generated by ws_helper ) registers the {\b\i Calculator} implementation by calling in turn {\b\f4 GetServiceImplementationRegistry:}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ab\ltrch\dbch\af6\langfe255\hich\f4\fs24\lang1033\b\loch\f4\fs24\lang1033\b +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code located in calculator_imp.pas]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure RegisterCalculatorImplementationFactory();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 GetServiceImplementationRegistry().Register(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 'Calculator',} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TSimpleItemFactory.Create(TCalculator_ServiceImp) as IitemFactory} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 Server_service_RegisterSoapFormat}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 located in the {\chcbpat3\b\fs20\f3 server_service_soap} unit ( provided by the toolkit ) registers the {\b\i SOAP} implementation by calling in turn {\b\f4 GetFormatterRegistry:}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ab\ltrch\dbch\af6\langfe255\hich\f4\fs24\lang1033\b\loch\f4\fs24\lang1033\b +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code located in server_service_soap.pas]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure Server_service_RegisterSoapFormat();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 GetFormatterRegistry().Register(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 sSOAP_CONTENT_TYPE,} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TSimpleItemFactory.Create(TSOAPFormatter) as IitemFactory} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 RegisterStdTypes();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b0{\f4 Server_service_RegisterBinaryFormat}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 located in the {\chcbpat3\b\fs20\f3 server_binary_formatter} unit ( provided by the toolkit ) registers the {\b\i Binary message} implementation by calling in turn {\b\f4 GetFormatterRegistry:}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ab\ltrch\dbch\af6\langfe255\hich\f4\fs24\lang1033\b\loch\f4\fs24\lang1033\b +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code located in server_binary_formatter.pas]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure Server_service_RegisterBinaryFormat();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 GetFormatterRegistry().Register(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 sCONTENT_TYPE,} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TBinaryFormatterFactory.Create() as IitemFactory} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 HandleServiceRequest}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 is invoked to process incoming request buffer in the socket client processing procedure {\f4 ProcessData} located in the {\chcbpat3\b\fs20\f3 server_unit} unit. } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [Code]} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure TTcpSrvApp.ProcessData(Client : TTcpSrvClient);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Var} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 buff, trgt,ctntyp : string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 rqst : IRequestBuffer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 wrtr : IDataStore;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 rdr : IDataStoreReader;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 inStream, outStream, bufStream : TMemoryStream;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 i : Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 inStream := Nil;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 outStream := Nil;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 bufStream := Nil;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Try} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Client.RequestStream.Position := 0;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Try} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 inStream := TMemoryStream.Create();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 outStream := TMemoryStream.Create();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 bufStream := TMemoryStream.Create();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 rdr := CreateBinaryReader(Client.RequestStream);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 trgt := rdr.ReadStr();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ctntyp := rdr.ReadStr();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 buff := rdr.ReadStr();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 inStream.Write(buff[1],Length(buff));} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 inStream.Position := 0;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b\b HandleServiceRequest(rqst);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 i := bufStream.Size;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 SetLength(buff,i);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 bufStream.Position := 0;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 bufStream.Read(buff[1],i);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 wrtr := CreateBinaryWriter(outStream);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 wrtr.WriteStr(buff);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Client.Send(outStream.Memory,outStream.Size);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Finally} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 bufStream.Free();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 outStream.Free();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 inStream.Free();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Client.FDataLentgh := -1;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Client.RequestStream.Size := 0;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Except} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 On e : Exception Do} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Display('ProcessData()>> Exception = '+e.Message);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ab\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\b\loch\f3\fs20\lang1033\b {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b [/Code]} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 In order to give it a try one have to :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360 1.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls6\aspalpha\li720\ri0\lin720\rin0\fi-360\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 compile the server,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360 2.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls6\aspalpha\li720\ri0\lin720\rin0\fi-360\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 compile the client application,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360 3.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls6\aspalpha\li720\ri0\lin720\rin0\fi-360\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 execute the server and start listening,} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360 4.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls6\aspalpha\li720\ri0\lin720\rin0\fi-360\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 execute the client.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b WSDL generation.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Services in the toolkit are organized into {\b\i meta data repositories}. Conceptually a repository corresponds :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls5\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 at compile time to the pascal unit containing the service definition} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls5\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 at runtime to a name space. } +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The repository is the toolkit WSDL generation unit.} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b The Meta data Service.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit is provided with an easy to use metadata service implementation which in turn uses the raw interface defined in the {\b\f4 metadata_repository} unit (see above). A Lazarus GUI client application is located in the {\b\f4 tests\\metadata_browser} folder.} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b WSDL generation API.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The {\b\f4 metadata_wsdl} pascal unit contains the {\b\f4 GenerateWSDL} function for WSDL generation from a repository (see the signature below). } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 PServiceRepository = ^TServiceRepository;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TServiceRepository = record} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 NameSpace : ShortString;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Name : ShortString;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 RootAddress : ShortString;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ServicesCount : Byte;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Services : PService;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TDOMDocument);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs23\b\f7\fs23\b\fs23\b \ltrpar\s8\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\b\loch\f2\fs23\lang1033\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i0\b WSDL Customization.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The WSDL generation is based on the {\b\f4 IWsdlTypeHandler} and the {\b\f4 IWsdlTypeHandlerRegistry} interfaces located in the {\b\f4 metadata_wsdl} unit. In order to customize the generated WSDL, one has to provide a class implementing the {\b\f4 IWsdlTypeHandler} interface. Then that + class has to be registered in the registry. The {\b\f4 metadata_wsdl} unit contains implementations for pascal enumerations, {\b\f4 TBaseComplexRemotable} descendants, and {\b\f4 TBaseArrayRemotable} descendants.} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Sample} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 A functional sample project is located under {\b\f4 \\tests\\http_server} . It is an Indy base http server.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Services Extensions \'96 Server side} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Services extensions provide a mean to hook into all the services request processing stages. Services extensions may be used, for example, to implement authentication, request logging, data compression, etc.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The IServiceExtension bellow is the interface used by the toolkit runtime to call services extensions.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TMessageStage = (} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 msAfterDeserialize, msAfterSerialize, msBeforeDeserialize, msBeforeSerialize} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 IServiceExtension = interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ['\{E192E6B3-7932-4D44-A8AC-135D7A0B8C93\}']} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure ProcessMessage(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const AMessageStage : TMessageStage;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ACallContext : ICallContext;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AMsgData : IInterface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\chcbpat3{\rtlch \ltrch\loch }}{\chcbpat3{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 } +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The "{\b\f4 AMsgData}" parameter actual type depends on the message processing state and corresponds to :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls4\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b0{\f4 IRequestBuffer}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 on "{\f4 msBeforeDeserialize}" and "{\f4 msAfterSerialize}"} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\sa120\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls4\aspalpha\li720\ri0\lin720\rin0\fi-360\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b0{\f4 IFormatterResponse}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 on "{\f4 msAfterDeserialize}" and "{\f4 msBeforeSerialize}" } +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 These types are located in the {\b\f4 server_service_intf} unit. Extensions have to be registered in the extensions registry ( located in the {\b\f4 server_service_intf unit }) printed bellow :} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 IServiceExtensionRegistry = Interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ['\{68DC78F1-E6CF-4D6B-8473-75288794769C\}']} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function Find(const AName : string):IServiceExtension;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure Register(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const AName : string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AFactory : IItemFactory} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 In order for an service implementation to use a service extension, it has to register himself to that extension. To that end, the {\b\f4 IServiceImplementationFactory} interface provides the {\b\f4 RegisterExtension} method. A complete sample is included in the {\b{\f4 calculator}}{\b + }sample.} +\par \page\pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i\b Services meta data.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Services in the toolkit are organized into {\b\i meta data repositories( see the \'93services's meta data\'94 below )}. Conceptually a repository corresponds :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls5\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 at compile time to the pascal unit containing the service definition} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls5\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 at runtime to a name space. } +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The {\b\f4 ws_helper} tool, when parsing the interface definition file, records the meta data of the services contained in the file to a Lazarus resource file. The resource file is then embedded into the generated binder's unit file( see the unit \'93initialization\'94 +part ). At runtime the service's recorded meta data are accessible through the interface {\b\f4 IModuleMetadataMngr} defined in the {\b\f4 metadata_repository} unit ( see below ). The {\b\f4 GetModuleMetadataMngr} function defined in the same unit returns an instance of an object + supporting that interface.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 IModuleMetadataMngr = interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ['\{B10ACF6A-A599-45A3-B083-BEEFB810C889\}']} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function IndexOfName(const ARepName : shortstring):Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function GetCount():Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function GetRepositoryName(const AIndex : Integer):shortstring;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure SetRepositoryNameSpace(const ARepName,ANameSpace : shortstring);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function LoadRepositoryName(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const ARepName,ARootAddress : shortstring;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 out ARepository : PServiceRepository} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ):Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure ClearRepository(var ARepository : PServiceRepository);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure SetOperationCustomData(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const ARepName : shortstring;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const AServiceName : shortstring;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const AOperationName : shortstring;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const ADataName,} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AData : string} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function GetServiceMetadata(const ARepName,AServiceName : shortstring) : PService;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure ClearServiceMetadata(var AService : PService);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\chcbpat3{\rtlch \ltrch\loch }}{\chcbpat3{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Extended Meta data.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The meta data interface provides a way to add custom data to recorded ones. Currently only operation's meta data are supported through the {\chcbpat3\b\fs20\f3 SetOperationCustomData} method.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 A repository's extended meta data has to be registered after the service meta data recorded in the Lazarus resource file have been registered. So for client application the generated proxy unit contains a conditional code fragment to call a registration pr +ocedure like showed below for the eBay sample located in the {\chcbpat3\b\fs20\f3 tests\\ebay} folder. The procedure name is obtained from the interface unit name ( the repository's name ) : {\chcbpat3\fs20\f3{\b0 Register_}}{\chcbpat3\fs20\f3{\b %UNIT_NAME%}{\b0 _ServiceMetadata}} . } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 initialization} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$i ebay.lrs\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$IF DECLARED(Register_ebay_ServiceMetadata)\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Register_ebay_ServiceMetadata();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 \{$ENDIF\}} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End. } +\par \pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b +\par \page\pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i\b Headers support.} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b The THeaderBlock class } +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 THeaderBlock = class(TBaseComplexRemotable)} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 public} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 property Direction : THeaderDirection read FDirection write FDirection;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 property Understood : Boolean read FUnderstood write FUnderstood;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 published} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 property mustUnderstand : Integer read FmustUnderstand write SetmustUnderstand } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 stored HasmustUnderstand;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The {\b\f4 TheaderBlock} showed above ( the private part has been omitted for brevity), located in the {\chcbpat3\b\fs20\f3 base_service_intf} unit, is the root class all header classes are derived from.. The {\b\f4 Direction} property indicate whether it is an incoming header or an outgoin +g one. The {\b\f4 mustUnderstand} property define whether the header is a mandatory one.} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Defining header class.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Soap headers are derived from the THeaderBlock base class located in the {\chcbpat3\b\fs20\f3 base_service_intf} unit. They have to be registered in the type registry. Below is reproduced an header example extracted from the {\b \'93calculator\'94} sample project.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TCalcHeader = class(THeaderBlock)} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 published} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 property Login : string read FLogin write FLogin;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 property Password : string read FPassword write FPassword;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 property WantedPrecision : Integer read FWantedPrecision write FWantedPrecision;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end; } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b The ICallContext interface.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ICallContext = Interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ['\{855EB8E2-0700-45B1-B852-2101023200E0\}']} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure AddObjectToFree(const AObject : TObject);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure Clear();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function AddHeader(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const AHeader : THeaderBlock;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const AKeepOwnership : Boolean} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ):Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function GetHeaderCount(const ADirections : THeaderDirections):Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function GetHeader(const AIndex : Integer) : THeaderBlock;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure ClearHeaders(const ADirection : THeaderDirection);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End; } +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The ICallContext interface defined in the {\chcbpat3\b\fs20\f3 base_service_intf} unit represents the service call context. The {\chcbpat3\b0\fs20\f3 AddHeader} method allows headers sending while the {\chcbpat3\b0\fs20\f3 GetHeader} method retrieves header in the call context.} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Client side headers.} +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 An {\chcbpat3\b0\fs20\f3 ICallContext} reference may be obtained from the current service proxy instance simply by querying it for that interface as showed in the code fragment below extracted from the {\b \'93calculator\'94} client example project.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 var} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ch : TCalcHeader;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 hdrs : ICallContext;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FObj := TCalculator_Proxy.Create('Calculator', edtFormat.Text, edtAddress.Text);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ch := TCalcHeader.Create();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ch.mustUnderstand := 1;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ch.Login := 'azerty';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ch.Password := 'qwerty';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ch.WantedPrecision := 121076;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 hdrs := FObj as ICallContext;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 hdrs.AddHeader(ch,true);} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 A header may be made mandatory by setting its {\chcbpat3\b0\fs20\f3 mustUnderstand} property to 1 as in the code above.} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Server side headers.} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b The ICallControl interface.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ICallControl = interface} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ['\{7B4B7192-EE96-4B52-92C7-AE855FBC31E7\}']} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure SetCallContext(ACallContext : ICallContext);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function GetCallContext():ICallContext;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The {\chcbpat3\b\fs20\f3 ICallControl} interface, located in the {\chcbpat3\b\fs20\f3 server_service_intf} unit, is used by the toolkit runtime to share the executing call environment with service implementation classes. When the runtime is about to issue a call against a implementation class insta +nce, it queries that instance for ICallControl interface support; If the implementation has ICallControl interface support then the obtained reference is used to set the call context through the {\chcbpat3\b0\fs20\f3 SetCallContext} method. The implementation instance can then a +ccess the call context by calling the {\chcbpat3\b0\fs20\f3 GetCallContex} method.} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit provides the {\chcbpat3\b\fs20\f3 TBaseServiceImplementation} class which has support for the ICallControl interface and can be used as a base implementation class. It is the base class used by the {\chcbpat3\b\fs20\f3 ws_helpe}r generated skeleton implementation class when invoked the + {\chcbpat3\b\fs20\f3 -i }command line option.} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The method printed bellow, extracted from the {\chcbpat3\b\fs20\f3 calculator} sample service demonstrates the access to headers for read and write.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function TCalculator_ServiceImp.AddInt(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const A : Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const B : Integer} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ):TBinaryArgsResult;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 var} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 hdr : TCalcResultHeader;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 h : TCalcHeader;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 cc : ICallContext;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 hdr := TCalcResultHeader.Create();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 cc := GetCallContext();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 if Assigned(cc) and ( cc.GetHeaderCount([hdIn]) > 0 ) and ( cc.GetHeader(0).InheritsFrom(TCalcHeader) ) then begin} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 h := cc.GetHeader(0) as TCalcHeader;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 h.Understood := True;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 hdr.Assign(h);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 hdr.TimeStamp := DateTimeToStr(Now());} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 hdr.SessionID := 'testSession';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 cc.AddHeader(hdr,True);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 hdr := nil;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result := TBinaryArgsResult.Create();} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Try} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Arg_OP := '+';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Arg_OpEnum := coAdd;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Arg_A := A;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Arg_B := B;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Arg_R := A + B;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Result.Comment := 'Doing an + operation';} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Except} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FreeAndNil(Result);} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Raise;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End; } +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \page\pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i\b SOAP Specific.} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Binding style.} +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The binding style is used to indicate whether the service is {\b\f4 \'93RPC\'94} oriented or {\b\f4 \'93Document\'94} oriented.} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Client side.} +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The binding style may be specified in the SOAP protocol string on the creation of a service proxy. The default value for the binding style is \'93RPC\'94. Below is printed a sample code that demonstrates the use of \'93Document\'94 style.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 locService := TSampleService_Proxy.Create(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 'SampleService',} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b{\b 'SOAP:Style=Document;EncodingStyle=Litteral'}}{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ,} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 'http:address=http://127.0.0.1/services/SampleService'} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 ); } +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Server side.} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Currently services created with the toolkit use the \'93RPC\'94 binding style.} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Encoding style.} +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The encoding style indicates the rules used to encode types in XML. Supported values are {\b\f4 \'93Encoded\'94} and {\b\f4 \'93Litteral\'94}.} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Client side.} +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The encoding style may be specified in the SOAP protocol string on the creation of a service proxy. The default value for the encoding style is \'93Encoded\'94. The above sample demonstrates the use of \'93Litteral\'94 style.} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Server side.} +\par \pard\plain \ltrpar\s2\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Currently services created with the toolkit use the \'93Encoded\'94 encoding style.} +\par \page\pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i\b Provided examples} +\par \pard\plain \ltrpar\s2\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sa120\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The HTTP server side samples has been tested on Windows XP and Ubuntu. The client side has been tested under Windows XP and Ubuntu. The samples are located under the {\b\f4 \'93tests\'94} folder.} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Client side examples} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls3\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Google sample : It demonstrates use of class and array data types.} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls3\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Metadata Browser : This sample demonstrates use of class and array data types and mainly the toolkit metadata service.} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls3\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 eBay sample, this sample uses OpenSLL which can be found at {\field{\*\fldinst HYPERLINK "http://www.openssl.org/" }{\fldrslt \*\cs24\cf2\ul\ulc0\rtlch\ltrch\dbch\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 http://www.openssl.org}} and SYNAPSE ( http://www.ararat.cz/synapse/ ).} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Server side examples} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls2\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 TCP server : This is a sample TCP server based on the ICS components. It uses the calculator service.} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls2\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 HTTP server : This is a sample HTTP server based on the Indy10 components. It uses the calculator service and the toolkit metadata service. It demonstrates the WSDL generation.} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls2\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Apache module sample : This sample demonstrates the hosting of the toolkit into the Apache HTTP web server. It is based on Sekelsenmat 's Apache headers translation. It uses the calculator service and the toolkit metadata service. It demonstrates the WSDL + generation.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i\b Status} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit is usable for simple types and for class types. The serialization is designed to allow customization of basic types and class types by implementing classes derived from \'93{\chcbpat3{\b0\fs20\f3 TBaseRemotable}}{\chcbpat3 \'94}. This classes have to be registered in the type registry. +} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit is provide with a SOAP 1.1 message format implementation ( based on the FCL XML units) and a binary one.} +\par \pard\plain \sb240\sa120\keepn\f2\fs28\b\f7\fs28\b\fs28\b \ltrpar\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\b\loch\f2\fs28\lang1033\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i0\b Serialization} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The serialization is based on the {\chcbpat3\b0\fs20\f3 IFormatterBase} interface located in the {\chcbpat3\b0\fs20\f3 base_service_intf} unit.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit has two serializers implementations : the SOAP serializer and a binary serializer.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b SOAP serializer} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The SOAP serializer implements SOAP 1.1. It has support for the following pascal types:} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Available integers : } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Byte mapped to unsignedByte} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ShortInt mapped to byte} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 SmallInt mapped to short} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Word mapped to unsignedShort} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 LongInt mapped to int} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 LongWord mapped to unsignedInt} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Int64 mapped to long} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Qword mapped to int} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 String mapped to string} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Boolean mapped to boolean} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Enumerations mapped to their string representation (?)} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Float types : } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Single mapped to float} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Double mapped to double} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Extended mapped to double} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Currency mapped to float} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Object (class intances, not TP ones ) :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit has support for instances of classes derived from {\chcbpat3\b0\fs20\f3 TBaseRemotable}. {\chcbpat3\b0\fs20\f3 TBaseRemotable} is the base class used by the formatter interface to allow customization of the serialization.. The toolkit provides the {\chcbpat3\b0\fs20\f3 TBaseComplexRemotable} class which impleme +nts serialization for its ( or its descendants ) published properties. } +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Binary serializer} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The Binary serializer is more efficient in time and space compared to the SOAP serializer . It uses big endian to stream data. It has support for the following pascal types:} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Available integers : } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Byte } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ShortInt } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 SmallInt } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Word } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 LongInt } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 LongWord} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Int64 } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Qword } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 String } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Boolean } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Enumerations } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Float types : } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Single } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Double} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Extended } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Currency } +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Object (class intances, not TP ones ) :} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit has support for instances of classes derived from {\chcbpat3\b0\fs20\f3 TBaseRemotable}. {\chcbpat3\b0\fs20\f3 TBaseRemotable} is the base class used by the formatter interface to allow customization of the serialization.. The toolkit provides the {\chcbpat3\b0\fs20\f3 TBaseComplexRemotable} class which implemen +ts serialization for its ( or its descendants ) published properties. } +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\i\b\loch\f2\fs23\lang1033\i\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Class type serialization. } +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit has support for instances of classes derived from {\b\f4 TBaseRemotable}. {\b\f4 TBaseRemotable} is the abstract base class used by the formatter interface to allow customization of the serialization. The toolkit provides the {\b\f4 TBaseComplexRemotable} class which +implements serialization for its descendants classes published properties. It also provides {\b\f4 TBaseObjectArrayRemotable} class for serialization of array of {\b\f4 TBaseRemotable} descendant classes.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs23\b\f7\fs23\b\fs23\b \ltrpar\s8\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\b\loch\f2\fs23\lang1033\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i0\b The root \'93TBaseRemotable\'94 class.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch {\chcbpat3 }}{\chcbpat3{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TBaseRemotable = class(TPersistent)}} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Public} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 constructor Create();virtual;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 class procedure Save(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AObject : TBaseRemotable;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AStore : IFormatterBase;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const AName : String;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Const ATypeInfo : PTypeInfo} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );virtual;abstract;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 class procedure Load(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 Var AObject : TObject;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AStore : IFormatterBase;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 var AName : String;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const ATypeInfo : PTypeInfo} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );virtual;abstract;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End; } +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ab\ltrch\dbch\af6\langfe255\hich\f4\fs24\lang1033\b\loch\f4\fs24\lang1033\b +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 TBaseRemotable}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 is the abstract base class used by the formatter interface to allow customization of the serialization. This class defines a virtual constructor and mainly two(2) virtual abstract class methods :} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 Save}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 : this method is called when the toolkit needs to serialize the {\b\f4 AObject} parameter.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 Load}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 : this method is called when the toolkit needs to un-serialize to the {\b\f4 AObject} parameter.} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\b\f7\fs23\b\fs23\b \ltrpar\s8\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\b\loch\f2\fs23\lang1033\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i0\b The \'93TBaseComplexRemotable\'94 serialization.} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TBaseComplexRemotable = class(TAbstractComplexRemotable)} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 public} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 class procedure Save(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AObject : TBaseRemotable;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AStore : IFormatterBase;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const AName : string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const ATypeInfo : PTypeInfo} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );override;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 class procedure Load(} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 var AObject : TObject;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 AStore : IFormatterBase;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 var AName : string;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 const ATypeInfo : PTypeInfo} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 );override;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 class procedure RegisterAttributeProperty(const AProperty : shortstring);virtual;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 class procedure RegisterAttributeProperties(const APropertList : array of shortstring);virtual;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 class function IsAttributeProperty(const AProperty : shortstring):Boolean;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 procedure Assign(Source: TPersistent); override;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 end;} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 TBaseComplexRemotable}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 implements serialization for its descendants classes published properties. The serialization is based on runtime type information (RTTI) and can be customized to:} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls0\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ignore always some published properties.} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u57354\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls0\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ignore conditionally some published properties.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The following class shows a the serialization's customization sample.} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch {\chcbpat3 }}{\chcbpat3{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 TSampleClass = class(TBaseComplexRemotable)}} +\par \pard\plain \ltrpar\s1\cf0\chcbpat3{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs20\lang255\ltrch\dbch\af6\langfe255\hich\f3\fs20\lang1033\loch\f3\fs20\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 private} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FProp_Always: Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FProp_Never: Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 FProp_Optional: Integer;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 function GetStoredProp_Optional: boolean;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 published} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 //This property will always be serialized} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 property Prop_Always : Integer read FProp_Always write FProp_Always;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 //This property will never be serialized} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 property Prop_Never : Integer read FProp_Never write FProp_Never stored False;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 //This property will be serialized if "Self.GetStoredProp_Optional() = True"} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 property Prop_Optional : Integer read FProp_Optional write FProp_Optional stored GetStoredProp_Optional;} +\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch }{\rtlch \ltrch\loch\f3\fs20\lang1033\i0\b0 End;} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs21\b\f7\fs21\b\fs21\b \ltrpar\s9\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs21\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs21\lang1033\b\loch\f2\fs21\lang1033\b {\rtlch \ltrch\loch\f2\fs21\lang1033\i0\b Attribute properties.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033{\rtlch \ltrch\loch\f4\fs24\lang1033\i0\b{\b\f4 TBaseComplexRemotable}}{\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 allows properties serialization as attributes. Theses properties have to be registered as such with the {\b\f4 RegisterAttributeProperty} class method or {\b\f4 RegisterAttributeProperties} one.} +\par \pard\plain \sb240\sa120\keepn\f2\fs23\b\f7\fs23\b\fs23\b \ltrpar\s8\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs23\lang255\ab\ltrch\dbch\af7\langfe255\hich\f2\fs23\lang1033\b\loch\f2\fs23\lang1033\b {\rtlch \ltrch\loch\f2\fs23\lang1033\i0\b Provided array implementations.} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit provides array implementation for basic types ( in the {\b\f4 base_service_intf} unit ) listed bellow. The implementations are based on the serialization's customization.} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Available integers : } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Byte \tab TArrayOfInt8URemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 ShortInt \tab TArrayOfInt8SRemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 SmallInt \tab TArrayOfInt16SRemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Word \tab TArrayOfInt16URemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 LongInt \tab TArrayOfInt32SRemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 LongWord\tab TArrayOfInt32URemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Int64 \tab TArrayOfInt64SRemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Qword \tab \tab TArrayOfInt64URemotable} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 String \tab TarrayOfStringRemotable( AnsiString )} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Boolean \tab TArrayOfBooleanRemotable} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Float types : } +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Single \tab \tab TArrayOfFloatSingleRemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Double\tab \tab TArrayOfFloatDoubleRemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Extended \tab TArrayOfFloatExtendedRemotable} +\par \pard\plain {\listtext\pard\plain \li1789\ri0\lin1789\rin0\fi-360\qj\f5\fs18\f5\fs18\f5\fs18 \u10146\'3f\tab}\ilvl1 \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li1789\ri0\lin1789\rin0\fi-360\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Currency \tab TArrayOfFloatCurrencyRemotable} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch } +\par \pard\plain \sb240\sa120\keepn\f2\fs23\i\b\f7\fs23\i\b\fs23\i\b \ltrpar\s7\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql {\rtlch \ltrch\loch\f2\fs23\lang1033\i\b Test cases} +\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\f5\fs18\f5\fs18\f5\fs18 \u10004\'3f\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\aspalpha\li720\ri0\lin720\rin0\fi-360\ql\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 The toolkit uses {\chcbpat3\b0\fs20\f3 FPCUnit} for test cases. The test project is located in the {\chcbpat3\b0\fs20\f3 \\tests\\test_suite} folder. } +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 +\par \pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b +\par \pard\plain \sb240\sa120\keepn\f2\fs28\i\b\f7\fs28\i\b\fs28\i\b \ltrpar\s5\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\sb240\sa120\keepn\ql\rtlch\afs28\lang255\ai\ab\ltrch\dbch\af7\langfe255\hich\f2\fs28\lang1033\i\b\loch\f2\fs28\lang1033\i\b {\rtlch \ltrch\loch\f2\fs28\lang1033\i\b Author} +\par \pard\plain \ltrpar\s1\cf0\qj{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\aspalpha\rtlch\af6\afs24\lang255\ltrch\dbch\af6\langfe255\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 {\rtlch \ltrch\loch\f1\fs24\lang1033\i0\b0 Inoussa OUEDRAOGO, {\field{\*\fldinst HYPERLINK "mailto:inoussa12@gmail.com" }{\fldrslt \*\cs24\cf2\ul\ulc0\rtlch\ltrch\dbch\hich\f1\fs24\lang1033\loch\f1\fs24\lang1033 inoussa12@gmail.com}}. } +\par } \ No newline at end of file diff --git a/wst/tags/3.1/ics_http_protocol.pas b/wst/tags/3.1/ics_http_protocol.pas new file mode 100644 index 000000000..0c810035f --- /dev/null +++ b/wst/tags/3.1/ics_http_protocol.pas @@ -0,0 +1,198 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit ics_http_protocol; + +{$mode objfpc}{$H+} + +//{$DEFINE WST_DBG} + +interface + +uses + Classes, SysUtils, + service_intf, imp_utils, base_service_intf, + HttpProt; + +Const + sTRANSPORT_NAME = 'HTTP'; + +Type + +{$M+} + { THTTPTransport } + THTTPTransport = class(TSimpleFactoryItem,ITransport) + Private + FPropMngr : IPropertyManager; + FConnection : THttpCli; + FSoapAction: string; + function GetAddress: string; + function GetContentType: string; + function GetProxyPassword: string; + function GetProxyPort: Integer; + function GetProxyServer: string; + function GetProxyUsername: string; + procedure SetAddress(const AValue: string); + procedure SetContentType(const AValue: string); + procedure SetProxyPassword(const AValue: string); + procedure SetProxyPort(const AValue: Integer); + procedure SetProxyServer(const AValue: string); + procedure SetProxyUsername(const AValue: string); + private + procedure HttpBeforeHeaderSendHandler( + Sender : TObject; + const Method : String; + Headers : TStrings + ); + Public + constructor Create();override; + destructor Destroy();override; + function GetPropertyManager():IPropertyManager; + procedure SendAndReceive(ARequest,AResponse:TStream); + Published + property ContentType : string Read GetContentType Write SetContentType; + property Address : string Read GetAddress Write SetAddress; + property ProxyServer : string Read GetProxyServer Write SetProxyServer; + property ProxyPort : Integer Read GetProxyPort Write SetProxyPort; + property ProxyUsername : string read GetProxyUsername write SetProxyUsername; + property ProxyPassword : string read GetProxyPassword write SetProxyPassword; + property SoapAction : string read FSoapAction write FSoapAction; + End; +{$M+} + + procedure ICS_RegisterHTTP_Transport(); + +implementation + +{ THTTPTransport } + +function THTTPTransport.GetAddress: string; +begin + Result := FConnection.URL; +end; + +function THTTPTransport.GetContentType: string; +begin + Result := FConnection.ContentTypePost; +end; + +function THTTPTransport.GetProxyPassword: string; +begin + Result := FConnection.ProxyPassword; +end; + +function THTTPTransport.GetProxyPort: Integer; +begin + Result := StrToIntDef(FConnection.ProxyPort,0); +end; + +function THTTPTransport.GetProxyServer: string; +begin + Result := FConnection.Proxy; +end; + +function THTTPTransport.GetProxyUsername: string; +begin + Result := FConnection.ProxyUsername; +end; + +procedure THTTPTransport.SetAddress(const AValue: string); +begin + FConnection.URL := AValue; +end; + +procedure THTTPTransport.SetContentType(const AValue: string); +begin + FConnection.ContentTypePost := AValue; +end; + +procedure THTTPTransport.SetProxyPassword(const AValue: string); +begin + FConnection.ProxyPassword := AValue; +end; + +procedure THTTPTransport.SetProxyPort(const AValue: Integer); +begin + FConnection.ProxyPort := IntToStr(AValue); +end; + +procedure THTTPTransport.SetProxyServer(const AValue: string); +begin + FConnection.Proxy := AValue; +end; + +procedure THTTPTransport.SetProxyUsername(const AValue: string); +begin + FConnection.ProxyUsername := AValue; +end; + +procedure THTTPTransport.HttpBeforeHeaderSendHandler( + Sender: TObject; + const Method: String; + Headers: TStrings +); +begin + Headers.Add('soapAction:' + SoapAction); +end; + +constructor THTTPTransport.Create(); +begin + FPropMngr := TPublishedPropertyManager.Create(Self); + FConnection := THttpCli.Create(Nil); +end; + +destructor THTTPTransport.Destroy(); +begin + FreeAndNil(FConnection); + FPropMngr := Nil; + inherited Destroy(); +end; + +function THTTPTransport.GetPropertyManager(): IPropertyManager; +begin + Result := FPropMngr; +end; + +procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream); +{$IFDEF WST_DBG} +Var + s : string; + i : Int64; +{$ENDIF WST_DBG} +begin + {$IFDEF WST_DBG} + i := ARequest.Position; + ARequest.Position := 0; + SetLength(s,ARequest.Size); + ARequest.Read(s[1],ARequest.Size); + WriteLn(s); + ARequest.Position := i; + {$ENDIF WST_DBG} + + FConnection.SendStream := ARequest; + FConnection.RcvdStream := AResponse; + FConnection.Post(); + + {$IFDEF WST_DBG} + i := AResponse.Position; + SetLength(s,AResponse.Size); + AResponse.Read(s[1],AResponse.Size);TMemoryStream(AResponse).SaveToFile('E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log'); + WriteLn(s); + {$ENDIF WST_DBG} +end; + +procedure ICS_RegisterHTTP_Transport(); +begin + GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(THTTPTransport) as IItemFactory); +end; + +end. diff --git a/wst/tags/3.1/ics_tcp_protocol.pas b/wst/tags/3.1/ics_tcp_protocol.pas new file mode 100644 index 000000000..459a8b2cb --- /dev/null +++ b/wst/tags/3.1/ics_tcp_protocol.pas @@ -0,0 +1,222 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit ics_tcp_protocol; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + service_intf, imp_utils, base_service_intf, + WSocket; + +Const + sTRANSPORT_NAME = 'TCP'; + +Type + + ETCPException = class(EServiceException) + End; + +{$M+} + { TTCPTransport } + TTCPTransport = class(TSimpleFactoryItem,ITransport) + Private + FPropMngr : IPropertyManager; + FConnection : TWSocket; + FContentType : string; + FTarget: string; + function GetAddress: string; + function GetPort: string; + procedure SetAddress(const AValue: string); + procedure SetPort(const AValue: string); + private + FDataLength : LongInt; + FDataBuffer : string; + FAllDataRead : Boolean; + FBeginRead : Boolean; + FHasException : Boolean; + FExceptionMessage : string; + procedure DataAvailable(Sender: TObject; Error: Word); + procedure BgExceptionHandler(Sender : TObject;E : Exception;var CanClose : Boolean); + Public + constructor Create();override; + destructor Destroy();override; + function GetPropertyManager():IPropertyManager; + procedure SendAndReceive(ARequest,AResponse:TStream); + Published + property Target : string Read FTarget Write FTarget; + property ContentType : string Read FContentType Write FContentType; + property Address : string Read GetAddress Write SetAddress; + property Port : string Read GetPort Write SetPort; + End; +{$M+} + + procedure ICS_RegisterTCP_Transport(); + +implementation +uses binary_streamer, Math; + +{ TTCPTransport } + +function TTCPTransport.GetAddress: string; +begin + Result := FConnection.Addr; +end; + +function TTCPTransport.GetPort: string; +begin + Result := FConnection.Port; +end; + +procedure TTCPTransport.SetAddress(const AValue: string); +begin + FConnection.Addr := AValue; +end; + +procedure TTCPTransport.SetPort(const AValue: string); +begin + FConnection.Port := AValue; +end; + +procedure TTCPTransport.DataAvailable(Sender: TObject; Error: Word); +Var + i,j : PtrInt; + buff : string; +begin + If Not FBeginRead Then Begin + i := 1024; + SetLength(buff,i); + While ( FConnection.Receive(@(buff[1]),i) = i ) Do + ; + FDataBuffer := ''; + FDataLength := -1; + Exit; + End; + + If ( FDataLength < 0 ) Then Begin + i := 4; + if ( FConnection.Receive(@FDataLength,i) < i ) then + raise ETCPException.Create('Error reading data length.'); + FDataLength := Reverse_32(FDataLength); + End; + If ( FDataLength > Length(FDataBuffer) ) Then Begin + i := 1024; + If ( i > FDataLength ) Then + i := FDataLength; + SetLength(buff,i); + Repeat + j := FConnection.Receive(@(buff[1]),i); + FDataBuffer := FDataBuffer + Copy(buff,1,j); + i := Min(1024,(FDataLength-Length(FDataBuffer))); + Until ( i =0 ) or ( j <= 0 ); + End; + FAllDataRead := ( FDataLength <= Length(FDataBuffer) ); +end; + +procedure TTCPTransport.BgExceptionHandler(Sender: TObject; E: Exception;var CanClose: Boolean); +begin + CanClose := True; + FHasException := True; + FExceptionMessage := E.Message; +end; + +constructor TTCPTransport.Create(); +begin + FDataLength := -1; + FAllDataRead := False; + FPropMngr := TPublishedPropertyManager.Create(Self); + FConnection := TWSocket.Create(Nil); + FConnection.OnDataAvailable := @DataAvailable; + FConnection.OnBgException := @BgExceptionHandler; +end; + +destructor TTCPTransport.Destroy(); +begin + FreeAndNil(FConnection); + FPropMngr := Nil; + inherited Destroy(); +end; + +function TTCPTransport.GetPropertyManager(): IPropertyManager; +begin + Result := FPropMngr; +end; + +procedure TTCPTransport.SendAndReceive(ARequest, AResponse: TStream); + +Var + wrtr : IDataStore; + buffStream : TMemoryStream; + strBuff : string; +{$IFDEF WST_DBG} + s : string; + i : Int64; +{$ENDIF WST_DBG} +begin + buffStream := TMemoryStream.Create(); + Try + wrtr := CreateBinaryWriter(buffStream); + wrtr.WriteInt32S(0); + wrtr.WriteStr(Target); + wrtr.WriteStr(ContentType); + SetLength(strBuff,ARequest.Size); + ARequest.Position := 0; + ARequest.Read(strBuff[1],Length(strBuff)); + wrtr.WriteStr(strBuff); + buffStream.Position := 0; + wrtr.WriteInt32S(buffStream.Size-4); + + If ( FConnection.State = wsClosed ) Then Begin + FConnection.Connect(); + While ( FConnection.State < wsConnected ) Do + FConnection.ProcessMessage(); + End; + + FDataBuffer := ''; + FDataLength := -1; + FAllDataRead := False; + FHasException := False; + FExceptionMessage := ''; + FBeginRead := True; + + FConnection.Send(buffStream.Memory,buffStream.Size); + FConnection.Flush(); + While Not ( FAllDataRead Or FHasException ) Do + FConnection.ProcessMessage(); + If FHasException Then + Raise ETCPException.Create(FExceptionMessage); + AResponse.Size := 0; + AResponse.Write(FDataBuffer[1],Length(FDataBuffer)); + FDataBuffer := ''; + FDataLength := -1; + FAllDataRead := False; + AResponse.Position := 0; + {$IFDEF WST_DBG} + i := AResponse.Position; + SetLength(s,AResponse.Size); + AResponse.Read(s[1],AResponse.Size); + WriteLn(s); + {$ENDIF WST_DBG} + Finally + buffStream.Free(); + End; +end; + +procedure ICS_RegisterTCP_Transport(); +begin + GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(TTCPTransport) as IItemFactory); +end; + +end. diff --git a/wst/tags/3.1/imp_utils.pas b/wst/tags/3.1/imp_utils.pas new file mode 100644 index 000000000..0eb889387 --- /dev/null +++ b/wst/tags/3.1/imp_utils.pas @@ -0,0 +1,187 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit imp_utils; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, + base_service_intf; + +Type + + EPropertyManagerException = class(EServiceException) + End; + + { TPublishedPropertyManager } + + TPublishedPropertyManager = class(TInterfacedObject,IPropertyManager) + Private + FParent : TObject; + procedure Error(Const AMsg:string); + procedure Error(Const AMsg:string; Const AArgs : array of const); + Protected + procedure SetProperty(Const AName,AValue:string); + procedure SetProperties(Const APropsStr:string); + function GetProperty(Const AName:String):string; + function GetPropertyNames(ADest : TStrings):Integer; + procedure Clear(); + procedure Copy(ASource:IPropertyManager; Const AClearBefore : Boolean); + Public + constructor Create(AParent : TObject); + End; + + function IsStrEmpty(Const AStr:String):Boolean; + +implementation + +function IsStrEmpty(Const AStr:String):Boolean; +begin + Result := ( Length(Trim(AStr)) = 0 ); +end; + +{ TPublishedPropertyManager } + +procedure TPublishedPropertyManager.Error(const AMsg: string); +begin + Raise EPropertyManagerException.Create(AMsg); +end; + +procedure TPublishedPropertyManager.Error(const AMsg: string;const AArgs: array of const); +begin + Raise EPropertyManagerException.CreateFmt(AMsg,AArgs); +end; + +procedure TPublishedPropertyManager.SetProperty(const AName, AValue: string); +Var + pinf : PPropInfo; + int64Val : Int64; +begin + pinf := GetPropInfo(FParent,AName); + If Assigned(pinf) And Assigned(pinf^.SetProc) Then Begin + Case pinf^.PropType^.Kind of + tkSString,tkLString,tkAString,tkWString: + SetStrProp(FParent,pinf,AValue); + tkEnumeration : + SetEnumProp(FParent,pinf,AValue); + tkInteger,tkInt64,tkQWord: + Begin + If TryStrToInt64(AValue,int64Val) Then + SetOrdProp(FParent,AName,int64Val); + End; + End; + End; +end; + +procedure TPublishedPropertyManager.SetProperties(const APropsStr: string); +Var + lst : TStringList; + i : Integer; +begin + If IsStrEmpty(APropsStr) Then + Exit; + lst := TStringList.Create(); + Try + lst.QuoteChar := #0; + lst.Delimiter := PROP_LIST_DELIMITER; + lst.DelimitedText := APropsStr; + For i := 0 To Pred(lst.Count) Do + SetProperty(lst.Names[i],lst.ValueFromIndex[i]); + Finally + lst.Free(); + End; +end; + +function TPublishedPropertyManager.GetProperty(const AName: String): string; +Var + pinf : PPropInfo; +begin + Result := ''; + pinf := GetPropInfo(FParent,AName); + If Assigned(pinf) And Assigned(pinf^.SetProc) Then Begin + Case pinf^.PropType^.Kind of + tkSString,tkLString,tkAString,tkWString: + Result := GetStrProp(FParent,pinf); + tkEnumeration : + Result := GetEnumProp(FParent,pinf); + tkInteger,tkInt64,tkQWord: + Result := IntToStr(GetOrdProp(FParent,pinf)); + End; + End; +end; + +function TPublishedPropertyManager.GetPropertyNames(ADest: TStrings): Integer; +Var + propList : PPropList; + i, propListLen : Integer; +begin + ADest.Clear(); + propListLen := GetPropList(PTypeInfo(FParent.ClassInfo),propList); + Try + For i := 0 To Pred(propListLen) Do Begin + If ( propList^[i]^.PropType^.Kind in + [ tkSString,tkLString,tkAString,tkWString, + tkEnumeration, + tkInteger,tkInt64,tkQWord + ] + ) + Then + ADest.Add(propList^[i]^.Name); + End; + Finally + Freemem(propList,propListLen*SizeOf(Pointer)); + End; + Result := ADest.Count; +end; + +procedure TPublishedPropertyManager.Clear(); +begin + +end; + +procedure TPublishedPropertyManager.Copy( + ASource: IPropertyManager; + const AClearBefore: Boolean +); +Var + lst : TStringList; + i : Integer; + s : string; +begin + If AClearBefore Then + Clear(); + If Assigned(ASource) Then Begin + lst := TStringList.Create(); + Try + ASource.GetPropertyNames(lst); + For i := 0 To Pred(lst.Count) Do Begin + s := lst[i]; + SetProperty(s,ASource.GetProperty(s)); + End; + Finally + lst.Free(); + End; + End; +end; + +constructor TPublishedPropertyManager.Create(AParent: TObject); +begin + Assert(Assigned(AParent)); + FParent := AParent; +end; + + +end. + diff --git a/wst/tags/3.1/indy_http_protocol.pas b/wst/tags/3.1/indy_http_protocol.pas new file mode 100644 index 000000000..071c39823 --- /dev/null +++ b/wst/tags/3.1/indy_http_protocol.pas @@ -0,0 +1,170 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit indy_http_protocol; + +{$mode objfpc}{$H+} + +//{$DEFINE WST_DBG} + +interface + +uses + Classes, SysUtils, + service_intf, imp_utils, base_service_intf, + IdHTTP; + +Const + sTRANSPORT_NAME = 'HTTP'; + +Type + +{$M+} + { THTTPTransport } + THTTPTransport = class(TSimpleFactoryItem,ITransport) + Private + FPropMngr : IPropertyManager; + FConnection : TidHttp; + FSoapAction: string; + FContentType: string; + function GetAddress: string; + function GetProxyPassword: string; + function GetProxyPort: Integer; + function GetProxyServer: string; + function GetProxyUsername: string; + procedure SetAddress(const AValue: string); + procedure SetProxyPassword(const AValue: string); + procedure SetProxyPort(const AValue: Integer); + procedure SetProxyServer(const AValue: string); + procedure SetProxyUsername(const AValue: string); + Public + constructor Create();override; + destructor Destroy();override; + function GetPropertyManager():IPropertyManager; + procedure SendAndReceive(ARequest,AResponse:TStream); + Published + property ContentType : string Read FContentType Write FContentType; + property Address : string Read GetAddress Write SetAddress; + property ProxyServer : string Read GetProxyServer Write SetProxyServer; + property ProxyPort : Integer Read GetProxyPort Write SetProxyPort; + property ProxyUsername : string read GetProxyUsername write SetProxyUsername; + property ProxyPassword : string read GetProxyPassword write SetProxyPassword; + property SoapAction : string read FSoapAction write FSoapAction; + End; +{$M+} + + procedure INDY_RegisterHTTP_Transport(); + +implementation + +{ THTTPTransport } + +function THTTPTransport.GetAddress: string; +begin + Result := FConnection.Request.URL; +end; + +function THTTPTransport.GetProxyPassword: string; +begin + Result := FConnection.ProxyParams.ProxyPassword; +end; + +function THTTPTransport.GetProxyPort: Integer; +begin + Result := FConnection.ProxyParams.ProxyPort; +end; + +function THTTPTransport.GetProxyServer: string; +begin + Result := FConnection.ProxyParams.ProxyServer; +end; + +function THTTPTransport.GetProxyUsername: string; +begin + Result := FConnection.ProxyParams.ProxyUsername; +end; + +procedure THTTPTransport.SetAddress(const AValue: string); +begin + FConnection.Request.URL := AValue; +end; + +procedure THTTPTransport.SetProxyPassword(const AValue: string); +begin + FConnection.ProxyParams.ProxyPassword := AValue; +end; + +procedure THTTPTransport.SetProxyPort(const AValue: Integer); +begin + FConnection.ProxyParams.ProxyPort := AValue; +end; + +procedure THTTPTransport.SetProxyServer(const AValue: string); +begin + FConnection.ProxyParams.ProxyServer := AValue; +end; + +procedure THTTPTransport.SetProxyUsername(const AValue: string); +begin + FConnection.ProxyParams.ProxyUsername := AValue; +end; + +constructor THTTPTransport.Create(); +begin + FPropMngr := TPublishedPropertyManager.Create(Self); + FConnection := TidHttp.Create(Nil); +end; + +destructor THTTPTransport.Destroy(); +begin + FreeAndNil(FConnection); + FPropMngr := Nil; + inherited Destroy(); +end; + +function THTTPTransport.GetPropertyManager(): IPropertyManager; +begin + Result := FPropMngr; +end; + +procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream); +{$IFDEF WST_DBG} +var + s : string; + i : Int64; +{$ENDIF WST_DBG} +begin + if not ( IsStrEmpty(FConnection.ProxyParams.ProxyUsername) and + IsStrEmpty(FConnection.ProxyParams.ProxyPassword) + ) + then begin + FConnection.ProxyParams.BasicAuthentication := True; + end; + FConnection.Request.CustomHeaders.Clear(); + FConnection.Request.CustomHeaders.Values['soapAction'] := SoapAction; + FConnection.Request.ContentType := ContentType; + FConnection.Post(Address,ARequest, AResponse); + {$IFDEF WST_DBG} + i := AResponse.Size; + SetLength(s,i); + Move(TMemoryStream(AResponse).Memory^,s[1],i); + WriteLn('--------------------------------------------'); + WriteLn(s); + {$ENDIF WST_DBG} +end; + +procedure INDY_RegisterHTTP_Transport(); +begin + GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(THTTPTransport) as IItemFactory); +end; + +end. diff --git a/wst/tags/3.1/metadata_repository.pas b/wst/tags/3.1/metadata_repository.pas new file mode 100644 index 000000000..859f1f976 --- /dev/null +++ b/wst/tags/3.1/metadata_repository.pas @@ -0,0 +1,700 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} + +unit metadata_repository; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + + +const + sWST_SIGNATURE = 'WST_METADATA_0.2.2.0'; + sWST_META = 'wst_meta'; + +type + + EMetadataException = class(Exception) + end; + + PPropertyData = ^TPropertyData; + TPropertyData = record + Name : string; + Data : string; + Next : PPropertyData; + end; + + TOperationParamFlag = ( opfNone, opfIn, opfVar, opfOut ); + + POperationParam = ^TOperationParam; + TOperationParam = record + Name : ShortString; + TypeName : ShortString; + Modifier : TOperationParamFlag; + end; + + PServiceOperation = ^TServiceOperation; + TServiceOperation = record + Name : ShortString; + ParamsCount : Byte; + Params : POperationParam; + Properties : PPropertyData; + end; + + PService = ^TService; + TService = record + Name : ShortString; + OperationsCount : Byte; + Operations : PServiceOperation; + end; + + PServiceRepository = ^TServiceRepository; + TServiceRepository = record + NameSpace : ShortString; + Name : ShortString; + RootAddress : ShortString; + ServicesCount : Byte; + Services : PService; + end; + + IModuleMetadataMngr = interface + ['{B10ACF6A-A599-45A3-B083-BEEFB810C889}'] + function IndexOfName(const ARepName : shortstring):Integer; + function GetCount():Integer; + function GetRepositoryName(const AIndex : Integer):shortstring; + procedure SetRepositoryNameSpace(const ARepName,ANameSpace : shortstring); + function LoadRepositoryName( + const ARepName,ARootAddress : shortstring; + out ARepository : PServiceRepository + ):Integer; + procedure ClearRepository(var ARepository : PServiceRepository); + procedure SetOperationCustomData( + const ARepName : shortstring; + const AServiceName : shortstring; + const AOperationName : shortstring; + const ADataName, + AData : string + ); + //--------------------------------- + function GetServiceMetadata(const ARepName,AServiceName : shortstring) : PService; + procedure ClearServiceMetadata(var AService : PService); + end; + + function GetModuleMetadataMngr():IModuleMetadataMngr; + + function LoadRepositoryData( + const AStream : TStream; + out ARepository : PServiceRepository + ):LongInt; + procedure ClearRepositoryData(var ARepository : PServiceRepository); + +implementation +uses LResources, binary_streamer; + +procedure ClearProperties(var AProps : PPropertyData); +var + c : Integer; + q, p : PPropertyData; +begin + if not Assigned(AProps) then + Exit; + c := SizeOf(PPropertyData^); + p := AProps; + while Assigned(p) do begin + q := p; + p := p^.Next; + q^.Name := ''; + q^.Data := ''; + Freemem(q,c); + end; + AProps := nil; +end; + +function CloneProperties(const AProps : PPropertyData) : PPropertyData; +var + c : Integer; + p,q, q0 : PPropertyData; +begin + Result := nil; + if not Assigned(AProps) then + Exit; + c := SizeOf(PPropertyData^); + q0 := GetMem(c); + q := q0; + p := AProps; + while Assigned(p) do begin + q^.Next := GetMem(c); + FillChar(q^.Next^,c,#0); + q := q^.Next; + q^.Name := p^.Name; + q^.Data := p^.Data; + p := p^.Next; + end; + Result := q0^.Next; + Freemem(q0,c); +end; + +function Find(const AProps : PPropertyData; const APropName : string) : PPropertyData; +begin + if Assigned(AProps) then begin + Result := AProps; + while Assigned(Result) do begin + if AnsiSameText(APropName,Result^.Name) then + Exit; + Result := Result^.Next; + end; + end; + Result := nil; +end; + +function Add( + var AProps : PPropertyData; + const APropName, + APropData : string +) : PPropertyData; +begin + if not Assigned(AProps) then begin + AProps := GetMem(SizeOf(PPropertyData^)); + FillChar(AProps^,SizeOf(PPropertyData^),#0); + AProps^.Next := nil; + Result := AProps; + end else begin + Result := Find(AProps,APropName); + if not Assigned(Result) then begin + AProps^.Next := GetMem(SizeOf(PPropertyData^)); + FillChar(AProps^.Next^,SizeOf(PPropertyData^),#0); + Result := AProps^.Next; + Result^.Next := nil; + end; + end; + Result^.Name := APropName; + Result^.Data := APropData; +end; + +procedure ClearService(AService : PService; const AFreeService : Boolean); + + procedure ClearOperation(AOperation : PServiceOperation); + var + cc : LongInt; + begin + cc := AOperation^.ParamsCount; + if ( cc > 0 ) then begin + Freemem(AOperation^.Params, cc * SizeOf(POperationParam^) ); + end; + ClearProperties(AOperation^.Properties); + end; + +var + j, k : LongInt; + po : PServiceOperation; +begin + if not Assigned(AService) then + Exit; + k := AService^.OperationsCount; + if ( k > 0 ) then begin + po := AService^.Operations; + for j := 0 to Pred(k) do begin + ClearOperation(@(po[j])); + end; + Freemem(AService^.Operations, k * SizeOf(PServiceOperation^) ); + AService^.Operations := nil; + end; + if AFreeService then + Freemem(AService,SizeOf(PService^)); +end; + +procedure ClearRepositoryData(var ARepository : PServiceRepository); +var + i, c : LongInt; + ps : PService; +begin + if Assigned(ARepository) then begin + c := ARepository^.ServicesCount; + if ( c > 0 ) then begin + ps := ARepository^.Services; + for i := 0 to Pred(c) do begin + ClearService(@(ps[i]),false); + end; + Freemem(ARepository^.Services, c * SizeOf(PService^) ); + end; + Freemem(ARepository,SizeOf(PServiceRepository^)); + ARepository := nil; + end; +end; + +function LoadRepositoryData( + const AStream : TStream; + out ARepository : PServiceRepository +):LongInt; +var + rdr : IDataStoreReader; + + procedure LoadService(AService : PService); + + procedure LoadOperation(AOperation : PServiceOperation); + + procedure LoadParam(APrm : POperationParam); + begin + APrm^.Name := rdr.ReadStr(); + APrm^.TypeName := rdr.ReadStr(); + APrm^.Modifier := TOperationParamFlag(rdr.ReadEnum()); + end; + + var + ii, cc : LongInt; + pp : POperationParam; + begin + AOperation^.Name := rdr.ReadStr(); + AOperation^.Properties := nil; + cc := rdr.ReadInt8U(); + if ( cc > 0 ) then begin + AOperation^.Params := GetMem( cc * SizeOf(POperationParam^) ); + FillChar(AOperation^.Params^, cc * SizeOf(POperationParam^), #0); + AOperation^.ParamsCount := cc; + pp := AOperation^.Params; + for ii := 0 to Pred(cc) do begin + LoadParam(@(pp[ii])); + end; + end; + end; + + var + j, k : LongInt; + po : PServiceOperation; + begin + AService^.Name := rdr.ReadStr(); + k := rdr.ReadInt8U(); + if ( k > 0 ) then begin + AService^.Operations := GetMem( k * SizeOf(PServiceOperation^) ); + AService^.OperationsCount := k; + FillChar(AService^.Operations^,k * SizeOf(PServiceOperation^), #0); + po := AService^.Operations; + for j := 0 to Pred(k) do begin + LoadOperation(@(po[j])); + end; + end; + end; + +var + buf : string; + i, c : LongInt; + ps : PService; +begin + ARepository := nil; + Result := 0; + rdr := CreateBinaryReader(AStream); + buf := rdr.ReadStr(); + if ( sWST_SIGNATURE <> buf ) then + raise EMetadataException.CreateFmt('Invalid Metadata signature : "%s"',[buf]); + c := SizeOf(PServiceRepository^); + ARepository := GetMem(c); + try + FillChar(ARepository^,c,#0); + ARepository^.Name := rdr.ReadStr(); + c := rdr.ReadInt8U(); + if ( c > 0 ) then begin + ARepository^.Services := GetMem( c * SizeOf(PService^) ); + ARepository^.ServicesCount := c; + FillChar(ARepository^.Services^,c * SizeOf(PService^),#0); + ps := ARepository^.Services; + for i := 0 to Pred(c) do begin + LoadService(@(ps[i])); + end; + end; + Result := c; + except + ClearRepositoryData(ARepository); + raise; + end; +end; + + +procedure CopyService(ASrcService,ADestService : PService); + + procedure CopyOperation(ASrcOperation, ADstOperation : PServiceOperation); + + procedure CopyParam(ASrcPrm, ADstPrm : POperationParam); + begin + ADstPrm^ := ASrcPrm^; + end; + + var + ii, cc : LongInt; + pp : POperationParam; + begin + ADstOperation^.Name := ASrcOperation^.Name; + ADstOperation^.Properties := CloneProperties(ASrcOperation^.Properties); + cc := ASrcOperation^.ParamsCount; + if ( cc > 0 ) then begin + ADstOperation^.Params := GetMem( cc * SizeOf(POperationParam^) ); + FillChar(ADstOperation^.Params^, cc * SizeOf(POperationParam^), #0); + ADstOperation^.ParamsCount := cc; + pp := ADstOperation^.Params; + for ii := 0 to Pred(cc) do begin + CopyParam(@(ASrcOperation^.Params[ii]),@(pp[ii])); + end; + end; + end; + +var + j, k : LongInt; + po : PServiceOperation; +begin + ADestService^.Name := ASrcService^.Name; + k := ASrcService^.OperationsCount; + if ( k > 0 ) then begin + ADestService^.Operations := GetMem( k * SizeOf(PServiceOperation^) ); + ADestService^.OperationsCount := k; + FillChar(ADestService^.Operations^,k * SizeOf(PServiceOperation^), #0); + po := ADestService^.Operations; + for j := 0 to Pred(k) do begin + CopyOperation(@(ASrcService^.Operations[j]),@(po[j])); + end; + end; +end; + +function CloneService(const ASrcService : PService) : PService; +var + c : Integer; +begin + c := SizeOf(PService^); + Result := GetMem(c); + FillChar(Result^,c,#0); + CopyService(ASrcService,Result); +end; + +procedure CloneRepository( + const ASource : PServiceRepository; + out ADest : PServiceRepository +); +var + buf : string; + i, c : LongInt; + ps : PService; +begin + ADest := nil; + if not Assigned(ASource) then + Exit; + c := SizeOf(PServiceRepository^); + ADest := GetMem(c); + try + FillChar(ADest^,c,#0); + ADest^.Name := ASource^.Name; + ADest^.NameSpace := ASource^.NameSpace; + ADest^.RootAddress := ASource^.RootAddress; + c := ASource^.ServicesCount; + if ( c > 0 ) then begin + ADest^.Services := GetMem( c * SizeOf(PService^) ); + ADest^.ServicesCount := c; + FillChar(ADest^.Services^,c * SizeOf(PService^),#0); + ps := ADest^.Services; + for i := 0 to Pred(c) do begin + CopyService(@(ASource^.Services[i]),@(ps[i])); + end; + end; + except + ClearRepositoryData(ADest); + raise; + end; +end; + +type + + { TModuleMetadataMngr } + + TModuleMetadataMngr = class(TInterfacedObject,IInterface,IModuleMetadataMngr) + private + FList : TStringList; + FRepositories : array of PServiceRepository; + private + procedure LoadRegisteredNames(); + procedure ClearList(); + function FindInnerListIndex(const ARepName : shortstring):Integer; + function InternalLoadRepository(const ARepName : shortstring):Integer; + protected + function IndexOfName(const ARepName : shortstring):Integer; + procedure RegisterRepository(const ARepName : shortstring); + function GetCount():Integer; + function GetRepositoryName(const AIndex : Integer):shortstring; + procedure SetRepositoryNameSpace(const ARepName,ANameSpace : shortstring); + function LoadRepositoryName( + const ARepName,ARootAddress : shortstring; + out ARepository : PServiceRepository + ):Integer; + procedure ClearRepository(var ARepository : PServiceRepository); + procedure SetOperationCustomData( + const ARepName : shortstring; + const AServiceName : shortstring; + const AOperationName : shortstring; + const ADataName, + AData : string + ); + function GetServiceMetadata(const ARepName,AServiceName : shortstring) : PService; + procedure ClearServiceMetadata(var AService : PService); + public + constructor Create(); + destructor Destroy();override; + end; + +var + ModuleMetadataMngrInst : IModuleMetadataMngr = nil; + +function GetModuleMetadataMngr():IModuleMetadataMngr; +begin + if not Assigned(ModuleMetadataMngrInst) then + ModuleMetadataMngrInst := TModuleMetadataMngr.Create() as IModuleMetadataMngr; + Result := ModuleMetadataMngrInst; +end; + +{ TModuleMetadataMngr } + +procedure TModuleMetadataMngr.LoadRegisteredNames(); +var + i, c : Integer; + itm : TLResource; +begin + c := LazarusResources.Count; + for i := 0 to Pred(c) do begin + itm := LazarusResources.Items[i]; + if AnsiSameText(sWST_META,itm.ValueType) then + RegisterRepository(itm.Name); + end; +end; + +procedure TModuleMetadataMngr.ClearList(); +var + i : Integer; +begin + for i := 0 to Length(FRepositories) - 1 do begin + ClearRepository(FRepositories[i]); + end; + SetLength(FRepositories,0); +end; + +function TModuleMetadataMngr.FindInnerListIndex(const ARepName: shortstring): Integer; +begin + for Result := 0 to Pred(Length(FRepositories)) do begin + if AnsiSameText(ARepName,FRepositories[Result]^.Name) then + Exit; + end; + Result := -1; +end; + +function TModuleMetadataMngr.InternalLoadRepository(const ARepName: shortstring): Integer; +var + tmpStrm : TMemoryStream; + strBuffer : string; + i : Integer; + rs : TLResource; + tmpRes : PServiceRepository; +begin + rs := LazarusResources.Find(ARepName); + if not Assigned(rs) then + raise EMetadataException.CreateFmt('Repository not registered : "%s"',[ARepName]); + Result := FindInnerListIndex(ARepName); + if ( Result < 0 ) then begin + tmpStrm := TMemoryStream.Create(); + try + strBuffer := LazarusResources.Find(ARepName).Value; + i := Length(strBuffer); + tmpStrm.Write(strBuffer[1],i); + tmpStrm.Position := 0; + LoadRepositoryData(tmpStrm,tmpRes); + if Assigned(tmpRes) then begin + Result := Length(FRepositories); + SetLength(FRepositories, ( Result + 1 ) ); + FRepositories[Result] := tmpRes; + i := Length(tmpRes^.RootAddress); + if ( i = 0 ) or ( tmpRes^.RootAddress[i] <> '/' ) then + tmpRes^.RootAddress := tmpRes^.RootAddress + '/'; + tmpRes^.RootAddress := tmpRes^.RootAddress + 'services/'; + tmpRes^.NameSpace := FList.Values[tmpRes^.Name]; + if ( Length(tmpRes^.NameSpace) = 0 ) then + tmpRes^.NameSpace := 'urn:' + tmpRes^.Name; + end; + finally + tmpStrm.Free(); + end; + end; +end; + +function TModuleMetadataMngr.IndexOfName(const ARepName: shortstring): Integer; +begin + Result := FList.IndexOfName(ARepName); +end; + +procedure TModuleMetadataMngr.RegisterRepository(const ARepName: shortstring); +begin + if ( FList.IndexOfName(ARepName) = -1 ) then begin + FList.Values[ARepName] := 'urn:' + ARepName; + end; +end; + +function TModuleMetadataMngr.GetCount(): Integer; +begin + Result := FList.Count; +end; + +function TModuleMetadataMngr.GetRepositoryName(const AIndex: Integer): shortstring; +begin + Result := FList.Names[AIndex]; +end; + +procedure TModuleMetadataMngr.SetRepositoryNameSpace(const ARepName,ANameSpace: shortstring); +var + i : Integer; +begin + FList.Values[ARepName] := ANameSpace; + i := FindInnerListIndex(ARepName); + if ( i >= 0 ) then + FRepositories[i]^.NameSpace := ANameSpace; +end; + +function TModuleMetadataMngr.LoadRepositoryName( + const ARepName,ARootAddress : shortstring; + out ARepository : PServiceRepository +): Integer; +var + strBuffer : string; + i : Integer; +begin + Result := 0; + ARepository := nil; + i := FindInnerListIndex(ARepName); + if ( i < 0 ) then begin + i := InternalLoadRepository(ARepName); + end; + if ( Length(ARootAddress) > 0 ) and ( AnsiPos(ARootAddress,FRepositories[i]^.RootAddress) <> 1 ) then begin + strBuffer := ARootAddress; + if ( strBuffer[Length(strBuffer)] = '/' ) then + Delete(strBuffer,Length(strBuffer),1); + FRepositories[i]^.RootAddress := strBuffer + FRepositories[i]^.RootAddress; + end; + if ( i >= 0 ) then begin + CloneRepository(FRepositories[i],ARepository); + Exit; + end; +end; + +procedure TModuleMetadataMngr.ClearRepository(var ARepository: PServiceRepository); +begin + ClearRepositoryData(ARepository); +end; + +function FindService( + const ARep : PServiceRepository; + const AServiceName : shortstring +) : PService; +var + i : Integer; +begin + for i := 0 to Pred(ARep^.ServicesCount) do begin + if AnsiSameText(AServiceName,ARep^.Services[i].Name) then begin + Result := @(ARep^.Services[i]); + Exit; + end; + end; + Result := nil; +end; + +function FindOperation( + const AServ : PService; + const AOperationName : shortstring +) : PServiceOperation; +var + i : Integer; +begin + for i := 0 to Pred(AServ^.OperationsCount) do begin + if AnsiSameText(AOperationName,AServ^.Operations[i].Name) then begin + Result := @(AServ^.Operations[i]); + Exit; + end; + end; + Result := nil; +end; + +procedure TModuleMetadataMngr.SetOperationCustomData( + const ARepName : shortstring; + const AServiceName : shortstring; + const AOperationName : shortstring; + const ADataName, + AData : string +); +var + i : Integer; + rp : PServiceRepository; + sp : PService; + sop : PServiceOperation; +begin + i := FindInnerListIndex(ARepName); + if ( i < 0 ) then + i := InternalLoadRepository(ARepName); + rp := FRepositories[i]; + sp := FindService(rp,AServiceName); + if not Assigned(sp) then + raise EMetadataException.CreateFmt('Service non found : "%s"',[AServiceName]); + sop := FindOperation(sp,AOperationName); + if not Assigned(sop) then + raise EMetadataException.CreateFmt('Operation non found : "%s"',[AOperationName]); + Add(sop^.Properties,ADataName,AData); +end; + +function TModuleMetadataMngr.GetServiceMetadata(const ARepName,AServiceName: shortstring): PService; +var + i : Integer; + rp : PServiceRepository; +begin + Result := nil; + i := FindInnerListIndex(ARepName); + if ( i < 0 ) then + i := InternalLoadRepository(ARepName); + rp := FRepositories[i]; + for i := 0 to Pred(rp^.ServicesCount) do begin + if AnsiSameText(AServiceName,rp^.Services[i].Name) then begin + Result := CloneService(@(rp^.Services[i])); + Exit; + end; + end; +end; + +procedure TModuleMetadataMngr.ClearServiceMetadata(var AService: PService); +begin + ClearService(AService,True); + AService := nil; +end; + +constructor TModuleMetadataMngr.Create(); +begin + inherited Create(); + FRepositories := nil; + FList := TStringList.Create(); + LoadRegisteredNames(); +end; + +destructor TModuleMetadataMngr.Destroy(); +begin + ClearList(); + FreeAndNil(FList); + inherited Destroy(); +end; + + +initialization + +finalization + ModuleMetadataMngrInst := nil; + +End. diff --git a/wst/tags/3.1/metadata_service.lrs b/wst/tags/3.1/metadata_service.lrs new file mode 100644 index 000000000..c4484ab57 --- /dev/null +++ b/wst/tags/3.1/metadata_service.lrs @@ -0,0 +1,7 @@ +LazarusResources.Add('METADATA_SERVICE','wst_meta',[ + #0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#16'metadata_service'#1#0#0#0#19'IWSTMet' + +'adataService'#2#0#0#0#17'GetRepositoryList'#1#0#0#0#6'result'#0#0#0#23'TArr' + +'ayOfStringRemotable'#0#0#0#0#0#0#0#3#0#0#0#17'GetRepositoryInfo'#2#0#0#0#5 + +'AName'#0#0#0#6'string'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0#17'TWSTMtdRepo' + +'sitory'#0#0#0#0#0#0#0#3 +]); diff --git a/wst/tags/3.1/metadata_service.pas b/wst/tags/3.1/metadata_service.pas new file mode 100644 index 000000000..8b7ea9e52 --- /dev/null +++ b/wst/tags/3.1/metadata_service.pas @@ -0,0 +1,254 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} + +unit metadata_service; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + base_service_intf, metadata_repository; + +type + + TWSTMtdOperationParam = class(TBaseComplexRemotable) + private + FModifier: TOperationParamFlag; + FName: string; + FTypeName: string; + published + property Name : string read FName write FName; + property TypeName : string read FTypeName write FTypeName; + property Modifier : TOperationParamFlag read FModifier write FModifier; + end; + + TWSTMtdOperationParamArray = class(TBaseObjectArrayRemotable) + protected + function GetParam(AIndex: Integer): TWSTMtdOperationParam; + public + class function GetItemClass():TBaseRemotableClass;override; + property Item[AIndex:Integer] : TWSTMtdOperationParam read GetParam;default; + end; + + TWSTMtdServiceOperation = class(TBaseComplexRemotable) + private + FName: string; + FParams: TWSTMtdOperationParamArray; + function GetParams: TWSTMtdOperationParamArray; + procedure SetParams(const AValue: TWSTMtdOperationParamArray); + public + constructor Create();override; + destructor Destroy();override; + published + property Name : string read FName write FName; + property Params : TWSTMtdOperationParamArray read GetParams write SetParams; + end; + + TWSTMtdServiceOperationArray = class(TBaseObjectArrayRemotable) + private + function GetOperation(AIndex: Integer): TWSTMtdServiceOperation; + public + class function GetItemClass():TBaseRemotableClass;override; + property Item[AIndex:Integer] : TWSTMtdServiceOperation read GetOperation;default; + end; + + TWSTMtdService = class(TBaseComplexRemotable) + private + FName: string; + FOperations: TWSTMtdServiceOperationArray; + function GetOperations: TWSTMtdServiceOperationArray; + procedure SetOperations(const AValue: TWSTMtdServiceOperationArray); + public + constructor Create();override; + destructor Destroy();override; + published + property Name : string read FName write FName; + property Operations : TWSTMtdServiceOperationArray read GetOperations write SetOperations; + end; + + TWSTMtdServiceArray = class(TBaseObjectArrayRemotable) + protected + function GetService(AIndex: Integer): TWSTMtdService; + public + class function GetItemClass():TBaseRemotableClass;override; + Property Item[AIndex:Integer] : TWSTMtdService Read GetService;Default; + end; + + TWSTMtdRepository = class(TBaseComplexRemotable) + private + FName: string; + FNameSpace: string; + FServices : TWSTMtdServiceArray; + function GetServices: TWSTMtdServiceArray; + procedure SetServices(const AValue: TWSTMtdServiceArray); + public + constructor Create();override; + destructor Destroy();override; + published + property Name : string read FName write FName; + property NameSpace : string read FNameSpace write FNameSpace; + property Services : TWSTMtdServiceArray read GetServices write SetServices; + end; + + {The unique metadata public service} + IWSTMetadataService = interface + ['{804A3825-ADA5-4499-87BF-CF5491BFD674}'] + function GetRepositoryList():TArrayOfStringRemotable; + function GetRepositoryInfo(const AName : string):TWSTMtdRepository; + end; + + procedure Register_metadata_service_NameSpace(); + +implementation + +procedure Register_metadata_service_NameSpace(); +begin + GetModuleMetadataMngr().SetRepositoryNameSpace('metadata_service',sWST_BASE_NS); +end; + +procedure Register_metadata_service_Types(); +var + r : TTypeRegistry; +begin + r := GetTypeRegistry(); + + r.Register(sWST_BASE_NS,TypeInfo(TOperationParamFlag),'TOperationParamFlag'); + r.Register(sWST_BASE_NS,TypeInfo(TWSTMtdOperationParam),'TWSTMtdOperationParam'); + r.Register(sWST_BASE_NS,TypeInfo(TWSTMtdOperationParamArray),'TWSTMtdOperationParamArray'); + + r.Register(sWST_BASE_NS,TypeInfo(TWSTMtdOperationParam),'TWSTMtdOperationParam'); + r.Register(sWST_BASE_NS,TypeInfo(TWSTMtdOperationParamArray),'TWSTMtdOperationParamArray'); + + r.Register(sWST_BASE_NS,TypeInfo(TWSTMtdServiceOperation),'TWSTMtdServiceOperation'); + r.Register(sWST_BASE_NS,TypeInfo(TWSTMtdServiceOperationArray),'TWSTMtdServiceOperationArray'); + + r.Register(sWST_BASE_NS,TypeInfo(TWSTMtdService),'TWSTMtdService'); + r.Register(sWST_BASE_NS,TypeInfo(TWSTMtdServiceArray),'TWSTMtdServiceArray'); + + r.Register(sWST_BASE_NS,TypeInfo(TWSTMtdRepository),'TWSTMtdRepository'); +end; + +{ TWSTMtdServiceArray } + +function TWSTMtdServiceArray.GetService(AIndex: Integer): TWSTMtdService; +begin + Result := inherited Item[AIndex] as TWSTMtdService; +end; + +class function TWSTMtdServiceArray.GetItemClass(): TBaseRemotableClass; +begin + Result := TWSTMtdService; +end; + +{ TWSTMtdRepository } + +function TWSTMtdRepository.GetServices: TWSTMtdServiceArray; +begin + Result := FServices; +end; + +procedure TWSTMtdRepository.SetServices(const AValue: TWSTMtdServiceArray); +begin + FServices.Assign(AValue); +end; + +constructor TWSTMtdRepository.Create(); +begin + inherited Create(); + FServices := TWSTMtdServiceArray.Create(); +end; + +destructor TWSTMtdRepository.Destroy(); +begin + FreeAndNil(FServices); + inherited Destroy(); +end; + +{ TWSTMtdOperationParamArray } + +function TWSTMtdOperationParamArray.GetParam(AIndex: Integer): TWSTMtdOperationParam; +begin + Result := inherited Item[AIndex] as TWSTMtdOperationParam; +end; + +class function TWSTMtdOperationParamArray.GetItemClass(): TBaseRemotableClass; +begin + Result := TWSTMtdOperationParam; +end; + +{ TWSTMtdServiceOperation } + +function TWSTMtdServiceOperation.GetParams: TWSTMtdOperationParamArray; +begin + Result := FParams; +end; + +procedure TWSTMtdServiceOperation.SetParams(const AValue: TWSTMtdOperationParamArray); +begin + FParams.Assign(AValue); +end; + +constructor TWSTMtdServiceOperation.Create(); +begin + inherited Create(); + FParams := TWSTMtdOperationParamArray.Create(); +end; + +destructor TWSTMtdServiceOperation.Destroy(); +begin + FreeAndNil(FParams); + inherited Destroy(); +end; + +{ TWSTMtdServiceOperationArray } + +function TWSTMtdServiceOperationArray.GetOperation(AIndex: Integer): TWSTMtdServiceOperation; +begin + Result := inherited Item[AIndex] as TWSTMtdServiceOperation; +end; + +class function TWSTMtdServiceOperationArray.GetItemClass(): TBaseRemotableClass; +begin + Result := TWSTMtdServiceOperation; +end; + +{ TWSTMtdService } + +function TWSTMtdService.GetOperations: TWSTMtdServiceOperationArray; +begin + Result := FOperations; +end; + +procedure TWSTMtdService.SetOperations(const AValue: TWSTMtdServiceOperationArray); +begin + FOperations.Assign(AValue); +end; + +constructor TWSTMtdService.Create(); +begin + FOperations := TWSTMtdServiceOperationArray.Create(); + inherited Create(); +end; + +destructor TWSTMtdService.Destroy(); +begin + FreeAndNil(FOperations); + inherited Destroy(); +end; + +initialization + Register_metadata_service_Types(); + +end. diff --git a/wst/tags/3.1/metadata_service.wst_meta b/wst/tags/3.1/metadata_service.wst_meta new file mode 100644 index 000000000..1e634ff45 Binary files /dev/null and b/wst/tags/3.1/metadata_service.wst_meta differ diff --git a/wst/tags/3.1/metadata_service_binder.pas b/wst/tags/3.1/metadata_service_binder.pas new file mode 100644 index 000000000..4a87ffe5b --- /dev/null +++ b/wst/tags/3.1/metadata_service_binder.pas @@ -0,0 +1,129 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "metadata_service". + This unit name : "metadata_service_binder". + Date : "31/07/2006 23:18". +} +unit metadata_service_binder; +{$mode objfpc}{$H+} +interface + +uses SysUtils, Classes, base_service_intf, server_service_intf, metadata_service; + +type + + + TWSTMetadataService_ServiceBinder=class(TBaseServiceBinder) + Protected + procedure GetRepositoryListHandler(AFormatter:IFormatterResponse); + procedure GetRepositoryInfoHandler(AFormatter:IFormatterResponse); + Public + constructor Create(); + End; + + TWSTMetadataService_ServiceBinderFactory = class(TInterfacedObject,IItemFactory) + protected + function CreateInstance():IInterface; + End; + + procedure Server_service_RegisterWSTMetadataServiceService(); + +Implementation +uses TypInfo, LResources,metadata_repository; + +{ TWSTMetadataService_ServiceBinder implementation } +procedure TWSTMetadataService_ServiceBinder.GetRepositoryListHandler(AFormatter:IFormatterResponse); +Var + cllCntrl : ICallControl; + tmpObj : IWSTMetadataService; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + returnVal : TArrayOfStringRemotable; +Begin + callCtx := GetCallContext(); + If ( PTypeInfo(TypeInfo(TArrayOfStringRemotable))^.Kind in [tkClass,tkInterface] ) Then + Pointer(returnVal) := Nil; + + + tmpObj := Self.GetFactory().CreateInstance() as IWSTMetadataService; + if Supports(tmpObj,ICallControl,cllCntrl) then + cllCntrl.SetCallContext(GetCallContext()); + + returnVal := tmpObj.GetRepositoryList(); + If ( PTypeInfo(TypeInfo(TArrayOfStringRemotable))^.Kind = tkClass ) And Assigned(Pointer(returnVal)) Then + callCtx.AddObjectToFree(TObject(returnVal)); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(TArrayOfStringRemotable),returnVal); + AFormatter.EndCallResponse(); + + callCtx := Nil; +End; + +procedure TWSTMetadataService_ServiceBinder.GetRepositoryInfoHandler(AFormatter:IFormatterResponse); +Var + cllCntrl : ICallControl; + tmpObj : IWSTMetadataService; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + AName : string; + returnVal : TWSTMtdRepository; +Begin + callCtx := GetCallContext(); + Pointer(returnVal) := Nil; + + strPrmName := 'AName'; AFormatter.Get(TypeInfo(string),strPrmName,AName); + + tmpObj := Self.GetFactory().CreateInstance() as IWSTMetadataService; + if Supports(tmpObj,ICallControl,cllCntrl) then + cllCntrl.SetCallContext(GetCallContext()); + + returnVal := tmpObj.GetRepositoryInfo(AName); + If Assigned(Pointer(returnVal)) Then + callCtx.AddObjectToFree(TObject(returnVal)); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(TWSTMtdRepository),returnVal); + AFormatter.EndCallResponse(); + + callCtx := Nil; +End; + + +constructor TWSTMetadataService_ServiceBinder.Create(); +Begin + Inherited Create(GetServiceImplementationRegistry().FindFactory('IWSTMetadataService')); + RegisterVerbHandler('GetRepositoryList',@GetRepositoryListHandler); + RegisterVerbHandler('GetRepositoryInfo',@GetRepositoryInfoHandler); +End; + + +{ TWSTMetadataService_ServiceBinderFactory } +function TWSTMetadataService_ServiceBinderFactory.CreateInstance():IInterface; +Begin + Result := TWSTMetadataService_ServiceBinder.Create() as IInterface; +End; + + +procedure Server_service_RegisterWSTMetadataServiceService(); +Begin + GetServerServiceRegistry().Register('IWSTMetadataService',TWSTMetadataService_ServiceBinderFactory.Create() as IItemFactory); +End; + +initialization + + {$IF DECLARED(Register_metadata_service_NameSpace)} + Register_metadata_service_NameSpace(); + {$ENDIF} + + {$i metadata_service.lrs} + +End. diff --git a/wst/tags/3.1/metadata_service_imp.pas b/wst/tags/3.1/metadata_service_imp.pas new file mode 100644 index 000000000..7fe542a30 --- /dev/null +++ b/wst/tags/3.1/metadata_service_imp.pas @@ -0,0 +1,126 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "metadata_service". + This unit name : "metadata_service_imp". + Date : "01/07/2006 22:14". +} +Unit metadata_service_imp; +{$mode objfpc}{$H+} +Interface + +Uses SysUtils, Classes, + base_service_intf, server_service_intf, server_service_imputils, metadata_service; + +Type + + + TWSTMetadataService_ServiceImp=class(TSimpleFactoryItem,IWSTMetadataService) + Protected + function GetRepositoryList():TArrayOfStringRemotable; + function GetRepositoryInfo( + Const AName : string + ):TWSTMtdRepository; + End; + + + procedure RegisterWSTMetadataServiceImplementationFactory(); + +Implementation +uses metadata_repository; + +{ TWSTMetadataService_ServiceImp implementation } +function TWSTMetadataService_ServiceImp.GetRepositoryList():TArrayOfStringRemotable; +var + i, c : Integer; + mn : IModuleMetadataMngr; +Begin + Result := TArrayOfStringRemotable.Create(); + try + mn := GetModuleMetadataMngr(); + c := mn.GetCount(); + Result.SetLength(c); + for i := 0 to Pred(c) do + Result[i] := mn.GetRepositoryName(i); + except + FreeAndNil(Result); + raise; + end; +End; + +function TWSTMetadataService_ServiceImp.GetRepositoryInfo(Const AName : string):TWSTMtdRepository; + + procedure LoadService(ARawServ : PService; AObjServ : TWSTMtdService); + + procedure LoadOperation(ARawOper : PServiceOperation; AObjOper : TWSTMtdServiceOperation); + + procedure LoadParam(ARawParam : POperationParam; AObjPrm : TWSTMtdOperationParam); + begin + if Assigned(ARawParam) and Assigned(AObjPrm) then begin + AObjPrm.Name :=ARawParam^.Name; + AObjPrm.TypeName := ARawParam^.TypeName; + AObjPrm.Modifier := ARawParam^.Modifier; + end; + end; + + var + ii, cc : Integer; + begin + if Assigned(ARawOper) and Assigned(AObjOper) then begin + AObjOper.Name :=ARawOper^.Name; + cc := ARawOper^.ParamsCount; + AObjOper.Params.SetLength(cc); + for ii := 0 to Pred(cc) do + LoadParam(@(ARawOper^.Params[ii]),AObjOper.Params[ii]); + end; + end; + + var + k, d : Integer; + begin + if Assigned(ARawServ) and Assigned(AObjServ) then begin + AObjServ.Name :=ARawServ^.Name; + d := ARawServ^.OperationsCount; + AObjServ.Operations.SetLength(d); + for k := 0 to Pred(d) do + LoadOperation(@(ARawServ^.Operations[k]),AObjServ.Operations[k]); + end; + end; + +var + repData : PServiceRepository; + mn : IModuleMetadataMngr; + i, c : Integer; +Begin + Result := nil; + mn := GetModuleMetadataMngr(); + mn.LoadRepositoryName(AName,'/',repData); + if Assigned(repData) then begin + try + try + Result := TWSTMtdRepository.Create(); + Result.Name := repData^.Name; + Result.NameSpace := repData^.NameSpace; + c := repData^.ServicesCount; + Result.Services.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + LoadService(@(repData^.Services[i]),Result.Services[i]); + end; + end; + except + FreeAndNil(Result); + raise; + end; + finally + mn.ClearRepository(repData); + end; + end; +End; + + +procedure RegisterWSTMetadataServiceImplementationFactory(); +Begin + GetServiceImplementationRegistry().Register('IWSTMetadataService',TImplementationFactory.Create(TWSTMetadataService_ServiceImp) as IServiceImplementationFactory); +End; + +End. diff --git a/wst/tags/3.1/metadata_service_proxy.pas b/wst/tags/3.1/metadata_service_proxy.pas new file mode 100644 index 000000000..0b045b660 --- /dev/null +++ b/wst/tags/3.1/metadata_service_proxy.pas @@ -0,0 +1,90 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "metadata_service". + This unit name : "metadata_service_proxy". + Date : "31/07/2006 23:11". +} +Unit metadata_service_proxy; +{$mode objfpc}{$H+} +Interface + +Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, metadata_service; + +Type + + + TWSTMetadataService_Proxy=class(TBaseProxy,IWSTMetadataService) + Protected + class function GetServiceType() : PTypeInfo;override; + function GetRepositoryList():TArrayOfStringRemotable; + function GetRepositoryInfo( + Const AName : string + ):TWSTMtdRepository; + End; + +Implementation +uses LResources, metadata_repository; + +{ TWSTMetadataService_Proxy implementation } + +class function TWSTMetadataService_Proxy.GetServiceType() : PTypeInfo; +begin + result := TypeInfo(IWSTMetadataService); +end; + +function TWSTMetadataService_Proxy.GetRepositoryList():TArrayOfStringRemotable; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('GetRepositoryList', GetTarget(),(Self as ICallContext)); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + If ( PTypeInfo(TypeInfo(TArrayOfStringRemotable))^.Kind in [tkClass,tkInterface] ) Then + Pointer(Result) := Nil; + strPrmName := 'return'; + locSerializer.Get(TypeInfo(TArrayOfStringRemotable), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + +function TWSTMetadataService_Proxy.GetRepositoryInfo( + Const AName : string +):TWSTMtdRepository; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('GetRepositoryInfo', GetTarget(),(Self as ICallContext)); + locSerializer.Put('AName', TypeInfo(string), AName); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(Result) := Nil; + strPrmName := 'return'; + locSerializer.Get(TypeInfo(TWSTMtdRepository), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + + +initialization + {$i metadata_service.lrs} + + {$IF DECLARED(Register_metadata_service_ServiceMetadata)} + Register_metadata_service_ServiceMetadata(); + {$ENDIF} +End. diff --git a/wst/tags/3.1/metadata_wsdl.pas b/wst/tags/3.1/metadata_wsdl.pas new file mode 100644 index 000000000..46153930d --- /dev/null +++ b/wst/tags/3.1/metadata_wsdl.pas @@ -0,0 +1,803 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} + +unit metadata_wsdl; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, + DOM, + base_service_intf, metadata_repository; + +type + + IWsdlTypeHandler = interface + ['{DA9AF8B1-392B-49A8-91CC-6B5C5131E6FA}'] + procedure Generate( + const APascalTypeName : string; + AWsdlDocument : TDOMDocument + ); + end; + + IWsdlTypeHandlerRegistry = Interface + ['{A2FA2FE4-933D-44CC-B266-BF48674DECE9}'] + function Find(const APascalTypeName : string):IWsdlTypeHandler; + procedure Register( + const APascalTypeName : string; + AFactory : IItemFactory + ); + procedure RegisterDefaultHandler( + const ATypeKind : TTypeKind; + AFactory : IItemFactory + ); + End; + + { TEnumTypeHandler } + + TEnumTypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler) + protected + procedure Generate( + const APascalTypeName : string; + AWsdlDocument : TDOMDocument + ); + end; + + { TBaseComplexRemotable_TypeHandler } + + TBaseComplexRemotable_TypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler) + protected + procedure Generate( + const APascalTypeName : string; + AWsdlDocument : TDOMDocument + ); + end; + + { TBaseObjectArrayRemotable_TypeHandler } + + TBaseArrayRemotable_TypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler) + protected + procedure Generate( + const APascalTypeName : string; + AWsdlDocument : TDOMDocument + ); + end; + + procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TDOMDocument); + + function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry; + +implementation + +const + sWSDL_NS = 'http://schemas.xmlsoap.org/wsdl/'; + sSOAP_NS = 'http://schemas.xmlsoap.org/wsdl/soap/'; + sSOAP = 'soap'; + sSOAP_ENC_NS = 'http://schemas.xmlsoap.org/soap/encoding/'; + sXMLNS = 'xmlns'; + sXSD_NS = 'http://www.w3.org/2001/XMLSchema'; + sXSD = 'xsd'; + sTNS = 'tns'; + + sSOAP_ACTION = 'soapAction'; + sSOAP_ENCODED = 'encoded'; + sSOAP_ENCODING_STYLE = 'encodingStyle'; + sSOAP_RPC = 'rpc'; + sSOAP_TRANSPORT = 'http://schemas.xmlsoap.org/soap/http'; + sSOAP_USE = 'use'; + + sADDRESS = 'address'; + sATTRIBUTE = 'attribute'; + sBASE = 'base'; + sBINDING = 'binding'; + sBODY = 'body'; + sCOMPLEX_TYPE = 'complexType'; + sELEMENT = 'element'; + sENUMERATION = 'enumeration'; + sITEM = 'item'; + sLOCATION = 'location'; + sMIN_OCCURS = 'minOccurs'; + sMAX_OCCURS = 'maxOccurs'; + sNAME = 'name'; + sNAME_SPACE = 'namespace'; + sPORT_TYPE = 'portType'; + sRESTRICTION = 'restriction'; + sSEQUENCE = 'sequence'; + sSERVICE = 'service'; + sSIMPLE_TYPE = 'simpleType'; + sSTYLE = 'style'; + sTRANSPORT = 'transport'; + sTYPE = 'type'; + sUNBOUNDED = 'unbounded'; + sUSE = 'use'; + sVALUE = 'value'; + + sWSDL_DEFINITIONS = 'definitions'; + sWSDL_INPUT = 'input'; + sWSDL_MESSAGE = 'message'; + sWSDL_NAME = 'name'; + sWSDL_OPERATION = 'operation'; + sWSDL_OUTPUT = 'output'; + sWSDL_PART = 'part'; + sWSDL_PORT = 'port'; + sWSDL_PORT_TYPE = sPORT_TYPE; + sWSDL_SCHEMA = 'schema'; + sWSDL_TARGET_NS = 'targetNamespace'; + sWSDL_TYPE = sTYPE; + sWSDL_TYPES = 'types'; + +var + WsdlTypeHandlerRegistryInst : IWsdlTypeHandlerRegistry; + +type + + { TWsdlTypeHandlerRegistry } + + TWsdlTypeHandlerRegistry = class(TBaseFactoryRegistry,IInterface,IWsdlTypeHandlerRegistry) + private + FDefaultHandlerTable : Array[TTypeKind] of IItemFactory; + private + function FindNearestClass(const AClassType : TClass):IItemFactory; + protected + function Find(const APascalTypeName : string):IWsdlTypeHandler; + procedure RegisterDefaultHandler( + const ATypeKind : TTypeKind; + AFactory : IItemFactory + ); + public + destructor Destroy();override; + End; + +{ TWsdlTypeHandlerRegistry } + +function DistanceFromChildToParent(AChildClass,AParentClass : TClass):Integer; +var + ch : TClass; +begin + if Assigned(AChildClass) and Assigned(AParentClass) then begin + Result := 0; + ch := AChildClass; + while Assigned(ch) do begin + if ( ch = AParentClass ) then + Exit; + Inc(Result); + ch := ch.ClassParent; + end; + end; + Result := MaxInt; +end; + +function TWsdlTypeHandlerRegistry.FindNearestClass(const AClassType : TClass):IItemFactory; +var + i,c, foundIndex,tmpScore, score : Integer; + itm : TBaseFactoryRegistryItem; + typData : PTypeData; + r : TTypeRegistry; + ri : TTypeRegistryItem; +begin + Result := nil; + foundIndex := -1; + score := MaxInt; + r := GetTypeRegistry(); + c := Count; + for i := 0 to Pred(c) do begin + itm := Item[i]; + ri := r.Find(itm.Name); + if Assigned(ri) and ( ri.DataType^.Kind = tkClass ) then begin + typData := GetTypeData(ri.DataType); + tmpScore := DistanceFromChildToParent(AClassType,typData^.ClassType); + if ( tmpScore < score ) then begin + foundIndex := i; + score := tmpScore; + end; + end; + end; + if ( foundIndex >= 0 ) then begin + Result := Item[foundIndex].Factory; + end; +end; + +function TWsdlTypeHandlerRegistry.Find(const APascalTypeName: string): IWsdlTypeHandler; +Var + fct : IItemFactory; + ri : TTypeRegistryItem; +begin + Result := nil; + fct := FindFactory(APascalTypeName); + if not Assigned(fct) then begin + ri := GetTypeRegistry().Find(APascalTypeName); + if Assigned(ri) then begin + if ( ri.DataType^.Kind = tkClass ) then + fct := FindNearestClass(GetTypeData(ri.DataType)^.ClassType); + if not Assigned(fct) then + fct := FDefaultHandlerTable[ri.DataType^.Kind]; + end; + end; + if Assigned(fct) then + Result := fct.CreateInstance() as IWsdlTypeHandler; +end; + +procedure TWsdlTypeHandlerRegistry.RegisterDefaultHandler( + const ATypeKind: TTypeKind; + AFactory: IItemFactory +); +begin + FDefaultHandlerTable[ATypeKind] := AFactory; +end; + +destructor TWsdlTypeHandlerRegistry.Destroy(); +var + i : TTypeKind; +begin + for i := Low(TTypeKind) to High(TTypeKind) do + FDefaultHandlerTable[i] := nil; + inherited Destroy(); +end; + +function CreateElement(const ANodeName : DOMString; AParent : TDOMNode; ADoc : TDOMDocument):TDOMElement;//inline; +begin + Result := ADoc.CreateElement(ANodeName); + AParent.AppendChild(Result); +end; + +function FindAttributeByValueInNode( + const AAttValue : string; + const ANode : TDOMNode; + out AResAtt : string; + const AStartIndex : Integer = 0; + const AStartingWith : string = '' +):boolean; +var + i,c : Integer; + b : Boolean; +begin + AResAtt := ''; + if Assigned(ANode) and Assigned(ANode.Attributes) then begin + b := ( Length(AStartingWith) = 0); + c := Pred(ANode.Attributes.Length); + if ( AStartIndex >= 0 ) then + i := AStartIndex; + for i := 0 to c do begin + if AnsiSameText(AAttValue,ANode.Attributes.Item[i].NodeValue) and + ( b or ( Pos(AStartingWith,ANode.Attributes.Item[i].NodeName) = 1 )) + then begin + AResAtt := ANode.Attributes.Item[i].NodeName; + Result := True; + Exit; + end; + end; + end; + Result := False; +end; + +function GetNameSpaceShortName( + const ANameSpace : string; + AWsdlDocument : TDOMDocument +):string;//inline; +begin + if FindAttributeByValueInNode(ANameSpace,AWsdlDocument.DocumentElement,Result,0,sXMLNS) then begin + Result := Copy(Result,Length(sXMLNS+':')+1,MaxInt); + end else begin + Result := Format('ns%d',[AWsdlDocument.DocumentElement.Attributes.Count]) ; + AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,Result]),ANameSpace); + end; +end; + +type TServiceElementType = ( setPortType, setBinding, setPort, setService,setAddress ); +function GetServicePartName(AService : PService; const AServicePart : TServiceElementType):string; +const PART_NAME_MAP : array[TServiceElementType] of shortstring = ('', 'Binding', 'Port', '',''); +begin + Result := AService^.Name + PART_NAME_MAP[AServicePart]; +end; + +procedure GenerateWSDL(AMdtdRep : PServiceRepository; ADoc : TDOMDocument); + + procedure GenerateServiceMessages( + AService : PService; + ARootNode : TDOMElement + ); + + procedure GenerateOperationMessage(AOperation : PServiceOperation); + + procedure GenerateParam(APrm : POperationParam; AMsgNode : TDOMElement); + var + tmpNode : TDOMElement; + typItm : TTypeRegistryItem; + ns_shortName, s : string; + begin + tmpNode := CreateElement(sWSDL_PART,AMsgNode,ADoc); + tmpNode.SetAttribute(sWSDL_NAME,APrm^.Name); + typItm := GetTypeRegistry().Find(APrm^.TypeName); + if not Assigned(typItm) then + raise EMetadataException.CreateFmt('Type not registered : "%s".',[APrm^.TypeName]); + //Assert(Assigned(typItm),APrm^.TypeName); + ns_shortName := GetNameSpaceShortName(typItm.NameSpace,ADoc); + s := Format('%s:%s',[ns_shortName,typItm.DeclaredName]); + tmpNode.SetAttribute(sWSDL_TYPE,s); + end; + + var + qryNode, rspNode : TDOMElement; + ii, cc : Integer; + pp : POperationParam; + begin + qryNode := CreateElement(sWSDL_MESSAGE,ARootNode,ADoc); + qryNode.SetAttribute(sWSDL_NAME,Format('%s',[AOperation^.Name])); + rspNode := CreateElement(sWSDL_MESSAGE,ARootNode,ADoc); + rspNode.SetAttribute(sWSDL_NAME,Format('%sResponse',[AOperation^.Name])); + cc := AOperation^.ParamsCount; + for ii := 0 to Pred(cc) do begin + pp := @(AOperation^.Params[ii]); + if ( pp^.Modifier in [opfNone, opfIn] ) then + GenerateParam(pp,qryNode) + else if ( pp^.Modifier in [opfVar, opfOut] ) then + GenerateParam(pp,rspNode); + end; + end; + + Var + j, k : Integer; + po : PServiceOperation; + begin + k := AService^.OperationsCount; + if ( k > 0 ) then begin + po := AService^.Operations; + for j := 0 to pred(k) do + GenerateOperationMessage(@(po[j])); + end; + end; + + procedure GenerateServicePortType(AService : PService; ARootNode : TDOMElement); + + procedure GenerateOperation(AOperation : PServiceOperation; APrtTypeNode : TDOMElement); + var + opNode, inNode, outNode : TDOMElement; + begin + opNode := CreateElement(sWSDL_OPERATION,APrtTypeNode,ADoc); + opNode.SetAttribute(sWSDL_NAME,AOperation^.Name); + inNode := CreateElement(sWSDL_INPUT,opNode,ADoc); + inNode.SetAttribute(sWSDL_MESSAGE,Format('%s:%s',[sTNS,AOperation^.Name])); + outNode := CreateElement(sWSDL_OUTPUT,opNode,ADoc); + outNode.SetAttribute(sWSDL_MESSAGE,Format('%s:%sResponse',[sTNS,AOperation^.Name])); + end; + + var + prtTypeNode : TDOMElement; + j, k : Integer; + po : PServiceOperation; + begin + prtTypeNode := CreateElement(sWSDL_PORT_TYPE,ARootNode,ADoc); + prtTypeNode.SetAttribute(sWSDL_NAME,GetServicePartName(AService,setPortType)); + k := AService^.OperationsCount; + if ( k > 0 ) then begin + po := AService^.Operations; + for j := 0 to pred(k) do begin + GenerateOperation(@(po[j]),prtTypeNode); + end; + end; + end; + + procedure GenerateServiceBinding(AService : PService; ARootNode : TDOMElement); + + procedure GenerateOperation(AOperation : PServiceOperation; ABndngNode : TDOMElement); + var + opNode, inNode, outNode, bdyNode : TDOMElement; + strBuff : string; + begin + strBuff := Format('%s:%s',[sSOAP,sWSDL_OPERATION]); + CreateElement(strBuff,ABndngNode,ADoc).SetAttribute(sSOAP_ACTION,Format('%s/%s%s',[AMdtdRep^.NameSpace,AService^.Name,AOperation^.Name])); + opNode := CreateElement(sWSDL_OPERATION,ABndngNode,ADoc); + opNode.SetAttribute(sWSDL_NAME,AOperation^.Name); + inNode := CreateElement(sWSDL_INPUT,opNode,ADoc); + strBuff := Format('%s:%s',[sSOAP,sBODY]); + bdyNode := CreateElement(strBuff,inNode,ADoc); + bdyNode.SetAttribute(sSOAP_USE,sSOAP_ENCODED); + bdyNode.SetAttribute(sNAME_SPACE,Format('%s',[AMdtdRep^.NameSpace])); + bdyNode.SetAttribute(sSOAP_ENCODING_STYLE,sSOAP_ENC_NS); + + outNode := CreateElement(sWSDL_OUTPUT,opNode,ADoc); + strBuff := Format('%s:%s',[sSOAP,sBODY]); + bdyNode := CreateElement(strBuff,outNode,ADoc); + bdyNode.SetAttribute(sSOAP_USE,sSOAP_ENCODED); + bdyNode.SetAttribute(sNAME_SPACE,Format('%s',[AMdtdRep^.NameSpace])); + bdyNode.SetAttribute(sSOAP_ENCODING_STYLE,sSOAP_ENC_NS); + end; + + var + bndgNode, soapbndgNode : TDOMElement; + j, k : Integer; + po : PServiceOperation; + strBuf : string; + begin + bndgNode := CreateElement(sBINDING,ARootNode,ADoc); + bndgNode.SetAttribute(sWSDL_NAME,GetServicePartName(AService,setBinding)); + bndgNode.SetAttribute(sWSDL_TYPE,Format('%s:%s',[sTNS,GetServicePartName(AService,setPortType)])); + + strBuf := Format('%s:%s',[sSOAP,sBINDING]); + soapbndgNode := CreateElement(strBuf,bndgNode,ADoc); + soapbndgNode.SetAttribute(sSTYLE,sSOAP_RPC); + soapbndgNode.SetAttribute(sTRANSPORT,sSOAP_TRANSPORT); + + k := AService^.OperationsCount; + if ( k > 0 ) then begin + po := AService^.Operations; + for j := 0 to pred(k) do begin + GenerateOperation(@(po[j]),bndgNode); + end; + end; + end; + + procedure GenerateServicePublication(AService : PService; ARootNode : TDOMElement); + var + srvcNode, portNode, soapAdrNode : TDOMElement; + strBuf : string; + begin + srvcNode := CreateElement(sSERVICE,ARootNode,ADoc); + srvcNode.SetAttribute(sWSDL_NAME,GetServicePartName(AService,setService)); + + strBuf := Format('%s',[sWSDL_PORT]); + portNode := CreateElement(strBuf,srvcNode,ADoc); + portNode.SetAttribute(sWSDL_NAME,GetServicePartName(AService,setPort)); + portNode.SetAttribute(sBINDING,Format('%s:%s',[sTNS,GetServicePartName(AService,setBinding)])); + + strBuf := Format('%s:%s',[sSOAP,sADDRESS]); + soapAdrNode := CreateElement(strBuf,portNode,ADoc); + soapAdrNode.SetAttribute(sLOCATION,Format('%s%s',[AMdtdRep^.RootAddress,GetServicePartName(AService,setAddress)])); + end; + + procedure GenerateServiceTypes(); + var + j, k : Integer; + tr : TTypeRegistry; + tri : TTypeRegistryItem; + g : IWsdlTypeHandler; + gr : IWsdlTypeHandlerRegistry; + begin + tr := GetTypeRegistry(); + gr := GetWsdlTypeHandlerRegistry(); + k := tr.Count; + for j := 0 to Pred(k) do begin + tri := tr[j]; + if ( not ( trioNonVisibleToMetadataService in tri.Options ) ) and + AnsiSameText(AMdtdRep^.NameSpace,tri.NameSpace) + then begin + g := gr.Find(tri.DataType^.Name); + if assigned(g) then + g.Generate(tri.DataType^.Name,ADoc); + end; + end; + end; + + function CreateRootNode():TDOMElement; + begin + Result := CreateElement(sWSDL_DEFINITIONS,ADoc,ADoc); + Result.SetAttribute(sWSDL_NAME,AMdtdRep^.Name); + + Result.SetAttribute(sWSDL_TARGET_NS,AMdtdRep^.NameSpace); + Result.SetAttribute(Format('%s:%s',[sXMLNS,sSOAP]),sSOAP_NS); + Result.SetAttribute(Format('%s:%s',[sXMLNS,sXSD]),sXSD_NS); + Result.SetAttribute(Format('%s:%s',[sXMLNS,sTNS]),AMdtdRep^.NameSpace); + Result.SetAttribute(sXMLNS,sWSDL_NS); + end; + + function CreateTypesRootNode(ARootNode : TDOMNode):TDOMElement; + begin + Result := CreateElement(sWSDL_TYPES,ARootNode,ADoc); + //Result.SetAttribute(sWSDL_TARGET_NS,AMdtdRep^.NameSpace); + end; + +var + defNode, typesNode, schNode : TDOMElement; + i, c : Integer; + ps : PService; +begin + if not ( Assigned(AMdtdRep) and Assigned(ADoc)) then + Exit; + + defNode := CreateRootNode(); + typesNode := CreateTypesRootNode(defNode); + schNode := CreateElement(sXSD + ':' + sWSDL_SCHEMA,typesNode,ADoc); + schNode.SetAttribute(sXMLNS,sXSD_NS); + schNode.SetAttribute(sWSDL_TARGET_NS,AMdtdRep^.NameSpace); + + GenerateServiceTypes(); + + c := AMdtdRep^.ServicesCount; + if ( c > 0 ) then begin + ps := AMdtdRep^.Services; + for i := 0 to Pred(c) do begin + GenerateServiceMessages(@(ps[i]),defNode); + end; + for i := 0 to Pred(c) do begin + GenerateServicePortType(@(ps[i]),defNode); + end; + for i := 0 to Pred(c) do begin + GenerateServiceBinding(@(ps[i]),defNode); + end; + for i := 0 to Pred(c) do begin + GenerateServicePublication(@(ps[i]),defNode); + end; + end; + +end; + +function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry; +begin + Result := WsdlTypeHandlerRegistryInst; +end; + +type + + { TFakeTypeHandler } + + TFakeTypeHandler = class(TSimpleFactoryItem,IWsdlTypeHandler) + protected + procedure Generate( + const APascalTypeName : string; + AWsdlDocument : TDOMDocument + ); + end; + +{ TBaseComplexRemotable_TypeHandler } + +procedure TBaseComplexRemotable_TypeHandler.Generate( + const APascalTypeName : string; + AWsdlDocument : TDOMDocument +); +var + typItm, propTypItm : TTypeRegistryItem; + s, prop_ns_shortName : string; + defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, eltNode : TDOMElement; + i : Integer; + propList : PPropList; + propCount, propListLen : Integer; + p : PPropInfo; + persistType : TPropStoreType; + objTypeData : PTypeData; + clsTyp : TBaseComplexRemotableClass; + attProp : Boolean; +begin + typItm := GetTypeRegistry().Find(APascalTypeName); + if Assigned(typItm) and + ( typItm.DataType^.Kind = tkClass ) + then begin + GetNameSpaceShortName(typItm.NameSpace,AWsdlDocument); + defTypesNode := AWsdlDocument.DocumentElement.FindNode(sWSDL_TYPES) as TDOMElement; + Assert(Assigned(defTypesNode)); + defSchemaNode := defTypesNode.FirstChild as TDOMElement; + + s := Format('%s:%s',[sXSD,sELEMENT]); + eltNode := CreateElement(s,defSchemaNode,AWsdlDocument); + eltNode.SetAttribute(sNAME, typItm.DeclaredName) ; + + s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]); + cplxNode := CreateElement(s,eltNode,AWsdlDocument); + //cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ; + s := Format('%s:%s',[sXSD,sSEQUENCE]); + sqcNode := CreateElement(s,cplxNode,AWsdlDocument); + objTypeData := GetTypeData(typItm.DataType); + clsTyp := TBaseComplexRemotableClass(objTypeData^.ClassType); + propCount := objTypeData^.PropCount; + if ( propCount > 0 ) then begin + propListLen := GetPropList(typItm.DataType,propList); + try + for i := 0 to Pred(propCount) do begin + p := propList^[i]; + persistType := IsStoredPropClass(objTypeData^.ClassType,p); + if ( persistType in [pstOptional,pstAlways] ) then begin + attProp := clsTyp.IsAttributeProperty(p^.Name); + if attProp then begin + s := Format('%s:%s',[sXSD,sATTRIBUTE]); + propNode := CreateElement(s,cplxNode,AWsdlDocument) + end else begin + s := Format('%s:%s',[sXSD,sELEMENT]); + propNode := CreateElement(s,sqcNode,AWsdlDocument); + end; + propNode.SetAttribute(sNAME,p^.Name); + propTypItm := GetTypeRegistry().Find(p^.PropType^.Name); + if Assigned(propTypItm) then begin + prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace,AWsdlDocument); + propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName])); + if attProp then begin + if ( persistType = pstOptional ) then + propNode.SetAttribute(sATTRIBUTE,'optional') + else + propNode.SetAttribute(sATTRIBUTE,'required'); + end else begin + if ( persistType = pstOptional ) then + propNode.SetAttribute(sMIN_OCCURS,'0') + else + propNode.SetAttribute(sMIN_OCCURS,'1'); + propNode.SetAttribute(sMAX_OCCURS,'1'); + end; + end; + end; + end; + finally + Freemem(propList,propListLen*SizeOf(Pointer)); + end; + end; + end; +end; + +{ TEnumTypeHandler } + +procedure TEnumTypeHandler.Generate( + const APascalTypeName: string; + AWsdlDocument: TDOMDocument +); +var + typItm : TTypeRegistryItem; + ns_shortName, s : string; + defTypesNode, defSchemaNode, resNode, restrictNode, eltNode : TDOMElement; + i, c : Integer; +begin + typItm := GetTypeRegistry().Find(APascalTypeName); + if Assigned(typItm) and + ( typItm.DataType^.Kind = tkEnumeration ) + then begin + if FindAttributeByValueInNode(typItm.NameSpace,AWsdlDocument.DocumentElement,ns_shortName) then begin + ns_shortName := Copy(ns_shortName,Length(sXMLNS+':')+1,MaxInt); + end else begin + ns_shortName := Format('ns%d',[AWsdlDocument.DocumentElement.Attributes.Count]) ; + AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,ns_shortName]),typItm.NameSpace); + end; + defTypesNode := AWsdlDocument.DocumentElement.FindNode(sWSDL_TYPES) as TDOMElement; + Assert(Assigned(defTypesNode)); + defSchemaNode := defTypesNode.FirstChild as TDOMElement; + + //s := Format('%s:%s',[sXSD,sELEMENT]); + //eltNode := CreateElement(s,defSchemaNode,AWsdlDocument); + //eltNode.SetAttribute(sNAME, typItm.DeclaredName) ; + s := Format('%s:%s',[sXSD,sSIMPLE_TYPE]); + resNode := CreateElement(s,defSchemaNode,AWsdlDocument); + resNode.SetAttribute(sNAME, typItm.DeclaredName) ; + s := Format('%s:%s',[sXSD,sRESTRICTION]); + restrictNode := CreateElement(s,resNode,AWsdlDocument); + restrictNode.SetAttribute(sBASE,Format('%s:%s',[sXSD,'string'])) ; + c := GetEnumNameCount(typItm.DataType); + for i := 0 to pred(c) do begin + s := Format('%s:%s',[sXSD,sENUMERATION]); + CreateElement(s,restrictNode,AWsdlDocument).SetAttribute(sVALUE,GetEnumName(typItm.DataType,i)); + end; + end; +end; + + +{ TFakeTypeHandler } + +procedure TFakeTypeHandler.Generate( + const APascalTypeName: string; + AWsdlDocument: TDOMDocument +); +begin +end; + +procedure RegisterFondamentalTypes(); +var + r : IWsdlTypeHandlerRegistry; +begin + r := GetWsdlTypeHandlerRegistry(); + r.RegisterDefaultHandler(tkInteger,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.RegisterDefaultHandler(tkInt64,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.RegisterDefaultHandler(tkQWord,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + + r.RegisterDefaultHandler(tkSString,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.RegisterDefaultHandler(tkLString,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.RegisterDefaultHandler(tkAString,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.RegisterDefaultHandler(tkWString,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + + r.RegisterDefaultHandler(tkWString,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + + r.RegisterDefaultHandler(tkBool,TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + + r.RegisterDefaultHandler(tkEnumeration,TSimpleItemFactory.Create(TEnumTypeHandler) as IItemFactory); + + r.RegisterDefaultHandler(tkClass,TSimpleItemFactory.Create(TBaseComplexRemotable_TypeHandler) as IItemFactory); + + r.Register('TBaseArrayRemotable',TSimpleItemFactory.Create(TBaseArrayRemotable_TypeHandler) as IItemFactory); + +{ r.Register('Integer',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('LongWord',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + + r.Register('string',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('shortstring',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('ansistring',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('boolean',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + + r.Register('Byte',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('ShortInt',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('Word',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('SmallInt',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('Int64',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('QWord',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + + r.Register('Single',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('Currency',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('Comp',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('Double',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); + r.Register('Extended',TSimpleItemFactory.Create(TFakeTypeHandler) as IItemFactory); +} +end; + + +{ TBaseArrayRemotable_TypeHandler } + +procedure TBaseArrayRemotable_TypeHandler.Generate( + const APascalTypeName: string; + AWsdlDocument: TDOMDocument +); + + function GetNameSpaceShortName(const ANameSpace : string):string;//inline; + begin + if FindAttributeByValueInNode(ANameSpace,AWsdlDocument.DocumentElement,Result,0,sXMLNS) then begin + Result := Copy(Result,Length(sXMLNS+':')+1,MaxInt); + end else begin + Result := Format('ns%d',[AWsdlDocument.DocumentElement.Attributes.Count]) ; + AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,Result]),ANameSpace); + end; + end; + +var + typItm, propTypItm : TTypeRegistryItem; + s, prop_ns_shortName : string; + defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, eltNode : TDOMElement; + arrayTypeData : PTypeData; + arrayTypeClass : TBaseArrayRemotableClass; +begin + typItm := GetTypeRegistry().Find(APascalTypeName); + if not Assigned(typItm) then + Exit; + arrayTypeData := GetTypeData(typItm.DataType); + if Assigned(typItm) and + ( typItm.DataType^.Kind = tkClass ) and + ( arrayTypeData^.ClassType.InheritsFrom(TBaseArrayRemotable) ) + then begin + GetNameSpaceShortName(typItm.NameSpace); + defTypesNode := AWsdlDocument.DocumentElement.FindNode(sWSDL_TYPES) as TDOMElement; + Assert(Assigned(defTypesNode)); + defSchemaNode := defTypesNode.FirstChild as TDOMElement; + + s := Format('%s:%s',[sXSD,sELEMENT]); + eltNode := CreateElement(s,defSchemaNode,AWsdlDocument); + eltNode.SetAttribute(sNAME, typItm.DeclaredName) ; + + s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]); + cplxNode := CreateElement(s,eltNode,AWsdlDocument); + //cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ; + s := Format('%s:%s',[sXSD,sSEQUENCE]); + sqcNode := CreateElement(s,cplxNode,AWsdlDocument); + arrayTypeClass := TBaseArrayRemotableClass(arrayTypeData^.ClassType); + propTypItm := GetTypeRegistry().Find(arrayTypeClass.GetItemTypeInfo()^.Name); + s := Format('%s:%s',[sXSD,sELEMENT]); + propNode := CreateElement(s,sqcNode,AWsdlDocument); + propNode.SetAttribute(sNAME,sITEM); + if Assigned(propTypItm) then begin + prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace); + propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,propTypItm.DeclaredName])); + propNode.SetAttribute(sMIN_OCCURS,'0'); + propNode.SetAttribute(sMAX_OCCURS,sUNBOUNDED); + end; + end; +end; + +initialization + WsdlTypeHandlerRegistryInst := TWsdlTypeHandlerRegistry.Create() as IWsdlTypeHandlerRegistry; + RegisterFondamentalTypes(); + +finalization + WsdlTypeHandlerRegistryInst := nil; + +end. diff --git a/wst/tags/3.1/same_process_protocol.pas b/wst/tags/3.1/same_process_protocol.pas new file mode 100644 index 000000000..4502eccf0 --- /dev/null +++ b/wst/tags/3.1/same_process_protocol.pas @@ -0,0 +1,94 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit same_process_protocol; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + service_intf, imp_utils, + server_service_intf, server_service_imputils, base_service_intf; + +Const + sTRANSPORT_NAME = 'SAME_PROCESS'; + +Type + +{$M+} + + { TInProcessTransport } + + TInProcessTransport = class(TSimpleFactoryItem,ITransport) + Private + FAdress: string; + FContentType: string; + FPropMngr : IPropertyManager; + Public + constructor Create();override; + destructor Destroy();override; + function GetPropertyManager():IPropertyManager; + procedure SendAndReceive(ARequest,AResponse:TStream); + Published + property ContentType : string Read FContentType Write FContentType; + property Adress : string Read FAdress Write FAdress; + End; +{$M+} + + procedure SAME_PROCESS_Register_Local_Transport(); + +implementation + +{ TInProcessTransport } + +constructor TInProcessTransport.Create(); +begin + FPropMngr := TPublishedPropertyManager.Create(Self); +end; + +destructor TInProcessTransport.Destroy(); +begin + FPropMngr := Nil; + inherited Destroy(); +end; + +function TInProcessTransport.GetPropertyManager(): IPropertyManager; +begin + Result := FPropMngr; +end; + +procedure TInProcessTransport.SendAndReceive(ARequest, AResponse: TStream); +Var + bffr : IRequestBuffer; +{$IFDEF WST_DBG} + s : string; + i : Int64; +{$ENDIF WST_DBG} +begin + bffr := TRequestBuffer.Create(Adress,ContentType,ARequest,AResponse); + HandleServiceRequest(bffr); + {$IFDEF WST_DBG} + i := AResponse.Position; + SetLength(s,AResponse.Size); + AResponse.Read(s[1],AResponse.Size); + WriteLn(s); + {$ENDIF WST_DBG} +end; + +procedure SAME_PROCESS_Register_Local_Transport(); +begin + GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(TInProcessTransport) as IItemFactory); +end; + +end. diff --git a/wst/tags/3.1/server_binary_formatter.pas b/wst/tags/3.1/server_binary_formatter.pas new file mode 100644 index 000000000..f6536502a --- /dev/null +++ b/wst/tags/3.1/server_binary_formatter.pas @@ -0,0 +1,137 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit server_binary_formatter; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, + base_service_intf, server_service_intf, + base_binary_formatter; + +const + sBINARY_CONTENT_TYPE = 'binary'; + + procedure Server_service_RegisterBinaryFormat(); + +implementation + +Type + + { TBinaryFormatter } + + TBinaryFormatter = class(TBaseBinaryFormatter,IFormatterBase,IFormatterResponse) + Private + FCallProcedureName : string; + FCallTarget : string; + Protected + procedure BeginCallResponse(Const AProcName,ATarget:string); + procedure EndCallResponse(); + procedure BeginCallRead(ACallContext : ICallContext); + function GetCallProcedureName():String; + function GetCallTarget():String; + procedure BeginExceptionList( + const AErrorCode : string; + const AErrorMsg : string + ); + procedure EndExceptionList(); + End; + + { TBinaryFormatterFactory } + + TBinaryFormatterFactory = class(TInterfacedObject,IItemFactory) + protected + function CreateInstance():IInterface; + End; + +{ TBinaryFormatterFactory } + +function TBinaryFormatterFactory.CreateInstance(): IInterface; +begin + Result := TBinaryFormatter.Create() as IFormatterResponse; +end; + + +{ TBinaryFormatter } + +procedure TBinaryFormatter.BeginCallResponse(const AProcName, ATarget: string); +begin + BeginObject('Body',Nil); + BeginObject(ATarget,Nil); + BeginObject(AProcName + 'Response',Nil); +end; + +procedure Print(const AMsg:string); +begin + WriteLn(AMsg); +End; + +procedure TBinaryFormatter.EndCallResponse(); +begin + EndScope(); + EndScope(); + EndScope(); + //PrintObj(GetRootData(),0,@Print); +end; + +procedure TBinaryFormatter.BeginCallRead(ACallContext : ICallContext); +Var + s : string; +begin + ClearStack(); + PushStack(GetRootData(),stObject); + s := 'Body'; + BeginScopeRead(s,nil); + FCallTarget := StackTop().GetByIndex(0)^.Name; + BeginScopeRead(FCallTarget,nil); + FCallProcedureName := StackTop().GetByIndex(0)^.Name; + BeginScopeRead(FCallProcedureName,nil); +end; + +function TBinaryFormatter.GetCallProcedureName(): String; +begin + Result := FCallProcedureName; +end; + +function TBinaryFormatter.GetCallTarget(): String; +begin + Result := FCallTarget; +end; + +procedure TBinaryFormatter.BeginExceptionList( + const AErrorCode: string; + const AErrorMsg: string +); +begin + BeginObject('Body',Nil); + BeginObject('Fault',Nil); + Put('faultcode',TypeInfo(string),AErrorCode); + Put('faultstring',TypeInfo(string),AErrorMsg); +end; + +procedure TBinaryFormatter.EndExceptionList(); +begin + EndScope(); + EndScope(); +end; + +procedure Server_service_RegisterBinaryFormat(); +begin + GetFormatterRegistry().Register(sBINARY_CONTENT_TYPE,TBinaryFormatterFactory.Create() as IItemFactory); +end; + +Initialization + +end. diff --git a/wst/tags/3.1/server_service_imputils.pas b/wst/tags/3.1/server_service_imputils.pas new file mode 100644 index 000000000..92e4326dd --- /dev/null +++ b/wst/tags/3.1/server_service_imputils.pas @@ -0,0 +1,105 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit server_service_imputils; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, + server_service_intf; + +Type + + { TRequestBuffer } + + TRequestBuffer = class(TInterfacedObject,IRequestBuffer) + private + FTargetService : string; + FContentType : string; + //FLength : Integer; + FContent : TStream; + FResponse : TStream; + protected + function GetTargetService():string; + function GetContentType():string; + //function GetLength():Integer; + function GetContent():TStream; + function GetResponse():TStream; + public + constructor Create( + ATargetService : string; + AContentType : string; + //ALength : Integer; + AContent : TStream; + AResponse : TStream + ); + End; + + + function IsStrEmpty(Const AStr:String):Boolean; + +implementation + +function IsStrEmpty(Const AStr:String):Boolean; +begin + Result := ( Length(Trim(AStr)) = 0 ); +end; + +{ TRequestBuffer } + +function TRequestBuffer.GetTargetService(): string; +begin + Result := FTargetService; +end; + +function TRequestBuffer.GetContentType(): string; +begin + Result := FContentType; +end; + +{function TRequestBuffer.GetLength(): Integer; +begin + Result := FLength; +end;} + +function TRequestBuffer.GetContent(): TStream; +begin + Result := FContent; +end; + +function TRequestBuffer.GetResponse(): TStream; +begin + Result := FResponse; +end; + +constructor TRequestBuffer.Create( + ATargetService : string; + AContentType : string; + //ALength : Integer; + AContent : TStream; + AResponse : TStream +); +begin + FTargetService := ATargetService; + FContentType := AContentType; + //FLength := ALength; + FContent := AContent; + FResponse := AResponse; +end; + + + + +end. diff --git a/wst/tags/3.1/server_service_intf.pas b/wst/tags/3.1/server_service_intf.pas new file mode 100644 index 000000000..9a8fe95bb --- /dev/null +++ b/wst/tags/3.1/server_service_intf.pas @@ -0,0 +1,635 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} + +unit server_service_intf; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, Contnrs, + base_service_intf; + +Type + + IRequestBuffer = interface; + IServerService = interface; + IServerServiceRegistry = interface; + IFormatterResponse = interface; + IServiceImplementationRegistry = interface; + IServiceImplementationFactory = interface; + ICallControl = interface; + + IServiceExtension = interface; + IServiceExtensionRegistry = interface; + + ICallControl = interface + ['{7B4B7192-EE96-4B52-92C7-AE855FBC31E7}'] + procedure SetCallContext(ACallContext : ICallContext); + function GetCallContext():ICallContext; + end; + + IRequestBuffer = interface + ['{6BF71D1F-DDC0-4432-83C6-6D50D26762C3}'] + function GetTargetService():string; + function GetContentType():string; + //function GetLength():Integer; + function GetContent():TStream; + function GetResponse():TStream; + End; + + IServerService = Interface + ['{EEBF8E24-8B20-462F-AA4A-48A5C8BAE680}'] + procedure HandleRequest(ARequestBuffer : IRequestBuffer); + End; + + TMessageStage = ( + msAfterDeserialize, msAfterSerialize, msBeforeDeserialize, msBeforeSerialize + ); + IServiceExtension = interface + ['{E192E6B3-7932-4D44-A8AC-135D7A0B8C93}'] + procedure ProcessMessage( + const AMessageStage : TMessageStage; + ACallContext : ICallContext; + AMsgData : IInterface + { The "AMsgData" parameter actual type depends on the message state + on correspond to : + - IRequestBuffer on "msBeforeDeserialize" and "msAfterSerialize" + - IFormatterResponse on "msAfterDeserialize", "msBeforeSerialize" + } + ); + end; + + IServiceExtensionRegistry = Interface + ['{68DC78F1-E6CF-4D6B-8473-75288794769C}'] + function Find(const AName : string):IServiceExtension; + procedure Register( + const AName : string; + AFactory : IItemFactory + ); + end; + + IServerServiceRegistry = Interface + ['{83E7BBEB-A33D-4A3E-896D-D351C2819009}'] + function Find(const AServiceName : string):IServerService; + procedure Register( + const AServiceName : string; + AFactory : IItemFactory + ); + End; + + IServiceImplementationFactory = interface(IItemFactoryEx) + ['{23A745BC-5F63-404D-BF53-55A6E64DE5BE}'] + procedure RegisterExtension( + const AExtensionList : array of string + ); + function GetExtension( + out AExtensionList : string + ) : Boolean; + end; + + IServiceImplementationRegistry = Interface + ['{0AE04033-475E-4FD5-88BD-9F816FD53A97}'] + function FindFactory(const AServiceName : string):IServiceImplementationFactory; + function Register( + const AServiceName : string; + AFactory : IServiceImplementationFactory + ) : IServiceImplementationFactory; + End; + + IFormatterResponse = Interface(IFormatterBase) + ['{CA7538D4-2C16-48C2-9F39-ACE45FEBB27E}'] + procedure BeginCallResponse(Const AProcName,ATarget:string); + procedure EndCallResponse(); + procedure BeginCallRead(ACallContext : ICallContext); + function GetCallProcedureName():String; + function GetCallTarget():String; + procedure BeginExceptionList( + const AErrorCode : string; + const AErrorMsg : string + ); + procedure EndExceptionList(); + End; + + TServiceVerbMethod = procedure(AFormatter:IFormatterResponse) of object; + + { TBaseServiceBinder } + + TBaseServiceBinder = Class(TInterfacedObject,IServerService) + Private + FVerbList : TObjectList; + FImplementationFactory : IServiceImplementationFactory; + FCallContext : ICallContext; + Protected + procedure RegisterVerbHandler( + const AVerb : string; + AVerbHandler : TServiceVerbMethod + ); + function FindVerbHandler(const AVerb : string):TServiceVerbMethod; + procedure HandleRequest(ARequestBuffer : IRequestBuffer); + function GetFactory():IItemFactory; + function CreateCallContext():ICallContext;virtual; + function GetCallContext():ICallContext; + procedure DoProcessMessage( + const AMessageStage : TMessageStage; + ACallContext : ICallContext; + AMsgData : IInterface + ); + Public + constructor Create(AImplementationFactory : IServiceImplementationFactory); + destructor Destroy();override; + procedure Error(Const AMsg : string);overload; + procedure Error(Const AMsg : string;Const AArgs : Array of Const);overload; + End; + + { TBaseServiceImplementation } + + TBaseServiceImplementation = class(TSimpleFactoryItem,ICallControl) + private + FCallContext : ICallContext; + protected + procedure SetCallContext(ACallContext : ICallContext); + function GetCallContext():ICallContext; + End; + + + { TImplementationFactory } + + TImplementationFactory = class( + TSimpleItemFactoryEx, + IInterface, + IItemFactory, + IItemFactoryEx, + IServiceImplementationFactory + ) + protected + procedure RegisterExtension( + const AExtensionList : array of string + ); + function GetExtension( + out AExtensionList : string + ) : Boolean; + end; + + + procedure HandleServiceRequest( + ARequestBuffer : IRequestBuffer; + AServiceRegistry : IServerServiceRegistry = Nil + ); + function GetFormatterRegistry():IFormatterRegistry; + function GetServerServiceRegistry():IServerServiceRegistry; + function GetServiceImplementationRegistry():IServiceImplementationRegistry ; + function GetServiceExtensionRegistry():IServiceExtensionRegistry; + +implementation +Var + FormatterRegistryInst : IFormatterRegistry = Nil; + ServerServiceRegistryInst : IServerServiceRegistry = Nil; + ServiceImplementationRegistryInst : IServiceImplementationRegistry = Nil; + ServiceExtensionRegistryInst : IServiceExtensionRegistry = nil; + +procedure HandleServiceRequest( + ARequestBuffer : IRequestBuffer; + AServiceRegistry : IServerServiceRegistry +); +Var + sr : IServerServiceRegistry; + s : IServerService; + svcName : string; +Begin + Assert(Assigned(ARequestBuffer)); + If Assigned(AServiceRegistry) Then + sr := AServiceRegistry + Else + sr := GetServerServiceRegistry(); + svcName := ARequestBuffer.GetTargetService(); + s := sr.Find(svcName); + If Not Assigned(s) Then + Raise EServiceException.CreateFmt('Service not found : "%s"',[svcName]); + s.HandleRequest(ARequestBuffer); +End; + +Type + + TFormatterRegistry = class(TBaseFactoryRegistry,IFormatterRegistry) + protected + function Find(const AFormatterName : string):IFormatterBase; + End; + + { TServerServiceRegistry } + + TServerServiceRegistry = class(TBaseFactoryRegistry,IServerServiceRegistry) + protected + function Find(const AServiceName : string):IServerService; + End; + +{ TServerServiceRegistry } + +function TServerServiceRegistry.Find(const AServiceName: string): IServerService; +Var + fct : IItemFactory; +begin + fct := FindFactory(AServiceName); + If Assigned(fct) Then + Result := fct.CreateInstance() as IServerService + Else + Result := Nil; +end; + +function TFormatterRegistry.Find(const AFormatterName: string): IFormatterBase; +Var + fct : IItemFactory; +begin + fct := FindFactory(AFormatterName); + If Assigned(fct) Then + Result := fct.CreateInstance() as IFormatterBase + Else + Result := Nil; +end; + +Type + + { TServiceVerbItem } + + TServiceVerbItem = class + private + FVerb: string; + FVerbHandler: TServiceVerbMethod; + public + constructor Create( + const AVerb : string; + AVerbHandler : TServiceVerbMethod + ); + property Verb : string Read FVerb; + property VerbHandler : TServiceVerbMethod Read FVerbHandler; + End; + +{ TServiceVerbItem } + +constructor TServiceVerbItem.Create( + const AVerb: string; + AVerbHandler: TServiceVerbMethod +); +begin + FVerb := AVerb; + FVerbHandler := AVerbHandler; +end; + +{ TBaseServiceBinder } + +procedure TBaseServiceBinder.RegisterVerbHandler( + const AVerb : string; + AVerbHandler : TServiceVerbMethod +); +Var + s : string; +begin + Assert(Assigned(AVerbHandler)); + s := LowerCase(Trim(AVerb)); + If Not Assigned(FindVerbHandler(s)) Then + FVerbList.Add(TServiceVerbItem.Create(s,AVerbHandler)); +end; + +function TBaseServiceBinder.FindVerbHandler(const AVerb: string):TServiceVerbMethod; +Var + i : Integer; + s : string; +begin + s := LowerCase(Trim(AVerb)); + For i := 0 To Pred(FVerbList.Count) Do Begin + If AnsiSameText(TServiceVerbItem(FVerbList[i]).Verb,s) Then Begin + Result := TServiceVerbItem(FVerbList[i]).VerbHandler; + Exit; + End; + End; + Result := Nil; +end; + +procedure TBaseServiceBinder.HandleRequest(ARequestBuffer: IRequestBuffer); +Var + f : IFormatterResponse; + s : string; + m : TServiceVerbMethod; + strm : TStream; + cllCtx : ICallContext; + i : Integer; + hdr : THeaderBlock; + typRegItm : TTypeRegistryItem; +begin + s := ARequestBuffer.GetContentType(); + f := GetFormatterRegistry().Find(s) as IFormatterResponse; + if not Assigned(f) then + Error('No formatter for that content type : "%s"',[s]); + try + cllCtx := GetCallContext(); + DoProcessMessage(msBeforeDeserialize,cllCtx,ARequestBuffer); + strm := ARequestBuffer.GetContent(); + f.LoadFromStream(strm); + f.BeginCallRead(GetCallContext()); + DoProcessMessage(msAfterDeserialize,cllCtx,f); + s := f.GetCallProcedureName(); + m := FindVerbHandler(s); + if not Assigned(m) then + Error('No handler for that verb : "%s"',[s]); + m(f); + for i := 0 to Pred(cllCtx.GetHeaderCount(AllHeaderDirection)) do begin + hdr := cllCtx.GetHeader(i); + if ( hdr.Direction = hdIn ) and ( hdr.mustUnderstand <> 0 ) and ( not hdr.Understood ) then begin + typRegItm := GetTypeRegistry().Find(hdr.ClassName); + if Assigned(typRegItm) then + s := typRegItm.DeclaredName + else + s := hdr.ClassName; + Error('Header "%s" not Understood.',[s]); + end; + end; + except + on e : Exception do begin + f.Clear(); + f.SetSerializationStyle(ssNodeSerialization); + f.BeginExceptionList('Server',E.Message); + f.EndExceptionList(); + end; + end; + strm := ARequestBuffer.GetResponse(); + DoProcessMessage(msBeforeSerialize,cllCtx,f); + f.SaveToStream(strm); + DoProcessMessage(msAfterSerialize,cllCtx,ARequestBuffer); +end; + +function TBaseServiceBinder.GetFactory(): IItemFactory; +begin + Result := FImplementationFactory; +end; + +function TBaseServiceBinder.CreateCallContext(): ICallContext; +begin + if not Assigned(FCallContext) then + FCallContext := TSimpleCallContext.Create() as ICallContext; + Result := FCallContext; +end; + +function TBaseServiceBinder.GetCallContext(): ICallContext; +begin + if not Assigned(FCallContext) then + CreateCallContext(); + Result := FCallContext; +end; + +procedure TBaseServiceBinder.DoProcessMessage( + const AMessageStage : TMessageStage; + ACallContext : ICallContext; + AMsgData : IInterface +); +var + s : string; + ls : TStringList; + i : Integer; + exreg : IServiceExtensionRegistry; + se : IServiceExtension; +begin + exreg := GetServiceExtensionRegistry(); + if FImplementationFactory.GetExtension(s) then begin + ls := TStringList.Create(); + try + ls.QuoteChar := #0; + ls.Delimiter := PROP_LIST_DELIMITER; + ls.DelimitedText := s; + for i := 0 to Pred(ls.Count) do begin + s := ls[i]; + se := exreg.Find(s); + if Assigned(se) then + se.ProcessMessage(AMessageStage,ACallContext,AMsgData); + end; + finally + ls.Free(); + end; + end; +end; + +constructor TBaseServiceBinder.Create(AImplementationFactory : IServiceImplementationFactory); +begin + Assert(Assigned(AImplementationFactory)); + FImplementationFactory := AImplementationFactory; + FVerbList := TObjectList.Create(True); +end; + +destructor TBaseServiceBinder.Destroy(); +begin + FVerbList.Free(); + inherited Destroy(); +end; + +procedure TBaseServiceBinder.Error(const AMsg: string); +begin + Raise EServiceException.Create(AMsg); +end; + +procedure TBaseServiceBinder.Error(const AMsg: string;const AArgs: array of const); +begin + Raise EServiceException.CreateFmt(AMsg,AArgs); +end; + +function GetFormatterRegistry():IFormatterRegistry; +begin + Result := FormatterRegistryInst; +end; + +function GetServerServiceRegistry():IServerServiceRegistry; +begin + Result := ServerServiceRegistryInst; +end; + +Type + + { TServiceImplementationRegistry } + + TServiceImplementationRegistry = class(TInterfacedObject,IInterface,IServiceImplementationRegistry) + private + FList : TObjectList; + protected + function FindFactory(const AServiceName : string): IServiceImplementationFactory; + function Register( + const AServiceName : string; + AFactory : IServiceImplementationFactory + ) : IServiceImplementationFactory; + public + constructor Create(); + destructor Destroy();override; + End; + + { TServiceImplementationRegistryItem } + + TServiceImplementationRegistryItem = class + private + FFactory: IServiceImplementationFactory; + FItemTypeInfo: string; + public + constructor Create( + const AItemTypeInfo : string; + AFactory : IServiceImplementationFactory + ); + property ItemTypeInfo : string Read FItemTypeInfo; + property Factory : IServiceImplementationFactory Read FFactory; + End; + +function TServiceImplementationRegistry.FindFactory( + const AServiceName : string +): IServiceImplementationFactory; +Var + i : Integer; +begin + For i := 0 To Pred(FList.Count) Do Begin + If ( AServiceName = TServiceImplementationRegistryItem(FList[i]).ItemTypeInfo ) Then Begin + Result := TServiceImplementationRegistryItem(FList[i]).Factory; + Exit; + End; + End; + Result := Nil; +end; + +function TServiceImplementationRegistry.Register( + const AServiceName : string; + AFactory : IServiceImplementationFactory +) : IServiceImplementationFactory; +begin + Assert(Assigned(AFactory)); + if not Assigned(FindFactory(AServiceName)) then + FList.Add(TServiceImplementationRegistryItem.Create(AServiceName,AFactory)); + Result := AFactory; +end; + +constructor TServiceImplementationRegistry.Create(); +begin + FList := TObjectList.Create(True); + inherited Create(); +end; + +destructor TServiceImplementationRegistry.Destroy(); +begin + FreeAndNil(FList); + inherited Destroy(); +end; + +{ TServiceImplementationRegistryItem } + +constructor TServiceImplementationRegistryItem.Create( + const AItemTypeInfo: string; + AFactory: IServiceImplementationFactory +); +begin + Assert(Assigned(AFactory)); + FItemTypeInfo := AItemTypeInfo; + FFactory := AFactory; +end; + +function GetServiceImplementationRegistry():IServiceImplementationRegistry ; +begin + Result := ServiceImplementationRegistryInst; +end; + +{ TBaseServiceImplementation } + +procedure TBaseServiceImplementation.SetCallContext(ACallContext: ICallContext); +begin + FCallContext := ACallContext; +end; + +function TBaseServiceImplementation.GetCallContext(): ICallContext; +begin + Result := FCallContext; +end; + + +{ TImplementationFactory } +const sSERVICES_EXTENSIONS = 'extensions';sLIST = 'list'; +procedure TImplementationFactory.RegisterExtension( + const AExtensionList : array of string +); +var + pmngr : IPropertyManager; + i : Integer; + strBuffer, s : string; +begin + if ( Length(AExtensionList) > 0 ) then begin + pmngr := GetPropertyManager(sSERVICES_EXTENSIONS,True); + strBuffer := ''; + for i := Low(AExtensionList) to High(AExtensionList) do begin + s := Trim(AExtensionList[i]); + if ( Length(s) > 0 ) then + strBuffer := strBuffer + ';' + s; + end; + if ( Length(strBuffer) > 0 ) then begin + s:= Trim(pmngr.GetProperty(sLIST)); + if ( Length(s) = 0 ) then + Delete(strBuffer,1,1); + s := s + strBuffer; + pmngr.SetProperty(sLIST,s); + end; + end; +end; + +function TImplementationFactory.GetExtension( + out AExtensionList : string +): Boolean; +var + pmngr : IPropertyManager; +begin + pmngr := GetPropertyManager(sSERVICES_EXTENSIONS,False); + if Assigned(pmngr) then + AExtensionList := Trim(pmngr.GetProperty(sLIST)) + else + AExtensionList := ''; + Result := ( Length(AExtensionList) > 0 ); +end; + +type + + { TServiceExtensionRegistry } + + TServiceExtensionRegistry = class(TBaseFactoryRegistry,IServiceExtensionRegistry) + protected + function Find(const AName : string):IServiceExtension; + End; + +{ TServiceExtensionRegistry } + +function TServiceExtensionRegistry.Find(const AName: string): IServiceExtension; +Var + fct : IItemFactory; +begin + fct := FindFactory(AName); + If Assigned(fct) Then + Result := fct.CreateInstance() as IServiceExtension + Else + Result := Nil; +end; + +function GetServiceExtensionRegistry():IServiceExtensionRegistry ; +begin + Result := ServiceExtensionRegistryInst; +end; + +Initialization + FormatterRegistryInst := TFormatterRegistry.Create() as IFormatterRegistry; + ServerServiceRegistryInst := TServerServiceRegistry.Create() as IServerServiceRegistry; + ServiceImplementationRegistryInst := TServiceImplementationRegistry.Create() As IServiceImplementationRegistry; + ServiceExtensionRegistryInst := TServiceExtensionRegistry.Create() as IServiceExtensionRegistry; + +Finalization + ServiceExtensionRegistryInst := nil; + ServiceImplementationRegistryInst := Nil; + ServerServiceRegistryInst := Nil; + FormatterRegistryInst := Nil; +end. diff --git a/wst/tags/3.1/server_service_soap.pas b/wst/tags/3.1/server_service_soap.pas new file mode 100644 index 000000000..4491194fd --- /dev/null +++ b/wst/tags/3.1/server_service_soap.pas @@ -0,0 +1,209 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit server_service_soap; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, DOM, + base_service_intf, server_service_intf, server_service_imputils, + base_soap_formatter; + +Type + + { TSOAPFormatter } + +{$M+} + TSOAPFormatter = class(TSOAPBaseFormatter,IFormatterBase,IFormatterResponse) + private + FCallProcedureName : string; + FCallTarget : String; + FCallContext : ICallContext; + public + + procedure BeginCallResponse(Const AProcName,ATarget:string); + procedure EndCallResponse(); + + procedure BeginCallRead(ACallContext : ICallContext); + function GetCallProcedureName():String; + function GetCallTarget():String; + + procedure BeginExceptionList( + const AErrorCode : string; + const AErrorMsg : string + ); + procedure EndExceptionList(); + End; + + procedure Server_service_RegisterSoapFormat(); + +implementation + +Const NAMESPACE_SEPARATOR = ':'; +function ExtractNamespacePart( Const AQualifiedName : string):String; +Var + i : Integer; +begin + Result := ''; + i := Pos(NAMESPACE_SEPARATOR,AQualifiedName); + If ( i <= 0 ) Then + Exit; + Result := Copy(AQualifiedName,1,Pred(i)); +end; + +function ExtractNamePart(Const AQualifiedName : string):String; +Var + i : Integer; +begin + i := Pos(NAMESPACE_SEPARATOR,AQualifiedName); + If ( i <= 0 ) Then + i := 0; + Result := Copy(AQualifiedName,Succ(i),MaxInt); +end; + +{ TSOAPFormatter } + +procedure TSOAPFormatter.BeginCallResponse(Const AProcName,ATarget:string); +begin +{ Clear(); + BeginScope('Envelope',sSOAP_ENV,'SOAP-ENV'); + AddScopeAttribute('xmlns:xsi',sXSI_NS); + AddScopeAttribute('xmlns:'+sXSD, sXSD_NS); + AddScopeAttribute('xmlns:'+sSOAP_ENC_ABR, sSOAP_ENC); + BeginScope('Body',sSOAP_ENV); + BeginScope(AProcName + 'Response',ATarget); +} + Clear(); + Prepare(); + WriteHeaders(FCallContext); + BeginScope('Body',sSOAP_ENV); + BeginScope(AProcName + 'Response',ATarget); +end; + +procedure TSOAPFormatter.EndCallResponse(); +begin + EndScope(); //BeginScope(AProcName,ATarget); + EndScope(); //BeginScope('Body','http://schemas.xmlsoap.org/soap/envelope/'); + EndScope(); //BeginScope('Envelope','http://schemas.xmlsoap.org/soap/envelope/','SOAP-ENV'); +end; + +procedure TSOAPFormatter.BeginCallRead(ACallContext : ICallContext); +Var + envNd : TDOMElement; + hdrNd, bdyNd, mthdNd, tmpNode : TDOMNode; + s,nsShortName,eltName : string; + doc : TXMLDocument; +begin + FCallContext := ACallContext; + ClearStack(); + doc := GetXmlDoc(); + If FindAttributeByValueInNode(sSOAP_ENV,doc.DocumentElement,nsShortName) Then Begin + nsShortName := Copy(nsShortName,1 + Pos(':',nsShortName),MaxInt); + If Not IsStrEmpty(nsShortName) Then + nsShortName := nsShortName + ':'; + End Else + nsShortName := ''; + eltName := nsShortName + 'Envelope'; + envNd := doc.DocumentElement; + If Not SameText(eltName,envNd.NodeName) Then + Error('XML root node must be "Envelope".'); + PushStack(envNd).SetNameSpace(sSOAP_ENV); + + bdyNd := envNd.FirstChild; + If Not Assigned(bdyNd) Then + Error('Node not found : "Body".'); + + eltName := nsShortName + 'Body'; + if not SameText(bdyNd.NodeName,eltName) then begin + eltName := nsShortName + 'Header'; + hdrNd := bdyNd; + bdyNd := hdrNd.NextSibling; + if SameText(hdrNd.NodeName,eltName) then begin + PushStack(hdrNd,stArray).SetNameSpace(sSOAP_ENV); + ReadHeaders(FCallContext); + PopStack().Free(); + end; + end; + + eltName := nsShortName + 'Body'; + If Not Assigned(bdyNd) Then + Error('Node not found : "Body".'); + PushStack(bdyNd).SetNameSpace(sSOAP_ENV); + If Not Assigned(bdyNd.FirstChild) Then + Error('Method Node not found.'); + mthdNd := bdyNd.FirstChild; + PushStack(mthdNd); + s := mthdNd.NodeName; + nsShortName := ExtractNamespacePart(s); + If IsStrEmpty(nsShortName) Then + Error('Method Node must have a qualified name.'); + FCallProcedureName := ExtractNamePart(s); + If IsStrEmpty(FCallProcedureName) Then + Error('No Method name.'); + tmpNode := mthdNd.Attributes.GetNamedItem(sXML_NS + ':' + nsShortName); + If Not Assigned(tmpNode) Then + Error('Call target attribute not found.'); + FCallTarget := tmpNode.NodeValue; +end; + +function TSOAPFormatter.GetCallProcedureName(): String; +begin + Result := FCallProcedureName; +end; + +function TSOAPFormatter.GetCallTarget(): String; +begin + Result := FCallTarget; +end; + +procedure TSOAPFormatter.BeginExceptionList( + const AErrorCode: string; + const AErrorMsg: string +); +Var + c,m :string; +begin + If IsStrEmpty(AErrorCode) Then + c := 'SOAP-ENV:Server' + Else + c := AErrorCode; + If IsStrEmpty(AErrorMsg) Then + m := 'Server Error' + Else + m := AErrorMsg; + Clear(); + BeginScope('Envelope',sSOAP_ENV,'SOAP-ENV'); + AddScopeAttribute('xmlns:xsi',sXSI_NS); + AddScopeAttribute('xmlns:'+sXSD, sXSD_NS); + BeginScope('Body',sSOAP_ENV); + BeginScope('Fault',sSOAP_ENV); + Put('faultcode',TypeInfo(string),c); + Put('faultstring',TypeInfo(string),m); +end; + +procedure TSOAPFormatter.EndExceptionList(); +begin + EndScope(); //BeginScope('Fault',sSOAP_ENV); + EndScope(); //BeginScope('Body','http://schemas.xmlsoap.org/soap/envelope/'); + EndScope(); //BeginScope('Envelope','http://schemas.xmlsoap.org/soap/envelope/','SOAP-ENV'); +end; + +procedure Server_service_RegisterSoapFormat(); +begin + GetFormatterRegistry().Register(sSOAP_CONTENT_TYPE,TSimpleItemFactory.Create(TSOAPFormatter) as IItemFactory); + RegisterStdTypes(); +end; + +end. diff --git a/wst/tags/3.1/service_intf.pas b/wst/tags/3.1/service_intf.pas new file mode 100644 index 000000000..09f756c44 --- /dev/null +++ b/wst/tags/3.1/service_intf.pas @@ -0,0 +1,571 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} + +{ Base service interface } + +unit service_intf; +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, Contnrs, + base_service_intf; + +Const + sTARGET = 'target'; + +Type + + ITransport = Interface + ['{AEB6677A-9620-4E7D-82A0-43E3C4C52B43}'] + function GetPropertyManager():IPropertyManager; + procedure SendAndReceive(ARequest,AResponse:TStream); + End; + + //The client formater interface, used to marshall parameters. + IFormatterClient = Interface(IFormatterBase) + ['{73746BC7-CA43-4C00-8789-71E23033C3B2}'] + function GetPropertyManager():IPropertyManager; + + procedure BeginCall( + const AProcName, + ATarget : string; + ACallContext : ICallContext + ); + procedure EndCall(); + procedure BeginCallRead(ACallContext : ICallContext); + function GetCallProcedureName():String; + function GetCallTarget():String; + End; + + (* This interface is used with IFormatterClient to handle messages *) + ICallMaker = Interface + ['{4CF7B98B-8C37-479F-AFF3-822FCCEECEC8}'] + function GetPropertyManager():IPropertyManager; + procedure MakeCall( + ASerializer : IFormatterClient; + ATransport : ITransport + ); + End; + + + (* A service protocol is defined by : + - a marshaller + - a call handler for that marshaller + - and a tranport. *) + IServiceProtocol = Interface + ['{777FE102-0F6C-495C-9A92-528D07F1C60C}'] + function GetSerializer() : IFormatterClient; // the marshaller >> SOAP, XML-RPC, Binary,... + function GetCallHandler() : ICallMaker; // Call handler >> SOAP call handler, XML-RPC call handler, ... + function GetTransport() : ITransport; // the transport >> HTTP, TCP, named pipes, ... + procedure SetTransport(AValue : ITransport); + End; + + + { TBaseProxy } + (* The base class for service proxy *) + TBaseProxy = Class(TInterfacedObject,IInterface,ICallContext) + private + FTarget : String; + FProtocol : IServiceProtocol; + FOperationsProperties : TStrings; + private + procedure LoadProperties(); + protected + function GetTarget():String; + function GetSerializer() : IFormatterClient; + function GetCallHandler() : ICallMaker; + function GetTransport() : ITransport; + procedure MakeCall(); + class function GetServiceType() : PTypeInfo;virtual;abstract; + + // ---- BEGIN >> ICallContext implementation ---- + private + FCallContext : ICallContext; + protected + procedure AddObjectToFree(const AObject : TObject); + procedure Clear(); + function AddHeader( + const AHeader : THeaderBlock; + const AKeepOwnership : Boolean + ):Integer; + function GetHeaderCount(const ADirections : THeaderDirections):Integer; + function GetHeader(const AIndex : Integer) : THeaderBlock; + // ---- END >> ICallContext implementation ---- + procedure ClearHeaders(const ADirection : THeaderDirection); + public + (* This is the primary constructor! + Objects passed by the parameter "AProtocol" will be freed by + this instance( the new one create by this constructor call ). *) + constructor Create( + Const ATarget : String; // the target service + Const AProtocol : IServiceProtocol + );virtual; + (* A User friendly constructor *) + constructor Create( + Const ATarget : String; + Const AProtocolData : string; + Const ATransportData : string + );virtual; + destructor Destroy();override; + End; + + + IFormaterQueryRegistry = Interface + ['{037907E1-5E44-4A91-B290-CA70ACACF5E6}'] + function Find( + Const AProtocolData : string; + Out ARes : IServiceProtocol + ):Boolean; + procedure Register( + Const AProtocolName : string; + AFormaterFactory : IItemFactory; + ACallHandlerFactory : IItemFactory + ); + End; + + ITransportRegistry = Interface + ['{ED34F7A2-2335-4FD3-A457-2B8C4349664E}'] + function Find( + Const ATransportData : string; + Out ARes : ITransport + ):Boolean; + procedure Register( + const ATransportName : string; + const AFactory : IItemFactory + ); + End; + + function GetFormaterRegistry():IFormaterQueryRegistry; + function GetTransportRegistry():ITransportRegistry; + +implementation +uses imp_utils, metadata_repository; + +{ TBaseProxy } + +procedure TBaseProxy.LoadProperties(); +var + pd : PPropertyData; + i : Integer; + sd : PService; + opd : PServiceOperation; + mm : IModuleMetadataMngr; + strBuffer : string; +begin + if not Assigned(FOperationsProperties) then begin + FOperationsProperties := TStringList.Create(); + mm := GetModuleMetadataMngr(); + sd := mm.GetServiceMetadata(GetTypeData(GetServiceType())^.IntfUnit,GetServiceType()^.Name); + try + Assert(Assigned(sd)); + for i := 0 to Pred(sd^.OperationsCount) do begin + opd := @(sd^.Operations[i]); + strBuffer := ''; + pd := opd^.Properties; + while Assigned(pd) do begin + strBuffer := Format('%s%s=%s;',[strBuffer,pd^.Name,pd^.Data]); + pd := pd^.Next; + end; + if not IsStrEmpty(strBuffer) then begin + Delete(strBuffer,Length(strBuffer),1); + FOperationsProperties.Values[opd^.Name] := strBuffer; + end; + end; + finally + mm.ClearServiceMetadata(sd); + end; + end; +end; + +function TBaseProxy.GetTarget(): String; +begin + Result := FTarget; +end; + +function TBaseProxy.GetSerializer(): IFormatterClient; +begin + Result := FProtocol.GetSerializer(); +end; + +function TBaseProxy.GetCallHandler(): ICallMaker; +begin + Result := FProtocol.GetCallHandler(); +end; + +function TBaseProxy.GetTransport(): ITransport; +begin + Result := FProtocol.GetTransport(); +end; + +procedure TBaseProxy.MakeCall(); + + procedure PrepareTransport(); + var + strBuffer : string; + begin + LoadProperties(); + strBuffer := FOperationsProperties.Values[GetSerializer().GetCallProcedureName()]; + if not IsStrEmpty(strBuffer) then + GetTransport().GetPropertyManager().SetProperties(strBuffer); + end; + +begin + PrepareTransport(); + GetCallHandler().MakeCall(GetSerializer(),GetTransport()); +end; + +procedure TBaseProxy.AddObjectToFree(const AObject: TObject); +begin + FCallContext.AddObjectToFree(AObject); +end; + +procedure TBaseProxy.Clear(); +begin + FCallContext.Clear(); +end; + +function TBaseProxy.AddHeader( + const AHeader: THeaderBlock; + const AKeepOwnership: Boolean +): Integer; +begin + Result := FCallContext.AddHeader(AHeader,AKeepOwnership); +end; + +function TBaseProxy.GetHeaderCount(const ADirections : THeaderDirections):Integer; +begin + Result := FCallContext.GetHeaderCount(ADirections); +end; + +function TBaseProxy.GetHeader(const AIndex: Integer): THeaderBlock; +begin + Result := FCallContext.GetHeader(AIndex); +end; + +procedure TBaseProxy.ClearHeaders(const ADirection: THeaderDirection); +begin + FCallContext.ClearHeaders(ADirection); +end; + +constructor TBaseProxy.Create( + const ATarget : String; + const AProtocol : IServiceProtocol +); +begin + Assert(Assigned(AProtocol)); + Assert(Assigned(AProtocol.GetCallHandler())); + Assert(Assigned(AProtocol.GetSerializer())); + Assert(Assigned(AProtocol.GetTransport())); + FCallContext := TSimpleCallContext.Create() as ICallContext; + FTarget := ATarget; + FProtocol := AProtocol; + FProtocol.GetSerializer().GetPropertyManager().SetProperty(sTARGET,FTarget); + FProtocol.GetCallHandler().GetPropertyManager().SetProperty(sTARGET,FTarget); +end; + +constructor TBaseProxy.Create( + const ATarget: String; + const AProtocolData: string; + const ATransportData: string +); +Var + ptcl : IServiceProtocol; + tmpTrprt : ITransport; +begin + ptcl := Nil; + If GetFormaterRegistry().Find(AProtocolData,ptcl) And + GetTransportRegistry().Find(ATransportData,tmpTrprt) + Then Begin + ptcl.SetTransport(tmpTrprt); + Create(ATarget,ptcl); + End; +end; + +destructor TBaseProxy.Destroy(); +begin + FProtocol := Nil; + FreeAndNil(FOperationsProperties); + inherited Destroy(); +end; + +Const PROTOCOL_SEPARATOR = ':'; +function ExtractProtocol( Const AProtocolName : string):String; +Var + i : Integer; +begin + i := Pos(PROTOCOL_SEPARATOR,AProtocolName); + If ( i <= 0 ) Then + i := MaxInt; + Result := lowercase(Copy(AProtocolName,1,Pred(i))); +end; + +function ExtractProtocolData(Const AProtocolPropsStr : string):String; +Var + i : Integer; +begin + i := Pos(PROTOCOL_SEPARATOR,AProtocolPropsStr); + If ( i <= 0 ) Then + i := 0; + Result := Copy(AProtocolPropsStr,Succ(i),MaxInt); +end; + +Type + + { TFormatterFactoryRegistryItem } + + { TServiceProtocol } + + TServiceProtocol = class(TInterfacedObject,IInterface,IServiceProtocol) + Private + FFormatter : IFormatterClient; + FCallHandler : ICallMaker; + FTransport : ITransport; + Protected + function GetSerializer() : IFormatterClient; + function GetCallHandler() : ICallMaker; + function GetTransport() : ITransport; + procedure SetTransport(AValue : ITransport); + Public + constructor Create( + AFormatter : IFormatterClient; + ACallHandler : ICallMaker + ); + End; + + TFormatterFactoryRegistryItem = class + private + FCallHandlerFactory: IItemFactory; + FFormaterFactory: IItemFactory; + FProtocolName: string; + public + constructor Create( + Const AProtocolName : string; + AFormaterFactory : IItemFactory; + ACallHandlerFactory : IItemFactory + ); + destructor Destroy();override; + property ProtocolName : string Read FProtocolName; + property FormaterFactory : IItemFactory Read FFormaterFactory; + property CallHandlerFactory : IItemFactory Read FCallHandlerFactory; + End; + + { TFormatterRegistry } + //Make it Threadsafe ??? + TFormatterRegistry = class(TInterfacedObject,IInterface,IFormaterQueryRegistry) + private + FList : TObjectList; + function IndexOf(Const AName : string ):Integer; + procedure Clear(); + function GetCount():Integer; + function GetItem(const AIndex:Integer): TFormatterFactoryRegistryItem; + protected + function Find( + Const AProtocolData : string; + Out ARes : IServiceProtocol + ):Boolean; + procedure Register( + Const AProtocolName : string; + AFormaterFactory : IItemFactory; + ACallHandlerFactory : IItemFactory + ); + public + constructor Create(); + destructor Destroy();override; + End; + +{ TServiceProtocol } + +function TServiceProtocol.GetSerializer(): IFormatterClient; +begin + Result := FFormatter; +end; + +function TServiceProtocol.GetCallHandler(): ICallMaker; +begin + Result := FCallHandler; +end; + +function TServiceProtocol.GetTransport(): ITransport; +begin + Result := FTransport; +end; + +procedure TServiceProtocol.SetTransport(AValue: ITransport); +begin + FTransport := AValue; +end; + +constructor TServiceProtocol.Create(AFormatter: IFormatterClient;ACallHandler: ICallMaker); +begin + FFormatter := AFormatter; + FCallHandler := ACallHandler; +end; + +{ TFormatterFactoryRegistryItem } + +constructor TFormatterFactoryRegistryItem.Create( + const AProtocolName: string; + AFormaterFactory: IItemFactory; ACallHandlerFactory: IItemFactory); +begin + FProtocolName := AProtocolName; + FFormaterFactory := AFormaterFactory; + FCallHandlerFactory := ACallHandlerFactory; +end; + +destructor TFormatterFactoryRegistryItem.Destroy(); +begin + FFormaterFactory := nil; + FCallHandlerFactory := nil; + inherited Destroy(); +end; + +Var + FormaterRegistryInst : IFormaterQueryRegistry = Nil; +function GetFormaterRegistry():IFormaterQueryRegistry; +begin + If Not Assigned(FormaterRegistryInst) Then + FormaterRegistryInst := TFormatterRegistry.Create() as IFormaterQueryRegistry;// Lock!!! + Result := FormaterRegistryInst; +end; + +{ TFormatterRegistry } + +function TFormatterRegistry.IndexOf(const AName: string): Integer; +Var + s : string; +begin + s := lowercase(AName); + + For Result := 0 To Pred(GetCount()) Do + If SameText(s,GetItem(Result).ProtocolName) Then + Exit; + Result := -1; +end; + +procedure TFormatterRegistry.Clear(); +begin + FList.Clear(); +end; + +function TFormatterRegistry.GetCount(): Integer; +begin + Result := FList.Count; +end; + +function TFormatterRegistry.GetItem(const AIndex: Integer): TFormatterFactoryRegistryItem; +begin + Result := FList[AIndex] as TFormatterFactoryRegistryItem; +end; + +function TFormatterRegistry.Find( + Const AProtocolData : string; + Out ARes : IServiceProtocol +): Boolean; +Var + i : Integer; + r : TFormatterFactoryRegistryItem; + initData : String; +begin + ARes := Nil; + i := IndexOf(ExtractProtocol(AProtocolData)); + Result := ( i > -1 ); + If Result Then Begin + initData := ExtractProtocolData(AProtocolData); + r := GetItem(i); + ARes := TServiceProtocol.Create( + r.FormaterFactory.CreateInstance() as IFormatterClient, + r.CallHandlerFactory.CreateInstance() as ICallMaker + ) as IServiceProtocol; + ARes.GetSerializer().GetPropertyManager().SetProperties(initData); + ARes.GetCallHandler().GetPropertyManager().SetProperties(initData); + End; +end; + +procedure TFormatterRegistry.Register( + Const AProtocolName : string; + AFormaterFactory : IItemFactory; + ACallHandlerFactory : IItemFactory +); +Var + i : Integer; + s : string; +begin + Assert(Assigned(AFormaterFactory)); + Assert(Assigned(ACallHandlerFactory)); + s := ExtractProtocol(AProtocolName); + i := IndexOf(s); + If ( i = -1 ) Then + FList.Add(TFormatterFactoryRegistryItem.Create(s,AFormaterFactory,ACallHandlerFactory)); +end; + +constructor TFormatterRegistry.Create(); +begin + FList := TObjectList.Create(True); +end; + +destructor TFormatterRegistry.Destroy(); +begin + FreeAndNil(FList); + inherited Destroy(); +end; + +Type + { TTransportRegistry } + //Make it Threadsafe ??? + TTransportRegistry = class(TBaseFactoryRegistry,IInterface,ITransportRegistry) + protected + function Find( + Const ATransportData : string; + Out ARes : ITransport + ):Boolean; + End; + + +Var + TransportRegistryInst : ITransportRegistry = Nil; +function GetTransportRegistry():ITransportRegistry; +begin + If Not Assigned(TransportRegistryInst) Then + TransportRegistryInst := TTransportRegistry.Create() as ITransportRegistry;// Lock!!! + Result := TransportRegistryInst; +end; + +{ TTransportRegistry } + +function TTransportRegistry.Find( + const ATransportData : string; + Out ARes : ITransport +): Boolean; +Var + fct : IItemFactory; +begin + fct := FindFactory(ExtractProtocol(ATransportData)); + If Assigned(fct) Then Begin + ARes := fct.CreateInstance() as ITransport; + ARes.GetPropertyManager().SetProperties(ExtractProtocolData(ATransportData)); + Result := True; + End Else Begin + Result := False; + End; +end; + +initialization + TransportRegistryInst := TTransportRegistry.Create() as ITransportRegistry; + FormaterRegistryInst := TFormatterRegistry.Create() as IFormaterQueryRegistry; + +finalization + FormaterRegistryInst := nil; + TransportRegistryInst := nil; +end. diff --git a/wst/tags/3.1/soap_formatter.pas b/wst/tags/3.1/soap_formatter.pas new file mode 100644 index 000000000..fc628d84d --- /dev/null +++ b/wst/tags/3.1/soap_formatter.pas @@ -0,0 +1,267 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit soap_formatter; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, TypInfo, DOM, + base_service_intf, service_intf, imp_utils, base_soap_formatter; + + +Type + + + { TSOAPFormatter } +{$M+} + TSOAPFormatter = class(TSOAPBaseFormatter,IFormatterClient) + private + FPropMngr : IPropertyManager; + FCallProcedureName : string; + FCallTarget : String; + public + destructor Destroy();override; + function GetPropertyManager():IPropertyManager; + + procedure BeginCall( + const AProcName, + ATarget : string; + ACallContext : ICallContext + ); + procedure EndCall(); + procedure BeginCallRead(ACallContext : ICallContext); + + function GetCallProcedureName():String; + function GetCallTarget():String; + End; + + { TSOAPCallMaker } + + TSOAPCallMaker = class(TSimpleFactoryItem,ICallMaker) + private + FPropMngr : IPropertyManager; + FUniqueAddress: Boolean; + public + constructor Create();override; + destructor Destroy();override; + function GetPropertyManager():IPropertyManager; + procedure MakeCall( + ASerializer : IFormatterClient; + ATransport : ITransport + ); + published + property UniqueAddress : Boolean read FUniqueAddress Write FUniqueAddress; + end; +{$M-} + +implementation + + +{ TSOAPFormatter } + +destructor TSOAPFormatter.Destroy(); +begin + FPropMngr := nil; + inherited Destroy(); +end; + +function TSOAPFormatter.GetPropertyManager(): IPropertyManager; +begin + If Not Assigned(FPropMngr) Then + FPropMngr := TPublishedPropertyManager.Create(Self); + Result := FPropMngr; +end; + +procedure TSOAPFormatter.BeginCall( + const AProcName, + ATarget : string; + ACallContext : ICallContext +); +begin + //BeginScope('Envelope',sSOAP_ENV,sSOAP_ENV_ABR); + //AddScopeAttribute('xmlns:xsi',sXSI_NS); + //AddScopeAttribute('xmlns:'+sXSD, sXSD_NS); + //AddScopeAttribute('xmlns:'+sSOAP_ENC_ABR, sSOAP_ENC); + Prepare(); + WriteHeaders(ACallContext); + BeginScope('Body',sSOAP_ENV); + if ( Style = RPC ) then + BeginScope(AProcName,ATarget); + + FCallTarget := ATarget; + FCallProcedureName := AProcName; +end; + +procedure TSOAPFormatter.EndCall(); +begin + if ( Style = RPC ) then + EndScope(); //BeginScope(AProcName,ATarget); + EndScope(); //BeginScope('Body','http://schemas.xmlsoap.org/soap/envelope/'); + EndScope(); //BeginScope('Envelope','http://schemas.xmlsoap.org/soap/envelope/','SOAP-ENV'); +end; + +procedure TSOAPFormatter.BeginCallRead(ACallContext : ICallContext); +Var + envNd : TDOMElement; + bdyNd, fltNd, hdrNd : TDOMNode; + nsShortName,eltName, msgBuff : string; + excpt_Obj : ESOAPException; + doc : TXMLDocument; +begin + ClearStack(); + doc := GetXmlDoc(); + If FindAttributeByValueInNode(sSOAP_ENV,doc.DocumentElement,nsShortName) or + FindAttributeByValueInNode('"' + sSOAP_ENV + '"',doc.DocumentElement,nsShortName) + Then Begin + nsShortName := Copy(nsShortName,1 + Pos(':',nsShortName),MaxInt); + If Not IsStrEmpty(nsShortName) Then + nsShortName := nsShortName + ':'; + End Else + nsShortName := ''; + eltName := nsShortName + sENVELOPE; + envNd := doc.DocumentElement; + If Not SameText(eltName,envNd.NodeName) Then + Error('XML root node must be "Envelope", found : "%s"',[envNd.NodeName + ':::' + nsShortName]); + PushStack(envNd); + + bdyNd := envNd.FirstChild; + if not Assigned(bdyNd) then + Error('Node not found : "Body".'); + + eltName := nsShortName + 'Body'; + if not SameText(bdyNd.NodeName,eltName) then begin + eltName := nsShortName + 'Header'; + hdrNd := bdyNd; + bdyNd := hdrNd.NextSibling; + if SameText(hdrNd.NodeName,eltName) then begin + PushStack(hdrNd,stArray).SetNameSpace(sSOAP_ENV); + ReadHeaders(ACallContext); + PopStack().Free(); + end; + end; + + eltName := nsShortName + 'Body'; + bdyNd := envNd.FirstChild; + If Not Assigned(bdyNd) Then + Error('Node not found : "Body"'); + If Not SameText(bdyNd.NodeName,eltName) Then + bdyNd := bdyNd.NextSibling; + If Not Assigned(bdyNd) Then + Error('Node not found : "Body"'); + PushStack(bdyNd); + If Not Assigned(bdyNd.FirstChild) Then + Error('Response Node not found'); + if ( Style = RPC ) then begin + PushStack(bdyNd.FirstChild); + end; + eltName := nsShortName + 'Fault'; + If SameText(eltName,bdyNd.FirstChild.NodeName) Then Begin + fltNd := bdyNd.FirstChild; + excpt_Obj := ESOAPException.Create(''); + Try + eltName := 'faultcode'; + Get(TypeInfo(string),eltName,msgBuff); + excpt_Obj.FaultCode := msgBuff; + eltName := 'faultstring'; + Get(TypeInfo(string),eltName,msgBuff); + excpt_Obj.FaultString := msgBuff; ; + excpt_Obj.Message := Format( + 'Service exception :%s Code = "%s"%s Message = "%s"', + [LineEnding,excpt_Obj.FaultCode,LineEnding,excpt_Obj.FaultString] + ); + Except + FreeAndNil(excpt_Obj); + Raise; + End; + Raise excpt_Obj; + End; +end; + +function TSOAPFormatter.GetCallProcedureName(): String; +begin + Result := FCallProcedureName; +end; + +function TSOAPFormatter.GetCallTarget(): String; +begin + Result := FCallTarget; +end; + +{ TSOAPCallMaker } + +constructor TSOAPCallMaker.Create(); +begin + FUniqueAddress := True; + FPropMngr := TPublishedPropertyManager.Create(Self); +end; + +destructor TSOAPCallMaker.Destroy(); +begin + FPropMngr := Nil; + inherited Destroy(); +end; + +function TSOAPCallMaker.GetPropertyManager(): IPropertyManager; +begin + Result := FPropMngr; +end; + +procedure TSOAPCallMaker.MakeCall( + ASerializer : IFormatterClient; + ATransport : ITransport +); +Var + rqt, rsps : TMemoryStream; + {$IFDEF WST_DBG} + s : string; + {$ENDIF WST_DBG} +begin + Assert(Assigned(ASerializer)); + Assert(Assigned(ATransport)); + ATransport.GetPropertyManager().SetProperty( + sCONTENT_TYPE, + ASerializer.GetPropertyManager().GetProperty(sCONTENT_TYPE) + ); + rsps := Nil; + rqt := TMemoryStream.Create(); + Try + rsps := TMemoryStream.Create(); + ASerializer.SaveToStream(rqt); + rqt.Position := 0; + ATransport.SendAndReceive(rqt,rsps); + rqt.Clear(); + rsps.Position := 0; + ASerializer.Clear(); + ASerializer.LoadFromStream(rsps); + Finally + rsps.Free(); + rqt.Free(); + End; +end; + +procedure RegisterSoapProtocol(); +begin + RegisterStdTypes(); + GetFormaterRegistry().Register( + sPROTOCOL_NAME, + TSimpleItemFactory.Create(TSOAPFormatter) as IItemFactory, + TSimpleItemFactory.Create(TSOAPCallMaker) as IItemFactory + ); +end; + +Initialization + RegisterSoapProtocol(); + +end. diff --git a/wst/tags/3.1/synapse_http_protocol.pas b/wst/tags/3.1/synapse_http_protocol.pas new file mode 100644 index 000000000..5f0551cee --- /dev/null +++ b/wst/tags/3.1/synapse_http_protocol.pas @@ -0,0 +1,178 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit synapse_http_protocol; + +{$mode objfpc}{$H+} +//{$DEFINE WST_DBG} + +interface + +uses + Classes, SysUtils,{$IFDEF WST_DBG}Dialogs,{$ENDIF} + service_intf, imp_utils, base_service_intf, + httpsend; + +Const + sTRANSPORT_NAME = 'HTTP'; + +Type + +{$M+} + { THTTPTransport } + THTTPTransport = class(TSimpleFactoryItem,ITransport) + Private + FPropMngr : IPropertyManager; + FConnection : THTTPSend; + FAddress : string; + private + FSoapAction: string; + function GetAddress: string; + function GetContentType: string; + function GetProxyPassword: string; + function GetProxyPort: Integer; + function GetProxyServer: string; + function GetProxyUsername: string; + procedure SetAddress(const AValue: string); + procedure SetContentType(const AValue: string); + procedure SetProxyPassword(const AValue: string); + procedure SetProxyPort(const AValue: Integer); + procedure SetProxyServer(const AValue: string); + procedure SetProxyUsername(const AValue: string); + Public + constructor Create();override; + destructor Destroy();override; + function GetPropertyManager():IPropertyManager; + procedure SendAndReceive(ARequest,AResponse:TStream); + Published + property ContentType : string Read GetContentType Write SetContentType; + property Address : string Read GetAddress Write SetAddress; + property ProxyServer : string Read GetProxyServer Write SetProxyServer; + property ProxyPort : Integer Read GetProxyPort Write SetProxyPort; + property ProxyUsername : string read GetProxyUsername write SetProxyUsername; + property ProxyPassword : string read GetProxyPassword write SetProxyPassword; + property SoapAction : string read FSoapAction write FSoapAction; + End; +{$M+} + + procedure SYNAPSE_RegisterHTTP_Transport(); + +implementation + +{ THTTPTransport } + +function THTTPTransport.GetAddress: string; +begin + Result := FAddress; +end; + +function THTTPTransport.GetContentType: string; +begin + Result := FConnection.MimeType; +end; + +function THTTPTransport.GetProxyPassword: string; +begin + Result := FConnection.ProxyPass; +end; + +function THTTPTransport.GetProxyPort: Integer; +begin + Result := StrToInt(FConnection.ProxyPort); +end; + +function THTTPTransport.GetProxyServer: string; +begin + Result := FConnection.ProxyHost; +end; + +function THTTPTransport.GetProxyUsername: string; +begin + Result := FConnection.ProxyUser; +end; + +procedure THTTPTransport.SetAddress(const AValue: string); +begin + FAddress := AValue; +end; + +procedure THTTPTransport.SetContentType(const AValue: string); +begin + FConnection.MimeType := AValue; +end; + +procedure THTTPTransport.SetProxyPassword(const AValue: string); +begin + FConnection.ProxyPass := AValue; +end; + +procedure THTTPTransport.SetProxyPort(const AValue: Integer); +begin + FConnection.ProxyPort := IntToStr(AValue); +end; + +procedure THTTPTransport.SetProxyServer(const AValue: string); +begin + FConnection.ProxyHost := AValue; +end; + +procedure THTTPTransport.SetProxyUsername(const AValue: string); +begin + FConnection.ProxyUser := AValue; +end; + +constructor THTTPTransport.Create(); +begin + inherited Create(); + FPropMngr := TPublishedPropertyManager.Create(Self); + FConnection := THTTPSend.Create(); + FConnection.Protocol := '1.1'; +end; + +destructor THTTPTransport.Destroy(); +begin + FreeAndNil(FConnection); + FPropMngr := Nil; + inherited Destroy(); +end; + +function THTTPTransport.GetPropertyManager(): IPropertyManager; +begin + Result := FPropMngr; +end; + +procedure THTTPTransport.SendAndReceive(ARequest, AResponse: TStream); +{$IFDEF WST_DBG} +var + s : string; +{$ENDIF} +begin + FConnection.Document.Size := 0; + FConnection.Headers.Add('soapAction:' + SoapAction); + FConnection.Document.CopyFrom(ARequest,0); + FConnection.HTTPMethod('POST',FAddress); + AResponse.CopyFrom(FConnection.Document,0); + FConnection.Clear(); +{$IFDEF WST_DBG} + TMemoryStream(AResponse).SaveToFile('log.log'); + SetLength(s,AResponse.Size); + Move(TMemoryStream(AResponse).Memory^,s[1],Length(s)); + ShowMessage(s); +{$ENDIF} +end; + +procedure SYNAPSE_RegisterHTTP_Transport(); +begin + GetTransportRegistry().Register(sTRANSPORT_NAME,TSimpleItemFactory.Create(THTTPTransport) as IItemFactory); +end; + +end. diff --git a/wst/tags/3.1/tests/apache_module/mod_wst.lpi b/wst/tags/3.1/tests/apache_module/mod_wst.lpi new file mode 100644 index 000000000..47889313c --- /dev/null +++ b/wst/tags/3.1/tests/apache_module/mod_wst.lpi @@ -0,0 +1,359 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/apache_module/mod_wst.lpr b/wst/tags/3.1/tests/apache_module/mod_wst.lpr new file mode 100644 index 000000000..a908942dd --- /dev/null +++ b/wst/tags/3.1/tests/apache_module/mod_wst.lpr @@ -0,0 +1,51 @@ +library mod_wst; +{$mode objfpc}{$H+} + +{$IFDEF WIN32} + {$DEFINE WINDOWS} +{$ENDIF} + +uses + SysUtils, + httpd, apr, apriconv, aprutil, wst_apache_binding; + +var + wst_module: module; {$ifdef Unix} public name 'wst_module'; {$endif} + default_module_ptr: Pmodule; + +const + MODULE_NAME = 'mod_wst.so'; + +{$ifdef WINDOWS} +exports + wst_module name 'wst_module'; +{$endif} + + +function DefaultHandler(r: Prequest_rec): Integer; cdecl; +begin + if not SameText(r^.handler, 'wst-handler') then + begin + Result := DECLINED; + Exit; + end; + + Result := wst_RequestHandler(r); +end; + +procedure RegisterHooks(p: Papr_pool_t); cdecl; +begin + ap_hook_handler(@DefaultHandler, nil, nil, APR_HOOK_MIDDLE); +end; + +begin + default_module_ptr := @wst_module; + FillChar(default_module_ptr^, SizeOf(default_module_ptr^), 0); + STANDARD20_MODULE_STUFF(default_module_ptr^); + with wst_module do + begin + name := MODULE_NAME; + magic := MODULE_MAGIC_COOKIE; + register_hooks := @RegisterHooks; + end; +end. diff --git a/wst/tags/3.1/tests/apache_module/wst_apache_binding.pas b/wst/tags/3.1/tests/apache_module/wst_apache_binding.pas new file mode 100644 index 000000000..3c3143e47 --- /dev/null +++ b/wst/tags/3.1/tests/apache_module/wst_apache_binding.pas @@ -0,0 +1,318 @@ +//{$DEFINE WST_DBG} + +unit wst_apache_binding; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + httpd, apr, apriconv, aprutil; + +const + sWST_ROOT = 'wst'; + sSEPARATOR = '/'; + sSERVICES_PREFIXE = 'services'; + sWSDL = 'WSDL'; + sHTTP_BINARY_CONTENT_TYPE = 'application/octet-stream'; + sCONTENT_TYPE = 'Content-Type'; + + function wst_RequestHandler(r: Prequest_rec): Integer; + +implementation +uses base_service_intf, + server_service_intf, server_service_imputils, + server_service_soap, server_binary_formatter, + metadata_repository, metadata_wsdl, DOM, XMLWrite, + + calculator, calculator_binder, calculator_imp, + metadata_service, metadata_service_binder, metadata_service_imp; + +type + TRequestInfo = record + Root : string; + URI : string; + ContentType : string; + Buffer : string; + end; + + TResponseInfo = record + ContentText : string; + ContentType : string; + end; + + +procedure SaveStringToFile(const AStr,AFile:string;const AKeepExisting : Boolean); +begin + with TMemoryStream.Create() do try + if AKeepExisting and FileExists(AFile) then begin + LoadFromFile(AFile); + Position := Size; + end; + if ( Length(AStr) > 0 ) then + Write(AStr[1],Length(AStr)); + SaveToFile(AFile); + finally + Free(); + end; +end; + +function ReadBuffer(r : Prequest_rec; out rbuf : string ) : Integer; +var + argsbuffer : string; + rsize, len_read, rpos : Integer; + loc_length : Integer; +begin + rbuf := ''; + Result := ap_setup_client_block(r, REQUEST_CHUNKED_ERROR); + if ( Result <> OK ) then + Exit; + + if ( ap_should_client_block(r) <> 0 ) then begin + SetLength(argsbuffer,HUGE_STRING_LEN); + FillChar(argsbuffer[1],Length(argsbuffer),0); + rsize := 0; len_read := 0; rpos := 0; + loc_length := r^.remaining; + SetLength(rbuf, loc_length ); + + while True do begin + len_read := ap_get_client_block(r, @(argsbuffer[1]), Length(argsbuffer)); + if ( len_read <= 0 ) then + Exit; + if ( ( rpos + len_read ) > loc_length ) then + rsize := loc_length - rpos + else + rsize := len_read; + Move(argsbuffer[1],rbuf[ ( 1 + rpos ) ], rsize); + Inc(rpos,rsize); + end; + end; +end; + +function ExtractNextPathElement(var AFullPath : string):string; +var + i : SizeInt; +begin + Result := ''; + if ( Length(AFullPath) > 0 ) then begin + while ( Length(AFullPath) > 0 ) and ( AFullPath[1] = sSEPARATOR ) do begin + Delete(AFullPath,1,1); + end; + i := Pos(sSEPARATOR,AFullPath); + if ( i < 1 ) then begin + Result := AFullPath; + AFullPath := ''; + end else begin + Result := Copy(AFullPath,1,Pred(i)); + Delete(AFullPath,1,i); + end; + end; +end; + +function GetWSDL(const ARepName, ARootAddress: shortstring):string; +var + strm : TMemoryStream; + rep : PServiceRepository; + doc :TXMLDocument; + i : SizeInt; + s : string; +begin + Result := ''; + rep := nil; + doc := Nil; + i := GetModuleMetadataMngr().IndexOfName(ARepName); + if ( i < 0 ) then + Exit; + strm := TMemoryStream.Create(); + try + s := GetModuleMetadataMngr().GetRepositoryName(i); + GetModuleMetadataMngr().LoadRepositoryName(s,ARootAddress,rep); + strm.Clear(); + doc := TXMLDocument.Create(); + GenerateWSDL(rep,doc); + WriteXMLFile(doc,strm); + i := strm.Size; + if ( i > 0 ) then begin + SetLength(Result,i); + Move(strm.memory^,Result[1],i); + end; + finally + doc.Free(); + strm.Free(); + GetModuleMetadataMngr().ClearRepository(rep); + end; +end; + +function GenerateWSDLTable(): string; +var + r : IModuleMetadataMngr; + i : Integer; +begin + r := GetModuleMetadataMngr(); + Result := '' + + ''+ + ''+ + 'The Web Service Toolkit generated Metadata table'+ + ''+ + '' + + '

The following repositories has available. Click on the link to view the corresponding WSDL.

'+ + ''; + + for i := 0 to Pred(r.GetCount()) do + Result := Result + '' + + '' + + ''; + + Result := Result + + ''+ + '
' + + Format('',[sSEPARATOR+sWST_ROOT+sSEPARATOR+sSERVICES_PREFIXE+sSEPARATOR+sWSDL+sSEPARATOR+r.GetRepositoryName(i)])+ + r.GetRepositoryName(i) + + ''+ + '
'+ + ''+ + ''+ + ''; +end; + +procedure ProcessWSDLRequest( + const ARequestInfo : TRequestInfo; + out AResponseInfo : TResponseInfo +); +var + locRepName, strBuff, locPath : string; + i : Integer; +begin + FillChar(AResponseInfo,SizeOf(TResponseInfo),#0); + locPath := ARequestInfo.URI; + locRepName := ExtractNextPathElement(locPath); + if AnsiSameText(sWSDL,locRepName) then + locRepName := ExtractNextPathElement(locPath); + strBuff := GetWSDL(locRepName,ARequestInfo.Root); + i := Length(strBuff); + if ( i > 0 ) then begin + AResponseInfo.ContentType := 'text/xml'; + AResponseInfo.ContentText := strBuff; + Exit; + end; + AResponseInfo.ContentText := GenerateWSDLTable(); + AResponseInfo.ContentType := 'text/html'; +end; + +function ProcessServiceRequest( + const ARequestInfo : TRequestInfo; + out AResponseInfo : TResponseInfo +):Boolean; +var + trgt,ctntyp, loc_path : string; + rqst : IRequestBuffer; + inStream, outStream: TMemoryStream; + i : Integer; +begin + FillChar(AResponseInfo,SizeOf(TResponseInfo),#0); + loc_path := ARequestInfo.URI; + trgt := ExtractNextPathElement(loc_path); + Result := False; + if AnsiSameText(sWSDL,trgt) then + Exit; + Result := True; + inStream := nil; + outStream := nil; + try + inStream := TMemoryStream.Create(); + outStream := TMemoryStream.Create(); + + ctntyp := ARequestInfo.ContentType; + i := Length(ARequestInfo.Buffer); + if ( i > 0 ) then + inStream.Write(ARequestInfo.Buffer[1],i); + inStream.Position := 0; + if AnsiSameText(sBINARY_CONTENT_TYPE,ctntyp) then + AResponseInfo.ContentType := sHTTP_BINARY_CONTENT_TYPE + else + AResponseInfo.ContentType := ctntyp; + rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,outStream); + HandleServiceRequest(rqst); + i := outStream.Size; + if ( i > 0 ) then begin + SetLength(AResponseInfo.ContentText,i); + Move(outStream.Memory^,AResponseInfo.ContentText[1],i); + end; + finally + outStream.Free(); + inStream.Free(); + {$IFDEF WST_DBG} + {SaveStringToFile('RequestInfo.ContentType=' + ARequestInfo.ContentType + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',False); + SaveStringToFile('RequestInfo.Buffer=' + ARequestInfo.Buffer + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',True); + SaveStringToFile('RequestInfo.URI=' + ARequestInfo.URI + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',True); + SaveStringToFile('ResponseInfo.ContentType=' + AResponseInfo.ContentType + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',True); + SaveStringToFile('ResponseInfo.ContentText=' + AResponseInfo.ContentText + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',True); + } + {$ENDIF} + end; +end; + +function wst_RequestHandler(r: Prequest_rec): Integer; + + function FillRequestInfo(var ARequestInfo : TRequestInfo):Integer; + begin + ARequestInfo.ContentType := apr_table_get(r^.headers_in,sCONTENT_TYPE); + ARequestInfo.Root := ap_get_server_name(r) + sSEPARATOR + sWST_ROOT + sSEPARATOR; + ARequestInfo.URI := r^.uri; + Result := ReadBuffer(r,ARequestInfo.Buffer); + end; + +var + sInputBuffer : string; + iRet, iLen : Integer; + loc_RequestInfo : TRequestInfo; + loc_ResponseInfo : TResponseInfo; +begin + Result := FillRequestInfo(loc_RequestInfo); + if not AnsiSameText(sWST_ROOT,ExtractNextPathElement(loc_RequestInfo.URI)) then + Result := DECLINED; + if ( Result <> OK ) then + Exit; + + try + if AnsiSameText(sSERVICES_PREFIXE,ExtractNextPathElement(loc_RequestInfo.URI)) then begin + if not ProcessServiceRequest(loc_RequestInfo,loc_ResponseInfo) then + ProcessWSDLRequest(loc_RequestInfo,loc_ResponseInfo); + end else begin + ProcessWSDLRequest(loc_RequestInfo,loc_ResponseInfo); + end; + + ap_set_content_type(r, PCHAR(loc_ResponseInfo.ContentType)); + if AnsiSameText(sHTTP_BINARY_CONTENT_TYPE,loc_ResponseInfo.ContentType) then begin + ap_set_content_length(r,Length(loc_ResponseInfo.ContentText)); + ap_rwrite(@(loc_ResponseInfo.ContentText[1]),Length(loc_ResponseInfo.ContentText),r); + ap_rflush(r); + end else begin + ap_rputs(PCHAR(loc_ResponseInfo.ContentText), r); + end; + Result := OK; + Exit; + except + on e : Exception do begin + ap_set_content_type(r, 'text/html'); + ap_rputs(' Error' + LineEnding, r); + ap_rputs('',r); + ap_rprintf(r, '

"%s"

' + LineEnding, [PCHAR(e.Message)]); + Exit; + end; + end; +end; + +initialization + RegisterStdTypes(); + Server_service_RegisterBinaryFormat(); + Server_service_RegisterSoapFormat(); + + RegisterCalculatorImplementationFactory(); + Server_service_RegisterCalculatorService(); + + Server_service_RegisterWSTMetadataServiceService(); + RegisterWSTMetadataServiceImplementationFactory(); + +end. diff --git a/wst/tags/3.1/tests/calculator/calculator.pas b/wst/tags/3.1/tests/calculator/calculator.pas new file mode 100644 index 000000000..b408fedc2 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/calculator.pas @@ -0,0 +1,114 @@ +unit calculator; + +{$mode objfpc}{$H+} + +interface +uses SysUtils, + base_service_intf; + +Type + + + TCalc_Op = ( coAdd, coSub, coMul, coDiv ); + + { TCalcHeader } + + TCalcHeader = class(THeaderBlock) + private + FLogin: string; + FPassword: string; + FWantedPrecision: Integer; + published + property Login : string read FLogin write FLogin; + property Password : string read FPassword write FPassword; + property WantedPrecision : Integer read FWantedPrecision write FWantedPrecision; + end; + + { TCalcResultHeader } + + TCalcResultHeader = class(TCalcHeader) + private + FSessionID: string; + FTimeStamp: string; + published + property TimeStamp : string read FTimeStamp write FTimeStamp; + property SessionID : string read FSessionID write FSessionID; + end; + + TBinaryArgsResult = class(TBaseComplexRemotable) + private + FArg_A: Integer; + FArg_B: Integer; + FArg_OP: string; + FArg_OpEnum: TCalc_Op; + FArg_R: Integer; + FComment: string; + private + function GetHasComment: boolean; + Published + Property Arg_A : Integer Read FArg_A Write FArg_A; + Property Arg_B : Integer Read FArg_B Write FArg_B; + Property Arg_R : Integer Read FArg_R Write FArg_R; + Property Arg_OP : string Read FArg_OP Write FArg_OP; + Property Arg_OpEnum : TCalc_Op Read FArg_OpEnum Write FArg_OpEnum; + property Comment : string read FComment write FComment stored GetHasComment; + End; + + TBinaryArgsResultArray = class(TBaseObjectArrayRemotable) + private + function GetItem(AIndex: Integer): TBinaryArgsResult; + Public + class function GetItemClass():TBaseRemotableClass;override; + Property Item[AIndex:Integer] : TBinaryArgsResult Read GetItem;Default; + End; + + ICalculator = Interface + function AddInt( + Const A:Integer; + Const B:Integer + ):TBinaryArgsResult; + function DivInt( + Const A:Integer; + Const B:Integer + ):Integer; + function DoAllOperations( + Const A:Integer; + Const B:Integer + ):TBinaryArgsResultArray; + function DoOperation( + Const A:Integer; + Const B:Integer; + const AOperation : TCalc_Op + ):TBinaryArgsResult; + End; + +implementation + + +{ TBinaryArgsResultArray } + +function TBinaryArgsResultArray.GetItem(AIndex: Integer): TBinaryArgsResult; +begin + Result := Inherited GetItem(AIndex) as TBinaryArgsResult; +end; + +class function TBinaryArgsResultArray.GetItemClass(): TBaseRemotableClass; +begin + Result := TBinaryArgsResult; +end; + +{ TBinaryArgsResult } + +function TBinaryArgsResult.GetHasComment: boolean; +begin + Result := ( Length(Trim(FComment)) > 0 ) ; +end; + +Initialization + GetTypeRegistry().Register('urn:calculator',TypeInfo(TCalc_Op),'TCalc_Op'); + GetTypeRegistry().Register('urn:calculator',TypeInfo(TBinaryArgsResult),'TBinaryArgsResult'); + GetTypeRegistry().Register('urn:calculator',TypeInfo(TBinaryArgsResultArray),'TBinaryArgsResultArray'); + GetTypeRegistry().Register('urn:calculator',TypeInfo(TCalcHeader),'CalcHeader').AddPascalSynonym('TCalcHeader'); + GetTypeRegistry().Register('urn:calculator',TypeInfo(TCalcResultHeader),'CalcResultHeader').AddPascalSynonym('TCalcResultHeader'); + +end. diff --git a/wst/tags/3.1/tests/calculator/calculator.wst_meta b/wst/tags/3.1/tests/calculator/calculator.wst_meta new file mode 100644 index 000000000..b4a0cfa80 Binary files /dev/null and b/wst/tags/3.1/tests/calculator/calculator.wst_meta differ diff --git a/wst/tags/3.1/tests/calculator/client/calc_client.lpi b/wst/tags/3.1/tests/calculator/client/calc_client.lpi new file mode 100644 index 000000000..c6708f850 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/client/calc_client.lpi @@ -0,0 +1,278 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/calculator/client/calc_client.pas b/wst/tags/3.1/tests/calculator/client/calc_client.pas new file mode 100644 index 000000000..63b16fcd4 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/client/calc_client.pas @@ -0,0 +1,83 @@ +program calc_client; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, + service_intf, + base_soap_formatter, soap_formatter, binary_formatter, + ics_tcp_protocol, + calculator, calculator_proxy, TypInfo; + +Var + calcObj : ICalculator; + i, j, k : Integer; + rk : TBinaryArgsResult; + vA : TBinaryArgsResultArray; + f : IFormatterClient; + s : TStream; + msgProt : string; +begin +{ vA := TBinaryArgsResultArray.Create(); + vA.SetLength(2); + f := TBinaryFormatter.Create() as IFormatterClient; + f.BeginCall('pr','trgt'); + f.Put('xx',TypeInfo(TBinaryArgsResultArray),vA); + f.EndCall(); + s:= TMemoryStream.Create(); + f.SaveToStream(s); + f := Nil; + f := TBinaryFormatter.Create() as IFormatterClient; + s.Position := 0; + WriteLn('------------------------------------------'); + WriteLn('------------------------------------------'); + f.LoadFromStream(s); + ReadLn(); + Exit;} + //Client + Write('Enter msg protocol :'); + ReadLn(msgProt); + If Not( AnsiSameText(msgProt,'SOAP') Or AnsiSameText(msgProt,'binary') ) Then + msgProt := 'binary'; + Writeln('USED Msg protocol = ',msgProt); + ICS_RegisterTCP_Transport(); + + rk := nil; + Try + Try + calcObj := TCalculator_Proxy.Create( + 'ICalculator', // Target + msgProt,//'SOAP',//'binary', // Protocol Data + 'TCP:Address=127.0.0.1;Port=1234;target=ICalculator' // Transport Data + ); + WriteLn('Calculator test.'); + Write('Enter A = '); ReadLn(i); + Write('Enter B = '); ReadLn(j); + k := calcObj.DivInt(i,j); + Write(' A / B = '); WriteLn(k); + rk := calcObj.AddInt(i,j); + WriteLn(Format(' ( %d %s %d ) = %d',[rk.Arg_A, rk.Arg_OP, rk.Arg_B, rk.Arg_R])); + WriteLn('----------------------------------------------'); + vA := calcObj.DoAllOperations(i,j); + Try + For i := 0 To Pred(vA.Length) Do + WriteLn(Format(' ( %d %s %d ) = %d; OP=%s',[vA[i].Arg_A, vA[i].Arg_OP, vA[i].Arg_B, vA[i].Arg_R,GetEnumName(TypeInfo(TCalc_Op),Ord(vA[i].Arg_OpEnum))])); + Finally + vA.Free(); + End; + Except + On E : ESOAPException Do Begin + WriteLn('Oups ( SOAP Exception ) :'); + WriteLn(' Code=',E.FaultCode); + WriteLn(' String=',E.FaultString); + End; + On E : Exception Do Begin + WriteLn('Oups:'); + WriteLn(E.Message); + End; + End; + Finally + rk.Free(); + End; + ReadLn(); +end. diff --git a/wst/tags/3.1/tests/calculator/client/calculator.lrs b/wst/tags/3.1/tests/calculator/client/calculator.lrs new file mode 100644 index 000000000..7fc82fd05 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/client/calculator.lrs @@ -0,0 +1,13 @@ +LazarusResources.Add('CALCULATOR','wst_meta',[ + #0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#10'calculator'#1#0#0#0#11'ICalculator'#4 + +#0#0#0#6'AddInt'#3#0#0#0#1'A'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#1'B'#0#0 + +#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0#17'TBinaryArgsResult'#0#0 + +#0#0#0#0#0#3#0#0#0#6'DivInt'#3#0#0#0#1'A'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0 + +#0#0#1'B'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0#7'Integer'#0 + +#0#0#0#0#0#0#3#0#0#0#15'DoAllOperations'#3#0#0#0#1'A'#0#0#0#7'Integer'#0#0#0 + +#0#0#0#0#1#0#0#0#1'B'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0 + +#22'TBinaryArgsResultArray'#0#0#0#0#0#0#0#3#0#0#0#11'DoOperation'#4#0#0#0#1 + +'A'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#1'B'#0#0#0#7'Integer'#0#0#0#0#0#0 + +#0#1#0#0#0#10'AOperation'#0#0#0#8'TCalc_Op'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0 + +#0#0#17'TBinaryArgsResult'#0#0#0#0#0#0#0#3 +]); diff --git a/wst/tags/3.1/tests/calculator/client/calculator_proxy.pas b/wst/tags/3.1/tests/calculator/client/calculator_proxy.pas new file mode 100644 index 000000000..7668378b8 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/client/calculator_proxy.pas @@ -0,0 +1,164 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "calculator". + This unit name : "calculator_proxy". + Date : "30/07/2006 01:54". +} +Unit calculator_proxy; +{$mode objfpc}{$H+} +Interface + +Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, calculator; + +Type + + + TCalculator_Proxy=class(TBaseProxy,ICalculator) + Protected + class function GetServiceType() : PTypeInfo;override; + function AddInt( + Const A : Integer; + Const B : Integer + ):TBinaryArgsResult; + function DivInt( + Const A : Integer; + Const B : Integer + ):Integer; + function DoAllOperations( + Const A : Integer; + Const B : Integer + ):TBinaryArgsResultArray; + function DoOperation( + Const A : Integer; + Const B : Integer; + Const AOperation : TCalc_Op + ):TBinaryArgsResult; + End; + +Implementation +uses LResources, metadata_repository; + +{ TCalculator_Proxy implementation } + +class function TCalculator_Proxy.GetServiceType() : PTypeInfo; +begin + result := TypeInfo(ICalculator); +end; + +function TCalculator_Proxy.AddInt( + Const A : Integer; + Const B : Integer +):TBinaryArgsResult; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('AddInt', GetTarget(),(Self as ICallContext)); + locSerializer.Put('A', TypeInfo(Integer), A); + locSerializer.Put('B', TypeInfo(Integer), B); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(Result) := Nil; + strPrmName := 'return'; + locSerializer.Get(TypeInfo(TBinaryArgsResult), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + +function TCalculator_Proxy.DivInt( + Const A : Integer; + Const B : Integer +):Integer; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('DivInt', GetTarget(),(Self as ICallContext)); + locSerializer.Put('A', TypeInfo(Integer), A); + locSerializer.Put('B', TypeInfo(Integer), B); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + strPrmName := 'return'; + locSerializer.Get(TypeInfo(Integer), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + +function TCalculator_Proxy.DoAllOperations( + Const A : Integer; + Const B : Integer +):TBinaryArgsResultArray; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('DoAllOperations', GetTarget(),(Self as ICallContext)); + locSerializer.Put('A', TypeInfo(Integer), A); + locSerializer.Put('B', TypeInfo(Integer), B); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(Result) := Nil; + strPrmName := 'return'; + locSerializer.Get(TypeInfo(TBinaryArgsResultArray), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + +function TCalculator_Proxy.DoOperation( + Const A : Integer; + Const B : Integer; + Const AOperation : TCalc_Op +):TBinaryArgsResult; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('DoOperation', GetTarget(),(Self as ICallContext)); + locSerializer.Put('A', TypeInfo(Integer), A); + locSerializer.Put('B', TypeInfo(Integer), B); + locSerializer.Put('AOperation', TypeInfo(TCalc_Op), AOperation); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(Result) := Nil; + strPrmName := 'return'; + locSerializer.Get(TypeInfo(TBinaryArgsResult), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + + +initialization + {$i calculator.lrs} + + {$IF DECLARED(Register_calculator_ServiceMetadata)} + Register_calculator_ServiceMetadata(); + {$ENDIF} +End. diff --git a/wst/tags/3.1/tests/calculator/gui_client/calculator.lrs b/wst/tags/3.1/tests/calculator/gui_client/calculator.lrs new file mode 100644 index 000000000..7fc82fd05 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/gui_client/calculator.lrs @@ -0,0 +1,13 @@ +LazarusResources.Add('CALCULATOR','wst_meta',[ + #0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#10'calculator'#1#0#0#0#11'ICalculator'#4 + +#0#0#0#6'AddInt'#3#0#0#0#1'A'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#1'B'#0#0 + +#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0#17'TBinaryArgsResult'#0#0 + +#0#0#0#0#0#3#0#0#0#6'DivInt'#3#0#0#0#1'A'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0 + +#0#0#1'B'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0#7'Integer'#0 + +#0#0#0#0#0#0#3#0#0#0#15'DoAllOperations'#3#0#0#0#1'A'#0#0#0#7'Integer'#0#0#0 + +#0#0#0#0#1#0#0#0#1'B'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0 + +#22'TBinaryArgsResultArray'#0#0#0#0#0#0#0#3#0#0#0#11'DoOperation'#4#0#0#0#1 + +'A'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#1'B'#0#0#0#7'Integer'#0#0#0#0#0#0 + +#0#1#0#0#0#10'AOperation'#0#0#0#8'TCalc_Op'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0 + +#0#0#17'TBinaryArgsResult'#0#0#0#0#0#0#0#3 +]); diff --git a/wst/tags/3.1/tests/calculator/gui_client/calculator.wst_meta b/wst/tags/3.1/tests/calculator/gui_client/calculator.wst_meta new file mode 100644 index 000000000..b4a0cfa80 Binary files /dev/null and b/wst/tags/3.1/tests/calculator/gui_client/calculator.wst_meta differ diff --git a/wst/tags/3.1/tests/calculator/gui_client/calculator_proxy.pas b/wst/tags/3.1/tests/calculator/gui_client/calculator_proxy.pas new file mode 100644 index 000000000..7668378b8 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/gui_client/calculator_proxy.pas @@ -0,0 +1,164 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "calculator". + This unit name : "calculator_proxy". + Date : "30/07/2006 01:54". +} +Unit calculator_proxy; +{$mode objfpc}{$H+} +Interface + +Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, calculator; + +Type + + + TCalculator_Proxy=class(TBaseProxy,ICalculator) + Protected + class function GetServiceType() : PTypeInfo;override; + function AddInt( + Const A : Integer; + Const B : Integer + ):TBinaryArgsResult; + function DivInt( + Const A : Integer; + Const B : Integer + ):Integer; + function DoAllOperations( + Const A : Integer; + Const B : Integer + ):TBinaryArgsResultArray; + function DoOperation( + Const A : Integer; + Const B : Integer; + Const AOperation : TCalc_Op + ):TBinaryArgsResult; + End; + +Implementation +uses LResources, metadata_repository; + +{ TCalculator_Proxy implementation } + +class function TCalculator_Proxy.GetServiceType() : PTypeInfo; +begin + result := TypeInfo(ICalculator); +end; + +function TCalculator_Proxy.AddInt( + Const A : Integer; + Const B : Integer +):TBinaryArgsResult; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('AddInt', GetTarget(),(Self as ICallContext)); + locSerializer.Put('A', TypeInfo(Integer), A); + locSerializer.Put('B', TypeInfo(Integer), B); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(Result) := Nil; + strPrmName := 'return'; + locSerializer.Get(TypeInfo(TBinaryArgsResult), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + +function TCalculator_Proxy.DivInt( + Const A : Integer; + Const B : Integer +):Integer; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('DivInt', GetTarget(),(Self as ICallContext)); + locSerializer.Put('A', TypeInfo(Integer), A); + locSerializer.Put('B', TypeInfo(Integer), B); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + strPrmName := 'return'; + locSerializer.Get(TypeInfo(Integer), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + +function TCalculator_Proxy.DoAllOperations( + Const A : Integer; + Const B : Integer +):TBinaryArgsResultArray; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('DoAllOperations', GetTarget(),(Self as ICallContext)); + locSerializer.Put('A', TypeInfo(Integer), A); + locSerializer.Put('B', TypeInfo(Integer), B); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(Result) := Nil; + strPrmName := 'return'; + locSerializer.Get(TypeInfo(TBinaryArgsResultArray), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + +function TCalculator_Proxy.DoOperation( + Const A : Integer; + Const B : Integer; + Const AOperation : TCalc_Op +):TBinaryArgsResult; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('DoOperation', GetTarget(),(Self as ICallContext)); + locSerializer.Put('A', TypeInfo(Integer), A); + locSerializer.Put('B', TypeInfo(Integer), B); + locSerializer.Put('AOperation', TypeInfo(TCalc_Op), AOperation); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(Result) := Nil; + strPrmName := 'return'; + locSerializer.Get(TypeInfo(TBinaryArgsResult), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + + +initialization + {$i calculator.lrs} + + {$IF DECLARED(Register_calculator_ServiceMetadata)} + Register_calculator_ServiceMetadata(); + {$ENDIF} +End. diff --git a/wst/tags/3.1/tests/calculator/gui_client/main_unit.lfm b/wst/tags/3.1/tests/calculator/gui_client/main_unit.lfm new file mode 100644 index 000000000..d5e7328f9 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/gui_client/main_unit.lfm @@ -0,0 +1,126 @@ +object fmain: Tfmain + Left = 269 + Height = 300 + Top = 234 + Width = 528 + HorzScrollBar.Page = 527 + VertScrollBar.Page = 299 + ActiveControl = edtA + Caption = '"calculator" service test' + OnCreate = FormCreate + object Label1: TLabel + Left = 16 + Height = 14 + Top = 48 + Width = 49 + Caption = 'Param "A"' + Color = clNone + ParentColor = False + end + object Label2: TLabel + Left = 17 + Height = 14 + Top = 80 + Width = 48 + Caption = 'Param "B"' + Color = clNone + ParentColor = False + end + object Label3: TLabel + Left = 240 + Height = 14 + Top = 52 + Width = 35 + Caption = 'Format' + Color = clNone + ParentColor = False + end + object Label4: TLabel + Left = 16 + Height = 14 + Top = 8 + Width = 40 + Caption = 'Address' + Color = clNone + ParentColor = False + end + object edtA: TEdit + Left = 80 + Height = 23 + Top = 48 + Width = 80 + TabOrder = 0 + Text = '5' + end + object edtB: TEdit + Left = 80 + Height = 23 + Top = 80 + Width = 80 + TabOrder = 1 + Text = '2' + end + object btnExec: TButton + Left = 384 + Height = 25 + Top = 8 + Width = 128 + BorderSpacing.InnerBorder = 4 + Caption = 'Execute' + OnClick = btnExecClick + TabOrder = 2 + end + object mmoLog: TMemo + Height = 180 + Top = 120 + Width = 528 + Align = alBottom + Anchors = [akTop, akLeft, akRight, akBottom] + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -19 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Lines.Strings = ( + '' + ) + ScrollBars = ssBoth + TabOrder = 3 + end + object edtFormat: TEdit + Left = 288 + Height = 23 + Top = 50 + Width = 80 + TabOrder = 4 + Text = 'SOAP' + end + object btnInit: TButton + Left = 384 + Height = 25 + Top = 48 + Width = 75 + BorderSpacing.InnerBorder = 4 + Caption = 'Init Obj' + OnClick = btnInitClick + TabOrder = 5 + end + object btnClearLog: TButton + Left = 384 + Height = 25 + Top = 80 + Width = 75 + BorderSpacing.InnerBorder = 4 + Caption = 'Clear Log' + OnClick = btnClearLogClick + TabOrder = 6 + end + object edtAddress: TEdit + Left = 80 + Height = 23 + Top = 11 + Width = 288 + TabOrder = 7 + Text = 'http:Address=http://127.0.0.1:8000/services/ICalculator' + end +end diff --git a/wst/tags/3.1/tests/calculator/gui_client/main_unit.lrs b/wst/tags/3.1/tests/calculator/gui_client/main_unit.lrs new file mode 100644 index 000000000..105e44e92 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/gui_client/main_unit.lrs @@ -0,0 +1,34 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('Tfmain','FORMDATA',[ + 'TPF0'#6'Tfmain'#5'fmain'#4'Left'#3#13#1#6'Height'#3','#1#3'Top'#3#234#0#5'Wi' + +'dth'#3#16#2#18'HorzScrollBar.Page'#3#15#2#18'VertScrollBar.Page'#3'+'#1#13 + +'ActiveControl'#7#4'edtA'#7'Caption'#6#25'"calculator" service test'#8'OnCre' + +'ate'#7#10'FormCreate'#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#14#3'T' + +'op'#2'0'#5'Width'#2'1'#7'Caption'#6#9'Param "A"'#5'Color'#7#6'clNone'#11'Pa' + +'rentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#17#6'Height'#2#14#3'Top'#2'P' + +#5'Width'#2'0'#7'Caption'#6#9'Param "B"'#5'Color'#7#6'clNone'#11'ParentColor' + +#8#0#0#6'TLabel'#6'Label3'#4'Left'#3#240#0#6'Height'#2#14#3'Top'#2'4'#5'Widt' + +'h'#2'#'#7'Caption'#6#6'Format'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6 + +'TLabel'#6'Label4'#4'Left'#2#16#6'Height'#2#14#3'Top'#2#8#5'Width'#2'('#7'Ca' + +'ption'#6#7'Address'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#5'TEdit'#4'e' + +'dtA'#4'Left'#2'P'#6'Height'#2#23#3'Top'#2'0'#5'Width'#2'P'#8'TabOrder'#2#0#4 + +'Text'#6#1'5'#0#0#5'TEdit'#4'edtB'#4'Left'#2'P'#6'Height'#2#23#3'Top'#2'P'#5 + +'Width'#2'P'#8'TabOrder'#2#1#4'Text'#6#1'2'#0#0#7'TButton'#7'btnExec'#4'Left' + +#3#128#1#6'Height'#2#25#3'Top'#2#8#5'Width'#3#128#0#25'BorderSpacing.InnerBo' + +'rder'#2#4#7'Caption'#6#7'Execute'#7'OnClick'#7#12'btnExecClick'#8'TabOrder' + +#2#2#0#0#5'TMemo'#6'mmoLog'#6'Height'#3#180#0#3'Top'#2'x'#5'Width'#3#16#2#5 + +'Align'#7#8'alBottom'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom' + +#0#12'Font.CharSet'#7#12'ANSI_CHARSET'#10'Font.Color'#7#7'clBlack'#11'Font.H' + +'eight'#2#237#9'Font.Name'#6#11'Courier New'#10'Font.Pitch'#7#7'fpFixed'#13 + +'Lines.Strings'#1#6#0#0#10'ScrollBars'#7#6'ssBoth'#8'TabOrder'#2#3#0#0#5'TEd' + +'it'#9'edtFormat'#4'Left'#3' '#1#6'Height'#2#23#3'Top'#2'2'#5'Width'#2'P'#8 + +'TabOrder'#2#4#4'Text'#6#4'SOAP'#0#0#7'TButton'#7'btnInit'#4'Left'#3#128#1#6 + +'Height'#2#25#3'Top'#2'0'#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#7 + +'Caption'#6#8'Init Obj'#7'OnClick'#7#12'btnInitClick'#8'TabOrder'#2#5#0#0#7 + +'TButton'#11'btnClearLog'#4'Left'#3#128#1#6'Height'#2#25#3'Top'#2'P'#5'Width' + +#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#9'Clear Log'#7'OnClick' + +#7#16'btnClearLogClick'#8'TabOrder'#2#6#0#0#5'TEdit'#10'edtAddress'#4'Left'#2 + +'P'#6'Height'#2#23#3'Top'#2#11#5'Width'#3' '#1#8'TabOrder'#2#7#4'Text'#6'7ht' + +'tp:Address=http://127.0.0.1:8000/services/ICalculator'#0#0#0 +]); diff --git a/wst/tags/3.1/tests/calculator/gui_client/main_unit.pas b/wst/tags/3.1/tests/calculator/gui_client/main_unit.pas new file mode 100644 index 000000000..b970c9ac8 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/gui_client/main_unit.pas @@ -0,0 +1,144 @@ +unit main_unit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + Buttons, calculator, calculator_proxy; + +type + + { Tfmain } + + Tfmain = class(TForm) + btnExec: TButton; + btnInit: TButton; + btnClearLog: TButton; + edtAddress: TEdit; + edtFormat: TEdit; + edtA: TEdit; + edtB: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + mmoLog: TMemo; + procedure btnClearLogClick(Sender: TObject); + procedure btnExecClick(Sender: TObject); + procedure btnInitClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + FObj : ICalculator; + procedure LogMsg(const AMsg : string); + public + end; + +var + fmain: Tfmain; + +implementation +uses TypInfo, base_service_intf, soap_formatter, binary_formatter, + ics_tcp_protocol, ics_http_protocol, + //synapse_http_protocol, + service_intf; + +{ Tfmain } + +procedure Tfmain.btnExecClick(Sender: TObject); +Var + a, b, k : Integer; + rk : TBinaryArgsResult; + vA : TBinaryArgsResultArray; + ch : TCalcHeader; + rch : TCalcResultHeader; + hdrs : ICallContext; +begin + try + if not Assigned(FObj) then + FObj := TCalculator_Proxy.Create( + 'Calculator', // Target + edtFormat.Text,//'SOAP',//'binary', // Protocol Data + edtAddress.Text + //'http:Address=http://127.0.0.1:8000/services/ICalculator' + //'TCP:Address=127.0.0.1;Port=1234;target=ICalculator' + );//'TCP:Address=127.0.0.1;Port=1234;target=ICalculator' + + ch := TCalcHeader.Create(); + ch.mustUnderstand := 0; + ch.Login := 'azerty'; + ch.Password := 'qwerty'; + ch.WantedPrecision := 121076; + hdrs := FObj as ICallContext; + hdrs.AddHeader(ch,true); + ch := TCalcHeader.Create(); + ch.Login := 'azerty'; + ch.Password := ''; + ch.WantedPrecision := 321654; + hdrs.AddHeader(ch,true); + ch := nil; + rk := Nil; + vA := Nil; + a := StrToInt(edtA.Text); + b := StrToInt(edtB.Text); + Try + rk := FObj.AddInt(a,b); + hdrs.ClearHeaders(hdOut); + LogMsg(Format('Header Count = %d',[hdrs.GetHeaderCount(AllHeaderDirection)])); + if ( hdrs.GetHeaderCount(AllHeaderDirection) > 0 ) then begin + LogMsg(Format('Header(0) Class = %s',[hdrs.GetHeader(0).ClassName])); + if hdrs.GetHeader(0).InheritsFrom(TCalcResultHeader) then begin + rch := hdrs.GetHeader(0) as TCalcResultHeader; + LogMsg(Format('Header(0) Dir = %d; TimeStamp = %s; SessionID = %s; Login =%s; Password = %s',[Ord(rch.Direction),rch.TimeStamp,rch.SessionID,rch.Login,rch.Password])); + end; + end; + LogMsg(Format(' ( %d %s %d ) = %d; Comment = %s',[rk.Arg_A, rk.Arg_OP, rk.Arg_B, rk.Arg_R,rk.Comment])); + + + rk := FObj.DoOperation(a,b,coSub); + LogMsg(Format(' ( %d %s %d ) = %d; Comment = %s',[rk.Arg_A, rk.Arg_OP, rk.Arg_B, rk.Arg_R,rk.Comment])); + + vA := FObj.DoAllOperations(a,b); + For k := 0 To Pred(vA.Length) Do + LogMsg(Format(' ( %d %s %d ) = %d; OP=%s; Comment = %s',[vA[k].Arg_A, vA[k].Arg_OP, vA[k].Arg_B, vA[k].Arg_R,GetEnumName(TypeInfo(TCalc_Op),Ord(vA[k].Arg_OpEnum)),vA[k].Comment])); + Finally + FreeAndNil(rk); + FreeAndNil(vA); + End; + except + on e : Exception do + ShowMessage(e.Message); + end; +end; + +procedure Tfmain.btnClearLogClick(Sender: TObject); +begin + mmoLog.Clear(); +end; + +procedure Tfmain.btnInitClick(Sender: TObject); +begin + FObj := Nil; +end; + +procedure Tfmain.FormCreate(Sender: TObject); +begin + FObj := Nil; + //ICS_RegisterTCP_Transport(); + ICS_RegisterHTTP_Transport(); + //SYNAPSE_RegisterHTTP_Transport(); +end; + +procedure Tfmain.LogMsg(const AMsg: string); +begin + mmoLog.Lines.Add(AMsg); +end; + +initialization + {$I main_unit.lrs} + + RegisterStdTypes(); + +end. + diff --git a/wst/tags/3.1/tests/calculator/gui_client/test_calc.lpi b/wst/tags/3.1/tests/calculator/gui_client/test_calc.lpi new file mode 100644 index 000000000..00f69a425 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/gui_client/test_calc.lpi @@ -0,0 +1,369 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/calculator/gui_client/test_calc.lpr b/wst/tags/3.1/tests/calculator/gui_client/test_calc.lpr new file mode 100644 index 000000000..62c5c8912 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/gui_client/test_calc.lpr @@ -0,0 +1,18 @@ +program test_calc; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, main_unit, calculator, calculator_proxy; + +begin + Application.Initialize; + Application.CreateForm(Tfmain, fmain); + Application.Run; +end. + diff --git a/wst/tags/3.1/tests/calculator/srv/calculator.lrs b/wst/tags/3.1/tests/calculator/srv/calculator.lrs new file mode 100644 index 000000000..7fc82fd05 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/srv/calculator.lrs @@ -0,0 +1,13 @@ +LazarusResources.Add('CALCULATOR','wst_meta',[ + #0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#10'calculator'#1#0#0#0#11'ICalculator'#4 + +#0#0#0#6'AddInt'#3#0#0#0#1'A'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#1'B'#0#0 + +#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0#17'TBinaryArgsResult'#0#0 + +#0#0#0#0#0#3#0#0#0#6'DivInt'#3#0#0#0#1'A'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0 + +#0#0#1'B'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0#7'Integer'#0 + +#0#0#0#0#0#0#3#0#0#0#15'DoAllOperations'#3#0#0#0#1'A'#0#0#0#7'Integer'#0#0#0 + +#0#0#0#0#1#0#0#0#1'B'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0#0 + +#22'TBinaryArgsResultArray'#0#0#0#0#0#0#0#3#0#0#0#11'DoOperation'#4#0#0#0#1 + +'A'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#1'B'#0#0#0#7'Integer'#0#0#0#0#0#0 + +#0#1#0#0#0#10'AOperation'#0#0#0#8'TCalc_Op'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0 + +#0#0#17'TBinaryArgsResult'#0#0#0#0#0#0#0#3 +]); diff --git a/wst/tags/3.1/tests/calculator/srv/calculator_binder.pas b/wst/tags/3.1/tests/calculator/srv/calculator_binder.pas new file mode 100644 index 000000000..62119c5cc --- /dev/null +++ b/wst/tags/3.1/tests/calculator/srv/calculator_binder.pas @@ -0,0 +1,207 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "calculator". + This unit name : "calculator_binder". + Date : "30/07/2006 01:52". +} +unit calculator_binder; +{$mode objfpc}{$H+} +interface + +uses SysUtils, Classes, base_service_intf, server_service_intf, calculator; + +type + + + TCalculator_ServiceBinder=class(TBaseServiceBinder) + Protected + procedure AddIntHandler(AFormatter:IFormatterResponse); + procedure DivIntHandler(AFormatter:IFormatterResponse); + procedure DoAllOperationsHandler(AFormatter:IFormatterResponse); + procedure DoOperationHandler(AFormatter:IFormatterResponse); + Public + constructor Create(); + End; + + TCalculator_ServiceBinderFactory = class(TInterfacedObject,IItemFactory) + protected + function CreateInstance():IInterface; + End; + + procedure Server_service_RegisterCalculatorService(); + +Implementation +uses TypInfo, LResources,metadata_repository; + +{ TCalculator_ServiceBinder implementation } +procedure TCalculator_ServiceBinder.AddIntHandler(AFormatter:IFormatterResponse); +Var + cllCntrl : ICallControl; + tmpObj : ICalculator; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + A : Integer; + B : Integer; + returnVal : TBinaryArgsResult; +Begin + callCtx := GetCallContext(); + Pointer(returnVal) := Nil; + + strPrmName := 'A'; AFormatter.Get(TypeInfo(Integer),strPrmName,A); + strPrmName := 'B'; AFormatter.Get(TypeInfo(Integer),strPrmName,B); + + tmpObj := Self.GetFactory().CreateInstance() as ICalculator; + if Supports(tmpObj,ICallControl,cllCntrl) then + cllCntrl.SetCallContext(GetCallContext()); + + returnVal := tmpObj.AddInt(A,B); + If Assigned(Pointer(returnVal)) Then + callCtx.AddObjectToFree(TObject(returnVal)); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(TBinaryArgsResult),returnVal); + AFormatter.EndCallResponse(); + + callCtx := Nil; +End; + +procedure TCalculator_ServiceBinder.DivIntHandler(AFormatter:IFormatterResponse); +Var + cllCntrl : ICallControl; + tmpObj : ICalculator; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + A : Integer; + B : Integer; + returnVal : Integer; +Begin + callCtx := GetCallContext(); + + strPrmName := 'A'; AFormatter.Get(TypeInfo(Integer),strPrmName,A); + strPrmName := 'B'; AFormatter.Get(TypeInfo(Integer),strPrmName,B); + + tmpObj := Self.GetFactory().CreateInstance() as ICalculator; + if Supports(tmpObj,ICallControl,cllCntrl) then + cllCntrl.SetCallContext(GetCallContext()); + + returnVal := tmpObj.DivInt(A,B); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(Integer),returnVal); + AFormatter.EndCallResponse(); + + callCtx := Nil; +End; + +procedure TCalculator_ServiceBinder.DoAllOperationsHandler(AFormatter:IFormatterResponse); +Var + cllCntrl : ICallControl; + tmpObj : ICalculator; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + A : Integer; + B : Integer; + returnVal : TBinaryArgsResultArray; +Begin + callCtx := GetCallContext(); + Pointer(returnVal) := Nil; + + strPrmName := 'A'; AFormatter.Get(TypeInfo(Integer),strPrmName,A); + strPrmName := 'B'; AFormatter.Get(TypeInfo(Integer),strPrmName,B); + + tmpObj := Self.GetFactory().CreateInstance() as ICalculator; + if Supports(tmpObj,ICallControl,cllCntrl) then + cllCntrl.SetCallContext(GetCallContext()); + + returnVal := tmpObj.DoAllOperations(A,B); + If Assigned(Pointer(returnVal)) Then + callCtx.AddObjectToFree(TObject(returnVal)); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(TBinaryArgsResultArray),returnVal); + AFormatter.EndCallResponse(); + + callCtx := Nil; +End; + +procedure TCalculator_ServiceBinder.DoOperationHandler(AFormatter:IFormatterResponse); +Var + cllCntrl : ICallControl; + tmpObj : ICalculator; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + A : Integer; + B : Integer; + AOperation : TCalc_Op; + returnVal : TBinaryArgsResult; +Begin + callCtx := GetCallContext(); + Pointer(returnVal) := Nil; + + strPrmName := 'A'; AFormatter.Get(TypeInfo(Integer),strPrmName,A); + strPrmName := 'B'; AFormatter.Get(TypeInfo(Integer),strPrmName,B); + strPrmName := 'AOperation'; AFormatter.Get(TypeInfo(TCalc_Op),strPrmName,AOperation); + + tmpObj := Self.GetFactory().CreateInstance() as ICalculator; + if Supports(tmpObj,ICallControl,cllCntrl) then + cllCntrl.SetCallContext(GetCallContext()); + + returnVal := tmpObj.DoOperation(A,B,AOperation); + If Assigned(Pointer(returnVal)) Then + callCtx.AddObjectToFree(TObject(returnVal)); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(TBinaryArgsResult),returnVal); + AFormatter.EndCallResponse(); + + callCtx := Nil; +End; + + +constructor TCalculator_ServiceBinder.Create(); +Begin + Inherited Create(GetServiceImplementationRegistry().FindFactory('ICalculator')); + RegisterVerbHandler('AddInt',@AddIntHandler); + RegisterVerbHandler('DivInt',@DivIntHandler); + RegisterVerbHandler('DoAllOperations',@DoAllOperationsHandler); + RegisterVerbHandler('DoOperation',@DoOperationHandler); +End; + + +{ TCalculator_ServiceBinderFactory } +function TCalculator_ServiceBinderFactory.CreateInstance():IInterface; +Begin + Result := TCalculator_ServiceBinder.Create() as IInterface; +End; + + +procedure Server_service_RegisterCalculatorService(); +Begin + GetServerServiceRegistry().Register('ICalculator',TCalculator_ServiceBinderFactory.Create() as IItemFactory); +End; + +initialization + + {$IF DECLARED(Register_calculator_NameSpace)} + Register_calculator_NameSpace(); + {$ENDIF} + + {$i calculator.lrs} + +End. diff --git a/wst/tags/3.1/tests/calculator/srv/calculator_imp.pas b/wst/tags/3.1/tests/calculator/srv/calculator_imp.pas new file mode 100644 index 000000000..9f4da2731 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/srv/calculator_imp.pas @@ -0,0 +1,157 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "calculator". + This unit name : "calculator_imp". + Date : "02/07/2006 16:49". +} +Unit calculator_imp; +{$mode objfpc}{$H+} +Interface + +Uses SysUtils, Classes, + base_service_intf, server_service_intf, server_service_imputils, calculator; + +Type + + + TCalculator_ServiceImp=class(TBaseServiceImplementation,ICalculator) + Protected + function AddInt( + Const A : Integer; + Const B : Integer + ):TBinaryArgsResult; + function DivInt( + Const A : Integer; + Const B : Integer + ):Integer; + function DoAllOperations( + Const A : Integer; + Const B : Integer + ):TBinaryArgsResultArray; + function DoOperation( + Const A : Integer; + Const B : Integer; + Const AOperation : TCalc_Op + ):TBinaryArgsResult; + End; + + + procedure RegisterCalculatorImplementationFactory(); + +Implementation + +{ TCalculator_ServiceImp implementation } +function TCalculator_ServiceImp.AddInt( + Const A : Integer; + Const B : Integer +):TBinaryArgsResult; +var + hdr : TCalcResultHeader; + h : TCalcHeader; + cc : ICallContext; +Begin + hdr := TCalcResultHeader.Create(); + cc := GetCallContext(); + if Assigned(cc) and ( cc.GetHeaderCount([hdIn]) > 0 ) and ( cc.GetHeader(0).InheritsFrom(TCalcHeader) ) then begin + h := cc.GetHeader(0) as TCalcHeader; + h.Understood := True; + hdr.Assign(h); + end; + hdr.TimeStamp := DateTimeToStr(Now()); + hdr.SessionID := 'testSession'; + cc.AddHeader(hdr,True); + hdr := nil; + Result := TBinaryArgsResult.Create(); + Try + Result.Arg_OP := '+'; + Result.Arg_OpEnum := coAdd; + Result.Arg_A := A; + Result.Arg_B := B; + Result.Arg_R := A + B; + Result.Comment := 'Doing an + operation'; + Except + FreeAndNil(Result); + Raise; + End; +End; + +function TCalculator_ServiceImp.DivInt( + Const A : Integer; + Const B : Integer +):Integer; +Begin + Result := A div B; +End; + +function TCalculator_ServiceImp.DoAllOperations( + Const A : Integer; + Const B : Integer +):TBinaryArgsResultArray; +Begin + Result := TBinaryArgsResultArray.Create(); + Result.SetLength(4); + With Result[0] do Begin + Arg_A := A; + Arg_B := B; + Arg_OP := '-'; + Arg_OpEnum := coSub; + Arg_R := Arg_A - Arg_B; + End; + With Result[1] do Begin + Arg_A := A; + Arg_B := B; + Arg_OP := '+'; + Arg_OpEnum := coAdd; + Arg_R := Arg_A + Arg_B; + End; + With Result[2] do Begin + Arg_A := A; + Arg_B := B; + Arg_OP := '*'; + Arg_OpEnum := coMul; + Arg_R := Arg_A * Arg_B; + End; + With Result[3] do Begin + Arg_A := A; + Arg_B := B; + Arg_OP := '/'; + Arg_OpEnum := coDiv; + Arg_R := Arg_A div Arg_B; + End; +End; + +function TCalculator_ServiceImp.DoOperation( + Const A : Integer; + Const B : Integer; + Const AOperation : TCalc_Op +):TBinaryArgsResult; +Begin + Result := TBinaryArgsResult.Create(); + try + Result.Arg_A := A; + Result.Arg_B := B; + Result.Arg_OP := 'X'; + Result.Arg_OpEnum := AOperation; + Result.Comment := 'Doing an operation...'; + + case AOperation of + coAdd : Result.Arg_R := Result.Arg_A + Result.Arg_B; + coSub : Result.Arg_R := Result.Arg_A - Result.Arg_B; + coMul : Result.Arg_R := Result.Arg_A * Result.Arg_B; + coDiv : Result.Arg_R := Result.Arg_A div Result.Arg_B; + end; + except + FreeAndNil(Result); + raise; + end; +End; + +procedure RegisterCalculatorImplementationFactory(); +Begin + GetServiceImplementationRegistry().Register( + 'ICalculator', + TImplementationFactory.Create(TCalculator_ServiceImp) as IServiceImplementationFactory + ).RegisterExtension(['TLoggerServiceExtension']); +End; + +End. diff --git a/wst/tags/3.1/tests/calculator/srv/logger_extension.pas b/wst/tags/3.1/tests/calculator/srv/logger_extension.pas new file mode 100644 index 000000000..c5fc91108 --- /dev/null +++ b/wst/tags/3.1/tests/calculator/srv/logger_extension.pas @@ -0,0 +1,81 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} +unit logger_extension; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, base_service_intf, server_service_intf; + +type + + { TLoggerServiceExtension } + + TLoggerServiceExtension = class(TSimpleFactoryItem,IServiceExtension) + private + procedure TraceMessage(const AMsg : string); + protected + procedure ProcessMessage( + const AMessageStage : TMessageStage; + ACallContext : ICallContext; + AMsgData : IInterface + { The "AMsgData" parameter actual type depends on the message state + on correspond to : + - IRequestBuffer on "msBeforeDeserialize" and "msAfterSerialize" + - IFormatterResponse on "msAfterDeserialize", "msBeforeSerialize" + } + ); + end; + +implementation +uses TypInfo; + +{ TLoggerServiceExtension } + +procedure TLoggerServiceExtension.TraceMessage(const AMsg: string); +begin + WriteLn(AMsg); +end; + +procedure TLoggerServiceExtension.ProcessMessage( + const AMessageStage: TMessageStage; + ACallContext: ICallContext; + AMsgData: IInterface +); +var + s : string; + rqb : IRequestBuffer; + frmtr : IFormatterResponse; +begin + s := GetEnumName(TypeInfo(TMessageStage),Ord(AMessageStage)); + case AMessageStage of + msBeforeDeserialize, msAfterSerialize : + begin + rqb := AMsgData as IRequestBuffer; + s := Format('Called service : "%s"; Processing stage : "%s"',[rqb.GetTargetService(),s]); + end; + msAfterDeserialize, msBeforeSerialize : + begin + frmtr := AMsgData as IFormatterResponse; + s := Format('Called service : "%s"; Target Operation = "%s"; Processing stage : "%s"',[frmtr.GetCallTarget(),frmtr.GetCallProcedureName(),s]); + end; + end; + TraceMessage(s); +end; + +initialization + GetServiceExtensionRegistry().Register('TLoggerServiceExtension',TSimpleItemFactory.Create(TLoggerServiceExtension) as IItemFactory); + +end. diff --git a/wst/tags/3.1/tests/ebay/ebay.lrs b/wst/tags/3.1/tests/ebay/ebay.lrs new file mode 100644 index 000000000..94084df70 --- /dev/null +++ b/wst/tags/3.1/tests/ebay/ebay.lrs @@ -0,0 +1,9 @@ +LazarusResources.Add('EBAY','wst_meta',[ + #0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#4'ebay'#1#0#0#0#24'IeBayAPIInterfaceSer' + +'vice'#2#0#0#0#13'GetCategories'#2#0#0#0#20'GetCategoriesRequest'#0#0#0#25'T' + +'GetCategoriesRequestType'#0#0#0#0#0#0#0#1#0#0#0#21'GetCategoriesResponse'#0 + +#0#0#26'TGetCategoriesResponseType'#0#0#0#0#0#0#0#3#0#0#0#18'GetPopularKeywo' + +'rds'#2#0#0#0#25'GetPopularKeywordsRequest'#0#0#0#30'TGetPopularKeywordsRequ' + +'estType'#0#0#0#0#0#0#0#1#0#0#0#26'GetPopularKeywordsResponse'#0#0#0#31'TGet' + +'PopularKeywordsResponseType'#0#0#0#0#0#0#0#3 +]); diff --git a/wst/tags/3.1/tests/ebay/ebay.pas b/wst/tags/3.1/tests/ebay/ebay.pas new file mode 100644 index 000000000..b435b966f --- /dev/null +++ b/wst/tags/3.1/tests/ebay/ebay.pas @@ -0,0 +1,562 @@ +unit ebay; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, base_service_intf; + +const + sAPP_ID = ''; + sEBAY_VERSION = '467'; + +type + + TAckCodeType = ( Success, Failure, Warning, PartialFailure, CustomCode ); + +{ TErrorType = class(TBaseComplexRemotable) + published + property ShortMessage : string read FShortMessage write FShortMessage stored HasShortMessage; + property LongMessage : string read FLongMessage write FLongMessage stored HasLongMessage; + end; +} + + { TPaginationType } + + TPaginationType = class(TBaseComplexRemotable) + private + FEntriesPerPage: Integer; + FPageNumber: Integer; + function HasEntriesPerPage: boolean; + function HasPageNumber: boolean; + published + property EntriesPerPage : Integer read FEntriesPerPage write FEntriesPerPage stored HasEntriesPerPage; + property PageNumber : Integer read FPageNumber write FPageNumber stored HasPageNumber; + end; + + { TPaginationResultType } + + TPaginationResultType = class(TBaseComplexRemotable) + private + FTotalNumberOfEntries: Integer; + FTotalNumberOfPages: Integer; + function HasTotalNumberOfEntries: boolean; + function HasTotalNumberOfPages: boolean; + published + property TotalNumberOfPages : Integer read FTotalNumberOfPages write FTotalNumberOfPages stored HasTotalNumberOfPages; + property TotalNumberOfEntries : Integer read FTotalNumberOfEntries write FTotalNumberOfEntries stored HasTotalNumberOfEntries; + end; + + { TCategoryType } + + TCategoryType = class(TBaseComplexRemotable) + private + FAutoPayEnabled: Boolean; + FB2BVATEnabled: Boolean; + FBestOfferEnabled: Boolean; + FCatalogEnabled: Boolean; + FCategoryID: string; + FCategoryLevel: Integer; + FCategoryName: string; + FCategoryParentID: string; + FCategoryParentName: string; + FKeywords: string; + FProductFinderAvailable: Boolean; + FProductFinderID: Integer; + FProductSearchPageAvailable: Boolean; + function HasCategoryID: boolean; + function HasCategoryLevel: boolean; + function HasCategoryName: boolean; + function HasCategoryParentID: boolean; + function HasCategoryParentName: boolean; + function HasKeywords: boolean; + function HasProductFinderID: boolean; + published + property BestOfferEnabled : Boolean read FBestOfferEnabled write FBestOfferEnabled stored FBestOfferEnabled; + property AutoPayEnabled : Boolean read FAutoPayEnabled write FAutoPayEnabled stored FAutoPayEnabled; + property B2BVATEnabled : Boolean read FB2BVATEnabled write FB2BVATEnabled stored FB2BVATEnabled; + property CatalogEnabled : Boolean read FCatalogEnabled write FCatalogEnabled stored FCatalogEnabled; + property CategoryID : string read FCategoryID write FCategoryID stored HasCategoryID; + property CategoryLevel : Integer read FCategoryLevel write FCategoryLevel stored HasCategoryLevel; + property CategoryName : string read FCategoryName write FCategoryName stored HasCategoryName; + property CategoryParentID : string read FCategoryParentID write FCategoryParentID stored HasCategoryParentID; + property CategoryParentName : string read FCategoryParentName write FCategoryParentName stored HasCategoryParentName; + property ProductFinderID : Integer read FProductFinderID write FProductFinderID stored HasProductFinderID; + property ProductSearchPageAvailable : Boolean read FProductSearchPageAvailable write FProductSearchPageAvailable stored FProductSearchPageAvailable; + property ProductFinderAvailable : Boolean read FProductFinderAvailable write FProductFinderAvailable stored FProductFinderAvailable; + property Keywords : string read FKeywords write FKeywords stored HasKeywords; + end; + + { TCategoryArrayType } + + TCategoryArrayType = class(TBaseObjectArrayRemotable) + private + function GetCategoryItem(AIndex: Integer): TCategoryType; + public + class function GetItemClass():TBaseRemotableClass;override; + property Item[AIndex:Integer] : TCategoryType read GetCategoryItem; + property Category[AIndex:Integer] : TCategoryType read GetCategoryItem;default; + end; + + { TUserIdPasswordType } + + TUserIdPasswordType = class(TBaseComplexRemotable) + private + FAppId: string; + FAuthCert: string; + FDevId: string; + FPassword: string; + FUsername: string; + function HasAppId: boolean; + function HasAuthCert: boolean; + function HasDevId: boolean; + function HasPassword: boolean; + function HasUsername: boolean; + published + property AppId : string read FAppId write FAppId stored HasAppId; + property DevId : string read FDevId write FDevId stored HasDevId; + property AuthCert : string read FAuthCert write FAuthCert stored HasAuthCert; + property Username : string read FUsername write FUsername stored HasUsername; + property Password : string read FPassword write FPassword stored HasPassword; + end; + + { TCustomSecurityHeaderType } + + TCustomSecurityHeaderType = class(THeaderBlock) + private + FCredentials: TUserIdPasswordType; + FeBayAuthToken: string; + public + constructor Create();override; + destructor Destroy();override; + published + property eBayAuthToken : string read FeBayAuthToken write FeBayAuthToken; + property Credentials : TUserIdPasswordType read FCredentials write FCredentials; + end; + + { TAbstractRequestType } + + TAbstractRequestType = class(TBaseComplexRemotable) + private + FVersion: string; + published + property Version : string read FVersion write FVersion; + end; + + { TAbstractResponseType } + + TAbstractResponseType = class(TBaseComplexRemotable) + private + FAck: TAckCodeType; + FCorrelationID: string; + FMessage: string; + FVersion: string; + function HasAck: boolean; + function HasCorrelationID: boolean; + function HasMessage: boolean; + function HasVersion: boolean; + published + property CorrelationID : string read FCorrelationID write FCorrelationID stored HasCorrelationID; + property Message : string read FMessage write FMessage stored HasMessage; + property Version : string read FVersion write FVersion stored HasVersion; + property Ack : TAckCodeType read FAck write FAck stored HasAck; + end; + + { TGetCategoriesRequestType } + + TGetCategoriesRequestType = class(TAbstractRequestType) + private + FCategorySiteID: string; + function HasCategorySiteID: boolean; + published + property CategorySiteID : string read FCategorySiteID write FCategorySiteID stored HasCategorySiteID; + end; + + { TGetCategoriesResponseType } + + TGetCategoriesResponseType = class(TAbstractResponseType) + private + FCategoryCount: Integer; + FCategoryVersion: string; + FMinimumReservePrice: Double; + FReservePriceAllowed: Boolean; + function HasCategoryCount: boolean; + function HasCategoryVersion: boolean; + function HasMinimumReservePrice: boolean; + function HasReservePriceAllowed: boolean; + published + property CategoryCount : Integer read FCategoryCount write FCategoryCount stored HasCategoryCount; + property CategoryVersion : string read FCategoryVersion write FCategoryVersion stored HasCategoryVersion; + property ReservePriceAllowed : Boolean read FReservePriceAllowed write FReservePriceAllowed stored HasReservePriceAllowed; + property MinimumReservePrice : Double read FMinimumReservePrice write FMinimumReservePrice stored HasMinimumReservePrice; + end; + + { TGetPopularKeywordsRequestType } + + TGetPopularKeywordsRequestType = class(TAbstractRequestType) + private + FCategoryID: string; + FIncludeChildCategories: Boolean; + FMaxKeywordsRetrieved: Integer; + FPagination: TPaginationType; + function HasCategoryID: boolean; + function HasIncludeChildCategories: boolean; + function HasMaxKeywordsRetrieved: boolean; + function HasPagination: boolean; + public + constructor Create();override; + destructor Destroy();override; + published + property CategoryID : string read FCategoryID write FCategoryID stored HasCategoryID; + property IncludeChildCategories : Boolean read FIncludeChildCategories write FIncludeChildCategories stored HasIncludeChildCategories; + property MaxKeywordsRetrieved : Integer read FMaxKeywordsRetrieved write FMaxKeywordsRetrieved stored HasMaxKeywordsRetrieved; + property Pagination : TPaginationType read FPagination write FPagination stored HasPagination; + end; + + { TGetPopularKeywordsResponseType } + + TGetPopularKeywordsResponseType = class(TAbstractResponseType) + private + FCategoryArray: TCategoryArrayType; + FHasMore: Boolean; + FPaginationResult: TPaginationResultType; + function HasCategoryArray: boolean; + function HasPaginationResult: boolean; + procedure SetCategoryArray(const AValue: TCategoryArrayType); + procedure SetPaginationResult(const AValue: TPaginationResultType); + public + constructor Create();override; + destructor Destroy();override; + published + property HasMore : Boolean read FHasMore write FHasMore stored FHasMore; + property CategoryArray : TCategoryArrayType read FCategoryArray write SetCategoryArray stored HasCategoryArray; + property PaginationResult : TPaginationResultType read FPaginationResult write SetPaginationResult stored HasPaginationResult; + end; + + IeBayAPIInterfaceService = interface + {function GetCategories(GetCategoriesRequest : TGetCategoriesRequestType ) : TGetCategoriesResponseType;} + procedure GetCategories( + const GetCategoriesRequest : TGetCategoriesRequestType; + out GetCategoriesResponse : TGetCategoriesResponseType + ); + procedure GetPopularKeywords( + const GetPopularKeywordsRequest : TGetPopularKeywordsRequestType; + out GetPopularKeywordsResponse : TGetPopularKeywordsResponseType + ); + end; + + procedure Register_ebay_ServiceMetadata(); + +implementation +uses imp_utils, metadata_repository; + +const + sE_BAY_API_VERSION = 'Version 467'; + sE_BAY_NAME_SPACE = 'urn:ebay:apis:eBLBaseComponents'; + +{ TAbstractResponseType } + +function TAbstractResponseType.HasCorrelationID: boolean; +begin + Result := not IsStrEmpty(FCorrelationID); +end; + +function TAbstractResponseType.HasAck: boolean; +begin + Result := FAck > Success; +end; + +function TAbstractResponseType.HasMessage: boolean; +begin + Result := not IsStrEmpty(FMessage); +end; + +function TAbstractResponseType.HasVersion: boolean; +begin + Result := not IsStrEmpty(FVersion); +end; + +{ TGetCategoriesRequestType } + +function TGetCategoriesRequestType.HasCategorySiteID: boolean; +begin + Result := not IsStrEmpty(FCategorySiteID); +end; + +{ TGetCategoriesResponseType } + +function TGetCategoriesResponseType.HasCategoryCount: boolean; +begin + Result := ( FCategoryCount > 0 ); +end; + +function TGetCategoriesResponseType.HasCategoryVersion: boolean; +begin + Result := not IsStrEmpty(FCategoryVersion); +end; + +function TGetCategoriesResponseType.HasMinimumReservePrice: boolean; +begin + Result := ( MinimumReservePrice <> 0 ); +end; + +function TGetCategoriesResponseType.HasReservePriceAllowed: boolean; +begin + Result := FReservePriceAllowed; +end; + +{ TUserIdPasswordType } + +function TUserIdPasswordType.HasAppId: boolean; +begin + Result := not IsStrEmpty(FAppId); +end; + +function TUserIdPasswordType.HasAuthCert: boolean; +begin + Result := not IsStrEmpty(FAuthCert); +end; + +function TUserIdPasswordType.HasDevId: boolean; +begin + Result := not IsStrEmpty(FDevId); +end; + +function TUserIdPasswordType.HasPassword: boolean; +begin + Result := not IsStrEmpty(FPassword); +end; + +function TUserIdPasswordType.HasUsername: boolean; +begin + Result := not IsStrEmpty(FUsername); +end; + +{ TCustomSecurityHeaderType } + +constructor TCustomSecurityHeaderType.Create(); +begin + inherited Create(); + FCredentials := TUserIdPasswordType.Create(); +end; + +destructor TCustomSecurityHeaderType.Destroy(); +begin + FreeAndNil(FCredentials); + inherited Destroy(); +end; + +{ TPaginationType } + +function TPaginationType.HasEntriesPerPage: boolean; +begin + Result := HasEntriesPerPage; +end; + +function TPaginationType.HasPageNumber: boolean; +begin + Result := ( FPageNumber <> 0 ); +end; + +{ TGetPopularKeywordsRequestType } + +function TGetPopularKeywordsRequestType.HasCategoryID: boolean; +begin + Result := not IsStrEmpty(FCategoryID); +end; + +function TGetPopularKeywordsRequestType.HasIncludeChildCategories: boolean; +begin + Result := IncludeChildCategories; +end; + +function TGetPopularKeywordsRequestType.HasMaxKeywordsRetrieved: boolean; +begin + Result := ( MaxKeywordsRetrieved <> 0 ); +end; + +function TGetPopularKeywordsRequestType.HasPagination: boolean; +begin + Result := Assigned(FPagination) and + ( FPagination.HasEntriesPerPage or FPagination.HasPageNumber); +end; + +constructor TGetPopularKeywordsRequestType.Create(); +begin + inherited Create(); +end; + +destructor TGetPopularKeywordsRequestType.Destroy(); +begin + FreeAndNil(FPagination); + inherited Destroy(); +end; + +{ TCategoryType } + +function TCategoryType.HasCategoryID: boolean; +begin + Result := not IsStrEmpty(FCategoryID); +end; + +function TCategoryType.HasCategoryLevel: boolean; +begin + Result := ( FCategoryLevel <> 0 ); +end; + +function TCategoryType.HasCategoryName: boolean; +begin + Result := not IsStrEmpty(FCategoryName); +end; + +function TCategoryType.HasCategoryParentID: boolean; +begin + Result := not IsStrEmpty(FCategoryParentID); +end; + +function TCategoryType.HasCategoryParentName: boolean; +begin + Result := not IsStrEmpty(FCategoryParentName); +end; + +function TCategoryType.HasKeywords: boolean; +begin + Result := not IsStrEmpty(FKeywords); +end; + +function TCategoryType.HasProductFinderID: boolean; +begin + Result := ( FProductFinderID > 0 ); +end; + +{ TCategoryArrayType } + +function TCategoryArrayType.GetCategoryItem(AIndex: Integer): TCategoryType; +begin + Result := inherited GetItem(AIndex) as TCategoryType; +end; + +class function TCategoryArrayType.GetItemClass(): TBaseRemotableClass; +begin + Result := TCategoryType; +end; + +{ TGetPopularKeywordsResponseType } + +function TGetPopularKeywordsResponseType.HasCategoryArray: boolean; +begin + Result := ( FCategoryArray.Length > 0 ); +end; + +function TGetPopularKeywordsResponseType.HasPaginationResult: boolean; +begin + Result := ( FPaginationResult.TotalNumberOfEntries <> 0 ) or + ( FPaginationResult.TotalNumberOfPages <> 0 ) ; +end; + +procedure TGetPopularKeywordsResponseType.SetCategoryArray( + const AValue: TCategoryArrayType +); +begin + if ( FCategoryArray = AValue ) then + exit; + FCategoryArray.Assign(AValue) ; +end; + +procedure TGetPopularKeywordsResponseType.SetPaginationResult( + const AValue: TPaginationResultType +); +begin + if ( FPaginationResult = AValue ) then + exit; + FPaginationResult.Assign(AValue); +end; + +constructor TGetPopularKeywordsResponseType.Create(); +begin + FCategoryArray := TCategoryArrayType.Create(); + FPaginationResult := TPaginationResultType.Create(); + inherited Create(); +end; + +destructor TGetPopularKeywordsResponseType.Destroy(); +begin + FreeAndNil(FPaginationResult); + FreeAndNil(FCategoryArray); + inherited Destroy(); +end; + +procedure RegisterEbayTypes(); +Var + r : TTypeRegistry; + ri : TTypeRegistryItem; +begin + r := GetTypeRegistry(); + + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TAckCodeType),'AckCodeType'); + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TCategoryType),'CategoryType'); + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TCategoryArrayType),'CategoryArrayType'); + + + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TPaginationType),'PaginationType'); + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TPaginationResultType),'PaginationResultType'); + + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TGetPopularKeywordsRequestType),'GetPopularKeywordsRequestType'); + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TGetPopularKeywordsResponseType),'GetPopularKeywordsResponseType'); + + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TUserIdPasswordType),'UserIdPasswordType'); + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TCustomSecurityHeaderType),'RequesterCredentials');//'CustomSecurityHeaderType'); + + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TGetCategoriesRequestType),'GetCategoriesRequestType'); + r.Register(sE_BAY_NAME_SPACE,TypeInfo(TGetCategoriesResponseType),'GetCategoriesResponseType'); +end; + +procedure Register_ebay_ServiceMetadata(); +var + mm : IModuleMetadataMngr; +begin + mm := GetModuleMetadataMngr(); + mm.SetOperationCustomData( + 'ebay', + 'IeBayAPIInterfaceService', + 'GetCategories', + 'Address', + 'https://api.sandbox.ebay.com/wsapi?' + + 'callname=GetCategories' + + '&siteid=0' + + '&appid=' + sAPP_ID + + '&version=' + sEBAY_VERSION + ); + + mm.SetOperationCustomData( + 'ebay', + 'IeBayAPIInterfaceService', + 'GetPopularKeywords', + 'Address', + 'https://api.sandbox.ebay.com/wsapi?' + + 'callname=GetPopularKeywords' + + '&siteid=0' + + '&appid=' + sAPP_ID + + '&version=' + sEBAY_VERSION + + ); + +end; + +{ TPaginationResultType } + +function TPaginationResultType.HasTotalNumberOfEntries: boolean; +begin + Result := ( FTotalNumberOfEntries <> 0 ); +end; + +function TPaginationResultType.HasTotalNumberOfPages: boolean; +begin + Result := ( FTotalNumberOfPages <> 0 ); +end; + +initialization + RegisterEbayTypes(); + +end. diff --git a/wst/tags/3.1/tests/ebay/ebay.wst_meta b/wst/tags/3.1/tests/ebay/ebay.wst_meta new file mode 100644 index 000000000..141b44490 Binary files /dev/null and b/wst/tags/3.1/tests/ebay/ebay.wst_meta differ diff --git a/wst/tags/3.1/tests/ebay/ebay_proxy.pas b/wst/tags/3.1/tests/ebay/ebay_proxy.pas new file mode 100644 index 000000000..3eecc244b --- /dev/null +++ b/wst/tags/3.1/tests/ebay/ebay_proxy.pas @@ -0,0 +1,98 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "ebay". + This unit name : "ebay_proxy". + Date : "30/07/2006 21:52". +} +Unit ebay_proxy; +{$mode objfpc}{$H+} +Interface + +Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, ebay; + +Type + + + TeBayAPIInterfaceService_Proxy=class(TBaseProxy,IeBayAPIInterfaceService) + Protected + class function GetServiceType() : PTypeInfo;override; + procedure GetCategories( + Const GetCategoriesRequest : TGetCategoriesRequestType; + Out GetCategoriesResponse : TGetCategoriesResponseType + ); + procedure GetPopularKeywords( + Const GetPopularKeywordsRequest : TGetPopularKeywordsRequestType; + Out GetPopularKeywordsResponse : TGetPopularKeywordsResponseType + ); + End; + +Implementation +uses LResources, metadata_repository; + +{ TeBayAPIInterfaceService_Proxy implementation } + +class function TeBayAPIInterfaceService_Proxy.GetServiceType() : PTypeInfo; +begin + result := TypeInfo(IeBayAPIInterfaceService); +end; + +procedure TeBayAPIInterfaceService_Proxy.GetCategories( + Const GetCategoriesRequest : TGetCategoriesRequestType; + Out GetCategoriesResponse : TGetCategoriesResponseType +); +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('GetCategories', GetTarget(),(Self as ICallContext)); + locSerializer.Put('GetCategoriesRequest', TypeInfo(TGetCategoriesRequestType), GetCategoriesRequest); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(GetCategoriesResponse) := Nil; + strPrmName := 'GetCategoriesResponse'; + locSerializer.Get(TypeInfo(TGetCategoriesResponseType), strPrmName, GetCategoriesResponse); + + Finally + locSerializer.Clear(); + End; +End; + +procedure TeBayAPIInterfaceService_Proxy.GetPopularKeywords( + Const GetPopularKeywordsRequest : TGetPopularKeywordsRequestType; + Out GetPopularKeywordsResponse : TGetPopularKeywordsResponseType +); +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('GetPopularKeywords', GetTarget(),(Self as ICallContext)); + locSerializer.Put('GetPopularKeywordsRequest', TypeInfo(TGetPopularKeywordsRequestType), GetPopularKeywordsRequest); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(GetPopularKeywordsResponse) := Nil; + strPrmName := 'GetPopularKeywordsResponse'; + locSerializer.Get(TypeInfo(TGetPopularKeywordsResponseType), strPrmName, GetPopularKeywordsResponse); + + Finally + locSerializer.Clear(); + End; +End; + + +initialization + {$i ebay.lrs} + + {$IF DECLARED(Register_ebay_ServiceMetadata)} + Register_ebay_ServiceMetadata(); + {$ENDIF} +End. diff --git a/wst/tags/3.1/tests/ebay/test_ebay.lpi b/wst/tags/3.1/tests/ebay/test_ebay.lpi new file mode 100644 index 000000000..998f0e244 --- /dev/null +++ b/wst/tags/3.1/tests/ebay/test_ebay.lpi @@ -0,0 +1,386 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/ebay/test_ebay.lpr b/wst/tags/3.1/tests/ebay/test_ebay.lpr new file mode 100644 index 000000000..c4cd639bc --- /dev/null +++ b/wst/tags/3.1/tests/ebay/test_ebay.lpr @@ -0,0 +1,83 @@ +program test_ebay; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, SysUtils, + service_intf, soap_formatter, base_service_intf, base_soap_formatter, + //ics_http_protocol, + //indylaz, + //indy_http_protocol, + ebay, ebay_proxy, + ssl_openssl, synapse_http_protocol; + +var + locService : IeBayAPIInterfaceService; + locHdr : TCustomSecurityHeaderType; + r : TGetCategoriesRequestType; + rsp : TGetCategoriesResponseType; +begin + //Indy_RegisterHTTP_Transport(); + SYNAPSE_RegisterHTTP_Transport(); + r := nil; + rsp := nil; + locHdr := TCustomSecurityHeaderType.Create(); + try + locHdr.eBayAuthToken := { + 'AgAAAA**AQAAAA**aAAAAA**OeGvRA**nY+sHZ2PrBmdj6wVnY+sEZ2PrA2dj6wJnY+lAZOE'+ + 'pgqdj6x9nY+seQ**uoUAAA**AAMAAA**z5djiOw1a7Tk12KGGPqSpvnxxNYOVUtaSbmQ7hYd4p'+ + 'X4XfafLKBtImKsW9SUsbmBS9fXOyBnXA3k0jLelpiMptvlZ8N52UQA/ePc6+JE7LJFrARMoBaW5l'+ + 'HEQOMESJLAdFJiGmLwrnagdeo6WRI89guRtDkydPyHwHUJ7aCFQvwzeD/b+1pnXelHQvQBRFtD3drU'+ + 'BV9FbAf1/d4w/C+x5EHrBHyA+/T9uBelb3wkI8Rk/jnwF+L1qZlSW90pcyi3uxoSuBGVolgihrL/IKE'+ + '2mPcK3GAtqROu6Tsasjzz/tqkSIuFLeJ9HphAzdB+LNhyR1NGbe+l+goY74saRbEb2iqYo5wCTTLELC2k3'+ + '9p0V1Fp7CWn3Fet+y6fz8PXMb1BfYKg6fLzHXaqCRaffHJCSkvhrWwIVEuxbot4o5T8/v'+ + 'TcmmAm3T78S4B6NBdLPv7f4WxbzYYRS8Y8k7Y9GZ1/8Jomfv+LlGNrs0/sN+PkCJATAJZ3W'+ + 'tIWqyg9GHnHVA+oKCdmItd2j6nEiNq7whNdJegMOWp3jI2BvJoauJc06lw6ZMHhuj4zDiDnEwP'+ + 'DCBmY6sHWMUx1xacahKYrRsvKYvE9/eOlEaQP7OCDmJm6VVwJIkSejOnmnMmUxLGMu6to17jruAj'+ + 'Wb4s0oXSKPg9J/M2rvgE0l0tWj3O6kt9jPH533K5Wj2I/i6s0blc9z9eY/WY4+HDHe+VFX9AqMmHuD'+ + 'yog//CUNDaG5HUSw10GM26gvswNpYWGih5Ju5ylvf9B';} + + 'AgAAAA**AQAAAA**aAAAAA**5Ca0RA**nY+sHZ2PrBmdj6wVnY+sEZ2PrA2dj6wJnY+lAZSFpg'+ + 'Wdj6x9nY+seQ**uoUAAA**AAMAAA**CVYGMzI5zQ2Wh9dcHROrT0o6/BWlHNSzb+sPVl+W7UK8o0'+ + 'zpmispZNrnzXjlqd5m5nZjWfXzEGFTZVw7B+2k14tcQyiCQQn0nD6ft5KUWsxZ4Ugx/EgilEFNhT7l'+ + 'iQXBxblWq1K3CJJtyCRu1Q/eyW0c4cttutktG3c5wFGR20QUm8pFBaXVNEB11jAyzz2dB+Ij3efuSTZR'+ + 'umGNaVHeNXkLXTfaVuOzREjU5zye4bh1cHtw72pS+oTbmKB+Svflhtq7asqnfrsllRENP6fEpCzJSVqbMW'+ + 'Om+rulRa0qKOOpEGk2Mme8HDdccwtqHIq1MwT9WbcF2pV6aGKpllU4H+ii7SYwDTr8mwb45t7l26loyszoZo'+ + 'NelhXq3TS85KwmDqwgZzVlHoY+4yZVe8FRvOY7rYbtCJtZnwv7fx8+tdoogeE2eW5hNkXPvuS+Wh9yj+T1yexp'+ + '5szSfOVmn1Obik6Cz/qOxF+AIHpdO1N8qC6D/x85nlkxUbvVWBHkAVYsAxbQ1uZzpRIednc8wKLZ47cTUGPinP1B'+ + 'hgC9+l14Isquhsx5gx9t3vc79lzfRPMOaQ5k42vZaUFYTpQ2tYn7kQ9y850NPBdNVmUxLi5hCActWCHFplNrYVnnnm'+ + 'WOcuZT+DTUmh2OHiL59Av33CPhGNCGktEX0/I3FNTbM2OHCqet/eSRXNHM4JuuLhP2p7IyDfbowkXpwDZtanew64itUr'+ + 'iSInDbHpO9xlVK32t/+na6yNuCGqFEEtnl5gJ2OI1P'; + + //locHdr.Credentials.Username := 'inousa12'; + //locHdr.Credentials.Password := 'atou121076'; + locHdr.Credentials.AppId := 'INOUSSAOUEU258CIC9Z5E83UXC1BE5'; + locHdr.Credentials.DevId := 'L11ZDC63VDJ1FPLJL5EA161OQ2MS95'; + locHdr.Credentials.AuthCert := 'A266GKZC9F5$HI2HIH58A-D3JH2YA4';//'L11ZDC63VDJ1FPLJL5EA161OQ2MS95;INOUSSAOUEU258CIC9Z5E83UXC1BE5;A266GKZC9F5$HI2HIH58A-D3JH2YA4'; + locService := TeBayAPIInterfaceService_Proxy.Create( + 'eBayAPIInterfaceService', + 'SOAP:Style=Document;EncodingStyle=Litteral', + 'http:Address=https://api.sandbox.ebay.com/wsapi?callname=GetCategories&siteid=0&appid=INOUSSAOUEU258CIC9Z5E83UXC1BE5&version=467' + ); //https://api.sandbox.ebay.com/wsapi + //https://api.sandbox.ebay.com/wsapi + //https://api.sandbox.ebay.com/ws/api.dll + (locService as ICallContext).AddHeader(locHdr,True); + r := TGetCategoriesRequestType.Create(); + r.Version := '467'; + try + locService.GetCategories(r,rsp); + except + on e : Exception do begin + WriteLn('Exception : ',e.Message); + raise; + end; + end; + finally + r.Free(); + rsp.Free(); + end; +end. + diff --git a/wst/tags/3.1/tests/ebay/test_ebay_gui.lpi b/wst/tags/3.1/tests/ebay/test_ebay_gui.lpi new file mode 100644 index 000000000..20d61c3c6 --- /dev/null +++ b/wst/tags/3.1/tests/ebay/test_ebay_gui.lpi @@ -0,0 +1,304 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/ebay/test_ebay_gui.lpr b/wst/tags/3.1/tests/ebay/test_ebay_gui.lpr new file mode 100644 index 000000000..9bc754f0b --- /dev/null +++ b/wst/tags/3.1/tests/ebay/test_ebay_gui.lpr @@ -0,0 +1,18 @@ +program test_ebay_gui; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, umain, synapse_http_protocol, ebay, ebay_proxy; + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/wst/tags/3.1/tests/ebay/umain.lfm b/wst/tags/3.1/tests/ebay/umain.lfm new file mode 100644 index 000000000..00ac18617 --- /dev/null +++ b/wst/tags/3.1/tests/ebay/umain.lfm @@ -0,0 +1,121 @@ +object Form1: TForm1 + Left = 301 + Height = 388 + Top = 159 + Width = 400 + HorzScrollBar.Page = 399 + VertScrollBar.Page = 387 + ActiveControl = Button1 + Caption = 'Form1' + OnCreate = FormCreate + object Panel1: TPanel + Height = 184 + Width = 400 + Align = alTop + TabOrder = 0 + object Label1: TLabel + Left = 16 + Height = 14 + Top = 53 + Width = 77 + Caption = 'eBayAuthToken' + Color = clNone + ParentColor = False + end + object Label2: TLabel + Left = 16 + Height = 14 + Top = 79 + Width = 30 + Caption = 'AppId' + Color = clNone + ParentColor = False + end + object Label3: TLabel + Left = 16 + Height = 14 + Top = 111 + Width = 30 + Caption = 'DevId' + Color = clNone + ParentColor = False + end + object Label4: TLabel + Left = 16 + Height = 14 + Top = 144 + Width = 45 + Caption = 'AuthCert' + Color = clNone + ParentColor = False + end + object Bevel1: TBevel + Left = 10 + Height = 170 + Top = 4 + Width = 380 + Anchors = [akTop, akLeft, akRight] + end + object Button1: TButton + Left = 288 + Height = 25 + Top = 8 + Width = 99 + BorderSpacing.InnerBorder = 4 + Caption = 'GetCategories' + OnClick = Button1Click + TabOrder = 0 + Visible = False + end + object Button3: TButton + Left = 16 + Height = 25 + Top = 8 + Width = 136 + BorderSpacing.InnerBorder = 4 + Caption = 'GetPopularKeywords' + OnClick = Button3Click + TabOrder = 1 + end + object edteBayAuthToken: TEdit + Left = 96 + Height = 23 + Top = 48 + Width = 288 + Anchors = [akTop, akLeft, akRight] + TabOrder = 2 + end + object edtAppId: TEdit + Left = 96 + Height = 23 + Top = 77 + Width = 288 + Anchors = [akTop, akLeft, akRight] + TabOrder = 3 + end + object edtDevId: TEdit + Left = 96 + Height = 23 + Top = 108 + Width = 288 + Anchors = [akTop, akLeft, akRight] + TabOrder = 4 + end + object edtAuthCert: TEdit + Left = 96 + Height = 23 + Top = 136 + Width = 288 + Anchors = [akTop, akLeft, akRight] + TabOrder = 5 + end + end + object trvOut: TTreeView + Height = 204 + Top = 184 + Width = 400 + Align = alClient + DefaultItemHeight = 15 + TabOrder = 1 + end +end diff --git a/wst/tags/3.1/tests/ebay/umain.lrs b/wst/tags/3.1/tests/ebay/umain.lrs new file mode 100644 index 000000000..a2b43944a --- /dev/null +++ b/wst/tags/3.1/tests/ebay/umain.lrs @@ -0,0 +1,31 @@ +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'-'#1#6'Height'#3#132#1#3'Top'#3#159#0#5'W' + +'idth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3#131#1 + +#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#8'OnCreate'#7#10'FormC' + +'reate'#0#6'TPanel'#6'Panel1'#6'Height'#3#184#0#5'Width'#3#144#1#5'Align'#7#5 + +'alTop'#8'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#14#3 + +'Top'#2'5'#5'Width'#2'M'#7'Caption'#6#13'eBayAuthToken'#5'Color'#7#6'clNone' + +#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#16#6'Height'#2#14#3'Top' + +#2'O'#5'Width'#2#30#7'Caption'#6#5'AppId'#5'Color'#7#6'clNone'#11'ParentColo' + +'r'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#16#6'Height'#2#14#3'Top'#2'o'#5'Widt' + +'h'#2#30#7'Caption'#6#5'DevId'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6 + +'TLabel'#6'Label4'#4'Left'#2#16#6'Height'#2#14#3'Top'#3#144#0#5'Width'#2'-'#7 + +'Caption'#6#8'AuthCert'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TBevel' + +#6'Bevel1'#4'Left'#2#10#6'Height'#3#170#0#3'Top'#2#4#5'Width'#3'|'#1#7'Ancho' + +'rs'#11#5'akTop'#6'akLeft'#7'akRight'#0#0#0#7'TButton'#7'Button1'#4'Left'#3 + +' '#1#6'Height'#2#25#3'Top'#2#8#5'Width'#2'c'#25'BorderSpacing.InnerBorder'#2 + +#4#7'Caption'#6#13'GetCategories'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2 + +#0#7'Visible'#8#0#0#7'TButton'#7'Button3'#4'Left'#2#16#6'Height'#2#25#3'Top' + +#2#8#5'Width'#3#136#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#18'GetP' + +'opularKeywords'#7'OnClick'#7#12'Button3Click'#8'TabOrder'#2#1#0#0#5'TEdit' + +#16'edteBayAuthToken'#4'Left'#2'`'#6'Height'#2#23#3'Top'#2'0'#5'Width'#3' '#1 + +#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#2#0#0#5'TEdit'#8 + +'edtAppId'#4'Left'#2'`'#6'Height'#2#23#3'Top'#2'M'#5'Width'#3' '#1#7'Anchors' + +#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#3#0#0#5'TEdit'#8'edtDevId' + +#4'Left'#2'`'#6'Height'#2#23#3'Top'#2'l'#5'Width'#3' '#1#7'Anchors'#11#5'akT' + +'op'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#4#0#0#5'TEdit'#11'edtAuthCert'#4'L' + +'eft'#2'`'#6'Height'#2#23#3'Top'#3#136#0#5'Width'#3' '#1#7'Anchors'#11#5'akT' + +'op'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#5#0#0#0#9'TTreeView'#6'trvOut'#6'H' + +'eight'#3#204#0#3'Top'#3#184#0#5'Width'#3#144#1#5'Align'#7#8'alClient'#17'De' + +'faultItemHeight'#2#15#8'TabOrder'#2#1#0#0#0 +]); diff --git a/wst/tags/3.1/tests/ebay/umain.pas b/wst/tags/3.1/tests/ebay/umain.pas new file mode 100644 index 000000000..3a6142b70 --- /dev/null +++ b/wst/tags/3.1/tests/ebay/umain.pas @@ -0,0 +1,182 @@ +unit umain; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, + Buttons, StdCtrls, ComCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + Bevel1: TBevel; + Button1: TButton; + Button3: TButton; + edteBayAuthToken: TEdit; + edtAppId: TEdit; + edtDevId: TEdit; + edtAuthCert: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Label4: TLabel; + Panel1: TPanel; + trvOut: TTreeView; + procedure Button1Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation +uses TypInfo, StrUtils, + httpsend, ssl_openssl, + service_intf, soap_formatter, base_service_intf, base_soap_formatter, + ebay, ebay_proxy, + synapse_http_protocol; + + +{ TForm1 } + +procedure TForm1.Button1Click(Sender: TObject); +var + locService : IeBayAPIInterfaceService; + locHdr : TCustomSecurityHeaderType; + r : TGetCategoriesRequestType; + rsp : TGetCategoriesResponseType; +begin + try + r := nil; + rsp := nil; + locHdr := TCustomSecurityHeaderType.Create(); + try + locHdr.eBayAuthToken := edteBayAuthToken.Text; + + locHdr.Credentials.AppId := edtAppId.Text; + locHdr.Credentials.DevId := edtDevId.Text; + locHdr.Credentials.AuthCert := edtAuthCert.Text; + locService := TeBayAPIInterfaceService_Proxy.Create( + 'eBayAPIInterfaceService', + 'SOAP:Style=Document;EncodingStyle=Litteral;UniqueAddress=false', + 'http:Address=https://api.sandbox.ebay.com/wsapi' + ); + (locService as ICallContext).AddHeader(locHdr,True); + r := TGetCategoriesRequestType.Create(); + r.Version := sEBAY_VERSION; + locService.GetCategories(r,rsp); + if Assigned(rsp) then + ShowMessageFmt('CategoryCount=%d; Message=%s; Version = %s',[rsp.CategoryCount,rsp.Message,rsp.Version]) + else + ShowMessage('rsp = nil'); + finally + r.Free(); + rsp.Free(); + end; + except + on e : ESOAPException do begin + ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"',[e.FaultCode,e.FaultString]); + end; + end; +end; + +procedure TForm1.Button3Click(Sender: TObject); + + procedure ShowResponse(ARsp : TGetPopularKeywordsResponseType); + var + nd, an, nn, pn : TTreeNode; + k : Integer; + ci : TCategoryType; + begin + trvOut.BeginUpdate(); + try + trvOut.Items.Clear(); + if not Assigned(ARsp) then + Exit; + nd := trvOut.Items.AddChild(nil,'Response'); + trvOut.Items.AddChild(nd,'Ack = ' + GetEnumName(TypeInfo(TAckCodeType),Ord(ARsp.Ack))); + trvOut.Items.AddChild(nd,'Version = ' + ARsp.Version); + trvOut.Items.AddChild(nd,'HasMore = ' + IfThen(ARsp.HasMore,'True','False')); + + pn := trvOut.Items.AddChild(nd,'PaginationResult'); + trvOut.Items.AddChild(pn,'TotalNumberOfEntries = ' + IntToStr(ARsp.PaginationResult.TotalNumberOfEntries)); + trvOut.Items.AddChild(pn,'TotalNumberOfPages = ' + IntToStr(ARsp.PaginationResult.TotalNumberOfPages)); + + an := trvOut.Items.AddChild(nd,'CategoryArray ( ' + IntToStr(ARsp.CategoryArray.Length) + ')'); + for k := 0 to Pred(ARsp.CategoryArray.Length) do begin + ci := ARsp.CategoryArray[k]; + nn := trvOut.Items.AddChild(an,'Category ( ' + IntToStr(k) + ' )'); + trvOut.Items.AddChild(nn,'CategoryID = ' + ci.CategoryID); + trvOut.Items.AddChild(nn,'CategoryParentID = ' + ci.CategoryParentID); + trvOut.Items.AddChild(nn,'Keywords = ' + ci.Keywords); + end; + finally + trvOut.EndUpdate(); + end; + end; + +var + locService : IeBayAPIInterfaceService; + locHdr : TCustomSecurityHeaderType; + r : TGetPopularKeywordsRequestType; + rsp : TGetPopularKeywordsResponseType; + kpCrs : TCursor; +begin + try + r := nil; + rsp := nil; + kpCrs := Screen.Cursor; + locHdr := TCustomSecurityHeaderType.Create(); + try + Screen.Cursor := crHourGlass; + locHdr.eBayAuthToken := edteBayAuthToken.Text; + + locHdr.Credentials.AppId := edtAppId.Text; + locHdr.Credentials.DevId := edtDevId.Text; + locHdr.Credentials.AuthCert := edtAuthCert.Text; + locService := TeBayAPIInterfaceService_Proxy.Create( + 'eBayAPIInterfaceService', + 'SOAP:Style=Document;EncodingStyle=Litteral;UniqueAddress=false', + 'http:Address=https://api.sandbox.ebay.com/wsapi' + ); + (locService as ICallContext).AddHeader(locHdr,True); + r := TGetPopularKeywordsRequestType.Create(); + r.Version := sEBAY_VERSION; + r.IncludeChildCategories := True; + locService.GetPopularKeywords(r,rsp); + if Assigned(rsp) then begin + ShowResponse(rsp); + end else begin + ShowMessage('rsp = nil'); + end; + finally + Screen.Cursor := kpCrs; + r.Free(); + rsp.Free(); + end; + except + on e : ESOAPException do begin + ShowMessageFmt('SOAP EXCEPTION Code : "%s"; String = "%s"',[e.FaultCode,e.FaultString]); + end; + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + SYNAPSE_RegisterHTTP_Transport(); +end; + +initialization + {$I umain.lrs} + +end. + diff --git a/wst/tags/3.1/tests/google_api/googlewebapi.lrs b/wst/tags/3.1/tests/google_api/googlewebapi.lrs new file mode 100644 index 000000000..8e71e5f75 --- /dev/null +++ b/wst/tags/3.1/tests/google_api/googlewebapi.lrs @@ -0,0 +1,13 @@ +LazarusResources.Add('GOOGLEWEBAPI','wst_meta',[ + #0#0#0#20'WST_METADATA_0.2.2.0'#0#0#0#12'googlewebapi'#1#0#0#0#13'IGoogleSear' + +'ch'#2#0#0#0#20'doSpellingSuggestion'#3#0#0#0#3'key'#0#0#0#6'string'#0#0#0#0 + +#0#0#0#1#0#0#0#6'phrase'#0#0#0#6'string'#0#0#0#0#0#0#0#1#0#0#0#6'result'#0#0 + +#0#6'string'#0#0#0#0#0#0#0#3#0#0#0#14'doGoogleSearch'#11#0#0#0#3'key'#0#0#0#6 + +'string'#0#0#0#0#0#0#0#1#0#0#0#1'q'#0#0#0#6'string'#0#0#0#0#0#0#0#1#0#0#0#5 + +'start'#0#0#0#7'Integer'#0#0#0#0#0#0#0#1#0#0#0#10'maxResults'#0#0#0#7'Intege' + +'r'#0#0#0#0#0#0#0#1#0#0#0#6'filter'#0#0#0#7'Boolean'#0#0#0#0#0#0#0#1#0#0#0#8 + +'restrict'#0#0#0#6'string'#0#0#0#0#0#0#0#1#0#0#0#10'safeSearch'#0#0#0#7'Bool' + +'ean'#0#0#0#0#0#0#0#1#0#0#0#2'lr'#0#0#0#6'string'#0#0#0#0#0#0#0#1#0#0#0#2'ie' + +#0#0#0#6'string'#0#0#0#0#0#0#0#1#0#0#0#2'oe'#0#0#0#6'string'#0#0#0#0#0#0#0#1 + +#0#0#0#6'result'#0#0#0#19'TGoogleSearchResult'#0#0#0#0#0#0#0#3 +]); diff --git a/wst/tags/3.1/tests/google_api/googlewebapi.meta b/wst/tags/3.1/tests/google_api/googlewebapi.meta new file mode 100644 index 000000000..6d462d4e2 Binary files /dev/null and b/wst/tags/3.1/tests/google_api/googlewebapi.meta differ diff --git a/wst/tags/3.1/tests/google_api/googlewebapi.pas b/wst/tags/3.1/tests/google_api/googlewebapi.pas new file mode 100644 index 000000000..d05a778c6 --- /dev/null +++ b/wst/tags/3.1/tests/google_api/googlewebapi.pas @@ -0,0 +1,157 @@ +Unit googlewebapi; +{$mode objfpc}{$H+} +interface +uses SysUtils, Classes, base_service_intf; + +Type + + TResultElement = class(TBaseComplexRemotable) + private + FcachedSize: string; + FdirectoryTitle: string; + FhostName: string; + FrelatedInformationPresent: boolean; + Fsnippet: string; + Fsummary: string; + Ftitle: string; + FURL: string; + Published + property summary : string Read Fsummary Write Fsummary; + property URL : string Read FURL Write FURL; + property snippet: string Read Fsnippet Write Fsnippet; + property title : string Read Ftitle Write Ftitle; + property cachedSize : string Read FcachedSize Write FcachedSize; + property relatedInformationPresent : boolean Read FrelatedInformationPresent Write FrelatedInformationPresent; + property hostName : string Read FhostName Write FhostName; + property directoryTitle : string Read FdirectoryTitle Write FdirectoryTitle; + End; + + TResultElementArray = class(TBaseObjectArrayRemotable) + private + function GetItem(AIndex: Integer): TResultElement; + Public + class function GetItemClass():TBaseRemotableClass;override; + property Item[AIndex:Integer] : TResultElement Read GetItem;Default; + End; + + TDirectoryCategory = class(TBaseComplexRemotable) + private + FfullViewableName: string; + FspecialEncoding: string; + Published + property fullViewableName : string Read FfullViewableName Write FfullViewableName; + property specialEncoding : string Read FspecialEncoding Write FspecialEncoding; + End; + + TDirectoryCategoryArray = class(TBaseObjectArrayRemotable) + private + function GetItem(AIndex: Integer): TDirectoryCategory; + Public + class function GetItemClass():TBaseRemotableClass;override; + property Item[AIndex:Integer] : TDirectoryCategory Read GetItem;Default; + End; + + TGoogleSearchResult = class(TBaseComplexRemotable) + private + FdirectoryCategories: TDirectoryCategoryArray; + FdocumentFiltering: Boolean; + FendIndex: Integer; + FestimatedTotalResultsCount: Integer; + FestimateIsExact: Boolean; + FresultElements: TResultElementArray; + FsearchComments: string; + FsearchQuery: string; + FsearchTime: Double; + FsearchTips: string; + FstartIndex: Integer; + Public + constructor Create();override; + destructor Destroy();override; + Published + property documentFiltering : Boolean Read FdocumentFiltering Write FdocumentFiltering; + property searchComments :string Read FsearchComments Write FsearchComments; + property estimatedTotalResultsCount: Integer Read FestimatedTotalResultsCount Write FestimatedTotalResultsCount; + property estimateIsExact : Boolean Read FestimateIsExact Write FestimateIsExact; + property searchQuery : string Read FsearchQuery Write FsearchQuery; + property startIndex : Integer Read FstartIndex Write FstartIndex; + property endIndex : Integer Read FendIndex Write FendIndex; + property searchTips :string Read FsearchTips Write FsearchTips; + property searchTime : Double Read FsearchTime Write FsearchTime; + property resultElements : TResultElementArray Read FresultElements Write FresultElements; + property directoryCategories : TDirectoryCategoryArray Read FdirectoryCategories Write FdirectoryCategories; + End; + + IGoogleSearch = Interface + ['{17FCCC65-4A0B-4D19-93F6-F69EAA719CA3}'] + function doSpellingSuggestion( + const key:string; + const phrase:string + ):string; + function doGoogleSearch( + Const key : string; + Const q : string; + Const start : Integer; + Const maxResults : Integer; + Const filter : Boolean; + Const restrict : string; + Const safeSearch : Boolean; + Const lr : string; + Const ie : string; + Const oe : string + ) : TGoogleSearchResult ; + End; + +Implementation +uses base_soap_formatter; + +Const + GOOGLE_NAMESPACE = 'urn:GoogleSearch'; + +{ TResultElementArray } + +function TResultElementArray.GetItem(AIndex: Integer): TResultElement; +begin + Result := Inherited GetItem(AIndex) As TResultElement; +end; + +class function TResultElementArray.GetItemClass(): TBaseRemotableClass; +begin + Result:= TResultElement; +end; + +{ TGoogleSearchResult } + +constructor TGoogleSearchResult.Create(); +begin + inherited Create(); + FresultElements := TResultElementArray.Create(); + FdirectoryCategories := TDirectoryCategoryArray.Create(); +end; + +destructor TGoogleSearchResult.Destroy(); +begin + FdirectoryCategories.Free(); + FresultElements.Free(); + inherited Destroy(); +end; + +{ TDirectoryCategoryArray } + +function TDirectoryCategoryArray.GetItem(AIndex: Integer): TDirectoryCategory; +begin + Result := Inherited GetItem(AIndex) As TDirectoryCategory; +end; + +class function TDirectoryCategoryArray.GetItemClass(): TBaseRemotableClass; +begin + Result:= TDirectoryCategory; +end; + +Initialization + GetTypeRegistry().Register(GOOGLE_NAMESPACE,TypeInfo(TDirectoryCategory),'DirectoryCategory'); + GetTypeRegistry().Register(GOOGLE_NAMESPACE,TypeInfo(TDirectoryCategoryArray),'DirectoryCategoryArray'); + GetTypeRegistry().Register(GOOGLE_NAMESPACE,TypeInfo(TResultElement),'ResultElement'); + GetTypeRegistry().Register(GOOGLE_NAMESPACE,TypeInfo(TResultElementArray),'ResultElementArray'); + GetTypeRegistry().Register(GOOGLE_NAMESPACE,TypeInfo(TGoogleSearchResult),'GoogleSearchResult'); + +End. diff --git a/wst/tags/3.1/tests/google_api/googlewebapi.wst_meta b/wst/tags/3.1/tests/google_api/googlewebapi.wst_meta new file mode 100644 index 000000000..c6cac8262 Binary files /dev/null and b/wst/tags/3.1/tests/google_api/googlewebapi.wst_meta differ diff --git a/wst/tags/3.1/tests/google_api/googlewebapi_binder.pas b/wst/tags/3.1/tests/google_api/googlewebapi_binder.pas new file mode 100644 index 000000000..756daf8c7 --- /dev/null +++ b/wst/tags/3.1/tests/google_api/googlewebapi_binder.pas @@ -0,0 +1,138 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "googlewebapi". + This unit name : "googlewebapi_binder". + Date : "08/06/2006 23:28". +} +Unit googlewebapi_binder; +{$mode objfpc}{$H+} +Interface + +Uses SysUtils, Classes, base_service_intf, server_service_intf, googlewebapi; + +Type + + + TGoogleSearch_ServiceBinder=class(TBaseServiceBinder) + Protected + procedure doSpellingSuggestionHandler(AFormatter:IFormatterResponse); + procedure doGoogleSearchHandler(AFormatter:IFormatterResponse); + Public + constructor Create(); + End; + + TGoogleSearch_ServiceBinderFactory = class(TInterfacedObject,IItemFactory) + protected + function CreateInstance():IInterface; + End; + + procedure Server_service_RegisterGoogleSearchService(); + +Implementation +uses TypInfo; + +{ TGoogleSearch_ServiceBinder implementation } +procedure TGoogleSearch_ServiceBinder.doSpellingSuggestionHandler(AFormatter:IFormatterResponse); +Var + tmpObj : IGoogleSearch; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + key : string; + phrase : string; + returnVal : string; + locTypeInfo : PTypeInfo; +Begin + callCtx := CreateCallContext(); + + strPrmName := 'key'; AFormatter.Get(TypeInfo(string),strPrmName,key); + strPrmName := 'phrase'; AFormatter.Get(TypeInfo(string),strPrmName,phrase); + + tmpObj := Self.GetFactory().CreateInstance() as IGoogleSearch; + + returnVal := tmpObj.doSpellingSuggestion(key,phrase); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(string),returnVal); + AFormatter.EndCallResponse(); + + callCtx := Nil; +End; + +procedure TGoogleSearch_ServiceBinder.doGoogleSearchHandler(AFormatter:IFormatterResponse); +Var + tmpObj : IGoogleSearch; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + key : string; + q : string; + start : Integer; + maxResults : Integer; + filter : Boolean; + restrict : string; + safeSearch : Boolean; + lr : string; + ie : string; + oe : string; + returnVal : TGoogleSearchResult; + locTypeInfo : PTypeInfo; +Begin + callCtx := CreateCallContext(); + locTypeInfo := TypeInfo(TGoogleSearchResult); + If ( locTypeInfo^.Kind in [tkClass,tkInterface] ) Then + Pointer(returnVal) := Nil; + + strPrmName := 'key'; AFormatter.Get(TypeInfo(string),strPrmName,key); + strPrmName := 'q'; AFormatter.Get(TypeInfo(string),strPrmName,q); + strPrmName := 'start'; AFormatter.Get(TypeInfo(Integer),strPrmName,start); + strPrmName := 'maxResults'; AFormatter.Get(TypeInfo(Integer),strPrmName,maxResults); + strPrmName := 'filter'; AFormatter.Get(TypeInfo(Boolean),strPrmName,filter); + strPrmName := 'restrict'; AFormatter.Get(TypeInfo(string),strPrmName,restrict); + strPrmName := 'safeSearch'; AFormatter.Get(TypeInfo(Boolean),strPrmName,safeSearch); + strPrmName := 'lr'; AFormatter.Get(TypeInfo(string),strPrmName,lr); + strPrmName := 'ie'; AFormatter.Get(TypeInfo(string),strPrmName,ie); + strPrmName := 'oe'; AFormatter.Get(TypeInfo(string),strPrmName,oe); + + tmpObj := Self.GetFactory().CreateInstance() as IGoogleSearch; + + returnVal := tmpObj.doGoogleSearch(key,q,start,maxResults,filter,restrict,safeSearch,lr,ie,oe); + locTypeInfo := TypeInfo(TGoogleSearchResult); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(returnVal)) Then + callCtx.AddObject(TObject(returnVal)); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(TGoogleSearchResult),returnVal); + AFormatter.EndCallResponse(); + + callCtx := Nil; +End; + + +constructor TGoogleSearch_ServiceBinder.Create(); +Begin + Inherited Create(GetServiceImplementationRegistry().FindFactory('GoogleSearch')); + RegisterVerbHandler('doSpellingSuggestion',@doSpellingSuggestionHandler); + RegisterVerbHandler('doGoogleSearch',@doGoogleSearchHandler); +End; + + +{ TGoogleSearch_ServiceBinderFactory } +function TGoogleSearch_ServiceBinderFactory.CreateInstance():IInterface; +Begin + Result := TGoogleSearch_ServiceBinder.Create() as IInterface; +End; + + +procedure Server_service_RegisterGoogleSearchService(); +Begin + GetServerServiceRegistry().Register('GoogleSearch',TGoogleSearch_ServiceBinderFactory.Create() as IItemFactory); +End; + +End. diff --git a/wst/tags/3.1/tests/google_api/googlewebapi_proxy.pas b/wst/tags/3.1/tests/google_api/googlewebapi_proxy.pas new file mode 100644 index 000000000..43db0b117 --- /dev/null +++ b/wst/tags/3.1/tests/google_api/googlewebapi_proxy.pas @@ -0,0 +1,123 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "googlewebapi". + This unit name : "googlewebapi_proxy". + Date : "30/07/2006 21:44". +} +Unit googlewebapi_proxy; +{$mode objfpc}{$H+} +Interface + +Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, googlewebapi; + +Type + + + TGoogleSearch_Proxy=class(TBaseProxy,IGoogleSearch) + Protected + class function GetServiceType() : PTypeInfo;override; + function doSpellingSuggestion( + Const key : string; + Const phrase : string + ):string; + function doGoogleSearch( + Const key : string; + Const q : string; + Const start : Integer; + Const maxResults : Integer; + Const filter : Boolean; + Const restrict : string; + Const safeSearch : Boolean; + Const lr : string; + Const ie : string; + Const oe : string + ):TGoogleSearchResult; + End; + +Implementation +uses LResources, metadata_repository; + +{ TGoogleSearch_Proxy implementation } + +class function TGoogleSearch_Proxy.GetServiceType() : PTypeInfo; +begin + result := TypeInfo(IGoogleSearch); +end; + +function TGoogleSearch_Proxy.doSpellingSuggestion( + Const key : string; + Const phrase : string +):string; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('doSpellingSuggestion', GetTarget(),(Self as ICallContext)); + locSerializer.Put('key', TypeInfo(string), key); + locSerializer.Put('phrase', TypeInfo(string), phrase); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + strPrmName := 'return'; + locSerializer.Get(TypeInfo(string), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + +function TGoogleSearch_Proxy.doGoogleSearch( + Const key : string; + Const q : string; + Const start : Integer; + Const maxResults : Integer; + Const filter : Boolean; + Const restrict : string; + Const safeSearch : Boolean; + Const lr : string; + Const ie : string; + Const oe : string +):TGoogleSearchResult; +Var + locSerializer : IFormatterClient; + strPrmName : string; +Begin + locSerializer := GetSerializer(); + Try + locSerializer.BeginCall('doGoogleSearch', GetTarget(),(Self as ICallContext)); + locSerializer.Put('key', TypeInfo(string), key); + locSerializer.Put('q', TypeInfo(string), q); + locSerializer.Put('start', TypeInfo(Integer), start); + locSerializer.Put('maxResults', TypeInfo(Integer), maxResults); + locSerializer.Put('filter', TypeInfo(Boolean), filter); + locSerializer.Put('restrict', TypeInfo(string), restrict); + locSerializer.Put('safeSearch', TypeInfo(Boolean), safeSearch); + locSerializer.Put('lr', TypeInfo(string), lr); + locSerializer.Put('ie', TypeInfo(string), ie); + locSerializer.Put('oe', TypeInfo(string), oe); + locSerializer.EndCall(); + + MakeCall(); + + locSerializer.BeginCallRead((Self as ICallContext)); + Pointer(Result) := Nil; + strPrmName := 'return'; + locSerializer.Get(TypeInfo(TGoogleSearchResult), strPrmName, result); + + Finally + locSerializer.Clear(); + End; +End; + + +initialization + {$i googlewebapi.lrs} + + {$IF DECLARED(Register_googlewebapi_ServiceMetadata)} + Register_googlewebapi_ServiceMetadata(); + {$ENDIF} +End. diff --git a/wst/tags/3.1/tests/google_api/googlewebapi_stub.pas b/wst/tags/3.1/tests/google_api/googlewebapi_stub.pas new file mode 100644 index 000000000..7d5331122 --- /dev/null +++ b/wst/tags/3.1/tests/google_api/googlewebapi_stub.pas @@ -0,0 +1,200 @@ +{ +This unit has been produced by ws_helper. + Input unit name : "googlewebapi". + This unit name : "googlewebapi_stub". + Date : "17/05/2006 21:28". +} +Unit googlewebapi_stub; +{$mode objfpc}{$H+} +Interface + +Uses SysUtils, Classes, server_service_intf, googlewebapi; + +Type + + + TGoogleSearch_ServiceBinder=class(TBaseServiceBinder) + Protected + procedure doSpellingSuggestionHandler(AFormatter:IFormatterResponse); + procedure doGoogleSearchHandler(AFormatter:IFormatterResponse); + Public + constructor Create(); + End; + + TGoogleSearchServiceBinderFactory = class(TInterfacedObject,IItemFactory) + protected + function CreateInstance():IInterface; + End; + + procedure Server_service_RegisterGoogleSearchService(); + +Implementation +uses TypInfo, server_service_imputils; + +{ TGoogleSearch_ServiceBinder implementation } +procedure TGoogleSearch_ServiceBinder.doSpellingSuggestionHandler(AFormatter:IFormatterResponse); +Var + tmpObj : IGoogleSearch; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + key : string; + phrase : string; + returnVal : string; + locTypeInfo : PTypeInfo; +Begin + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(returnVal) := Nil; + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(key) := Nil; + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(phrase) := Nil; + + strPrmName := 'key'; AFormatter.Get(TypeInfo(string),strPrmName,key); + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(key)) Then + callCtx.AddObject(TObject(key)); + strPrmName := 'phrase'; AFormatter.Get(TypeInfo(string),strPrmName,phrase); + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(phrase)) Then + callCtx.AddObject(TObject(phrase)); + + tmpObj := Self.GetFactory().CreateInstance() as IGoogleSearch; + + returnVal := tmpObj.doSpellingSuggestion(key,phrase); + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(returnVal)) Then + callCtx.AddObject(TObject(returnVal)); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(string),returnVal); + AFormatter.EndCallResponse(); +End; + +procedure TGoogleSearch_ServiceBinder.doGoogleSearchHandler(AFormatter:IFormatterResponse); +Var + tmpObj : IGoogleSearch; + callCtx : ICallContext; + strPrmName : string; + procName,trgName : string; + key : string; + q : string; + start : Integer; + maxResults : Integer; + filter : Boolean; + restrict : string; + safeSearch : Boolean; + lr : string; + ie : string; + oe : string; + returnVal : TGoogleSearchResult; + locTypeInfo : PTypeInfo; +Begin + locTypeInfo := TypeInfo(TGoogleSearchResult); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(returnVal) := Nil; + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(key) := Nil; + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(q) := Nil; + locTypeInfo := TypeInfo(Integer); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(start) := Nil; + locTypeInfo := TypeInfo(Integer); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(maxResults) := Nil; + locTypeInfo := TypeInfo(Boolean); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(filter) := Nil; + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(restrict) := Nil; + locTypeInfo := TypeInfo(Boolean); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(safeSearch) := Nil; + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(lr) := Nil; + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(ie) := Nil; + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind in [tkClass,tkObject,tkInterface] ) Then + Pointer(oe) := Nil; + + strPrmName := 'key'; AFormatter.Get(TypeInfo(string),strPrmName,key); + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(key)) Then + callCtx.AddObject(TObject(key)); + strPrmName := 'q'; AFormatter.Get(TypeInfo(string),strPrmName,q); + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(q)) Then + callCtx.AddObject(TObject(q)); + strPrmName := 'start'; AFormatter.Get(TypeInfo(Integer),strPrmName,start); + locTypeInfo := TypeInfo(Integer); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(start)) Then + callCtx.AddObject(TObject(start)); + strPrmName := 'maxResults'; AFormatter.Get(TypeInfo(Integer),strPrmName,maxResults); + locTypeInfo := TypeInfo(Integer); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(maxResults)) Then + callCtx.AddObject(TObject(maxResults)); + strPrmName := 'filter'; AFormatter.Get(TypeInfo(Boolean),strPrmName,filter); + locTypeInfo := TypeInfo(Boolean); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(filter)) Then + callCtx.AddObject(TObject(filter)); + strPrmName := 'restrict'; AFormatter.Get(TypeInfo(string),strPrmName,restrict); + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(restrict)) Then + callCtx.AddObject(TObject(restrict)); + strPrmName := 'safeSearch'; AFormatter.Get(TypeInfo(Boolean),strPrmName,safeSearch); + locTypeInfo := TypeInfo(Boolean); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(safeSearch)) Then + callCtx.AddObject(TObject(safeSearch)); + strPrmName := 'lr'; AFormatter.Get(TypeInfo(string),strPrmName,lr); + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(lr)) Then + callCtx.AddObject(TObject(lr)); + strPrmName := 'ie'; AFormatter.Get(TypeInfo(string),strPrmName,ie); + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(ie)) Then + callCtx.AddObject(TObject(ie)); + strPrmName := 'oe'; AFormatter.Get(TypeInfo(string),strPrmName,oe); + locTypeInfo := TypeInfo(string); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(oe)) Then + callCtx.AddObject(TObject(oe)); + + tmpObj := Self.GetFactory().CreateInstance() as IGoogleSearch; + + returnVal := tmpObj.doGoogleSearch(key,q,start,maxResults,filter,restrict,safeSearch,lr,ie,oe); + locTypeInfo := TypeInfo(TGoogleSearchResult); + If ( locTypeInfo^.Kind = tkClass ) And Assigned(Pointer(returnVal)) Then + callCtx.AddObject(TObject(returnVal)); + + procName := AFormatter.GetCallProcedureName(); + trgName := AFormatter.GetCallTarget(); + AFormatter.Clear(); + AFormatter.BeginCallResponse(procName,trgName); + AFormatter.Put('return',TypeInfo(TGoogleSearchResult),returnVal); + AFormatter.EndCallResponse(); +End; + + +{ TGoogleSearchServiceBinderFactory } +function TGoogleSearchServiceBinderFactory.CreateInstance():IInterface; +Begin + Result := TGoogleSearch_ServiceBinder.Create() as IInterface; +End; + + +procedure Server_service_RegisterGoogleSearchService(); +Begin + GetServerServiceRegistry().Register('GoogleSearch',TGoogleSearchServiceBinderFactory.Create() as IItemFactory); +End; diff --git a/wst/tags/3.1/tests/google_api/test_google_api.lpi b/wst/tags/3.1/tests/google_api/test_google_api.lpi new file mode 100644 index 000000000..3e2cb04e5 --- /dev/null +++ b/wst/tags/3.1/tests/google_api/test_google_api.lpi @@ -0,0 +1,391 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/google_api/test_google_api.pas b/wst/tags/3.1/tests/google_api/test_google_api.pas new file mode 100644 index 000000000..024f00a34 --- /dev/null +++ b/wst/tags/3.1/tests/google_api/test_google_api.pas @@ -0,0 +1,98 @@ +program test_google_api; +{$mode objfpc}{$H+} +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, SysUtils, + base_service_intf, service_intf, soap_formatter, + //indy_http_protocol, + ics_http_protocol, + synapse_http_protocol, + googlewebapi, googlewebapi_proxy; + +Const + sADRESS = 'http:Address=http://api.google.com/search/beta2'; + sTARGET = 'urn:GoogleSearch'; + sKEY = '0w9pU3tQFHJyjRUP/bKgv2qwCoXf5pop'; + sSERVICE_PROTOCOL = 'SOAP'; +Var + tmpObj : IGoogleSearch; + qryRes : TGoogleSearchResult; + strBuffer : string; + i , c: Integer; + resElt : TResultElement; + resDir : TDirectoryCategory; +begin + //ICS_RegisterHTTP_Transport(); + SYNAPSE_RegisterHTTP_Transport(); + //INDY_RegisterHTTP_Transport(); + WriteLn(); + WriteLn('Enter phrase to spell :'); + ReadLn(strBuffer); + tmpObj := TGoogleSearch_Proxy.Create(sTARGET,sSERVICE_PROTOCOL,sADRESS); + Try + strBuffer := tmpObj.doSpellingSuggestion(sKEY,strBuffer); + WriteLn('google spell >>> ',strBuffer); + Except + On E : Exception Do + WriteLn(E.Message); + End; + + WriteLn(); + WriteLn('Enter phrase to search :'); + ReadLn(strBuffer); + Try + qryRes := tmpObj.doGoogleSearch(sKEY,strBuffer,0,10,True,'',False,'','latin1','latin1'); + Try + WriteLn('---------------------------------------'); + WriteLn('google Search >>'); + WriteLn('documentFiltering = ',qryRes.documentFiltering); + WriteLn('startIndex = ',qryRes.startIndex); + WriteLn('endIndex = ',qryRes.endIndex); + WriteLn('estimatedTotalResultsCount = ',qryRes.estimatedTotalResultsCount); + WriteLn('estimateIsExact = ',qryRes.estimateIsExact); + WriteLn('searchComments = ',qryRes.searchComments); + WriteLn('searchQuery = ',qryRes.searchQuery); + WriteLn('searchTime = ',qryRes.searchTime); + WriteLn('searchTips = ',qryRes.searchTips); + + WriteLn('-------------------------------------------'); + WriteLn('directoryCategories >>'); + WriteLn(' Length = ',qryRes.directoryCategories.Length); + c := qryRes.directoryCategories.Length; + For i := 0 To Pred(c) Do Begin + resDir := qryRes.directoryCategories[i]; + WriteLn(''); + WriteLn('Item[',i,'] >>'); + WriteLn(' fullViewableName = ',resDir.fullViewableName); + WriteLn(' specialEncoding = ',resDir.specialEncoding); + End; + + WriteLn('-------------------------------------------'); + WriteLn('resultElements >>'); + WriteLn(' Length = ',qryRes.resultElements.Length); + c := qryRes.resultElements.Length; + For i := 0 To Pred(c) Do Begin + resElt := qryRes.resultElements[i]; + WriteLn(''); + WriteLn('Item[',i,'] >>'); + WriteLn(' cachedSize = ',resElt.cachedSize); + WriteLn(' directoryTitle = ',resElt.directoryTitle); + WriteLn(' hostName = ',resElt.hostName); + WriteLn(' relatedInformationPresent = ',resElt.relatedInformationPresent); + WriteLn(' snippet = ',resElt.snippet); + WriteLn(' summary = ',resElt.summary); + WriteLn(' title = ',resElt.title); + WriteLn(' URL = ',resElt.URL); + End; + Finally + qryRes.Free(); + End; + Except + On E : Exception Do + WriteLn(E.Message); + End; + + ReadLn(); +end. diff --git a/wst/tags/3.1/tests/http_server/app_object.pas b/wst/tags/3.1/tests/http_server/app_object.pas new file mode 100644 index 000000000..49814fa3f --- /dev/null +++ b/wst/tags/3.1/tests/http_server/app_object.pas @@ -0,0 +1,301 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} + +unit app_object; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + IdCustomHTTPServer, + IdHTTPServer, IdContext, IdSocketHandle; + +type + + { TwstWebApplication } + + TwstWebApplication = class(TObject) + private + FHTTPServerObject: TIdHTTPServer; + FRootAddress : string; + private + function GenerateWSDLTable():string; + + procedure ProcessWSDLRequest( + AContext : TIdContext; + ARequestInfo : TIdHTTPRequestInfo; + AResponseInfo : TIdHTTPResponseInfo; + var APath : string + ); + procedure ProcessServiceRequest( + AContext : TIdContext; + ARequestInfo : TIdHTTPRequestInfo; + AResponseInfo : TIdHTTPResponseInfo; + var APath : string + ); + private + procedure Handler_CommandGet( + AContext : TIdContext; + ARequestInfo : TIdHTTPRequestInfo; + AResponseInfo : TIdHTTPResponseInfo + ); + public + constructor Create(); + destructor Destroy(); override; + procedure Display(const AMsg : string); + end; + + +implementation +uses base_service_intf, + server_service_intf, server_service_imputils, + server_service_soap, server_binary_formatter, + metadata_repository, metadata_wsdl, DOM, XMLWrite, + calculator, calculator_binder, calculator_imp, + metadata_service, metadata_service_binder, metadata_service_imp; + +const + sSEPARATOR = '/'; + sSERVICES_PREFIXE = 'services'; + sWSDL = 'WSDL'; + +function ExtractNextPathElement(var AFullPath : string):string; +var + i : SizeInt; +begin + Result := ''; + if ( Length(AFullPath) > 0 ) then begin + while ( Length(AFullPath) > 0 ) and ( AFullPath[1] = sSEPARATOR ) do begin + Delete(AFullPath,1,1); + end; + i := Pos(sSEPARATOR,AFullPath); + if ( i < 1 ) then begin + Result := AFullPath; + AFullPath := ''; + end else begin + Result := Copy(AFullPath,1,Pred(i)); + Delete(AFullPath,1,i); + end; + end; +end; + +function GetWSDL(const ARepName, ARootAddress: shortstring):string; +var + strm : TMemoryStream; + rep : PServiceRepository; + doc :TXMLDocument; + i : SizeInt; + s : string; +begin + Result := ''; + rep := nil; + doc := Nil; + i := GetModuleMetadataMngr().IndexOfName(ARepName); + if ( i < 0 ) then + Exit; + strm := TMemoryStream.Create(); + try + s := GetModuleMetadataMngr().GetRepositoryName(i); + GetModuleMetadataMngr().LoadRepositoryName(s,ARootAddress,rep); + //if ( GetModuleMetadataMngr().LoadRepositoryName(s,rep) > 0 ) then + //rep^.namespace := 'urn:wst'; + strm.Clear(); + doc := TXMLDocument.Create(); + GenerateWSDL(rep,doc); + WriteXMLFile(doc,strm); + i := strm.Size; + if ( i > 0 ) then begin + SetLength(Result,i); + Move(strm.memory^,Result[1],i); + end; + finally + doc.Free(); + strm.Free(); + GetModuleMetadataMngr().ClearRepository(rep); + end; +end; + + +{ TwstWebApplication } + +function TwstWebApplication.GenerateWSDLTable(): string; +var + r : IModuleMetadataMngr; + i : Integer; +begin + r := GetModuleMetadataMngr(); + Result := '' + + ''+ + ''+ + 'The Web Service Toolkit generated Metadata table'+ + ''+ + '' + + '

The following repositories has available. Click on the link to view the corresponding WSDL.

'+ + '' + + ''; + + for i := 0 to Pred(r.GetCount()) do + Result := Result + ''; + + Result := Result + + ''+ + '
' + + Format('',[sSEPARATOR+sSERVICES_PREFIXE+sSEPARATOR+sWSDL+sSEPARATOR+r.GetRepositoryName(i)])+ + r.GetRepositoryName(i) + + ''+ + '
'+ + ''+ + ''+ + ''; +end; + +procedure TwstWebApplication.ProcessWSDLRequest( + AContext : TIdContext; + ARequestInfo : TIdHTTPRequestInfo; + AResponseInfo : TIdHTTPResponseInfo; + var APath : string +); +var + locRepName, strBuff : string; + i : Integer; +begin + locRepName := ExtractNextPathElement(APath); + if AnsiSameText(sWSDL,locRepName) then + locRepName := ExtractNextPathElement(APath); + strBuff := GetWSDL(locRepName,FRootAddress); + i := Length(strBuff); + if ( i > 0 ) then begin + AResponseInfo.ContentType := 'text/xml'; + if not Assigned(AResponseInfo.ContentStream) then + AResponseInfo.ContentStream := TMemoryStream.Create(); + AResponseInfo.ContentStream.Write(strBuff[1],i); + Exit; + end; + AResponseInfo.ContentText := GenerateWSDLTable(); + AResponseInfo.ContentType := 'text/html'; +end; + +procedure TwstWebApplication.ProcessServiceRequest( + AContext : TIdContext; + ARequestInfo : TIdHTTPRequestInfo; + AResponseInfo : TIdHTTPResponseInfo; + var APath : string +); +var + trgt,ctntyp : string; + rqst : IRequestBuffer; + inStream: TMemoryStream; +begin + trgt := ExtractNextPathElement(APath); + if AnsiSameText(sWSDL,trgt) then begin + ProcessWSDLRequest(AContext,ARequestInfo,AResponseInfo,APath); + Exit; + end; + inStream := nil; + try + try + inStream := TMemoryStream.Create(); + AResponseInfo.ContentStream := TMemoryStream.Create(); + + ctntyp := ARequestInfo.ContentType; + inStream.CopyFrom(ARequestInfo.PostStream,0); + inStream.Position := 0; + AResponseInfo.ContentType := ctntyp; + rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,AResponseInfo.ContentStream); + HandleServiceRequest(rqst); + finally + inStream.Free(); + end; + except + on e : Exception do begin + Display('ProcessData()>> Exception = '+e.Message); + raise; + end; + end; +end; + +procedure TwstWebApplication.Handler_CommandGet( + AContext : TIdContext; + ARequestInfo : TIdHTTPRequestInfo; + AResponseInfo : TIdHTTPResponseInfo +); +var + locPath, locPathPart, s : string; + j : SizeInt; +begin + if Assigned(ARequestInfo.PostStream) and ( ARequestInfo.PostStream.Size > 0 ) then begin + j := ARequestInfo.PostStream.Size; + SetLength(s,j); + ARequestInfo.PostStream.Read(s[1],j); + Display('----------- QUERY ----------------------'); + Display(s); + end; + locPath := ARequestInfo.Document; + locPathPart := ExtractNextPathElement(locPath); + if AnsiSameText(sSERVICES_PREFIXE,locPathPart) then begin + ProcessServiceRequest(AContext,ARequestInfo,AResponseInfo,locPath); + if Assigned(AResponseInfo.ContentStream) and ( AResponseInfo.ContentStream.Size > 0 ) then begin + j := AResponseInfo.ContentStream.Size; + SetLength(s,j); + AResponseInfo.ContentStream.Position := 0; + AResponseInfo.ContentStream.Read(s[1],j); + Display('--------- RESPONSE ------------------------'); + Display(s); + end; + Exit; + end; + + ProcessWSDLRequest(AContext,ARequestInfo,AResponseInfo,locPath); +end; + +constructor TwstWebApplication.Create(); +var + b : TIdSocketHandle; +begin + inherited Create(); + FHTTPServerObject := TIdHTTPServer.Create(); + b := FHTTPServerObject.Bindings.Add(); + b.IP:='127.0.0.1'; + b.port:=8000; + FRootAddress := 'http://127.0.0.1:8000/'; + + FHTTPServerObject.DefaultPort := 25000; + FHTTPServerObject.ServerSoftware := 'Web Service Toolkit Sample WebServer'; + FHTTPServerObject.Active := True; + FHTTPServerObject.OnCommandGet := @Handler_CommandGet; +end; + +destructor TwstWebApplication.Destroy(); +begin + FreeAndNil(FHTTPServerObject); + inherited Destroy(); +end; + +procedure TwstWebApplication.Display(const AMsg: string); +begin + WriteLn(AMsg); +end; + +initialization + RegisterStdTypes(); + Server_service_RegisterBinaryFormat(); + Server_service_RegisterSoapFormat(); + + RegisterCalculatorImplementationFactory(); + Server_service_RegisterCalculatorService(); + + Server_service_RegisterWSTMetadataServiceService(); + RegisterWSTMetadataServiceImplementationFactory(); +end. diff --git a/wst/tags/3.1/tests/http_server/wst_http_server.lpi b/wst/tags/3.1/tests/http_server/wst_http_server.lpi new file mode 100644 index 000000000..8abe204da --- /dev/null +++ b/wst/tags/3.1/tests/http_server/wst_http_server.lpi @@ -0,0 +1,709 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/http_server/wst_http_server.pas b/wst/tags/3.1/tests/http_server/wst_http_server.pas new file mode 100644 index 000000000..c627f53be --- /dev/null +++ b/wst/tags/3.1/tests/http_server/wst_http_server.pas @@ -0,0 +1,40 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} + +program wst_http_server; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, SysUtils, + app_object, metadata_service, logger_extension; + + +var + AppObject : TwstWebApplication; +begin + AppObject := TwstWebApplication.Create(); + try + WriteLn('"Web Service Toolkit" WebServer listening at:'); + WriteLn(''); + WriteLn('http://127.0.0.1:8000/'); + WriteLn(''); + WriteLn('Press enter to quit.'); + ReadLn(); + finally + FreeAndNil(AppObject); + end; +end. diff --git a/wst/tags/3.1/tests/metadata_browser/metadata_browser.lpi b/wst/tags/3.1/tests/metadata_browser/metadata_browser.lpi new file mode 100644 index 000000000..41857c35d --- /dev/null +++ b/wst/tags/3.1/tests/metadata_browser/metadata_browser.lpi @@ -0,0 +1,326 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/metadata_browser/metadata_browser.lpr b/wst/tags/3.1/tests/metadata_browser/metadata_browser.lpr new file mode 100644 index 000000000..fd235bdfc --- /dev/null +++ b/wst/tags/3.1/tests/metadata_browser/metadata_browser.lpr @@ -0,0 +1,19 @@ +program metadata_browser; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, umain, metadata_service_proxy, indylaz, + metadata_service; + +begin + Application.Initialize; + Application.CreateForm(TfMain, fMain); + Application.Run; +end. + diff --git a/wst/tags/3.1/tests/metadata_browser/umain.lfm b/wst/tags/3.1/tests/metadata_browser/umain.lfm new file mode 100644 index 000000000..fa99c6460 --- /dev/null +++ b/wst/tags/3.1/tests/metadata_browser/umain.lfm @@ -0,0 +1,150 @@ +object fMain: TfMain + Left = 175 + Height = 311 + Top = 233 + Width = 574 + HorzScrollBar.Page = 573 + VertScrollBar.Page = 310 + ActiveControl = edtAddress + Caption = 'WST Metadata Browser' + object pnlHead: TPanel + Height = 82 + Width = 574 + Align = alTop + TabOrder = 0 + object Label1: TLabel + Left = 14 + Height = 14 + Top = 12 + Width = 20 + Caption = 'URL' + Color = clNone + ParentColor = False + end + object Label3: TLabel + Left = 11 + Height = 14 + Top = 46 + Width = 35 + Caption = 'Format' + Color = clNone + ParentColor = False + end + object edtAddress: TEdit + Left = 88 + Height = 23 + Top = 12 + Width = 480 + Anchors = [akTop, akLeft, akRight] + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -13 + Font.Name = 'Arial' + Font.Pitch = fpVariable + TabOrder = 0 + Text = 'http://127.0.0.1:8000/wst/services/IWSTMetadataService' + end + object btnGetRepList: TButton + Left = 477 + Height = 25 + Top = 40 + Width = 91 + Action = actGetRepositoryList + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + TabOrder = 2 + end + object edtFormat: TRadioGroup + Left = 88 + Height = 37 + Top = 35 + Width = 238 + AutoFill = True + Caption = ' &Format ' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + Columns = 2 + ItemIndex = 0 + Items.Strings = ( + '&SOAP' + '&binary' + ) + TabOrder = 1 + end + end + object pnlClient: TPanel + Height = 229 + Top = 82 + Width = 574 + Align = alClient + BevelInner = bvRaised + BevelOuter = bvLowered + TabOrder = 1 + object Label2: TLabel + Left = 14 + Height = 14 + Top = 14 + Width = 53 + Caption = 'Repository' + Color = clNone + ParentColor = False + end + object edtRepositoryList: TComboBox + Left = 112 + Height = 21 + Top = 7 + Width = 344 + Anchors = [akTop, akLeft, akRight] + AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] + MaxLength = 0 + TabOrder = 0 + Text = 'edtRepositoryList' + end + object tvwMetadata: TTreeView + Left = 11 + Height = 176 + Top = 38 + Width = 555 + Anchors = [akTop, akLeft, akRight, akBottom] + DefaultItemHeight = 18 + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -13 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + ReadOnly = True + TabOrder = 1 + Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoShowSeparators, tvoToolTips] + TreeLineColor = clNavy + end + object Button1: TButton + Left = 477 + Height = 25 + Top = 6 + Width = 91 + Action = actGetRepository + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + TabOrder = 2 + end + end + object AL: TActionList + left = 48 + top = 384 + object actGetRepositoryList: TAction + Caption = 'Get Rep. List' + OnExecute = actGetRepositoryListExecute + end + object actGetRepository: TAction + Caption = 'Get Repository' + OnExecute = actGetRepositoryExecute + OnUpdate = actGetRepositoryUpdate + end + end +end diff --git a/wst/tags/3.1/tests/metadata_browser/umain.lrs b/wst/tags/3.1/tests/metadata_browser/umain.lrs new file mode 100644 index 000000000..3ab0a63c2 --- /dev/null +++ b/wst/tags/3.1/tests/metadata_browser/umain.lrs @@ -0,0 +1,51 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TfMain','FORMDATA',[ + 'TPF0'#6'TfMain'#5'fMain'#4'Left'#3#175#0#6'Height'#3'7'#1#3'Top'#3#233#0#5'W' + +'idth'#3'>'#2#18'HorzScrollBar.Page'#3'='#2#18'VertScrollBar.Page'#3'6'#1#13 + +'ActiveControl'#7#10'edtAddress'#7'Caption'#6#20'WST Metadata Browser'#0#6'T' + +'Panel'#7'pnlHead'#6'Height'#2'R'#5'Width'#3'>'#2#5'Align'#7#5'alTop'#8'TabO' + +'rder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2#14#6'Height'#2#14#3'Top'#2#12#5'W' + +'idth'#2#20#7'Caption'#6#3'URL'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6 + +'TLabel'#6'Label3'#4'Left'#2#11#6'Height'#2#14#3'Top'#2'.'#5'Width'#2'#'#7'C' + +'aption'#6#6'Format'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#5'TEdit'#10 + +'edtAddress'#4'Left'#2'X'#6'Height'#2#23#3'Top'#2#12#5'Width'#3#224#1#7'Anch' + +'ors'#11#5'akTop'#6'akLeft'#7'akRight'#0#12'Font.CharSet'#7#12'ANSI_CHARSET' + +#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#243#9'Font.Name'#6#5'Arial'#10 + +'Font.Pitch'#7#10'fpVariable'#8'TabOrder'#2#0#4'Text'#6'6http://127.0.0.1:80' + +'00/wst/services/IWSTMetadataService'#0#0#7'TButton'#13'btnGetRepList'#4'Lef' + +'t'#3#221#1#6'Height'#2#25#3'Top'#2'('#5'Width'#2'['#6'Action'#7#20'actGetRe' + +'positoryList'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBor' + +'der'#2#4#8'TabOrder'#2#2#0#0#11'TRadioGroup'#9'edtFormat'#4'Left'#2'X'#6'He' + +'ight'#2'%'#3'Top'#2'#'#5'Width'#3#238#0#8'AutoFill'#9#7'Caption'#6#9' &Form' + +'at '#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpacing'#2 + +#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResize'#27'Child' + +'Sizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'ChildSizing.Shrin' + +'kHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7#14'crsSc' + +'aleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBottom'#27'Ch' + +'ildSizing.ControlsPerLine'#2#2#7'Columns'#2#2#9'ItemIndex'#2#0#13'Items.Str' + +'ings'#1#6#5'&SOAP'#6#7'&binary'#0#8'TabOrder'#2#1#0#0#0#6'TPanel'#9'pnlClie' + +'nt'#6'Height'#3#229#0#3'Top'#2'R'#5'Width'#3'>'#2#5'Align'#7#8'alClient'#10 + +'BevelInner'#7#8'bvRaised'#10'BevelOuter'#7#9'bvLowered'#8'TabOrder'#2#1#0#6 + +'TLabel'#6'Label2'#4'Left'#2#14#6'Height'#2#14#3'Top'#2#14#5'Width'#2'5'#7'C' + +'aption'#6#10'Repository'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#9'TComb' + +'oBox'#17'edtRepositoryList'#4'Left'#2'p'#6'Height'#2#21#3'Top'#2#7#5'Width' + +#3'X'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#16'AutoCompleteText'#11 + +#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0#9'MaxLength'#2#0#8'Ta' + +'bOrder'#2#0#4'Text'#6#17'edtRepositoryList'#0#0#9'TTreeView'#11'tvwMetadata' + +#4'Left'#2#11#6'Height'#3#176#0#3'Top'#2'&'#5'Width'#3'+'#2#7'Anchors'#11#5 + +'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#17'DefaultItemHeight'#2#18#12'Fon' + +'t.CharSet'#7#12'ANSI_CHARSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2 + +#243#9'Font.Name'#6#11'Courier New'#10'Font.Pitch'#7#7'fpFixed'#8'ReadOnly'#9 + +#8'TabOrder'#2#1#7'Options'#11#17'tvoAutoItemHeight'#16'tvoHideSelection'#21 + +'tvoKeepCollapsedNodes'#11'tvoReadOnly'#14'tvoShowButtons'#12'tvoShowLines' + +#11'tvoShowRoot'#17'tvoShowSeparators'#11'tvoToolTips'#0#13'TreeLineColor'#7 + +#6'clNavy'#0#0#7'TButton'#7'Button1'#4'Left'#3#221#1#6'Height'#2#25#3'Top'#2 + +#6#5'Width'#2'['#6'Action'#7#16'actGetRepository'#7'Anchors'#11#5'akTop'#7'a' + +'kRight'#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#2#0#0#0#11'TActio' + +'nList'#2'AL'#4'left'#2'0'#3'top'#3#128#1#0#7'TAction'#20'actGetRepositoryLi' + +'st'#7'Caption'#6#13'Get Rep. List'#9'OnExecute'#7#27'actGetRepositoryListEx' + +'ecute'#0#0#7'TAction'#16'actGetRepository'#7'Caption'#6#14'Get Repository'#9 + +'OnExecute'#7#23'actGetRepositoryExecute'#8'OnUpdate'#7#22'actGetRepositoryU' + +'pdate'#0#0#0#0 +]); diff --git a/wst/tags/3.1/tests/metadata_browser/umain.pas b/wst/tags/3.1/tests/metadata_browser/umain.pas new file mode 100644 index 000000000..e8780389c --- /dev/null +++ b/wst/tags/3.1/tests/metadata_browser/umain.pas @@ -0,0 +1,164 @@ +unit umain; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, + StdCtrls, Buttons, ActnList, metadata_service, ComCtrls; + +type + + { TfMain } + + TfMain = class(TForm) + actGetRepositoryList: TAction; + actGetRepository: TAction; + AL: TActionList; + btnGetRepList: TButton; + Button1: TButton; + edtRepositoryList: TComboBox; + edtAddress: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + pnlClient: TPanel; + pnlHead: TPanel; + edtFormat: TRadioGroup; + tvwMetadata: TTreeView; + procedure actGetRepositoryExecute(Sender: TObject); + procedure actGetRepositoryListExecute(Sender: TObject); + procedure actGetRepositoryUpdate(Sender: TObject); + private + function CreateMetadataObject():IWSTMetadataService; + procedure LoadRepository(ARep : TWSTMtdRepository); + public + { public declarations } + end; + +var + fMain: TfMain; + +implementation +uses base_service_intf, service_intf, + soap_formatter, binary_formatter, + synapse_http_protocol, //indy_http_protocol, ics_http_protocol, + //ics_tcp_protocol, + metadata_service_proxy; + +{ TfMain } + +procedure TfMain.actGetRepositoryListExecute(Sender: TObject); +var + tmpObj : IWSTMetadataService; + locList : TArrayOfStringRemotable; + i : Integer; +begin + tmpObj := CreateMetadataObject(); + locList := tmpObj.GetRepositoryList(); + edtRepositoryList.Items.Clear(); + for i := 0 to Pred(locList.Length) do begin + edtRepositoryList.Items.Add(locList.Item[i]); + end; +end; + +procedure TfMain.actGetRepositoryExecute(Sender: TObject); +var + rd : TWSTMtdRepository; +begin + rd := CreateMetadataObject().GetRepositoryInfo(edtRepositoryList.Items[edtRepositoryList.ItemIndex]); + try + LoadRepository(rd); + finally + rd.Free(); + end; +end; + +procedure TfMain.actGetRepositoryUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := ( edtRepositoryList.ItemIndex > -1 ); +end; + +function TfMain.CreateMetadataObject(): IWSTMetadataService; +const FORMAT_MAP : Array[0..1] of string = ( 'SOAP', 'binary' ); +var + i : Integer; + s : string; +begin + i := edtFormat.ItemIndex; + if not ( i in [0..1] ) then + i := 0; + s := FORMAT_MAP[i]; + Result := TWSTMetadataService_Proxy.Create( + 'WSTMetadataService', + s, + Format('http:Address=%s',[edtAddress.Text])// 'http:Address=http://127.0.0.1:8000/services/IWSTMetadataService' + ) as IWSTMetadataService;//'TCP:Address=127.0.0.1;Port=1234;target=Calculator' +end; + +procedure TfMain.LoadRepository(ARep: TWSTMtdRepository); + + procedure LoadService(ASrvsNd : TTreeNode; AService : TWSTMtdService); + + procedure LoadOperation(AOprsNd : TTreeNode; AOper : TWSTMtdServiceOperation); + + procedure LoadParam(APrmsNd : TTreeNode; APrm : TWSTMtdOperationParam); + var + prmNd : TTreeNode; + begin + prmNd := tvwMetadata.Items.AddChild(APrmsNd,APrm.Name); + tvwMetadata.Items.AddChild(prmNd,Format('Name = %s',[APrm.Name])); + tvwMetadata.Items.AddChild(prmNd,Format('Type = %s',[APrm.TypeName])); + end; + + var + opNd, prmsNd : TTreeNode; + ii, cc : Integer; + begin + opNd := tvwMetadata.Items.AddChild(AOprsNd,AOper.Name); + tvwMetadata.Items.AddChild(opNd,Format('Name = %s',[AOper.Name])); + cc := AOper.Params.Length; + prmsNd := tvwMetadata.Items.AddChild(opNd,Format('Parameters = %d',[cc])); + for ii := 0 to Pred(cc) do + LoadParam(prmsNd,AOper.Params[ii]); + end; + + var + svNd, oprsNd : TTreeNode; + j, k : Integer; + begin + svNd := tvwMetadata.Items.AddChild(ASrvsNd,AService.Name); + tvwMetadata.Items.AddChild(svNd,Format('Name = %s',[AService.Name])); + k := AService.Operations.Length; + oprsNd := tvwMetadata.Items.AddChild(svNd,Format('Operations = %d',[k])); + for j := 0 to Pred(k) do + LoadOperation(oprsNd,AService.Operations[j]); + end; + +var + rtNd, srvsNd : TTreeNode; + i, c : Integer; +begin + tvwMetadata.Items.Clear(); + if not Assigned(ARep) then + Exit; + rtNd := tvwMetadata.Items.AddChild(Nil,ARep.Name); + tvwMetadata.Items.AddChild(rtNd,Format('Name = %s',[ARep.Name])); + tvwMetadata.Items.AddChild(rtNd,Format('Name Space = %s',[ARep.Name])); + c := ARep.Services.Length; + srvsNd := tvwMetadata.Items.AddChild(rtNd,Format('Services Count = %d',[c])); + for i := 0 to Pred(c) do begin + LoadService(srvsNd,ARep.Services[i]); + end; +end; + +initialization + {$I umain.lrs} + + RegisterStdTypes(); + SYNAPSE_RegisterHTTP_Transport(); + //ICS_RegisterHTTP_Transport(); + //INDY_RegisterHTTP_Transport(); +end. + diff --git a/wst/tags/3.1/tests/tcp_server/server_unit.pas b/wst/tags/3.1/tests/tcp_server/server_unit.pas new file mode 100644 index 000000000..75322866b --- /dev/null +++ b/wst/tags/3.1/tests/tcp_server/server_unit.pas @@ -0,0 +1,270 @@ +unit server_unit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Windows, Dialogs, + WSocket, WSocketS; + + +Type + + { TTcpSrvClient } + + TTcpSrvClient = class(TWSocketClient) + Private + FConnectTime: TDateTime; + FDataLentgh: LongInt; + FRequestStream : TStream; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy();override; + function TryRead():Boolean; + property ConnectTime : TDateTime Read FConnectTime Write FConnectTime; + property RequestStream : TStream Read FRequestStream; + property DataLentgh : LongInt Read FDataLentgh; + end; + + { TTcpSrvApp } + + TTcpSrvApp = class + Private + procedure HandleClientConnect(Sender: TObject;Client: TWSocketClient; Error: Word); + procedure HandleClientDisconnect(Sender: TObject; + Client: TWSocketClient; Error: Word); + procedure HandleBgException(Sender: TObject; E: Exception; + var CanClose: Boolean); + private + FWSocketServer: TWSocketServer; + procedure ClientDataAvailable(Sender: TObject; Error: Word); + procedure ProcessData(Client : TTcpSrvClient); + procedure ClientBgException(Sender : TObject; + E : Exception; + var CanClose : Boolean); + procedure ClientLineLimitExceeded(Sender : TObject; + Cnt : LongInt; + var ClearData : Boolean); + Public + constructor Create(); + destructor Destroy();override; + procedure Display(Msg : String); + procedure Start(); + procedure Stop(); + function IsActive():Boolean; + End; + +Implementation +uses umain, server_service_intf, server_service_imputils, binary_streamer; + +procedure LogMsg(const Msg : String); +Begin + fMain.LogMessage(Msg); +End; + +procedure TTcpSrvApp.Display(Msg : String); +begin + LogMsg(Msg); +end; + +procedure TTcpSrvApp.Start(); +begin + Display('Starting...'); + FWSocketServer.Proto := 'tcp'; { Use TCP protocol } + FWSocketServer.Port := '1234'; + FWSocketServer.Addr := '0.0.0.0'; { Use any interface } + FWSocketServer.ClientClass := TTcpSrvClient; + FWSocketServer.Listen; { Start litening } + Display('Waiting for clients...'); +end; + +procedure TTcpSrvApp.Stop(); +begin + FWSocketServer.CloseDelayed(); +end; + +function TTcpSrvApp.IsActive(): Boolean; +begin + Result := ( FWSocketServer.State < wsClosed ); +end; + +procedure TTcpSrvApp.HandleClientConnect( + Sender : TObject; + Client : TWSocketClient; + Error : Word); +begin + with Client as TTcpSrvClient do begin + Display('Client connected.' + + ' Remote: ' + PeerAddr + '/' + PeerPort + + ' Local: ' + GetXAddr + '/' + GetXPort); + Display('There is now ' + + IntToStr(TWSocketServer(Sender).ClientCount) + + ' clients connected.'); + LineMode := False; + LineEdit := False; + OnDataAvailable := @ClientDataAvailable; + OnLineLimitExceeded := @ClientLineLimitExceeded; + OnBgException := @ClientBgException; + ConnectTime := Now; + end; +end; + +procedure TTcpSrvApp.HandleClientDisconnect( + Sender : TObject; + Client : TWSocketClient; + Error : Word); +begin + with Client as TTcpSrvClient do begin + Display('Client disconnecting : ' + PeerAddr + ' ' + + 'Duration: ' + FormatDateTime('hh:nn:ss', + Now - ConnectTime)); + Display('There is now ' + + IntToStr(TWSocketServer(Sender).ClientCount - 1) + + ' clients connected.'); + end; +end; + +procedure TTcpSrvApp.ClientLineLimitExceeded( + Sender : TObject; + Cnt : LongInt; + var ClearData : Boolean); +begin + with Sender as TTcpSrvClient do begin + Display('Line limit exceeded from ' + GetPeerAddr + '. Closing.'); + ClearData := TRUE; + Close; + end; +end; + +constructor TTcpSrvApp.Create(); +begin + FWSocketServer := TWSocketServer.Create(Nil); + FWSocketServer.Banner := ''; + FWSocketServer.OnClientConnect := @HandleClientConnect; + FWSocketServer.OnBgException := @HandleBgException; + FWSocketServer.OnClientDisconnect := @HandleClientDisconnect; +end; + +destructor TTcpSrvApp.Destroy(); +begin + FWSocketServer.Free(); +end; + +procedure TTcpSrvApp.ClientDataAvailable(Sender : TObject;Error : Word); +Var + cliTCP : TTcpSrvClient; +begin + cliTCP := Sender as TTcpSrvClient; + //Display('ClientDataAvailable()'); + If cliTCP.TryRead() And ( cliTCP.DataLentgh > 0 ) Then + ProcessData(cliTCP) +end; + +procedure TTcpSrvApp.ProcessData(Client : TTcpSrvClient); +Var + buff, trgt,ctntyp : string; + rqst : IRequestBuffer; + wrtr : IDataStore; + rdr : IDataStoreReader; + inStream, outStream, bufStream : TMemoryStream; + i : Integer; +begin + inStream := Nil; + outStream := Nil; + bufStream := Nil; + Try + Client.RequestStream.Position := 0; + Try + inStream := TMemoryStream.Create(); + outStream := TMemoryStream.Create(); + bufStream := TMemoryStream.Create(); + rdr := CreateBinaryReader(Client.RequestStream); + trgt := rdr.ReadStr(); + ctntyp := rdr.ReadStr(); + buff := rdr.ReadStr(); + inStream.Write(buff[1],Length(buff)); + inStream.Position := 0; + rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream); + HandleServiceRequest(rqst); + i := bufStream.Size; + SetLength(buff,i); + bufStream.Position := 0; + bufStream.Read(buff[1],i); + wrtr := CreateBinaryWriter(outStream); + wrtr.WriteStr(buff); + //Display('ProcessData() resp Ln =' + IntToStr(i) + '; resp = ' + buff); + Client.Send(outStream.Memory,outStream.Size); + Finally + //Display('ProcessData()>> END'); + bufStream.Free(); + outStream.Free(); + inStream.Free(); + Client.FDataLentgh := -1; + Client.RequestStream.Size := 0; + End; + Except + On e : Exception Do + Display('ProcessData()>> Exception = '+e.Message); + End; +end; + +procedure TTcpSrvApp.HandleBgException( + Sender : TObject; + E : Exception; + var CanClose : Boolean); +begin + Display('Server exception occured: ' + E.ClassName + ': ' + E.Message); + CanClose := FALSE; { Hoping that server will still work ! } +end; + +procedure TTcpSrvApp.ClientBgException( + Sender : TObject; + E : Exception; + var CanClose : Boolean); +begin + Display('Client exception occured: ' + E.ClassName + ': ' + E.Message); + CanClose := TRUE; { Goodbye client ! } +end; + +{ TTcpSrvClient } + +constructor TTcpSrvClient.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FDataLentgh := -1; + FRequestStream := TMemoryStream.Create(); +end; + +destructor TTcpSrvClient.Destroy(); +begin + FRequestStream.Free(); + inherited Destroy(); +end; + +function TTcpSrvClient.TryRead(): Boolean; +Var + i,j : PtrInt; + buff : string; +begin + If ( FDataLentgh < 0 ) Then Begin + i := 4; + If ( Receive(@FDataLentgh,i) < 4 ) Then Begin + FDataLentgh := -1; + Result := False; + Exit; + End; + FDataLentgh := Reverse_32(FDataLentgh); + End; + If ( FDataLentgh > FRequestStream.Size ) Then Begin + i := Min((FDataLentgh-FRequestStream.Size),1024); + SetLength(buff,i); + j := Receive(@(buff[1]),i); + FRequestStream.Write(buff[1],j); + //LogMsg(Format('Read %d bytes; buff=%s',[j,buff])); + End; + Result := ( FDataLentgh <= FRequestStream.Size ); + //LogMsg(Format('TryRead() >> FDataLentgh=%d; Size=%d',[FDataLentgh,FRequestStream.Size])); +end; + +end. diff --git a/wst/tags/3.1/tests/tcp_server/tcp_gui_server.lpi b/wst/tags/3.1/tests/tcp_server/tcp_gui_server.lpi new file mode 100644 index 000000000..8965410ba --- /dev/null +++ b/wst/tags/3.1/tests/tcp_server/tcp_gui_server.lpi @@ -0,0 +1,381 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/tcp_server/tcp_gui_server.lpr b/wst/tags/3.1/tests/tcp_server/tcp_gui_server.lpr new file mode 100644 index 000000000..abe43a526 --- /dev/null +++ b/wst/tags/3.1/tests/tcp_server/tcp_gui_server.lpr @@ -0,0 +1,17 @@ +program tcp_gui_server; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, umain, server_unit, calculator, calculator_imp, calculator_binder; + +begin + Application.Initialize; + Application.CreateForm(TfMain, fMain); + Application.Run; +end. + diff --git a/wst/tags/3.1/tests/tcp_server/umain.lfm b/wst/tags/3.1/tests/tcp_server/umain.lfm new file mode 100644 index 000000000..1a1e9b16b --- /dev/null +++ b/wst/tags/3.1/tests/tcp_server/umain.lfm @@ -0,0 +1,77 @@ +object fMain: TfMain + Left = 290 + Height = 300 + Top = 180 + Width = 400 + HorzScrollBar.Page = 399 + VertScrollBar.Page = 299 + ActiveControl = Button1 + Caption = 'Simple TCP App Server' + ClientHeight = 300 + ClientWidth = 400 + OnCreate = FormCreate + PixelsPerInch = 96 + object Label1: TLabel + Left = 16 + Height = 14 + Top = 72 + Width = 18 + Caption = 'Log' + Color = clNone + ParentColor = False + end + object Button1: TButton + Left = 16 + Height = 25 + Top = 8 + Width = 104 + Action = actStart + BorderSpacing.InnerBorder = 2 + TabOrder = 0 + end + object mmoLog: TMemo + Left = 8 + Height = 192 + Top = 96 + Width = 384 + Anchors = [akTop, akLeft, akRight, akBottom] + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 1 + end + object Button2: TButton + Left = 16 + Height = 25 + Top = 40 + Width = 104 + Action = actStop + BorderSpacing.InnerBorder = 2 + TabOrder = 2 + end + object edtPort: TEdit + Left = 128 + Height = 23 + Top = 10 + Width = 80 + TabOrder = 3 + Text = '1234' + end + object AL: TActionList + left = 152 + top = 32 + object actStart: TAction + Caption = 'Start( Port=)' + OnExecute = actStartExecute + OnUpdate = actStartUpdate + end + object actStop: TAction + Caption = 'Stop' + OnExecute = actStopExecute + OnUpdate = actStopUpdate + end + object actClearLog: TAction + Caption = 'Clear Log' + OnExecute = actClearLogExecute + end + end +end diff --git a/wst/tags/3.1/tests/tcp_server/umain.lrs b/wst/tags/3.1/tests/tcp_server/umain.lrs new file mode 100644 index 000000000..5910ad7aa --- /dev/null +++ b/wst/tags/3.1/tests/tcp_server/umain.lrs @@ -0,0 +1,24 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TfMain','FORMDATA',[ + 'TPF0'#6'TfMain'#5'fMain'#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#180#0#5'Wi' + +'dth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#13 + +'ActiveControl'#7#7'Button1'#7'Caption'#6#21'Simple TCP App Server'#12'Clien' + +'tHeight'#3','#1#11'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#13'Pix' + +'elsPerInch'#2'`'#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#14#3'Top'#2 + +'H'#5'Width'#2#18#7'Caption'#6#3'Log'#5'Color'#7#6'clNone'#11'ParentColor'#8 + +#0#0#7'TButton'#7'Button1'#4'Left'#2#16#6'Height'#2#25#3'Top'#2#8#5'Width'#2 + +'h'#6'Action'#7#8'actStart'#25'BorderSpacing.InnerBorder'#2#2#8'TabOrder'#2#0 + +#0#0#5'TMemo'#6'mmoLog'#4'Left'#2#8#6'Height'#3#192#0#3'Top'#2'`'#5'Width'#3 + +#128#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#8'ReadOnly' + +#9#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#1#0#0#7'TButton'#7'Button2' + +#4'Left'#2#16#6'Height'#2#25#3'Top'#2'('#5'Width'#2'h'#6'Action'#7#7'actStop' + +#25'BorderSpacing.InnerBorder'#2#2#8'TabOrder'#2#2#0#0#5'TEdit'#7'edtPort'#4 + +'Left'#3#128#0#6'Height'#2#23#3'Top'#2#10#5'Width'#2'P'#8'TabOrder'#2#3#4'Te' + +'xt'#6#4'1234'#0#0#11'TActionList'#2'AL'#4'left'#3#152#0#3'top'#2' '#0#7'TAc' + +'tion'#8'actStart'#7'Caption'#6#13'Start( Port=)'#9'OnExecute'#7#15'actStart' + +'Execute'#8'OnUpdate'#7#14'actStartUpdate'#0#0#7'TAction'#7'actStop'#7'Capti' + +'on'#6#4'Stop'#9'OnExecute'#7#14'actStopExecute'#8'OnUpdate'#7#13'actStopUpd' + +'ate'#0#0#7'TAction'#11'actClearLog'#7'Caption'#6#9'Clear Log'#9'OnExecute'#7 + +#18'actClearLogExecute'#0#0#0#0 +]); diff --git a/wst/tags/3.1/tests/tcp_server/umain.pas b/wst/tags/3.1/tests/tcp_server/umain.pas new file mode 100644 index 000000000..e42cd76b7 --- /dev/null +++ b/wst/tags/3.1/tests/tcp_server/umain.pas @@ -0,0 +1,98 @@ +unit umain; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, + StdCtrls, ActnList, ExtCtrls; + +type + + { TfMain } + + TfMain = class(TForm) + actClearLog: TAction; + actStop: TAction; + actStart: TAction; + AL: TActionList; + Button1: TButton; + Button2: TButton; + edtPort: TEdit; + Label1: TLabel; + mmoLog: TMemo; + procedure actClearLogExecute(Sender: TObject); + procedure actStartExecute(Sender: TObject); + procedure actStartUpdate(Sender: TObject); + procedure actStopExecute(Sender: TObject); + procedure actStopUpdate(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + public + procedure LogMessage(const AMsg : string); + end; + +var + fMain: TfMain; + +implementation +uses server_unit, + server_service_soap, server_binary_formatter, + calculator, calculator_imp, calculator_binder; + +Var + scktServer : TTcpSrvApp; + +{ TfMain } + +procedure TfMain.actStartUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Not ( Assigned(scktServer) And scktServer.IsActive() ); +end; + +procedure TfMain.actStopExecute(Sender: TObject); +begin + If Assigned(scktServer) Then Begin + scktServer.Stop(); + End; +end; + +procedure TfMain.actStopUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(scktServer) And scktServer.IsActive(); +end; + +procedure TfMain.actStartExecute(Sender: TObject); +begin + mmoLog.Clear(); + If Not Assigned(scktServer) Then + scktServer := TTcpSrvApp.Create(); + If Not scktServer.IsActive() Then + scktServer.Start(); +end; + +procedure TfMain.actClearLogExecute(Sender: TObject); +begin + mmoLog.Clear(); +end; + +procedure TfMain.FormCreate(Sender: TObject); +begin + Server_service_RegisterCalculatorService(); + Server_service_RegisterCalculatorService(); + RegisterCalculatorImplementationFactory(); + Server_service_RegisterSoapFormat(); + Server_service_RegisterBinaryFormat(); +end; + +procedure TfMain.LogMessage(const AMsg: string); +begin + mmoLog.Lines.Add(AMsg); +end; + +initialization + {$I umain.lrs} + +end. + diff --git a/wst/tags/3.1/tests/test_float_to_str/project1.lpi b/wst/tags/3.1/tests/test_float_to_str/project1.lpi new file mode 100644 index 000000000..387f7eb93 --- /dev/null +++ b/wst/tags/3.1/tests/test_float_to_str/project1.lpi @@ -0,0 +1,171 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/test_float_to_str/project1.lpr b/wst/tags/3.1/tests/test_float_to_str/project1.lpr new file mode 100644 index 000000000..63cbfae1d --- /dev/null +++ b/wst/tags/3.1/tests/test_float_to_str/project1.lpr @@ -0,0 +1,18 @@ +program project1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, Unit1; + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/wst/tags/3.1/tests/test_float_to_str/unit1.lfm b/wst/tags/3.1/tests/test_float_to_str/unit1.lfm new file mode 100644 index 000000000..f1dbc25f1 --- /dev/null +++ b/wst/tags/3.1/tests/test_float_to_str/unit1.lfm @@ -0,0 +1,58 @@ +object Form1: TForm1 + Left = 295 + Height = 300 + Top = 234 + Width = 400 + HorzScrollBar.Page = 399 + VertScrollBar.Page = 299 + Caption = 'Form1' + ClientHeight = 300 + ClientWidth = 400 + PixelsPerInch = 96 + object Button1: TButton + Left = 72 + Height = 25 + Top = 56 + Width = 75 + BorderSpacing.InnerBorder = 2 + Caption = 'Button1' + OnClick = Button1Click + TabOrder = 0 + end + object Edit1: TEdit + Left = 176 + Height = 23 + Top = 58 + Width = 80 + TabOrder = 1 + Text = '124656.32145' + end + object Memo1: TMemo + Left = 24 + Height = 184 + Top = 104 + Width = 352 + Lines.Strings = ( + 'Memo1' + ) + TabOrder = 2 + end + object Edit2: TEdit + Left = 103 + Height = 23 + Top = 26 + Width = 80 + TabOrder = 3 + Text = '#.#######E-0' + end + object Button2: TButton + Left = 264 + Height = 25 + Top = 24 + Width = 75 + BorderSpacing.InnerBorder = 2 + Caption = 'Button2' + OnClick = Button2Click + TabOrder = 4 + end +end diff --git a/wst/tags/3.1/tests/test_float_to_str/unit1.lrs b/wst/tags/3.1/tests/test_float_to_str/unit1.lrs new file mode 100644 index 000000000..4db2d6571 --- /dev/null +++ b/wst/tags/3.1/tests/test_float_to_str/unit1.lrs @@ -0,0 +1,17 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3''''#1#6'Height'#3','#1#3'Top'#3#234#0#5'W' + +'idth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#7 + +'Caption'#6#5'Form1'#12'ClientHeight'#3','#1#11'ClientWidth'#3#144#1#13'Pixe' + +'lsPerInch'#2'`'#0#7'TButton'#7'Button1'#4'Left'#2'H'#6'Height'#2#25#3'Top'#2 + +'8'#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#7'Button1'#7 + +'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#0#0#5'TEdit'#5'Edit1'#4'Left'#3 + +#176#0#6'Height'#2#23#3'Top'#2':'#5'Width'#2'P'#8'TabOrder'#2#1#4'Text'#6#12 + +'124656.32145'#0#0#5'TMemo'#5'Memo1'#4'Left'#2#24#6'Height'#3#184#0#3'Top'#2 + +'h'#5'Width'#3'`'#1#13'Lines.Strings'#1#6#5'Memo1'#0#8'TabOrder'#2#2#0#0#5'T' + +'Edit'#5'Edit2'#4'Left'#2'g'#6'Height'#2#23#3'Top'#2#26#5'Width'#2'P'#8'TabO' + +'rder'#2#3#4'Text'#6#12'#.#######E-0'#0#0#7'TButton'#7'Button2'#4'Left'#3#8#1 + +#6'Height'#2#25#3'Top'#2#24#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#2#7 + +'Caption'#6#7'Button2'#7'OnClick'#7#12'Button2Click'#8'TabOrder'#2#4#0#0#0 +]); diff --git a/wst/tags/3.1/tests/test_float_to_str/unit1.pas b/wst/tags/3.1/tests/test_float_to_str/unit1.pas new file mode 100644 index 000000000..d5759d2f9 --- /dev/null +++ b/wst/tags/3.1/tests/test_float_to_str/unit1.pas @@ -0,0 +1,69 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, + StdCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + Button1: TButton; + Button2: TButton; + Edit1: TEdit; + Edit2: TEdit; + Memo1: TMemo; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +{ TForm1 } + +procedure TForm1.Button1Click(Sender: TObject); +Var + s : single; +begin + If TryStrToFloat(Edit1.Text,s) then begin + Memo1.Clear(); + Memo1.Lines.Add(FloatToStrF(s,ffExponent,8,5)); + Memo1.Lines.Add(FloatToStrF(s,ffGeneral,8,5)); + Memo1.Lines.Add(FloatToStrF(s,ffFixed,8,5)); + Memo1.Lines.Add(FloatToStrF(s,ffNumber,8,5)); + Memo1.Lines.Add(FloatToStrF(s,ffCurrency,8,5)) ; + Memo1.Lines.Add(FormatFloat(Edit2.Text,s)); + end; +end; + +procedure TForm1.Button2Click(Sender: TObject); +Var + v : TFloatRec; + s : single; + b : string; +begin + If TryStrToFloat(Edit1.Text,s) then begin + FillChar(v,SizeOf(v),0); + FloatToDecimal(v,s,7,1); + Memo1.Clear(); + Memo1.Lines.Add(Format('%d',[v.Exponent])); + end; +end; + +initialization + {$I unit1.lrs} + +end. + diff --git a/wst/tags/3.1/tests/test_suite/testformatter_unit.pas b/wst/tags/3.1/tests/test_suite/testformatter_unit.pas new file mode 100644 index 000000000..1f7f9661e --- /dev/null +++ b/wst/tags/3.1/tests/test_suite/testformatter_unit.pas @@ -0,0 +1,2142 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} + +unit testformatter_unit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testutils, testregistry, + TypInfo, + base_service_intf; + +type + + TTestEnum = ( teOne, teTwo, teThree, teFour ); + + { TClass_A } + + TClass_A = class(TBaseComplexRemotable) + private + FVal_32S: LongInt; + FVal_Bool: Boolean; + FVal_Enum: TTestEnum; + FVal_String: string; + Published + property Val_32S : LongInt Read FVal_32S Write FVal_32S; + property Val_Enum : TTestEnum Read FVal_Enum Write FVal_Enum; + property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool; + property Val_String : string Read FVal_String Write FVal_String; + End; + + { TClass_B } + + TClass_B = class(TBaseComplexRemotable) + private + FNonStored: Integer; + FObjProp: TClass_A; + FVal_32S: LongInt; + FVal_Bool: Boolean; + FVal_Enum: TTestEnum; + FVal_String: string; + procedure SetObjProp(const AValue: TClass_A); + Public + constructor Create();override; + destructor Destroy();override; + Published + property Val_32S : LongInt Read FVal_32S Write FVal_32S; + property Val_Enum : TTestEnum Read FVal_Enum Write FVal_Enum; + property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool; + property Val_String : string Read FVal_String Write FVal_String; + property ObjProp : TClass_A Read FObjProp Write SetObjProp stored True; + property NonStored : Integer Read FNonStored Write FNonStored stored false; + End; + + { TClass_Int } + + TClass_Int = class(TBaseComplexRemotable) + private + FVal_16S: SmallInt; + FVal_16U: Word; + FVal_32S: LongInt; + FVal_32U: LongWord; + FVal_64S: Int64; + FVal_64U: QWord; + FVal_8S: ShortInt; + FVal_8U: Byte; + Published + property Val_8U : Byte Read FVal_8U Write FVal_8U; + property Val_8S : ShortInt Read FVal_8S Write FVal_8S; + property Val_16U : Word Read FVal_16U Write FVal_16U; + property Val_16S : SmallInt Read FVal_16S Write FVal_16S; + property Val_32U : LongWord Read FVal_32U Write FVal_32U; + property Val_32S : LongInt Read FVal_32S Write FVal_32S; + property Val_64U : QWord Read FVal_64U Write FVal_64U; + property Val_64S : Int64 Read FVal_64S Write FVal_64S; + End; + + { TClass_Enum } + + TClass_Enum = class(TBaseComplexRemotable) + private + FVal_Bool: Boolean; + FVal_Enum: TTestEnum; + FVal_String: string; + Published + property Val_Enum : TTestEnum Read FVal_Enum Write FVal_Enum; + property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool; + property Val_String : string Read FVal_String Write FVal_String; + End; + + { TClass_Float } + + TClass_Float = class(TBaseComplexRemotable) + private + FVal_Currency: Currency; + FVal_Double: Double; + FVal_Extended: Extended; + FVal_Single: Single; + Published + property Val_Single : Single Read FVal_Single Write FVal_Single; + property Val_Double : Double Read FVal_Double Write FVal_Double; + property Val_Extended : Extended Read FVal_Extended Write FVal_Extended; + property Val_Currency : Currency Read FVal_Currency Write FVal_Currency; + End; + + { TTestFormatter } + + TTestFormatter= class(TTestCase) + protected + function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;virtual;abstract; + published + procedure Test_Int_8; + procedure Test_Int_16; + procedure Test_Int_32; + procedure Test_Int_64; + procedure Test_Int_WithClass; + + procedure Test_Single_4; + procedure Test_Double_8; + procedure Test_Currency_8; + procedure Test_Extended_10; + procedure Test_Float_WithClass; + + procedure Test_String; + procedure Test_Bool; + procedure Test_Enum; + procedure Test_Enum_Bool_String_WithClass; + + procedure Test_Object(); + procedure Test_Object_Nil(); + procedure Test_StringArray(); + procedure Test_StringArrayZeroLength(); + procedure Test_BooleanArray(); + + procedure Test_Int8UArray(); + procedure Test_Int8SArray(); + + procedure Test_Int16SArray(); + procedure Test_Int16UArray(); + + procedure Test_Int32UArray(); + procedure Test_Int32SArray(); + + procedure Test_Int64SArray(); + procedure Test_Int64UArray(); + + procedure Test_FloatSingleArray(); + procedure Test_FloatDoubleArray(); + procedure Test_FloatExtendedArray(); + procedure Test_FloatCurrencyArray(); + end; + + { TTestBinaryFormatter } + + TTestBinaryFormatter= class(TTestFormatter) + protected + function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; + end; + + { TTestBinaryFormatterAttributes } + + TTestBinaryFormatterAttributes= class(TTestBinaryFormatter) + protected + function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; + end; + + { TTestSOAPFormatter } + + TTestSOAPFormatter= class(TTestFormatter) + protected + function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; + end; + + { TTestSOAPFormatterAttributes } + + TTestSOAPFormatterAttributes = class(TTestSOAPFormatter) + protected + function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; + end; + + { TTestArray } + + TTestArray= class(TTestCase) + published + procedure Test_StringArray(); + procedure Test_BooleanArray(); + + procedure Test_Int8UArray(); + procedure Test_Int8SArray(); + + procedure Test_Int16SArray(); + procedure Test_Int16UArray(); + + procedure Test_Int32UArray(); + procedure Test_Int32SArray(); + + procedure Test_Int64SArray(); + procedure Test_Int64UArray(); + + procedure Test_FloatSingleArray(); + procedure Test_FloatDoubleArray(); + procedure Test_FloatExtendedArray(); + procedure Test_FloatCurrencyArray(); + end; + + { TTest_TBaseComplexRemotable } + + TTest_TBaseComplexRemotable= class(TTestCase) + published + procedure Test_Assign(); + end; + +implementation +uses base_binary_formatter, base_soap_formatter; + +procedure TTestFormatter.Test_Int_8; +const VAL_1 = 12; VAL_2 = -10; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + intVal_U : Byte; intVal_S : ShortInt; +begin + s := Nil; + Try + intVal_U := VAL_1; + intVal_S := VAL_2; + f := CreateFormatter(TypeInfo(TClass_Int)); + + f.BeginObject('Root',TypeInfo(TClass_Int)); + f.Put('intVal_U',TypeInfo(Byte),intVal_U); + f.Put('intVal_S',TypeInfo(ShortInt),intVal_S); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + intVal_U := 0; + intVal_S := 0; + + f := CreateFormatter(TypeInfo(TClass_Int)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + x := 'intVal_U'; + f.Get(TypeInfo(Byte),x,intVal_U); + x := 'intVal_S'; + f.Get(TypeInfo(ShortInt),x,intVal_S); + f.EndScopeRead(); + + AssertEquals(VAL_1,intVal_U); + AssertEquals(VAL_2,intVal_S); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Int_16; +const VAL_1 = 1210; VAL_2 : SmallInt = -1012; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + intVal_U : Word; intVal_S : SmallInt; +begin + s := Nil; + Try + intVal_U := VAL_1; + intVal_S := VAL_2; + f := CreateFormatter(TypeInfo(TClass_Int)); + + f.BeginObject('Root',TypeInfo(TClass_Int)); + f.Put('intVal_U',TypeInfo(Word),intVal_U); + f.Put('intVal_S',TypeInfo(SmallInt),intVal_S); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + intVal_U := 0; + intVal_S := 0; + + f := CreateFormatter(TypeInfo(TClass_Int)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + x := 'intVal_U'; + f.Get(TypeInfo(Word),x,intVal_U); + x := 'intVal_S'; + f.Get(TypeInfo(SmallInt),x,intVal_S); + f.EndScopeRead(); + + AssertEquals(VAL_1,intVal_U); + AssertEquals(VAL_2,intVal_S); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Int_32; +const VAL_1 = 121076; VAL_2 : LongInt = -101276; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + intVal_U : LongWord; intVal_S : LongInt; +begin + s := Nil; + Try + intVal_U := VAL_1; + intVal_S := VAL_2; + f := CreateFormatter(TypeInfo(TClass_Int)); + + f.BeginObject('Root',TypeInfo(TClass_Int)); + f.Put('intVal_U',TypeInfo(LongWord),intVal_U); + f.Put('intVal_S',TypeInfo(LongInt),intVal_S); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + intVal_U := 0; + intVal_S := 0; + + f := CreateFormatter(TypeInfo(TClass_Int)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + x := 'intVal_U'; + f.Get(TypeInfo(LongWord),x,intVal_U); + x := 'intVal_S'; + f.Get(TypeInfo(LongInt),x,intVal_S); + f.EndScopeRead(); + + AssertEquals(VAL_1,intVal_U); + AssertEquals(VAL_2,intVal_S); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Int_64; +const VAL_1 = 121076; VAL_2 : Int64 = -101276; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + intVal_U : QWord; intVal_S : Int64; +begin + s := Nil; + Try + intVal_U := VAL_1; + intVal_S := VAL_2; + f := CreateFormatter(TypeInfo(TClass_Int)); + + f.BeginObject('Root',TypeInfo(TClass_Int)); + f.Put('intVal_U',TypeInfo(QWord),intVal_U); + f.Put('intVal_S',TypeInfo(Int64),intVal_S); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + intVal_U := 0; + intVal_S := 0; + + f := CreateFormatter(TypeInfo(TClass_Int)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + x := 'intVal_U'; + f.Get(TypeInfo(QWord),x,intVal_U); + x := 'intVal_S'; + f.Get(TypeInfo(Int64),x,intVal_S); + f.EndScopeRead(); + + AssertEquals(VAL_1,intVal_U); + AssertEquals(VAL_2,intVal_S); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Int_WithClass; +Var + f : IFormatterBase; + s : TMemoryStream; + a : TClass_Int; + x : string; +begin + s := Nil; + a := TClass_Int.Create(); + Try + a.Val_8U := 8; + a.Val_8S := -8; + a.Val_16U := 16; + a.Val_16S := -16; + a.Val_32U := 32; + a.Val_32S := -32; + a.Val_64U := 64; + a.Val_64S := -64; + + f := CreateFormatter(TypeInfo(TClass_Int)); + + f.BeginObject('Root',TypeInfo(TClass_Int)); + f.Put('o1',TypeInfo(TClass_Int),a); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + + a := TClass_Int.Create(); + f := CreateFormatter(TypeInfo(TClass_Int)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + x := 'o1'; + f.Get(TypeInfo(TClass_Int),x,a); + f.EndScopeRead(); + + AssertEquals(8,a.Val_8U); + AssertEquals(-8,a.Val_8S); + AssertEquals(16,a.Val_16U); + AssertEquals(-16,a.Val_16S); + AssertEquals(32,a.Val_32U); + AssertEquals(-32,a.Val_32S); + AssertEquals(64,a.Val_64U); + AssertEquals(-64,a.Val_64S); + Finally + a.Free(); + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Single_4; +const VAL_1 = 12.10; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + tmpVal : Single; +begin + s := Nil; + Try + tmpVal := VAL_1; + f := CreateFormatter(TypeInfo(TClass_Float)); + + f.BeginObject('Root',TypeInfo(TClass_Float)); + f.Put('tmpVal',TypeInfo(Single),tmpVal); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + tmpVal := 0; + + f := CreateFormatter(TypeInfo(TClass_Float)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + x := 'tmpVal'; + f.Get(TypeInfo(Single),x,tmpVal); + f.EndScopeRead(); + + AssertEquals(VAL_1,tmpVal); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Double_8; +const VAL_1 = 12.10; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + tmpVal : Double; +begin + s := Nil; + Try + tmpVal := VAL_1; + f := CreateFormatter(TypeInfo(TClass_Float)); + + f.BeginObject('Root',TypeInfo(TClass_Float)); + f.Put('tmpVal',TypeInfo(Double),tmpVal); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + tmpVal := 0; + + f := CreateFormatter(TypeInfo(TClass_Float)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + x := 'tmpVal'; + f.Get(TypeInfo(Double),x,tmpVal); + f.EndScopeRead(); + + AssertEquals(VAL_1,tmpVal); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Currency_8; +const VAL_1 = 12.10; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + tmpVal : Currency; +begin + s := Nil; + Try + tmpVal := VAL_1; + f := CreateFormatter(TypeInfo(TClass_Float)); + + f.BeginObject('Root',TypeInfo(TClass_Float)); + f.Put('tmpVal',TypeInfo(Currency),tmpVal); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + tmpVal := 0; + + f := CreateFormatter(TypeInfo(TClass_Float)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + x := 'tmpVal'; + f.Get(TypeInfo(Currency),x,tmpVal); + f.EndScopeRead(); + + AssertEquals(VAL_1,tmpVal); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Extended_10; +const VAL_1 = 12.10; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + tmpVal : Extended; +begin + s := Nil; + Try + tmpVal := VAL_1; + f := CreateFormatter(TypeInfo(TClass_Float)); + + f.BeginObject('Root',TypeInfo(TClass_Float)); + f.Put('tmpVal',TypeInfo(Extended),tmpVal); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + tmpVal := 0; + + f := CreateFormatter(TypeInfo(TClass_Float)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + x := 'tmpVal'; + f.Get(TypeInfo(Extended),x,tmpVal); + f.EndScopeRead(); + + AssertEquals(VAL_1,tmpVal); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Float_WithClass; +Var + f : IFormatterBase; + s : TMemoryStream; + a : TClass_Float; + x : string; +begin + s := Nil; + a := TClass_Float.Create(); + Try + a.Val_Currency := 8.8; + a.Val_Double := 8.8; + a.Val_Extended := 10.10; + a.Val_Single := 4.4; + + f := CreateFormatter(TypeInfo(TClass_Float)); + + f.BeginObject('Root',TypeInfo(TClass_Float)); + f.Put('o1',TypeInfo(TClass_Float),a); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + + a := TClass_Float.Create(); + f := CreateFormatter(TypeInfo(TClass_Float)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Float),stObject); + x := 'o1'; + f.Get(TypeInfo(TClass_Float),x,a); + f.EndScopeRead(); + + AssertEquals(4.4,a.Val_Single); + AssertEquals(8.8,a.Val_Double); + AssertEquals(8.8,a.Val_Currency); + AssertEquals(10.10,a.Val_Extended); + Finally + a.Free(); + s.Free(); + End; +end; + +procedure TTestFormatter.Test_String; +const VAL_1 = 'AzErTy'; VAL_2 = 'QwErTy'; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + intVal_1 : string; intVal_3 : string; +begin + s := Nil; + Try + intVal_1 := VAL_1; + intVal_3 := VAL_2; + f := CreateFormatter(TypeInfo(TClass_Int)); + + f.BeginObject('Root',TypeInfo(TClass_Int)); + f.Put('intVal_1',TypeInfo(string),intVal_1); + f.Put('intVal_3',TypeInfo(string),intVal_3); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + intVal_1 := ''; + intVal_3 := 'yyyyyyyy'; + + f := CreateFormatter(TypeInfo(TClass_Int)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + x := 'intVal_1'; + f.Get(TypeInfo(string),x,intVal_1); + x := 'intVal_3'; + f.Get(TypeInfo(string),x,intVal_3); + f.EndScopeRead(); + + AssertEquals(VAL_1,intVal_1); + AssertEquals(VAL_2,intVal_3); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Bool; +const VAL_1 = True; VAL_2 = False; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + intVal_1 : Boolean; intVal_3 : Boolean; +begin + s := Nil; + Try + intVal_1 := VAL_1; + intVal_3 := VAL_2; + f := CreateFormatter(TypeInfo(TClass_Int)); + + f.BeginObject('Root',TypeInfo(TClass_Int)); + f.Put('intVal_1',TypeInfo(Boolean),intVal_1); + f.Put('intVal_3',TypeInfo(Boolean),intVal_3); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + intVal_1 := False; + intVal_3 := True; + + f := CreateFormatter(TypeInfo(TClass_Int)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + x := 'intVal_1'; + f.Get(TypeInfo(Boolean),x,intVal_1); + x := 'intVal_3'; + f.Get(TypeInfo(Boolean),x,intVal_3); + f.EndScopeRead(); + + AssertEquals(VAL_1,intVal_1); + AssertEquals(VAL_2,intVal_3); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Enum; +const VAL_1 = teTwo; VAL_2 = teFour; +Var + f : IFormatterBase; + s : TMemoryStream; + x : string; + intVal_1 : TTestEnum; intVal_3 : TTestEnum; +begin + s := Nil; + Try + intVal_1 := VAL_1; + intVal_3 := VAL_2; + f := CreateFormatter(TypeInfo(TClass_Int)); + + f.BeginObject('Root',TypeInfo(TClass_Enum)); + f.Put('intVal_1',TypeInfo(TTestEnum),intVal_1); + f.Put('intVal_3',TypeInfo(TTestEnum),intVal_3); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + intVal_1 := teOne; + intVal_3 := teOne; + + f := CreateFormatter(TypeInfo(TClass_Int)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Int),stObject); + x := 'intVal_1'; + f.Get(TypeInfo(TTestEnum),x,intVal_1); + x := 'intVal_3'; + f.Get(TypeInfo(TTestEnum),x,intVal_3); + f.EndScopeRead(); + + AssertEquals(Ord(VAL_1),Ord(intVal_1)); + AssertEquals(Ord(VAL_2),Ord(intVal_3)); + Finally + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Enum_Bool_String_WithClass; +Var + f : IFormatterBase; + s : TMemoryStream; + a : TClass_Enum; + x : string; +begin + s := Nil; + a := TClass_Enum.Create(); + Try + a.Val_Bool := True; + a.Val_Enum := teThree; + a.Val_String := 'atou'; + f := CreateFormatter(TypeInfo(TClass_Enum)); + + f.BeginObject('Root',TypeInfo(TClass_Enum)); + f.Put('o1',TypeInfo(TClass_Enum),a); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + + a := TClass_Enum.Create(); + f := CreateFormatter(TypeInfo(TClass_Enum)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_Enum),stObject); + x := 'o1'; + f.Get(TypeInfo(TClass_Enum),x,a); + f.EndScopeRead(); + + AssertEquals(True,a.Val_Bool); + AssertEquals(Ord(teThree),Ord(a.Val_Enum)); + AssertEquals('atou',a.Val_String); + Finally + a.Free(); + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Object(); +Var + f : IFormatterBase; + s : TMemoryStream; + a : TClass_B; + x : string; +begin + s := Nil; + a := TClass_B.Create(); + Try + a.Val_Bool := False; + a.Val_Enum := teThree; + a.Val_String := '123'; + a.ObjProp.Val_String := '456'; + a.ObjProp.Val_Enum := teFour; + a.ObjProp.Val_Bool := True; + a.ObjProp.Val_32S := 121076; + a.NonStored := 121076; + + f := CreateFormatter(TypeInfo(TClass_B)); + + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('o1',TypeInfo(TClass_B),a); + f.EndScope(); + + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + + a := TClass_B.Create(); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'o1'; + f.Get(TypeInfo(TClass_B),x,a); + f.EndScopeRead(); + + AssertEquals(False,a.Val_Bool); + AssertEquals(Ord(teThree),Ord(a.Val_Enum)); + AssertEquals('123',a.Val_String); + + AssertEquals(True,a.ObjProp.Val_Bool); + AssertEquals(Ord(teFour),Ord(a.ObjProp.Val_Enum)); + AssertEquals('456',a.ObjProp.Val_String); + AssertEquals(121076,a.ObjProp.Val_32S); + + AssertEquals(0,a.NonStored); + Finally + a.Free(); + s.Free(); + End; +end; + +procedure TTestFormatter.Test_Object_Nil(); +begin + Fail('Write me!'); +end; + +procedure TTestFormatter.Test_StringArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of string = ('AzErTy','QwErTy','123456','','1'); +var + a : TArrayOfStringRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfStringRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfStringRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfStringRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfStringRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertEquals(VAL_AR[i],a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_StringArrayZeroLength(); +var + a : TArrayOfStringRemotable; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfStringRemotable.Create(); + try + AssertEquals(0,a.Length); + + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfStringRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfStringRemotable),x,a); + f.EndScopeRead(); + AssertNotNull(a); + AssertEquals(0,a.Length); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_BooleanArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Boolean = (True,True,False,True,False); +var + a : TArrayOfBooleanRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfBooleanRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfBooleanRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfBooleanRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfBooleanRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertEquals(VAL_AR[i],a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_Int8UArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Byte = (12,34,100,200,180); +var + a : TArrayOfInt8URemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfInt8URemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfInt8URemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfInt8URemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfInt8URemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertEquals(VAL_AR[i],a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_Int8SArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of ShortInt = (-12,-34,100,200,180); +var + a : TArrayOfInt8SRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfInt8SRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfInt8SRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfInt8SRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfInt8SRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertEquals(VAL_AR[i],a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_Int16SArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of SmallInt = (-12,-34,100,200,180); +var + a : TArrayOfInt16SRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfInt16SRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfInt16SRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfInt16SRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfInt16SRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertEquals(VAL_AR[i],a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_Int16UArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Word = (12,34,100,200,180); +var + a : TArrayOfInt16URemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfInt16URemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfInt16URemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfInt16URemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfInt16URemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertEquals(VAL_AR[i],a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_Int32UArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of LongWord = (12,34,100,200,180); +var + a : TArrayOfInt32URemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfInt32URemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfInt32URemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfInt32URemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfInt32URemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertEquals(VAL_AR[i],a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_Int32SArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of LongInt = (-12,-34,100,200,180); +var + a : TArrayOfInt32SRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfInt32SRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfInt32SRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfInt32SRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfInt32SRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertEquals(VAL_AR[i],a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_Int64SArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Int64 = (-12,-34,100,200,180); +var + a : TArrayOfInt64SRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfInt64SRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfInt64SRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfInt64SRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfInt64SRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertEquals(VAL_AR[i],a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_Int64UArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of QWord = (12,34,100,200,180); +var + a : TArrayOfInt64URemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfInt64URemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfInt64URemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfInt64URemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfInt64URemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertTrue(VAL_AR[i]=a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_FloatSingleArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Single = (-12.10,-4.45,100,200.58,180.3); +var + a : TArrayOfFloatSingleRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfFloatSingleRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfFloatSingleRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfFloatSingleRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfFloatSingleRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertTrue(VAL_AR[i]=a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_FloatDoubleArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Double = (-12.10,-4.45,100,200.58,180.3); +var + a : TArrayOfFloatDoubleRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfFloatDoubleRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfFloatDoubleRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfFloatDoubleRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfFloatDoubleRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertTrue(VAL_AR[i]=a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_FloatExtendedArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Extended = (-12.10,-4.45,100,200.58,180.3); +var + a : TArrayOfFloatExtendedRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfFloatExtendedRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfFloatExtendedRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfFloatExtendedRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfFloatExtendedRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertTrue(VAL_AR[i]=a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_FloatCurrencyArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Currency = (-12.10,-4.45,100,200.58,180.3); +var + a : TArrayOfFloatCurrencyRemotable; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + a := TArrayOfFloatCurrencyRemotable.Create(); + try + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + a.SetLength(AR_LEN); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + a[i] := VAL_AR[i]; + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TArrayOfFloatCurrencyRemotable),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + FreeAndNil(a); + a := TArrayOfFloatCurrencyRemotable.Create(); + a.SetLength(0); + a.SetLength(0); + a.SetLength(0); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginScopeRead(x,TypeInfo(TClass_B),stObject); + x := 'a'; + f.Get(TypeInfo(TArrayOfFloatCurrencyRemotable),x,a); + f.EndScopeRead(); + AssertEquals(AR_LEN,a.Length); + + for i := 0 to Pred(AR_LEN) do + AssertTrue(VAL_AR[i]=a[i]); + + finally + a.Free(); + s.Free(); + end; +end; + + +{ TTestBinaryFormatter } + +function TTestBinaryFormatter.CreateFormatter(ARootType : PTypeInfo):IFormatterBase; +begin + Result := TBaseBinaryFormatter.Create() as IFormatterBase; + //Result.BeginObject('root',Nil); +end; + +{ TTestSOAPFormatter } + +function TTestSOAPFormatter.CreateFormatter(ARootType : PTypeInfo):IFormatterBase; +begin + Result := TSOAPBaseFormatter.Create() as IFormatterBase; + Result.BeginObject('Env',ARootType) +end; + +{ TClass_B } + +procedure TClass_B.SetObjProp(const AValue: TClass_A); +begin + FObjProp.Assign(AValue); +end; + +constructor TClass_B.Create(); +begin + inherited Create(); + FObjProp := TClass_A.Create(); +end; + +destructor TClass_B.Destroy(); +begin + FreeAndNil(FObjProp); + inherited Destroy(); +end; + +{ TTestArray } + +procedure TTestArray.Test_StringArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of string = ('AzErTy','QwErTy','123456','','1'); +var + a : TArrayOfStringRemotable; + i, j : Integer; +begin + a := TArrayOfStringRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(ansistring))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(ansistring))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertEquals('Item',VAL_AR[j],a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_BooleanArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Boolean = (True,True,False,True,False); +var + a : TArrayOfBooleanRemotable; + i, j : Integer; +begin + a := TArrayOfBooleanRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(Boolean))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(Boolean))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertEquals('Item',VAL_AR[j],a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_Int8UArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Byte = (12,34,100,200,180); +var + a : TArrayOfInt8URemotable; + i, j : Integer; +begin + a := TArrayOfInt8URemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(Byte))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(Byte))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertEquals('Item',VAL_AR[j],a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_Int8SArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of ShortInt = (-12,-34,100,200,180); +var + a : TArrayOfInt8SRemotable; + i, j : Integer; +begin + a := TArrayOfInt8SRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(ShortInt))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(ShortInt))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertEquals('Item',VAL_AR[j],a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_Int16SArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of SmallInt = (-12,-34,100,200,180); +var + a : TArrayOfInt16SRemotable; + i, j : Integer; +begin + a := TArrayOfInt16SRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(SmallInt))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(SmallInt))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertEquals('Item',VAL_AR[j],a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_Int16UArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Word = (12,4,100,200,180); +var + a : TArrayOfInt16URemotable; + i, j : Integer; +begin + a := TArrayOfInt16URemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(Word))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(Word))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertEquals('Item',VAL_AR[j],a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_Int32UArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of LongWord = (12,4,100,200,180); +var + a : TArrayOfInt32URemotable; + i, j : Integer; +begin + a := TArrayOfInt32URemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(LongWord))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(LongWord))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertEquals('Item',VAL_AR[j],a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_Int32SArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of LongInt = (-12,-34,100,200,180); +var + a : TArrayOfInt32SRemotable; + i, j : Integer; +begin + a := TArrayOfInt32SRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(LongInt))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(LongInt))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertEquals('Item',VAL_AR[j],a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_Int64SArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Int64 = (-12,-34,100,200,180); +var + a : TArrayOfInt64SRemotable; + i, j : Integer; +begin + a := TArrayOfInt64SRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(Int64))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(Int64))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertEquals('Item',VAL_AR[j],a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_Int64UArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of QWord = (12,4,100,200,180); +var + a : TArrayOfInt64URemotable; + i, j : Integer; +begin + a := TArrayOfInt64URemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(QWord))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(QWord))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertTrue('Item',VAL_AR[j]=a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_FloatSingleArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Single = (-12.10,-4.45,100,200.58,180.3); +var + a : TArrayOfFloatSingleRemotable; + i, j : Integer; +begin + a := TArrayOfFloatSingleRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(Single))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(Single))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertTrue('Item',VAL_AR[j]=a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_FloatDoubleArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Double = (-12.10,-4.45,100,200.58,180.3); +var + a : TArrayOfFloatDoubleRemotable; + i, j : Integer; +begin + a := TArrayOfFloatDoubleRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(Double))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(Double))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertTrue('Item',VAL_AR[j]=a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_FloatExtendedArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Extended = (-12.10,-4.45,100,200.58,180.3); +var + a : TArrayOfFloatExtendedRemotable; + i, j : Integer; +begin + a := TArrayOfFloatExtendedRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(Extended))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(Extended))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertTrue('Item',VAL_AR[j]=a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +procedure TTestArray.Test_FloatCurrencyArray(); +const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Currency = (-12.10,-4.45,100,200.58,180.3); +var + a : TArrayOfFloatCurrencyRemotable; + i, j : Integer; +begin + a := TArrayOfFloatCurrencyRemotable.Create(); + try + AssertEquals('TypeInfo',PTypeInfo(TypeInfo(Currency))^.Name,a.GetItemTypeInfo()^.Name); + AssertEquals('TypeInfo',Ord(PTypeInfo(TypeInfo(Currency))^.Kind),Ord(a.GetItemTypeInfo()^.Kind)); + + AssertEquals(0,a.Length); + a.SetLength(0); + AssertEquals(0,a.Length); + + for i := 1 to AR_LEN do begin + a.SetLength(i); + AssertEquals('Length',i,a.Length); + for j := 0 to Pred(i) do + a[j] := VAL_AR[j]; + for j := 0 to Pred(i) do + AssertTrue('Item',VAL_AR[j]=a[j]); + end; + + a.SetLength(0); + AssertEquals(0,a.Length); + finally + a.Free(); + end; +end; + +{ TTest_TBaseComplexRemotable } + +procedure TTest_TBaseComplexRemotable.Test_Assign(); +Var + a,b : TClass_B; +begin + b := nil; + a := TClass_B.Create(); + Try + a.Val_Bool := False; + a.Val_Enum := teThree; + a.Val_String := '123'; + a.ObjProp.Val_String := '456'; + a.ObjProp.Val_Enum := teFour; + a.ObjProp.Val_Bool := True; + a.ObjProp.Val_32S := 121076; + a.NonStored := 121076; + + b := TClass_B.Create(); + + b.Assign(a); + + AssertEquals(a.Val_Bool,b.Val_Bool); + AssertEquals(Ord(a.Val_Enum),Ord(b.Val_Enum)); + AssertEquals(a.Val_String,b.Val_String); + + AssertEquals(a.ObjProp.Val_Bool,b.ObjProp.Val_Bool); + AssertEquals(Ord(a.ObjProp.Val_Enum),Ord(b.ObjProp.Val_Enum)); + AssertEquals(a.ObjProp.Val_String,a.ObjProp.Val_String); + Finally + a.Free(); + b.Free(); + End; +end; + +{ TTestSOAPFormatterAttributes } + +function TTestSOAPFormatterAttributes.CreateFormatter(ARootType: PTypeInfo): IFormatterBase; +begin + Result := inherited CreateFormatter(ARootType); + Result.SetSerializationStyle(ssAttibuteSerialization); +end; + +{ TTestBinaryFormatterAttributes } + +function TTestBinaryFormatterAttributes.CreateFormatter(ARootType: PTypeInfo): IFormatterBase; +begin + Result := inherited CreateFormatter(ARootType); + Result.SetSerializationStyle(ssAttibuteSerialization); +end; + +initialization + RegisterStdTypes(); + GetTypeRegistry().Register(sXSD_NS,TypeInfo(TTestEnum),'TTestEnum'); + GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_Int),'TClass_Int'); + GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_Enum),'TClass_Enum'); + GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_A),'TClass_A'); + GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_B),'TClass_B'); + GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_Float),'TClass_Float'); + + + RegisterTest(TTestArray); + RegisterTest(TTestSOAPFormatter); + RegisterTest(TTestBinaryFormatter); + RegisterTest(TTest_TBaseComplexRemotable); + RegisterTest(TTestSOAPFormatterAttributes); + RegisterTest(TTestBinaryFormatterAttributes); +end. + diff --git a/wst/tags/3.1/tests/test_suite/testmetadata_unit.pas b/wst/tags/3.1/tests/test_suite/testmetadata_unit.pas new file mode 100644 index 000000000..a4ea7f168 --- /dev/null +++ b/wst/tags/3.1/tests/test_suite/testmetadata_unit.pas @@ -0,0 +1,153 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + 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. +} + +unit testmetadata_unit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, DOM, XMLWrite, + fpcunit, testutils, testregistry, + metadata_generator, binary_streamer, metadata_repository, parserdefs, + metadata_wsdl; + +type + + { TTestMetadata } + + TTestMetadata= class(TTestCase) + protected + function CreateSymbolTable():TSymbolTable; + published + procedure test_Metadata(); + end; + + +implementation + +{ TTestMetadata } + +function TTestMetadata.CreateSymbolTable(): TSymbolTable; +Var + inft : TInterfaceDefinition; +begin + Result := TSymbolTable.Create('test_unit_name'); + Result.Add(TTypeDefinition.Create('integer')); + Result.Add(TTypeDefinition.Create('string')); + Result.Add(TTypeDefinition.Create('double')); + + inft := TInterfaceDefinition.Create('service_1'); + Result.Add(inft); + inft.AddMethod('void_operation_proc',mtProcedure); + inft.AddMethod('void_operation_func',mtProcedure).AddParameter('result',pmOut,Result.ByName('integer') as TTypeDefinition); + + inft := TInterfaceDefinition.Create('service_2'); + Result.Add(inft); + with inft.AddMethod('dis_proc',mtProcedure) do begin + AddParameter('d',pmNone,Result.ByName('double') as TTypeDefinition); + AddParameter('i',pmConst,Result.ByName('integer') as TTypeDefinition); + AddParameter('s',pmOut,Result.ByName('string') as TTypeDefinition); + end; + with inft.AddMethod('sid_func',mtFunction) do begin + AddParameter('s',pmConst,Result.ByName('string') as TTypeDefinition); + AddParameter('i',pmVar,Result.ByName('integer') as TTypeDefinition); + AddParameter('d',pmOut,Result.ByName('double') as TTypeDefinition); + end; +end; + +procedure PrintWSDL(ARep : PServiceRepository); +var + locDoc : TXMLDocument; + strm : TMemoryStream; + s : string; +begin + strm := nil;; + locDoc := TXMLDocument.Create(); + try + GenerateWSDL(ARep,locDoc); + strm := TMemoryStream.Create(); + WriteXMLFile(locDoc,strm); + SetLength(s,strm.Size); + Move(strm.Memory^,s[1],strm.Size); + WriteLn('*******************************************************'); + WriteLn(s); + WriteLn('*******************************************************'); + finally + locDoc.Free(); + strm.Free(); + end; +end; + +procedure TTestMetadata.test_Metadata(); +var + st : TSymbolTable; + mg : TMetadataGenerator; + wtr : IDataStore; + strm : TMemoryStream; + + rp : PServiceRepository; + ps : PService; + po : PServiceOperation; + pop : POperationParam; +begin + strm := nil; + mg := nil; + rp := nil; + st := CreateSymbolTable(); + try + strm := TMemoryStream.Create(); + wtr := CreateBinaryWriter(strm); + mg := TMetadataGenerator.Create(st,wtr); + mg.Execute(); + wtr := nil; + strm.Position := 0; + + AssertTrue(strm.Size>10); + AssertEquals('symbol count',2,LoadRepositoryData(strm,rp)); + AssertEquals('unit name','test_unit_name',rp^.Name); + AssertEquals('services count',2,rp^.ServicesCount); + AssertNotNull('services pointer',rp^.Services); + + ps := rp^.Services; + AssertEquals('service name','service_1',ps^.Name); + AssertEquals('operations count',2,ps^.OperationsCount); + AssertNotNull('operations pointer',ps^.Operations); + po := ps^.Operations; + AssertEquals('operation name','void_operation_proc',po^.Name); + AssertEquals('params count',0,po^.ParamsCount); + AssertNull('params pointer',po^.Params); + Inc(po); + AssertEquals('operation name','void_operation_func',po^.Name); + AssertEquals('params count',1,po^.ParamsCount); + AssertNotNull('params pointer',po^.Params); + pop := po^.Params; + AssertEquals('param name','result',pop^.Name); + AssertEquals('param type name','integer',pop^.TypeName); + AssertEquals('param modifier',ord(pmOut),ord(pop^.Modifier)); + + rp^.NameSpace := 'http://test_name_space/'; + //PrintWSDL(rp); + finally + mg.Free(); + st.Free(); + strm.Free(); + ClearRepositoryData(rp); + end; +end; + +initialization + RegisterTest(TTestMetadata); + +end. diff --git a/wst/tags/3.1/tests/test_suite/wst_test_suite.lpi b/wst/tags/3.1/tests/test_suite/wst_test_suite.lpi new file mode 100644 index 000000000..3147a7fdb --- /dev/null +++ b/wst/tags/3.1/tests/test_suite/wst_test_suite.lpi @@ -0,0 +1,501 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/tests/test_suite/wst_test_suite.lpr b/wst/tags/3.1/tests/test_suite/wst_test_suite.lpr new file mode 100644 index 000000000..917b78093 --- /dev/null +++ b/wst/tags/3.1/tests/test_suite/wst_test_suite.lpr @@ -0,0 +1,121 @@ +program wst_test_suite; + +{$mode objfpc}{$H+} + +uses + custapp, classes, sysutils, fpcunit, testreport, testregistry, + TestFormatter_unit, testmetadata_unit, + server_service_soap, soap_formatter, base_binary_formatter, + base_service_intf, base_soap_formatter, binary_formatter, binary_streamer, + server_binary_formatter, metadata_repository, + metadata_generator, parserdefs, server_service_intf, metadata_wsdl; + +Const + ShortOpts = 'alh'; + Longopts : Array[1..5] of String = ( + 'all','list','format:','suite:','help'); + Version = 'Version 0.1'; + +Type + TTestRunner = Class(TCustomApplication) + private + FXMLResultsWriter: TXMLResultsWriter; + protected + procedure DoRun ; Override; + procedure doTestRun(aTest: TTest); virtual; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + +constructor TTestRunner.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FXMLResultsWriter := TXMLResultsWriter.Create; +end; + +destructor TTestRunner.Destroy; +begin + FXMLResultsWriter.Free; +end; + +procedure TTestRunner.doTestRun(aTest: TTest); +var + testResult: TTestResult; +begin + testResult := TTestResult.Create; + try + testResult.AddListener(FXMLResultsWriter); + FXMLResultsWriter.WriteHeader; + aTest.Run(testResult); + FXMLResultsWriter.WriteResult(testResult); + finally + testResult.Free; + end; +end; + +procedure TTestRunner.DoRun; +var + I : Integer; + S : String; +begin + S:=CheckOptions(ShortOpts,LongOpts); + If (S<>'') then + Writeln(S); + if HasOption('h', 'help') or (ParamCount = 0) then + begin + writeln(Title); + writeln(Version); + writeln('Usage: '); + writeln('-l or --list to show a list of registered tests'); + writeln('default format is xml, add --format=latex to output the list as latex source'); + writeln('-a or --all to run all the tests and show the results in xml format'); + writeln('The results can be redirected to an xml file,'); + writeln('for example: ./testrunner --all > results.xml'); + writeln('use --suite=MyTestSuiteName to run only the tests in a single test suite class'); + end; + if HasOption('l', 'list') then + begin + if HasOption('format') then + begin + if GetOptionValue('format') = 'latex' then + writeln(GetSuiteAsLatex(GetTestRegistry)) + else + writeln(GetSuiteAsXML(GetTestRegistry)); + end + else + writeln(GetSuiteAsXML(GetTestRegistry)); + end; + if HasOption('a', 'all') then + begin + doTestRun(GetTestRegistry) + end + else + if HasOption('suite') then + begin + S := ''; + S:=GetOptionValue('suite'); + if S = '' then + for I := 0 to GetTestRegistry.Tests.count - 1 do + writeln(GetTestRegistry[i].TestName) + else + for I := 0 to GetTestRegistry.Tests.count - 1 do + if GetTestRegistry[i].TestName = S then + begin + doTestRun(GetTestRegistry[i]); + end; + end; + Terminate; +end; + +Var + App : TTestRunner; + +begin + App:=TTestRunner.Create(Nil); + App.Initialize; + App.Title := 'FPCUnit Console Test Case runner.'; + App.Run; + App.Free; +end. + diff --git a/wst/tags/3.1/ws_helper/COPYING.GPL b/wst/tags/3.1/ws_helper/COPYING.GPL new file mode 100644 index 000000000..c79e32906 --- /dev/null +++ b/wst/tags/3.1/ws_helper/COPYING.GPL @@ -0,0 +1,340 @@ + + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 675 Mass Ave, Cambridge, MA 02139, 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 + + Appendix: 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. + + + Copyright (C) 19yy + + 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., 675 Mass Ave, Cambridge, MA 02139, 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) 19yy 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. + + , 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. diff --git a/wst/tags/3.1/ws_helper/command_line_parser.pas b/wst/tags/3.1/ws_helper/command_line_parser.pas new file mode 100644 index 000000000..23f435a13 --- /dev/null +++ b/wst/tags/3.1/ws_helper/command_line_parser.pas @@ -0,0 +1,72 @@ +{ + This unit is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + 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., 675 Mass Ave, Cambridge, MA 02139, USA. +} + +unit command_line_parser; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +Type + + TComandLineOption = ( cloProxy, cloImp, cloBinder, cloOutPutDir ); + TComandLineOptions = set of TComandLineOption; + + function ParseCmdLineOptions(out AAppOptions : TComandLineOptions):Integer; + function GetOptionArg(const AOption : TComandLineOption):string; + +implementation +uses getopts; + +Var + OptionsArgsMAP : Array[TComandLineOption] of string; + +function GetOptionArg(const AOption : TComandLineOption):string; +begin + Result := OptionsArgsMAP[AOption]; +end; + +function ParseCmdLineOptions(out AAppOptions : TComandLineOptions):Integer; +Var + c : Char; + +begin + AAppOptions := []; + c := #0; + Repeat + c := GetOpt('pibo:'); + case c of + 'p' : Include(AAppOptions,cloProxy); + 'i' : Include(AAppOptions,cloImp); + 'b' : Include(AAppOptions,cloBinder); + 'o' : + Begin + Include(AAppOptions,cloOutPutDir); + OptionsArgsMAP[cloOutPutDir] := OptArg; + End; + end; + Until ( c = EndOfOptions ); + Result := OptInd; +end; + +end. + diff --git a/wst/tags/3.1/ws_helper/generator.pas b/wst/tags/3.1/ws_helper/generator.pas new file mode 100644 index 000000000..2a9f86654 --- /dev/null +++ b/wst/tags/3.1/ws_helper/generator.pas @@ -0,0 +1,1206 @@ +{ + This unit is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + 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., 675 Mass Ave, Cambridge, MA 02139, USA. +} + + +unit generator; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + parserdefs, source_utils; + +Type + + { TBaseGenerator } + + TBaseGenerator = class + Private + FSrcMngr : ISourceManager; + FCurrentStream : ISourceStream; + FSymbolTable: TSymbolTable; + Protected + procedure SetCurrentStream(AStream : ISourceStream); + procedure Indent(); + function IncIndent():Integer; + function DecIndent():Integer; + procedure BeginAutoIndent(); + procedure EndAutoIndent(); + procedure Write(AText : String);overload; + procedure Write(AText : String; Const AArgs : array of const);overload; + procedure WriteLn(AText : String);overload; + procedure WriteLn(AText : String; Const AArgs : array of const);overload; + procedure NewLine(); + + function ExtractserviceName(AIntf : TInterfaceDefinition):String; + Public + constructor Create( + ASymTable : TSymbolTable; + ASrcMngr : ISourceManager + ); + procedure Execute();virtual;abstract; + property SymbolTable : TSymbolTable Read FSymbolTable; + property SrcMngr : ISourceManager Read FSrcMngr; + End; + + { TProxyGenerator } + + TProxyGenerator = class(TBaseGenerator) + Private + FDecStream : ISourceStream; + FImpStream : ISourceStream; + + function GenerateClassName(AIntf : TInterfaceDefinition):String; + + procedure GenerateUnitHeader(); + procedure GenerateUnitImplementationHeader(); + procedure GenerateUnitImplementationFooter(); + + procedure GenerateProxyIntf(AIntf : TInterfaceDefinition); + procedure GenerateProxyImp(AIntf : TInterfaceDefinition); + + function GetDestUnitName():string; + Public + constructor Create( + ASymTable : TSymbolTable; + ASrcMngr : ISourceManager + ); + procedure Execute();override; + End; + + { TStubGenerator } + + TBinderGenerator = class(TBaseGenerator) + Private + FDecStream : ISourceStream; + FImpStream : ISourceStream; + + function GenerateClassName(AIntf : TInterfaceDefinition):String; + + procedure GenerateUnitHeader(); + procedure GenerateUnitImplementationHeader(); + procedure GenerateUnitImplementationFooter(); + + procedure GenerateIntf(AIntf : TInterfaceDefinition); + procedure GenerateImp(AIntf : TInterfaceDefinition); + + function GetDestUnitName():string; + Public + constructor Create( + ASymTable : TSymbolTable; + ASrcMngr : ISourceManager + ); + procedure Execute();override; + End; + + { TImplementationGenerator } + + TImplementationGenerator = class(TBaseGenerator) + Private + FDecStream : ISourceStream; + FImpStream : ISourceStream; + + function GenerateClassName(AIntf : TInterfaceDefinition):String; + + procedure GenerateUnitHeader(); + procedure GenerateUnitImplementationHeader(); + procedure GenerateUnitImplementationFooter(); + + procedure GenerateIntf(AIntf : TInterfaceDefinition); + procedure GenerateImp(AIntf : TInterfaceDefinition); + + function GetDestUnitName():string; + Public + constructor Create( + ASymTable : TSymbolTable; + ASrcMngr : ISourceManager + ); + procedure Execute();override; + End; + + +implementation +uses parserutils; + +Const sPROXY_BASE_CLASS = 'TBaseProxy'; + sBINDER_BASE_CLASS = 'TBaseServiceBinder'; + sIMP_BASE_CLASS = 'TBaseServiceImplementation'; + sSERIALIZER_CLASS = 'IFormatterClient'; + RETURN_PARAM_NAME = 'return'; + RETURN_VAL_NAME = 'returnVal'; + + sPRM_NAME = 'strPrmName'; + sLOC_SERIALIZER = 'locSerializer'; + //sRES_TYPE_INFO = 'resTypeInfo'; + //sLOC_TYPE_INFO = 'locTypeInfo'; + +{ TProxyGenerator } + +function TProxyGenerator.GenerateClassName(AIntf: TInterfaceDefinition): String; +begin + Result := ExtractserviceName(AIntf); + Result := Format('T%s_Proxy',[Result]); +end; + +procedure TProxyGenerator.GenerateUnitHeader(); +begin + SetCurrentStream(FDecStream); + WriteLn('{'); + WriteLn('This unit has been produced by ws_helper.'); + WriteLn(' Input unit name : "%s".',[SymbolTable.Name]); + WriteLn(' This unit name : "%s".',[GetDestUnitName()]); + WriteLn(' Date : "%s".',[DateTimeToStr(Now())]); + WriteLn('}'); + + WriteLn('Unit %s;',[GetDestUnitName()]); + WriteLn('{$mode objfpc}{$H+}'); + WriteLn('Interface'); + WriteLn(''); + WriteLn('Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, %s;',[SymbolTable.Name]); + WriteLn(''); + WriteLn('Type'); + WriteLn(''); +end; + +procedure TProxyGenerator.GenerateUnitImplementationHeader(); +begin + SetCurrentStream(FImpStream); + WriteLn(''); + WriteLn('Implementation'); + WriteLn('uses LResources, metadata_repository;'); +end; + +procedure TProxyGenerator.GenerateUnitImplementationFooter(); +var + s :string; +begin + SetCurrentStream(FImpStream); + NewLine(); + WriteLn('initialization'); + WriteLn(' {$i %s.lrs}',[SymbolTable.Name]); + NewLine(); + s := Format('Register_%s_ServiceMetadata',[SymbolTable.Name]); + WriteLn(' {$IF DECLARED(%s)}',[s]); + WriteLn(' %s();',[s]); + WriteLn(' {$ENDIF}'); + WriteLn('End.'); +end; + +constructor TProxyGenerator.Create( + ASymTable : TSymbolTable; + ASrcMngr : ISourceManager +); +begin + Inherited Create(ASymTable,ASrcMngr); + FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec'); + FImpStream := SrcMngr.CreateItem(GetDestUnitName() + '.imp'); +end; + +procedure TProxyGenerator.Execute(); +Var + i,c : Integer; + intf : TInterfaceDefinition; +begin + GenerateUnitHeader(); + GenerateUnitImplementationHeader(); + c := Pred(SymbolTable.Count); + For i := 0 To c Do Begin + If SymbolTable.Item[i] Is TInterfaceDefinition Then Begin + intf := SymbolTable.Item[i] As TInterfaceDefinition; + GenerateProxyIntf(intf); + GenerateProxyImp(intf); + End; + End; + GenerateUnitImplementationFooter(); + FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream]); + FDecStream := Nil; + FImpStream := Nil; +end; + +function TProxyGenerator.GetDestUnitName(): string; +begin + Result := Format('%s_proxy',[SymbolTable.Name]); +end; + +procedure TProxyGenerator.GenerateProxyIntf(AIntf: TInterfaceDefinition); + procedure WriteDec(); + begin + Indent(); + WriteLn('%s=class(%s,%s)',[GenerateClassName(AIntf),sPROXY_BASE_CLASS,AIntf.Name]); + end; + + procedure WriteMethod(AMthd : TMethodDefinition); + Var + prmCnt,k : Integer; + prm : TParameterDefinition; + Begin + Indent(); + prmCnt := AMthd.ParameterCount; + If ( AMthd.MethodType = mtProcedure ) Then + Write('procedure ') + Else Begin + Write('function '); + Dec(prmCnt); + End; + Write('%s(',[AMthd.Name]); + + If ( prmCnt > 0 ) Then Begin + IncIndent(); + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + If (k > 0 ) Then + Write('; '); + NewLine(); + Indent(); + Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]); + End; + DecIndent(); + NewLine(); + Indent(); + End; + + Write(')'); + If ( AMthd.MethodType = mtFunction ) Then Begin + Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]); + End; + WriteLn(';'); + End; + + procedure WriteMethods(); + Var + k : Integer; + begin + If ( AIntf.MethodCount = 0 ) Then + Exit; + //IncIndent(); + Indent(); + WriteLn('Protected'); + IncIndent(); + Indent();WriteLn('class function GetServiceType() : PTypeInfo;override;'); + For k := 0 To Pred(AIntf.MethodCount) Do + WriteMethod(AIntf.Method[k]); + DecIndent(); + //DecIndent(); + end; + +begin + SetCurrentStream(FDecStream); + NewLine(); + IncIndent(); + WriteDec(); + WriteMethods(); + Indent(); WriteLn('End;'); + DecIndent(); +end; + +procedure TProxyGenerator.GenerateProxyImp(AIntf: TInterfaceDefinition); +Var + strClassName : String; + + procedure WriteDec(); + begin + If ( AIntf.MethodCount > 0 ) Then + WriteLn('{ %s implementation }',[strClassName]); + end; + + procedure WriteMethodDec(AMthd : TMethodDefinition); + Var + prmCnt,k : Integer; + prm : TParameterDefinition; + Begin + prmCnt := AMthd.ParameterCount; + If ( AMthd.MethodType = mtProcedure ) Then + Write('procedure ') + Else Begin + Write('function '); + Dec(prmCnt); + End; + Write('%s.%s(',[strClassName,AMthd.Name]); + + If ( prmCnt > 0 ) Then Begin + IncIndent(); + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + If (k > 0 ) Then + Write('; '); + NewLine(); + Indent(); + Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]); + End; + DecIndent(); + NewLine(); + Indent(); + End; + + Write(')'); + If ( AMthd.MethodType = mtFunction ) Then Begin + Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]); + End; + WriteLn(';'); + End; + + procedure WriteMethodImp(AMthd : TMethodDefinition); + Var + prmCnt,k : Integer; + prm : TParameterDefinition; + Begin + IncIndent(); + WriteLn('Var'); + + Indent();WriteLn('%s : %s;',[sLOC_SERIALIZER,sSERIALIZER_CLASS]); + Indent();WriteLn('%s : %s;',[sPRM_NAME,'string']); + //If ( AMthd.MethodType = mtFunction ) Then + //Indent();WriteLn('%s : %s;',[sRES_TYPE_INFO,'PTypeInfo']); + WriteLn('Begin'); + + Indent();WriteLn('%s := GetSerializer();',[sLOC_SERIALIZER]); + Indent();WriteLn('Try');IncIndent(); + + Indent();WriteLn('%s.BeginCall(''%s'', GetTarget(),(Self as ICallContext));',[sLOC_SERIALIZER,AMthd.Name]); + IncIndent(); + prmCnt := AMthd.ParameterCount; + If ( AMthd.MethodType = mtFunction ) Then + Dec(prmCnt); + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + If ( prm.Modifier <> pmOut ) Then Begin + Indent();WriteLn('%s.Put(''%s'', TypeInfo(%s), %s);',[sLOC_SERIALIZER,prm.Name,prm.DataType.Name,prm.Name]); + End; + End; + DecIndent(); + Indent();WriteLn('%s.EndCall();',[sLOC_SERIALIZER]); + + WriteLn(''); + Indent();WriteLn('MakeCall();'); + WriteLn(''); + + Indent();WriteLn('%s.BeginCallRead((Self as ICallContext));',[sLOC_SERIALIZER]); + IncIndent(); + k:= Pred(AMthd.ParameterCount); + If ( AMthd.MethodType = mtFunction ) Then Begin + prm := AMthd.Parameter[k]; + //Indent();WriteLn('%s := TypeInfo(%s);',[sRES_TYPE_INFO,prm.DataType.Name]); + if prm.DataType.NeedFinalization() then begin + if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin + Indent();WriteLn('Pointer(Result) := Nil;'); + end else begin + Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]); + IncIndent(); + Indent();WriteLn('Pointer(Result) := Nil;'); + DecIndent(); + end; + end; + Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(RETURN_PARAM_NAME)]); + Indent();WriteLn('%s.Get(TypeInfo(%s), %s, %s);',[sLOC_SERIALIZER,prm.DataType.Name,sPRM_NAME,prm.Name]); + End; + //-------------------------------- + for k := 0 to Pred(prmCnt) do begin + prm := AMthd.Parameter[k]; + if ( prm.Modifier = pmOut ) then begin + if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin + Indent();WriteLn('Pointer(%s) := Nil;',[prm.Name]); + end else begin + Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]); + IncIndent(); + Indent();WriteLn('Pointer(%s) := Nil;',[prm.Name]); + DecIndent(); + end; + end; + end; + //-------------------------------- + + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + If ( prm.Modifier In [pmVar, pmOut] ) Then Begin + Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(prm.Name)]); + Indent();WriteLn('%s.Get(TypeInfo(%s), %s, %s);',[sLOC_SERIALIZER,prm.DataType.Name,sPRM_NAME,prm.Name]); + End; + End; + DecIndent(); + + + WriteLn(''); + DecIndent(); + Indent();WriteLn('Finally'); + IncIndent(); + Indent();WriteLn('%s.Clear();',[sLOC_SERIALIZER]); + DecIndent(); + Indent();WriteLn('End;');DecIndent(); + + WriteLn('End;'); + End; + + procedure WriteTypeInfoMethod(); + begin + NewLine(); + WriteLn('class function %s.GetServiceType() : PTypeInfo;',[strClassName]); + WriteLn('begin'); + IncIndent(); + Indent(); WriteLn('result := TypeInfo(%s);',[AIntf.Name]); + DecIndent(); + WriteLn('end;'); + NewLine(); + end; + + procedure WriteMethods(); + Var + k : Integer; + begin + WriteTypeInfoMethod(); + For k := 0 To Pred(AIntf.MethodCount) Do Begin + WriteMethodDec(AIntf.Method[k]); + WriteMethodImp(AIntf.Method[k]); + WriteLn(''); + End; + end; + +begin + SetCurrentStream(FImpStream); + IncIndent(); + While ( DecIndent() > 0 ) Do + ; + strClassName := GenerateClassName(AIntf); + NewLine(); + WriteDec(); + WriteMethods(); +end; + + +{ TBaseGenerator } + +procedure TBaseGenerator.SetCurrentStream(AStream: ISourceStream); +begin + FCurrentStream := AStream; +end; + +procedure TBaseGenerator.Indent(); +begin + FCurrentStream.Indent(); +end; + +function TBaseGenerator.IncIndent():Integer; +begin + Result := FCurrentStream.IncIndent(); +end; + +function TBaseGenerator.DecIndent():Integer; +begin + Result := FCurrentStream.DecIndent(); +end; + +procedure TBaseGenerator.BeginAutoIndent(); +begin + FCurrentStream.BeginAutoIndent(); +end; + +procedure TBaseGenerator.EndAutoIndent(); +begin + FCurrentStream.EndAutoIndent(); +end; + +procedure TBaseGenerator.Write(AText: String); +begin + FCurrentStream.Write(AText); +end; + +procedure TBaseGenerator.Write(AText: String; const AArgs: array of const); +begin + Write(Format(AText,AArgs)); +end; + +procedure TBaseGenerator.WriteLn(AText: String); +begin + Write(AText+sNEW_LINE); +end; + +procedure TBaseGenerator.WriteLn(AText: String; const AArgs: array of const); +begin + Write(AText+sNEW_LINE,AArgs); +end; + +procedure TBaseGenerator.NewLine(); +begin + WriteLn(''); +end; + +function TBaseGenerator.ExtractserviceName(AIntf: TInterfaceDefinition): String; +begin + Result := AIntf.Name; + If upCase(Result[1]) = 'I' Then + Delete(Result,1,1); +end; + +constructor TBaseGenerator.Create(ASymTable: TSymbolTable; ASrcMngr: ISourceManager); +begin + Assert(Assigned(ASymTable)); + Assert(Assigned(ASrcMngr)); + FSrcMngr :=ASrcMngr; + FCurrentStream := Nil; + FSymbolTable := ASymTable; +end; + +{ TBinderGenerator } + +function TBinderGenerator.GenerateClassName(AIntf: TInterfaceDefinition): String; +begin + Result := ExtractserviceName(AIntf); + Result := Format('T%s_ServiceBinder',[Result]); +end; + +procedure TBinderGenerator.GenerateUnitHeader(); +begin + SetCurrentStream(FDecStream); + WriteLn('{'); + WriteLn('This unit has been produced by ws_helper.'); + WriteLn(' Input unit name : "%s".',[SymbolTable.Name]); + WriteLn(' This unit name : "%s".',[GetDestUnitName()]); + WriteLn(' Date : "%s".',[DateTimeToStr(Now())]); + WriteLn('}'); + + WriteLn('unit %s;',[GetDestUnitName()]); + WriteLn('{$mode objfpc}{$H+}'); + WriteLn('interface'); + WriteLn(''); + WriteLn('uses SysUtils, Classes, base_service_intf, server_service_intf, %s;',[SymbolTable.Name]); + WriteLn(''); + WriteLn('type'); + WriteLn(''); +end; + +procedure TBinderGenerator.GenerateUnitImplementationHeader(); +begin + SetCurrentStream(FImpStream); + WriteLn(''); + WriteLn('Implementation'); + WriteLn('uses TypInfo, LResources,metadata_repository;'); +end; + +procedure TBinderGenerator.GenerateUnitImplementationFooter(); +var + s :string; +begin + NewLine(); + WriteLn('initialization'); + NewLine(); + s := Format('Register_%s_NameSpace',[SymbolTable.Name]); + WriteLn(' {$IF DECLARED(%s)}',[s]); + WriteLn(' %s();',[s]); + WriteLn(' {$ENDIF}'); + NewLine(); + WriteLn(' {$i %s.lrs}',[SymbolTable.Name]); + NewLine(); + WriteLn('End.'); +end; + +procedure TBinderGenerator.GenerateIntf(AIntf: TInterfaceDefinition); + procedure WriteDec(); + begin + Indent(); + WriteLn('%s=class(%s)',[GenerateClassName(AIntf),sBINDER_BASE_CLASS]); + end; + + procedure WriteConstructor(); + Begin + Indent(); + WriteLn('constructor Create();') + End; + + procedure WriteMethod(AMthd : TMethodDefinition); + Begin + Indent(); + WriteLn('procedure %sHandler(AFormatter:IFormatterResponse);',[AMthd.Name]) + End; + + procedure WriteMethods(); + Var + k : Integer; + begin + If ( AIntf.MethodCount = 0 ) Then + Exit; + Indent();WriteLn('Protected'); + IncIndent(); + For k := 0 To Pred(AIntf.MethodCount) Do + WriteMethod(AIntf.Method[k]); + DecIndent(); + + Indent();WriteLn('Public'); + Indent();WriteConstructor(); + end; + + procedure GenerateFactoryClass(); + Begin + NewLine(); + IncIndent();BeginAutoIndent(); + WriteLn('T%s_ServiceBinderFactory = class(TInterfacedObject,IItemFactory)',[ExtractserviceName(AIntf)]); + WriteLn('protected'); + + IncIndent(); + WriteLn('function CreateInstance():IInterface;'); + DecIndent(); + WriteLn('End;'); + DecIndent();EndAutoIndent(); + End; + + procedure GenerateRegistrationProc(); + Begin + NewLine(); + BeginAutoIndent(); + IncIndent(); + WriteLn('procedure Server_service_Register%sService();',[ExtractserviceName(AIntf)]); + DecIndent(); + EndAutoIndent(); + End; + +begin + SetCurrentStream(FDecStream); + NewLine(); + IncIndent(); + WriteDec(); + WriteMethods(); + Indent();WriteLn('End;'); + DecIndent(); + + GenerateFactoryClass(); + GenerateRegistrationProc(); +end; + +procedure TBinderGenerator.GenerateImp(AIntf: TInterfaceDefinition); +Var + strClassName : String; + + procedure WriteDec(); + begin + If ( AIntf.MethodCount > 0 ) Then + WriteLn('{ %s implementation }',[strClassName]); + end; + + procedure WriteMethodDec(AMthd : TMethodDefinition); + Begin + WriteLn('procedure %s.%sHandler(AFormatter:IFormatterResponse);',[strClassName,AMthd.Name]); + End; + + procedure WriteMethodImp(AMthd : TMethodDefinition); + Var + prmCnt,k : Integer; + prm : TParameterDefinition; + strBuff : string; + Begin + prmCnt := AMthd.ParameterCount; + If ( AMthd.MethodType = mtFunction ) Then + Dec(prmCnt); + + WriteLn('Var'); + IncIndent();BeginAutoIndent(); + WriteLn('cllCntrl : ICallControl;'); + WriteLn('tmpObj : %s;',[AIntf.Name]); + WriteLn('callCtx : ICallContext;'); + If ( prmCnt > 0 ) Or ( AMthd.MethodType = mtFunction ) Then Begin + WriteLn('%s : string;',[sPRM_NAME]); + WriteLn('procName,trgName : string;'); + End; + If ( prmCnt > 0 ) Then Begin + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + WriteLn('%s : %s;',[prm.Name,prm.DataType.Name]); + End; + End; + If ( AMthd.MethodType = mtFunction ) Or ( prmCnt > 0 ) Then Begin + WriteLn('%s : %s;',[RETURN_VAL_NAME,AMthd.Parameter[prmCnt].DataType.Name]); + //WriteLn('%s : %s;',[sLOC_TYPE_INFO,'PTypeInfo']); + End; + DecIndent();EndAutoIndent(); + + WriteLn('Begin'); + IncIndent();BeginAutoIndent(); + + WriteLn('callCtx := GetCallContext();'); + If ( AMthd.MethodType = mtFunction ) Then Begin + prm := AMthd.Parameter[prmCnt]; + If prm.DataType.NeedFinalization() Then Begin + if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin + WriteLn('Pointer(%s) := Nil;',[RETURN_VAL_NAME]); + end else begin + WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]); + IncIndent(); + WriteLn('Pointer(%s) := Nil;',[RETURN_VAL_NAME]); + DecIndent(); + end; + End; + End; + + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + If prm.DataType.NeedFinalization() Then Begin + if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin + WriteLn('Pointer(%s) := Nil;',[prm.Name]); + end else begin + WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkObject,tkInterface] ) Then',[prm.DataType.Name]); + IncIndent(); + WriteLn('Pointer(%s) := Nil;',[prm.Name]); + DecIndent(); + end; + End; + End; + + NewLine(); + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + Write('%s := %s;',[sPRM_NAME,QuotedStr(prm.Name)]); + WriteLn('AFormatter.Get(TypeInfo(%s),%s,%s);',[prm.DataType.Name,sPRM_NAME,prm.Name]); + If prm.DataType.NeedFinalization() Then Begin + if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin + WriteLn('If Assigned(Pointer(%s)) Then',[prm.Name]); + IncIndent(); + WriteLn('callCtx.AddObjectToFree(TObject(%s));',[prm.Name]); + DecIndent(); + end else begin + WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) And Assigned(Pointer(%s)) Then',[prm.DataType.Name,prm.Name]); + IncIndent(); + WriteLn('callCtx.AddObjectToFree(TObject(%s));',[prm.Name]); + DecIndent(); + end; + End; + End; + + NewLine(); + WriteLn('tmpObj := Self.GetFactory().CreateInstance() as %s;',[AIntf.Name]); + WriteLn('if Supports(tmpObj,ICallControl,cllCntrl) then'); + Indent();WriteLn('cllCntrl.SetCallContext(GetCallContext());'); + NewLine(); + + If ( AMthd.MethodType = mtFunction ) Then + Write('%s := tmpObj.%s(',[RETURN_VAL_NAME,AMthd.Name]) + Else + Write('tmpObj.%s(',[AMthd.Name]); + strBuff := ''; + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + strBuff := strBuff + Format('%s,',[prm.Name]); + End; + If ( prmCnt > 0 ) Then + Delete(strBuff,Length(strBuff),1); + strBuff := strBuff + ');'; + EndAutoIndent(); + WriteLn(strBuff); + BeginAutoIndent(); + + If ( AMthd.MethodType = mtFunction ) Then Begin + prm := AMthd.Parameter[prmCnt]; + If prm.DataType.NeedFinalization() Then Begin + if prm.DataType.InheritsFrom(TClassTypeDefinition) then + WriteLn('If Assigned(Pointer(%s)) Then',[RETURN_VAL_NAME]) + else + WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) And Assigned(Pointer(%s)) Then',[prm.DataType.Name,RETURN_VAL_NAME]); + IncIndent(); + WriteLn('callCtx.AddObjectToFree(TObject(%s));',[RETURN_VAL_NAME]); + DecIndent(); + End; + End; + NewLine(); + + WriteLn('procName := AFormatter.GetCallProcedureName();'); + WriteLn('trgName := AFormatter.GetCallTarget();'); + WriteLn('AFormatter.Clear();'); + + WriteLn('AFormatter.BeginCallResponse(procName,trgName);'); + //BeginAutoIndent(); + IncIndent(); + If ( AMthd.MethodType = mtFunction ) Then + WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(RETURN_PARAM_NAME),AMthd.Parameter[prmCnt].DataType.Name,RETURN_VAL_NAME]); + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + If ( prm.Modifier In [pmOut,pmVar] ) Then + WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(prm.Name),prm.DataType.Name,prm.Name]); + End; + DecIndent(); + WriteLn('AFormatter.EndCallResponse();'); + NewLine(); + WriteLn('callCtx := Nil;'); + //EndAutoIndent(); + + DecIndent();EndAutoIndent(); + WriteLn('End;'); + End; + + procedure WriteConstructor(); + Var + k : Integer; + mtd : TMethodDefinition; + Begin + NewLine(); + WriteLn('constructor %s.Create();',[strClassName]); + WriteLn('Begin'); + IncIndent(); + BeginAutoIndent(); + WriteLn('Inherited Create(GetServiceImplementationRegistry().FindFactory(%s));',[QuotedStr(AIntf.Name)]); + For k := 0 To Pred(AIntf.MethodCount) Do Begin + mtd := AIntf.Method[k]; + WriteLn('RegisterVerbHandler(%s,@%sHandler);',[QuotedStr(mtd.Name),mtd.Name]); + End; + EndAutoIndent(); + DecIndent(); + WriteLn('End;'); + NewLine(); + End; + + procedure WriteMethods(); + Var + k : Integer; + begin + For k := 0 To Pred(AIntf.MethodCount) Do Begin + WriteMethodDec(AIntf.Method[k]); + WriteMethodImp(AIntf.Method[k]); + WriteLn(''); + End; + WriteConstructor(); + end; + + procedure GenerateFactoryClass(); + Var + strBuff : string; + Begin + NewLine(); + BeginAutoIndent(); + strBuff := Format('T%s_ServiceBinderFactory',[ExtractserviceName(AIntf)]); + WriteLn('{ %s }',[strBuff]); + WriteLn('function %s.CreateInstance():IInterface;',[strBuff]); + WriteLn('Begin'); + IncIndent(); + WriteLn('Result := %s.Create() as IInterface;',[strClassName]); + DecIndent(); + WriteLn('End;'); + EndAutoIndent(); + End; + + procedure GenerateRegistrationProc(); + Var + strBuff : string; + Begin + NewLine(); + BeginAutoIndent(); + strBuff := ExtractserviceName(AIntf); + NewLine(); + WriteLn('procedure Server_service_Register%sService();',[strBuff]); + WriteLn('Begin'); + IncIndent(); + WriteLn('GetServerServiceRegistry().Register(%s,T%s_ServiceBinderFactory.Create() as IItemFactory);',[QuotedStr(AIntf.Name),strBuff]); + DecIndent(); + WriteLn('End;'); + EndAutoIndent(); + End; + +begin + SetCurrentStream(FImpStream); + IncIndent(); + While ( DecIndent() > 0 ) Do + ; + strClassName := GenerateClassName(AIntf); + NewLine(); + WriteDec(); + WriteMethods(); + + GenerateFactoryClass(); + GenerateRegistrationProc(); +end; + +function TBinderGenerator.GetDestUnitName(): string; +begin + Result := Format('%s_binder',[SymbolTable.Name]); +end; + +constructor TBinderGenerator.Create(ASymTable: TSymbolTable;ASrcMngr: ISourceManager); +begin + Inherited Create(ASymTable,ASrcMngr); + FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec'); + FImpStream := SrcMngr.CreateItem(GetDestUnitName() + '.imp'); +end; + +procedure TBinderGenerator.Execute(); +Var + i,c : Integer; + intf : TInterfaceDefinition; +begin + GenerateUnitHeader(); + GenerateUnitImplementationHeader(); + c := Pred(SymbolTable.Count); + For i := 0 To c Do Begin + If SymbolTable.Item[i] Is TInterfaceDefinition Then Begin + intf := SymbolTable.Item[i] As TInterfaceDefinition; + GenerateIntf(intf); + GenerateImp(intf); + End; + End; + GenerateUnitImplementationFooter(); + FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream]); + FDecStream := Nil; + FImpStream := Nil; +end; + +{ TImplementationGenerator } + +function TImplementationGenerator.GenerateClassName(AIntf: TInterfaceDefinition): String; +begin + Result := ExtractserviceName(AIntf); + Result := Format('T%s_ServiceImp',[Result]); +end; + +procedure TImplementationGenerator.GenerateUnitHeader(); +begin + SetCurrentStream(FDecStream); + WriteLn('{'); + WriteLn('This unit has been produced by ws_helper.'); + WriteLn(' Input unit name : "%s".',[SymbolTable.Name]); + WriteLn(' This unit name : "%s".',[GetDestUnitName()]); + WriteLn(' Date : "%s".',[DateTimeToStr(Now())]); + WriteLn('}'); + + WriteLn('Unit %s;',[GetDestUnitName()]); + WriteLn('{$mode objfpc}{$H+}'); + WriteLn('Interface'); + WriteLn(''); + WriteLn('Uses SysUtils, Classes, '); + WriteLn(' base_service_intf, server_service_intf, server_service_imputils, %s;',[SymbolTable.Name]); + WriteLn(''); + WriteLn('Type'); + WriteLn(''); +end; + +procedure TImplementationGenerator.GenerateUnitImplementationHeader(); +begin + SetCurrentStream(FImpStream); + WriteLn(''); + WriteLn('Implementation'); +end; + +procedure TImplementationGenerator.GenerateUnitImplementationFooter(); +begin + NewLine(); + WriteLn('End.'); +end; + +procedure TImplementationGenerator.GenerateIntf(AIntf: TInterfaceDefinition); + procedure WriteDec(); + begin + Indent(); + WriteLn('%s=class(%s,%s)',[GenerateClassName(AIntf),sIMP_BASE_CLASS,AIntf.Name]); + end; + + procedure WriteMethod(AMthd : TMethodDefinition); + Var + prmCnt,k : Integer; + prm : TParameterDefinition; + Begin + Indent(); + prmCnt := AMthd.ParameterCount; + If ( AMthd.MethodType = mtProcedure ) Then + Write('procedure ') + Else Begin + Write('function '); + Dec(prmCnt); + End; + Write('%s(',[AMthd.Name]); + + If ( prmCnt > 0 ) Then Begin + IncIndent(); + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + If (k > 0 ) Then + Write('; '); + NewLine(); + Indent(); + Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]); + End; + DecIndent(); + NewLine(); + Indent(); + End; + + Write(')'); + If ( AMthd.MethodType = mtFunction ) Then Begin + Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]); + End; + WriteLn(';'); + End; + + procedure WriteMethods(); + Var + k : Integer; + begin + If ( AIntf.MethodCount = 0 ) Then + Exit; + Indent();WriteLn('Protected'); + IncIndent(); + For k := 0 To Pred(AIntf.MethodCount) Do + WriteMethod(AIntf.Method[k]); + DecIndent(); + end; + + procedure GenerateRegistrationProc(); + Begin + NewLine(); + BeginAutoIndent(); + IncIndent(); + WriteLn('procedure Register%sImplementationFactory();',[ExtractserviceName(AIntf)]); + DecIndent(); + EndAutoIndent(); + End; + +begin + SetCurrentStream(FDecStream); + NewLine(); + IncIndent(); + WriteDec(); + WriteMethods(); + Indent(); WriteLn('End;'); + NewLine(); + DecIndent(); + + GenerateRegistrationProc(); +end; + +procedure TImplementationGenerator.GenerateImp(AIntf: TInterfaceDefinition); +Var + strClassName : String; + + procedure WriteDec(); + begin + If ( AIntf.MethodCount > 0 ) Then + WriteLn('{ %s implementation }',[strClassName]); + end; + + procedure WriteMethodDec(AMthd : TMethodDefinition); + Var + prmCnt,k : Integer; + prm : TParameterDefinition; + Begin + prmCnt := AMthd.ParameterCount; + If ( AMthd.MethodType = mtProcedure ) Then + Write('procedure ') + Else Begin + Write('function '); + Dec(prmCnt); + End; + Write('%s.%s(',[strClassName,AMthd.Name]); + + If ( prmCnt > 0 ) Then Begin + IncIndent(); + For k := 0 To Pred(prmCnt) Do Begin + prm := AMthd.Parameter[k]; + If (k > 0 ) Then + Write('; '); + NewLine(); + Indent(); + Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]); + End; + DecIndent(); + NewLine(); + Indent(); + End; + + Write(')'); + If ( AMthd.MethodType = mtFunction ) Then Begin + Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]); + End; + WriteLn(';'); + End; + + procedure WriteMethodImp(AMthd : TMethodDefinition); + Begin + WriteLn('Begin'); + WriteLn('// your code here'); + WriteLn('End;'); + End; + + procedure WriteMethods(); + Var + k : Integer; + begin + For k := 0 To Pred(AIntf.MethodCount) Do Begin + WriteMethodDec(AIntf.Method[k]); + WriteMethodImp(AIntf.Method[k]); + WriteLn(''); + End; + end; + + procedure GenerateRegistrationProc(); + Var + strBuff : string; + Begin + NewLine(); + BeginAutoIndent(); + strBuff := ExtractserviceName(AIntf); + NewLine(); + WriteLn('procedure Register%sImplementationFactory();',[strBuff]); + WriteLn('Begin'); + IncIndent(); + WriteLn('GetServiceImplementationRegistry().Register(%s,TImplementationFactory.Create(%s) as IServiceImplementationFactory);',[QuotedStr(AIntf.Name),strClassName]); + DecIndent(); + WriteLn('End;'); + EndAutoIndent(); + End; + +begin + SetCurrentStream(FImpStream); + IncIndent(); + While ( DecIndent() > 0 ) Do + ; + strClassName := GenerateClassName(AIntf); + NewLine(); + WriteDec(); + WriteMethods(); + + GenerateRegistrationProc(); +end; + +function TImplementationGenerator.GetDestUnitName(): string; +begin + Result := Format('%s_imp',[SymbolTable.Name]); +end; + +constructor TImplementationGenerator.Create(ASymTable: TSymbolTable;ASrcMngr: ISourceManager); +begin + Inherited Create(ASymTable,ASrcMngr); + FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec'); + FImpStream := SrcMngr.CreateItem(GetDestUnitName() + '.imp'); +end; + +procedure TImplementationGenerator.Execute(); +Var + i,c : Integer; + intf : TInterfaceDefinition; +begin + GenerateUnitHeader(); + GenerateUnitImplementationHeader(); + c := Pred(SymbolTable.Count); + For i := 0 To c Do Begin + If SymbolTable.Item[i] Is TInterfaceDefinition Then Begin + intf := SymbolTable.Item[i] As TInterfaceDefinition; + GenerateIntf(intf); + GenerateImp(intf); + End; + End; + GenerateUnitImplementationFooter(); + FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream]); + FDecStream := Nil; + FImpStream := Nil; +end; + +end. diff --git a/wst/tags/3.1/ws_helper/metadata_generator.pas b/wst/tags/3.1/ws_helper/metadata_generator.pas new file mode 100644 index 000000000..1571d4e05 --- /dev/null +++ b/wst/tags/3.1/ws_helper/metadata_generator.pas @@ -0,0 +1,108 @@ +unit metadata_generator; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + parserdefs, binary_streamer; + +const + sWST_META = 'WST_METADATA_0.2.2.0'; + +type + + { TMetadataGenerator } + + TMetadataGenerator = class + private + FStream : IDataStore; + FSymbolTable: TSymbolTable; + + procedure GenerateHeader(); + procedure GenerateIntfMetadata(AIntf : TInterfaceDefinition); + public + constructor Create( + ASymTable : TSymbolTable; + ADstStream : IDataStore + ); + procedure Execute(); + end; + + +implementation + +{ TMetadataGenerator } + +procedure TMetadataGenerator.GenerateHeader(); +var + c, i, k : LongInt; +begin + FStream.WriteStr(sWST_META); + FStream.WriteStr(FSymbolTable.Name); + k := 0; + c := FSymbolTable.Count; + for i := 0 to pred(c) do begin + if FSymbolTable.Item[i] is TInterfaceDefinition then + inc(k); + end; + FStream.WriteInt8U(k); +end; + +procedure TMetadataGenerator.GenerateIntfMetadata(AIntf: TInterfaceDefinition); + + procedure WriteMethod(AMeth:TMethodDefinition); + + procedure WriteParam(APrm : TParameterDefinition); + begin + FStream.WriteStr(APrm.Name); + FStream.WriteStr(APrm.DataType.Name); + FStream.WriteEnum(Ord(APrm.Modifier)); + end; + + var + j, k : LongInt; + begin + k := AMeth.ParameterCount; + FStream.WriteStr(AMeth.Name); + FStream.WriteInt8U(k); + for j := 0 to pred(k) do + WriteParam(AMeth.Parameter[j]); + end; + +var + i, c : LongInt; +begin + FStream.WriteStr(AIntf.Name); + c := AIntf.MethodCount; + FStream.WriteInt8U(c); + for i := 0 to pred(c) do + WriteMethod(AIntf.Method[i]); +end; + +constructor TMetadataGenerator.Create(ASymTable: TSymbolTable;ADstStream: IDataStore); +begin + Assert(Assigned(ASymTable)); + Assert(Assigned(ADstStream)); + FSymbolTable := ASymTable; + FStream := ADstStream; +end; + +procedure TMetadataGenerator.Execute(); +Var + i,c : Integer; + intf : TInterfaceDefinition; +begin + GenerateHeader(); + c := Pred(FSymbolTable.Count); + for i := 0 to c do begin + if FSymbolTable.Item[i] is TInterfaceDefinition then begin + intf := FSymbolTable.Item[i] as TInterfaceDefinition; + GenerateIntfMetadata(intf); + end; + end; +end; + +end. + diff --git a/wst/tags/3.1/ws_helper/parserdefs.pas b/wst/tags/3.1/ws_helper/parserdefs.pas new file mode 100644 index 000000000..2e4412eb4 --- /dev/null +++ b/wst/tags/3.1/ws_helper/parserdefs.pas @@ -0,0 +1,481 @@ +{ + This unit is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + 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., 675 Mass Ave, Cambridge, MA 02139, USA. +} + + +unit parserdefs; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Contnrs; + +Type + + ESymbolException = class(Exception) + End; + + { TAbstractSymbolDefinition } + + TAbstractSymbolDefinition = class + private + FName: String; + Public + constructor Create(Const AName : String); + Property Name : String Read FName; + End; + + { TTypeDefinition } + + TTypeDefinition = class(TAbstractSymbolDefinition) + public + function NeedFinalization():Boolean;virtual; + end; + + { TEnumItemDefinition } + + TEnumItemDefinition = class(TAbstractSymbolDefinition) + private + FOrder: Integer; + Public + constructor Create(Const AName : String; Const AOrder : Integer); + Property Order : Integer Read FOrder; + End; + + { TEnumTypeDefinition } + + TEnumTypeDefinition = class(TTypeDefinition) + Private + FItemList : TObjectList; + private + function GetItem(Index: Integer): TEnumItemDefinition; + function GetItemCount: Integer; + Public + constructor Create(Const AName : String); + destructor Destroy();override; + function NeedFinalization():Boolean;override; + Procedure AddItem(AItem:TEnumItemDefinition); + function FindItem(Const AName:String):TEnumItemDefinition; + Property ItemCount : Integer Read GetItemCount; + Property Item[Index:Integer]:TEnumItemDefinition Read GetItem; + End; + + { TClassTypeDefinition } + + TClassTypeDefinition = class(TTypeDefinition) + public + function NeedFinalization():Boolean;override; + end; + + TParameterModifier = ( pmNone, pmConst, pmVar, pmOut ); + + { TParameterDefinition } + + TParameterDefinition = class(TAbstractSymbolDefinition) + private + FDataType: TTypeDefinition; + FModifier: TParameterModifier; + Public + constructor Create( + Const AName : String; + Const AModifier : TParameterModifier; + ADataType : TTypeDefinition + ); + property Modifier : TParameterModifier Read FModifier; + property DataType : TTypeDefinition Read FDataType; + End; + + TMethodType = ( mtProcedure, mtFunction ); +Const + ParameterModifierMAP : Array[TParameterModifier] Of String = + ( '', 'Const', 'Var', 'Out' ); +Type + + { TMethodDefinition } + + TMethodDefinition = class(TAbstractSymbolDefinition) + private + FMethodType: TMethodType; + FParameterList : TObjectList; + function GetParameter(Index: Integer): TParameterDefinition; + function GetParameterCount: Integer; + Public + constructor Create(Const AName : String; Const AMethodType : TMethodType); + destructor Destroy();override; + function AddParameter( + Const AName : String; + Const AModifier : TParameterModifier; + ADataType : TTypeDefinition + ):TParameterDefinition; + function GetParameterIndex(Const AName : String):Integer; + function FindParameter(Const AName : String):TParameterDefinition; + property MethodType : TMethodType Read FMethodType; + property ParameterCount : Integer Read GetParameterCount; + property Parameter[Index:Integer] : TParameterDefinition Read GetParameter; + End; + + { TInterfaceDefinition } + + TInterfaceDefinition = class(TAbstractSymbolDefinition) + Private + FInterfaceGUID: string; + FMethodList : TObjectList; + function GetMethod(Index: Integer): TMethodDefinition; + function GetMethodCount: Integer; + Public + constructor Create(Const AName : String); + destructor Destroy();override; + function GetMethodIndex(Const AName : String):Integer; + function FindMethod(Const AName : String):TMethodDefinition; + function AddMethod( + Const AName : String; + Const AMethodType : TMethodType + ):TMethodDefinition; + Property MethodCount : Integer Read GetMethodCount; + Property Method[Index:Integer] : TMethodDefinition Read GetMethod; + property InterfaceGUID : string read FInterfaceGUID write FInterfaceGUID; + End; + + { TSymbolTable } + + TSymbolTable = class(TAbstractSymbolDefinition) + Private + FList : TObjectList; + procedure CheckIndex(Const AIndex : Integer); + function GetCount: Integer; + function GetItem(Index: Integer): TAbstractSymbolDefinition; + procedure SetName(const AValue: String); + Public + constructor Create(Const AName : String); + destructor Destroy();override; + procedure Clear(); + function Add(ASym : TAbstractSymbolDefinition):Integer; + function IndexOf(Const AName : String):Integer;overload; + function IndexOf(ASym : TAbstractSymbolDefinition):Integer;overload; + function Find(Const AName : String):TAbstractSymbolDefinition; + function ByName(Const AName : String):TAbstractSymbolDefinition; + Property Name : String Read FName Write SetName; + Property Count : Integer Read GetCount; + Property Item[Index:Integer] : TAbstractSymbolDefinition Read GetItem; + End; + +implementation +uses StrUtils, parserutils; + +{ TAbstractSymbolDefinition } + +constructor TAbstractSymbolDefinition.Create(const AName: String); +begin + Assert(Not IsStrEmpty(AName)); + FName := AName; +end; + +{ TParameterDefinition } + +constructor TParameterDefinition.Create( + const AName: String; + const AModifier: TParameterModifier; + ADataType: TTypeDefinition +); +begin + Inherited Create(AName); + Assert(Assigned(ADataType)); + FModifier := AModifier; + FDataType := ADataType; +end; + +{ TMethodDefinition } + +function TMethodDefinition.GetParameter(Index: Integer): TParameterDefinition; +begin + Result := FParameterList[Index] As TParameterDefinition; +end; + +function TMethodDefinition.GetParameterCount: Integer; +begin + Result := FParameterList.Count; +end; + +constructor TMethodDefinition.Create( + const AName: String; + const AMethodType: TMethodType +); +begin + Inherited Create(AName); + FMethodType := AMethodType; + FParameterList := TObjectList.create(True); +end; + +destructor TMethodDefinition.Destroy(); +begin + FreeAndNil(FParameterList); + inherited Destroy(); +end; + +function TMethodDefinition.AddParameter( + Const AName : String; + Const AModifier : TParameterModifier; + ADataType : TTypeDefinition +): TParameterDefinition; +begin + If ( GetParameterIndex(Name) = -1 ) Then Begin + Result := TParameterDefinition.Create(AName,AModifier,ADataType); + FParameterList.Add(Result); + End Else Begin + Raise ESymbolException.CreateFmt('Duplicated parameter : %s.%s',[Name,AName]); + End; +end; + +function TMethodDefinition.GetParameterIndex(const AName: String): Integer; +begin + For Result := 0 To Pred(ParameterCount) Do + If AnsiSameText(AName,Parameter[Result].Name) Then + Exit; + Result := -1; +end; + +function TMethodDefinition.FindParameter( + const AName: String +): TParameterDefinition; +Var + i : Integer; +begin + i := GetParameterIndex(AName); + If ( i > -1 ) Then + Result := Parameter[i] + Else + Result := Nil; +end; + +{ TInterfaceDefinition } + +function TInterfaceDefinition.GetMethod(Index: Integer): TMethodDefinition; +begin + Result := FMethodList[Index] As TMethodDefinition; +end; + +function TInterfaceDefinition.GetMethodCount: Integer; +begin + Result := FMethodList.Count; +end; + +constructor TInterfaceDefinition.Create(const AName: String); +begin + Inherited Create(AName); + FMethodList := TObjectList.create(True); +end; + +destructor TInterfaceDefinition.Destroy(); +begin + FreeAndNil(FMethodList); + inherited Destroy(); +end; + +function TInterfaceDefinition.GetMethodIndex(const AName: String): Integer; +begin + For Result := 0 To Pred(MethodCount) Do + If AnsiSameText(AName,Method[Result].Name) Then + Exit; + Result := -1; +end; + +function TInterfaceDefinition.FindMethod(const AName: String): TMethodDefinition; +Var + i : Integer; +begin + i := GetMethodIndex(AName); + If ( i > -1 ) Then + Result := Method[i] + Else + Result := Nil; +end; + +function TInterfaceDefinition.AddMethod( + Const AName : String; + Const AMethodType : TMethodType +):TMethodDefinition; +begin + If ( GetMethodIndex(Name) = -1 ) Then Begin + Result := TMethodDefinition.Create(AName,AMethodType); + FMethodList.Add(Result); + End Else Begin + Raise ESymbolException.CreateFmt('Duplicated methode : %s.%s',[Name,AName]); + End; +end; + +{ TSymbolTable } + +procedure TSymbolTable.CheckIndex(const AIndex: Integer); +begin + If ( AIndex < 0 ) Or ( AIndex >= Count ) Then + Raise ESymbolException.CreateFmt('Invalid Table Index : %d',[AIndex]); +end; + +function TSymbolTable.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TSymbolTable.GetItem(Index: Integer): TAbstractSymbolDefinition; +begin + CheckIndex(Index); + Result := FList[Index] As TAbstractSymbolDefinition; +end; + +procedure TSymbolTable.SetName(const AValue: String); +begin + if ( FName = AValue ) then exit; + FName := AValue; +end; + +constructor TSymbolTable.Create(Const AName : String); +begin + Inherited Create(AName); + FList := TObjectList.Create(True); +end; + +destructor TSymbolTable.Destroy(); +begin + FList.Free(); + inherited Destroy(); +end; + +procedure TSymbolTable.Clear(); +begin + FList.Clear(); +end; + +function TSymbolTable.Add(ASym: TAbstractSymbolDefinition): Integer; +begin + Result := IndexOf(ASym); + If ( Result = -1 ) Then Begin + If ( IndexOf(ASym.Name) <> -1 ) Then + Raise ESymbolException.CreateFmt('Duplicated symbol name : %s',[ASym.Name]); + Result := FList.Add(ASym); + End; +end; + +function TSymbolTable.IndexOf(const AName: String): Integer; +begin + For Result := 0 To Pred(Count) Do + If AnsiSameText(AName,Item[Result].Name) Then + Exit; + Result := -1; +end; + +function TSymbolTable.IndexOf(ASym: TAbstractSymbolDefinition): Integer; +begin + Result := FList.IndexOf(ASym); +end; + +function TSymbolTable.Find(const AName: String): TAbstractSymbolDefinition; +Var + i : Integer; +begin + i := IndexOf(AName); + If ( i > -1 ) Then + Result := Item[i] + Else + Result := Nil; +end; + +function TSymbolTable.ByName(const AName: String): TAbstractSymbolDefinition; +begin + Result := Find(AName); + If Not Assigned(Result) Then + Raise ESymbolException.CreateFmt('No such Symbol : %s',[AName]); +end; + +{ TEnumItemDefinition } + +constructor TEnumItemDefinition.Create(const AName: String; Const AOrder: Integer); +begin + Inherited Create(AName); + FOrder := AOrder; +end; + +{ TEnumTypeDefinition } + +function TEnumTypeDefinition.GetItem(Index: Integer): TEnumItemDefinition; +begin + Result := FItemList[Index] As TEnumItemDefinition; +end; + +function TEnumTypeDefinition.GetItemCount: Integer; +begin + Result := FItemList.Count; +end; + +constructor TEnumTypeDefinition.Create(const AName: String); +begin + Inherited Create(AName); + FItemList := TObjectList.Create(False); +end; + +destructor TEnumTypeDefinition.Destroy(); +begin + FItemList.Free(); + inherited Destroy(); +end; + +function TEnumTypeDefinition.NeedFinalization(): Boolean; +begin + Result := False; +end; + +procedure TEnumTypeDefinition.AddItem(AItem:TEnumItemDefinition); +Begin + If ( FItemList.IndexOf(AItem) = -1 ) Then + FItemList.Add(AItem); +end; + +function TEnumTypeDefinition.FindItem(const AName: String): TEnumItemDefinition; +Var + i,c : Integer; +begin + c := Pred(ItemCount); + For i := 0 To c Do Begin + If AnsiSameText(AName,Item[i].Name) Then Begin + Result := Item[i]; + Exit; + End; + End; + Result := Nil; +end; + +{ TTypeDefinition } +const SIMPLE_TYPES : Array[0..12] Of string = ( + 'string', 'integer', 'smallint', 'shortint', 'char', 'boolean', + 'byte', 'word', 'longint', 'int64', + 'single', 'double', 'extended' + ); +function TTypeDefinition.NeedFinalization(): Boolean; +begin + Result := ( AnsiIndexText(Name,SIMPLE_TYPES) = -1 ); +end; + +{ TClassTypeDefinition } + +function TClassTypeDefinition.NeedFinalization(): Boolean; +begin + Result := True; +end; + +end. diff --git a/wst/tags/3.1/ws_helper/parserutils.pas b/wst/tags/3.1/ws_helper/parserutils.pas new file mode 100644 index 000000000..b021ca77b --- /dev/null +++ b/wst/tags/3.1/ws_helper/parserutils.pas @@ -0,0 +1,42 @@ +{ + This unit is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + 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., 675 Mass Ave, Cambridge, MA 02139, USA. +} + +unit parserutils; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils; + +const + sNEW_LINE = {$ifndef Unix}#13#10{$else}#10{$endif}; + + function IsStrEmpty(Const AStr : String):Boolean; + +implementation + +function IsStrEmpty(Const AStr : String):Boolean; +begin + Result := ( Length(Trim(AStr)) = 0 ); +end; + +end. + diff --git a/wst/tags/3.1/ws_helper/source_utils.pas b/wst/tags/3.1/ws_helper/source_utils.pas new file mode 100644 index 000000000..8e6e6a0fe --- /dev/null +++ b/wst/tags/3.1/ws_helper/source_utils.pas @@ -0,0 +1,307 @@ +{ + This unit is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + 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., 675 Mass Ave, Cambridge, MA 02139, USA. +} + +unit source_utils; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +Type + + EsourceException = class(Exception) + End; + + ISourceStream = Interface + function GetFileName():string; + procedure SaveToFile(const APath : string); + procedure Indent(); + function IncIndent():Integer; + function DecIndent():Integer; + procedure Write(AText : String);overload; + procedure Write(AText : String; Const AArgs : array of const);overload; + procedure WriteLn(AText : String);overload; + procedure WriteLn(AText : String; Const AArgs : array of const);overload; + procedure NewLine(); + procedure BeginAutoIndent(); + procedure EndAutoIndent(); + End; + + ISourceManager = Interface + function CreateItem(const AFileName : string):ISourceStream; + function Find(const AFileName : string):ISourceStream; + function Merge( + const AFinalFileName : string; + const ASourceList : array of ISourceStream + ) : ISourceStream; + procedure SaveToFile(const APath : string); + End; + + function CreateSourceManager():ISourceManager; + +implementation +uses StrUtils, parserutils; + +Type + + ISavableSourceStream = Interface(ISourceStream) + procedure SaveToStream(AStream : TStream); + procedure SaveToFile(const APath : string); + function GetStream(): TStream; + End; + + { TSourceStream } + + TSourceStream = class(TInterfacedObject,ISavableSourceStream) + Private + FStream : TMemoryStream; + FIndentCount : Integer; + FAutoIndentCount : Integer; + FFileName : string; + Protected + function GetFileName():string; + procedure SaveToStream(AStream : TStream); + function GetStream(): TStream; + procedure SaveToFile(const APath : string); + procedure Indent(); + function IncIndent():Integer; + function DecIndent():Integer; + procedure Write(AText : String);overload; + procedure Write(AText : String; Const AArgs : array of const);overload; + procedure WriteLn(AText : String);overload; + procedure WriteLn(AText : String; Const AArgs : array of const);overload; + procedure NewLine(); + procedure BeginAutoIndent(); + procedure EndAutoIndent(); + function IsInAutoInden():Boolean; + Public + constructor Create(const AFileName:string); + destructor Destroy();override; + End; + + { TSourceManager } + + TSourceManager = class(TInterfacedObject,ISourceManager) + Private + FList : IInterfaceList; + Private + procedure Error(AText : String);overload; + procedure Error(AText : String; Const AArgs : array of const);overload; + + function GetCount():Integer; + function GetItem(const AIndex:Integer):ISourceStream; + Protected + function CreateItem(const AFileName : string):ISourceStream; + function Find(const AFileName : string):ISourceStream; + procedure SaveToFile(const APath : string); + function Merge( + const AFinalFileName : string; + const ASourceList : array of ISourceStream + ) : ISourceStream; + Public + constructor Create(); + End; + +function CreateSourceManager():ISourceManager; +begin + Result := TSourceManager.Create() as ISourceManager; +end; + +{ TSourceManager } + +procedure TSourceManager.Error(AText: String); +begin + Raise EsourceException.Create(AText); +end; + +procedure TSourceManager.Error(AText: String; const AArgs: array of const); +begin + Raise EsourceException.CreateFmt(AText,AArgs); +end; + +function TSourceManager.GetCount(): Integer; +begin + Result := FList.Count; +end; + +function TSourceManager.GetItem(const AIndex: Integer): ISourceStream; +begin + Result := FList[AIndex] as ISourceStream; +end; + +function TSourceManager.CreateItem(const AFileName: string): ISourceStream; +begin + If Assigned(Find(AFileName)) Then + Error('A file named "%s" allready exists.',[AFileName]); + Result := TSourceStream.Create(AFileName) as ISourceStream; + FList.Add(Result); +end; + +function TSourceManager.Find(const AFileName: string): ISourceStream; +Var + i : Integer; + s : string; +begin + s := LowerCase(AFileName); + For i := 0 To Pred(GetCount()) Do Begin + Result := GetItem(i); + If AnsiSameText(s,Result.GetFileName()) Then + Exit; + End; + Result := Nil; +end; + +procedure TSourceManager.SaveToFile(const APath: string); +Var + i : Integer; +begin + For i := 0 To Pred(GetCount()) Do Begin + (GetItem(i) As ISavableSourceStream).SaveToFile(APath); + End; +end; + +function TSourceManager.Merge(const AFinalFileName: string;const ASourceList: array of ISourceStream): ISourceStream; +Var + i : Integer; + s : TStream; +begin + Result := CreateItem(AFinalFileName); + s := (Result as ISavableSourceStream).GetStream(); + For i := Low(ASourceList) To High(ASourceList) Do Begin + (ASourceList[i] as ISavableSourceStream).SaveToStream(s); + FList.Remove(ASourceList[i]); + End; +end; + +constructor TSourceManager.Create(); +begin + FList := TInterfaceList.Create() as IInterfaceList; +end; + +{ TSourceStream } + +function TSourceStream.GetFileName(): string; +begin + Result := FFileName; +end; + +procedure TSourceStream.SaveToStream(AStream: TStream); +begin + AStream.CopyFrom(FStream,0); +end; + +function TSourceStream.GetStream(): TStream; +begin + Result := FStream; +end; + +procedure TSourceStream.SaveToFile(const APath: string); +begin + FStream.SaveToFile(IncludeTrailingPathDelimiter(APath) + GetFileName()); +end; + +procedure TSourceStream.Indent(); +Const INDENT_STR = ' '; +Var + s : string; +begin + If ( FIndentCount > 0 ) Then Begin + s := DupeString(INDENT_STR,FIndentCount); + FStream.Write(s[1],Length(s)); + End; +end; + +function TSourceStream.IncIndent():Integer; +begin + Inc(FIndentCount); + Result := FIndentCount; +end; + +function TSourceStream.DecIndent():Integer; +begin + Assert(FIndentCount>0); + Dec(FIndentCount); + Result := FIndentCount; +end; + +procedure TSourceStream.Write(AText: String); +Var + i : Integer; +begin + If IsInAutoInden() Then + Indent(); + i := Length(AText); + If ( i > 0 ) Then + FStream.Write(AText[1],i); +end; + +procedure TSourceStream.Write(AText: String; const AArgs: array of const); +begin + Write(Format(AText,AArgs)); +end; + +procedure TSourceStream.WriteLn(AText: String); +begin + Write(AText+sNEW_LINE); +end; + +procedure TSourceStream.WriteLn(AText: String; const AArgs: array of const); +begin + Write(AText+sNEW_LINE,AArgs); +end; + +procedure TSourceStream.NewLine(); +begin + WriteLn(''); +end; + +procedure TSourceStream.BeginAutoIndent(); +begin + Inc(FAutoIndentCount); +end; + +procedure TSourceStream.EndAutoIndent(); +begin + Assert(FAutoIndentCount>0); + Dec(FAutoIndentCount); +end; + +function TSourceStream.IsInAutoInden(): Boolean; +begin + Result := ( FAutoIndentCount > 0 ); +end; + +constructor TSourceStream.Create(const AFileName: string); +begin + FFileName := AFileName; + FStream := TMemoryStream.Create(); + FIndentCount := 0; + FAutoIndentCount := 0; +end; + +destructor TSourceStream.Destroy(); +begin + FreeAndNil(FStream); + inherited Destroy(); +end; + +end. diff --git a/wst/tags/3.1/ws_helper/ws_helper.lpi b/wst/tags/3.1/ws_helper/ws_helper.lpi new file mode 100644 index 000000000..16e0f58b5 --- /dev/null +++ b/wst/tags/3.1/ws_helper/ws_helper.lpi @@ -0,0 +1,309 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/tags/3.1/ws_helper/ws_helper.pas b/wst/tags/3.1/ws_helper/ws_helper.pas new file mode 100644 index 000000000..b98abb2fb --- /dev/null +++ b/wst/tags/3.1/ws_helper/ws_helper.pas @@ -0,0 +1,160 @@ +{ + This unit is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + 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., 675 Mass Ave, Cambridge, MA 02139, USA. +} + + +program ws_helper; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, LResources, + parserdefs, ws_parser, generator, parserutils, source_utils, + command_line_parser, metadata_generator, binary_streamer; + +resourcestring + sUSAGE = 'ws_helper [-p] [-b] [-i] [-oPATH] inputFilename' + sNEW_LINE + + ' -p Generate service proxy' + sNEW_LINE + + ' -b Generate service binder' + sNEW_LINE + + ' -i Generate service minimal implementation' + sNEW_LINE + + ' -o PATH Output directory' + sNEW_LINE; + sCOPYRIGHT = 'ws_helper, Web Service Toolkit 0.3 Copyright (c) 2006 by Inoussa OUEDRAOGO'; + +const + sWST_META = 'wst_meta'; + +Var + inFileName,outPath,errStr : string; + srcMngr : ISourceManager; + AppOptions : TComandLineOptions; + NextParam : Integer; + + function ProcessCmdLine():boolean; + begin + NextParam := ParseCmdLineOptions(AppOptions); + If ( NextParam <= Paramcount ) Then + inFileName := ParamStr(NextParam); + Result := FileExists(ExpandFileName(inFileName)); + If Result Then Begin + If ( AppOptions = [] ) Then + Include(AppOptions,cloProxy); + End Else + errStr := Format('File not Found : "%s"',[inFileName]); + outPath := ExtractFilePath(inFileName); + If ( cloOutPutDir in AppOptions ) Then Begin + outPath := outPath + Trim(GetOptionArg(cloOutPutDir)); + outPath := IncludeTrailingPathDelimiter(outPath); + End; + end; + + function ProcessFile():Boolean; + Var + p : TPascalParser; + s : TFileStream; + mtdaFS: TMemoryStream; + g : TBaseGenerator; + mg : TMetadataGenerator; + rsrcStrm : TMemoryStream; + begin + Result := False; + rsrcStrm := nil; + mtdaFS := nil; + mg := nil; + g := Nil; + s := Nil; + p := Nil; + Try + Try + s := TFileStream.Create(inFileName,fmOpenRead); + p := TPascalParser.Create(s); + If Not p.Parse() Then + p.Error(p.ErrorMessage); + If ( cloProxy in AppOptions ) Then Begin + g := TProxyGenerator.Create(p.SymbolTable,srcMngr); + g.Execute(); + FreeAndNil(g); + End; + + If ( cloBinder in AppOptions ) Then Begin + g := TBinderGenerator.Create(p.SymbolTable,srcMngr); + g.Execute(); + FreeAndNil(g); + End; + + If ( cloImp in AppOptions ) Then Begin + g := TImplementationGenerator.Create(p.SymbolTable,srcMngr); + g.Execute(); + FreeAndNil(g); + End; + + if ( [cloBinder,cloProxy]*AppOptions <> [] ) then begin + mtdaFS := TMemoryStream.Create(); + mg := TMetadataGenerator.Create(p.SymbolTable,CreateBinaryWriter(mtdaFS)); + mg.Execute(); + mtdaFS.SaveToFile(ChangeFileExt(inFileName,'.' + sWST_META)); + rsrcStrm := TMemoryStream.Create(); + mtdaFS.Position := 0; + BinaryToLazarusResourceCode(mtdaFS,rsrcStrm,UpperCase(p.SymbolTable.Name),sWST_META); + rsrcStrm.SaveToFile(outPath + ChangeFileExt(ExtractFileName(inFileName),'.lrs')); + end; + + Result := True; + Except + On E : Exception Do Begin + Result := False; + errStr := Format('"%s" at line %d',[E.Message,p.SourceLine]) ; + End; + End; + Finally + rsrcStrm.Free(); + mg.Free();; + mtdaFS.Free();; + g.Free(); + p.Free(); + s.Free(); + End; + end; + + +begin + Try + Writeln(sCOPYRIGHT); + If ( ParamCount = 0 ) Then Begin + WriteLn(sUSAGE); + Exit; + End; + + + srcMngr := CreateSourceManager(); + If Not ProcessCmdLine() Then Begin + WriteLn(errStr); + Exit; + End; + + If Not ProcessFile() Then Begin + WriteLn(errStr); + Exit; + End; + + srcMngr.SaveToFile(outPath); + WriteLn(Format('File "%s" parsed succesfully.',[inFileName])); + except + on e:exception Do + Writeln('Exception : ' + e.Message) + end; +end. diff --git a/wst/tags/3.1/ws_helper/ws_helper.rst b/wst/tags/3.1/ws_helper/ws_helper.rst new file mode 100644 index 000000000..ab04eb91d --- /dev/null +++ b/wst/tags/3.1/ws_helper/ws_helper.rst @@ -0,0 +1,15 @@ + +# hash value = 13585 +ws_helper.sversion='2.1' + + +# hash value = 71138986 +ws_helper.susage='ws_helper [-p] [-b] [-i] [-oPATH] inputFilename'#13#10' '+ +' -p Generate service proxy'#13#10' -b Generate service binder'#13#10' '+ +' -i Generate service minimal implementation'#13#10' -o PATH Output d'+ +'irectory'#13#10 + +# hash value = 89842783 +ws_helper.scopyright='ws_helper, Web Service Toolkit 2.2 Copyright (c) 20'+ +'06 by Inoussa OUEDRAOGO' + diff --git a/wst/tags/3.1/ws_helper/ws_parser.pas b/wst/tags/3.1/ws_helper/ws_parser.pas new file mode 100644 index 000000000..8792764f6 --- /dev/null +++ b/wst/tags/3.1/ws_helper/ws_parser.pas @@ -0,0 +1,489 @@ +{ + This unit is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + 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., 675 Mass Ave, Cambridge, MA 02139, USA. +} + +unit ws_parser; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + parserdefs; + +Type + EParserException = class(Exception) + End; + + { TPascalParser } + + TPascalParser = class + private + FStream : TStream; + FTokenizer : TParser; + FErrorMessage : String; + FSymbolTable : TSymbolTable; + FCurrentSymbol : TAbstractSymbolDefinition; + private + Property Tokenizer : TParser Read FTokenizer; + procedure SetErrorMessage(Const AValue : String); + procedure CheckCurrentString(Const AString : String); + private + procedure BeginParsing(); + procedure EndParsing(); + function GetSourceLine: Integer; + function ReadUntil(Const AText : String; Const ARaiseException : Boolean):Boolean; + procedure SkipComment(); + function NextToken(): Char; + Private + procedure ParseHeader(); + procedure ParseInterfaceSection(); + procedure ParseUses(); + procedure ParseTypeDeclaration(); + procedure ParseInterfaceType(Const AName : String); + procedure ParseEnumType(Const AName : String); + procedure ParseClassType(Const AName : String); + public + constructor Create(AStream : TStream); + destructor Destroy();override; + procedure Error(Const AMsg : String);overload; + procedure Error(Const AMsg : String; Const AArgs : Array of const);overload; + function Parse():Boolean; + property SourceLine: Integer read GetSourceLine; + property ErrorMessage : String read FErrorMessage; + property SymbolTable : TSymbolTable Read FSymbolTable; + End; + + +implementation + +Type + TPascalToken = ( + ptNone, + ptUnit, ptInterface, ptUses, ptType, + ptImplementation, ptEnd, + ptProcedure, ptFunction, + ptSemicolon, ptComma, ptPeriod, ptEqual, ptColon, + ptLeftParenthesis, ptRigthParenthesis, + ptLeftSquareBracket, ptRigthSquareBracket, + ptConst, ptVar, ptOut, + ptClass + ); +Const + PascalTokenStrMAP : Array[TPascalToken] Of String = ( + '', + 'UNIT', 'INTERFACE', 'USES', 'TYPE', + 'IMPLEMENTATION', 'END', + 'PROCEDURE', 'FUNCTION', + ';', ',', '.', '=', ':', + '(', ')', + '[', ']', + 'CONST', 'VAR', 'OUT', + 'CLASS' + ); + +function GetPascalTokenStr(Const AToken:TPascalToken):String; +begin + Result := PascalTokenStrMAP[AToken]; +end; + +function GetPascalTokenFromStr(Const ATokenStr:String):TPascalToken; +begin + Result := Succ(ptNone); + For Result := Result To High(TPascalToken) Do Begin + If AnsiSameText(ATokenStr,PascalTokenStrMAP[Result]) Then + Exit; + End; + Result := ptNone; +end; + +{ TPascalParser } + +procedure TPascalParser.SetErrorMessage(const AValue: String); +begin + FErrorMessage := AValue; +end; + +procedure TPascalParser.Error(const AMsg: String); +begin + Raise EParserException.Create(AMsg); +end; + +procedure TPascalParser.Error(const AMsg: String; const AArgs: array of const); +begin + Raise EParserException.CreateFmt(AMsg,AArgs); +end; + +procedure TPascalParser.CheckCurrentString(const AString: String); +begin + If Not AnsiSameText(Tokenizer.TokenString,AString) Then + Error('"%s" expected.',[AString]); +end; + +procedure TPascalParser.BeginParsing(); +begin + +end; + +procedure TPascalParser.EndParsing(); +begin + +end; + +function TPascalParser.GetSourceLine: Integer; +begin + Result := Tokenizer.SourceLine; +end; + +function TPascalParser.ReadUntil(Const AText : String; Const ARaiseException : Boolean):Boolean; +begin + While ( Tokenizer.Token <> toEOF ) And ( Not AnsiSameText(Tokenizer.TokenString,AText) ) Do + Tokenizer.NextToken(); + Result := AnsiSameText(Tokenizer.TokenString,AText); + If ARaiseException And ( Not Result ) Then + Error('"%s" not found.',[AText]); +end; + +procedure TPascalParser.SkipComment(); +const L_C = '{'; R_C = '}'; +begin + While ( FTokenizer.TokenString = L_C ) do begin + ReadUntil(R_C,False); + FTokenizer.NextToken(); + end; +end; + +function TPascalParser.NextToken(): Char; +begin + SkipComment(); + Result := FTokenizer.NextToken(); + SkipComment(); +end; + +procedure TPascalParser.ParseHeader(); +begin // Unit UnitName; + SkipComment(); + Tokenizer.CheckTokenSymbol(GetPascalTokenStr(ptUnit)); + NextToken(); + Tokenizer.CheckToken(toSymbol); + FSymbolTable.Name := Tokenizer.TokenString; + NextToken(); + CheckCurrentString(GetPascalTokenStr(ptSemicolon)); + + NextToken(); +end; + +procedure TPascalParser.ParseInterfaceSection(); +begin + ReadUntil(GetPascalTokenStr(ptInterface),True); + Tokenizer.CheckTokenSymbol(GetPascalTokenStr(ptInterface)); + NextToken(); + Tokenizer.CheckToken(toSymbol); + If Tokenizer.TokenSymbolIs(GetPascalTokenStr(ptUses)) Then + ParseUses(); + Tokenizer.CheckToken(toSymbol); + If Tokenizer.TokenSymbolIs(GetPascalTokenStr(ptType)) Then Begin + NextToken(); + Repeat + ParseTypeDeclaration(); + Until ( Tokenizer.Token = toEOF ) Or + Tokenizer.TokenSymbolIs(GetPascalTokenStr(ptImplementation)) Or + Tokenizer.TokenSymbolIs(GetPascalTokenStr(ptProcedure)) Or + Tokenizer.TokenSymbolIs(GetPascalTokenStr(ptFunction)); + End; +end; + +procedure TPascalParser.ParseUses(); +begin + Tokenizer.CheckTokenSymbol(GetPascalTokenStr(ptUses)); + NextToken(); + Repeat + Tokenizer.CheckToken(toSymbol); //UnitName + NextToken(); + If AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptSemicolon)) Then + Break; + CheckCurrentString(GetPascalTokenStr(ptComma)); + NextToken(); + Until ( Tokenizer.Token = toEOF ) Or AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptSemicolon)); + CheckCurrentString(GetPascalTokenStr(ptSemicolon)); + NextToken(); +end; + +procedure TPascalParser.ParseTypeDeclaration(); +var + sname : string; +begin + Tokenizer.CheckToken(toSymbol); + sname := Tokenizer.TokenString; + NextToken(); + CheckCurrentString(GetPascalTokenStr(ptEqual)); + + NextToken(); + if AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptLeftParenthesis)) then + self.ParseEnumType(sname) + else if AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptClass)) then + self.ParseClassType(sname) + else begin + Tokenizer.CheckToken(toSymbol); + if Tokenizer.TokenSymbolIs(GetPascalTokenStr(ptInterface)) then + ParseInterfaceType(sname) + else begin + ReadUntil(GetPascalTokenStr(ptEnd),True); + NextToken();// End + NextToken();// ; + end; + end; +end; + +procedure TPascalParser.ParseInterfaceType(const AName: String); +Var + sbl : TInterfaceDefinition; + + procedure ReadIntfHeader(); + Var + tmpStr : String; + begin + NextToken(); + Repeat + Tokenizer.CheckToken(toSymbol); + tmpStr := Tokenizer.TokenString; + NextToken(); + If AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptRigthParenthesis)) Then Begin + NextToken(); + Break; + End; + NextToken(); + CheckCurrentString(GetPascalTokenStr(ptComma)); + + NextToken(); + Until ( Tokenizer.Token = toEOF ) ; + end; + + procedure ReadProcedure(Const AProc : Boolean); + Var + tmpStr,prmName : String; + tmpTkn : TPascalToken; + pr : TMethodDefinition; + prmM : TParameterModifier; + dataTypeSbl : TTypeDefinition; + foundSymbol : TAbstractSymbolDefinition; + begin + NextToken(); + Tokenizer.CheckToken(toSymbol); + tmpStr := Tokenizer.TokenString; + If AProc Then + pr := sbl.AddMethod(tmpStr,mtProcedure) + Else + pr := sbl.AddMethod(tmpStr,mtFunction); + NextToken(); + If AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptLeftParenthesis)) Then Begin + NextToken(); + If AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptRigthParenthesis)) Then + NextToken() + Else Begin + Repeat + Tokenizer.CheckToken(toSymbol); + tmpStr := Tokenizer.TokenString; + tmpTkn := GetPascalTokenFromStr(tmpStr); + prmM := pmNone; + If ( tmpTkn = ptConst ) Then Begin + prmM := pmConst; + End Else If ( tmpTkn = ptVar ) Then Begin + prmM := pmVar; + End Else If ( tmpTkn = ptOut ) Then Begin + prmM := pmOut; + End; + If ( prmM > pmNone ) Then Begin + NextToken(); + tmpStr := Tokenizer.TokenString; + End; + prmName := tmpStr; + NextToken(); + CheckCurrentString(GetPascalTokenStr(ptColon)); + + NextToken(); + Tokenizer.CheckToken(toSymbol); + tmpStr := Tokenizer.TokenString; + foundSymbol := FSymbolTable.Find(tmpStr); + If Assigned(foundSymbol) And ( Not foundSymbol.InheritsFrom(TTypeDefinition) ) Then + Error('Type symbol expected where "%s" was found.',[foundSymbol.Name]); + If Assigned(foundSymbol) Then + dataTypeSbl := foundSymbol As TTypeDefinition + Else Begin + dataTypeSbl := TTypeDefinition.Create(tmpStr); + FSymbolTable.Add(dataTypeSbl); + End; + pr.AddParameter(prmName,prmM,dataTypeSbl); + NextToken(); + tmpStr := Tokenizer.TokenString; + If AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptRigthParenthesis)) Then Begin + NextToken(); + Break; + End; + NextToken(); + Until ( Tokenizer.Token = toEOF ) ; + End; + End; + If Not AProc Then Begin + CheckCurrentString(GetPascalTokenStr(ptColon)); + NextToken(); + Tokenizer.CheckToken(toSymbol); + tmpStr := Tokenizer.TokenString; + dataTypeSbl := FSymbolTable.Find(tmpStr) As TTypeDefinition; + If Not Assigned(dataTypeSbl) Then Begin + dataTypeSbl := TTypeDefinition.Create(tmpStr); + FSymbolTable.Add(dataTypeSbl); + End; + pr.AddParameter('result',pmOut,dataTypeSbl); + NextToken(); + End; + CheckCurrentString(GetPascalTokenStr(ptSemicolon)); + NextToken(); + end; + + procedure ReadFunction(); + begin + ReadProcedure(False); + end; + + procedure ReadGUID(); + begin //['{804A3825-ADA5-4499-87BF-CF5491BFD674}'] + CheckCurrentString(GetPascalTokenStr(ptLeftSquareBracket)); + NextToken(); + FTokenizer.CheckToken(toString); + sbl.InterfaceGUID := FTokenizer.TokenString; + NextToken(); + CheckCurrentString(GetPascalTokenStr(ptRigthSquareBracket)); + NextToken(); + end; + +begin + Tokenizer.CheckTokenSymbol(GetPascalTokenStr(ptInterface)); + sbl := TInterfaceDefinition.Create(AName); + FSymbolTable.Add(sbl); + FCurrentSymbol := sbl; + NextToken(); + if AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptLeftParenthesis)) then + ReadIntfHeader(); + if AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptLeftSquareBracket)) then + ReadGUID(); + repeat + if Tokenizer.TokenSymbolIs(GetPascalTokenStr(ptProcedure)) then + ReadProcedure(True) + else if Tokenizer.TokenSymbolIs(GetPascalTokenStr(ptFunction)) then + ReadFunction() + else if Tokenizer.TokenSymbolIs(GetPascalTokenStr(ptEnd)) then begin + NextToken(); + NextToken(); + Break; + end else begin + Error('"%s", "%s", "%s" expected.',[GetPascalTokenStr(ptProcedure),GetPascalTokenStr(ptFunction),GetPascalTokenStr(ptEnd)]); + end; + until ( Tokenizer.Token = toEOF ) ; +end; + +procedure TPascalParser.ParseEnumType(const AName: String); +Var + sbl : TEnumTypeDefinition; + tmpStr : String; + sblItem : TEnumItemDefinition; + tmpInt : Integer; +begin + sbl := TEnumTypeDefinition.Create(AName); + FSymbolTable.Add(sbl); + FCurrentSymbol := sbl; + CheckCurrentString(GetPascalTokenStr(ptLeftParenthesis)); + NextToken(); + Tokenizer.CheckToken(toSymbol); + tmpInt := 0; + Repeat + tmpStr := Tokenizer.TokenString; + If ( FSymbolTable.IndexOf(tmpStr) > -1 ) Then + Error('Duplicated symbol : "%s"',[tmpStr]); + sblItem := TEnumItemDefinition.Create(tmpStr,tmpInt); + FSymbolTable.Add(sblItem); + sbl.AddItem(sblItem); + NextToken(); + If AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptRigthParenthesis)) Then + Break; + If AnsiSameText(Tokenizer.TokenString,GetPascalTokenStr(ptComma)) Then + NextToken(); + Tokenizer.CheckToken(toSymbol); + Inc(tmpInt); + Until ( Tokenizer.Token = toEOF ) ; + CheckCurrentString(GetPascalTokenStr(ptRigthParenthesis)); + NextToken(); + CheckCurrentString(GetPascalTokenStr(ptSemicolon)); + NextToken(); +end; + +procedure TPascalParser.ParseClassType(const AName: String); +Var + sbl : TClassTypeDefinition; + tmpStr : String; +begin + sbl := TClassTypeDefinition.Create(AName); + FSymbolTable.Add(sbl); + FCurrentSymbol := sbl; + CheckCurrentString(GetPascalTokenStr(ptClass)); + NextToken(); + ReadUntil(GetPascalTokenStr(ptEnd),True); + CheckCurrentString(GetPascalTokenStr(ptEnd)); + NextToken(); + CheckCurrentString(GetPascalTokenStr(ptSemicolon)); + NextToken(); +end; + +constructor TPascalParser.Create(AStream : TStream); +begin + Assert(Assigned(AStream)); + FStream := AStream; + FTokenizer := TParser.Create(FStream); + FSymbolTable := TSymbolTable.Create(''); + FCurrentSymbol := Nil; +end; + +destructor TPascalParser.Destroy(); +begin + FTokenizer.Free(); + FreeAndNil(FSymbolTable); + inherited Destroy(); +end; + +function TPascalParser.Parse(): Boolean; +begin + BeginParsing(); + Try + Try + SkipComment(); + ParseHeader(); + ParseInterfaceSection(); + Except + On E : Exception Do Begin + Result := False; + SetErrorMessage(E.Message ); + End; + End; + Finally + EndParsing(); + End; +end; + +end. +